Changeset 6 for trunk/LocalPlayer
- Timestamp:
- Jan 7, 2017, 11:32:14 AM (8 years ago)
- Location:
- trunk/LocalPlayer
- Files:
-
- 37 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LocalPlayer/BaseWin.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit BaseWin; 4 3 … … 6 5 7 6 uses 8 ScreenTools, Messg,9 10 Windows, Messages,SysUtils,Classes,Graphics,Controls,Forms;7 ScreenTools, Messg, 8 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms; 11 10 12 11 type … … 16 15 constructor Create(AOwner: TComponent); override; 17 16 procedure FormClose(Sender: TObject; var Action: TCloseAction); 18 procedure FormPaint(Sender:TObject); 19 procedure FormKeyDown(Sender: TObject; var Key: Word; 20 Shift: TShiftState); 17 procedure FormPaint(Sender: TObject); 18 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 21 19 procedure FormDeactivate(Sender: TObject); 22 20 procedure SmartUpdateContent(ImmUpdate: boolean = false); 23 21 procedure StayOnTop_Workaround; 24 22 protected 25 FWindowMode, ModalFrameIndent: integer;23 FWindowMode, ModalFrameIndent: integer; 26 24 HelpContext: string; 27 25 procedure ShowNewContent(NewMode: integer; forceclose: boolean = false); 28 procedure MarkUsedOffscreen(xMax, yMax: integer);26 procedure MarkUsedOffscreen(xMax, yMax: integer); 29 27 procedure OffscreenPaint; virtual; 30 28 procedure VPaint; virtual; … … 33 31 end; 34 32 35 36 33 TFramedDlg = class(TBufferedDrawDlg) 37 34 public 38 35 constructor Create(AOwner: TComponent); override; 39 procedure FormCreate(Sender: TObject);36 procedure FormCreate(Sender: TObject); 40 37 procedure SmartInvalidate; override; 41 38 protected … … 44 41 procedure InitWindowRegion; 45 42 procedure VPaint; override; 46 procedure FillOffscreen(Left,Top,Width,Height: integer); 47 end; 48 43 procedure FillOffscreen(Left, Top, Width, Height: integer); 44 end; 49 45 50 46 const 51 // window modes 52 wmNone=0; wmModal=$1; wmPersistent=$2; wmSubmodal=$3; 53 54 55 yUnused=161; 56 NarrowFrame=11; WideFrame=36; SideFrame=9; 47 // window modes 48 wmNone = 0; 49 wmModal = $1; 50 wmPersistent = $2; 51 wmSubmodal = $3; 52 53 yUnused = 161; 54 NarrowFrame = 11; 55 WideFrame = 36; 56 SideFrame = 9; 57 57 58 58 var 59 UsedOffscreenWidth, UsedOffscreenHeight: integer;60 Offscreen: TBitmap;61 OffscreenUser: TForm;59 UsedOffscreenWidth, UsedOffscreenHeight: integer; 60 Offscreen: TBitmap; 61 OffscreenUser: TForm; 62 62 63 63 procedure CreateOffscreen; 64 64 65 66 65 implementation 67 66 68 67 uses 69 Term, Help, ButtonBase, Area; 70 68 Term, Help, ButtonBase, Area; 71 69 72 70 constructor TBufferedDrawDlg.Create; 73 71 begin 74 OnClose:=FormClose;75 OnPaint:=FormPaint;76 OnKeyDown:=FormKeyDown;77 OnDeactivate:=FormDeactivate;78 inherited;79 FWindowMode:=wmNone;80 HelpContext:='CONCEPTS';81 TitleHeight:=WideFrame;82 ModalFrameIndent:=45;83 UserLeft:=(Screen.Width-Width) div 2;84 UserTop:=(Screen.Height-Height) div 2;72 OnClose := FormClose; 73 OnPaint := FormPaint; 74 OnKeyDown := FormKeyDown; 75 OnDeactivate := FormDeactivate; 76 inherited; 77 FWindowMode := wmNone; 78 HelpContext := 'CONCEPTS'; 79 TitleHeight := WideFrame; 80 ModalFrameIndent := 45; 81 UserLeft := (Screen.Width - Width) div 2; 82 UserTop := (Screen.Height - Height) div 2; 85 83 end; 86 84 87 85 procedure TBufferedDrawDlg.FormClose(Sender: TObject; var Action: TCloseAction); 88 86 begin 89 if FWindowMode=wmPersistent then 90 begin UserLeft:=Left; UserTop:=Top end; 91 if OffscreenUser=self then OffscreenUser:=nil; 92 end; 93 94 procedure TBufferedDrawDlg.FormPaint(Sender:TObject); 95 begin 96 if OffscreenUser<>self then OffscreenPaint; 97 VPaint 87 if FWindowMode = wmPersistent then 88 begin 89 UserLeft := Left; 90 UserTop := Top 91 end; 92 if OffscreenUser = self then 93 OffscreenUser := nil; 94 end; 95 96 procedure TBufferedDrawDlg.FormPaint(Sender: TObject); 97 begin 98 if OffscreenUser <> self then 99 OffscreenPaint; 100 VPaint 98 101 end; 99 102 … … 101 104 Shift: TShiftState); 102 105 begin 103 if Key=VK_ESCAPE then 104 begin 105 if fsModal in FormState then ModalResult:=mrCancel 106 end 107 else if Key=VK_RETURN then 108 begin 109 if fsModal in FormState then ModalResult:=mrOK 110 end 111 else if Key=VK_F1 then 112 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkText, HelpDlg.TextIndex(HelpContext)) 113 else if FWindowMode=wmPersistent then 114 MainScreen.FormKeyDown(Sender, Key, Shift); 106 if Key = VK_ESCAPE then 107 begin 108 if fsModal in FormState then 109 ModalResult := mrCancel 110 end 111 else if Key = VK_RETURN then 112 begin 113 if fsModal in FormState then 114 ModalResult := mrOK 115 end 116 else if Key = VK_F1 then 117 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkText, 118 HelpDlg.TextIndex(HelpContext)) 119 else if FWindowMode = wmPersistent then 120 MainScreen.FormKeyDown(Sender, Key, Shift); 115 121 end; 116 122 117 123 procedure TBufferedDrawDlg.FormDeactivate(Sender: TObject); 118 124 begin 119 if FWindowMode=wmSubmodal then Close 125 if FWindowMode = wmSubmodal then 126 Close 120 127 end; 121 128 122 129 procedure TBufferedDrawDlg.OffscreenPaint; 123 130 begin 124 if (OffscreenUser<>nil) and (OffscreenUser<>self) then125 OffscreenUser.Update; // complete working with old owner to prevent rebound126 OffscreenUser:=self;131 if (OffscreenUser <> nil) and (OffscreenUser <> self) then 132 OffscreenUser.Update; // complete working with old owner to prevent rebound 133 OffscreenUser := self; 127 134 end; 128 135 129 136 procedure TBufferedDrawDlg.VPaint; 130 137 begin 131 BitBlt(Canvas.Handle, 0, 0, ClientWidth, 132 ClientHeight, offscreen.Canvas. Handle, 0, 0, SRCCOPY); 133 end; 134 135 procedure TBufferedDrawDlg.ShowNewContent(NewMode: integer; forceclose: boolean); 136 begin 137 if Visible then 138 begin 139 assert((NewMode=wmModal) or (FWindowMode<>wmModal)); // don't make modal window non-modal 140 if (NewMode=wmModal) and (forceclose or (FWindowMode<>wmModal)) then 138 BitBlt(Canvas.Handle, 0, 0, ClientWidth, ClientHeight, 139 Offscreen.Canvas.Handle, 0, 0, SRCCOPY); 140 end; 141 142 procedure TBufferedDrawDlg.ShowNewContent(NewMode: integer; 143 forceclose: boolean); 144 begin 145 if Visible then 146 begin 147 assert((NewMode = wmModal) or (FWindowMode <> wmModal)); 148 // don't make modal window non-modal 149 if (NewMode = wmModal) and (forceclose or (FWindowMode <> wmModal)) then 141 150 begin // make modal 142 UserLeft:=Left;143 UserTop:=Top;144 Visible:=false;145 FWindowMode:=NewMode;146 ShowModal;151 UserLeft := Left; 152 UserTop := Top; 153 Visible := false; 154 FWindowMode := NewMode; 155 ShowModal; 147 156 end 148 else if forceclose then157 else if forceclose then 149 158 begin // make modal 150 Visible:=false;151 FWindowMode:=NewMode;152 Left:=UserLeft;153 Top:=UserTop;154 Show;159 Visible := false; 160 FWindowMode := NewMode; 161 Left := UserLeft; 162 Top := UserTop; 163 Show; 155 164 end 156 else157 begin 158 FWindowMode:=NewMode;159 if @OnShow<>nil then160 OnShow(nil);161 Invalidate;162 BringToFront165 else 166 begin 167 FWindowMode := NewMode; 168 if @OnShow <> nil then 169 OnShow(nil); 170 Invalidate; 171 BringToFront 163 172 end 164 173 end 165 else 166 begin 167 FWindowMode:=NewMode; 168 Left:=UserLeft; 169 Top:=UserTop; 170 if FWindowMode=wmModal then ShowModal 171 else Show 174 else 175 begin 176 FWindowMode := NewMode; 177 Left := UserLeft; 178 Top := UserTop; 179 if FWindowMode = wmModal then 180 ShowModal 181 else 182 Show 172 183 end 173 184 end; … … 175 186 procedure TBufferedDrawDlg.SmartUpdateContent(ImmUpdate: boolean); 176 187 begin 177 if Visible then 178 begin 179 OffscreenPaint; 180 SmartInvalidate; 181 if ImmUpdate then Update 182 end 183 end; 184 185 procedure TBufferedDrawDlg.MarkUsedOffscreen(xMax,yMax: integer); 186 begin 187 if xMax>UsedOffscreenWidth then UsedOffscreenWidth:=xMax; 188 if yMax>UsedOffscreenHeight then UsedOffscreenHeight:=yMax; 188 if Visible then 189 begin 190 OffscreenPaint; 191 SmartInvalidate; 192 if ImmUpdate then 193 Update 194 end 195 end; 196 197 procedure TBufferedDrawDlg.MarkUsedOffscreen(xMax, yMax: integer); 198 begin 199 if xMax > UsedOffscreenWidth then 200 UsedOffscreenWidth := xMax; 201 if yMax > UsedOffscreenHeight then 202 UsedOffscreenHeight := yMax; 189 203 end; 190 204 … … 193 207 // after application lost focus, so show all stayontop-windows in first turn 194 208 var 195 SaveOnShow, SaveOnPaint: TNotifyEvent; 196 begin 197 Top:=Screen.Height; 198 SaveOnShow:=OnShow; 199 OnShow:=nil; 200 SaveOnPaint:=OnPaint; 201 OnPaint:=nil; 202 FWindowMode:=wmNone; 203 Show; 204 Hide; 205 OnShow:=SaveOnShow; 206 OnPaint:=SaveOnPaint; 207 end; 208 209 SaveOnShow, SaveOnPaint: TNotifyEvent; 210 begin 211 Top := Screen.Height; 212 SaveOnShow := OnShow; 213 OnShow := nil; 214 SaveOnPaint := OnPaint; 215 OnPaint := nil; 216 FWindowMode := wmNone; 217 Show; 218 Hide; 219 OnShow := SaveOnShow; 220 OnPaint := SaveOnPaint; 221 end; 209 222 210 223 constructor TFramedDlg.Create; 211 224 begin 212 OnCreate:=FormCreate; 213 inherited; 214 end; 215 216 procedure TFramedDlg.FormCreate(Sender:TObject); 217 begin 218 CaptionLeft:=0; CaptionRight:=$FFFF; 219 WideBottom:=false; 220 FullCaption:=true; 221 TexOverride:=false; 222 ModalIndication:=true; 223 Canvas.Brush.Style:=bsClear; 224 InnerWidth:=ClientWidth-2*SideFrame; 225 InnerHeight:=ClientHeight-TitleHeight-NarrowFrame; 225 OnCreate := FormCreate; 226 inherited; 227 end; 228 229 procedure TFramedDlg.FormCreate(Sender: TObject); 230 begin 231 CaptionLeft := 0; 232 CaptionRight := $FFFF; 233 WideBottom := false; 234 FullCaption := true; 235 TexOverride := false; 236 ModalIndication := true; 237 Canvas.Brush.Style := bsClear; 238 InnerWidth := ClientWidth - 2 * SideFrame; 239 InnerHeight := ClientHeight - TitleHeight - NarrowFrame; 226 240 end; 227 241 228 242 procedure TFramedDlg.SmartInvalidate; 229 243 var 230 i,BottomFrame: integer; 231 r0,r1: HRgn; 232 begin 233 if WideBottom then BottomFrame:=WideFrame else BottomFrame:=NarrowFrame; 234 r0:=CreateRectRgn(SideFrame,TitleHeight,ClientWidth-SideFrame, 235 ClientHeight-BottomFrame); 236 for i:=0 to ControlCount-1 do 237 if not (Controls[i] is TArea) and Controls[i].Visible then 238 begin 239 with Controls[i].BoundsRect do 240 r1:=CreateRectRgn(Left,Top,Right,Bottom); 241 CombineRgn(r0,r0,r1,RGN_DIFF); 242 DeleteObject(r1); 244 i, BottomFrame: integer; 245 r0, r1: HRgn; 246 begin 247 if WideBottom then 248 BottomFrame := WideFrame 249 else 250 BottomFrame := NarrowFrame; 251 r0 := CreateRectRgn(SideFrame, TitleHeight, ClientWidth - SideFrame, 252 ClientHeight - BottomFrame); 253 for i := 0 to ControlCount - 1 do 254 if not(Controls[i] is TArea) and Controls[i].Visible then 255 begin 256 with Controls[i].BoundsRect do 257 r1 := CreateRectRgn(Left, Top, Right, Bottom); 258 CombineRgn(r0, r0, r1, RGN_DIFF); 259 DeleteObject(r1); 243 260 end; 244 InvalidateRgn(Handle,r0,false);245 DeleteObject(r0);261 InvalidateRgn(Handle, r0, false); 262 DeleteObject(r0); 246 263 end; 247 264 248 265 procedure TFramedDlg.VPaint; 249 266 250 procedure CornerFrame(x0,y0,x1,y1: integer); 251 begin 252 Frame(Canvas,x0+1,y0+1,x1-2,y1-2,MainTexture.clBevelLight,MainTexture.clBevelShade); 253 Frame(Canvas,x0+2,y0+2,x1-3,y1-3,MainTexture.clBevelLight,MainTexture.clBevelShade); 254 Corner(Canvas,x0+1,y0+1,0,MainTexture); 255 Corner(Canvas,x1-9,y0+1,1,MainTexture); 256 Corner(Canvas,x0+1,y1-9,2,MainTexture); 257 Corner(Canvas,x1-9,y1-9,3,MainTexture); 267 procedure CornerFrame(x0, y0, x1, y1: integer); 268 begin 269 Frame(Canvas, x0 + 1, y0 + 1, x1 - 2, y1 - 2, MainTexture.clBevelLight, 270 MainTexture.clBevelShade); 271 Frame(Canvas, x0 + 2, y0 + 2, x1 - 3, y1 - 3, MainTexture.clBevelLight, 272 MainTexture.clBevelShade); 273 Corner(Canvas, x0 + 1, y0 + 1, 0, MainTexture); 274 Corner(Canvas, x1 - 9, y0 + 1, 1, MainTexture); 275 Corner(Canvas, x0 + 1, y1 - 9, 2, MainTexture); 276 Corner(Canvas, x1 - 9, y1 - 9, 3, MainTexture); 258 277 end; 259 278 260 279 var 261 i,l,FrameTop,FrameBottom,InnerBottom,Cut,xTexOffset,yTexOffset: integer; 262 R: TRect; 263 begin 264 if not TexOverride then 265 begin 266 if (FWindowMode=wmModal) and ModalIndication then MainTexture:=MainTexture 267 else MainTexture:=MainTexture; 268 MainTexture:=MainTexture 269 end; 270 Canvas.Font.Assign(UniFont[ftCaption]); 271 l:=BiColorTextWidth(Canvas,Caption); 272 Cut:=(ClientWidth-l) div 2; 273 xTexOffset:=(wMaintexture-ClientWidth) div 2; 274 yTexOffset:=(hMaintexture-ClientHeight) div 2; 275 if WideBottom then InnerBottom:=ClientHeight-WideFrame 276 else InnerBottom:=ClientHeight-NarrowFrame; 277 if FullCaption then begin FrameTop:=0; FrameBottom:=ClientHeight end 278 else 279 begin 280 FrameTop:=TitleHeight-NarrowFrame; 281 if WideBottom then FrameBottom:=ClientHeight-(WideFrame-NarrowFrame) 282 else FrameBottom:=ClientHeight 283 end; 284 Fill(Canvas,3,InnerBottom+1,ClientWidth-6,ClientHeight-InnerBottom-4, 285 xTexOffset,yTexOffset); 286 Fill(Canvas,3,TitleHeight-2,SideFrame-3,InnerBottom-TitleHeight+4, 287 xTexOffset,yTexOffset); 288 Fill(Canvas,ClientWidth-SideFrame,TitleHeight-2,SideFrame-3, 289 InnerBottom-TitleHeight+4,xTexOffset,yTexOffset); 290 Frame(Canvas,0,FrameTop,ClientWidth-1,FrameBottom-1,0,0); 291 Frame(Canvas,SideFrame-1,TitleHeight-1,ClientWidth-SideFrame, 292 InnerBottom,MainTexture.clBevelShade,MainTexture.clBevelLight); 293 //RFrame(Canvas,SideFrame-2,TitleHeight-2,ClientWidth-SideFrame+1, 294 // InnerBottom+1,MainTexture.clBevelShade,MainTexture.clBevelLight); 295 if FullCaption then 296 begin 297 if (FWindowMode<>wmModal) or not ModalIndication then 298 begin 299 Fill(Canvas,3,3+FrameTop,ClientWidth-6,TitleHeight-FrameTop-4, 300 xTexOffset,yTexOffset); 301 CornerFrame(0,FrameTop,ClientWidth,FrameBottom); 280 i, l, FrameTop, FrameBottom, InnerBottom, Cut, xTexOffset, 281 yTexOffset: integer; 282 R: TRect; 283 begin 284 if not TexOverride then 285 begin 286 if (FWindowMode = wmModal) and ModalIndication then 287 MainTexture := MainTexture 288 else 289 MainTexture := MainTexture; 290 MainTexture := MainTexture 291 end; 292 Canvas.Font.Assign(UniFont[ftCaption]); 293 l := BiColorTextWidth(Canvas, Caption); 294 Cut := (ClientWidth - l) div 2; 295 xTexOffset := (wMaintexture - ClientWidth) div 2; 296 yTexOffset := (hMaintexture - ClientHeight) div 2; 297 if WideBottom then 298 InnerBottom := ClientHeight - WideFrame 299 else 300 InnerBottom := ClientHeight - NarrowFrame; 301 if FullCaption then 302 begin 303 FrameTop := 0; 304 FrameBottom := ClientHeight 305 end 306 else 307 begin 308 FrameTop := TitleHeight - NarrowFrame; 309 if WideBottom then 310 FrameBottom := ClientHeight - (WideFrame - NarrowFrame) 311 else 312 FrameBottom := ClientHeight 313 end; 314 Fill(Canvas, 3, InnerBottom + 1, ClientWidth - 6, ClientHeight - InnerBottom - 315 4, xTexOffset, yTexOffset); 316 Fill(Canvas, 3, TitleHeight - 2, SideFrame - 3, InnerBottom - TitleHeight + 4, 317 xTexOffset, yTexOffset); 318 Fill(Canvas, ClientWidth - SideFrame, TitleHeight - 2, SideFrame - 3, 319 InnerBottom - TitleHeight + 4, xTexOffset, yTexOffset); 320 Frame(Canvas, 0, FrameTop, ClientWidth - 1, FrameBottom - 1, 0, 0); 321 Frame(Canvas, SideFrame - 1, TitleHeight - 1, ClientWidth - SideFrame, 322 InnerBottom, MainTexture.clBevelShade, MainTexture.clBevelLight); 323 // RFrame(Canvas,SideFrame-2,TitleHeight-2,ClientWidth-SideFrame+1, 324 // InnerBottom+1,MainTexture.clBevelShade,MainTexture.clBevelLight); 325 if FullCaption then 326 begin 327 if (FWindowMode <> wmModal) or not ModalIndication then 328 begin 329 Fill(Canvas, 3, 3 + FrameTop, ClientWidth - 6, TitleHeight - FrameTop - 4, 330 xTexOffset, yTexOffset); 331 CornerFrame(0, FrameTop, ClientWidth, FrameBottom); 302 332 end 303 else with Canvas do 304 begin 305 Fill(Canvas,3+ModalFrameIndent,3+FrameTop,ClientWidth-6-2*ModalFrameIndent, 306 TitleHeight-FrameTop-4,xTexOffset,yTexOffset); 307 Fill(Canvas,ClientWidth-3-ModalFrameIndent,3+FrameTop,ModalFrameIndent, 308 TitleHeight-FrameTop-4,xTexOffset,yTexOffset); 309 Fill(Canvas,3,3+FrameTop,ModalFrameIndent,TitleHeight-FrameTop-4, 310 xTexOffset,yTexOffset); 311 CornerFrame(0,FrameTop,ClientWidth,FrameBottom); 312 Pen.Color:=MainTexture.clBevelShade; 313 MoveTo(3+ModalFrameIndent,2); LineTo(3+ModalFrameIndent,TitleHeight); 314 Pen.Color:=MainTexture.clBevelShade; 315 MoveTo(4+ModalFrameIndent,TitleHeight-1); 316 LineTo(ClientWidth-4-ModalFrameIndent,TitleHeight-1); 317 LineTo(ClientWidth-4-ModalFrameIndent,1); 318 Pen.Color:=MainTexture.clBevelLight; 319 MoveTo(ClientWidth-5-ModalFrameIndent,2); 320 LineTo(4+ModalFrameIndent,2); 321 LineTo(4+ModalFrameIndent,TitleHeight); 322 MoveTo(ClientWidth-4-ModalFrameIndent,1); 323 LineTo(3+ModalFrameIndent,1); 324 Pen.Color:=MainTexture.clBevelLight; 325 MoveTo(ClientWidth-3-ModalFrameIndent,3); LineTo(ClientWidth-3-ModalFrameIndent,TitleHeight); 326 end 327 end 328 else 329 begin 330 Fill(Canvas,3,3+FrameTop,ClientWidth-6,TitleHeight-FrameTop-4, 331 xTexOffset,yTexOffset); 332 CornerFrame(0,FrameTop,ClientWidth,FrameBottom); 333 334 Frame(Canvas,CaptionLeft,0,ClientWidth-CaptionLeft-1,FrameTop,0,0); 335 Fill(Canvas,CaptionLeft+3,3,ClientWidth-2*(CaptionLeft)-6,TitleHeight-4, 336 xTexOffset,yTexOffset); 337 338 Frame(Canvas,CaptionLeft+1,0+1, 339 ClientWidth-CaptionLeft-2,TitleHeight-1,MainTexture.clBevelLight,MainTexture.clBevelShade); 340 Frame(Canvas,CaptionLeft+2,0+2, 341 ClientWidth-CaptionLeft-3,TitleHeight-1,MainTexture.clBevelLight,MainTexture.clBevelShade); 342 Corner(Canvas,CaptionLeft+1,0+1,0,MainTexture); 343 Corner(Canvas,ClientWidth-CaptionLeft-9,0+1,1,MainTexture); 344 345 with Canvas do 346 begin 347 Pen.Color:=MainTexture.clBevelShade; 348 MoveTo(CaptionLeft+1,FrameTop+2); 349 LineTo(CaptionLeft+1,TitleHeight); 350 Pen.Color:=MainTexture.clBevelLight; 351 MoveTo(ClientWidth-CaptionLeft-2,FrameTop+2); 352 LineTo(ClientWidth-CaptionLeft-2,TitleHeight); 333 else 334 with Canvas do 335 begin 336 Fill(Canvas, 3 + ModalFrameIndent, 3 + FrameTop, 337 ClientWidth - 6 - 2 * ModalFrameIndent, TitleHeight - FrameTop - 4, 338 xTexOffset, yTexOffset); 339 Fill(Canvas, ClientWidth - 3 - ModalFrameIndent, 3 + FrameTop, 340 ModalFrameIndent, TitleHeight - FrameTop - 4, xTexOffset, yTexOffset); 341 Fill(Canvas, 3, 3 + FrameTop, ModalFrameIndent, TitleHeight - FrameTop - 342 4, xTexOffset, yTexOffset); 343 CornerFrame(0, FrameTop, ClientWidth, FrameBottom); 344 Pen.Color := MainTexture.clBevelShade; 345 MoveTo(3 + ModalFrameIndent, 2); 346 LineTo(3 + ModalFrameIndent, TitleHeight); 347 Pen.Color := MainTexture.clBevelShade; 348 MoveTo(4 + ModalFrameIndent, TitleHeight - 1); 349 LineTo(ClientWidth - 4 - ModalFrameIndent, TitleHeight - 1); 350 LineTo(ClientWidth - 4 - ModalFrameIndent, 1); 351 Pen.Color := MainTexture.clBevelLight; 352 MoveTo(ClientWidth - 5 - ModalFrameIndent, 2); 353 LineTo(4 + ModalFrameIndent, 2); 354 LineTo(4 + ModalFrameIndent, TitleHeight); 355 MoveTo(ClientWidth - 4 - ModalFrameIndent, 1); 356 LineTo(3 + ModalFrameIndent, 1); 357 Pen.Color := MainTexture.clBevelLight; 358 MoveTo(ClientWidth - 3 - ModalFrameIndent, 3); 359 LineTo(ClientWidth - 3 - ModalFrameIndent, TitleHeight); 360 end 361 end 362 else 363 begin 364 Fill(Canvas, 3, 3 + FrameTop, ClientWidth - 6, TitleHeight - FrameTop - 4, 365 xTexOffset, yTexOffset); 366 CornerFrame(0, FrameTop, ClientWidth, FrameBottom); 367 368 Frame(Canvas, CaptionLeft, 0, ClientWidth - CaptionLeft - 1, 369 FrameTop, 0, 0); 370 Fill(Canvas, CaptionLeft + 3, 3, ClientWidth - 2 * (CaptionLeft) - 6, 371 TitleHeight - 4, xTexOffset, yTexOffset); 372 373 Frame(Canvas, CaptionLeft + 1, 0 + 1, ClientWidth - CaptionLeft - 2, 374 TitleHeight - 1, MainTexture.clBevelLight, MainTexture.clBevelShade); 375 Frame(Canvas, CaptionLeft + 2, 0 + 2, ClientWidth - CaptionLeft - 3, 376 TitleHeight - 1, MainTexture.clBevelLight, MainTexture.clBevelShade); 377 Corner(Canvas, CaptionLeft + 1, 0 + 1, 0, MainTexture); 378 Corner(Canvas, ClientWidth - CaptionLeft - 9, 0 + 1, 1, MainTexture); 379 380 with Canvas do 381 begin 382 Pen.Color := MainTexture.clBevelShade; 383 MoveTo(CaptionLeft + 1, FrameTop + 2); 384 LineTo(CaptionLeft + 1, TitleHeight); 385 Pen.Color := MainTexture.clBevelLight; 386 MoveTo(ClientWidth - CaptionLeft - 2, FrameTop + 2); 387 LineTo(ClientWidth - CaptionLeft - 2, TitleHeight); 353 388 end; 354 if WideBottom then 355 begin 356 Frame(Canvas,CaptionLeft,FrameBottom,ClientWidth-CaptionLeft-1,ClientHeight-1,0,0); 357 Fill(Canvas,CaptionLeft+3,ClientHeight-3-(WideFrame-5), 358 ClientWidth-2*(CaptionLeft)-6,WideFrame-5,xTexOffset,yTexOffset); 359 Frame(Canvas,CaptionLeft+1,ClientHeight-WideFrame-1+1, 360 ClientWidth-CaptionLeft-2,ClientHeight-2,MainTexture.clBevelLight,MainTexture.clBevelShade); 361 Frame(Canvas,CaptionLeft+2,ClientHeight-WideFrame-1+1, 362 ClientWidth-CaptionLeft-3,ClientHeight-3,MainTexture.clBevelLight,MainTexture.clBevelShade); 363 Corner(Canvas,CaptionLeft+1,ClientHeight-9,2,MainTexture); 364 Corner(Canvas,ClientWidth-CaptionLeft-9,ClientHeight-9,3,MainTexture); 365 366 with Canvas do 389 if WideBottom then 390 begin 391 Frame(Canvas, CaptionLeft, FrameBottom, ClientWidth - CaptionLeft - 1, 392 ClientHeight - 1, 0, 0); 393 Fill(Canvas, CaptionLeft + 3, ClientHeight - 3 - (WideFrame - 5), 394 ClientWidth - 2 * (CaptionLeft) - 6, WideFrame - 5, xTexOffset, 395 yTexOffset); 396 Frame(Canvas, CaptionLeft + 1, ClientHeight - WideFrame - 1 + 1, 397 ClientWidth - CaptionLeft - 2, ClientHeight - 2, 398 MainTexture.clBevelLight, MainTexture.clBevelShade); 399 Frame(Canvas, CaptionLeft + 2, ClientHeight - WideFrame - 1 + 1, 400 ClientWidth - CaptionLeft - 3, ClientHeight - 3, 401 MainTexture.clBevelLight, MainTexture.clBevelShade); 402 Corner(Canvas, CaptionLeft + 1, ClientHeight - 9, 2, MainTexture); 403 Corner(Canvas, ClientWidth - CaptionLeft - 9, ClientHeight - 9, 3, 404 MainTexture); 405 406 with Canvas do 367 407 begin 368 Pen.Color:=MainTexture.clBevelShade;369 MoveTo(CaptionLeft+1,ClientHeight-WideFrame);370 LineTo(CaptionLeft+1,FrameBottom-2);371 Pen.Color:=MainTexture.clBevelLight;372 MoveTo(ClientWidth-CaptionLeft-2,ClientHeight-WideFrame);373 LineTo(ClientWidth-CaptionLeft-2,FrameBottom-2);408 Pen.Color := MainTexture.clBevelShade; 409 MoveTo(CaptionLeft + 1, ClientHeight - WideFrame); 410 LineTo(CaptionLeft + 1, FrameBottom - 2); 411 Pen.Color := MainTexture.clBevelLight; 412 MoveTo(ClientWidth - CaptionLeft - 2, ClientHeight - WideFrame); 413 LineTo(ClientWidth - CaptionLeft - 2, FrameBottom - 2); 374 414 end; 375 415 end 376 416 end; 377 RisedTextOut(Canvas,Cut-1,7,Caption);378 379 for i:=0 to ControlCount-1 do380 if Controls[i].Visible and (Controls[i] is TButtonBase) then381 begin 382 R:=Controls[i].BoundsRect;383 if (R.Bottom<=TitleHeight) or (R.Top>=InnerBottom) then384 BtnFrame(Canvas,R,MainTexture);417 RisedTextOut(Canvas, Cut - 1, 7, Caption); 418 419 for i := 0 to ControlCount - 1 do 420 if Controls[i].Visible and (Controls[i] is TButtonBase) then 421 begin 422 R := Controls[i].BoundsRect; 423 if (R.Bottom <= TitleHeight) or (R.Top >= InnerBottom) then 424 BtnFrame(Canvas, R, MainTexture); 385 425 end; 386 426 387 BitBlt(Canvas.Handle,SideFrame,TitleHeight,ClientWidth-2*SideFrame,388 InnerBottom-TitleHeight,offscreen.Canvas.Handle,0,0,SRCCOPY);427 BitBlt(Canvas.Handle, SideFrame, TitleHeight, ClientWidth - 2 * SideFrame, 428 InnerBottom - TitleHeight, Offscreen.Canvas.Handle, 0, 0, SRCCOPY); 389 429 end; 390 430 391 431 procedure TFramedDlg.InitWindowRegion; 392 432 var 393 r0,r1: HRgn; 394 begin 395 if FullCaption then exit; 396 r0:=CreateRectRgn(0,0,ClientWidth,ClientHeight); 397 r1:=CreateRectRgn(0,0,CaptionLeft,TitleHeight-NarrowFrame); 398 CombineRgn(r0,r0,r1,RGN_DIFF); 399 //DeleteObject(r1); 400 r1:=CreateRectRgn(ClientWidth-CaptionLeft,0,ClientWidth,TitleHeight-NarrowFrame); 401 CombineRgn(r0,r0,r1,RGN_DIFF); 402 //DeleteObject(r1); 403 if WideBottom then 404 begin 405 r1:=CreateRectRgn(0,ClientHeight-(WideFrame-NarrowFrame),CaptionLeft, 406 ClientHeight); 407 CombineRgn(r0,r0,r1,RGN_DIFF); 408 //DeleteObject(r1); 409 r1:=CreateRectRgn(ClientWidth-CaptionLeft, 410 ClientHeight-(WideFrame-NarrowFrame),ClientWidth,ClientHeight); 411 CombineRgn(r0,r0,r1,RGN_DIFF); 412 //DeleteObject(r1); 413 end; 414 SetWindowRgn(Handle,r0,false); 415 //DeleteObject(r0); // causes crash with Windows 95 416 end; 417 418 procedure TFramedDlg.FillOffscreen(Left,Top,Width,Height: integer); 419 begin 420 Fill(Offscreen.Canvas,Left,Top,Width,Height,SideFrame+(wMaintexture-ClientWidth) div 2, 421 TitleHeight+(hMaintexture-ClientHeight) div 2); 422 end; 423 433 r0, r1: HRgn; 434 begin 435 if FullCaption then 436 exit; 437 r0 := CreateRectRgn(0, 0, ClientWidth, ClientHeight); 438 r1 := CreateRectRgn(0, 0, CaptionLeft, TitleHeight - NarrowFrame); 439 CombineRgn(r0, r0, r1, RGN_DIFF); 440 // DeleteObject(r1); 441 r1 := CreateRectRgn(ClientWidth - CaptionLeft, 0, ClientWidth, 442 TitleHeight - NarrowFrame); 443 CombineRgn(r0, r0, r1, RGN_DIFF); 444 // DeleteObject(r1); 445 if WideBottom then 446 begin 447 r1 := CreateRectRgn(0, ClientHeight - (WideFrame - NarrowFrame), 448 CaptionLeft, ClientHeight); 449 CombineRgn(r0, r0, r1, RGN_DIFF); 450 // DeleteObject(r1); 451 r1 := CreateRectRgn(ClientWidth - CaptionLeft, 452 ClientHeight - (WideFrame - NarrowFrame), ClientWidth, ClientHeight); 453 CombineRgn(r0, r0, r1, RGN_DIFF); 454 // DeleteObject(r1); 455 end; 456 SetWindowRgn(Handle, r0, false); 457 // DeleteObject(r0); // causes crash with Windows 95 458 end; 459 460 procedure TFramedDlg.FillOffscreen(Left, Top, Width, Height: integer); 461 begin 462 Fill(Offscreen.Canvas, Left, Top, Width, Height, 463 SideFrame + (wMaintexture - ClientWidth) div 2, 464 TitleHeight + (hMaintexture - ClientHeight) div 2); 465 end; 424 466 425 467 procedure CreateOffscreen; 426 468 begin 427 if OffScreen<>nil then exit; 428 offscreen:=TBitmap.Create; 429 Offscreen.PixelFormat:=pf24bit; 430 offscreen.Width:=Screen.Width; 431 if Screen.Height-yUnused<480 then offscreen.Height:=480 432 else offscreen.Height:=Screen.Height-yUnused; 433 offscreen.Canvas.Brush.Style:=bsClear; 434 end; 435 469 if Offscreen <> nil then 470 exit; 471 Offscreen := TBitmap.Create; 472 Offscreen.PixelFormat := pf24bit; 473 Offscreen.Width := Screen.Width; 474 if Screen.Height - yUnused < 480 then 475 Offscreen.Height := 480 476 else 477 Offscreen.Height := Screen.Height - yUnused; 478 Offscreen.Canvas.Brush.Style := bsClear; 479 end; 436 480 437 481 initialization 438 offscreen:=nil; 439 OffscreenUser:=nil; 482 483 Offscreen := nil; 484 OffscreenUser := nil; 440 485 441 486 finalization 442 offscreen.Free; 487 488 Offscreen.Free; 443 489 444 490 end. 445 -
trunk/LocalPlayer/Battle.pas
r2 r6 5 5 6 6 uses 7 ScreenTools, Protocol,Messg,ButtonBase, ButtonA,7 ScreenTools, Protocol, Messg, ButtonBase, ButtonA, 8 8 9 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms; … … 17 17 Shift: TShiftState; X, Y: Integer); 18 18 procedure FormDeactivate(Sender: TObject); 19 procedure FormKeyDown(Sender: TObject; var Key: Word; 20 Shift: TShiftState); 19 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 21 20 procedure FormCreate(Sender: TObject); 22 21 procedure FormShow(Sender: TObject); … … 24 23 procedure CancelBtnClick(Sender: TObject); 25 24 public 26 uix, ToLoc: integer;25 uix, ToLoc: Integer; 27 26 Forecast: TBattleForecastEx; 28 27 IsSuicideQuery: boolean; … … 32 31 BattleDlg: TBattleDlg; 33 32 34 procedure PaintBattleOutcome(ca: TCanvas; xm, ym,uix,ToLoc: integer;33 procedure PaintBattleOutcome(ca: TCanvas; xm, ym, uix, ToLoc: Integer; 35 34 Forecast: TBattleForecastEx); 36 35 37 38 36 implementation 39 37 40 38 uses 41 Term,ClientTools,IsoEngine;39 Term, ClientTools, IsoEngine; 42 40 43 41 {$R *.DFM} 44 42 45 43 const 46 Border=3; 47 MessageLineSpacing=20; 48 49 DamageColor=$0000E0; 50 FanaticColor=$800080; 51 FirstStrikeColor=$A0A0A0; 52 53 54 procedure PaintBattleOutcome(ca: TCanvas; xm,ym,uix,ToLoc: integer; 44 Border = 3; 45 MessageLineSpacing = 20; 46 47 DamageColor = $0000E0; 48 FanaticColor = $800080; 49 FirstStrikeColor = $A0A0A0; 50 51 procedure PaintBattleOutcome(ca: TCanvas; xm, ym, uix, ToLoc: Integer; 55 52 Forecast: TBattleForecastEx); 56 53 var 57 euix,ADamage,DDamage,StrMax,DamageMax,MaxBar,LAStr,LDStr, 58 LADamage,LDDamage,LABaseDamage,LAAvoidedDamage,LDBaseDamage: integer; 59 //TerrType: Cardinal; 60 UnitInfo: TUnitInfo; 61 TextSize: TSize; 62 LabelText: string; 63 FirstStrike: boolean; 64 begin 65 MaxBar:=65; 66 67 //TerrType:=MyMap[ToLoc] and fTerrain; 68 GetUnitInfo(ToLoc,euix,UnitInfo); 69 70 FirstStrike:=(MyModel[MyUn[uix].mix].Cap[mcFirst]>0) 71 and (Forecast.DBaseDamage>=UnitInfo.Health); 72 ADamage:=MyUn[uix].Health-Forecast.EndHealthAtt; 73 if FirstStrike then 74 ADamage:=ADamage+Forecast.ABaseDamage div 2; 75 DDamage:=UnitInfo.Health-Forecast.EndHealthDef; 76 if Forecast.AStr>Forecast.DStr then 77 StrMax:=Forecast.AStr 78 else StrMax:=Forecast.DStr; 79 if ADamage>DDamage then 80 DamageMax:=ADamage 81 else DamageMax:=DDamage; 82 if Forecast.ABaseDamage>Forecast.DBaseDamage then 83 StrMax:=StrMax*DamageMax div Forecast.ABaseDamage 84 else StrMax:=StrMax*DamageMax div Forecast.DBaseDamage; 85 86 LAStr:=Forecast.AStr*MaxBar div StrMax; 87 LDStr:=Forecast.DStr*MaxBar div StrMax; 88 LADamage:=ADamage*MaxBar div DamageMax; 89 LABaseDamage:=Forecast.ABaseDamage*MaxBar div DamageMax; 90 if FirstStrike then 91 LAAvoidedDamage:=LABaseDamage div 2 92 else LAAvoidedDamage:=0; 93 LDDamage:=DDamage*MaxBar div DamageMax; 94 LDBaseDamage:=Forecast.DBaseDamage*MaxBar div DamageMax; 95 96 DarkGradient(ca,xm-8-LAStr,ym-8,LAStr,2); 97 VDarkGradient(ca,xm-8,ym-8-LDStr,LDStr,2); 98 LightGradient(ca,xm+8,ym-8,LDBaseDamage,DamageColor); 99 if LDDamage>LDBaseDamage then 100 LightGradient(ca,xm+8+LDBaseDamage,ym-8,LDDamage-LDBaseDamage,FanaticColor); 101 if LAAvoidedDamage>0 then 102 VLightGradient(ca,xm-8,ym+8,LAAvoidedDamage,FirstStrikeColor); 103 VLightGradient(ca,xm-8,ym+8+LAAvoidedDamage,LABaseDamage-LAAvoidedDamage, 104 DamageColor); 105 if LADamage>LABaseDamage then 106 VLightGradient(ca,xm-8,ym+8+LABaseDamage,LADamage-LABaseDamage,FanaticColor); 107 BitBlt(ca.Handle,xm-12,ym-12,24,24, 108 GrExt[HGrSystem].Mask.Canvas.Handle,26,146,SRCAND); 109 BitBlt(ca.Handle,xm-12,ym-12,24,24, 110 GrExt[HGrSystem].Data.Canvas.Handle,26,146,SRCPAINT); 111 112 LabelText:=Format('%d', [Forecast.AStr]); 113 TextSize:=ca.TextExtent(LabelText); 114 if TextSize.cx div 2+2>LAStr div 2 then 115 RisedTextOut(ca,xm-10-TextSize.cx,ym-(TextSize.cy+1) div 2, LabelText) 116 else RisedTextOut(ca,xm-8-(LAStr+TextSize.cx) div 2,ym-(TextSize.cy+1) div 2, LabelText); 117 118 LabelText:=Format('%d', [Forecast.DStr]); 119 TextSize:=ca.TextExtent(LabelText); 120 if TextSize.cy div 2>LDStr div 2 then 121 RisedTextOut(ca,xm-(TextSize.cx+1) div 2, ym-8-TextSize.cy,LabelText) 122 else RisedTextOut(ca,xm-(TextSize.cx+1) div 2, ym-8-(LDStr+TextSize.cy) div 2,LabelText); 123 124 if Forecast.EndHealthDef<=0 then 125 begin 126 BitBlt(ca.Handle,xm+9+LDDamage-7,ym-6,14,17, 127 GrExt[HGrSystem].Mask.Canvas.Handle,51,153,SRCAND); 128 BitBlt(ca.Handle,xm+8+LDDamage-7,ym-7,14,17, 129 GrExt[HGrSystem].Mask.Canvas.Handle,51,153,SRCAND); 130 BitBlt(ca.Handle,xm+8+LDDamage-7,ym-7,14,17, 131 GrExt[HGrSystem].Data.Canvas.Handle,51,153,SRCPAINT); 132 end; 133 LabelText:=Format('%d', [DDamage]); 134 TextSize:=ca.TextExtent(LabelText); 135 if TextSize.cx div 2+2>LDDamage div 2 then 136 begin 137 if Forecast.EndHealthDef>0 then 138 RisedTextOut(ca,xm+10,ym-(TextSize.cy+1) div 2, LabelText) 139 end 140 else RisedTextOut(ca,xm+8+(LDDamage-TextSize.cx) div 2,ym-(TextSize.cy+1) div 2, LabelText); 141 142 if Forecast.EndHealthAtt<=0 then 143 begin 144 BitBlt(ca.Handle,xm-6,ym+9+LADamage-7,14,17, 145 GrExt[HGrSystem].Mask.Canvas.Handle,51,153,SRCAND); 146 BitBlt(ca.Handle,xm-7,ym+8+LADamage-7,14,17, 147 GrExt[HGrSystem].Mask.Canvas.Handle,51,153,SRCAND); 148 BitBlt(ca.Handle,xm-7,ym+8+LADamage-7,14,17, 149 GrExt[HGrSystem].Data.Canvas.Handle,51,153,SRCPAINT); 150 end; 151 LabelText:=Format('%d', [MyUn[uix].Health-Forecast.EndHealthAtt]); 152 TextSize:=ca.TextExtent(LabelText); 153 if TextSize.cy div 2>(LADamage-LAAvoidedDamage) div 2+LAAvoidedDamage then 154 begin 155 if Forecast.EndHealthAtt>0 then 156 RisedTextOut(ca,xm-(TextSize.cx+1) div 2, ym+8+LAAvoidedDamage,LabelText) 157 end 158 else RisedTextOut(ca,xm-(TextSize.cx+1) div 2, ym+8+LAAvoidedDamage+(LADamage-LAAvoidedDamage-TextSize.cy) div 2,LabelText); 159 160 NoMap.SetOutput(Buffer); 161 BitBlt(Buffer.Canvas.Handle,0,0,66,48,ca.Handle,xm+8+4,ym-8-12-48,SRCCOPY); 162 {if TerrType<fForest then 163 Sprite(Buffer,HGrTerrain,0,16,66,32,1+TerrType*(xxt*2+1),1+yyt) 164 else 165 begin 166 Sprite(Buffer,HGrTerrain,0,16,66,32,1+2*(xxt*2+1),1+yyt+2*(yyt*3+1)); 167 if (TerrType=fForest) and IsJungle(ToLoc div G.lx) then 54 euix, ADamage, DDamage, StrMax, DamageMax, MaxBar, LAStr, LDStr, LADamage, 55 LDDamage, LABaseDamage, LAAvoidedDamage, LDBaseDamage: Integer; 56 // TerrType: Cardinal; 57 UnitInfo: TUnitInfo; 58 TextSize: TSize; 59 LabelText: string; 60 FirstStrike: boolean; 61 begin 62 MaxBar := 65; 63 64 // TerrType:=MyMap[ToLoc] and fTerrain; 65 GetUnitInfo(ToLoc, euix, UnitInfo); 66 67 FirstStrike := (MyModel[MyUn[uix].mix].Cap[mcFirst] > 0) and 68 (Forecast.DBaseDamage >= UnitInfo.Health); 69 ADamage := MyUn[uix].Health - Forecast.EndHealthAtt; 70 if FirstStrike then 71 ADamage := ADamage + Forecast.ABaseDamage div 2; 72 DDamage := UnitInfo.Health - Forecast.EndHealthDef; 73 if Forecast.AStr > Forecast.DStr then 74 StrMax := Forecast.AStr 75 else 76 StrMax := Forecast.DStr; 77 if ADamage > DDamage then 78 DamageMax := ADamage 79 else 80 DamageMax := DDamage; 81 if Forecast.ABaseDamage > Forecast.DBaseDamage then 82 StrMax := StrMax * DamageMax div Forecast.ABaseDamage 83 else 84 StrMax := StrMax * DamageMax div Forecast.DBaseDamage; 85 86 LAStr := Forecast.AStr * MaxBar div StrMax; 87 LDStr := Forecast.DStr * MaxBar div StrMax; 88 LADamage := ADamage * MaxBar div DamageMax; 89 LABaseDamage := Forecast.ABaseDamage * MaxBar div DamageMax; 90 if FirstStrike then 91 LAAvoidedDamage := LABaseDamage div 2 92 else 93 LAAvoidedDamage := 0; 94 LDDamage := DDamage * MaxBar div DamageMax; 95 LDBaseDamage := Forecast.DBaseDamage * MaxBar div DamageMax; 96 97 DarkGradient(ca, xm - 8 - LAStr, ym - 8, LAStr, 2); 98 VDarkGradient(ca, xm - 8, ym - 8 - LDStr, LDStr, 2); 99 LightGradient(ca, xm + 8, ym - 8, LDBaseDamage, DamageColor); 100 if LDDamage > LDBaseDamage then 101 LightGradient(ca, xm + 8 + LDBaseDamage, ym - 8, LDDamage - LDBaseDamage, 102 FanaticColor); 103 if LAAvoidedDamage > 0 then 104 VLightGradient(ca, xm - 8, ym + 8, LAAvoidedDamage, FirstStrikeColor); 105 VLightGradient(ca, xm - 8, ym + 8 + LAAvoidedDamage, 106 LABaseDamage - LAAvoidedDamage, DamageColor); 107 if LADamage > LABaseDamage then 108 VLightGradient(ca, xm - 8, ym + 8 + LABaseDamage, LADamage - LABaseDamage, 109 FanaticColor); 110 BitBlt(ca.Handle, xm - 12, ym - 12, 24, 24, 111 GrExt[HGrSystem].Mask.Canvas.Handle, 26, 146, SRCAND); 112 BitBlt(ca.Handle, xm - 12, ym - 12, 24, 24, 113 GrExt[HGrSystem].Data.Canvas.Handle, 26, 146, SRCPAINT); 114 115 LabelText := Format('%d', [Forecast.AStr]); 116 TextSize := ca.TextExtent(LabelText); 117 if TextSize.cx div 2 + 2 > LAStr div 2 then 118 RisedTextOut(ca, xm - 10 - TextSize.cx, ym - (TextSize.cy + 1) div 2, 119 LabelText) 120 else 121 RisedTextOut(ca, xm - 8 - (LAStr + TextSize.cx) div 2, 122 ym - (TextSize.cy + 1) div 2, LabelText); 123 124 LabelText := Format('%d', [Forecast.DStr]); 125 TextSize := ca.TextExtent(LabelText); 126 if TextSize.cy div 2 > LDStr div 2 then 127 RisedTextOut(ca, xm - (TextSize.cx + 1) div 2, ym - 8 - TextSize.cy, 128 LabelText) 129 else 130 RisedTextOut(ca, xm - (TextSize.cx + 1) div 2, 131 ym - 8 - (LDStr + TextSize.cy) div 2, LabelText); 132 133 if Forecast.EndHealthDef <= 0 then 134 begin 135 BitBlt(ca.Handle, xm + 9 + LDDamage - 7, ym - 6, 14, 17, 136 GrExt[HGrSystem].Mask.Canvas.Handle, 51, 153, SRCAND); 137 BitBlt(ca.Handle, xm + 8 + LDDamage - 7, ym - 7, 14, 17, 138 GrExt[HGrSystem].Mask.Canvas.Handle, 51, 153, SRCAND); 139 BitBlt(ca.Handle, xm + 8 + LDDamage - 7, ym - 7, 14, 17, 140 GrExt[HGrSystem].Data.Canvas.Handle, 51, 153, SRCPAINT); 141 end; 142 LabelText := Format('%d', [DDamage]); 143 TextSize := ca.TextExtent(LabelText); 144 if TextSize.cx div 2 + 2 > LDDamage div 2 then 145 begin 146 if Forecast.EndHealthDef > 0 then 147 RisedTextOut(ca, xm + 10, ym - (TextSize.cy + 1) div 2, LabelText) 148 end 149 else 150 RisedTextOut(ca, xm + 8 + (LDDamage - TextSize.cx) div 2, 151 ym - (TextSize.cy + 1) div 2, LabelText); 152 153 if Forecast.EndHealthAtt <= 0 then 154 begin 155 BitBlt(ca.Handle, xm - 6, ym + 9 + LADamage - 7, 14, 17, 156 GrExt[HGrSystem].Mask.Canvas.Handle, 51, 153, SRCAND); 157 BitBlt(ca.Handle, xm - 7, ym + 8 + LADamage - 7, 14, 17, 158 GrExt[HGrSystem].Mask.Canvas.Handle, 51, 153, SRCAND); 159 BitBlt(ca.Handle, xm - 7, ym + 8 + LADamage - 7, 14, 17, 160 GrExt[HGrSystem].Data.Canvas.Handle, 51, 153, SRCPAINT); 161 end; 162 LabelText := Format('%d', [MyUn[uix].Health - Forecast.EndHealthAtt]); 163 TextSize := ca.TextExtent(LabelText); 164 if TextSize.cy div 2 > (LADamage - LAAvoidedDamage) div 2 + LAAvoidedDamage 165 then 166 begin 167 if Forecast.EndHealthAtt > 0 then 168 RisedTextOut(ca, xm - (TextSize.cx + 1) div 2, ym + 8 + LAAvoidedDamage, 169 LabelText) 170 end 171 else 172 RisedTextOut(ca, xm - (TextSize.cx + 1) div 2, ym + 8 + LAAvoidedDamage + 173 (LADamage - LAAvoidedDamage - TextSize.cy) div 2, LabelText); 174 175 NoMap.SetOutput(Buffer); 176 BitBlt(Buffer.Canvas.Handle, 0, 0, 66, 48, ca.Handle, xm + 8 + 4, 177 ym - 8 - 12 - 48, SRCCOPY); 178 { if TerrType<fForest then 179 Sprite(Buffer,HGrTerrain,0,16,66,32,1+TerrType*(xxt*2+1),1+yyt) 180 else 181 begin 182 Sprite(Buffer,HGrTerrain,0,16,66,32,1+2*(xxt*2+1),1+yyt+2*(yyt*3+1)); 183 if (TerrType=fForest) and IsJungle(ToLoc div G.lx) then 168 184 Sprite(Buffer,HGrTerrain,0,16,66,32,1+7*(xxt*2+1),1+yyt+19*(yyt*3+1)) 169 else Sprite(Buffer,HGrTerrain,0,16,66,32,1+7*(xxt*2+1),1+yyt+2*(2+TerrType-fForest)*(yyt*3+1)); 170 end;} 171 NoMap.PaintUnit(1,0,UnitInfo,0); 172 BitBlt(ca.Handle,xm+8+4,ym-8-12-48,66,48,Buffer.Canvas.Handle,0,0,SRCCOPY); 173 174 BitBlt(Buffer.Canvas.Handle,0,0,66,48,ca.Handle,xm-8-4-66,ym+8+12,SRCCOPY); 175 MakeUnitInfo(me,MyUn[uix],UnitInfo); 176 UnitInfo.Flags:=UnitInfo.Flags and not unFortified; 177 NoMap.PaintUnit(1,0,UnitInfo,0); 178 BitBlt(ca.Handle,xm-8-4-66,ym+8+12,66,48,Buffer.Canvas.Handle,0,0,SRCCOPY); 179 end; {PaintBattleOutcome} 180 185 else Sprite(Buffer,HGrTerrain,0,16,66,32,1+7*(xxt*2+1),1+yyt+2*(2+TerrType-fForest)*(yyt*3+1)); 186 end; } 187 NoMap.PaintUnit(1, 0, UnitInfo, 0); 188 BitBlt(ca.Handle, xm + 8 + 4, ym - 8 - 12 - 48, 66, 48, Buffer.Canvas.Handle, 189 0, 0, SRCCOPY); 190 191 BitBlt(Buffer.Canvas.Handle, 0, 0, 66, 48, ca.Handle, xm - 8 - 4 - 66, 192 ym + 8 + 12, SRCCOPY); 193 MakeUnitInfo(me, MyUn[uix], UnitInfo); 194 UnitInfo.Flags := UnitInfo.Flags and not unFortified; 195 NoMap.PaintUnit(1, 0, UnitInfo, 0); 196 BitBlt(ca.Handle, xm - 8 - 4 - 66, ym + 8 + 12, 66, 48, Buffer.Canvas.Handle, 197 0, 0, SRCCOPY); 198 end; { PaintBattleOutcome } 181 199 182 200 procedure TBattleDlg.FormCreate(Sender: TObject); 183 201 begin 184 OKBtn.Caption:=Phrases.Lookup('BTN_YES');185 CancelBtn.Caption:=Phrases.Lookup('BTN_NO');186 InitButtons();202 OKBtn.Caption := Phrases.Lookup('BTN_YES'); 203 CancelBtn.Caption := Phrases.Lookup('BTN_NO'); 204 InitButtons(); 187 205 end; 188 206 189 207 procedure TBattleDlg.FormShow(Sender: TObject); 190 208 begin 191 if IsSuicideQuery then192 begin 193 ClientWidth:=300;194 ClientHeight:=288;195 OKBtn.Visible:=true;196 CancelBtn.Visible:=true;197 Left:=(Screen.Width-ClientWidth) div 2; // center on screen198 Top:=(Screen.Height-ClientHeight) div 2;199 end 200 else201 begin 202 ClientWidth:=178;203 ClientHeight:=178;204 OKBtn.Visible:=false;205 CancelBtn.Visible:=false;209 if IsSuicideQuery then 210 begin 211 ClientWidth := 300; 212 ClientHeight := 288; 213 OKBtn.Visible := true; 214 CancelBtn.Visible := true; 215 Left := (Screen.Width - ClientWidth) div 2; // center on screen 216 Top := (Screen.Height - ClientHeight) div 2; 217 end 218 else 219 begin 220 ClientWidth := 178; 221 ClientHeight := 178; 222 OKBtn.Visible := false; 223 CancelBtn.Visible := false; 206 224 end; 207 225 end; … … 209 227 procedure TBattleDlg.FormPaint(Sender: TObject); 210 228 var 211 ym,cix,p: integer; 212 s,s1: string; 213 begin 214 with Canvas do 215 begin 216 Brush.Color:=0; 217 FillRect(Rect(0,0,ClientWidth,ClientHeight)); 218 Brush.Style:=bsClear; 219 PaintBackground(self,3+Border,3+Border,ClientWidth-(6+2*Border), 220 ClientHeight-(6+2*Border)) 221 end; 222 Frame(Canvas,Border+1,Border+1,ClientWidth-(2+Border),ClientHeight-(2+Border), 223 MainTexture.clBevelLight,MainTexture.clBevelShade); 224 Frame(Canvas,2+Border,2+Border,ClientWidth-(3+Border),ClientHeight-(3+Border), 225 MainTexture.clBevelLight,MainTexture.clBevelShade); 226 227 if IsSuicideQuery then 228 begin 229 Canvas.Font.Assign(UniFont[ftCaption]); 230 s:=Phrases.Lookup('TITLE_SUICIDE'); 231 RisedTextout(Canvas,(ClientWidth-BiColorTextWidth(Canvas,s)) div 2, 7+Border, s); 232 Canvas.Font.Assign(UniFont[ftNormal]); 233 s:=Phrases.Lookup('SUICIDE'); 234 p:=pos('\',s); 235 if p=0 then 236 RisedTextout(Canvas,(ClientWidth-BiColorTextWidth(Canvas,s)) div 2, 205, s) 237 else 229 ym, cix, p: Integer; 230 s, s1: string; 231 begin 232 with Canvas do 233 begin 234 Brush.Color := 0; 235 FillRect(Rect(0, 0, ClientWidth, ClientHeight)); 236 Brush.Style := bsClear; 237 PaintBackground(self, 3 + Border, 3 + Border, 238 ClientWidth - (6 + 2 * Border), ClientHeight - (6 + 2 * Border)) 239 end; 240 Frame(Canvas, Border + 1, Border + 1, ClientWidth - (2 + Border), 241 ClientHeight - (2 + Border), MainTexture.clBevelLight, 242 MainTexture.clBevelShade); 243 Frame(Canvas, 2 + Border, 2 + Border, ClientWidth - (3 + Border), 244 ClientHeight - (3 + Border), MainTexture.clBevelLight, 245 MainTexture.clBevelShade); 246 247 if IsSuicideQuery then 248 begin 249 Canvas.Font.Assign(UniFont[ftCaption]); 250 s := Phrases.Lookup('TITLE_SUICIDE'); 251 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, s)) div 2, 252 7 + Border, s); 253 Canvas.Font.Assign(UniFont[ftNormal]); 254 s := Phrases.Lookup('SUICIDE'); 255 p := pos('\', s); 256 if p = 0 then 257 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, s)) 258 div 2, 205, s) 259 else 238 260 begin 239 s1:=copy(s,1,p-1);240 RisedTextout(Canvas,(ClientWidth-BiColorTextWidth(Canvas,s1)) div 2,241 205-MessageLineSpacing div 2, s1);242 s1:=copy(s,p+1,255);243 RisedTextout(Canvas,(ClientWidth-BiColorTextWidth(Canvas,s1)) div 2,244 205+(MessageLineSpacing-MessageLineSpacing div 2), s1);261 s1 := copy(s, 1, p - 1); 262 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, s1)) div 2, 263 205 - MessageLineSpacing div 2, s1); 264 s1 := copy(s, p + 1, 255); 265 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, s1)) div 2, 266 205 + (MessageLineSpacing - MessageLineSpacing div 2), s1); 245 267 end; 246 ym:=110 247 end 248 else ym:=ClientHeight div 2; 249 Canvas.Font.Assign(UniFont[ftSmall]); 250 PaintBattleOutcome(Canvas, ClientWidth div 2, ym, uix, ToLoc, Forecast); 251 252 for cix:=0 to ControlCount-1 do 253 if (Controls[cix].Visible) and (Controls[cix] is TButtonBase) then 254 BtnFrame(Canvas,Controls[cix].BoundsRect,MainTexture); 268 ym := 110 269 end 270 else 271 ym := ClientHeight div 2; 272 Canvas.Font.Assign(UniFont[ftSmall]); 273 PaintBattleOutcome(Canvas, ClientWidth div 2, ym, uix, ToLoc, Forecast); 274 275 for cix := 0 to ControlCount - 1 do 276 if (Controls[cix].Visible) and (Controls[cix] is TButtonBase) then 277 BtnFrame(Canvas, Controls[cix].BoundsRect, MainTexture); 255 278 end; 256 279 … … 258 281 Shift: TShiftState; X, Y: Integer); 259 282 begin 260 if not IsSuicideQuery then261 Close;283 if not IsSuicideQuery then 284 Close; 262 285 end; 263 286 264 287 procedure TBattleDlg.FormDeactivate(Sender: TObject); 265 288 begin 266 if not IsSuicideQuery then267 Close289 if not IsSuicideQuery then 290 Close 268 291 end; 269 292 … … 271 294 Shift: TShiftState); 272 295 begin 273 if not IsSuicideQuery and (Key<>VK_SHIFT) then274 begin 275 Close;276 MainScreen.Update;277 if Key<>VK_ESCAPE then278 MainScreen.FormKeyDown(Sender, Key, Shift);296 if not IsSuicideQuery and (Key <> VK_SHIFT) then 297 begin 298 Close; 299 MainScreen.Update; 300 if Key <> VK_ESCAPE then 301 MainScreen.FormKeyDown(Sender, Key, Shift); 279 302 end 280 303 end; … … 282 305 procedure TBattleDlg.OKBtnClick(Sender: TObject); 283 306 begin 284 ModalResult:=mrOK;307 ModalResult := mrOK; 285 308 end; 286 309 287 310 procedure TBattleDlg.CancelBtnClick(Sender: TObject); 288 311 begin 289 ModalResult:=mrCancel;312 ModalResult := mrCancel; 290 313 end; 291 314 292 315 end. 293 -
trunk/LocalPlayer/CityScreen.pas
r3 r6 1 1 {$INCLUDE switches} 2 3 2 unit CityScreen; 4 3 … … 6 5 7 6 uses 8 Protocol,ClientTools,Term,ScreenTools,IsoEngine,BaseWin, 9 10 Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,ExtCtrls,ButtonA, 7 Protocol, ClientTools, Term, ScreenTools, IsoEngine, BaseWin, 8 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, 10 ButtonA, 11 11 ButtonB, ButtonBase, ButtonC, Area; 12 12 13 13 const 14 WM_PLAYSOUND=WM_USER;14 WM_PLAYSOUND = WM_USER; 15 15 16 16 type 17 TCityCloseAction =(None, RestoreFocus, StepFocus);17 TCityCloseAction = (None, RestoreFocus, StepFocus); 18 18 19 19 TCityDlg = class(TBufferedDrawDlg) … … 36 36 Pop1Area: TArea; 37 37 SupportArea: TArea; 38 procedure FormCreate(Sender: TObject);39 procedure FormDestroy(Sender: TObject);40 procedure FormMouseDown(Sender: TObject;Button:TMouseButton;41 Shift: TShiftState;x,y:integer);42 procedure BuyClick(Sender: TObject);43 procedure CloseBtnClick(Sender: TObject);38 procedure FormCreate(Sender: TObject); 39 procedure FormDestroy(Sender: TObject); 40 procedure FormMouseDown(Sender: TObject; Button: TMouseButton; 41 Shift: TShiftState; x, y: integer); 42 procedure BuyClick(Sender: TObject); 43 procedure CloseBtnClick(Sender: TObject); 44 44 procedure FormShow(Sender: TObject); 45 45 procedure FormClose(Sender: TObject; var Action: TCloseAction); … … 48 48 procedure NextCityBtnClick(Sender: TObject); 49 49 procedure PrevCityBtnClick(Sender: TObject); 50 procedure FormKeyDown(Sender: TObject; var Key: Word; 51 Shift: TShiftState); 52 //procedure AdviceBtnClick(Sender: TObject); 50 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 51 // procedure AdviceBtnClick(Sender: TObject); 53 52 procedure PageUpBtnClick(Sender: TObject); 54 53 procedure PageDownBtnClick(Sender: TObject); … … 58 57 CloseAction: TCityCloseAction; 59 58 procedure OffscreenPaint; override; 60 procedure ShowNewContent(NewMode, Loc: integer; ShowEvent: cardinal);59 procedure ShowNewContent(NewMode, Loc: integer; ShowEvent: cardinal); 61 60 procedure Reset; 62 61 procedure CheckAge; … … 64 63 private 65 64 c: TCity; 66 Report:TCityReportNew; 67 cOwner,cGov, 68 emix{enemy model index of produced unit}, 69 cix,cLoc,Mode,ZoomArea,Page,PageCount,BlinkTime,OpenSoundEvent, 70 SizeClass,AgePrepared: integer; 71 Optimize_cixTileChange,Optimize_TilesBeforeChange: integer; 65 Report: TCityReportNew; 66 cOwner, cGov, emix { enemy model index of produced unit } , cix, cLoc, Mode, 67 ZoomArea, Page, PageCount, BlinkTime, OpenSoundEvent, SizeClass, 68 AgePrepared: integer; 69 Optimize_cixTileChange, Optimize_TilesBeforeChange: integer; 72 70 Happened: cardinal; 73 imix: array[0..15] of integer;71 imix: array [0 .. 15] of integer; 74 72 CityAreaInfo: TCityAreaInfo; 75 73 AreaMap: TIsoMap; 76 CityMapTemplate, SmallCityMapTemplate, Back, SmallCityMap, ZoomCityMap, Template: TBitmap; 77 IsPort,ProdHint,AllowChange: boolean; 74 CityMapTemplate, SmallCityMapTemplate, Back, SmallCityMap, ZoomCityMap, 75 Template: TBitmap; 76 IsPort, ProdHint, AllowChange: boolean; 78 77 procedure InitSmallCityMap; 79 78 procedure InitZoomCityMap; … … 81 80 procedure ChangeCity(d: integer); 82 81 procedure ChangeResourceWeights(iResourceWeights: integer); 83 procedure OnPlaySound(var Msg: TMessage); message WM_PLAYSOUND;82 procedure OnPlaySound(var Msg: TMessage); message WM_PLAYSOUND; 84 83 end; 85 84 86 85 var 87 CityDlg: TCityDlg;86 CityDlg: TCityDlg; 88 87 89 88 implementation 90 89 91 90 uses 92 Select, Messg,MessgEx,Help,Inp,Tribes,Directories,91 Select, Messg, MessgEx, Help, Inp, Tribes, Directories, 93 92 94 93 Math; … … 97 96 98 97 const 99 {modes} 100 mSupp=1; mImp=2; 101 102 wBar=106; 103 xDiv=400; xService=296; 104 xmArea=197; ymArea=170; 105 xView=326; yView=275; 106 dxBar=wBar+12; dyBar=39; 107 xHapp=404; yHapp=9; 108 xFood=404; yFood=yHapp+3*dyBar+6; 109 xProd=404; yProd=yFood+3*dyBar+6; 110 xTrade=404; yTrade=yProd+2*dyBar+22; 111 xPoll=xmArea-186; yPoll=ymArea+64; 112 xmOpt=40; ymOpt=ymArea+96+34; 113 xSmallMap=271; ySmallMap=339; wSmallMap=98; hSmallMap=74; 114 xSupport=xSmallMap; ySupport=ySmallmap+hSmallmap+2; wSupport=64; hSupport=18; 115 xZoomMap=34; yZoomMap=338; wZoomMap=228; hZoomMap=124; wZoomEnvironment=68; 116 117 ImpPosition: array[28..nImp-1] of integer= 118 (-1, //imTrGoods 119 21, //imBarracks 120 6, //imGranary 121 1, //imTemple 122 7, //imMarket 123 14, //imLibrary 124 8, //imCourt 125 18, //imWalls 126 10, //imAqueduct 127 11, //imBank 128 5, //imCathedral 129 13, //imUniversity 130 29, //imHarbor 131 2, //imTheater 132 24, //imFactory 133 25, //imMfgPlant 134 28, //imRecycling 135 27, //imPower 136 27, //imHydro 137 27, //imNuclear 138 26, //imPlatform 139 8, //imTownHall 140 10, //imSewer 141 3, //imSupermarket 142 17, //imHighways 143 15, //imResLab 144 19, //imMissileBat 145 23, //imCoastalFort 146 22, //imAirport 147 20, //imDockyard 148 8, //imPalace 149 -1, //imGrWall 150 4, //imColosseum 151 16, //imObservatory 152 21, //imMilAcademy 153 -1, //imBunker 154 -1, //imAlgae 155 9, //imStockEx 156 -1, //imSpacePort 157 -1, //imShipComp 158 -1, //imShipPow 159 -1); //imShipHab 160 98 { modes } 99 mSupp = 1; 100 mImp = 2; 101 102 wBar = 106; 103 xDiv = 400; 104 xService = 296; 105 xmArea = 197; 106 ymArea = 170; 107 xView = 326; 108 yView = 275; 109 dxBar = wBar + 12; 110 dyBar = 39; 111 xHapp = 404; 112 yHapp = 9; 113 xFood = 404; 114 yFood = yHapp + 3 * dyBar + 6; 115 xProd = 404; 116 yProd = yFood + 3 * dyBar + 6; 117 xTrade = 404; 118 yTrade = yProd + 2 * dyBar + 22; 119 xPoll = xmArea - 186; 120 yPoll = ymArea + 64; 121 xmOpt = 40; 122 ymOpt = ymArea + 96 + 34; 123 xSmallMap = 271; 124 ySmallMap = 339; 125 wSmallMap = 98; 126 hSmallMap = 74; 127 xSupport = xSmallMap; 128 ySupport = ySmallMap + hSmallMap + 2; 129 wSupport = 64; 130 hSupport = 18; 131 xZoomMap = 34; 132 yZoomMap = 338; 133 wZoomMap = 228; 134 hZoomMap = 124; 135 wZoomEnvironment = 68; 136 137 ImpPosition: array [28 .. nImp - 1] of integer = (-1, // imTrGoods 138 21, // imBarracks 139 6, // imGranary 140 1, // imTemple 141 7, // imMarket 142 14, // imLibrary 143 8, // imCourt 144 18, // imWalls 145 10, // imAqueduct 146 11, // imBank 147 5, // imCathedral 148 13, // imUniversity 149 29, // imHarbor 150 2, // imTheater 151 24, // imFactory 152 25, // imMfgPlant 153 28, // imRecycling 154 27, // imPower 155 27, // imHydro 156 27, // imNuclear 157 26, // imPlatform 158 8, // imTownHall 159 10, // imSewer 160 3, // imSupermarket 161 17, // imHighways 162 15, // imResLab 163 19, // imMissileBat 164 23, // imCoastalFort 165 22, // imAirport 166 20, // imDockyard 167 8, // imPalace 168 -1, // imGrWall 169 4, // imColosseum 170 16, // imObservatory 171 21, // imMilAcademy 172 -1, // imBunker 173 -1, // imAlgae 174 9, // imStockEx 175 -1, // imSpacePort 176 -1, // imShipComp 177 -1, // imShipPow 178 -1); // imShipHab 161 179 162 180 var 163 ImpSorted: array[0..nImp-1] of integer; 164 165 166 procedure TCityDlg.FormCreate(Sender:TObject); 167 begin 168 inherited; 169 AreaMap:=TIsoMap.Create; 170 AreaMap.SetOutput(offscreen); 171 AreaMap.SetPaintBounds(xmArea-192,ymArea-96-32,xmArea+192,ymArea+96); 172 Mode:=mImp; 173 ZoomArea:=1; 174 ProdHint:=false; 175 RestoreUnFocus:=-1; 176 OpenSoundEvent:=-1; 177 AgePrepared:=-2; 178 Optimize_cixTileChange:=-1; 179 InitButtons(); 180 //InitWindowRegion; 181 CloseBtn.Caption:=Phrases.Lookup('BTN_OK'); 182 BuyBtn.Hint:=Phrases.Lookup('BTN_BUY'); 183 if not Phrases2FallenBackToEnglish then 184 SupportArea.Hint:=Phrases2.Lookup('TIP_SUPUNITS') 185 else SupportArea.Hint:=Phrases.Lookup('SUPUNITS'); 186 if not Phrases2FallenBackToEnglish then 187 begin 188 Pop0Area.Hint:=Phrases2.Lookup('TIP_WORKING'); 189 Pop1Area.Hint:=Phrases2.Lookup('TIP_CIVIL'); 190 PrimacyArea.Hint:=Phrases2.Lookup('TIP_PRIMACY'); 191 ProjectArea.Hint:=Phrases2.Lookup('TIP_PROJECT'); 192 end; 193 194 Back:=TBitmap.Create; 195 Back.PixelFormat:=pf24bit; 196 Back.Width:=ClientWidth; Back.Height:=ClientHeight; 197 Template:=TBitmap.Create; 198 LoadGraphicFile(Template, HomeDir+'Graphics\City', gfNoGamma); 199 Template.PixelFormat:=pf8bit; 200 CityMapTemplate:=TBitmap.Create; 201 LoadGraphicFile(CityMapTemplate, HomeDir+'Graphics\BigCityMap', gfNoGamma); 202 CityMapTemplate.PixelFormat:=pf8bit; 203 SmallCityMapTemplate:=TBitmap.Create; 204 LoadGraphicFile(SmallCityMapTemplate, HomeDir+'Graphics\SmallCityMap', gfNoGamma); 205 SmallCityMapTemplate.PixelFormat:=pf24bit; 206 SmallCityMap:=TBitmap.Create; 207 SmallCityMap.PixelFormat:=pf24bit; 208 SmallCityMap.Width:=98; SmallCityMap.Height:=74; 209 ZoomCityMap:=TBitmap.Create; 210 ZoomCityMap.PixelFormat:=pf24bit; 211 ZoomCityMap.Width:=228; ZoomCityMap.Height:=124; 212 end; 213 214 procedure TCityDlg.FormDestroy(Sender:TObject); 215 begin 216 AreaMap.Free; 217 SmallCityMap.Free; 218 ZoomCityMap.Free; 219 CityMapTemplate.Free; 220 Template.Free; 221 Back.Free; 181 ImpSorted: array [0 .. nImp - 1] of integer; 182 183 procedure TCityDlg.FormCreate(Sender: TObject); 184 begin 185 inherited; 186 AreaMap := TIsoMap.Create; 187 AreaMap.SetOutput(offscreen); 188 AreaMap.SetPaintBounds(xmArea - 192, ymArea - 96 - 32, xmArea + 192, 189 ymArea + 96); 190 Mode := mImp; 191 ZoomArea := 1; 192 ProdHint := false; 193 RestoreUnFocus := -1; 194 OpenSoundEvent := -1; 195 AgePrepared := -2; 196 Optimize_cixTileChange := -1; 197 InitButtons(); 198 // InitWindowRegion; 199 CloseBtn.Caption := Phrases.Lookup('BTN_OK'); 200 BuyBtn.Hint := Phrases.Lookup('BTN_BUY'); 201 if not Phrases2FallenBackToEnglish then 202 SupportArea.Hint := Phrases2.Lookup('TIP_SUPUNITS') 203 else 204 SupportArea.Hint := Phrases.Lookup('SUPUNITS'); 205 if not Phrases2FallenBackToEnglish then 206 begin 207 Pop0Area.Hint := Phrases2.Lookup('TIP_WORKING'); 208 Pop1Area.Hint := Phrases2.Lookup('TIP_CIVIL'); 209 PrimacyArea.Hint := Phrases2.Lookup('TIP_PRIMACY'); 210 ProjectArea.Hint := Phrases2.Lookup('TIP_PROJECT'); 211 end; 212 213 Back := TBitmap.Create; 214 Back.PixelFormat := pf24bit; 215 Back.Width := ClientWidth; 216 Back.Height := ClientHeight; 217 Template := TBitmap.Create; 218 LoadGraphicFile(Template, HomeDir + 'Graphics\City', gfNoGamma); 219 Template.PixelFormat := pf8bit; 220 CityMapTemplate := TBitmap.Create; 221 LoadGraphicFile(CityMapTemplate, HomeDir + 'Graphics\BigCityMap', gfNoGamma); 222 CityMapTemplate.PixelFormat := pf8bit; 223 SmallCityMapTemplate := TBitmap.Create; 224 LoadGraphicFile(SmallCityMapTemplate, HomeDir + 'Graphics\SmallCityMap', 225 gfNoGamma); 226 SmallCityMapTemplate.PixelFormat := pf24bit; 227 SmallCityMap := TBitmap.Create; 228 SmallCityMap.PixelFormat := pf24bit; 229 SmallCityMap.Width := 98; 230 SmallCityMap.Height := 74; 231 ZoomCityMap := TBitmap.Create; 232 ZoomCityMap.PixelFormat := pf24bit; 233 ZoomCityMap.Width := 228; 234 ZoomCityMap.Height := 124; 235 end; 236 237 procedure TCityDlg.FormDestroy(Sender: TObject); 238 begin 239 AreaMap.Free; 240 SmallCityMap.Free; 241 ZoomCityMap.Free; 242 CityMapTemplate.Free; 243 Template.Free; 244 Back.Free; 222 245 end; 223 246 224 247 procedure TCityDlg.Reset; 225 248 begin 226 Mode:=mImp;227 ZoomArea:=1;249 Mode := mImp; 250 ZoomArea := 1; 228 251 end; 229 252 230 253 procedure TCityDlg.CheckAge; 231 254 begin 232 if MainTextureAge<>AgePrepared then233 begin 234 AgePrepared:=MainTextureAge;235 bitblt(Back.Canvas.Handle,0,0,ClientWidth,ClientHeight,236 MainTexture.Image.Canvas.Handle,0,0,SRCCOPY);237 ImageOp_B(Back,Template,0,0,0,0,ClientWidth,ClientHeight);255 if MainTextureAge <> AgePrepared then 256 begin 257 AgePrepared := MainTextureAge; 258 bitblt(Back.Canvas.Handle, 0, 0, ClientWidth, ClientHeight, 259 MainTexture.Image.Canvas.Handle, 0, 0, SRCCOPY); 260 ImageOp_B(Back, Template, 0, 0, 0, 0, ClientWidth, ClientHeight); 238 261 end 239 262 end; 240 263 241 procedure TCityDlg.CloseBtnClick(Sender: TObject);242 begin 243 Close264 procedure TCityDlg.CloseBtnClick(Sender: TObject); 265 begin 266 Close 244 267 end; 245 268 246 269 procedure TCityDlg.InitSmallCityMap; 247 270 var 248 i,iix,cli1,Color0,Color1,Color2: integer; 249 begin 250 if cix>=0 then c:=MyCity[cix]; 251 case MyMap[cLoc] and fTerrain of 252 fPrairie: cli1:=cliPrairie; 253 fHills: cli1:=cliHills; 254 fTundra: cli1:=cliTundra; 255 else cli1:=cliPlains; 256 end; 257 Color0:=Colors.Canvas.Pixels[clkAge0+Age,cliRoad]; 258 Color1:=Colors.Canvas.Pixels[clkCity,cli1]; 259 Color2:=Colors.Canvas.Pixels[clkAge0+Age,cliHouse]; 260 BitBlt(SmallCityMap.Canvas.Handle,0,0,83,hSmallMap,SmallCityMapTemplate.Canvas.Handle,83*SizeClass,0,SRCCOPY); 261 if IsPort then 262 begin 263 BitBlt(SmallCityMap.Canvas.Handle,83,0,15,hSmallMap,SmallCityMapTemplate.Canvas.Handle,332+15,0,SRCCOPY); 264 ImageOp_CCC(SmallCityMap,0,0,83,hSmallMap,Color0,Color1,Color2); 265 Color2:=Colors.Canvas.Pixels[clkCity,cliWater]; 266 ImageOp_CCC(SmallCityMap,83,0,15,hSmallMap,Color0,Color1,Color2); 271 i, iix, cli1, Color0, Color1, Color2: integer; 272 begin 273 if cix >= 0 then 274 c := MyCity[cix]; 275 case MyMap[cLoc] and fTerrain of 276 fPrairie: 277 cli1 := cliPrairie; 278 fHills: 279 cli1 := cliHills; 280 fTundra: 281 cli1 := cliTundra; 282 else 283 cli1 := cliPlains; 284 end; 285 Color0 := Colors.Canvas.Pixels[clkAge0 + Age, cliRoad]; 286 Color1 := Colors.Canvas.Pixels[clkCity, cli1]; 287 Color2 := Colors.Canvas.Pixels[clkAge0 + Age, cliHouse]; 288 bitblt(SmallCityMap.Canvas.Handle, 0, 0, 83, hSmallMap, 289 SmallCityMapTemplate.Canvas.Handle, 83 * SizeClass, 0, SRCCOPY); 290 if IsPort then 291 begin 292 bitblt(SmallCityMap.Canvas.Handle, 83, 0, 15, hSmallMap, 293 SmallCityMapTemplate.Canvas.Handle, 332 + 15, 0, SRCCOPY); 294 ImageOp_CCC(SmallCityMap, 0, 0, 83, hSmallMap, Color0, Color1, Color2); 295 Color2 := Colors.Canvas.Pixels[clkCity, cliWater]; 296 ImageOp_CCC(SmallCityMap, 83, 0, 15, hSmallMap, Color0, Color1, Color2); 267 297 end 268 else 269 begin 270 BitBlt(SmallCityMap.Canvas.Handle,83,0,15,hSmallMap,SmallCityMapTemplate.Canvas.Handle,332,0,SRCCOPY); 271 ImageOp_CCC(SmallCityMap,0,0,wSmallMap,hSmallMap,Color0,Color1,Color2); 272 end; 273 274 with SmallCityMap.canvas do 275 begin 276 brush.Color:=Colors.Canvas.Pixels[clkAge0+Age,cliImp]; 277 for i:=0 to 29 do 278 begin 279 for iix:=28 to nImp-1 do 280 if (ImpPosition[iix]=i) and (c.Built[iix]>0) then 298 else 299 begin 300 bitblt(SmallCityMap.Canvas.Handle, 83, 0, 15, hSmallMap, 301 SmallCityMapTemplate.Canvas.Handle, 332, 0, SRCCOPY); 302 ImageOp_CCC(SmallCityMap, 0, 0, wSmallMap, hSmallMap, Color0, 303 Color1, Color2); 304 end; 305 306 with SmallCityMap.Canvas do 307 begin 308 brush.Color := Colors.Canvas.Pixels[clkAge0 + Age, cliImp]; 309 for i := 0 to 29 do 310 begin 311 for iix := 28 to nImp - 1 do 312 if (ImpPosition[iix] = i) and (c.Built[iix] > 0) then 281 313 begin 282 FillRect(Rect(5+16*(i mod 3)+48*(i div 18), 3+12*(i mod 18 div 3), 283 13+16*(i mod 3)+48*(i div 18), 11+12*(i mod 18 div 3))); 284 break; 314 FillRect(Rect(5 + 16 * (i mod 3) + 48 * (i div 18), 315 3 + 12 * (i mod 18 div 3), 13 + 16 * (i mod 3) + 48 * (i div 18), 316 11 + 12 * (i mod 18 div 3))); 317 break; 285 318 end 286 319 end; 287 i:=30;288 for iix:=0 to nImp do289 if (c.Built[iix]>0) and ((iix<28) or (ImpPosition[iix]<0)) then320 i := 30; 321 for iix := 0 to nImp do 322 if (c.Built[iix] > 0) and ((iix < 28) or (ImpPosition[iix] < 0)) then 290 323 begin 291 FillRect(Rect(5+16*(i mod 3)+48*(i div 18), 3+12*(i mod 18 div 3), 292 13+16*(i mod 3)+48*(i div 18), 11+12*(i mod 18 div 3))); 293 inc(i); 294 if i=36 then break; // area is full 324 FillRect(Rect(5 + 16 * (i mod 3) + 48 * (i div 18), 325 3 + 12 * (i mod 18 div 3), 13 + 16 * (i mod 3) + 48 * (i div 18), 326 11 + 12 * (i mod 18 div 3))); 327 inc(i); 328 if i = 36 then 329 break; // area is full 295 330 end; 296 if c.Project and cpImp<>0 then297 begin 298 iix:=c.Project and cpIndex;299 if iix<>imTrGoods then331 if c.Project and cpImp <> 0 then 332 begin 333 iix := c.Project and cpIndex; 334 if iix <> imTrGoods then 300 335 begin 301 if (iix>=28) and (ImpPosition[iix]>=0) then302 i:=ImpPosition[iix];303 if i<36 then336 if (iix >= 28) and (ImpPosition[iix] >= 0) then 337 i := ImpPosition[iix]; 338 if i < 36 then 304 339 begin 305 brush.Color:=Colors.Canvas.Pixels[clkAge0+Age,cliImpProject]; 306 FillRect(Rect(5+16*(i mod 3)+48*(i div 18), 3+12*(i mod 18 div 3), 307 13+16*(i mod 3)+48*(i div 18), 11+12*(i mod 18 div 3))); 340 brush.Color := Colors.Canvas.Pixels[clkAge0 + Age, cliImpProject]; 341 FillRect(Rect(5 + 16 * (i mod 3) + 48 * (i div 18), 342 3 + 12 * (i mod 18 div 3), 13 + 16 * (i mod 3) + 48 * (i div 18), 343 11 + 12 * (i mod 18 div 3))); 308 344 end 309 345 end 310 346 end; 311 brush.style:=bsClear;347 brush.style := bsClear; 312 348 end 313 349 end; … … 315 351 procedure TCityDlg.InitZoomCityMap; 316 352 begin 317 bitblt(ZoomCityMap.canvas.handle,0,0,wZoomMap,hZoomMap,Back.Canvas.handle, 318 xZoomMap,yZoomMap,SRCCOPY); 319 if Mode=mImp then 320 begin 321 if ZoomArea<3 then 322 ImageOp_B(ZoomCityMap,CityMapTemplate,0,0,376*SizeClass, 323 112*ZoomArea,wZoomMap,hZoomMap) 324 else 325 begin 326 ImageOp_B(ZoomCityMap,CityMapTemplate,0,0,376*SizeClass+216, 327 112*(ZoomArea-3),wZoomMap-wZoomEnvironment,hZoomMap); 328 ImageOp_B(ZoomCityMap,CityMapTemplate,wZoomMap-wZoomEnvironment,0, 329 1504+wZoomEnvironment*byte(IsPort),112*(ZoomArea-3),wZoomEnvironment,hZoomMap); 330 end; 331 end 353 bitblt(ZoomCityMap.Canvas.Handle, 0, 0, wZoomMap, hZoomMap, 354 Back.Canvas.Handle, xZoomMap, yZoomMap, SRCCOPY); 355 if Mode = mImp then 356 begin 357 if ZoomArea < 3 then 358 ImageOp_B(ZoomCityMap, CityMapTemplate, 0, 0, 376 * SizeClass, 359 112 * ZoomArea, wZoomMap, hZoomMap) 360 else 361 begin 362 ImageOp_B(ZoomCityMap, CityMapTemplate, 0, 0, 376 * SizeClass + 216, 363 112 * (ZoomArea - 3), wZoomMap - wZoomEnvironment, hZoomMap); 364 ImageOp_B(ZoomCityMap, CityMapTemplate, wZoomMap - wZoomEnvironment, 0, 365 1504 + wZoomEnvironment * byte(IsPort), 112 * (ZoomArea - 3), 366 wZoomEnvironment, hZoomMap); 367 end; 368 end 332 369 end; 333 370 334 371 procedure TCityDlg.OffscreenPaint; 335 372 336 procedure FillBar(x,y,pos,Growth,max,Kind: integer; IndicateComplete: boolean); 373 procedure FillBar(x, y, pos, Growth, max, Kind: integer; 374 IndicateComplete: boolean); 337 375 var 338 Tex: TTexture;339 begin 340 Tex:=MainTexture;341 if Kind=3 then342 begin 343 Tex.clBevelLight:=GrExt[HGrSystem].Data.Canvas.Pixels[104,36];344 Tex.clBevelShade:=Tex.clBevelLight;345 end; 346 PaintRelativeProgressBar(offscreen.Canvas,Kind,x-3,y,wBar-4,pos,Growth,max,347 IndicateComplete,Tex);348 end; 349 350 procedure PaintResources(x, y,Loc:integer; Add4Happy: boolean);376 Tex: TTexture; 377 begin 378 Tex := MainTexture; 379 if Kind = 3 then 380 begin 381 Tex.clBevelLight := GrExt[HGrSystem].Data.Canvas.Pixels[104, 36]; 382 Tex.clBevelShade := Tex.clBevelLight; 383 end; 384 PaintRelativeProgressBar(offscreen.Canvas, Kind, x - 3, y, wBar - 4, pos, 385 Growth, max, IndicateComplete, Tex); 386 end; 387 388 procedure PaintResources(x, y, Loc: integer; Add4Happy: boolean); 351 389 var 352 d,i,Total,xGr,yGr:integer; 353 TileInfo:TTileInfo; 354 rare: boolean; 355 begin 356 if Server(sGetCityTileInfo,me,Loc,TileInfo)<>eOk then 357 begin assert(cix<0); exit end; 358 Total:=TileInfo.Food+TileInfo.Prod+TileInfo.Trade; 359 rare:=MyMap[Loc] and $06000000>0; 360 if rare then 361 inc(Total); 362 if Add4Happy then 363 inc(Total,4); 364 if Total>1 then d:=(xxt-11) div (Total-1); 365 if d<1 then d:=1; 366 if d>4 then d:=4; 367 for i:=0 to Total-1 do 368 begin 369 yGr:=115; 370 if Add4Happy and (i>=Total-4) then 371 begin xGr:=132; yGr:=126 end 372 else if rare and (i=Total-1) then xGr:=66+110 373 else if i>=TileInfo.Food+TileInfo.Prod then xGr:=66+44 374 else if i>=TileInfo.Prod then xGr:=66 375 else xGr:=66+22; 376 Sprite(offscreen,HGrSystem,x+xxt-5+d*(2*i+1-Total),y+yyt-5,10,10,xGr,yGr); 390 d, i, Total, xGr, yGr: integer; 391 TileInfo: TTileInfo; 392 rare: boolean; 393 begin 394 if Server(sGetCityTileInfo, me, Loc, TileInfo) <> eOk then 395 begin 396 assert(cix < 0); 397 exit 398 end; 399 Total := TileInfo.Food + TileInfo.Prod + TileInfo.Trade; 400 rare := MyMap[Loc] and $06000000 > 0; 401 if rare then 402 inc(Total); 403 if Add4Happy then 404 inc(Total, 4); 405 if Total > 1 then 406 d := (xxt - 11) div (Total - 1); 407 if d < 1 then 408 d := 1; 409 if d > 4 then 410 d := 4; 411 for i := 0 to Total - 1 do 412 begin 413 yGr := 115; 414 if Add4Happy and (i >= Total - 4) then 415 begin 416 xGr := 132; 417 yGr := 126 418 end 419 else if rare and (i = Total - 1) then 420 xGr := 66 + 110 421 else if i >= TileInfo.Food + TileInfo.Prod then 422 xGr := 66 + 44 423 else if i >= TileInfo.Prod then 424 xGr := 66 425 else 426 xGr := 66 + 22; 427 Sprite(offscreen, HGrSystem, x + xxt - 5 + d * (2 * i + 1 - Total), 428 y + yyt - 5, 10, 10, xGr, yGr); 377 429 end 378 430 end; 379 431 380 procedure MakeRed(x, y,w,h: integer);432 procedure MakeRed(x, y, w, h: integer); 381 433 type 382 TLine=array[0..99999,0..2] of Byte;383 PLine=^TLine;434 TLine = array [0 .. 99999, 0 .. 2] of byte; 435 PLine = ^TLine; 384 436 385 437 procedure RedLine(line: PLine; length: integer); 386 438 var 387 i,gray: integer;388 begin 389 for i:=0 to length-1 do439 i, gray: integer; 440 begin 441 for i := 0 to length - 1 do 390 442 begin 391 gray:=(integer(line[i,0])+integer(line[i,1])+integer(line[i,2])) *85 shr 8; 392 line[i,0]:=0; 393 line[i,1]:=0; 394 line[i,2]:=gray; //255-(255-gray) div 2; 443 gray := (integer(line[i, 0]) + integer(line[i, 1]) + integer(line[i, 2]) 444 ) * 85 shr 8; 445 line[i, 0] := 0; 446 line[i, 1] := 0; 447 line[i, 2] := gray; // 255-(255-gray) div 2; 395 448 end 396 449 end; 397 450 398 451 var 399 i: integer;400 begin 401 for i:=0 to h-1 do402 RedLine(@(PLine(Offscreen.ScanLine[y+i])[x]),w)452 i: integer; 453 begin 454 for i := 0 to h - 1 do 455 RedLine(@(PLine(offscreen.ScanLine[y + i])[x]), w) 403 456 end; 404 457 405 458 var 406 line, MessageCount: integer;459 line, MessageCount: integer; 407 460 408 461 procedure CheckMessage(Flag: integer); 409 462 var 410 i, test: integer; 411 s: string; 412 begin 413 if Happened and Flag<>0 then 414 begin 415 i:=0; 416 test:=1; 417 while test<Flag do begin inc(i); inc(test,test) end; 418 419 if AllowChange and (Sounds<>nil) and (OpenSoundEvent=-1) then 463 i, test: integer; 464 s: string; 465 begin 466 if Happened and Flag <> 0 then 467 begin 468 i := 0; 469 test := 1; 470 while test < Flag do 420 471 begin 421 s:=CityEventSoundItem[i]; 422 if s<>'' then s:=Sounds.Lookup(s); 423 if (Flag=chProduction) or (s<>'') and (s[1]<>'*') and (s[1]<>'[') then 424 OpenSoundEvent:=i 472 inc(i); 473 inc(test, test) 425 474 end; 426 475 427 s:=CityEventName(i); 428 { if Flag=chNoGrowthWarning then 429 if c.Built[imAqueduct]=0 then 476 if AllowChange and (Sounds <> nil) and (OpenSoundEvent = -1) then 477 begin 478 s := CityEventSoundItem[i]; 479 if s <> '' then 480 s := Sounds.Lookup(s); 481 if (Flag = chProduction) or (s <> '') and (s[1] <> '*') and (s[1] <> '[') 482 then 483 OpenSoundEvent := i 484 end; 485 486 s := CityEventName(i); 487 { if Flag=chNoGrowthWarning then 488 if c.Built[imAqueduct]=0 then 430 489 s:=Format(s,[Phrases.Lookup('IMPROVEMENTS',imAqueduct)]) 431 else s:=Format(s,[Phrases.Lookup('IMPROVEMENTS',imSewer)]);} 432 RisedTextOut(offscreen.Canvas,xmOpt+40,ymOpt-1-8*MessageCount+16*line,s); 433 inc(line) 490 else s:=Format(s,[Phrases.Lookup('IMPROVEMENTS',imSewer)]); } 491 RisedTextOut(offscreen.Canvas, xmOpt + 40, ymOpt - 1 - 8 * MessageCount + 492 16 * line, s); 493 inc(line) 434 494 end 435 495 end; 436 496 437 497 var 438 x,y,xGr,i,i1,j,iix,d,dx,dy,PrCost,Cnt,Loc1,FreeSupp,Paintiix,HappyGain, 439 OptiType,rx,ry,TrueFood,TrueProd,TruePoll: integer; 440 av: Integer; 441 PrName,s:string; 442 UnitInfo: TUnitInfo; 443 UnitReport: TUnitReport; 444 RedTex: TTexture; 445 IsCityAlive,CanGrow: boolean; 446 begin 447 inherited; 448 if cix>=0 then c:=MyCity[cix]; 449 Report.HypoTiles:=-1; 450 Report.HypoTaxRate:=-1; 451 Report.HypoLuxuryRate:=-1; 452 if cix>=0 then Server(sGetCityReportNew,me,cix,Report) // own city 453 else Server(sGetEnemyCityReportNew,me,cLoc,Report); // enemy city 454 TrueFood:=c.Food; 455 TrueProd:=c.Prod; 456 TruePoll:=c.Pollution; 457 if supervising or (cix<0) then 498 x, y, xGr, i, i1, j, iix, d, dx, dy, PrCost, Cnt, Loc1, FreeSupp, Paintiix, 499 HappyGain, OptiType, rx, ry, TrueFood, TrueProd, TruePoll: integer; 500 av: integer; 501 PrName, s: string; 502 UnitInfo: TUnitInfo; 503 UnitReport: TUnitReport; 504 RedTex: TTexture; 505 IsCityAlive, CanGrow: boolean; 506 begin 507 inherited; 508 if cix >= 0 then 509 c := MyCity[cix]; 510 Report.HypoTiles := -1; 511 Report.HypoTaxRate := -1; 512 Report.HypoLuxuryRate := -1; 513 if cix >= 0 then 514 Server(sGetCityReportNew, me, cix, Report) // own city 515 else 516 Server(sGetEnemyCityReportNew, me, cLoc, Report); // enemy city 517 TrueFood := c.Food; 518 TrueProd := c.Prod; 519 TruePoll := c.Pollution; 520 if supervising or (cix < 0) then 458 521 begin // normalize city from after-turn state 459 dec(TrueFood,Report.FoodSurplus); 460 if TrueFood<0 then 461 TrueFood:=0; // shouldn't happen 462 dec(TrueProd,Report.Production); 463 if TrueProd<0 then 464 TrueProd:=0; // shouldn't happen 465 dec(TruePoll,Report.AddPollution); 466 if TruePoll<0 then 467 TruePoll:=0; // shouldn't happen 468 end; 469 IsCityAlive:= (cGov<>gAnarchy) and (c.Flags and chCaptured=0); 470 if not IsCityAlive then Report.Working:=c.Size; 471 472 RedTex:=MainTexture; 473 RedTex.clBevelLight:=$0000FF; 474 RedTex.clBevelShade:=$000000; 475 RedTex.clTextLight:=$000000; 476 RedTex.clTextShade:=$0000FF; 477 478 bitblt(offscreen.canvas.handle,0,0,640,480,Back.Canvas.handle,0,0,SRCCOPY); 479 480 offscreen.Canvas.Font.Assign(UniFont[ftCaption]); 481 RisedTextout(offscreen.Canvas,42,7,Caption); 482 with offscreen.canvas do 522 dec(TrueFood, Report.FoodSurplus); 523 if TrueFood < 0 then 524 TrueFood := 0; // shouldn't happen 525 dec(TrueProd, Report.Production); 526 if TrueProd < 0 then 527 TrueProd := 0; // shouldn't happen 528 dec(TruePoll, Report.AddPollution); 529 if TruePoll < 0 then 530 TruePoll := 0; // shouldn't happen 531 end; 532 IsCityAlive := (cGov <> gAnarchy) and (c.Flags and chCaptured = 0); 533 if not IsCityAlive then 534 Report.Working := c.Size; 535 536 RedTex := MainTexture; 537 RedTex.clBevelLight := $0000FF; 538 RedTex.clBevelShade := $000000; 539 RedTex.clTextLight := $000000; 540 RedTex.clTextShade := $0000FF; 541 542 bitblt(offscreen.Canvas.Handle, 0, 0, 640, 480, Back.Canvas.Handle, 0, 543 0, SRCCOPY); 544 545 offscreen.Canvas.Font.Assign(UniFont[ftCaption]); 546 RisedTextOut(offscreen.Canvas, 42, 7, Caption); 547 with offscreen.Canvas do 483 548 begin // city size 484 brush.color:=$000000; 485 fillrect(rect(8+1,7+1,36+1,32+1)); 486 brush.color:=$FFFFFF; 487 fillrect(rect(8,7,36,32)); 488 brush.style:=bsClear; 489 font.color:=$000000; 490 s:=inttostr(c.Size); 491 TextOut(8+14-textwidth(s) div 2, 7, s); 492 end; 493 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 494 495 if not IsCityAlive then 496 begin 497 MakeRed(18,280,298,40); 498 if cGov=gAnarchy then s:=Phrases.Lookup('GOVERNMENT',gAnarchy) 499 else {if c.Flags and chCaptured<>0 then} 500 s:=Phrases.Lookup('CITYEVENTS',14); 501 RisedTextout(offscreen.canvas,167-BiColorTextWidth(offscreen.canvas,s) div 2,ymOpt-9, s); 549 brush.Color := $000000; 550 FillRect(Rect(8 + 1, 7 + 1, 36 + 1, 32 + 1)); 551 brush.Color := $FFFFFF; 552 FillRect(Rect(8, 7, 36, 32)); 553 brush.style := bsClear; 554 Font.Color := $000000; 555 s := inttostr(c.Size); 556 TextOut(8 + 14 - textwidth(s) div 2, 7, s); 557 end; 558 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 559 560 if not IsCityAlive then 561 begin 562 MakeRed(18, 280, 298, 40); 563 if cGov = gAnarchy then 564 s := Phrases.Lookup('GOVERNMENT', gAnarchy) 565 else { if c.Flags and chCaptured<>0 then } 566 s := Phrases.Lookup('CITYEVENTS', 14); 567 RisedTextOut(offscreen.Canvas, 167 - BiColorTextWidth(offscreen.Canvas, s) 568 div 2, ymOpt - 9, s); 502 569 end 503 else if AllowChange then 504 begin 505 OptiType:=c.Status shr 4 and $0F; 506 Sprite(offscreen,HGrSystem2,xmOpt-32,ymOpt-32,64,64,1+OptiType mod 3*64,217+OptiType div 3*64); 507 508 {display messages now} 509 MessageCount:=0; 510 for i:=0 to 31 do 511 if Happened and ($FFFFFFFF-chCaptured) and (1 shl i)<>0 then 512 inc(MessageCount); 513 if MessageCount>3 then 514 MessageCount:=3; 515 if MessageCount>0 then 516 begin 517 MakeBlue(Offscreen,74,280,242,40); 518 line:=0; 519 for i:=0 to nCityEventPriority-1 do 520 if line<MessageCount then 521 CheckMessage(CityEventPriority[i]); 570 else if AllowChange then 571 begin 572 OptiType := c.Status shr 4 and $0F; 573 Sprite(offscreen, HGrSystem2, xmOpt - 32, ymOpt - 32, 64, 64, 574 1 + OptiType mod 3 * 64, 217 + OptiType div 3 * 64); 575 576 { display messages now } 577 MessageCount := 0; 578 for i := 0 to 31 do 579 if Happened and ($FFFFFFFF - chCaptured) and (1 shl i) <> 0 then 580 inc(MessageCount); 581 if MessageCount > 3 then 582 MessageCount := 3; 583 if MessageCount > 0 then 584 begin 585 MakeBlue(offscreen, 74, 280, 242, 40); 586 line := 0; 587 for i := 0 to nCityEventPriority - 1 do 588 if line < MessageCount then 589 CheckMessage(CityEventPriority[i]); 522 590 end 523 else 524 begin 525 s:=Phrases.Lookup('CITYMANAGETYPE',OptiType); 526 j:=pos('\',s); 527 if j=0 then 528 LoweredTextout(offscreen.canvas, -1, MainTexture, xmOpt+40, ymOpt-9, s) 529 else 591 else 592 begin 593 s := Phrases.Lookup('CITYMANAGETYPE', OptiType); 594 j := pos('\', s); 595 if j = 0 then 596 LoweredTextout(offscreen.Canvas, -1, MainTexture, xmOpt + 40, 597 ymOpt - 9, s) 598 else 530 599 begin 531 LoweredTextout(offscreen.canvas, -1, MainTexture, xmOpt+40, ymOpt-17,532 copy(s,1,j-1));533 LoweredTextout(offscreen.canvas, -1, MainTexture, xmOpt+40, ymOpt-1,534 copy(s,j+1,255));600 LoweredTextout(offscreen.Canvas, -1, MainTexture, xmOpt + 40, 601 ymOpt - 17, copy(s, 1, j - 1)); 602 LoweredTextout(offscreen.Canvas, -1, MainTexture, xmOpt + 40, ymOpt - 1, 603 copy(s, j + 1, 255)); 535 604 end 536 605 end 537 606 end; 538 607 539 rx:=(192+xxt*2-1) div (xxt*2); 540 ry:=(96+yyt*2-1) div (yyt*2); 541 AreaMap.Paint(xmArea-xxt*2*rx,ymArea-yyt*2*ry-3*yyt,dLoc(cLoc,-2*rx+1,-2*ry-1),4*rx-1,4*ry+1,cLoc,cOwner, 542 false,AllowChange and IsCityAlive and (c.Status and csResourceWeightsMask=0)); 543 bitblt(offscreen.canvas.handle,xmArea+102,42,90,33,Back.Canvas.handle,xmArea+102,42,SRCCOPY); 544 545 if IsCityAlive then 546 for dy:=-3 to 3 do for dx:=-3 to 3 do 547 if ((dx+dy) and 1=0) and (dx*dx*dy*dy<81) then 608 rx := (192 + xxt * 2 - 1) div (xxt * 2); 609 ry := (96 + yyt * 2 - 1) div (yyt * 2); 610 AreaMap.Paint(xmArea - xxt * 2 * rx, ymArea - yyt * 2 * ry - 3 * yyt, 611 dLoc(cLoc, -2 * rx + 1, -2 * ry - 1), 4 * rx - 1, 4 * ry + 1, cLoc, cOwner, 612 false, AllowChange and IsCityAlive and 613 (c.Status and csResourceWeightsMask = 0)); 614 bitblt(offscreen.Canvas.Handle, xmArea + 102, 42, 90, 33, Back.Canvas.Handle, 615 xmArea + 102, 42, SRCCOPY); 616 617 if IsCityAlive then 618 for dy := -3 to 3 do 619 for dx := -3 to 3 do 620 if ((dx + dy) and 1 = 0) and (dx * dx * dy * dy < 81) then 621 begin 622 Loc1 := dLoc(cLoc, dx, dy); 623 av := CityAreaInfo.Available[(dy + 3) shl 2 + (dx + 3) shr 1]; 624 if ((av = faNotAvailable) or (av = faTreaty) or (av = faInvalid)) and 625 ((Loc1 < 0) or (Loc1 >= G.lx * G.ly) or (MyMap[Loc1] and fCity = 0)) 626 then 627 Sprite(offscreen, HGrTerrain, xmArea - xxt + xxt * dx, 628 ymArea - yyt + yyt * dy, xxt * 2, yyt * 2, 1 + 5 * (xxt * 2 + 1), 629 1 + yyt + 15 * (yyt * 3 + 1)); 630 if (1 shl ((dy + 3) shl 2 + (dx + 3) shr 1) and c.Tiles <> 0) then 631 PaintResources(xmArea - xxt + xxt * dx, ymArea - yyt + yyt * dy, 632 Loc1, (dx = 0) and (dy = 0)); 633 end; 634 635 if Report.Working > 1 then 636 d := (xService - (xmArea - 192) - 8 - 32) div (Report.Working - 1); 637 if d > 28 then 638 d := 28; 639 for i := Report.Working - 1 downto 0 do 640 begin 641 if IsCityAlive then 642 xGr := 29 643 else 644 xGr := 141; 645 bitblt(offscreen.Canvas.Handle, xmArea - 192 + 5 + i * d, ymArea - 96 - 29, 646 27, 30, GrExt[HGrSystem].Mask.Canvas.Handle, xGr, 171, SRCAND); { shadow } 647 Sprite(offscreen, HGrSystem, xmArea - 192 + 4 + i * d, ymArea - 96 - 30, 27, 648 30, xGr, 171); 649 end; 650 if c.Size - Report.Working > 1 then 651 d := (xmArea + 192 - xService - 32) div (c.Size - Report.Working - 1); 652 if d > 28 then 653 d := 28; 654 for i := 0 to c.Size - Report.Working - 1 do 655 begin 656 xGr := 1 + 112; 657 bitblt(offscreen.Canvas.Handle, xmArea + 192 - 27 + 1 - i * d, 29 + 1, 27, 658 30, GrExt[HGrSystem].Mask.Canvas.Handle, xGr, 171, SRCAND); { shadow } 659 Sprite(offscreen, HGrSystem, xmArea + 192 - 27 - i * d, 29, 27, 30, 660 xGr, 171); 661 Sprite(offscreen, HGrSystem, xmArea + 192 - 27 + 4 - i * d, 29 + 32, 10, 662 10, 121, 126); 663 Sprite(offscreen, HGrSystem, xmArea + 192 - 27 + 13 - i * d, 29 + 32, 10, 664 10, 121, 126); 665 // Sprite(offscreen,HGrSystem,xmArea+192-31+18-i*d,ymArea-96-80+32,10,10,88,115); 666 end; 667 668 if c.Project and cpImp = 0 then 669 PrName := Tribe[cOwner].ModelName[c.Project and cpIndex] 670 else 671 PrName := Phrases.Lookup('IMPROVEMENTS', c.Project and cpIndex); 672 PrCost := Report.ProjectCost; 673 674 // happiness section 675 if IsCityAlive then 676 begin 677 if cGov = gFundamentalism then 678 CountBar(offscreen, xHapp, yHapp + dyBar, wBar, 17, 679 Phrases.Lookup('FAITH'), Report.CollectedControl, MainTexture) 680 else 681 begin 682 CountBar(offscreen, xHapp, yHapp + dyBar, wBar, 17, 683 Phrases.Lookup('HAPPINESS'), Report.Morale, MainTexture); 684 CountBar(offscreen, xHapp, yHapp + 2 * dyBar, wBar, 16, 685 Phrases.Lookup('CONTROL'), Report.CollectedControl, MainTexture); 686 end; 687 CountBar(offscreen, xHapp, yHapp, wBar, 8, Phrases.Lookup('LUX'), 688 Report.Luxury, MainTexture); 689 CountBar(offscreen, xHapp + dxBar, yHapp, wBar, 19, 690 Phrases.Lookup('UNREST'), 2 * Report.Deployed, MainTexture); 691 CountBar(offscreen, xHapp + dxBar, yHapp + dyBar, wBar, 17, 692 Phrases.Lookup('HAPPINESSDEMAND'), c.Size, MainTexture); 693 if Report.HappinessBalance >= 0 then 694 CountBar(offscreen, xHapp + dxBar, yHapp + 2 * dyBar, wBar, 17, 695 Phrases.Lookup('HAPPINESSPLUS'), Report.HappinessBalance, MainTexture) 696 else 697 begin 698 MakeRed(xHapp + dxBar - 6, yHapp + 2 * dyBar, wBar + 10, 38); 699 CountBar(offscreen, xHapp + dxBar, yHapp + 2 * dyBar, wBar, 18, 700 Phrases.Lookup('LACK'), -Report.HappinessBalance, RedTex); 701 end; 702 end; 703 704 // food section 705 if IsCityAlive then 706 begin 707 CountBar(offscreen, xFood, yFood + dyBar div 2, wBar, 0, 708 Phrases.Lookup('FOOD'), Report.CollectedFood, MainTexture); 709 CountBar(offscreen, xFood + dxBar, yFood + dyBar, wBar, 0, 710 Phrases.Lookup('DEMAND'), 2 * c.Size, MainTexture); 711 CountBar(offscreen, xFood + dxBar, yFood, wBar, 0, 712 Phrases.Lookup('SUPPORT'), Report.FoodSupport, MainTexture); 713 if Report.FoodSurplus >= 0 then 714 if (cGov = gFuture) or (c.Size >= NeedAqueductSize) and 715 (Report.FoodSurplus < 2) then 716 CountBar(offscreen, xFood + dxBar, yFood + 2 * dyBar, wBar, 6, 717 Phrases.Lookup('PROFIT'), Report.FoodSurplus, MainTexture) 718 else 719 CountBar(offscreen, xFood + dxBar, yFood + 2 * dyBar, wBar, 0, 720 Phrases.Lookup('SURPLUS'), Report.FoodSurplus, MainTexture) 721 else 722 begin 723 MakeRed(xFood + dxBar - 6, yFood + 2 * dyBar, wBar + 10, 38); 724 CountBar(offscreen, xFood + dxBar, yFood + 2 * dyBar, wBar, 1, 725 Phrases.Lookup('LACK'), -Report.FoodSurplus, RedTex); 726 end; 727 end; 728 CanGrow := (c.Size < MaxCitySize) and (cGov <> gFuture) and 729 (Report.FoodSurplus > 0) and ((c.Size < NeedAqueductSize) or 730 (c.Built[imAqueduct] = 1) and (c.Size < NeedSewerSize) or 731 (c.Built[imSewer] = 1)); 732 FillBar(xFood + 3, yFood + 102, TrueFood, 733 CutCityFoodSurplus(Report.FoodSurplus, IsCityAlive, cGov, c.Size), 734 Report.Storage, 1, CanGrow); 735 LoweredTextout(offscreen.Canvas, -1, MainTexture, xFood + 3 - 5, 736 yFood + 102 - 20, Format('%d/%d', [TrueFood, Report.Storage])); 737 LoweredTextout(offscreen.Canvas, -1, MainTexture, xFood - 2, yFood + 66, 738 Phrases.Lookup('STORAGE')); 739 740 // production section 741 if IsCityAlive then 742 begin 743 CountBar(offscreen, xProd, yProd, wBar, 2, Phrases.Lookup('MATERIAL'), 744 Report.CollectedMaterial, MainTexture); 745 CountBar(offscreen, xProd + dxBar, yProd, wBar, 2, 746 Phrases.Lookup('SUPPORT'), Report.MaterialSupport, MainTexture); 747 if Report.Production >= 0 then 748 if c.Project and (cpImp + cpIndex) = cpImp + imTrGoods then 749 CountBar(offscreen, xProd + dxBar, yProd + dyBar + 16, wBar, 6, 750 Phrases.Lookup('PROFIT'), Report.Production, MainTexture) 751 else 752 CountBar(offscreen, xProd + dxBar, yProd + dyBar + 16, wBar, 2, 753 Phrases.Lookup('PROD'), Report.Production, MainTexture) 754 else 755 begin 756 MakeRed(xProd + dxBar - 6, yProd + dyBar, wBar + 10, 38); 757 CountBar(offscreen, xProd + dxBar, yProd + dyBar + 16, wBar, 3, 758 Phrases.Lookup('LACK'), -Report.Production, RedTex); 759 end; 760 end; 761 if c.Project and (cpImp + cpIndex) <> cpImp + imTrGoods then 762 with offscreen.Canvas do 763 begin 764 i := Report.Production; 765 if (i < 0) or not IsCityAlive then 766 i := 0; 767 FillBar(xProd + 3, yProd + 16 + 63, TrueProd, i, PrCost, 4, true); 768 LoweredTextout(offscreen.Canvas, -1, MainTexture, xProd + 3 - 5, 769 yProd + 16 + 43, Format('%d/%d', [TrueProd, PrCost])); 770 if BiColorTextWidth(offscreen.Canvas, PrName) > wBar + dxBar then 548 771 begin 549 Loc1:=dLoc(cLoc,dx,dy); 550 av := CityAreaInfo.Available[(dy+3) shl 2+(dx+3) shr 1]; 551 if ((av = faNotAvailable) or (av = faTreaty) or (av =faInvalid)) 552 and ((Loc1<0) or (Loc1>=G.lx*G.ly) or (MyMap[Loc1] and fCity=0)) then 553 Sprite(offscreen,HGrTerrain,xmArea-xxt+xxt*dx,ymArea-yyt+yyt*dy,xxt*2, 554 yyt*2,1+5*(xxt*2+1),1+yyt+15*(yyt*3+1)); 555 if (1 shl((dy+3) shl 2+(dx+3) shr 1) and c.Tiles<>0) then 556 PaintResources(xmArea-xxt+xxt*dx,ymArea-yyt+yyt*dy,Loc1,(dx=0) and (dy=0)); 772 repeat 773 Delete(PrName, length(PrName), 1) 774 until BiColorTextWidth(offscreen.Canvas, PrName) <= wBar + dxBar; 775 PrName := PrName + '.' 557 776 end; 558 559 if Report.Working>1 then d:=(xService-(xmArea-192)-8-32) div(Report.Working-1); 560 if d>28 then d:=28; 561 for i:=Report.Working-1 downto 0 do 562 begin 563 if IsCityAlive then xGr:=29 564 else xGr:=141; 565 BitBlt(offscreen.Canvas.Handle,xmArea-192+5+i*d,ymArea-96-29, 566 27,30,GrExt[HGrSystem].Mask.Canvas.Handle,xGr,171,SRCAND); {shadow} 567 Sprite(offscreen,HGrSystem,xmArea-192+4+i*d,ymArea-96-30,27,30,xGr,171); 568 end; 569 if c.Size-Report.Working>1 then d:=(xmArea+192-xService-32) div(c.Size-Report.Working-1); 570 if d>28 then d:=28; 571 for i:=0 to c.Size-Report.Working-1 do 572 begin 573 xGr:=1+112; 574 BitBlt(offscreen.Canvas.Handle,xmArea+192-27+1-i*d,29+1, 575 27,30,GrExt[HGrSystem].Mask.Canvas.Handle,xGr,171,SRCAND); {shadow} 576 Sprite(offscreen,HGrSystem,xmArea+192-27-i*d,29,27,30,xGr,171); 577 Sprite(offscreen,HGrSystem,xmArea+192-27+4-i*d,29+32,10,10,121,126); 578 Sprite(offscreen,HGrSystem,xmArea+192-27+13-i*d,29+32,10,10,121,126); 579 // Sprite(offscreen,HGrSystem,xmArea+192-31+18-i*d,ymArea-96-80+32,10,10,88,115); 580 end; 581 582 if c.Project and cpImp=0 then 583 PrName:=Tribe[cOwner].ModelName[c.Project and cpIndex] 584 else PrName:=Phrases.Lookup('IMPROVEMENTS',c.Project and cpIndex); 585 PrCost:=Report.ProjectCost; 586 587 // happiness section 588 if IsCityAlive then 589 begin 590 if cGov=gFundamentalism then 591 CountBar(offscreen,xHapp,yHapp+dyBar,wBar,17,Phrases.Lookup('FAITH'), 592 Report.CollectedControl,MainTexture) 777 end; 778 RisedTextOut(offscreen.Canvas, xProd - 2, yProd + 36, PrName); 779 780 // pollution section 781 if IsCityAlive and (Report.AddPollution > 0) then 782 begin 783 FillBar(xPoll + 3, yPoll + 20, TruePoll, Report.AddPollution, 784 MaxPollution, 3, true); 785 RisedTextOut(offscreen.Canvas, xPoll + 3 - 5, yPoll + 20 - 20, 786 Phrases.Lookup('POLL')); 787 end; 788 789 // trade section 790 if IsCityAlive and (Report.CollectedTrade > 0) then 791 begin 792 CountBar(offscreen, xTrade, yTrade + dyBar div 2, wBar, 4, 793 Phrases.Lookup('TRADE'), Report.CollectedTrade, MainTexture); 794 CountBar(offscreen, xTrade + dxBar, yTrade + 2 * dyBar, wBar, 5, 795 Phrases.Lookup('CORR'), Report.Corruption, MainTexture); 796 CountBar(offscreen, xTrade + dxBar, yTrade, wBar, 6, Phrases.Lookup('TAX'), 797 Report.Tax, MainTexture); 798 CountBar(offscreen, xTrade + dxBar, yTrade + dyBar, wBar, 12, 799 Phrases.Lookup('SCIENCE'), Report.Science, MainTexture); 800 end; 801 802 // small map 803 bitblt(offscreen.Canvas.Handle, xSmallMap, ySmallMap, wSmallMap, hSmallMap, 804 SmallCityMap.Canvas.Handle, 0, 0, SRCCOPY); 805 if Mode = mImp then 806 Frame(offscreen.Canvas, xSmallMap + 48 * (ZoomArea div 3), 807 ySmallMap + 24 * (ZoomArea mod 3), xSmallMap + 48 * (ZoomArea div 3) + 49, 808 ySmallMap + 24 * (ZoomArea mod 3) + 25, MainTexture.clMark, 809 MainTexture.clMark); 810 Frame(offscreen.Canvas, xSmallMap - 1, ySmallMap - 1, xSmallMap + wSmallMap, 811 ySmallMap + hSmallMap, $B0B0B0, $FFFFFF); 812 RFrame(offscreen.Canvas, xSmallMap - 2, ySmallMap - 2, xSmallMap + wSmallMap + 813 1, ySmallMap + hSmallMap + 1, $FFFFFF, $B0B0B0); 814 815 Frame(offscreen.Canvas, xSupport - 1, ySupport - 1, xSupport + wSupport, 816 ySupport + hSupport, $B0B0B0, $FFFFFF); 817 RFrame(offscreen.Canvas, xSupport - 2, ySupport - 2, xSupport + wSupport + 1, 818 ySupport + hSupport + 1, $FFFFFF, $B0B0B0); 819 x := xSupport + wSupport div 2; 820 y := ySupport + hSupport div 2; 821 if Mode = mSupp then 822 begin 823 offscreen.Canvas.brush.Color := MainTexture.clMark; 824 offscreen.Canvas.FillRect(Rect(x - 27, y - 6, x + 27, y + 6)); 825 offscreen.Canvas.brush.style := bsClear; 826 end; 827 Sprite(offscreen, HGrSystem, x - 16, y - 5, 10, 10, 88, 115); 828 Sprite(offscreen, HGrSystem, x - 5, y - 5, 10, 10, 66, 115); 829 Sprite(offscreen, HGrSystem, x + 6, y - 5, 10, 10, 154, 126); 830 831 bitblt(offscreen.Canvas.Handle, xZoomMap, yZoomMap, wZoomMap, hZoomMap, 832 ZoomCityMap.Canvas.Handle, 0, 0, SRCCOPY); 833 834 for i := 0 to 5 do 835 imix[i] := -1; 836 if Mode = mImp then 837 begin 838 if ZoomArea = 5 then 839 begin 840 Cnt := 0; 841 for iix := 0 to nImp - 1 do 842 if ((iix < 28) or (ImpPosition[iix] < 0)) and (c.Built[iix] > 0) then 843 begin 844 i := Cnt - Page * 6; 845 if (i >= 0) and (i < 6) then 846 imix[i] := iix; 847 inc(Cnt); 848 end; 849 PageCount := (Cnt + 5) div 6; 850 end 851 else 852 begin 853 for iix := 28 to nImp - 1 do 854 begin 855 i := ImpPosition[iix] - 6 * ZoomArea; 856 if (i >= 0) and (i < 6) and (c.Built[iix] > 0) then 857 imix[i] := iix; 858 end; 859 PageCount := 0; 860 end; 861 for i := 0 to 5 do 862 if imix[i] >= 0 then 863 begin 864 iix := imix[i]; 865 x := xZoomMap + 14 + 72 * (i mod 3); 866 y := yZoomMap + 14 + 56 * (i div 3); 867 ImpImage(offscreen.Canvas, x, y, iix, cGov, AllowChange and 868 (ClientMode < scContact)); 869 if IsCityAlive then 870 begin 871 if iix = imColosseum then 872 begin 873 Sprite(offscreen, HGrSystem, x + 46, y, 14, 14, 82, 100); 874 end 875 else 876 begin 877 HappyGain := 0; 878 case iix of 879 0 .. 27, imTemple: 880 HappyGain := 2; 881 imTheater: 882 HappyGain := 4; 883 imCathedral: 884 if MyRO.Wonder[woBach].EffectiveOwner = cOwner then 885 HappyGain := 6 886 else 887 HappyGain := 4; 888 end; 889 if HappyGain > 1 then 890 begin 891 d := 30 div (HappyGain - 1); 892 if d > 10 then 893 d := 10 894 end; 895 for j := 0 to HappyGain - 1 do 896 Sprite(offscreen, HGrSystem, x + 50, y + d * j, 10, 10, 132, 126); 897 end; 898 for j := 0 to Imp[iix].Maint - 1 do 899 Sprite(offscreen, HGrSystem, x - 4, y + 29 - 3 * j, 10, 10, 900 132, 115); 901 end 902 end; 903 if imix[0] >= 0 then 904 Imp0Area.Hint := Phrases.Lookup('IMPROVEMENTS', imix[0]) 905 else 906 Imp0Area.Hint := ''; 907 if imix[1] >= 0 then 908 Imp1Area.Hint := Phrases.Lookup('IMPROVEMENTS', imix[1]) 909 else 910 Imp1Area.Hint := ''; 911 if imix[2] >= 0 then 912 Imp2Area.Hint := Phrases.Lookup('IMPROVEMENTS', imix[2]) 913 else 914 Imp2Area.Hint := ''; 915 if imix[3] >= 0 then 916 Imp3Area.Hint := Phrases.Lookup('IMPROVEMENTS', imix[3]) 917 else 918 Imp3Area.Hint := ''; 919 if imix[4] >= 0 then 920 Imp4Area.Hint := Phrases.Lookup('IMPROVEMENTS', imix[4]) 921 else 922 Imp4Area.Hint := ''; 923 if imix[5] >= 0 then 924 Imp5Area.Hint := Phrases.Lookup('IMPROVEMENTS', imix[5]) 925 else 926 Imp5Area.Hint := ''; 927 end 928 else { if mode=mSupp then } 929 begin 930 LoweredTextout(offscreen.Canvas, -1, MainTexture, xZoomMap + 6, 931 yZoomMap + 2, Phrases.Lookup('SUPUNITS')); 932 FreeSupp := c.Size * SupportFree[cGov] shr 1; 933 Cnt := 0; 934 for i := 0 to MyRO.nUn - 1 do 935 if (MyUn[i].Loc >= 0) and (MyUn[i].Home = cix) then 936 with MyModel[MyUn[i].mix] do 937 begin 938 Server(sGetUnitReport, me, i, UnitReport); 939 if (Cnt >= 6 * Page) and (Cnt < 6 * (Page + 1)) then 940 begin // unit visible in display 941 imix[Cnt - 6 * Page] := i; 942 x := ((Cnt - 6 * Page) mod 3) * 64 + xZoomMap; 943 y := ((Cnt - 6 * Page) div 3) * 52 + yZoomMap + 20; 944 MakeUnitInfo(me, MyUn[i], UnitInfo); 945 NoMap.SetOutput(offscreen); 946 NoMap.PaintUnit(x, y, UnitInfo, MyUn[i].Status); 947 948 for j := 0 to UnitReport.FoodSupport - 1 do 949 Sprite(offscreen, HGrSystem, x + 38 + 11 * j, y + 40, 10, 950 10, 66, 115); 951 for j := 0 to UnitReport.ProdSupport - 1 do 952 begin 953 if (FreeSupp > 0) and 954 (UnitReport.ReportFlags and urfAlwaysSupport = 0) then 955 begin 956 Sprite(offscreen, HGrSystem, x + 16 - 11 * j, y + 40, 10, 957 10, 143, 115); 958 dec(FreeSupp); 959 end 960 else 961 Sprite(offscreen, HGrSystem, x + 16 - 11 * j, y + 40, 10, 962 10, 88, 115); 963 end; 964 if UnitReport.ReportFlags and urfDeployed <> 0 then 965 for j := 0 to 1 do 966 Sprite(offscreen, HGrSystem, x + 27 + 11 * j, y + 40, 10, 967 10, 154, 126) 968 end // unit visible in display 969 else 970 dec(FreeSupp, UnitReport.ProdSupport); 971 inc(Cnt); 972 end; 973 PageCount := (Cnt + 5) div 6; 974 Imp0Area.Hint := ''; 975 Imp1Area.Hint := ''; 976 Imp2Area.Hint := ''; 977 Imp3Area.Hint := ''; 978 Imp4Area.Hint := ''; 979 Imp5Area.Hint := ''; 980 end; 981 PageUpBtn.Visible := PageCount > 1; 982 PageDownBtn.Visible := PageCount > 1; 983 984 with offscreen.Canvas do 985 begin 986 { display project now } 987 DLine(offscreen.Canvas, xView + 9 + xSizeBig, xProd + 2 * wBar + 10, 988 yProd + dyBar + 16, $FFFFFF, $B0B0B0); 989 if ProdHint then 990 begin 991 Frame(offscreen.Canvas, xView + 9 - 1, yView + 5 - 1, 992 xView + 9 + xSizeBig, yView + 5 + ySizeBig, $B0B0B0, $FFFFFF); 993 RFrame(offscreen.Canvas, xView + 9 - 2, yView + 5 - 2, 994 xView + 9 + xSizeBig + 1, yView + 5 + ySizeBig + 1, $FFFFFF, $B0B0B0); 995 with offscreen.Canvas do 996 begin 997 brush.Color := $000000; 998 FillRect(Rect(xView + 9, yView + 5, xView + 1 + 72 - 8, 999 yView + 5 + 40)); 1000 brush.style := bsClear; 1001 end 1002 end 1003 else if AllowChange and (c.Status and 7 <> 0) then 1004 begin // city type autobuild 1005 FrameImage(offscreen.Canvas, bigimp, xView + 9, yView + 5, xSizeBig, 1006 ySizeBig, (c.Status and 7 - 1 + 3) * xSizeBig, 0, (cix >= 0) and 1007 (ClientMode < scContact)); 1008 end 1009 else if c.Project and cpImp = 0 then 1010 begin // project is unit 1011 FrameImage(offscreen.Canvas, bigimp, xView + 9, yView + 5, xSizeBig, 1012 ySizeBig, 0, 0, AllowChange and (ClientMode < scContact)); 1013 with Tribe[cOwner].ModelPicture[c.Project and cpIndex] do 1014 Sprite(offscreen, HGr, xView + 5, yView + 1, 64, 44, 1015 pix mod 10 * 65 + 1, pix div 10 * 49 + 1); 1016 end 1017 else 1018 begin // project is building 1019 if ProdHint then 1020 Paintiix := c.Project0 and cpIndex 1021 else 1022 Paintiix := c.Project and cpIndex; 1023 ImpImage(offscreen.Canvas, xView + 9, yView + 5, Paintiix, cGov, 1024 AllowChange and (ClientMode < scContact)); 1025 end; 1026 end; 1027 1028 if AllowChange and (ClientMode < scContact) then 1029 begin 1030 i := Server(sBuyCityProject - sExecute, me, cix, nil^); 1031 BuyBtn.Visible := (i = eOk) or (i = eViolation); 1032 end 593 1033 else 594 begin 595 CountBar(offscreen,xHapp,yHapp+dyBar,wBar,17,Phrases.Lookup('HAPPINESS'), 596 Report.Morale,MainTexture); 597 CountBar(offscreen,xHapp,yHapp+2*dyBar,wBar,16,Phrases.Lookup('CONTROL'), 598 Report.CollectedControl,MainTexture); 599 end; 600 CountBar(offscreen,xHapp,yHapp,wBar,8,Phrases.Lookup('LUX'), 601 Report.Luxury,MainTexture); 602 CountBar(offscreen,xHapp+dxBar,yHapp,wBar,19,Phrases.Lookup('UNREST'), 603 2*Report.Deployed,MainTexture); 604 CountBar(offscreen,xHapp+dxBar,yHapp+dyBar,wBar,17,Phrases.Lookup('HAPPINESSDEMAND'), 605 c.Size,MainTexture); 606 if Report.HappinessBalance>=0 then 607 CountBar(offscreen,xHapp+dxBar,yHapp+2*dyBar,wBar,17,Phrases.Lookup('HAPPINESSPLUS'), 608 Report.HappinessBalance,MainTexture) 1034 BuyBtn.Visible := false; 1035 1036 MarkUsedOffscreen(ClientWidth, ClientHeight); 1037 end; { OffscreenPaint } 1038 1039 procedure TCityDlg.FormShow(Sender: TObject); 1040 var 1041 dx, dy, Loc1: integer; 1042 GetCityData: TGetCityData; 1043 begin 1044 BlinkTime := 5; 1045 if cix >= 0 then 1046 begin { own city } 1047 c := MyCity[cix]; 1048 cOwner := me; 1049 cGov := MyRO.Government; 1050 ProdHint := (cGov <> gAnarchy) and 1051 (Happened and (chProduction or chFounded or chCaptured or 1052 chAllImpsMade) <> 0); 1053 Server(sGetCityAreaInfo, me, cix, CityAreaInfo); 1054 NextCityBtn.Visible := WindowMode = wmPersistent; 1055 PrevCityBtn.Visible := WindowMode = wmPersistent; 1056 end 1057 else { enemy city } 1058 begin 1059 Mode := mImp; 1060 Server(sGetCity, me, cLoc, GetCityData); 1061 c := GetCityData.c; 1062 cOwner := GetCityData.Owner; 1063 cGov := MyRO.EnemyReport[cOwner].Government; 1064 Happened := c.Flags and $7FFFFFFF; 1065 ProdHint := false; 1066 Server(sGetEnemyCityAreaInfo, me, cLoc, CityAreaInfo); 1067 1068 if c.Project and cpImp = 0 then 1069 begin 1070 emix := MyRO.nEnemyModel - 1; 1071 while (emix > 0) and ((MyRO.EnemyModel[emix].Owner <> cOwner) or 1072 (integer(MyRO.EnemyModel[emix].mix) <> c.Project and cpIndex)) do 1073 dec(emix); 1074 if Tribe[cOwner].ModelPicture[c.Project and cpIndex].HGr = 0 then 1075 InitEnemyModel(emix); 1076 end; 1077 1078 NextCityBtn.Visible := false; 1079 PrevCityBtn.Visible := false; 1080 end; 1081 Page := 0; 1082 1083 if c.Size < 5 then 1084 SizeClass := 0 1085 else if c.Size < 9 then 1086 SizeClass := 1 1087 else if c.Size < 13 then 1088 SizeClass := 2 609 1089 else 610 begin 611 MakeRed(xHapp+dxBar-6,yHapp+2*dyBar,wBar+10,38); 612 CountBar(offscreen,xHapp+dxBar,yHapp+2*dyBar,wBar,18,Phrases.Lookup('LACK'), 613 -Report.HappinessBalance,RedTex); 614 end; 615 end; 616 617 // food section 618 if IsCityAlive then 619 begin 620 CountBar(offscreen,xFood,yFood+dyBar div 2,wBar,0,Phrases.Lookup('FOOD'),Report.CollectedFood,MainTexture); 621 CountBar(offscreen,xFood+dxBar,yFood+dyBar,wBar,0,Phrases.Lookup('DEMAND'),2*c.Size,MainTexture); 622 CountBar(offscreen,xFood+dxBar,yFood,wBar,0,Phrases.Lookup('SUPPORT'),Report.FoodSupport,MainTexture); 623 if Report.FoodSurplus>=0 then 624 if (cGov=gFuture) 625 or (c.Size>=NeedAqueductSize) and (Report.FoodSurplus<2) then 626 CountBar(offscreen,xFood+dxBar,yFood+2*dyBar,wBar,6,Phrases.Lookup('PROFIT'), 627 Report.FoodSurplus,MainTexture) 628 else CountBar(offscreen,xFood+dxBar,yFood+2*dyBar,wBar,0,Phrases.Lookup('SURPLUS'), 629 Report.FoodSurplus,MainTexture) 1090 SizeClass := 3; 1091 1092 // check if port 1093 IsPort := false; 1094 for dx := -2 to 2 do 1095 for dy := -2 to 2 do 1096 if abs(dx) + abs(dy) = 2 then 1097 begin 1098 Loc1 := dLoc(cLoc, dx, dy); 1099 if (Loc1 >= 0) and (Loc1 < G.lx * G.ly) and 1100 (MyMap[Loc1] and fTerrain < fGrass) then 1101 IsPort := true; 1102 end; 1103 1104 if WindowMode = wmModal then 1105 begin { center on screen } 1106 Left := (Screen.Width - Width) div 2; 1107 Top := (Screen.Height - Height) div 2; 1108 end; 1109 1110 Caption := CityName(c.ID); 1111 1112 InitSmallCityMap; 1113 InitZoomCityMap; 1114 OpenSoundEvent := -1; 1115 OffscreenPaint; 1116 Timer1.Enabled := true; 1117 end; 1118 1119 procedure TCityDlg.ShowNewContent(NewMode, Loc: integer; ShowEvent: cardinal); 1120 begin 1121 if MyMap[Loc] and fOwned <> 0 then 1122 begin // own city 1123 cix := MyRO.nCity - 1; 1124 while (cix >= 0) and (MyCity[cix].Loc <> Loc) do 1125 dec(cix); 1126 assert(cix >= 0); 1127 if (Optimize_cixTileChange >= 0) and 1128 (Optimize_TilesBeforeChange and not MyCity[Optimize_cixTileChange].Tiles 1129 <> 0) then 1130 begin 1131 CityOptimizer_ReleaseCityTiles(Optimize_cixTileChange, 1132 Optimize_TilesBeforeChange and 1133 not MyCity[Optimize_cixTileChange].Tiles); 1134 if WindowMode <> wmModal then 1135 MainScreen.UpdateViews; 1136 end; 1137 Optimize_cixTileChange := cix; 1138 Optimize_TilesBeforeChange := MyCity[cix].Tiles; 1139 end 630 1140 else 631 begin 632 MakeRed(xFood+dxBar-6,yFood+2*dyBar,wBar+10,38); 633 CountBar(offscreen,xFood+dxBar,yFood+2*dyBar,wBar,1,Phrases.Lookup('LACK'), 634 -Report.FoodSurplus,RedTex); 635 end; 636 end; 637 CanGrow:= (c.Size<MaxCitySize) and (cGov<>gFuture) 638 and (Report.FoodSurplus>0) 639 and ((c.Size<NeedAqueductSize) 640 or (c.Built[imAqueduct]=1) and (c.Size<NeedSewerSize) 641 or (c.Built[imSewer]=1)); 642 FillBar(xFood+3,yFood+102,TrueFood, 643 CutCityFoodSurplus(Report.FoodSurplus,IsCityAlive,cGov,c.size), 644 Report.Storage,1,CanGrow); 645 LoweredTextOut(offscreen.Canvas,-1,MainTexture,xFood+3-5,yFood+102-20,Format('%d/%d',[TrueFood,Report.Storage])); 646 LoweredTextOut(offscreen.Canvas,-1,MainTexture,xFood-2,yFood+66,Phrases.Lookup('STORAGE')); 647 648 // production section 649 if IsCityAlive then 650 begin 651 CountBar(offscreen,xProd,yProd,wBar,2,Phrases.Lookup('MATERIAL'), 652 Report.CollectedMaterial,MainTexture); 653 CountBar(offscreen,xProd+dxBar,yProd,wBar,2,Phrases.Lookup('SUPPORT'), 654 Report.MaterialSupport,MainTexture); 655 if Report.Production>=0 then 656 if c.Project and (cpImp+cpIndex)=cpImp+imTrGoods then 657 CountBar(offscreen,xProd+dxBar,yProd+dyBar+16,wBar,6,Phrases.Lookup('PROFIT'), 658 Report.Production,MainTexture) 659 else CountBar(offscreen,xProd+dxBar,yProd+dyBar+16,wBar,2,Phrases.Lookup('PROD'), 660 Report.Production,MainTexture) 661 else 662 begin 663 MakeRed(xProd+dxBar-6,yProd+dyBar,wBar+10,38); 664 CountBar(offscreen,xProd+dxBar,yProd+dyBar+16,wBar,3,Phrases.Lookup('LACK'), 665 -Report.Production,RedTex); 666 end; 667 end; 668 if c.Project and (cpImp+cpIndex)<>cpImp+imTrGoods then with offscreen.Canvas do 669 begin 670 i:=Report.Production; 671 if (i<0) or not IsCityAlive then i:=0; 672 FillBar(xProd+3,yProd+16+63,TrueProd,i,PrCost,4,true); 673 LoweredTextOut(offscreen.Canvas,-1,MainTexture,xProd+3-5,yProd+16+43, 674 Format('%d/%d',[TrueProd,PrCost])); 675 if BiColorTextWidth(offscreen.Canvas,PrName)>wBar+dxBar then 676 begin 677 repeat Delete(PrName,Length(PrName),1) 678 until BiColorTextWidth(offscreen.Canvas,PrName)<=wBar+dxBar; 679 PrName:=PrName+'.' 680 end; 681 end; 682 RisedTextOut(offscreen.Canvas,xProd-2,yProd+36,PrName); 683 684 // pollution section 685 if IsCityAlive and (Report.AddPollution>0) then 686 begin 687 FillBar(xPoll+3,yPoll+20,TruePoll,Report.AddPollution, 688 MaxPollution,3,true); 689 RisedTextOut(offscreen.Canvas,xPoll+3-5,yPoll+20-20,Phrases.Lookup('POLL')); 690 end; 691 692 // trade section 693 if IsCityAlive and (Report.CollectedTrade>0) then 694 begin 695 CountBar(offscreen,xTrade,yTrade+dyBar div 2,wBar,4,Phrases.Lookup('TRADE'),Report.CollectedTrade,MainTexture); 696 CountBar(offscreen,xTrade+dxBar,yTrade+2*dyBar,wBar,5,Phrases.Lookup('CORR'),Report.Corruption,MainTexture); 697 CountBar(offscreen,xTrade+dxBar,yTrade,wBar,6,Phrases.Lookup('TAX'),Report.Tax,MainTexture); 698 CountBar(offscreen,xTrade+dxBar,yTrade+dyBar,wBar,12,Phrases.Lookup('SCIENCE'),Report.Science,MainTexture); 699 end; 700 701 // small map 702 BitBlt(Offscreen.Canvas.Handle,xSmallMap,ySmallmap,wSmallMap,hSmallMap,SmallCitymap.Canvas.Handle,0,0,SRCCOPY); 703 if Mode=mImp then 704 Frame(Offscreen.Canvas,xSmallMap+48*(ZoomArea div 3),ySmallmap+24*(ZoomArea mod 3), 705 xSmallMap+48*(ZoomArea div 3)+49,ySmallmap+24*(ZoomArea mod 3)+25, 706 MainTexture.clMark,MainTexture.clMark); 707 Frame(Offscreen.Canvas,xSmallMap-1,ySmallmap-1,xSmallMap+wSmallMap,ySmallmap+hSmallMap,$B0B0B0,$FFFFFF); 708 RFrame(Offscreen.Canvas,xSmallMap-2,ySmallmap-2,xSmallMap+wSmallMap+1,ySmallmap+hSmallMap+1,$FFFFFF,$B0B0B0); 709 710 Frame(Offscreen.Canvas,xSupport-1,ySupport-1,xSupport+wSupport,ySupport+hSupport,$B0B0B0,$FFFFFF); 711 RFrame(Offscreen.Canvas,xSupport-2,ySupport-2,xSupport+wSupport+1,ySupport+hSupport+1,$FFFFFF,$B0B0B0); 712 x:=xSupport+wSupport div 2; 713 y:=ySupport+hSupport div 2; 714 if Mode=mSupp then 715 begin 716 Offscreen.Canvas.brush.Color:=MainTexture.clMark; 717 Offscreen.Canvas.FillRect(Rect(x-27,y-6,x+27,y+6)); 718 Offscreen.Canvas.brush.style:=bsClear; 719 end; 720 Sprite(offscreen,HGrSystem,x-16,y-5,10,10,88,115); 721 Sprite(offscreen,HGrSystem,x-5,y-5,10,10,66,115); 722 Sprite(offscreen,HGrSystem,x+6,y-5,10,10,154,126); 723 724 BitBlt(Offscreen.Canvas.Handle,xZoomMap,yZoommap,wZoomMap,hZoomMap,ZoomCitymap.Canvas.Handle,0,0,SRCCOPY); 725 726 for i:=0 to 5 do imix[i]:=-1; 727 if Mode=mImp then 728 begin 729 if ZoomArea=5 then 730 begin 731 Cnt:=0; 732 for iix:=0 to nImp-1 do 733 if ((iix<28) or (ImpPosition[iix]<0)) and (c.Built[iix]>0) then 1141 cix := -1; 1142 AllowChange := not supervising and (cix >= 0); 1143 cLoc := Loc; 1144 Happened := ShowEvent; 1145 inherited ShowNewContent(NewMode); 1146 end; 1147 1148 procedure TCityDlg.FormMouseDown(Sender: TObject; Button: TMouseButton; 1149 Shift: TShiftState; x, y: integer); 1150 var 1151 i, qx, qy, dx, dy, fix, NewTiles, Loc1, iix, SellResult: integer; 1152 Rebuild: boolean; 1153 begin 1154 if (ssLeft in Shift) and (x >= xSmallMap) and (x < xSmallMap + wSmallMap) and 1155 (y >= ySmallMap) and (y < ySmallMap + hSmallMap) then 1156 begin 1157 Mode := mImp; 1158 ZoomArea := (y - ySmallMap) * 3 div hSmallMap + 3 * 1159 ((x - xSmallMap) * 2 div wSmallMap); 1160 Page := 0; 1161 InitZoomCityMap; 1162 SmartUpdateContent; 1163 exit; 1164 end; 1165 if (ssLeft in Shift) and (x >= xSupport) and (x < xSupport + wSupport) and 1166 (y >= ySupport) and (y < ySupport + hSupport) then 1167 begin 1168 Mode := mSupp; 1169 Page := 0; 1170 InitZoomCityMap; 1171 SmartUpdateContent; 1172 exit; 1173 end; 1174 if not AllowChange then 1175 exit; // not an own city 1176 1177 if (ssLeft in Shift) then 1178 if (ClientMode < scContact) and (x >= xView) and (y >= yView) and 1179 (x < xView + 73) and (y < yView + 50) then 1180 if cGov = gAnarchy then 1181 with MessgExDlg do 734 1182 begin 735 i:=Cnt-Page*6; 736 if (i>=0) and (i<6) then 737 imix[i]:=iix; 738 inc(Cnt); 739 end; 740 PageCount:=(Cnt+5) div 6; 741 end 742 else 743 begin 744 for iix:=28 to nImp-1 do 745 begin 746 i:=ImpPosition[iix]-6*ZoomArea; 747 if (i>=0) and (i<6) and (c.Built[iix]>0) then 748 imix[i]:=iix; 749 end; 750 PageCount:=0; 751 end; 752 for i:=0 to 5 do if imix[i]>=0 then 753 begin 754 iix:=imix[i]; 755 x:=xZoomMap+14+72*(i mod 3); 756 y:=yZoomMap+14+56*(i div 3); 757 ImpImage(offscreen.Canvas,x,y,iix,cGov,AllowChange and (ClientMode<scContact)); 758 if IsCityAlive then 759 begin 760 if iix=imColosseum then 761 begin 762 Sprite(offscreen,HGrSystem,x+46,y,14,14,82,100); 1183 { MessgText:=Phrases.Lookup('OUTOFCONTROL'); 1184 if c.Project and cpImp=0 then 1185 MessgText:=Format(MessgText,[Tribe[cOwner].ModelName[c.Project and cpIndex]]) 1186 else MessgText:=Format(MessgText,[Phrases.Lookup('IMPROVEMENTS',c.Project and cpIndex)]); } 1187 MessgText := Phrases.Lookup('NOCHANGEINANARCHY'); 1188 Kind := mkOk; 1189 ShowModal; 763 1190 end 764 1191 else 1192 begin 1193 if ProdHint then 765 1194 begin 766 HappyGain:=0; 767 case iix of 768 0..27,imTemple: HappyGain:=2; 769 imTheater: HappyGain:=4; 770 imCathedral: 771 if MyRO.Wonder[woBach].EffectiveOwner=cOwner then HappyGain:=6 772 else HappyGain:=4; 773 end; 774 if HappyGain>1 then 775 begin d:=30 div(HappyGain-1);if d>10 then d:=10 end; 776 for j:=0 to HappyGain-1 do 777 Sprite(offscreen,HGrSystem,x+50,y+d*j,10,10,132,126); 1195 ProdHint := false; 1196 SmartUpdateContent 778 1197 end; 779 for j:=0 to Imp[iix].Maint-1 do 780 Sprite(offscreen,HGrSystem,x-4,y+29-3*j,10,10,132,115); 1198 ChooseProject; 781 1199 end 782 end; 783 if imix[0]>=0 then 784 Imp0Area.Hint:=Phrases.Lookup('IMPROVEMENTS',imix[0]) 785 else Imp0Area.Hint:=''; 786 if imix[1]>=0 then 787 Imp1Area.Hint:=Phrases.Lookup('IMPROVEMENTS',imix[1]) 788 else Imp1Area.Hint:=''; 789 if imix[2]>=0 then 790 Imp2Area.Hint:=Phrases.Lookup('IMPROVEMENTS',imix[2]) 791 else Imp2Area.Hint:=''; 792 if imix[3]>=0 then 793 Imp3Area.Hint:=Phrases.Lookup('IMPROVEMENTS',imix[3]) 794 else Imp3Area.Hint:=''; 795 if imix[4]>=0 then 796 Imp4Area.Hint:=Phrases.Lookup('IMPROVEMENTS',imix[4]) 797 else Imp4Area.Hint:=''; 798 if imix[5]>=0 then 799 Imp5Area.Hint:=Phrases.Lookup('IMPROVEMENTS',imix[5]) 800 else Imp5Area.Hint:=''; 801 end 802 else {if mode=mSupp then} 803 begin 804 LoweredTextOut(offscreen.Canvas,-1,MainTexture,xZoomMap+6,yZoomMap+2,Phrases.Lookup('SUPUNITS')); 805 FreeSupp:=c.Size*SupportFree[cGov] shr 1; 806 Cnt:=0; 807 for i:=0 to MyRO.nUn-1 do if (MyUn[i].Loc>=0) and (MyUn[i].Home=cix) then 808 with MyModel[MyUn[i].mix] do 1200 else if (Mode = mImp) and (x >= xZoomMap) and (x < xZoomMap + wZoomMap) and 1201 (y >= yZoomMap) and (y < yZoomMap + hZoomMap) then 1202 begin 1203 i := 5; 1204 while (i >= 0) and not((x >= xZoomMap + 14 + 72 * (i mod 3)) and 1205 (x < xZoomMap + 14 + 56 + 72 * (i mod 3)) and 1206 (y >= yZoomMap + 14 + 56 * (i div 3)) and 1207 (y < yZoomMap + 14 + 40 + 56 * (i div 3))) do 1208 dec(i); 1209 if i >= 0 then 809 1210 begin 810 Server(sGetUnitReport, me, i, UnitReport); 811 if (Cnt>=6*Page) and (Cnt<6*(Page+1)) then 812 begin // unit visible in display 813 imix[Cnt-6*Page]:=i; 814 x:=((Cnt-6*Page) mod 3)*64+xZoomMap; 815 y:=((Cnt-6*Page) div 3)*52+yZoomMap+20; 816 MakeUnitInfo(me,MyUn[i],UnitInfo); 817 NoMap.SetOutput(offscreen); 818 NoMap.PaintUnit(x,y,UnitInfo,MyUn[i].Status); 819 820 for j:=0 to UnitReport.FoodSupport-1 do 821 Sprite(offscreen,HGrSystem,x+38+11*j,y+40,10,10,66,115); 822 for j:=0 to UnitReport.ProdSupport-1 do 823 begin 824 if (FreeSupp>0) and (UnitReport.ReportFlags and urfAlwaysSupport=0) then 1211 iix := imix[i]; 1212 if iix >= 0 then 1213 if ssShift in Shift then 1214 HelpDlg.ShowNewContent(Mode or wmPersistent, hkImp, iix) 1215 else if (ClientMode < scContact) then 1216 with MessgExDlg do 825 1217 begin 826 Sprite(offscreen,HGrSystem,x+16-11*j,y+40,10,10,143,115); 827 dec(FreeSupp); 828 end 829 else Sprite(offscreen,HGrSystem,x+16-11*j,y+40,10,10,88,115); 830 end; 831 if UnitReport.ReportFlags and urfDeployed<>0 then 832 for j:=0 to 1 do 833 Sprite(offscreen,HGrSystem,x+27+11*j,y+40,10,10,154,126) 834 end // unit visible in display 835 else dec(FreeSupp, UnitReport.ProdSupport); 836 inc(Cnt); 837 end; 838 PageCount:=(Cnt+5) div 6; 839 Imp0Area.Hint:=''; 840 Imp1Area.Hint:=''; 841 Imp2Area.Hint:=''; 842 Imp3Area.Hint:=''; 843 Imp4Area.Hint:=''; 844 Imp5Area.Hint:=''; 845 end; 846 PageUpBtn.Visible:= PageCount>1; 847 PageDownBtn.Visible:= PageCount>1; 848 849 with offscreen.Canvas do 850 begin 851 {display project now} 852 DLine(offscreen.Canvas,xView+9+xSizeBig,xProd+2*wBar+10,yProd+dyBar+16, 853 $FFFFFF,$B0B0B0); 854 if prodhint then 855 begin 856 Frame(offscreen.canvas,xView+9-1,yView+5-1,xView+9+xSizeBig,yView+5+ySizeBig,$B0B0B0,$FFFFFF); 857 RFrame(offscreen.canvas,xView+9-2,yView+5-2,xView+9+xSizeBig+1,yView+5+ySizeBig+1,$FFFFFF,$B0B0B0); 858 with offscreen.canvas do 859 begin 860 Brush.Color:=$000000; 861 FillRect(Rect(xView+9,yView+5,xView+1+72-8,yView+5+40)); 862 Brush.Style:=bsClear; 863 end 864 end 865 else if AllowChange and (c.Status and 7<>0) then 866 begin // city type autobuild 867 FrameImage(offscreen.canvas,bigimp,xView+9,yView+5,xSizeBig,ySizeBig, 868 (c.Status and 7-1+3)*xSizeBig,0, 869 (cix>=0) and (ClientMode<scContact)); 870 end 871 else if c.Project and cpImp=0 then 872 begin // project is unit 873 FrameImage(offscreen.canvas,bigimp,xView+9,yView+5,xSizeBig,ySizeBig,0,0, 874 AllowChange and (ClientMode<scContact)); 875 with Tribe[cOwner].ModelPicture[c.Project and cpIndex] do 876 Sprite(offscreen,HGr,xView+5,yView+1,64,44, 877 pix mod 10 *65+1,pix div 10*49+1); 878 end 879 else 880 begin // project is building 881 if ProdHint then Paintiix:=c.Project0 and cpIndex 882 else Paintiix:=c.Project and cpIndex; 883 ImpImage(Offscreen.Canvas,xView+9,yView+5,Paintiix,cGov, 884 AllowChange and (ClientMode<scContact)); 885 end; 886 end; 887 888 if AllowChange and (ClientMode<scContact) then 889 begin 890 i:=Server(sBuyCityProject-sExecute,me,cix,nil^); 891 BuyBtn.Visible:= (i=eOk) or (i=eViolation); 892 end 893 else BuyBtn.Visible:=false; 894 895 MarkUsedOffscreen(ClientWidth,ClientHeight); 896 end;{OffscreenPaint} 897 898 procedure TCityDlg.FormShow(Sender: TObject); 899 var 900 dx,dy,Loc1: integer; 901 GetCityData: TGetCityData; 902 begin 903 BlinkTime:=5; 904 if cix>=0 then 905 begin {own city} 906 c:=MyCity[cix]; 907 cOwner:=me; 908 cGov:=MyRO.Government; 909 ProdHint:= (cGov<>gAnarchy) 910 and (Happened and (chProduction or chFounded or chCaptured or chAllImpsMade)<>0); 911 Server(sGetCityAreaInfo,me,cix,CityAreaInfo); 912 NextCityBtn.Visible:= WindowMode=wmPersistent; 913 PrevCityBtn.Visible:= WindowMode=wmPersistent; 914 end 915 else {enemy city} 916 begin 917 Mode:=mImp; 918 Server(sGetCity,me,cLoc,GetCityData); 919 c:=GetCityData.c; 920 cOwner:=GetCityData.Owner; 921 cGov:=MyRO.EnemyReport[cOwner].Government; 922 Happened:=c.Flags and $7FFFFFFF; 923 ProdHint:=false; 924 Server(sGetEnemyCityAreaInfo,me,cLoc,CityAreaInfo); 925 926 if c.Project and cpImp=0 then 927 begin 928 emix:=MyRO.nEnemyModel-1; 929 while (emix>0) and ((MyRO.EnemyModel[emix].Owner<>cOwner) 930 or (integer(MyRO.EnemyModel[emix].mix)<>c.Project and cpIndex)) do dec(emix); 931 if Tribe[cOwner].ModelPicture[c.Project and cpIndex].HGr=0 then 932 InitEnemyModel(emix); 933 end; 934 935 NextCityBtn.Visible:=false; 936 PrevCityBtn.Visible:=false; 937 end; 938 Page:=0; 939 940 if c.Size<5 then SizeClass:=0 941 else if c.Size<9 then SizeClass:=1 942 else if c.Size<13 then SizeClass:=2 943 else SizeClass:=3; 944 945 // check if port 946 IsPort:=false; 947 for dx:=-2 to 2 do for dy:=-2 to 2 do if abs(dx)+abs(dy)=2 then 948 begin 949 Loc1:=dLoc(cLoc,dx,dy); 950 if (Loc1>=0) and (Loc1<G.lx*G.ly) and (MyMap[Loc1] and fTerrain<fGrass) then 951 IsPort:=true; 952 end; 953 954 if WindowMode=wmModal then 955 begin {center on screen} 956 Left:=(Screen.Width-Width) div 2; 957 Top:=(Screen.Height-Height) div 2; 958 end; 959 960 Caption:=CityName(c.ID); 961 962 InitSmallCityMap; 963 InitZoomCityMap; 964 OpenSoundEvent:=-1; 965 OffscreenPaint; 966 Timer1.Enabled:=true; 967 end; 968 969 procedure TCityDlg.ShowNewContent(NewMode,Loc: integer; ShowEvent: cardinal); 970 begin 971 if MyMap[Loc] and fOwned<>0 then 972 begin // own city 973 cix:=MyRO.nCity-1; 974 while (cix>=0) and (MyCity[cix].Loc<>Loc) do dec(cix); 975 assert(cix>=0); 976 if (Optimize_cixTileChange>=0) 977 and (Optimize_TilesBeforeChange 978 and not MyCity[Optimize_cixTileChange].Tiles<>0) then 979 begin 980 CityOptimizer_ReleaseCityTiles(Optimize_cixTileChange, 981 Optimize_TilesBeforeChange and not MyCity[Optimize_cixTileChange].Tiles); 982 if WindowMode<>wmModal then 983 MainScreen.UpdateViews; 984 end; 985 Optimize_cixTileChange:=cix; 986 Optimize_TilesBeforeChange:=MyCity[cix].Tiles; 987 end 988 else cix:=-1; 989 AllowChange:=not supervising and (cix>=0); 990 cLoc:=Loc; 991 Happened:=ShowEvent; 992 inherited ShowNewContent(NewMode); 993 end; 994 995 procedure TCityDlg.FormMouseDown(Sender:TObject; 996 Button:TMouseButton;Shift:TShiftState;x,y:integer); 997 var 998 i,qx,qy,dx,dy,fix,NewTiles,Loc1,iix,SellResult: integer; 999 Rebuild: boolean; 1000 begin 1001 if (ssLeft in Shift) and (x>=xSmallMap) and (x<xSmallMap+wSmallMap) 1002 and (y>=ySmallMap) and (y<ySmallMap+hSmallMap) then 1003 begin 1004 Mode:=mImp; 1005 ZoomArea:=(y-ySmallMap)*3 div hSmallMap+3*((x-xSmallMap)*2 div wSmallMap); 1006 Page:=0; 1007 InitZoomCityMap; 1008 SmartUpdateContent; 1009 exit; 1010 end; 1011 if (ssLeft in Shift) and (x>=xSupport) and (x<xSupport+wSupport) 1012 and (y>=ySupport) and (y<ySupport+hSupport) then 1013 begin 1014 Mode:=mSupp; 1015 Page:=0; 1016 InitZoomCityMap; 1017 SmartUpdateContent; 1018 exit; 1019 end; 1020 if not AllowChange then exit; // not an own city 1021 1022 if (ssLeft in Shift) then 1023 if (ClientMode<scContact) 1024 and (x>=xView) and (y>=yView) and (x<xView+73) and (y<yView+50) then 1025 if cGov=gAnarchy then with MessgExDlg do 1026 begin 1027 { MessgText:=Phrases.Lookup('OUTOFCONTROL'); 1028 if c.Project and cpImp=0 then 1029 MessgText:=Format(MessgText,[Tribe[cOwner].ModelName[c.Project and cpIndex]]) 1030 else MessgText:=Format(MessgText,[Phrases.Lookup('IMPROVEMENTS',c.Project and cpIndex)]);} 1031 MessgText:=Phrases.Lookup('NOCHANGEINANARCHY'); 1032 Kind:=mkOk; 1033 ShowModal; 1034 end 1035 else 1036 begin 1037 if ProdHint then 1038 begin 1039 ProdHint:=false; 1040 SmartUpdateContent 1041 end; 1042 ChooseProject; 1043 end 1044 else if (Mode=mImp) and (x>=xZoomMap) and (x<xZoomMap+wZoomMap) 1045 and (y>=yZoomMap) and (y<yZoomMap+hZoomMap) then 1046 begin 1047 i:=5; 1048 while (i>=0) and 1049 not ((x>=xZoomMap+14+72*(i mod 3)) 1050 and (x<xZoomMap+14+56+72*(i mod 3)) 1051 and (y>=yZoomMap+14+56*(i div 3)) 1052 and (y<yZoomMap+14+40+56*(i div 3))) do 1053 dec(i); 1054 if i>=0 then 1055 begin 1056 iix:=imix[i]; 1057 if iix>=0 then 1058 if ssShift in Shift then 1059 HelpDlg.ShowNewContent(Mode or wmPersistent, hkImp, iix) 1060 else if (ClientMode<scContact) then with MessgExDlg do 1061 begin 1062 IconKind:=mikImp; 1063 IconIndex:=iix; 1064 if (iix=imPalace) or (Imp[iix].Kind=ikWonder) then 1065 begin 1066 MessgText:=Phrases.Lookup('IMPROVEMENTS',iix); 1067 if iix=woOracle then 1068 MessgText:=MessgText+'\'+Format(Phrases.Lookup('ORACLEINCOME'), 1069 [MyRO.OracleIncome]); 1070 Kind:=mkOk; 1071 ShowModal; 1072 end 1073 else 1074 begin 1075 SellResult:=Server(sSellCityImprovement-sExecute,me,cix,iix); 1076 if SellResult<rExecuted then 1218 IconKind := mikImp; 1219 IconIndex := iix; 1220 if (iix = imPalace) or (Imp[iix].Kind = ikWonder) then 1077 1221 begin 1078 if SellResult=eOnlyOnce then1079 MessgText:=Phrases.Lookup('NOSELLAGAIN')1080 else MessgText:=Phrases.Lookup('OUTOFCONTROL');1081 MessgText:=Format(MessgText,[Phrases.Lookup('IMPROVEMENTS',iix)]);1082 Kind:=mkOk;1083 ShowModal;1222 MessgText := Phrases.Lookup('IMPROVEMENTS', iix); 1223 if iix = woOracle then 1224 MessgText := MessgText + '\' + 1225 Format(Phrases.Lookup('ORACLEINCOME'), [MyRO.OracleIncome]); 1226 Kind := mkOk; 1227 ShowModal; 1084 1228 end 1085 else1229 else 1086 1230 begin 1087 if Server(sRebuildCityImprovement-sExecute,me,cix,iix)<rExecuted then 1088 begin // no rebuild possible, ask for sell only 1089 Rebuild:=false; 1090 MessgText:=Phrases.Lookup('IMPROVEMENTS',iix); 1091 if not Phrases2FallenBackToEnglish then 1092 MessgText:=Format(Phrases2.Lookup('SELL2'),[MessgText, 1093 Imp[iix].Cost*BuildCostMod[G.Difficulty[me]] div 12]) 1094 else MessgText:=Format(Phrases.Lookup('SELL'),[MessgText]); 1095 if iix=imSpacePort then with MyRO.Ship[me] do 1096 if Parts[0]+Parts[1]+Parts[2]>0 then 1097 MessgText:=MessgText+' '+Phrases.Lookup('SPDESTRUCTQUERY'); 1098 Kind:=mkYesNo; 1099 ShowModal; 1100 if ModalResult<>mrOK then iix:=-1 1231 SellResult := Server(sSellCityImprovement - sExecute, me, 1232 cix, iix); 1233 if SellResult < rExecuted then 1234 begin 1235 if SellResult = eOnlyOnce then 1236 MessgText := Phrases.Lookup('NOSELLAGAIN') 1237 else 1238 MessgText := Phrases.Lookup('OUTOFCONTROL'); 1239 MessgText := Format(MessgText, 1240 [Phrases.Lookup('IMPROVEMENTS', iix)]); 1241 Kind := mkOk; 1242 ShowModal; 1101 1243 end 1102 else1244 else 1103 1245 begin 1104 Rebuild:=true; 1105 MessgText:=Phrases.Lookup('IMPROVEMENTS',iix); 1106 if not Phrases2FallenBackToEnglish then 1107 MessgText:=Format(Phrases2.Lookup('DISPOSE2'),[MessgText, 1108 Imp[iix].Cost*BuildCostMod[G.Difficulty[me]] div 12 *2 div 3]) 1109 else MessgText:=Format(Phrases.Lookup('DISPOSE'),[MessgText]); 1110 if iix=imSpacePort then with MyRO.Ship[me] do 1111 if Parts[0]+Parts[1]+Parts[2]>0 then 1112 MessgText:=MessgText+' '+Phrases.Lookup('SPDESTRUCTQUERY'); 1113 Kind:=mkYesNo; 1114 ShowModal; 1115 if ModalResult<>mrOK then iix:=-1 1116 end; 1117 if iix>=0 then 1118 begin 1119 if Rebuild then 1246 if Server(sRebuildCityImprovement - sExecute, me, cix, iix) < rExecuted 1247 then 1248 begin // no rebuild possible, ask for sell only 1249 Rebuild := false; 1250 MessgText := Phrases.Lookup('IMPROVEMENTS', iix); 1251 if not Phrases2FallenBackToEnglish then 1252 MessgText := Format(Phrases2.Lookup('SELL2'), 1253 [MessgText, Imp[iix].Cost * BuildCostMod 1254 [G.Difficulty[me]] div 12]) 1255 else 1256 MessgText := Format(Phrases.Lookup('SELL'), [MessgText]); 1257 if iix = imSpacePort then 1258 with MyRO.Ship[me] do 1259 if Parts[0] + Parts[1] + Parts[2] > 0 then 1260 MessgText := MessgText + ' ' + 1261 Phrases.Lookup('SPDESTRUCTQUERY'); 1262 Kind := mkYesNo; 1263 ShowModal; 1264 if ModalResult <> mrOK then 1265 iix := -1 1266 end 1267 else 1120 1268 begin 1121 Play('CITY_REBUILDIMP'); 1122 Server(sRebuildCityImprovement,me,cix,iix); 1269 Rebuild := true; 1270 MessgText := Phrases.Lookup('IMPROVEMENTS', iix); 1271 if not Phrases2FallenBackToEnglish then 1272 MessgText := Format(Phrases2.Lookup('DISPOSE2'), 1273 [MessgText, Imp[iix].Cost * BuildCostMod 1274 [G.Difficulty[me]] div 12 * 2 div 3]) 1275 else 1276 MessgText := Format(Phrases.Lookup('DISPOSE'), 1277 [MessgText]); 1278 if iix = imSpacePort then 1279 with MyRO.Ship[me] do 1280 if Parts[0] + Parts[1] + Parts[2] > 0 then 1281 MessgText := MessgText + ' ' + 1282 Phrases.Lookup('SPDESTRUCTQUERY'); 1283 Kind := mkYesNo; 1284 ShowModal; 1285 if ModalResult <> mrOK then 1286 iix := -1 1287 end; 1288 if iix >= 0 then 1289 begin 1290 if Rebuild then 1291 begin 1292 Play('CITY_REBUILDIMP'); 1293 Server(sRebuildCityImprovement, me, cix, iix); 1294 end 1295 else 1296 begin 1297 Play('CITY_SELLIMP'); 1298 Server(sSellCityImprovement, me, cix, iix); 1299 end; 1300 CityOptimizer_CityChange(cix); 1301 InitSmallCityMap; 1302 SmartUpdateContent; 1303 if WindowMode <> wmModal then 1304 MainScreen.UpdateViews; 1123 1305 end 1124 else1125 begin1126 Play('CITY_SELLIMP');1127 Server(sSellCityImprovement,me,cix,iix);1128 end;1129 CityOptimizer_CityChange(cix);1130 InitSmallCityMap;1131 SmartUpdateContent;1132 if WindowMode<>wmModal then1133 MainScreen.UpdateViews;1134 1306 end 1135 1307 end 1136 1308 end 1137 end1138 1309 end 1139 1310 end 1140 else if (Mode=mSupp) and (x>=xZoomMap) and (x<xZoomMap+wZoomMap)1141 and (y>=yZoomMap) and (y<yZoomMap+hZoomMap) then1142 begin 1143 i:=5;1144 while (i>=0) and1145 not ((x>=xZoomMap+64*(i mod 3))1146 and (x<xZoomMap+64+64*(i mod 3))1147 and (y>=yZoomMap+20+48*(i div 3))1148 and (y<yZoomMap+20+52+48*(i div 3))) do1149 dec(i);1150 if (i>=0) and (imix[i]>=0)then1151 if ssShift in Shift then1152 else if (cix>=0) and (ClientMode<scContact) and (WindowMode<>wmModal) then1311 else if (Mode = mSupp) and (x >= xZoomMap) and (x < xZoomMap + wZoomMap) and 1312 (y >= yZoomMap) and (y < yZoomMap + hZoomMap) then 1313 begin 1314 i := 5; 1315 while (i >= 0) and not((x >= xZoomMap + 64 * (i mod 3)) and 1316 (x < xZoomMap + 64 + 64 * (i mod 3)) and 1317 (y >= yZoomMap + 20 + 48 * (i div 3)) and 1318 (y < yZoomMap + 20 + 52 + 48 * (i div 3))) do 1319 dec(i); 1320 if (i >= 0) and (imix[i] >= 0) then 1321 if ssShift in Shift then 1322 else if (cix >= 0) and (ClientMode < scContact) and 1323 (WindowMode <> wmModal) then 1153 1324 begin 1154 CloseAction:=None;1155 Close;1156 MainScreen.CityClosed(imix[i],false,true);1325 CloseAction := None; 1326 Close; 1327 MainScreen.CityClosed(imix[i], false, true); 1157 1328 end 1158 1329 end 1159 else if (x>=xmArea-192) and (x<xmArea+192) and (y>=ymArea-96) and (y<ymArea+96) then 1160 begin 1161 qx:=((4000*xxt*yyt)+(x-xmArea)*(yyt*2)+(y-ymArea+yyt)*(xxt*2)) div (xxt*yyt*4)-1000; 1162 qy:=((4000*xxt*yyt)+(y-ymArea+yyt)*(xxt*2)-(x-xmArea)*(yyt*2)) div (xxt*yyt*4)-1000; 1163 dx:=qx-qy; 1164 dy:=qx+qy; 1165 if (dx>=-3) and (dx<=3) and (dy>=-3) and (dy<=3) and (dx*dx*dy*dy<81) 1166 and ((dx<>0) or (dy<>0)) then 1167 if ssShift in Shift then 1330 else if (x >= xmArea - 192) and (x < xmArea + 192) and (y >= ymArea - 96) 1331 and (y < ymArea + 96) then 1332 begin 1333 qx := ((4000 * xxt * yyt) + (x - xmArea) * (yyt * 2) + (y - ymArea + yyt) 1334 * (xxt * 2)) div (xxt * yyt * 4) - 1000; 1335 qy := ((4000 * xxt * yyt) + (y - ymArea + yyt) * (xxt * 2) - (x - xmArea) 1336 * (yyt * 2)) div (xxt * yyt * 4) - 1000; 1337 dx := qx - qy; 1338 dy := qx + qy; 1339 if (dx >= -3) and (dx <= 3) and (dy >= -3) and (dy <= 3) and 1340 (dx * dx * dy * dy < 81) and ((dx <> 0) or (dy <> 0)) then 1341 if ssShift in Shift then 1168 1342 begin // terrain help 1169 Loc1:=dLoc(cLoc,dx,dy);1170 if (Loc1>=0) and (Loc1<G.lx*G.ly) then1171 HelpOnTerrain(Loc1, Mode or wmPersistent)1343 Loc1 := dLoc(cLoc, dx, dy); 1344 if (Loc1 >= 0) and (Loc1 < G.lx * G.ly) then 1345 HelpOnTerrain(Loc1, Mode or wmPersistent) 1172 1346 end 1173 else if (ClientMode<scContact) and (cGov<>gAnarchy)1174 and (c.Flags and chCaptured=0) then1347 else if (ClientMode < scContact) and (cGov <> gAnarchy) and 1348 (c.Flags and chCaptured = 0) then 1175 1349 begin // toggle exploitation 1176 assert(not supervising);1177 if c.Status and csResourceWeightsMask<>0 then1350 assert(not supervising); 1351 if c.Status and csResourceWeightsMask <> 0 then 1178 1352 begin 1179 with MessgExDlg do1353 with MessgExDlg do 1180 1354 begin 1181 MessgText:=Phrases.Lookup('CITYMANAGEOFF');1182 OpenSound:='MSG_DEFAULT';1183 Kind:=mkOkCancel;1184 IconKind:=mikFullControl;1185 ShowModal;1355 MessgText := Phrases.Lookup('CITYMANAGEOFF'); 1356 OpenSound := 'MSG_DEFAULT'; 1357 Kind := mkOkCancel; 1358 IconKind := mikFullControl; 1359 ShowModal; 1186 1360 end; 1187 if MessgExDlg.ModalResult=mrOK then1361 if MessgExDlg.ModalResult = mrOK then 1188 1362 begin 1189 MyCity[cix].Status:=MyCity[cix].Status1190 andnot csResourceWeightsMask; // off1191 c.Status:=MyCity[cix].Status;1192 SmartUpdateContent1363 MyCity[cix].Status := MyCity[cix].Status and 1364 not csResourceWeightsMask; // off 1365 c.Status := MyCity[cix].Status; 1366 SmartUpdateContent 1193 1367 end; 1194 exit;1368 exit; 1195 1369 end; 1196 fix:=(dy+3) shl 2+(dx+3) shr 1;1197 NewTiles:=MyCity[cix].Tiles xor (1 shl fix);1198 if Server(sSetCityTiles,me,cix,NewTiles)>=rExecuted then1370 fix := (dy + 3) shl 2 + (dx + 3) shr 1; 1371 NewTiles := MyCity[cix].Tiles xor (1 shl fix); 1372 if Server(sSetCityTiles, me, cix, NewTiles) >= rExecuted then 1199 1373 begin 1200 SmartUpdateContent;1201 if WindowMode<>wmModal then1202 MainScreen.UpdateViews;1374 SmartUpdateContent; 1375 if WindowMode <> wmModal then 1376 MainScreen.UpdateViews; 1203 1377 end 1204 1378 end 1205 1379 end 1206 else if (ClientMode<scContact) and (cGov<>gAnarchy) and (c.Flags and chCaptured=0) 1207 and (x>=xmOpt-32) and (x<xmOpt+32) and (y>=ymOpt-32) and (y<ymOpt+32) then 1208 begin 1209 i:=sqr(x-xmOpt)+sqr(y-ymOpt); // click radius 1210 if i<=32*32 then 1380 else if (ClientMode < scContact) and (cGov <> gAnarchy) and 1381 (c.Flags and chCaptured = 0) and (x >= xmOpt - 32) and (x < xmOpt + 32) 1382 and (y >= ymOpt - 32) and (y < ymOpt + 32) then 1383 begin 1384 i := sqr(x - xmOpt) + sqr(y - ymOpt); // click radius 1385 if i <= 32 * 32 then 1211 1386 begin 1212 if i<16*16 then // inner area clicked 1213 if c.Status and csResourceWeightsMask<>0 then 1214 i:=(c.Status shr 4 and $0F) mod 5 +1 // rotate except off 1215 else i:=3 // rwGrowth 1216 else case trunc(arctan2(x-xmOpt,ymOpt-y)*180/pi) of 1217 -25-52*2..-26-52: i:=1; 1218 -25-52..-26: i:=2; 1219 -25..25: i:=3; 1220 26..25+52: i:=4; 1221 26+52..25+52*2: i:=5; 1222 180-26..180,-180..-180+26: i:=0; 1223 else i:=-1; 1224 end; 1225 if i>=0 then 1387 if i < 16 * 16 then // inner area clicked 1388 if c.Status and csResourceWeightsMask <> 0 then 1389 i := (c.Status shr 4 and $0F) mod 5 + 1 // rotate except off 1390 else 1391 i := 3 // rwGrowth 1392 else 1393 case trunc(arctan2(x - xmOpt, ymOpt - y) * 180 / pi) of 1394 - 25 - 52 * 2 .. -26 - 52: 1395 i := 1; 1396 -25 - 52 .. -26: 1397 i := 2; 1398 -25 .. 25: 1399 i := 3; 1400 26 .. 25 + 52: 1401 i := 4; 1402 26 + 52 .. 25 + 52 * 2: 1403 i := 5; 1404 180 - 26 .. 180, -180 .. -180 + 26: 1405 i := 0; 1406 else 1407 i := -1; 1408 end; 1409 if i >= 0 then 1226 1410 begin 1227 ChangeResourceWeights(i);1228 SmartUpdateContent;1229 if WindowMode<>wmModal then1230 MainScreen.UpdateViews;1411 ChangeResourceWeights(i); 1412 SmartUpdateContent; 1413 if WindowMode <> wmModal then 1414 MainScreen.UpdateViews; 1231 1415 end 1232 1416 end 1233 1417 end; 1234 end; {FormMouseDown}1418 end; { FormMouseDown } 1235 1419 1236 1420 procedure TCityDlg.ChooseProject; 1237 1421 const 1238 ptSelect=0; ptTrGoods=1; ptUn=2; ptCaravan=3; ptImp=4; ptWonder=6; 1239 ptShip=7; ptInvalid=8; 1422 ptSelect = 0; 1423 ptTrGoods = 1; 1424 ptUn = 2; 1425 ptCaravan = 3; 1426 ptImp = 4; 1427 ptWonder = 6; 1428 ptShip = 7; 1429 ptInvalid = 8; 1240 1430 1241 1431 function ProjectType(Project: integer): integer; 1242 1432 begin 1243 if Project and cpCompleted<>0 then result:=ptSelect 1244 else if Project and (cpImp+cpIndex)=cpImp+imTrGoods then result:=ptTrGoods 1245 else if Project and cpImp=0 then 1246 if MyModel[Project and cpIndex].Kind=mkCaravan then result:=ptCaravan 1247 else result:=ptUn 1248 else if Project and cpIndex>=nImp then result:=ptInvalid 1249 else if Imp[Project and cpIndex].Kind=ikWonder then result:=ptWonder 1250 else if Imp[Project and cpIndex].Kind=ikShipPart then result:=ptShip 1251 else result:=ptImp 1433 if Project and cpCompleted <> 0 then 1434 result := ptSelect 1435 else if Project and (cpImp + cpIndex) = cpImp + imTrGoods then 1436 result := ptTrGoods 1437 else if Project and cpImp = 0 then 1438 if MyModel[Project and cpIndex].Kind = mkCaravan then 1439 result := ptCaravan 1440 else 1441 result := ptUn 1442 else if Project and cpIndex >= nImp then 1443 result := ptInvalid 1444 else if Imp[Project and cpIndex].Kind = ikWonder then 1445 result := ptWonder 1446 else if Imp[Project and cpIndex].Kind = ikShipPart then 1447 result := ptShip 1448 else 1449 result := ptImp 1252 1450 end; 1253 1451 1254 1452 var 1255 NewProject, OldMoney,pt0,pt1,cix1: integer;1256 QueryOk: boolean;1257 begin 1258 assert(not supervising);1259 ModalSelectDlg.ShowNewContent_CityProject(wmModal,cix);1260 if ModalSelectDlg.result<>-1 then1261 begin 1262 if ModalSelectDlg.result and cpType<>0 then1263 begin 1264 MyCity[cix].Status:=MyCity[cix].Status and not 71265 or (1+ModalSelectDlg.result and cpIndex);1266 AutoBuild(cix, MyData.ImpOrder[ModalSelectDlg.result and cpIndex]);1453 NewProject, OldMoney, pt0, pt1, cix1: integer; 1454 QueryOk: boolean; 1455 begin 1456 assert(not supervising); 1457 ModalSelectDlg.ShowNewContent_CityProject(wmModal, cix); 1458 if ModalSelectDlg.result <> -1 then 1459 begin 1460 if ModalSelectDlg.result and cpType <> 0 then 1461 begin 1462 MyCity[cix].Status := MyCity[cix].Status and not 7 or 1463 (1 + ModalSelectDlg.result and cpIndex); 1464 AutoBuild(cix, MyData.ImpOrder[ModalSelectDlg.result and cpIndex]); 1267 1465 end 1268 else1269 begin 1270 NewProject:=ModalSelectDlg.result;1271 QueryOk:=true;1272 if (NewProject and cpImp<>0) and (NewProject and cpIndex>=28)1273 and (MyRO.NatBuilt[NewProject and cpIndex]>0) then1274 with MessgExDlg do1466 else 1467 begin 1468 NewProject := ModalSelectDlg.result; 1469 QueryOk := true; 1470 if (NewProject and cpImp <> 0) and (NewProject and cpIndex >= 28) and 1471 (MyRO.NatBuilt[NewProject and cpIndex] > 0) then 1472 with MessgExDlg do 1275 1473 begin 1276 cix1:=MyRO.nCity-1; 1277 while (cix1>=0) and (MyCity[cix1].Built[NewProject and cpIndex]=0) do 1278 dec(cix1); 1279 MessgText:=Format(Phrases.Lookup('DOUBLESTATEIMP'), 1280 [Phrases.Lookup('IMPROVEMENTS', NewProject and cpIndex), 1281 CityName(MyCity[cix1].ID)]); 1282 OpenSound:='MSG_DEFAULT'; 1283 Kind:=mkOkCancel; 1284 IconKind:=mikImp; 1285 IconIndex:=NewProject and cpIndex; 1286 ShowModal; 1287 QueryOk:= ModalResult=mrOK; 1474 cix1 := MyRO.nCity - 1; 1475 while (cix1 >= 0) and 1476 (MyCity[cix1].Built[NewProject and cpIndex] = 0) do 1477 dec(cix1); 1478 MessgText := Format(Phrases.Lookup('DOUBLESTATEIMP'), 1479 [Phrases.Lookup('IMPROVEMENTS', NewProject and cpIndex), 1480 CityName(MyCity[cix1].ID)]); 1481 OpenSound := 'MSG_DEFAULT'; 1482 Kind := mkOkCancel; 1483 IconKind := mikImp; 1484 IconIndex := NewProject and cpIndex; 1485 ShowModal; 1486 QueryOk := ModalResult = mrOK; 1288 1487 end; 1289 if not QueryOk then1290 exit;1291 1292 if (MyCity[cix].Prod>0) then1488 if not QueryOk then 1489 exit; 1490 1491 if (MyCity[cix].Prod > 0) then 1293 1492 begin 1294 pt0:=ProjectType(MyCity[cix].Project0);1295 pt1:=ProjectType(NewProject);1296 if (pt0<>ptSelect) and (pt1<>ptTrGoods) then1493 pt0 := ProjectType(MyCity[cix].Project0); 1494 pt1 := ProjectType(NewProject); 1495 if (pt0 <> ptSelect) and (pt1 <> ptTrGoods) then 1297 1496 begin 1298 if NewProject and (cpImp or cpIndex)<>MyCity[cix].Project0 and (cpImp or cpIndex) then 1497 if NewProject and (cpImp or cpIndex) <> MyCity[cix].Project0 and 1498 (cpImp or cpIndex) then 1299 1499 begin // loss of material -- do query 1300 if (pt1=ptTrGoods) or (pt1=ptShip) or (pt1<>pt0) and (pt0<>ptCaravan) then 1301 QueryOk:=SimpleQuery(mkOkCancel,Format(Phrases.Lookup('LOSEMAT'), 1302 [MyCity[cix].Prod0,MyCity[cix].Prod0]),'MSG_DEFAULT')=mrOK 1303 else if MyCity[cix].Project and (cpImp or cpIndex)=MyCity[cix].Project0 and (cpImp or cpIndex) then 1304 QueryOk:=SimpleQuery(mkOkCancel,Phrases.Lookup('LOSEMAT3'),'MSG_DEFAULT')=mrOK 1500 if (pt1 = ptTrGoods) or (pt1 = ptShip) or (pt1 <> pt0) and 1501 (pt0 <> ptCaravan) then 1502 QueryOk := SimpleQuery(mkOkCancel, 1503 Format(Phrases.Lookup('LOSEMAT'), [MyCity[cix].Prod0, 1504 MyCity[cix].Prod0]), 'MSG_DEFAULT') = mrOK 1505 else if MyCity[cix].Project and (cpImp or cpIndex) = MyCity[cix] 1506 .Project0 and (cpImp or cpIndex) then 1507 QueryOk := SimpleQuery(mkOkCancel, Phrases.Lookup('LOSEMAT3'), 1508 'MSG_DEFAULT') = mrOK 1305 1509 end; 1306 1510 end 1307 1511 end; 1308 if not QueryOk then 1309 exit; 1310 1311 OldMoney:=MyRO.Money; 1312 MyCity[cix].Status:=MyCity[cix].Status and not 7; 1313 if (NewProject and cpImp=0) 1314 and ((MyCity[cix].Size<4) and (MyModel[NewProject and cpIndex].Kind=mkSettler) 1315 or (MyCity[cix].Size<3) and ((MyModel[NewProject and cpIndex].Kind=mkSlaves) 1316 or (NewProject and cpConscripts<>0))) then 1317 if SimpleQuery(mkYesNo,Phrases.Lookup('EMIGRATE'),'MSG_DEFAULT')<>mrOK then 1318 NewProject:=NewProject or cpDisbandCity; 1319 Server(sSetCityProject,me,cix,NewProject); 1320 c.Project:=MyCity[cix].Project; 1321 if MyRO.Money>OldMoney then 1322 Play('CITY_SELLIMP'); 1323 end; 1324 CityOptimizer_CityChange(cix); 1325 1326 if WindowMode<>wmModal then 1327 MainScreen.UpdateViews; 1328 InitSmallCityMap; 1329 SmartUpdateContent; 1330 end; 1331 end; 1332 1333 procedure TCityDlg.BuyClick(Sender:TObject); 1512 if not QueryOk then 1513 exit; 1514 1515 OldMoney := MyRO.Money; 1516 MyCity[cix].Status := MyCity[cix].Status and not 7; 1517 if (NewProject and cpImp = 0) and 1518 ((MyCity[cix].Size < 4) and 1519 (MyModel[NewProject and cpIndex].Kind = mkSettler) or 1520 (MyCity[cix].Size < 3) and 1521 ((MyModel[NewProject and cpIndex].Kind = mkSlaves) or 1522 (NewProject and cpConscripts <> 0))) then 1523 if SimpleQuery(mkYesNo, Phrases.Lookup('EMIGRATE'), 'MSG_DEFAULT') <> mrOK 1524 then 1525 NewProject := NewProject or cpDisbandCity; 1526 Server(sSetCityProject, me, cix, NewProject); 1527 c.Project := MyCity[cix].Project; 1528 if MyRO.Money > OldMoney then 1529 Play('CITY_SELLIMP'); 1530 end; 1531 CityOptimizer_CityChange(cix); 1532 1533 if WindowMode <> wmModal then 1534 MainScreen.UpdateViews; 1535 InitSmallCityMap; 1536 SmartUpdateContent; 1537 end; 1538 end; 1539 1540 procedure TCityDlg.BuyClick(Sender: TObject); 1334 1541 var 1335 NextProd,Cost:integer; 1336 begin 1337 if (cix<0) or (ClientMode>=scContact) then exit; 1338 with MyCity[cix],MessgExDlg do 1339 begin 1340 Cost:=Report.ProjectCost; 1341 NextProd:=Report.Production; 1342 if NextProd<0 then NextProd:=0; 1343 Cost:=Cost-Prod-NextProd; 1344 if (MyRO.Wonder[woMich].EffectiveOwner=me) and (Project and cpImp<>0) then 1345 Cost:=Cost*2 1346 else Cost:=Cost*4; 1347 if (Cost<=0) and (Report.HappinessBalance>=0) {no disorder} then 1348 begin MessgText:=Phrases.Lookup('READY'); Kind:=mkOK; end 1349 else if Cost>MyRO.Money then 1350 begin 1351 OpenSound:='MSG_DEFAULT'; 1352 MessgText:=Format(Phrases.Lookup('NOMONEY'),[Cost,MyRO.Money]); 1353 Kind:=mkOK; 1542 NextProd, Cost: integer; 1543 begin 1544 if (cix < 0) or (ClientMode >= scContact) then 1545 exit; 1546 with MyCity[cix], MessgExDlg do 1547 begin 1548 Cost := Report.ProjectCost; 1549 NextProd := Report.Production; 1550 if NextProd < 0 then 1551 NextProd := 0; 1552 Cost := Cost - Prod - NextProd; 1553 if (MyRO.Wonder[woMich].EffectiveOwner = me) and (Project and cpImp <> 0) 1554 then 1555 Cost := Cost * 2 1556 else 1557 Cost := Cost * 4; 1558 if (Cost <= 0) and (Report.HappinessBalance >= 0) { no disorder } then 1559 begin 1560 MessgText := Phrases.Lookup('READY'); 1561 Kind := mkOk; 1354 1562 end 1355 else begin MessgText:=Format(Phrases.Lookup('BUY'),[Cost]); Kind:=mkYesNo; end; 1356 ShowModal; 1357 if (Kind=mkYesNo) and (ModalResult=mrOK) then 1358 begin 1359 if Server(sBuyCityProject,me,cix,nil^)>=rExecuted then 1563 else if Cost > MyRO.Money then 1564 begin 1565 OpenSound := 'MSG_DEFAULT'; 1566 MessgText := Format(Phrases.Lookup('NOMONEY'), [Cost, MyRO.Money]); 1567 Kind := mkOk; 1568 end 1569 else 1570 begin 1571 MessgText := Format(Phrases.Lookup('BUY'), [Cost]); 1572 Kind := mkYesNo; 1573 end; 1574 ShowModal; 1575 if (Kind = mkYesNo) and (ModalResult = mrOK) then 1576 begin 1577 if Server(sBuyCityProject, me, cix, nil^) >= rExecuted then 1360 1578 begin 1361 Play('CITY_BUYPROJECT');1362 SmartUpdateContent;1363 if WindowMode<>wmModal then1364 MainScreen.UpdateViews;1579 Play('CITY_BUYPROJECT'); 1580 SmartUpdateContent; 1581 if WindowMode <> wmModal then 1582 MainScreen.UpdateViews; 1365 1583 end 1366 1584 end … … 1370 1588 procedure TCityDlg.FormClose(Sender: TObject; var Action: TCloseAction); 1371 1589 begin 1372 Timer1.Enabled:=false; 1373 ProdHint:=false; 1374 MarkCityLoc:=-1; 1375 if Optimize_cixTileChange>=0 then 1376 begin 1377 if Optimize_TilesBeforeChange 1378 and not MyCity[Optimize_cixTileChange].Tiles<>0 then 1379 begin 1380 CityOptimizer_ReleaseCityTiles(Optimize_cixTileChange, 1381 Optimize_TilesBeforeChange and not MyCity[Optimize_cixTileChange].Tiles); 1382 if WindowMode<>wmModal then 1383 MainScreen.UpdateViews; 1384 end; 1385 Optimize_cixTileChange:=-1; 1386 end; 1387 if CloseAction>None then 1388 MainScreen.CityClosed(RestoreUnFocus,CloseAction=StepFocus); 1389 RestoreUnFocus:=-1; 1390 inherited; 1590 Timer1.Enabled := false; 1591 ProdHint := false; 1592 MarkCityLoc := -1; 1593 if Optimize_cixTileChange >= 0 then 1594 begin 1595 if Optimize_TilesBeforeChange and not MyCity[Optimize_cixTileChange] 1596 .Tiles <> 0 then 1597 begin 1598 CityOptimizer_ReleaseCityTiles(Optimize_cixTileChange, 1599 Optimize_TilesBeforeChange and 1600 not MyCity[Optimize_cixTileChange].Tiles); 1601 if WindowMode <> wmModal then 1602 MainScreen.UpdateViews; 1603 end; 1604 Optimize_cixTileChange := -1; 1605 end; 1606 if CloseAction > None then 1607 MainScreen.CityClosed(RestoreUnFocus, CloseAction = StepFocus); 1608 RestoreUnFocus := -1; 1609 inherited; 1391 1610 end; 1392 1611 1393 1612 procedure TCityDlg.Timer1Timer(Sender: TObject); 1394 1613 begin 1395 if ProdHint then 1396 begin 1397 BlinkTime:=(BlinkTime+1) mod 12; 1398 if BlinkTime=0 then with Canvas do 1399 begin 1400 BitBlt(canvas.Handle,xView+5,yView+1,64,2, 1401 back.Canvas.Handle,xView+5,yView+1,SRCCOPY); 1402 BitBlt(canvas.Handle,xView+5,yView+3,2,42, 1403 back.Canvas.Handle,xView+5,yView+3,SRCCOPY); 1404 BitBlt(canvas.Handle,xView+5+62,yView+3,2,42, 1405 back.Canvas.Handle,xView+5+62,yView+3,SRCCOPY); 1406 Frame(canvas,xView+9-1,yView+5-1,xView+9+xSizeBig,yView+5+ySizeBig,$B0B0B0,$FFFFFF); 1407 RFrame(canvas,xView+9-2,yView+5-2,xView+9+xSizeBig+1,yView+5+ySizeBig+1,$FFFFFF,$B0B0B0); 1408 Brush.Color:=$000000; 1409 FillRect(Rect(xView+9,yView+5,xView+1+72-8,yView+5+40)); 1410 Brush.Style:=bsClear; 1411 end 1412 else if BlinkTime=6 then 1413 begin 1414 if AllowChange and (c.Status and 7<>0) then 1614 if ProdHint then 1615 begin 1616 BlinkTime := (BlinkTime + 1) mod 12; 1617 if BlinkTime = 0 then 1618 with Canvas do 1619 begin 1620 bitblt(Canvas.Handle, xView + 5, yView + 1, 64, 2, Back.Canvas.Handle, 1621 xView + 5, yView + 1, SRCCOPY); 1622 bitblt(Canvas.Handle, xView + 5, yView + 3, 2, 42, Back.Canvas.Handle, 1623 xView + 5, yView + 3, SRCCOPY); 1624 bitblt(Canvas.Handle, xView + 5 + 62, yView + 3, 2, 42, 1625 Back.Canvas.Handle, xView + 5 + 62, yView + 3, SRCCOPY); 1626 Frame(Canvas, xView + 9 - 1, yView + 5 - 1, xView + 9 + xSizeBig, 1627 yView + 5 + ySizeBig, $B0B0B0, $FFFFFF); 1628 RFrame(Canvas, xView + 9 - 2, yView + 5 - 2, xView + 9 + xSizeBig + 1, 1629 yView + 5 + ySizeBig + 1, $FFFFFF, $B0B0B0); 1630 brush.Color := $000000; 1631 FillRect(Rect(xView + 9, yView + 5, xView + 1 + 72 - 8, 1632 yView + 5 + 40)); 1633 brush.style := bsClear; 1634 end 1635 else if BlinkTime = 6 then 1636 begin 1637 if AllowChange and (c.Status and 7 <> 0) then 1415 1638 begin // city type autobuild 1416 FrameImage(canvas,bigimp,xView+9,yView+5,xSizeBig,ySizeBig,1417 (c.Status and 7-1+3)*xSizeBig,0,true);1639 FrameImage(Canvas, bigimp, xView + 9, yView + 5, xSizeBig, ySizeBig, 1640 (c.Status and 7 - 1 + 3) * xSizeBig, 0, true); 1418 1641 end 1419 else if c.Project and cpImp=0 then1642 else if c.Project and cpImp = 0 then 1420 1643 begin // project is unit 1421 BitBlt(canvas.Handle,xView+9,yView+5,xSizeBig,ySizeBig,1422 bigimp.Canvas.Handle,0,0,SRCCOPY);1423 with Tribe[cOwner].ModelPicture[c.Project and cpIndex] do1424 Sprite(canvas,HGr,xView+5,yView+1,64,44,1425 pix mod 10 *65+1,pix div 10*49+1);1644 bitblt(Canvas.Handle, xView + 9, yView + 5, xSizeBig, ySizeBig, 1645 bigimp.Canvas.Handle, 0, 0, SRCCOPY); 1646 with Tribe[cOwner].ModelPicture[c.Project and cpIndex] do 1647 Sprite(Canvas, HGr, xView + 5, yView + 1, 64, 44, pix mod 10 * 65 + 1, 1648 pix div 10 * 49 + 1); 1426 1649 end 1427 else ImpImage(Canvas,xView+9,yView+5, 1428 c.Project0 and cpIndex,cGov,true); 1650 else 1651 ImpImage(Canvas, xView + 9, yView + 5, c.Project0 and cpIndex, 1652 cGov, true); 1429 1653 end 1430 1654 end … … 1433 1657 procedure TCityDlg.FormPaint(Sender: TObject); 1434 1658 begin 1435 inherited; 1436 if OpenSoundEvent>=0 then PostMessage(Handle, WM_PLAYSOUND, 0, 0); 1437 end; 1438 1439 procedure TCityDlg.OnPlaySound(var Msg:TMessage); 1440 begin 1441 if 1 shl OpenSoundEvent=chProduction then 1442 begin 1443 if c.Project0 and cpImp<>0 then 1444 begin 1445 if c.Project0 and cpIndex>=28 then // wonders have already extra message with sound 1446 if Imp[c.Project0 and cpIndex].Kind=ikShipPart then Play('SHIP_BUILT') 1447 else Play('CITY_IMPCOMPLETE') 1659 inherited; 1660 if OpenSoundEvent >= 0 then 1661 PostMessage(Handle, WM_PLAYSOUND, 0, 0); 1662 end; 1663 1664 procedure TCityDlg.OnPlaySound(var Msg: TMessage); 1665 begin 1666 if 1 shl OpenSoundEvent = chProduction then 1667 begin 1668 if c.Project0 and cpImp <> 0 then 1669 begin 1670 if c.Project0 and cpIndex >= 28 then 1671 // wonders have already extra message with sound 1672 if Imp[c.Project0 and cpIndex].Kind = ikShipPart then 1673 Play('SHIP_BUILT') 1674 else 1675 Play('CITY_IMPCOMPLETE') 1448 1676 end 1449 else Play('CITY_UNITCOMPLETE'); 1677 else 1678 Play('CITY_UNITCOMPLETE'); 1450 1679 end 1451 else Play(CityEventSoundItem[OpenSoundEvent]); 1452 OpenSoundEvent:=-2; 1680 else 1681 Play(CityEventSoundItem[OpenSoundEvent]); 1682 OpenSoundEvent := -2; 1453 1683 end; 1454 1684 1455 1685 function Prio(iix: integer): integer; 1456 1686 begin 1457 case Imp[iix].Kind of 1458 ikWonder: result:=iix+10000; 1459 ikNatLocal, ikNatGlobal: 1687 case Imp[iix].Kind of 1688 ikWonder: 1689 result := iix + 10000; 1690 ikNatLocal, ikNatGlobal: 1691 case iix of 1692 imPalace: 1693 result := 0; 1694 else 1695 result := iix + 20000; 1696 end; 1697 else 1460 1698 case iix of 1461 im Palace: result:=0;1462 else result:=iix+20000;1463 end;1464 else case iix of1465 imTownHall, imCourt: result:=iix+30000;1466 imAqueduct, imSewer: result:=iix+40000;1467 imTemple, imTheater, imCathedral: result:=iix+50000;1468 else result:=iix+90000;1699 imTownHall, imCourt: 1700 result := iix + 30000; 1701 imAqueduct, imSewer: 1702 result := iix + 40000; 1703 imTemple, imTheater, imCathedral: 1704 result := iix + 50000; 1705 else 1706 result := iix + 90000; 1469 1707 end; 1470 1708 end; … … 1473 1711 procedure TCityDlg.NextCityBtnClick(Sender: TObject); 1474 1712 begin 1475 ChangeCity(+1);1713 ChangeCity(+1); 1476 1714 end; 1477 1715 1478 1716 procedure TCityDlg.PrevCityBtnClick(Sender: TObject); 1479 1717 begin 1480 ChangeCity(-1);1718 ChangeCity(-1); 1481 1719 end; 1482 1720 1483 1721 procedure TCityDlg.ChangeCity(d: integer); 1484 1722 var 1485 cixNew: integer;1486 begin 1487 cixNew:=cix;1488 repeat1489 cixNew:=(cixNew+MyRO.nCity+d) mod MyRO.nCity;1490 until (MyCity[cixNew].Loc>=0) or (cixNew=cix);1491 if cixNew<>cix then1492 MainScreen.ZoomToCity(MyCity[cixNew].Loc);1723 cixNew: integer; 1724 begin 1725 cixNew := cix; 1726 repeat 1727 cixNew := (cixNew + MyRO.nCity + d) mod MyRO.nCity; 1728 until (MyCity[cixNew].Loc >= 0) or (cixNew = cix); 1729 if cixNew <> cix then 1730 MainScreen.ZoomToCity(MyCity[cixNew].Loc); 1493 1731 end; 1494 1732 … … 1496 1734 Shift: TShiftState); 1497 1735 begin 1498 if ((Key=VK_UP) or (Key=VK_NUMPAD8)) 1499 and (cix>=0) and (WindowMode=wmPersistent) then 1500 ChangeCity(-1) 1501 else if ((Key=VK_DOWN) or (Key=VK_NUMPAD2)) 1502 and (cix>=0) and (WindowMode=wmPersistent) then 1503 ChangeCity(+1) 1504 else inherited 1505 end; 1506 1507 {procedure TCityDlg.AdviceBtnClick(Sender: TObject); 1508 begin 1509 AdvisorDlg.GiveCityAdvice(cix); 1510 end;} 1736 if ((Key = VK_UP) or (Key = VK_NUMPAD8)) and (cix >= 0) and 1737 (WindowMode = wmPersistent) then 1738 ChangeCity(-1) 1739 else if ((Key = VK_DOWN) or (Key = VK_NUMPAD2)) and (cix >= 0) and 1740 (WindowMode = wmPersistent) then 1741 ChangeCity(+1) 1742 else 1743 inherited 1744 end; 1745 1746 { procedure TCityDlg.AdviceBtnClick(Sender: TObject); 1747 begin 1748 AdvisorDlg.GiveCityAdvice(cix); 1749 end; } 1511 1750 1512 1751 var 1513 i,j,k: integer;1752 i, j, k: integer; 1514 1753 1515 1754 procedure TCityDlg.PageUpBtnClick(Sender: TObject); 1516 1755 begin 1517 if Page>0 then1518 begin 1519 dec(Page);1520 SmartUpdateContent1756 if Page > 0 then 1757 begin 1758 dec(Page); 1759 SmartUpdateContent 1521 1760 end 1522 1761 end; … … 1524 1763 procedure TCityDlg.PageDownBtnClick(Sender: TObject); 1525 1764 begin 1526 if Page<PageCount-1 then1527 begin 1528 inc(Page);1529 SmartUpdateContent1765 if Page < PageCount - 1 then 1766 begin 1767 inc(Page); 1768 SmartUpdateContent 1530 1769 end 1531 1770 end; … … 1533 1772 procedure TCityDlg.ChangeResourceWeights(iResourceWeights: integer); 1534 1773 var 1535 Advice: TCityTileAdviceData; 1536 begin 1537 assert(not supervising); 1538 assert(cix>=0); 1539 MyCity[cix].Status:=MyCity[cix].Status 1540 and not csResourceWeightsMask or (iResourceWeights shl 4); 1541 c.Status:=MyCity[cix].Status; 1542 if iResourceWeights>0 then 1543 begin 1544 Advice.ResourceWeights:=OfferedResourceWeights[iResourceWeights]; 1545 Server(sGetCityTileAdvice,me,cix,Advice); 1546 if Advice.Tiles<>MyCity[cix].Tiles then 1547 Server(sSetCityTiles,me,cix,Advice.Tiles); 1548 end 1549 end; 1550 1774 Advice: TCityTileAdviceData; 1775 begin 1776 assert(not supervising); 1777 assert(cix >= 0); 1778 MyCity[cix].Status := MyCity[cix].Status and not csResourceWeightsMask or 1779 (iResourceWeights shl 4); 1780 c.Status := MyCity[cix].Status; 1781 if iResourceWeights > 0 then 1782 begin 1783 Advice.ResourceWeights := OfferedResourceWeights[iResourceWeights]; 1784 Server(sGetCityTileAdvice, me, cix, Advice); 1785 if Advice.Tiles <> MyCity[cix].Tiles then 1786 Server(sSetCityTiles, me, cix, Advice.Tiles); 1787 end 1788 end; 1551 1789 1552 1790 initialization 1553 for i:=0 to nImp-1 do ImpSorted[i]:=i; 1554 for i:=0 to nImp-2 do for j:=i+1 to nImp-1 do 1555 if Prio(ImpSorted[i])>Prio(ImpSorted[j]) then 1556 begin k:=ImpSorted[i]; ImpSorted[i]:=ImpSorted[j]; ImpSorted[j]:=k end; 1791 1792 for i := 0 to nImp - 1 do 1793 ImpSorted[i] := i; 1794 for i := 0 to nImp - 2 do 1795 for j := i + 1 to nImp - 1 do 1796 if Prio(ImpSorted[i]) > Prio(ImpSorted[j]) then 1797 begin 1798 k := ImpSorted[i]; 1799 ImpSorted[i] := ImpSorted[j]; 1800 ImpSorted[j] := k 1801 end; 1802 1557 1803 end. 1558 -
trunk/LocalPlayer/CityType.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit CityType; 4 3 … … 6 5 7 6 uses 8 Protocol, ClientTools,Term,ScreenTools,BaseWin,7 Protocol, ClientTools, Term, ScreenTools, BaseWin, 9 8 10 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, … … 26 25 procedure DeleteBtnClick(Sender: TObject); 27 26 public 28 procedure ShowNewContent(NewMode: integer); 27 procedure ShowNewContent(NewMode: integer); 29 28 protected 30 29 procedure OffscreenPaint; override; 31 30 private 32 nPool, dragiix,ctype: integer;33 Pooliix: array [0..nImp-1] of integer;34 listed: Set of 0 ..nImp;31 nPool, dragiix, ctype: integer; 32 Pooliix: array [0 .. nImp - 1] of integer; 33 listed: Set of 0 .. nImp; 35 34 Changed: boolean; 36 35 procedure LoadType(NewType: integer); … … 48 47 49 48 const 50 xList=7; yList=0; 51 nListRow=4; nListCol=10; 52 xPool=7; yPool=220; 53 nPoolRow=4; nPoolCol=10; 54 xSwitch=7; ySwitch=150; 55 xView=226; yView=130; 56 57 procedure TCityTypeDlg.FormCreate(Sender:TObject); 58 begin 59 inherited; 60 CaptionRight:=CloseBtn.Left; 61 InitButtons(); 62 HelpContext:='MACRO'; 63 Caption:=Phrases.Lookup('TITLE_CITYTYPES'); 64 DeleteBtn.Hint:=Phrases.Lookup('BTN_DELETE'); 65 end; 66 67 procedure TCityTypeDlg.CloseBtnClick(Sender:TObject); 68 begin 69 Close 70 end; 71 72 procedure TCityTypeDlg.FormPaint(Sender:TObject); 73 begin 74 inherited; 75 BtnFrame(Canvas,DeleteBtn.BoundsRect,MainTexture); 49 xList = 7; 50 yList = 0; 51 nListRow = 4; 52 nListCol = 10; 53 xPool = 7; 54 yPool = 220; 55 nPoolRow = 4; 56 nPoolCol = 10; 57 xSwitch = 7; 58 ySwitch = 150; 59 xView = 226; 60 yView = 130; 61 62 procedure TCityTypeDlg.FormCreate(Sender: TObject); 63 begin 64 inherited; 65 CaptionRight := CloseBtn.Left; 66 InitButtons(); 67 HelpContext := 'MACRO'; 68 Caption := Phrases.Lookup('TITLE_CITYTYPES'); 69 DeleteBtn.Hint := Phrases.Lookup('BTN_DELETE'); 70 end; 71 72 procedure TCityTypeDlg.CloseBtnClick(Sender: TObject); 73 begin 74 Close 75 end; 76 77 procedure TCityTypeDlg.FormPaint(Sender: TObject); 78 begin 79 inherited; 80 BtnFrame(Canvas, DeleteBtn.BoundsRect, MainTexture); 76 81 end; 77 82 78 83 procedure TCityTypeDlg.OffscreenPaint; 79 84 var 80 i,iix: integer; 81 s: string; 82 begin 83 inherited; 84 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 85 FillOffscreen(xList-7,yList,42*nListCol+14,32*nListRow); 86 FillOffscreen(xPool-7,yPool,42*nPoolCol+14,32*nPoolRow); 87 FillOffscreen(0,yList+32*nListRow,42*nPoolCol+14,yPool-yList-32*nListRow); 88 89 Frame(offscreen.Canvas,0,yList+32*nListRow,InnerWidth-255,yPool-23, 90 MainTexture.clBevelLight,MainTexture.clBevelShade); 91 Frame(offscreen.Canvas,InnerWidth-254,yList+32*nListRow,InnerWidth-89,yPool-23, 92 MainTexture.clBevelLight,MainTexture.clBevelShade); 93 Frame(offscreen.Canvas,InnerWidth-88,yList+32*nListRow,InnerWidth-1,yPool-23, 94 MainTexture.clBevelLight,MainTexture.clBevelShade); 95 Frame(offscreen.Canvas,0,yPool-22,InnerWidth-1,yPool-1, 96 MainTexture.clBevelLight,MainTexture.clBevelShade); 97 for i:=0 to nCityType-1 do 98 begin 99 RFrame(offscreen.Canvas,xSwitch+i*42,ySwitch,xSwitch+39+i*42,ySwitch+23, 100 MainTexture.clBevelShade,MainTexture.clBevelLight); 101 if i=ctype then 102 Frame(offscreen.Canvas,xSwitch+1+i*42,ySwitch+1,xSwitch+38+i*42,ySwitch+22, 103 MainTexture.clBevelShade,MainTexture.clBevelLight) 104 else Frame(offscreen.Canvas,xSwitch+1+i*42,ySwitch+1,xSwitch+38+i*42,ySwitch+22, 105 MainTexture.clBevelLight,MainTexture.clBevelShade); 106 BitBlt(offscreen.Canvas.Handle,xSwitch+2+i*42,ySwitch+2,xSizeSmall, 107 ySizeSmall,SmallImp.Canvas.Handle,(i+3)*xSizeSmall,0,SRCCOPY) 108 end; 109 RisedTextOut(offscreen.Canvas,8,yList+32*nListRow+2,Phrases.Lookup('BUILDORDER')); 110 RisedTextOut(offscreen.Canvas,8,ySwitch+26,Phrases.Lookup('CITYTYPE',ctype)); 111 s:=Phrases.Lookup('BUILDREST'); 112 RisedTextOut(offscreen.Canvas,(InnerWidth-BiColorTextWidth(Offscreen.Canvas,s)) div 2, 113 yList+72+32*nListRow,s); 114 115 with offscreen.Canvas do 116 begin 117 for i:=1 to nListRow-1 do 118 DLine(offscreen.Canvas,xList-5,xList+4+42*nListCol,yList-1+32*i, 119 MainTexture.clBevelLight,MainTexture.clBevelShade); 120 for i:=0 to nListCol*nListRow-1 do 121 begin 122 s:=IntToStr(i+1); 123 Font.Color:=MainTexture.clTextLight; 124 Textout(xList+20+i mod nListCol *42-TextWidth(s) div 2, 125 yList+15+i div nListCol *32-TextHeight(s) div 2,s); 85 i, iix: integer; 86 s: string; 87 begin 88 inherited; 89 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 90 FillOffscreen(xList - 7, yList, 42 * nListCol + 14, 32 * nListRow); 91 FillOffscreen(xPool - 7, yPool, 42 * nPoolCol + 14, 32 * nPoolRow); 92 FillOffscreen(0, yList + 32 * nListRow, 42 * nPoolCol + 14, 93 yPool - yList - 32 * nListRow); 94 95 Frame(offscreen.Canvas, 0, yList + 32 * nListRow, InnerWidth - 255, 96 yPool - 23, MainTexture.clBevelLight, MainTexture.clBevelShade); 97 Frame(offscreen.Canvas, InnerWidth - 254, yList + 32 * nListRow, 98 InnerWidth - 89, yPool - 23, MainTexture.clBevelLight, 99 MainTexture.clBevelShade); 100 Frame(offscreen.Canvas, InnerWidth - 88, yList + 32 * nListRow, 101 InnerWidth - 1, yPool - 23, MainTexture.clBevelLight, 102 MainTexture.clBevelShade); 103 Frame(offscreen.Canvas, 0, yPool - 22, InnerWidth - 1, yPool - 1, 104 MainTexture.clBevelLight, MainTexture.clBevelShade); 105 for i := 0 to nCityType - 1 do 106 begin 107 RFrame(offscreen.Canvas, xSwitch + i * 42, ySwitch, xSwitch + 39 + i * 42, 108 ySwitch + 23, MainTexture.clBevelShade, MainTexture.clBevelLight); 109 if i = ctype then 110 Frame(offscreen.Canvas, xSwitch + 1 + i * 42, ySwitch + 1, 111 xSwitch + 38 + i * 42, ySwitch + 22, MainTexture.clBevelShade, 112 MainTexture.clBevelLight) 113 else 114 Frame(offscreen.Canvas, xSwitch + 1 + i * 42, ySwitch + 1, 115 xSwitch + 38 + i * 42, ySwitch + 22, MainTexture.clBevelLight, 116 MainTexture.clBevelShade); 117 BitBlt(offscreen.Canvas.Handle, xSwitch + 2 + i * 42, ySwitch + 2, 118 xSizeSmall, ySizeSmall, SmallImp.Canvas.Handle, (i + 3) * xSizeSmall, 119 0, SRCCOPY) 120 end; 121 RisedTextOut(offscreen.Canvas, 8, yList + 32 * nListRow + 2, 122 Phrases.Lookup('BUILDORDER')); 123 RisedTextOut(offscreen.Canvas, 8, ySwitch + 26, 124 Phrases.Lookup('CITYTYPE', ctype)); 125 s := Phrases.Lookup('BUILDREST'); 126 RisedTextOut(offscreen.Canvas, 127 (InnerWidth - BiColorTextWidth(offscreen.Canvas, s)) div 2, 128 yList + 72 + 32 * nListRow, s); 129 130 with offscreen.Canvas do 131 begin 132 for i := 1 to nListRow - 1 do 133 DLine(offscreen.Canvas, xList - 5, xList + 4 + 42 * nListCol, 134 yList - 1 + 32 * i, MainTexture.clBevelLight, MainTexture.clBevelShade); 135 for i := 0 to nListCol * nListRow - 1 do 136 begin 137 s := IntToStr(i + 1); 138 Font.Color := MainTexture.clTextLight; 139 Textout(xList + 20 + i mod nListCol * 42 - TextWidth(s) div 2, 140 yList + 15 + i div nListCol * 32 - TextHeight(s) div 2, s); 126 141 end 127 142 end; 128 143 129 i:=0; 130 while MyData.ImpOrder[ctype,i]>=0 do 131 begin 132 RFrame(offscreen.Canvas, 133 xList+20-xSizeSmall div 2 + i mod nListCol *42, 134 yList+15-ySizeSmall div 2 + i div nListCol *32, 135 xList+21+xSizeSmall div 2 + i mod nListCol *42, 136 yList+16+ySizeSmall div 2 + i div nListCol *32, 137 MainTexture.clBevelLight,MainTexture.clBevelShade); 138 BitBlt(offscreen.Canvas.Handle, 139 xList+21-xSizeSmall div 2 + i mod nListCol *42, 140 yList+16-ySizeSmall div 2 + i div nListCol *32, 141 xSizeSmall,ySizeSmall,SmallImp.Canvas.Handle, 142 MyData.ImpOrder[ctype,i] mod 7*xSizeSmall, 143 (MyData.ImpOrder[ctype,i]+SystemIconLines*7) div 7*ySizeSmall,SRCCOPY); 144 inc(i); 145 end; 146 147 nPool:=0; 148 for iix:=28 to nImp-1 do 149 if not (iix in listed) and (Imp[iix].Kind=ikCommon) and (iix<>imTrGoods) 150 and (Imp[iix].Preq<>preNA) 151 and ((Imp[iix].Preq=preNone) or (MyRO.Tech[Imp[iix].Preq]>=tsApplicable)) then 152 begin 153 Pooliix[nPool]:=iix; 154 RFrame(offscreen.Canvas, 155 xPool+20-xSizeSmall div 2 + nPool mod nPoolCol *42, 156 yPool+15-ySizeSmall div 2 + nPool div nPoolCol *32, 157 xPool+21+xSizeSmall div 2 + nPool mod nPoolCol *42, 158 yPool+16+ySizeSmall div 2 + nPool div nPoolCol *32, 144 i := 0; 145 while MyData.ImpOrder[ctype, i] >= 0 do 146 begin 147 RFrame(offscreen.Canvas, xList + 20 - xSizeSmall div 2 + i mod nListCol * 148 42, yList + 15 - ySizeSmall div 2 + i div nListCol * 32, 149 xList + 21 + xSizeSmall div 2 + i mod nListCol * 42, 150 yList + 16 + ySizeSmall div 2 + i div nListCol * 32, 159 151 MainTexture.clBevelLight, MainTexture.clBevelShade); 160 BitBlt(offscreen.Canvas.Handle, 161 xPool+21-xSizeSmall div 2 + nPool mod nPoolCol *42, 162 yPool+16-ySizeSmall div 2 + nPool div nPoolCol *32, 163 xSizeSmall,ySizeSmall,SmallImp.Canvas.Handle, 164 iix mod 7*xSizeSmall,(iix+SystemIconLines*7) div 7*ySizeSmall,SRCCOPY); 165 inc(nPool) 152 BitBlt(offscreen.Canvas.Handle, xList + 21 - xSizeSmall div 2 + 153 i mod nListCol * 42, yList + 16 - ySizeSmall div 2 + i div nListCol * 32, 154 xSizeSmall, ySizeSmall, SmallImp.Canvas.Handle, 155 MyData.ImpOrder[ctype, i] mod 7 * xSizeSmall, 156 (MyData.ImpOrder[ctype, i] + SystemIconLines * 7) div 7 * 157 ySizeSmall, SRCCOPY); 158 inc(i); 159 end; 160 161 nPool := 0; 162 for iix := 28 to nImp - 1 do 163 if not(iix in listed) and (Imp[iix].Kind = ikCommon) and (iix <> imTrGoods) 164 and (Imp[iix].Preq <> preNA) and 165 ((Imp[iix].Preq = preNone) or (MyRO.Tech[Imp[iix].Preq] >= tsApplicable)) 166 then 167 begin 168 Pooliix[nPool] := iix; 169 RFrame(offscreen.Canvas, xPool + 20 - xSizeSmall div 2 + 170 nPool mod nPoolCol * 42, yPool + 15 - ySizeSmall div 2 + 171 nPool div nPoolCol * 32, xPool + 21 + xSizeSmall div 2 + 172 nPool mod nPoolCol * 42, yPool + 16 + ySizeSmall div 2 + 173 nPool div nPoolCol * 32, MainTexture.clBevelLight, 174 MainTexture.clBevelShade); 175 BitBlt(offscreen.Canvas.Handle, xPool + 21 - xSizeSmall div 2 + 176 nPool mod nPoolCol * 42, yPool + 16 - ySizeSmall div 2 + 177 nPool div nPoolCol * 32, xSizeSmall, ySizeSmall, SmallImp.Canvas.Handle, 178 iix mod 7 * xSizeSmall, (iix + SystemIconLines * 7) div 7 * 179 ySizeSmall, SRCCOPY); 180 inc(nPool) 166 181 end; 167 DeleteBtn.Visible:= MyData.ImpOrder[ctype,0]>=0; 168 169 if dragiix>=0 then 170 begin 171 ImpImage(offscreen.Canvas,xView+9,yView+5,dragiix); 172 s:=Phrases.Lookup('IMPROVEMENTS',dragiix); 173 RisedTextOut(offscreen.Canvas,xView+36-BiColorTextWidth(Offscreen.Canvas,s) div 2, 174 ySwitch+26,s); 175 end; 176 MarkUsedOffscreen(InnerWidth,InnerHeight); 177 end; {MainPaint} 182 DeleteBtn.Visible := MyData.ImpOrder[ctype, 0] >= 0; 183 184 if dragiix >= 0 then 185 begin 186 ImpImage(offscreen.Canvas, xView + 9, yView + 5, dragiix); 187 s := Phrases.Lookup('IMPROVEMENTS', dragiix); 188 RisedTextOut(offscreen.Canvas, 189 xView + 36 - BiColorTextWidth(offscreen.Canvas, s) div 2, 190 ySwitch + 26, s); 191 end; 192 MarkUsedOffscreen(InnerWidth, InnerHeight); 193 end; { MainPaint } 178 194 179 195 procedure TCityTypeDlg.LoadType(NewType: integer); 180 196 var 181 i: integer; 182 begin 183 ctype:=NewType; 184 listed:=[]; 185 i:=0; 186 while MyData.ImpOrder[ctype,i]>=0 do 187 begin include(listed,MyData.ImpOrder[ctype,i]); inc(i) end; 188 Changed:=false 197 i: integer; 198 begin 199 ctype := NewType; 200 listed := []; 201 i := 0; 202 while MyData.ImpOrder[ctype, i] >= 0 do 203 begin 204 include(listed, MyData.ImpOrder[ctype, i]); 205 inc(i) 206 end; 207 Changed := false 189 208 end; 190 209 191 210 procedure TCityTypeDlg.SaveType; 192 211 var 193 cix: integer;194 begin 195 if Changed then196 begin 197 for cix:=0 to MyRO.nCity-1 do198 if (MyCity[cix].Loc>=0) and (MyCity[cix].Status and 7=ctype+1) then199 AutoBuild(cix, MyData.ImpOrder[ctype]);200 Changed:=false212 cix: integer; 213 begin 214 if Changed then 215 begin 216 for cix := 0 to MyRO.nCity - 1 do 217 if (MyCity[cix].Loc >= 0) and (MyCity[cix].Status and 7 = ctype + 1) then 218 AutoBuild(cix, MyData.ImpOrder[ctype]); 219 Changed := false 201 220 end; 202 221 end; … … 204 223 procedure TCityTypeDlg.FormShow(Sender: TObject); 205 224 begin 206 LoadType(0);207 dragiix:=-1;208 OffscreenPaint;225 LoadType(0); 226 dragiix := -1; 227 OffscreenPaint; 209 228 end; 210 229 211 230 procedure TCityTypeDlg.ShowNewContent(NewMode: integer); 212 231 begin 213 inherited ShowNewContent(NewMode); 214 end; 215 216 procedure TCityTypeDlg.PaintBox1MouseDown(Sender: TObject; 217 Button: TMouseButton; Shift: TShiftState; x, y: integer); 218 var 219 i: integer; 220 begin 221 x:=x-SideFrame; y:=y-WideFrame; 222 i:=(x-xList) div 42+(y-yList) div 32 *nListCol; 223 if (i<nImp) and (MyData.ImpOrder[ctype,i]>=0) 224 and (x>xList+2+ i mod nListCol *42) and (y>yList+5+ i div nListCol *32) 225 and (x<xList+3+36+ i mod nListCol *42) and (y<yList+6+20+ i div nListCol *32) then 226 begin 227 if ssShift in Shift then 228 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkImp, MyData.ImpOrder[ctype,i]) 229 else 230 begin 231 dragiix:=MyData.ImpOrder[ctype,i]; 232 Screen.Cursor:=crImpDrag; 232 inherited ShowNewContent(NewMode); 233 end; 234 235 procedure TCityTypeDlg.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; 236 Shift: TShiftState; x, y: integer); 237 var 238 i: integer; 239 begin 240 x := x - SideFrame; 241 y := y - WideFrame; 242 i := (x - xList) div 42 + (y - yList) div 32 * nListCol; 243 if (i < nImp) and (MyData.ImpOrder[ctype, i] >= 0) and 244 (x > xList + 2 + i mod nListCol * 42) and 245 (y > yList + 5 + i div nListCol * 32) and 246 (x < xList + 3 + 36 + i mod nListCol * 42) and 247 (y < yList + 6 + 20 + i div nListCol * 32) then 248 begin 249 if ssShift in Shift then 250 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkImp, 251 MyData.ImpOrder[ctype, i]) 252 else 253 begin 254 dragiix := MyData.ImpOrder[ctype, i]; 255 Screen.Cursor := crImpDrag; 256 SmartUpdateContent 257 end; 258 exit; 259 end; 260 i := (x - xPool) div 42 + (y - yPool) div 32 * nPoolCol; 261 if (i < nPool) and (x > xPool + 2 + i mod nPoolCol * 42) and 262 (y > yPool + 5 + i div nPoolCol * 32) and 263 (x < xPool + 3 + 36 + i mod nPoolCol * 42) and 264 (y < yPool + 6 + 20 + i div nPoolCol * 32) then 265 begin 266 if ssShift in Shift then 267 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkImp, Pooliix[i]) 268 else 269 begin 270 dragiix := Pooliix[i]; 271 Screen.Cursor := crImpDrag; 272 SmartUpdateContent 273 end; 274 exit; 275 end; 276 i := (x - xSwitch) div 42; 277 if (i < nCityType) and (x > xSwitch + 2 + i * 42) and 278 (x < xSwitch + 3 + 36 + i * 42) and (y >= ySwitch + 2) and (y < ySwitch + 22) 279 then 280 begin 281 SaveType; 282 LoadType(i); 233 283 SmartUpdateContent 234 end;235 exit;236 end;237 i:=(x-xPool) div 42+(y-yPool) div 32 *nPoolCol;238 if (i<nPool) and (x>xPool+2+ i mod nPoolCol *42)239 and (y>yPool+5+ i div nPoolCol *32) and (x<xPool+3+36+ i mod nPoolCol *42)240 and (y<yPool+6+20+ i div nPoolCol *32) then241 begin242 if ssShift in Shift then243 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkImp, Pooliix[i])244 else245 begin246 dragiix:=Pooliix[i];247 Screen.Cursor:=crImpDrag;248 SmartUpdateContent249 end;250 exit;251 end;252 i:=(x-xSwitch) div 42;253 if (i<nCityType) and (x>xSwitch+2+ i*42) and (x<xSwitch+3+36+i*42)254 and (y>=ySwitch+2) and (y<ySwitch+22) then255 begin256 SaveType;257 LoadType(i);258 SmartUpdateContent259 284 end 260 285 end; … … 265 290 procedure UnList(iix: integer); 266 291 var 292 i: integer; 293 begin 294 i := 0; 295 while (MyData.ImpOrder[ctype, i] >= 0) and 296 (MyData.ImpOrder[ctype, i] <> iix) do 297 inc(i); 298 assert(MyData.ImpOrder[ctype, i] = iix); 299 move(MyData.ImpOrder[ctype, i + 1], MyData.ImpOrder[ctype, i], nImp - i); 300 Exclude(listed, iix); 301 end; 302 303 var 267 304 i: integer; 268 begin 269 i:=0; 270 while (MyData.ImpOrder[ctype,i]>=0) and (MyData.ImpOrder[ctype,i]<>iix) do 271 inc(i); 272 assert(MyData.ImpOrder[ctype,i]=iix); 273 move(MyData.ImpOrder[ctype,i+1],MyData.ImpOrder[ctype,i],nImp-i); 274 Exclude(listed,iix); 275 end; 276 277 var 278 i: integer; 279 begin 280 x:=x-SideFrame; y:=y-WideFrame; 281 if dragiix>=0 then 282 begin 283 if (x>=xList) and (x<xList+nListCol*42) 284 and (y>=yList) and (y<yList+nListRow*32) then 285 begin 286 if dragiix in listed then UnList(dragiix); 287 i:=(x-xList) div 42+(y-yList) div 32 *nListCol; 288 while (i>0) and (MyData.ImpOrder[ctype,i-1]<0) do dec(i); 289 move(MyData.ImpOrder[ctype,i],MyData.ImpOrder[ctype,i+1],nImp-i-1); 290 MyData.ImpOrder[ctype,i]:=dragiix; 291 include(listed,dragiix); 292 Changed:=true 305 begin 306 x := x - SideFrame; 307 y := y - WideFrame; 308 if dragiix >= 0 then 309 begin 310 if (x >= xList) and (x < xList + nListCol * 42) and (y >= yList) and 311 (y < yList + nListRow * 32) then 312 begin 313 if dragiix in listed then 314 UnList(dragiix); 315 i := (x - xList) div 42 + (y - yList) div 32 * nListCol; 316 while (i > 0) and (MyData.ImpOrder[ctype, i - 1] < 0) do 317 dec(i); 318 move(MyData.ImpOrder[ctype, i], MyData.ImpOrder[ctype, i + 1], 319 nImp - i - 1); 320 MyData.ImpOrder[ctype, i] := dragiix; 321 include(listed, dragiix); 322 Changed := true 293 323 end 294 else if (dragiix in listed) and (x>=xPool) and (x<xPool+nPoolCol*42)295 and (y>=yPool) and (y<yPool+nPoolRow*32) then296 begin 297 UnList(dragiix);298 Changed:=true324 else if (dragiix in listed) and (x >= xPool) and (x < xPool + nPoolCol * 42) 325 and (y >= yPool) and (y < yPool + nPoolRow * 32) then 326 begin 327 UnList(dragiix); 328 Changed := true 299 329 end; 300 dragiix:=-1; 330 dragiix := -1; 331 SmartUpdateContent 332 end; 333 Screen.Cursor := crDefault 334 end; 335 336 procedure TCityTypeDlg.FormClose(Sender: TObject; var Action: TCloseAction); 337 begin 338 SaveType; 339 inherited; 340 end; 341 342 procedure TCityTypeDlg.DeleteBtnClick(Sender: TObject); 343 begin 344 fillchar(MyData.ImpOrder[ctype], sizeof(MyData.ImpOrder[ctype]), -1); 345 listed := []; 346 Changed := true; 301 347 SmartUpdateContent 302 end;303 Screen.Cursor:=crDefault304 end;305 306 procedure TCityTypeDlg.FormClose(Sender: TObject; var Action: TCloseAction);307 begin308 SaveType;309 inherited;310 end;311 312 procedure TCityTypeDlg.DeleteBtnClick(Sender: TObject);313 begin314 fillchar(MyData.ImpOrder[ctype],sizeof(MyData.ImpOrder[ctype]),-1);315 listed:=[];316 Changed:=true;317 SmartUpdateContent318 348 end; 319 349 320 350 end. 321 -
trunk/LocalPlayer/ClientTools.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit ClientTools; 4 3 … … 9 8 10 9 const 11 nOfferedResourceWeights=6;12 OfferedResourceWeights: array[0..nOfferedResourceWeights-1] of cardinal=13 (rwOff, rwMaxScience, rwForceScience, rwMaxGrowth, rwForceProd, rwMaxProd);10 nOfferedResourceWeights = 6; 11 OfferedResourceWeights: array [0 .. nOfferedResourceWeights - 1] of cardinal = 12 (rwOff, rwMaxScience, rwForceScience, rwMaxGrowth, rwForceProd, rwMaxProd); 14 13 15 14 type 16 TImpOrder=array[0..(nImp+4) div 4 *4 -1] of ShortInt;17 TEnhancementJobs=array[0..11,0..7] of Byte;18 JobResultSet=set of 0..39;15 TImpOrder = array [0 .. (nImp + 4) div 4 * 4 - 1] of ShortInt; 16 TEnhancementJobs = array [0 .. 11, 0 .. 7] of Byte; 17 JobResultSet = set of 0 .. 39; 19 18 20 19 var 21 Server: TServerCall; 22 G: TNewGameData; 23 me: integer; 24 MyRO: ^TPlayerContext; 25 MyMap: ^TTileList; 26 MyUn: ^TUnList; 27 MyCity: ^TCityList; 28 MyModel: ^TModelList; 29 30 AdvValue: array[0..nAdv-1] of integer; 31 32 33 function dLoc(Loc,dx,dy: integer): integer; 34 function Distance(Loc0,Loc1: integer): integer; 35 function UnrestAtLoc(uix,Loc: integer): boolean; 20 Server: TServerCall; 21 G: TNewGameData; 22 me: integer; 23 MyRO: ^TPlayerContext; 24 MyMap: ^TTileList; 25 MyUn: ^TUnList; 26 MyCity: ^TCityList; 27 MyModel: ^TModelList; 28 29 AdvValue: array [0 .. nAdv - 1] of integer; 30 31 function dLoc(Loc, dx, dy: integer): integer; 32 function Distance(Loc0, Loc1: integer): integer; 33 function UnrestAtLoc(uix, Loc: integer): boolean; 36 34 function GetMoveAdvice(uix, ToLoc: integer; 37 35 var MoveAdviceData: TMoveAdviceData): integer; … … 43 41 function IsMilReportNew(Enemy: integer): boolean; 44 42 function CutCityFoodSurplus(FoodSurplus: integer; IsCityAlive: boolean; 45 gov,size: integer): integer; 46 function CityTaxBalance(cix: integer; const CityReport: TCityReportNew): integer; 43 gov, size: integer): integer; 44 function CityTaxBalance(cix: integer; const CityReport: TCityReportNew) 45 : integer; 47 46 procedure SumCities(var TaxSum, ScienceSum: integer); 48 function JobTest(uix, Job: integer; IgnoreResults: JobResultSet = []): boolean;47 function JobTest(uix, Job: integer; IgnoreResults: JobResultSet = []): boolean; 49 48 procedure GetUnitInfo(Loc: integer; var uix: integer; var UnitInfo: TUnitInfo); 50 49 procedure GetCityInfo(Loc: integer; var cix: integer; var CityInfo: TCityInfo); 51 50 function UnitExhausted(uix: integer): boolean; 52 51 function ModelHash(const ModelInfo: TModelInfo): integer; 53 function ProcessEnhancement(uix: integer; const Jobs: TEnhancementJobs): integer; 52 function ProcessEnhancement(uix: integer; const Jobs: TEnhancementJobs) 53 : integer; 54 54 function AutoBuild(cix: integer; const ImpOrder: TImpOrder): boolean; 55 55 procedure DebugMessage(Level: integer; Text: string); … … 62 62 procedure CityOptimizer_EndOfTurn; 63 63 64 65 64 implementation 66 65 67 66 var 68 CityNeedsOptimize: array[0..ncmax-1] of boolean; 69 70 71 function dLoc(Loc,dx,dy: integer): integer; 67 CityNeedsOptimize: array [0 .. ncmax - 1] of boolean; 68 69 function dLoc(Loc, dx, dy: integer): integer; 72 70 var 73 y0: integer;71 y0: integer; 74 72 begin 75 y0:=(Loc+G.lx*1024) div G.lx -1024; 76 result:=(Loc+(dx+y0 and 1+G.lx*1024) shr 1) mod G.lx +G.lx*(y0+dy) 73 y0 := (Loc + G.lx * 1024) div G.lx - 1024; 74 result := (Loc + (dx + y0 and 1 + G.lx * 1024) shr 1) mod G.lx + G.lx 75 * (y0 + dy) 77 76 end; 78 77 79 function Distance(Loc0, Loc1: integer): integer;78 function Distance(Loc0, Loc1: integer): integer; 80 79 var 81 dx,dy: integer;80 dx, dy: integer; 82 81 begin 83 inc(Loc0,G.lx*1024);84 inc(Loc1,G.lx*1024);85 dx:=abs(((Loc1 mod G.lx *2 +Loc1 div G.lx and 1) 86 -(Loc0 mod G.lx *2 +Loc0 div G.lx and 1)+3*G.lx) mod (2*G.lx) -G.lx);87 dy:=abs(Loc1 div G.lx-Loc0 div G.lx);88 result:=dx+dy+abs(dx-dy) shr 1;82 inc(Loc0, G.lx * 1024); 83 inc(Loc1, G.lx * 1024); 84 dx := abs(((Loc1 mod G.lx * 2 + Loc1 div G.lx and 1) - (Loc0 mod G.lx * 2 + 85 Loc0 div G.lx and 1) + 3 * G.lx) mod (2 * G.lx) - G.lx); 86 dy := abs(Loc1 div G.lx - Loc0 div G.lx); 87 result := dx + dy + abs(dx - dy) shr 1; 89 88 end; 90 89 91 function UnrestAtLoc(uix, Loc: integer): boolean;90 function UnrestAtLoc(uix, Loc: integer): boolean; 92 91 var 93 uix1: integer;92 uix1: integer; 94 93 begin 95 result:=false;96 if MyModel[MyUn[uix].mix].Flags and mdCivil=0 then97 case MyRO.Government of98 gRepublic, gFuture:99 result:=(MyRO.Territory[Loc]>=0) and (MyRO.Territory[Loc]<>me)100 and (MyRO.Treaty[MyRO.Territory[Loc]]<trAlliance);101 gDemocracy:102 result:=(MyRO.Territory[Loc]<0) or (MyRO.Territory[Loc]<>me)103 and (MyRO.Treaty[MyRO.Territory[Loc]]<trAlliance);94 result := false; 95 if MyModel[MyUn[uix].mix].Flags and mdCivil = 0 then 96 case MyRO.Government of 97 gRepublic, gFuture: 98 result := (MyRO.Territory[Loc] >= 0) and (MyRO.Territory[Loc] <> me) and 99 (MyRO.Treaty[MyRO.Territory[Loc]] < trAlliance); 100 gDemocracy: 101 result := (MyRO.Territory[Loc] < 0) or (MyRO.Territory[Loc] <> me) and 102 (MyRO.Treaty[MyRO.Territory[Loc]] < trAlliance); 104 103 end; 105 with MyModel[MyUn[uix].mix] do106 if Cap[mcSeaTrans]+Cap[mcAirTrans]+Cap[mcCarrier]>0 then107 for uix1:=0 to MyRO.nUn-1 do // check transported units too108 if (MyUn[uix1].Loc>=0) and (MyUn[uix1].Master=uix) then109 result:=result or UnrestAtLoc(uix1,Loc);104 with MyModel[MyUn[uix].mix] do 105 if Cap[mcSeaTrans] + Cap[mcAirTrans] + Cap[mcCarrier] > 0 then 106 for uix1 := 0 to MyRO.nUn - 1 do // check transported units too 107 if (MyUn[uix1].Loc >= 0) and (MyUn[uix1].Master = uix) then 108 result := result or UnrestAtLoc(uix1, Loc); 110 109 end; 111 110 112 function GetMoveAdvice(uix, ToLoc: integer; var MoveAdviceData: TMoveAdviceData): integer; 111 function GetMoveAdvice(uix, ToLoc: integer; 112 var MoveAdviceData: TMoveAdviceData): integer; 113 113 var 114 MinEndHealth: integer;114 MinEndHealth: integer; 115 115 begin 116 if MyModel[MyUn[uix].mix].Domain=dGround then MinEndHealth:=100 117 else MinEndHealth:=1; // resistent to hostile terrain -- don't consider 118 repeat 119 if MyUn[uix].Health>=MinEndHealth then 120 begin 121 MoveAdviceData.ToLoc:=ToLoc; 122 MoveAdviceData.MoreTurns:=999; 123 MoveAdviceData.MaxHostile_MovementLeft:=MyUn[uix].Health-MinEndHealth; 124 result:=Server(sGetMoveAdvice,me,uix,MoveAdviceData); 125 if (MinEndHealth<=1) or (result<>eNoWay) then exit; 116 if MyModel[MyUn[uix].mix].Domain = dGround then 117 MinEndHealth := 100 118 else 119 MinEndHealth := 1; // resistent to hostile terrain -- don't consider 120 repeat 121 if MyUn[uix].Health >= MinEndHealth then 122 begin 123 MoveAdviceData.ToLoc := ToLoc; 124 MoveAdviceData.MoreTurns := 999; 125 MoveAdviceData.MaxHostile_MovementLeft := MyUn[uix].Health - MinEndHealth; 126 result := Server(sGetMoveAdvice, me, uix, MoveAdviceData); 127 if (MinEndHealth <= 1) or (result <> eNoWay) then 128 exit; 126 129 end; 127 case MinEndHealth of 128 100: MinEndHealth:=50; 129 50: MinEndHealth:=25; 130 25: MinEndHealth:=12; 131 else MinEndHealth:=1 130 case MinEndHealth of 131 100: 132 MinEndHealth := 50; 133 50: 134 MinEndHealth := 25; 135 25: 136 MinEndHealth := 12; 137 else 138 MinEndHealth := 1 132 139 end; 133 until false 134 end; 135 136 function ColorOfHealth(Health: integer): integer; 137 var 138 red,green: integer; 139 begin 140 green:=400*Health div 100; if green>200 then green:=200; 141 red:=510*(100-Health) div 100; if red>255 then red:=255; 142 result:=green shl 8 + red 143 end; 144 145 function IsMultiPlayerGame: boolean; 146 var 147 p1: integer; 148 begin 149 result:=false; 150 for p1:=1 to nPl-1 do 151 if G.RO[p1]<>nil then result:=true; 152 end; 153 154 procedure ItsMeAgain(p: integer); 155 begin 156 if G.RO[p]<>nil then 157 MyRO:=pointer(G.RO[p]) 158 else if G.SuperVisorRO[p]<>nil then 159 MyRO:=pointer(G.SuperVisorRO[p]) 160 else exit; 161 me:=p; 162 MyMap:=pointer(MyRO.Map); 163 MyUn:=pointer(MyRO.Un); 164 MyCity:=pointer(MyRO.City); 165 MyModel:=pointer(MyRO.Model); 166 end; 167 168 function GetAge(p: integer): integer; 169 var 170 i: integer; 171 begin 172 if p=me then 173 begin 174 result:=0; 175 for i:=1 to 3 do 176 if MyRO.Tech[AgePreq[i]]>=tsApplicable then result:=i; 177 end 178 else 179 begin 180 result:=0; 181 for i:=1 to 3 do 182 if MyRO.EnemyReport[p].Tech[AgePreq[i]]>=tsApplicable then result:=i; 183 end 184 end; 185 186 function IsCivilReportNew(Enemy: integer): boolean; 187 var 188 i: integer; 189 begin 190 assert(Enemy<>me); 191 i:=MyRO.EnemyReport[Enemy].TurnOfCivilReport; 192 result:= (i=MyRO.Turn) or (i=MyRO.Turn-1) and (Enemy>me); 193 end; 194 195 function IsMilReportNew(Enemy: integer): boolean; 196 var 197 i: integer; 198 begin 199 assert(Enemy<>me); 200 i:=MyRO.EnemyReport[Enemy].TurnOfMilReport; 201 result:= (i=MyRO.Turn) or (i=MyRO.Turn-1) and (Enemy>me); 202 end; 203 204 function CutCityFoodSurplus(FoodSurplus: integer; IsCityAlive: boolean; 205 gov,size: integer): integer; 206 begin 207 result:=FoodSurplus; 208 if not IsCityAlive 209 or (result>0) 210 and ((gov=gFuture) 211 or (size>=NeedAqueductSize) and (result<2)) then 212 result:=0; {no growth} 213 end; 214 215 function CityTaxBalance(cix: integer; const CityReport: TCityReportNew): integer; 216 var 217 i: integer; 218 begin 219 result:=0; 220 if (CityReport.HappinessBalance>=0) {no disorder} 221 and (MyCity[cix].Flags and chCaptured=0) then // not captured 222 begin 223 inc(result, CityReport.Tax); 224 if (MyCity[cix].Project and (cpImp+cpIndex)=cpImp+imTrGoods) 225 and (CityReport.Production>0) then 226 inc(result, CityReport.Production); 227 if ((MyRO.Government=gFuture) 228 or (MyCity[cix].Size>=NeedAqueductSize) 229 and (CityReport.FoodSurplus<2)) 230 and (CityReport.FoodSurplus>0) then 231 inc(result, CityReport.FoodSurplus); 232 end; 233 for i:=28 to nImp-1 do if MyCity[cix].Built[i]>0 then 234 dec(result, Imp[i].Maint); 235 end; 236 237 procedure SumCities(var TaxSum, ScienceSum: integer); 238 var 239 cix: integer; 240 CityReport: TCityReportNew; 241 begin 242 TaxSum:=MyRO.OracleIncome; 243 ScienceSum:=0; 244 if MyRO.Government=gAnarchy then exit; 245 for cix:=0 to MyRO.nCity-1 do if MyCity[cix].Loc>=0 then 246 begin 247 CityReport.HypoTiles:=-1; 248 CityReport.HypoTaxRate:=-1; 249 CityReport.HypoLuxuryRate:=-1; 250 Server(sGetCityReportNew,me,cix,CityReport); 251 if (CityReport.HappinessBalance>=0) {no disorder} 252 and (MyCity[cix].Flags and chCaptured=0) then // not captured 253 ScienceSum:=ScienceSum+CityReport.Science; 254 TaxSum:=TaxSum+CityTaxBalance(cix, CityReport); 255 end; 256 end; 257 258 function JobTest(uix,Job: integer; IgnoreResults: JobResultSet): boolean; 259 var 260 Test: integer; 261 begin 262 Test:=Server(sStartJob+Job shl 4-sExecute,me,uix,nil^); 263 result:= (Test>=rExecuted) or (Test in IgnoreResults); 264 end; 265 266 procedure GetUnitInfo(Loc: integer; var uix: integer; var UnitInfo: TUnitInfo); 267 var 268 i,Cnt: integer; 269 begin 270 if MyMap[Loc] and fOwned<>0 then 271 begin 272 Server(sGetDefender,me,Loc,uix); 273 Cnt:=0; 274 for i:=0 to MyRO.nUn-1 do 275 if MyUn[i].Loc=Loc then inc(Cnt); 276 MakeUnitInfo(me,MyUn[uix],UnitInfo); 277 if Cnt>1 then UnitInfo.Flags:=UnitInfo.Flags or unMulti; 278 end 279 else 280 begin 281 uix:=MyRO.nEnemyUn-1; 282 while (uix>=0) and (MyRO.EnemyUn[uix].Loc<>Loc) do dec(uix); 283 UnitInfo:=MyRO.EnemyUn[uix]; 284 end 285 end;{GetUnitInfo} 286 287 procedure GetCityInfo(Loc: integer; var cix: integer; var CityInfo: TCityInfo); 288 begin 289 if MyMap[Loc] and fOwned<>0 then 290 begin 291 CityInfo.Loc:=Loc; 292 cix:=MyRO.nCity-1; 293 while (cix>=0) and (MyCity[cix].Loc<>Loc) do dec(cix); 294 with CityInfo do 295 begin 296 Owner:=me; 297 ID:=MyCity[cix].ID; 298 Size:=MyCity[cix].Size; 299 Flags:=0; 300 if MyCity[cix].Built[imPalace]>0 then inc(Flags,ciCapital); 301 if (MyCity[cix].Built[imWalls]>0) 302 or (MyMap[MyCity[cix].Loc] and fGrWall<>0) then inc(Flags,ciWalled); 303 if MyCity[cix].Built[imCoastalFort]>0 then inc(Flags,ciCoastalFort); 304 if MyCity[cix].Built[imMissileBat]>0 then inc(Flags,ciMissileBat); 305 if MyCity[cix].Built[imBunker]>0 then inc(Flags,ciBunker); 306 if MyCity[cix].Built[imSpacePort]>0 then inc(Flags,ciSpacePort); 140 until false end; 141 142 function ColorOfHealth(Health: integer): integer; 143 var 144 red, green: integer; 145 begin 146 green := 400 * Health div 100; 147 if green > 200 then 148 green := 200; 149 red := 510 * (100 - Health) div 100; 150 if red > 255 then 151 red := 255; 152 result := green shl 8 + red 153 end; 154 155 function IsMultiPlayerGame: boolean; 156 var 157 p1: integer; 158 begin 159 result := false; 160 for p1 := 1 to nPl - 1 do 161 if G.RO[p1] <> nil then 162 result := true; 163 end; 164 165 procedure ItsMeAgain(p: integer); 166 begin 167 if G.RO[p] <> nil then 168 MyRO := pointer(G.RO[p]) 169 else if G.SuperVisorRO[p] <> nil then 170 MyRO := pointer(G.SuperVisorRO[p]) 171 else 172 exit; 173 me := p; 174 MyMap := pointer(MyRO.Map); 175 MyUn := pointer(MyRO.Un); 176 MyCity := pointer(MyRO.City); 177 MyModel := pointer(MyRO.Model); 178 end; 179 180 function GetAge(p: integer): integer; 181 var 182 i: integer; 183 begin 184 if p = me then 185 begin 186 result := 0; 187 for i := 1 to 3 do 188 if MyRO.Tech[AgePreq[i]] >= tsApplicable then 189 result := i; 307 190 end 308 end 309 else 310 begin 311 cix:=MyRO.nEnemyCity-1; 312 while (cix>=0) and (MyRO.EnemyCity[cix].Loc<>Loc) do dec(cix); 313 CityInfo:=MyRO.EnemyCity[cix]; 314 end 315 end; 316 317 function UnitExhausted(uix: integer): boolean; 318 // check if another move of this unit is still possible 319 var 320 dx, dy: integer; 321 begin 322 result:=true; 323 if (MyUn[uix].Movement>0) or (MyRO.Wonder[woShinkansen].EffectiveOwner=me) then 324 if (MyUn[uix].Movement>=100) or ((MyModel[MyUn[uix].mix].Kind=mkCaravan) 325 and (MyMap[MyUn[uix].Loc] and fCity<>0)) then 326 result:=false 327 else for dx:=-2 to 2 do for dy:=-2 to 2 do if abs(dx)+abs(dy)=2 then 328 if Server(sMoveUnit-sExecute+dx and 7 shl 4+dy and 7 shl 7,me,uix,nil^)>=rExecuted then 329 result:=false; 330 end; 331 332 function ModelHash(const ModelInfo: TModelInfo): integer; 333 var 334 i,FeatureCode,Hash1,Hash2,Hash2r,d: cardinal; 335 begin 336 with ModelInfo do 337 if Kind>mkEnemyDeveloped then 338 result:=integer($C0000000+Speed div 50+Kind shl 8) 339 else 340 begin 341 FeatureCode:=0; 342 for i:=mcFirstNonCap to nFeature-1 do 343 if 1 shl Domain and Feature[i].Domains<>0 then 344 begin 345 FeatureCode:=FeatureCode*2; 346 if 1 shl (i-mcFirstNonCap)<>0 then 347 inc(FeatureCode); 348 end; 349 case Domain of 350 dGround: 351 begin 352 assert(FeatureCode<1 shl 8); 353 assert(Attack<5113); 354 assert(Defense<2273); 355 assert(Cost<1611); 356 Hash1:=(Attack*2273+Defense)*9+(Speed-150) div 50; 357 Hash2:=FeatureCode*1611+Cost; 358 end; 359 dSea: 360 begin 361 assert(FeatureCode<1 shl 9); 362 assert(Attack<12193); 363 assert(Defense<6097); 364 assert(Cost<4381); 365 Hash1:=((Attack*6097+Defense)*5+(Speed-350) div 100)*2; 366 if Weight>=6 then inc(Hash1); 367 Hash2:=((TTrans*17+ATrans_Fuel) shl 9+FeatureCode)*4381+Cost; 368 end; 369 dAir: 370 begin 371 assert(FeatureCode<1 shl 5); 372 assert(Attack<2407); 373 assert(Defense<1605); 374 assert(Bombs<4813); 375 assert(Cost<2089); 376 Hash1:=(Attack*1605+Defense) shl 5+FeatureCode; 377 Hash2:=((Bombs*7+ATrans_Fuel)*4+TTrans)*2089+Cost; 378 end; 379 end; 380 Hash2r:=0; 381 for i:=0 to 7 do 382 begin 383 Hash2r:=Hash2r*13; 384 d:=Hash2 div 13; 385 inc(Hash2r,Hash2-d*13); 386 Hash2:=d 387 end; 388 result:=integer(Domain shl 30+Hash1 xor Hash2r) 191 else 192 begin 193 result := 0; 194 for i := 1 to 3 do 195 if MyRO.EnemyReport[p].Tech[AgePreq[i]] >= tsApplicable then 196 result := i; 389 197 end 390 end; 391 392 function ProcessEnhancement(uix: integer; const Jobs: TEnhancementJobs): integer; 393 { return values: 394 eJobDone - all applicable jobs done 395 eOK - enhancement not complete 396 eDied - job done and died (thurst) } 397 var 398 stage, NextJob, Tile: integer; 399 Done: Set of jNone..jTrans; 400 begin 401 Done:=[]; 402 Tile:=MyMap[MyUn[uix].Loc]; 403 if Tile and fRoad<>0 then include(Done,jRoad); 404 if Tile and fRR<>0 then include(Done,jRR); 405 if (Tile and fTerImp=tiIrrigation) or (Tile and fTerImp=tiFarm) then 406 include(Done,jIrr); 407 if Tile and fTerImp=tiFarm then include(Done,jFarm); 408 if Tile and fTerImp=tiMine then include(Done,jMine); 409 if Tile and fPoll=0 then include(Done,jPoll); 410 411 if MyUn[uix].Job=jNone then result:=eJobDone 412 else result:=eOK; 413 while (result<>eOK) and (result<>eDied) do 414 begin 415 stage:=-1; 416 repeat 417 if stage=-1 then NextJob:=jPoll 418 else NextJob:=Jobs[Tile and fTerrain,stage]; 419 if (NextJob=jNone) or not (NextJob in Done) then Break; 420 inc(stage); 421 until stage=5; 422 if (stage=5) or (NextJob=jNone) then 423 begin result:=eJobDone; Break; end; // tile enhancement complete 424 result:=Server(sStartJob+NextJob shl 4,me,uix,nil^); 425 include(Done,NextJob) 426 end; 427 end; 428 429 function AutoBuild(cix: integer; const ImpOrder: TImpOrder): boolean; 430 var 431 i,NewProject: integer; 432 begin 433 result:=false; 434 if (MyCity[cix].Project and (cpImp+cpIndex)=cpImp+imTrGoods) 435 or (MyCity[cix].Flags and chProduction<>0) then 436 begin 437 i:=0; 438 repeat 439 while (ImpOrder[i]>=0) and (MyCity[cix].Built[ImpOrder[i]]>0) do inc(i); 440 if ImpOrder[i]<0 then Break; 441 assert(i<nImp); 442 NewProject:=cpImp+ImpOrder[i]; 443 if Server(sSetCityProject,me,cix,NewProject)>=rExecuted then 444 begin 445 result:=true; 446 CityOptimizer_CityChange(cix); 447 Break; 448 end; 449 inc(i); 450 until false 451 end 452 end; 453 454 procedure CalculateAdvValues; 455 var 456 i,j: integer; 457 known: array[0..nAdv-1] of integer; 458 459 procedure MarkPreqs(i: integer); 460 begin 461 if known[i]=0 then 462 begin 463 known[i]:=1; 464 if (i<>adScience) and (i<>adMassProduction) then 465 begin 466 if (AdvPreq[i,0]>=0) then MarkPreqs(AdvPreq[i,0]); 467 if (AdvPreq[i,1]>=0) then MarkPreqs(AdvPreq[i,1]); 198 end; 199 200 function IsCivilReportNew(Enemy: integer): boolean; 201 var 202 i: integer; 203 begin 204 assert(Enemy <> me); 205 i := MyRO.EnemyReport[Enemy].TurnOfCivilReport; 206 result := (i = MyRO.Turn) or (i = MyRO.Turn - 1) and (Enemy > me); 207 end; 208 209 function IsMilReportNew(Enemy: integer): boolean; 210 var 211 i: integer; 212 begin 213 assert(Enemy <> me); 214 i := MyRO.EnemyReport[Enemy].TurnOfMilReport; 215 result := (i = MyRO.Turn) or (i = MyRO.Turn - 1) and (Enemy > me); 216 end; 217 218 function CutCityFoodSurplus(FoodSurplus: integer; IsCityAlive: boolean; 219 gov, size: integer): integer; 220 begin 221 result := FoodSurplus; 222 if not IsCityAlive or (result > 0) and 223 ((gov = gFuture) or (size >= NeedAqueductSize) and (result < 2)) then 224 result := 0; { no growth } 225 end; 226 227 function CityTaxBalance(cix: integer; 228 const CityReport: TCityReportNew): integer; 229 var 230 i: integer; 231 begin 232 result := 0; 233 if (CityReport.HappinessBalance >= 0) { no disorder } 234 and (MyCity[cix].Flags and chCaptured = 0) then // not captured 235 begin 236 inc(result, CityReport.Tax); 237 if (MyCity[cix].Project and (cpImp + cpIndex) = cpImp + imTrGoods) and 238 (CityReport.Production > 0) then 239 inc(result, CityReport.Production); 240 if ((MyRO.Government = gFuture) or (MyCity[cix].size >= NeedAqueductSize) 241 and (CityReport.FoodSurplus < 2)) and (CityReport.FoodSurplus > 0) then 242 inc(result, CityReport.FoodSurplus); 243 end; 244 for i := 28 to nImp - 1 do 245 if MyCity[cix].Built[i] > 0 then 246 dec(result, Imp[i].Maint); 247 end; 248 249 procedure SumCities(var TaxSum, ScienceSum: integer); 250 var 251 cix: integer; 252 CityReport: TCityReportNew; 253 begin 254 TaxSum := MyRO.OracleIncome; 255 ScienceSum := 0; 256 if MyRO.Government = gAnarchy then 257 exit; 258 for cix := 0 to MyRO.nCity - 1 do 259 if MyCity[cix].Loc >= 0 then 260 begin 261 CityReport.HypoTiles := -1; 262 CityReport.HypoTaxRate := -1; 263 CityReport.HypoLuxuryRate := -1; 264 Server(sGetCityReportNew, me, cix, CityReport); 265 if (CityReport.HappinessBalance >= 0) { no disorder } 266 and (MyCity[cix].Flags and chCaptured = 0) then // not captured 267 ScienceSum := ScienceSum + CityReport.Science; 268 TaxSum := TaxSum + CityTaxBalance(cix, CityReport); 269 end; 270 end; 271 272 function JobTest(uix, Job: integer; IgnoreResults: JobResultSet): boolean; 273 var 274 Test: integer; 275 begin 276 Test := Server(sStartJob + Job shl 4 - sExecute, me, uix, nil^); 277 result := (Test >= rExecuted) or (Test in IgnoreResults); 278 end; 279 280 procedure GetUnitInfo(Loc: integer; var uix: integer; 281 var UnitInfo: TUnitInfo); 282 var 283 i, Cnt: integer; 284 begin 285 if MyMap[Loc] and fOwned <> 0 then 286 begin 287 Server(sGetDefender, me, Loc, uix); 288 Cnt := 0; 289 for i := 0 to MyRO.nUn - 1 do 290 if MyUn[i].Loc = Loc then 291 inc(Cnt); 292 MakeUnitInfo(me, MyUn[uix], UnitInfo); 293 if Cnt > 1 then 294 UnitInfo.Flags := UnitInfo.Flags or unMulti; 295 end 296 else 297 begin 298 uix := MyRO.nEnemyUn - 1; 299 while (uix >= 0) and (MyRO.EnemyUn[uix].Loc <> Loc) do 300 dec(uix); 301 UnitInfo := MyRO.EnemyUn[uix]; 302 end 303 end; { GetUnitInfo } 304 305 procedure GetCityInfo(Loc: integer; var cix: integer; 306 var CityInfo: TCityInfo); 307 begin 308 if MyMap[Loc] and fOwned <> 0 then 309 begin 310 CityInfo.Loc := Loc; 311 cix := MyRO.nCity - 1; 312 while (cix >= 0) and (MyCity[cix].Loc <> Loc) do 313 dec(cix); 314 with CityInfo do 315 begin 316 Owner := me; 317 ID := MyCity[cix].ID; 318 size := MyCity[cix].size; 319 Flags := 0; 320 if MyCity[cix].Built[imPalace] > 0 then 321 inc(Flags, ciCapital); 322 if (MyCity[cix].Built[imWalls] > 0) or 323 (MyMap[MyCity[cix].Loc] and fGrWall <> 0) then 324 inc(Flags, ciWalled); 325 if MyCity[cix].Built[imCoastalFort] > 0 then 326 inc(Flags, ciCoastalFort); 327 if MyCity[cix].Built[imMissileBat] > 0 then 328 inc(Flags, ciMissileBat); 329 if MyCity[cix].Built[imBunker] > 0 then 330 inc(Flags, ciBunker); 331 if MyCity[cix].Built[imSpacePort] > 0 then 332 inc(Flags, ciSpacePort); 468 333 end 469 334 end 470 end; 471 472 begin 473 FillChar(AdvValue,SizeOf(AdvValue),0); 474 for i:=0 to nAdv-1 do 475 begin 476 FillChar(known,SizeOf(known),0); 477 MarkPreqs(i); 478 for j:=0 to nAdv-1 do if known[j]>0 then inc(AdvValue[i]); 479 if i in FutureTech then inc(AdvValue[i],3000) 480 else if known[adMassProduction]>0 then inc(AdvValue[i],2000) 481 else if known[adScience]>0 then inc(AdvValue[i],1000) 482 end; 483 end; 484 485 procedure DebugMessage(Level: integer; Text: string); 486 begin 487 Server(sMessage,me,Level,pchar(Text)^) 488 end; 489 490 function MarkCitiesAround(Loc,cixExcept: integer): boolean; 491 // return whether a city was marked 492 var 493 cix: integer; 494 begin 495 result:=false; 496 for cix:=0 to MyRO.nCity-1 do 497 if (cix<>cixExcept) and (MyCity[cix].Loc>=0) 498 and (MyCity[cix].Flags and chCaptured=0) 499 and (Distance(MyCity[cix].Loc,Loc)<=5) then 500 begin 501 CityNeedsOptimize[cix]:=true; 502 result:=true; 335 else 336 begin 337 cix := MyRO.nEnemyCity - 1; 338 while (cix >= 0) and (MyRO.EnemyCity[cix].Loc <> Loc) do 339 dec(cix); 340 CityInfo := MyRO.EnemyCity[cix]; 503 341 end 504 end; 505 506 procedure OptimizeCities(CheckOnly: boolean); 507 var 508 cix,fix,dx,dy,Loc1,OptiType: integer; 509 done: boolean; 510 Advice: TCityTileAdviceData; 511 begin 512 repeat 513 done:=true; 514 for cix:=0 to MyRO.nCity-1 do if CityNeedsOptimize[cix] then 515 begin 516 OptiType:=MyCity[cix].Status shr 4 and $0F; 517 if OptiType<>0 then 518 begin 519 Advice.ResourceWeights:=OfferedResourceWeights[OptiType]; 520 Server(sGetCityTileAdvice,me,cix,Advice); 521 if Advice.Tiles<>MyCity[cix].Tiles then 522 if CheckOnly then 523 assert(false) 342 end; 343 344 function UnitExhausted(uix: integer): boolean; 345 // check if another move of this unit is still possible 346 var 347 dx, dy: integer; 348 begin 349 result := true; 350 if (MyUn[uix].Movement > 0) or 351 (MyRO.Wonder[woShinkansen].EffectiveOwner = me) then 352 if (MyUn[uix].Movement >= 100) or 353 ((MyModel[MyUn[uix].mix].Kind = mkCaravan) and 354 (MyMap[MyUn[uix].Loc] and fCity <> 0)) then 355 result := false 356 else 357 for dx := -2 to 2 do 358 for dy := -2 to 2 do 359 if abs(dx) + abs(dy) = 2 then 360 if Server(sMoveUnit - sExecute + dx and 7 shl 4 + dy and 7 shl 7, 361 me, uix, nil^) >= rExecuted then 362 result := false; 363 end; 364 365 function ModelHash(const ModelInfo: TModelInfo): integer; 366 var 367 i, FeatureCode, Hash1, Hash2, Hash2r, d: cardinal; 368 begin 369 with ModelInfo do 370 if Kind > mkEnemyDeveloped then 371 result := integer($C0000000 + Speed div 50 + Kind shl 8) 372 else 373 begin 374 FeatureCode := 0; 375 for i := mcFirstNonCap to nFeature - 1 do 376 if 1 shl Domain and Feature[i].Domains <> 0 then 377 begin 378 FeatureCode := FeatureCode * 2; 379 if 1 shl (i - mcFirstNonCap) <> 0 then 380 inc(FeatureCode); 381 end; 382 case Domain of 383 dGround: 384 begin 385 assert(FeatureCode < 1 shl 8); 386 assert(Attack < 5113); 387 assert(Defense < 2273); 388 assert(Cost < 1611); 389 Hash1 := (Attack * 2273 + Defense) * 9 + (Speed - 150) div 50; 390 Hash2 := FeatureCode * 1611 + Cost; 391 end; 392 dSea: 393 begin 394 assert(FeatureCode < 1 shl 9); 395 assert(Attack < 12193); 396 assert(Defense < 6097); 397 assert(Cost < 4381); 398 Hash1 := ((Attack * 6097 + Defense) * 5 + (Speed - 350) 399 div 100) * 2; 400 if Weight >= 6 then 401 inc(Hash1); 402 Hash2 := ((TTrans * 17 + ATrans_Fuel) shl 9 + FeatureCode) * 403 4381 + Cost; 404 end; 405 dAir: 406 begin 407 assert(FeatureCode < 1 shl 5); 408 assert(Attack < 2407); 409 assert(Defense < 1605); 410 assert(Bombs < 4813); 411 assert(Cost < 2089); 412 Hash1 := (Attack * 1605 + Defense) shl 5 + FeatureCode; 413 Hash2 := ((Bombs * 7 + ATrans_Fuel) * 4 + TTrans) * 2089 + Cost; 414 end; 415 end; 416 Hash2r := 0; 417 for i := 0 to 7 do 418 begin 419 Hash2r := Hash2r * 13; 420 d := Hash2 div 13; 421 inc(Hash2r, Hash2 - d * 13); 422 Hash2 := d 423 end; 424 result := integer(Domain shl 30 + Hash1 xor Hash2r) 425 end 426 end; 427 428 function ProcessEnhancement(uix: integer; 429 const Jobs: TEnhancementJobs): integer; 430 { return values: 431 eJobDone - all applicable jobs done 432 eOK - enhancement not complete 433 eDied - job done and died (thurst) } 434 var 435 stage, NextJob, Tile: integer; 436 Done: Set of jNone .. jTrans; 437 begin 438 Done := []; 439 Tile := MyMap[MyUn[uix].Loc]; 440 if Tile and fRoad <> 0 then 441 include(Done, jRoad); 442 if Tile and fRR <> 0 then 443 include(Done, jRR); 444 if (Tile and fTerImp = tiIrrigation) or (Tile and fTerImp = tiFarm) then 445 include(Done, jIrr); 446 if Tile and fTerImp = tiFarm then 447 include(Done, jFarm); 448 if Tile and fTerImp = tiMine then 449 include(Done, jMine); 450 if Tile and fPoll = 0 then 451 include(Done, jPoll); 452 453 if MyUn[uix].Job = jNone then 454 result := eJobDone 455 else 456 result := eOK; 457 while (result <> eOK) and (result <> eDied) do 458 begin 459 stage := -1; 460 repeat 461 if stage = -1 then 462 NextJob := jPoll 524 463 else 464 NextJob := Jobs[Tile and fTerrain, stage]; 465 if (NextJob = jNone) or not(NextJob in Done) then 466 Break; 467 inc(stage); 468 until stage = 5; 469 if (stage = 5) or (NextJob = jNone) then 470 begin 471 result := eJobDone; 472 Break; 473 end; // tile enhancement complete 474 result := Server(sStartJob + NextJob shl 4, me, uix, nil^); 475 include(Done, NextJob) 476 end; 477 end; 478 479 function AutoBuild(cix: integer; const ImpOrder: TImpOrder): boolean; 480 var 481 i, NewProject: integer; 482 begin 483 result := false; 484 if (MyCity[cix].Project and (cpImp + cpIndex) = cpImp + imTrGoods) or 485 (MyCity[cix].Flags and chProduction <> 0) then 486 begin 487 i := 0; 488 repeat 489 while (ImpOrder[i] >= 0) and (MyCity[cix].Built[ImpOrder[i]] > 0) do 490 inc(i); 491 if ImpOrder[i] < 0 then 492 Break; 493 assert(i < nImp); 494 NewProject := cpImp + ImpOrder[i]; 495 if Server(sSetCityProject, me, cix, NewProject) >= rExecuted then 496 begin 497 result := true; 498 CityOptimizer_CityChange(cix); 499 Break; 500 end; 501 inc(i); 502 until false end end; 503 504 procedure CalculateAdvValues; 505 var 506 i, j: integer; 507 known: array [0 .. nAdv - 1] of integer; 508 509 procedure MarkPreqs(i: integer); 510 begin 511 if known[i] = 0 then 525 512 begin 526 for fix:=1 to 26 do 527 if MyCity[cix].Tiles and not Advice.Tiles and (1 shl fix)<>0 then 528 begin // tile no longer used by this city -- check using it by another 529 dy:=fix shr 2-3; dx:=fix and 3 shl 1 -3 + (dy+3) and 1; 530 Loc1:=dLoc(MyCity[cix].Loc,dx,dy); 531 if MarkCitiesAround(Loc1,cix) then 532 done:=false; 513 known[i] := 1; 514 if (i <> adScience) and (i <> adMassProduction) then 515 begin 516 if (AdvPreq[i, 0] >= 0) then 517 MarkPreqs(AdvPreq[i, 0]); 518 if (AdvPreq[i, 1] >= 0) then 519 MarkPreqs(AdvPreq[i, 1]); 520 end 521 end 522 end; 523 524 begin 525 FillChar(AdvValue, SizeOf(AdvValue), 0); 526 for i := 0 to nAdv - 1 do 527 begin 528 FillChar(known, SizeOf(known), 0); 529 MarkPreqs(i); 530 for j := 0 to nAdv - 1 do 531 if known[j] > 0 then 532 inc(AdvValue[i]); 533 if i in FutureTech then 534 inc(AdvValue[i], 3000) 535 else if known[adMassProduction] > 0 then 536 inc(AdvValue[i], 2000) 537 else if known[adScience] > 0 then 538 inc(AdvValue[i], 1000) 539 end; 540 end; 541 542 procedure DebugMessage(Level: integer; Text: string); 543 begin 544 Server(sMessage, me, Level, pchar(Text)^) 545 end; 546 547 function MarkCitiesAround(Loc, cixExcept: integer): boolean; 548 // return whether a city was marked 549 var 550 cix: integer; 551 begin 552 result := false; 553 for cix := 0 to MyRO.nCity - 1 do 554 if (cix <> cixExcept) and (MyCity[cix].Loc >= 0) and 555 (MyCity[cix].Flags and chCaptured = 0) and 556 (Distance(MyCity[cix].Loc, Loc) <= 5) then 557 begin 558 CityNeedsOptimize[cix] := true; 559 result := true; 560 end 561 end; 562 563 procedure OptimizeCities(CheckOnly: boolean); 564 var 565 cix, fix, dx, dy, Loc1, OptiType: integer; 566 Done: boolean; 567 Advice: TCityTileAdviceData; 568 begin 569 repeat 570 Done := true; 571 for cix := 0 to MyRO.nCity - 1 do 572 if CityNeedsOptimize[cix] then 573 begin 574 OptiType := MyCity[cix].Status shr 4 and $0F; 575 if OptiType <> 0 then 576 begin 577 Advice.ResourceWeights := OfferedResourceWeights[OptiType]; 578 Server(sGetCityTileAdvice, me, cix, Advice); 579 if Advice.Tiles <> MyCity[cix].Tiles then 580 if CheckOnly then 581 assert(false) 582 else 583 begin 584 for fix := 1 to 26 do 585 if MyCity[cix].Tiles and not Advice.Tiles and 586 (1 shl fix) <> 0 then 587 begin // tile no longer used by this city -- check using it by another 588 dy := fix shr 2 - 3; 589 dx := fix and 3 shl 1 - 3 + (dy + 3) and 1; 590 Loc1 := dLoc(MyCity[cix].Loc, dx, dy); 591 if MarkCitiesAround(Loc1, cix) then 592 Done := false; 593 end; 594 Server(sSetCityTiles, me, cix, Advice.Tiles); 595 end; 533 596 end; 534 Server(sSetCityTiles,me,cix,Advice.Tiles); 535 end; 536 end; 537 CityNeedsOptimize[cix]:=false; 538 end; 539 until done; 540 end; 541 542 procedure CityOptimizer_BeginOfTurn; 543 var 544 cix: integer; 545 begin 546 fillchar(CityNeedsOptimize,MyRO.nCity-1,0); //false 547 if MyRO.Government<>gAnarchy then 548 begin 549 for cix:=0 to MyRO.nCity-1 do 550 if (MyCity[cix].Loc>=0) and (MyCity[cix].Flags and chCaptured=0) then 551 CityNeedsOptimize[cix]:=true; 552 OptimizeCities(false); // optimize all cities 553 end 554 end; 555 556 procedure CityOptimizer_CityChange(cix: integer); 557 begin 558 if (MyRO.Government<>gAnarchy) and (MyCity[cix].Flags and chCaptured=0) then 559 begin 560 CityNeedsOptimize[cix]:=true; 561 OptimizeCities(false); 562 end 563 end; 564 565 procedure CityOptimizer_TileBecomesAvailable(Loc: integer); 566 begin 567 if (MyRO.Government<>gAnarchy) and MarkCitiesAround(Loc,-1) then 568 OptimizeCities(false); 569 end; 570 571 procedure CityOptimizer_ReleaseCityTiles(cix, ReleasedTiles: integer); 572 var 573 fix,dx,dy,Loc1: integer; 574 done: boolean; 575 begin 576 if (MyRO.Government<>gAnarchy) and (ReleasedTiles<>0) then 577 begin 578 done:=true; 579 for fix:=1 to 26 do if ReleasedTiles and (1 shl fix)<>0 then 580 begin 581 dy:=fix shr 2-3; dx:=fix and 3 shl 1 -3 + (dy+3) and 1; 582 Loc1:=dLoc(MyCity[cix].Loc,dx,dy); 583 if MarkCitiesAround(Loc1,cix) then 584 done:=false; 585 end; 586 if not done then 587 OptimizeCities(false); 588 end 589 end; 590 591 procedure CityOptimizer_BeforeRemoveUnit(uix: integer); 592 var 593 uix1: integer; 594 begin 595 if MyRO.Government<>gAnarchy then 596 begin 597 if MyUn[uix].Home>=0 then 598 CityNeedsOptimize[MyUn[uix].Home]:=true; 599 600 // transported units are also removed 601 for uix1:=0 to MyRO.nUn-1 do 602 if (MyUn[uix1].Loc>=0) and (MyUn[uix1].Master=uix) 603 and (MyUn[uix1].Home>=0) then 604 CityNeedsOptimize[MyUn[uix1].Home]:=true; 605 end 606 end; 607 608 procedure CityOptimizer_AfterRemoveUnit; 609 begin 610 if MyRO.Government<>gAnarchy then 611 OptimizeCities(false); 612 end; 613 614 procedure CityOptimizer_EndOfTurn; 615 // all cities should already be optimized here -- only check this 616 var 617 cix: integer; 618 begin 597 CityNeedsOptimize[cix] := false; 598 end; 599 until Done; 600 end; 601 602 procedure CityOptimizer_BeginOfTurn; 603 var 604 cix: integer; 605 begin 606 FillChar(CityNeedsOptimize, MyRO.nCity - 1, 0); // false 607 if MyRO.Government <> gAnarchy then 608 begin 609 for cix := 0 to MyRO.nCity - 1 do 610 if (MyCity[cix].Loc >= 0) and (MyCity[cix].Flags and chCaptured = 0) 611 then 612 CityNeedsOptimize[cix] := true; 613 OptimizeCities(false); // optimize all cities 614 end 615 end; 616 617 procedure CityOptimizer_CityChange(cix: integer); 618 begin 619 if (MyRO.Government <> gAnarchy) and 620 (MyCity[cix].Flags and chCaptured = 0) then 621 begin 622 CityNeedsOptimize[cix] := true; 623 OptimizeCities(false); 624 end 625 end; 626 627 procedure CityOptimizer_TileBecomesAvailable(Loc: integer); 628 begin 629 if (MyRO.Government <> gAnarchy) and MarkCitiesAround(Loc, -1) then 630 OptimizeCities(false); 631 end; 632 633 procedure CityOptimizer_ReleaseCityTiles(cix, ReleasedTiles: integer); 634 var 635 fix, dx, dy, Loc1: integer; 636 Done: boolean; 637 begin 638 if (MyRO.Government <> gAnarchy) and (ReleasedTiles <> 0) then 639 begin 640 Done := true; 641 for fix := 1 to 26 do 642 if ReleasedTiles and (1 shl fix) <> 0 then 643 begin 644 dy := fix shr 2 - 3; 645 dx := fix and 3 shl 1 - 3 + (dy + 3) and 1; 646 Loc1 := dLoc(MyCity[cix].Loc, dx, dy); 647 if MarkCitiesAround(Loc1, cix) then 648 Done := false; 649 end; 650 if not Done then 651 OptimizeCities(false); 652 end 653 end; 654 655 procedure CityOptimizer_BeforeRemoveUnit(uix: integer); 656 var 657 uix1: integer; 658 begin 659 if MyRO.Government <> gAnarchy then 660 begin 661 if MyUn[uix].Home >= 0 then 662 CityNeedsOptimize[MyUn[uix].Home] := true; 663 664 // transported units are also removed 665 for uix1 := 0 to MyRO.nUn - 1 do 666 if (MyUn[uix1].Loc >= 0) and (MyUn[uix1].Master = uix) and 667 (MyUn[uix1].Home >= 0) then 668 CityNeedsOptimize[MyUn[uix1].Home] := true; 669 end 670 end; 671 672 procedure CityOptimizer_AfterRemoveUnit; 673 begin 674 if MyRO.Government <> gAnarchy then 675 OptimizeCities(false); 676 end; 677 678 procedure CityOptimizer_EndOfTurn; 679 // all cities should already be optimized here -- only check this 680 var 681 cix: integer; 682 begin 619 683 {$IFOPT O-} 620 if MyRO.Government<>gAnarchy then 621 begin 622 fillchar(CityNeedsOptimize,MyRO.nCity-1,0); //false 623 for cix:=0 to MyRO.nCity-1 do 624 if (MyCity[cix].Loc>=0) and (MyCity[cix].Flags and chCaptured=0) then 625 CityNeedsOptimize[cix]:=true; 626 OptimizeCities(true); // check all cities 627 end; 684 if MyRO.Government <> gAnarchy then 685 begin 686 FillChar(CityNeedsOptimize, MyRO.nCity - 1, 0); // false 687 for cix := 0 to MyRO.nCity - 1 do 688 if (MyCity[cix].Loc >= 0) and (MyCity[cix].Flags and chCaptured = 0) 689 then 690 CityNeedsOptimize[cix] := true; 691 OptimizeCities(true); // check all cities 692 end; 628 693 {$ENDIF} 629 end; 630 694 end; 631 695 632 696 initialization 633 assert(nImp<128); 697 698 assert(nImp < 128); 634 699 CalculateAdvValues; 635 700 636 701 end. 637 -
trunk/LocalPlayer/Diagram.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit Diagram; 4 3 … … 22 21 procedure ToggleBtnClick(Sender: TObject); 23 22 procedure PlayerClick(Sender: TObject); 24 procedure FormKeyDown(Sender: TObject; var Key: word; 25 Shift: TShiftState); 23 procedure FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState); 26 24 27 25 public … … 31 29 32 30 private 33 Kind: (dkChart,dkShip);34 Player, Mode: integer;31 Kind: (dkChart, dkShip); 32 Player, Mode: integer; 35 33 end; 36 34 … … 38 36 DiaDlg: TDiaDlg; 39 37 40 procedure PaintColonyShip(canvas: TCanvas; Player,Left,Width,Top: integer); 41 38 procedure PaintColonyShip(canvas: TCanvas; Player, Left, Width, Top: integer); 42 39 43 40 implementation 44 41 45 42 uses 46 Protocol, ScreenTools, ClientTools,Term,Tribes;43 Protocol, ScreenTools, ClientTools, Term, Tribes; 47 44 48 45 {$R *.DFM} 49 46 50 47 const 51 Border=24; 52 RoundPixels: array[0..nStat-1] of integer=(0,0,0,5,5,5); 53 54 yArea=48; 55 xComp: array[0..5] of integer=(-60,-28,4,4,36,68); 56 yComp: array[0..5] of integer=(-40,-40,-79,-1,-40,-40); 57 xPow: array[0..3] of integer=(-116,-116,-116,-116); 58 yPow: array[0..3] of integer=(-28,0,-44,16); 59 xHab: array[0..1] of integer=(23,23); 60 yHab: array[0..1] of integer=(-81,1); 61 62 procedure PaintColonyShip(canvas: TCanvas; Player,Left,Width,Top: integer); 63 var 64 i,x,r,nComp,nPow,nHab: integer; 65 begin 66 with canvas do 67 begin 68 Brush.Color:=$000000; 69 FillRect(Rect(Left,Top,Left+Width,Top+200)); 70 Brush.Style:=bsClear; 71 Frame(Canvas,Left-1,Top-1,Left+Width,Top+200,MainTexture.clBevelShade,MainTexture.clBevelLight); 72 RFrame(Canvas,Left-2,Top-2,Left+Width+1,Top+200+1,MainTexture.clBevelShade,MainTexture.clBevelLight); 73 74 // stars 75 RandSeed:=Player*11111; 76 for i:=1 to Width-16 do 48 Border = 24; 49 RoundPixels: array [0 .. nStat - 1] of integer = (0, 0, 0, 5, 5, 5); 50 51 yArea = 48; 52 xComp: array [0 .. 5] of integer = (-60, -28, 4, 4, 36, 68); 53 yComp: array [0 .. 5] of integer = (-40, -40, -79, -1, -40, -40); 54 xPow: array [0 .. 3] of integer = (-116, -116, -116, -116); 55 yPow: array [0 .. 3] of integer = (-28, 0, -44, 16); 56 xHab: array [0 .. 1] of integer = (23, 23); 57 yHab: array [0 .. 1] of integer = (-81, 1); 58 59 procedure PaintColonyShip(canvas: TCanvas; Player, Left, Width, Top: integer); 60 var 61 i, x, r, nComp, nPow, nHab: integer; 62 begin 63 with canvas do 64 begin 65 Brush.Color := $000000; 66 FillRect(Rect(Left, Top, Left + Width, Top + 200)); 67 Brush.Style := bsClear; 68 Frame(canvas, Left - 1, Top - 1, Left + Width, Top + 200, 69 MainTexture.clBevelShade, MainTexture.clBevelLight); 70 RFrame(canvas, Left - 2, Top - 2, Left + Width + 1, Top + 200 + 1, 71 MainTexture.clBevelShade, MainTexture.clBevelLight); 72 73 // stars 74 RandSeed := Player * 11111; 75 for i := 1 to Width - 16 do 77 76 begin 78 x:=Random((Width-16)*200); 79 r:=Random(13)+28; 80 Pixels[x div 200+8,x mod 200+Top]:=(r*r*r*r div 10001)*$10101; 77 x := Random((Width - 16) * 200); 78 r := Random(13) + 28; 79 Pixels[x div 200 + 8, x mod 200 + Top] := 80 (r * r * r * r div 10001) * $10101; 81 81 end; 82 82 83 nComp:=MyRO.Ship[Player].Parts[spComp]; 84 nPow:=MyRO.Ship[Player].Parts[spPow]; 85 nHab:=MyRO.Ship[Player].Parts[spHab]; 86 if nComp>6 then nComp:=6; 87 if nPow>4 then nPow:=4; 88 if nHab>2 then nHab:=2; 89 for i:=0 to nHab-1 do 90 Sprite(canvas,HGrSystem2,Left+Width div 2+xHab[i],Top+100+yHab[i], 91 80,80,34,1); 92 for i:=0 to nComp-1 do 93 Sprite(canvas,HGrSystem2,Left+Width div 2+xComp[i],Top+100+yComp[i], 94 32,80,1,1); 95 if nComp>0 then 96 for i:=3 downto nPow do 97 Sprite(canvas,HGrSystem2,Left+Width div 2+xPow[i]+40,Top+100+yPow[i], 98 16,27,1,82); 99 for i:=nPow-1 downto 0 do 100 Sprite(canvas,HGrSystem2,Left+Width div 2+xPow[i],Top+100+yPow[i], 101 56,28,58,82); 102 if (nComp<3) and (nHab>=1) then 103 Sprite(canvas,HGrSystem2,Left+Width div 2+xComp[2]+32-16,Top+100+7+yComp[2], 104 16,27,1,82); 105 if (nComp>=3) and (nHab<1) then 106 Sprite(canvas,HGrSystem2,Left+Width div 2+xComp[2]+32,Top+100+7+yComp[2], 107 16,27,18,82); 108 if (nComp<4) and (nHab>=2) then 109 Sprite(canvas,HGrSystem2,Left+Width div 2+xComp[3]+32-16,Top+100+46+yComp[3], 110 16,27,1,82); 111 if (nComp>=4) and (nHab<2) then 112 Sprite(canvas,HGrSystem2,Left+Width div 2+xComp[3]+32,Top+100+46+yComp[3], 113 16,27,18,82); 114 if (nComp<>6) and (nComp<>2) and not ((nComp=0) and (nPow<1)) then 115 Sprite(canvas,HGrSystem2,Left+Width div 2+xComp[nComp],Top+100+7+yComp[nComp], 116 16,27,18,82); 117 if (nComp<>6) and (nComp<>3) and not ((nComp=0) and (nPow<2)) then 118 Sprite(canvas,HGrSystem2,Left+Width div 2+xComp[nComp],Top+100+46+yComp[nComp], 119 16,27,18,82); 120 if nComp=2 then 121 Sprite(canvas,HGrSystem2,Left+Width div 2+xComp[3],Top+100+7+yComp[3], 122 16,27,18,82); 123 if nComp=3 then 124 Sprite(canvas,HGrSystem2,Left+Width div 2+xComp[4],Top+100+7+yComp[4], 125 16,27,18,82); 83 nComp := MyRO.Ship[Player].Parts[spComp]; 84 nPow := MyRO.Ship[Player].Parts[spPow]; 85 nHab := MyRO.Ship[Player].Parts[spHab]; 86 if nComp > 6 then 87 nComp := 6; 88 if nPow > 4 then 89 nPow := 4; 90 if nHab > 2 then 91 nHab := 2; 92 for i := 0 to nHab - 1 do 93 Sprite(canvas, HGrSystem2, Left + Width div 2 + xHab[i], 94 Top + 100 + yHab[i], 80, 80, 34, 1); 95 for i := 0 to nComp - 1 do 96 Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[i], 97 Top + 100 + yComp[i], 32, 80, 1, 1); 98 if nComp > 0 then 99 for i := 3 downto nPow do 100 Sprite(canvas, HGrSystem2, Left + Width div 2 + xPow[i] + 40, 101 Top + 100 + yPow[i], 16, 27, 1, 82); 102 for i := nPow - 1 downto 0 do 103 Sprite(canvas, HGrSystem2, Left + Width div 2 + xPow[i], 104 Top + 100 + yPow[i], 56, 28, 58, 82); 105 if (nComp < 3) and (nHab >= 1) then 106 Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[2] + 32 - 16, 107 Top + 100 + 7 + yComp[2], 16, 27, 1, 82); 108 if (nComp >= 3) and (nHab < 1) then 109 Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[2] + 32, 110 Top + 100 + 7 + yComp[2], 16, 27, 18, 82); 111 if (nComp < 4) and (nHab >= 2) then 112 Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[3] + 32 - 16, 113 Top + 100 + 46 + yComp[3], 16, 27, 1, 82); 114 if (nComp >= 4) and (nHab < 2) then 115 Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[3] + 32, 116 Top + 100 + 46 + yComp[3], 16, 27, 18, 82); 117 if (nComp <> 6) and (nComp <> 2) and not((nComp = 0) and (nPow < 1)) then 118 Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[nComp], 119 Top + 100 + 7 + yComp[nComp], 16, 27, 18, 82); 120 if (nComp <> 6) and (nComp <> 3) and not((nComp = 0) and (nPow < 2)) then 121 Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[nComp], 122 Top + 100 + 46 + yComp[nComp], 16, 27, 18, 82); 123 if nComp = 2 then 124 Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[3], 125 Top + 100 + 7 + yComp[3], 16, 27, 18, 82); 126 if nComp = 3 then 127 Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[4], 128 Top + 100 + 7 + yComp[4], 16, 27, 18, 82); 126 129 end 127 130 end; … … 129 132 procedure TDiaDlg.FormCreate(Sender: TObject); 130 133 begin 131 inherited;132 TitleHeight:=WideFrame+20;133 InnerHeight:=ClientHeight-TitleHeight-NarrowFrame;134 CaptionRight:=CloseBtn.Left;135 CaptionLeft:=ToggleBtn.Left+ToggleBtn.Width;136 InitButtons();134 inherited; 135 TitleHeight := WideFrame + 20; 136 InnerHeight := ClientHeight - TitleHeight - NarrowFrame; 137 CaptionRight := CloseBtn.Left; 138 CaptionLeft := ToggleBtn.Left + ToggleBtn.Width; 139 InitButtons(); 137 140 end; 138 141 139 142 procedure TDiaDlg.CloseBtnClick(Sender: TObject); 140 143 begin 141 Close;144 Close; 142 145 end; 143 146 144 147 procedure TDiaDlg.OffscreenPaint; 145 148 type 146 TLine=array[0..99999,0..2] of Byte;147 var 148 p,T,max,x,y,y0,Stop,r,RoundRange,LineStep: integer;149 s: string;150 List: ^TChart;149 TLine = array [0 .. 99999, 0 .. 2] of Byte; 150 var 151 p, T, max, x, y, y0, Stop, r, RoundRange, LineStep: integer; 152 s: string; 153 List: ^TChart; 151 154 152 155 function Round(T: integer): integer; 153 156 var 154 n,i: integer; 155 begin 156 if T<RoundRange then n:=T else n:=RoundRange; 157 result:=0; 158 for i:=T-n to T do inc(result,List[i]); 159 result:=result div (n+1); 157 n, i: integer; 158 begin 159 if T < RoundRange then 160 n := T 161 else 162 n := RoundRange; 163 result := 0; 164 for i := T - n to T do 165 inc(result, List[i]); 166 result := result div (n + 1); 160 167 end; 161 168 162 procedure ShareBar(x,y:integer; Cap:string; val0,val1: integer); 163 begin 164 LoweredTextOut(offscreen.Canvas,-1,MainTexture,x-2,y,Cap); 165 DLine(offscreen.Canvas,x-2,x+169,y+16,MainTexture.clTextShade, 166 MainTexture.clTextLight); 167 if val0>0 then s:=Format(Phrases.Lookup('SHARE'),[val0,val1]) 168 else s:='0'; 169 RisedTextOut(offscreen.Canvas,x+170-BiColorTextWidth(Offscreen.Canvas,s),y,s); 169 procedure ShareBar(x, y: integer; Cap: string; val0, val1: integer); 170 begin 171 LoweredTextOut(offscreen.canvas, -1, MainTexture, x - 2, y, Cap); 172 DLine(offscreen.canvas, x - 2, x + 169, y + 16, MainTexture.clTextShade, 173 MainTexture.clTextLight); 174 if val0 > 0 then 175 s := Format(Phrases.Lookup('SHARE'), [val0, val1]) 176 else 177 s := '0'; 178 RisedTextOut(offscreen.canvas, 179 x + 170 - BiColorTextWidth(offscreen.canvas, s), y, s); 170 180 end; 171 181 172 182 begin 173 inherited; 174 if Kind=dkChart then with offscreen.Canvas do 175 begin 176 Font.Assign(UniFont[ftTiny]); 177 Font.Color:=$808080; 178 179 RoundRange:=RoundPixels[Mode]*(MyRO.Turn-1) div (InnerWidth-2*Border); 180 181 GetMem(List,4*(MyRO.Turn+2)); 182 if Mode=stExplore then max:=G.lx*G.ly 183 else 183 inherited; 184 if Kind = dkChart then 185 with offscreen.canvas do 184 186 begin 185 max:=-1; 186 for p:=0 to nPl-1 do 187 if (G.Difficulty[p]>0) 188 and (Server(sGetChart+Mode shl 4,me,p,List^)>=rExecuted) then 189 for T:=0 to MyRO.Turn-1 do 190 begin r:=Round(T); if r>max then max:=r; end; 187 Font.Assign(UniFont[ftTiny]); 188 Font.Color := $808080; 189 190 RoundRange := RoundPixels[Mode] * (MyRO.Turn - 1) 191 div (InnerWidth - 2 * Border); 192 193 GetMem(List, 4 * (MyRO.Turn + 2)); 194 if Mode = stExplore then 195 max := G.lx * G.ly 196 else 197 begin 198 max := -1; 199 for p := 0 to nPl - 1 do 200 if (G.Difficulty[p] > 0) and 201 (Server(sGetChart + Mode shl 4, me, p, List^) >= rExecuted) then 202 for T := 0 to MyRO.Turn - 1 do 203 begin 204 r := Round(T); 205 if r > max then 206 max := r; 207 end; 208 end; 209 210 Brush.Color := $000000; 211 FillRect(Rect(0, 0, InnerWidth, InnerHeight)); 212 Brush.Style := bsClear; 213 Pen.Color := $606060; 214 MoveTo(Border, InnerHeight - Border); 215 LineTo(InnerWidth - Border, InnerHeight - Border); 216 if MyRO.Turn >= 800 then 217 LineStep := 200 218 else if MyRO.Turn >= 400 then 219 LineStep := 100 220 else 221 LineStep := 50; 222 for T := 0 to (MyRO.Turn - 1) div LineStep do 223 begin 224 x := Border + (InnerWidth - 2 * Border) * T * 225 LineStep div (MyRO.Turn - 1); 226 MoveTo(x, Border); 227 LineTo(x, InnerHeight - Border); 228 s := IntToStr(abs(TurnToYear(T * LineStep))); 229 Textout(x - TextWidth(s) div 2, Border - 16, s); 230 end; 231 232 if max > 0 then 233 begin 234 for p := 0 to nPl - 1 do 235 if (G.Difficulty[p] > 0) and 236 (Server(sGetChart + Mode shl 4, me, p, List^) >= rExecuted) then 237 begin 238 Pen.Color := Tribe[p].Color; 239 Stop := MyRO.Turn - 1; 240 while (Stop > 0) and (List[Stop] = 0) do 241 dec(Stop); 242 for T := 0 to Stop do 243 begin 244 r := Round(T); 245 x := Border + (InnerWidth - 2 * Border) * T div (MyRO.Turn - 1); 246 y := InnerHeight - Border - (InnerHeight - 2 * Border) * 247 r div max; 248 if T = 0 then 249 MoveTo(x, y) 250 // else if Mode=stTerritory then 251 // begin LineTo(x,y0); LineTo(x,y) end 252 else if RoundPixels[Mode] = 0 then 253 begin 254 if (y <> y0) or (T = Stop) then 255 LineTo(x, y) 256 end 257 else 258 LineTo(x, y); 259 y0 := y; 260 end; 261 end; 262 end; 263 FreeMem(List); 264 end 265 else 266 with offscreen.canvas do 267 begin 268 Font.Assign(UniFont[ftSmall]); 269 FillOffscreen(0, 0, InnerWidth, InnerHeight); 270 271 PaintColonyShip(offscreen.canvas, Player, 8, InnerWidth - 16, yArea); 272 273 ShareBar(InnerWidth div 2 - 85, InnerHeight - 62, 274 Phrases.Lookup('SHIPHAB'), MyRO.Ship[Player].Parts[spHab], 2); 275 ShareBar(InnerWidth div 2 - 85, InnerHeight - 43, 276 Phrases.Lookup('SHIPPOW'), MyRO.Ship[Player].Parts[spPow], 4); 277 ShareBar(InnerWidth div 2 - 85, InnerHeight - 24, 278 Phrases.Lookup('SHIPCOMP'), MyRO.Ship[Player].Parts[spComp], 6); 191 279 end; 192 193 Brush.Color:=$000000; 194 FillRect(Rect(0,0,InnerWidth,InnerHeight)); 195 Brush.Style:=bsClear;196 Pen.Color:=$606060; 197 MoveTo(Border,InnerHeight-Border);198 LineTo(InnerWidth-Border,InnerHeight-Border); 199 i f MyRO.Turn>=800 then LineStep:=200200 else if MyRO.Turn>=400 then LineStep:=100201 else LineStep:=50;202 for T:=0 to (MyRO.Turn-1) div LineStep do203 begin204 x:=Border+(InnerWidth-2*Border)*T*LineStep div (MyRO.Turn-1);205 MoveTo(x,Border);206 LineTo(x,InnerHeight-Border);207 s:=IntToStr(abs(TurnToYear(T*LineStep)));208 Textout(x-TextWidth(s) div 2,Border-16,s); 209 end;210 211 if max>0then212 begin213 for p:=0 to nPl-1 do214 if (G.Difficulty[p]>0)215 and (Server(sGetChart+Mode shl 4,me,p,List^)>=rExecuted) then216 begin217 Pen.Color:=Tribe[p].Color;218 Stop:=MyRO.Turn-1; 219 while (Stop>0) and (List[Stop]=0) do dec(Stop);220 for T:=0 to Stop do 221 begin222 r:=Round(T);223 x:=Border+(InnerWidth-2*Border)*T div (MyRO.Turn-1);224 y:=InnerHeight-Border-(InnerHeight-2*Border)*r div max;225 if T=0 then MoveTo(x,y)226 // else if Mode=stTerritory then 227 // begin LineTo(x,y0); LineTo(x,y) end 228 else if RoundPixels[Mode]=0 then 229 begin 230 if (y<>y0) or (T=Stop) then LineTo(x,y) 231 end232 else LineTo(x,y);233 y0:=y;234 end;235 end;236 end;237 FreeMem(List);280 MarkUsedOffscreen(InnerWidth, InnerHeight); 281 end; // OffscreenPaint 282 283 procedure TDiaDlg.FormPaint(Sender: TObject); 284 var 285 s: string; 286 begin 287 inherited; 288 canvas.Font.Assign(UniFont[ftNormal]); 289 if Kind = dkChart then 290 s := Phrases.Lookup('DIAGRAM', Mode) 291 else 292 s := Tribe[Player].TPhrase('SHORTNAME'); 293 LoweredTextOut(canvas, -1, MainTexture, 294 (ClientWidth - BiColorTextWidth(canvas, s)) div 2, 31, s); 295 end; 296 297 procedure TDiaDlg.FormShow(Sender: TObject); 298 begin 299 if WindowMode = wmModal then 300 begin { center on screen } 301 Left := (Screen.Width - Width) div 2; 302 Top := (Screen.Height - Height) div 2; 303 end; 304 OffscreenPaint; 305 end; 306 307 procedure TDiaDlg.ShowNewContent_Charts(NewMode: integer); 308 begin 309 Kind := dkChart; 310 Mode := stPop; 311 ToggleBtn.ButtonIndex := 15; 312 ToggleBtn.Hint := Phrases.Lookup('BTN_PAGE'); 313 Caption := Phrases.Lookup('TITLE_DIAGRAMS'); 314 inherited ShowNewContent(NewMode); 315 end; 316 317 procedure TDiaDlg.ShowNewContent_Ship(NewMode, p: integer); 318 begin 319 Kind := dkShip; 320 if p < 0 then 321 begin 322 Player := me; 323 while MyRO.Ship[Player].Parts[spComp] + MyRO.Ship[Player].Parts[spPow] + 324 MyRO.Ship[Player].Parts[spHab] = 0 do 325 Player := (Player + 1) mod nPl; 238 326 end 239 else with offscreen.Canvas do 240 begin 241 Font.Assign(UniFont[ftSmall]); 242 FillOffscreen(0,0,InnerWidth,InnerHeight); 243 244 PaintColonyShip(offscreen.Canvas,Player,8,InnerWidth-16,yArea); 245 246 ShareBar(InnerWidth div 2-85,InnerHeight-62,Phrases.Lookup('SHIPHAB'), 247 MyRO.Ship[Player].Parts[spHab],2); 248 ShareBar(InnerWidth div 2-85,InnerHeight-43,Phrases.Lookup('SHIPPOW'), 249 MyRO.Ship[Player].Parts[spPow],4); 250 ShareBar(InnerWidth div 2-85,InnerHeight-24,Phrases.Lookup('SHIPCOMP'), 251 MyRO.Ship[Player].Parts[spComp],6); 252 end; 253 MarkUsedOffscreen(InnerWidth,InnerHeight); 254 end; // OffscreenPaint 255 256 procedure TDiaDlg.FormPaint(Sender: TObject); 257 var 258 s: string; 259 begin 260 inherited; 261 Canvas.Font.Assign(UniFont[ftNormal]); 262 if Kind=dkChart then s:=Phrases.Lookup('DIAGRAM',Mode) 263 else s:=Tribe[Player].TPhrase('SHORTNAME'); 264 LoweredTextOut(Canvas, -1, MainTexture, 265 (ClientWidth-BiColorTextWidth(Canvas,s)) div 2, 31, s); 266 end; 267 268 procedure TDiaDlg.FormShow(Sender: TObject); 269 begin 270 if WindowMode=wmModal then 271 begin {center on screen} 272 Left:=(Screen.Width-Width) div 2; 273 Top:=(Screen.Height-Height) div 2; 274 end; 275 OffscreenPaint; 276 end; 277 278 procedure TDiaDlg.ShowNewContent_Charts(NewMode: integer); 279 begin 280 Kind:=dkChart; 281 Mode:=stPop; 282 ToggleBtn.ButtonIndex:=15; 283 ToggleBtn.Hint:=Phrases.Lookup('BTN_PAGE'); 284 Caption:=Phrases.Lookup('TITLE_DIAGRAMS'); 285 inherited ShowNewContent(NewMode); 286 end; 287 288 procedure TDiaDlg.ShowNewContent_Ship(NewMode,p: integer); 289 begin 290 Kind:=dkShip; 291 if p<0 then 292 begin 293 Player:=me; 294 while MyRO.Ship[Player].Parts[spComp]+MyRO.Ship[Player].Parts[spPow] 295 +MyRO.Ship[Player].Parts[spHab]=0 do 296 Player:=(Player+1) mod nPl; 327 else 328 Player := p; 329 ToggleBtn.ButtonIndex := 28; 330 ToggleBtn.Hint := Phrases.Lookup('BTN_SELECT'); 331 Caption := Phrases.Lookup('TITLE_SHIPS'); 332 inherited ShowNewContent(NewMode); 333 end; 334 335 procedure TDiaDlg.ToggleBtnClick(Sender: TObject); 336 var 337 p1: integer; 338 m: TMenuItem; 339 begin 340 if Kind = dkChart then 341 begin 342 Mode := (Mode + 1) mod nStat; 343 OffscreenPaint; 344 Invalidate; 297 345 end 298 else Player:=p; 299 ToggleBtn.ButtonIndex:=28; 300 ToggleBtn.Hint:=Phrases.Lookup('BTN_SELECT');301 Caption:=Phrases.Lookup('TITLE_SHIPS'); 302 inherited ShowNewContent(NewMode); 303 end; 304 305 procedure TDiaDlg.ToggleBtnClick(Sender: TObject);306 var 307 p1: integer;308 m: TMenuItem;309 begin 310 if Kind=dkChartthen311 begin312 Mode:=(Mode+1) mod nStat;313 OffscreenPaint;314 Invalidate;346 else 347 begin 348 EmptyMenu(Popup.Items); 349 for p1 := 0 to nPl - 1 do 350 if MyRO.Ship[p1].Parts[spComp] + MyRO.Ship[p1].Parts[spPow] + 351 MyRO.Ship[p1].Parts[spHab] > 0 then 352 begin 353 m := TMenuItem.Create(Popup); 354 m.RadioItem := true; 355 m.Caption := Tribe[p1].TPhrase('SHORTNAME'); 356 m.Tag := p1; 357 m.OnClick := PlayerClick; 358 if p1 = Player then 359 m.Checked := true; 360 Popup.Items.Add(m); 361 end; 362 Popup.Popup(Left + ToggleBtn.Left, Top + ToggleBtn.Top + ToggleBtn.Height); 315 363 end 316 else317 begin318 EmptyMenu(Popup.Items);319 for p1:=0 to nPl-1 do320 if MyRO.Ship[p1].Parts[spComp]+MyRO.Ship[p1].Parts[spPow]321 +MyRO.Ship[p1].Parts[spHab]>0 then322 begin323 m:=TMenuItem.Create(Popup);324 m.RadioItem:=true;325 m.Caption:=Tribe[p1].TPhrase('SHORTNAME');326 m.Tag:=p1;327 m.OnClick:=PlayerClick;328 if p1=Player then m.Checked:=true;329 Popup.Items.Add(m);330 end;331 Popup.Popup(Left+ToggleBtn.Left, Top+ToggleBtn.Top+ToggleBtn.Height);332 end333 364 end; 334 365 335 366 procedure TDiaDlg.PlayerClick(Sender: TObject); 336 367 begin 337 ShowNewContent_Ship(FWindowMode, TComponent(Sender).Tag);368 ShowNewContent_Ship(FWindowMode, TComponent(Sender).Tag); 338 369 end; 339 370 … … 341 372 Shift: TShiftState); 342 373 begin 343 if (Key=VK_F6) and (Kind=dkChart) then // my key 344 ToggleBtnClick(nil) 345 else if (Key=VK_F8) and (Kind=dkShip) then // my other key 346 else inherited 374 if (Key = VK_F6) and (Kind = dkChart) then // my key 375 ToggleBtnClick(nil) 376 else if (Key = VK_F8) and (Kind = dkShip) then // my other key 377 else 378 inherited 347 379 end; 348 380 349 381 end. 350 -
trunk/LocalPlayer/Diplomacy.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit Diplomacy; 4 3 … … 7 6 uses Protocol; 8 7 9 function DipCommandToString(pSender, pTarget, Treaty, OppCommand, Command: integer;10 const OppOffer, Offer: TOffer): string;8 function DipCommandToString(pSender, pTarget, Treaty, OppCommand, 9 Command: integer; const OppOffer, Offer: TOffer): string; 11 10 12 11 implementation 13 12 14 13 uses 15 ScreenTools,Tribes,SysUtils;14 ScreenTools, Tribes, SysUtils; 16 15 17 16 function DipCommandToString; … … 19 18 function PriceToString(p, Price: integer): string; 20 19 begin 21 case Price and opMask of22 opChoose:23 result:=Phrases.Lookup('PRICE_CHOOSE');24 opCivilReport:25 result:=Tribe[p].TPhrase('PRICE_CIVIL');26 opMilReport:27 result:=Tribe[p].TPhrase('PRICE_MIL');28 opMap:29 result:=Tribe[p].TPhrase('PRICE_MAP');30 opTreaty:31 {if Price-opTreaty<Treaty then32 case Treaty of20 case Price and opMask of 21 opChoose: 22 result := Phrases.Lookup('PRICE_CHOOSE'); 23 opCivilReport: 24 result := Tribe[p].TPhrase('PRICE_CIVIL'); 25 opMilReport: 26 result := Tribe[p].TPhrase('PRICE_MIL'); 27 opMap: 28 result := Tribe[p].TPhrase('PRICE_MAP'); 29 opTreaty: 30 { if Price-opTreaty<Treaty then 31 case Treaty of 33 32 trPeace: result:=Phrases.Lookup('FRENDTREATY_PEACE'); 34 33 trFriendlyContact: result:=Phrases.Lookup('FRENDTREATY_FRIENDLY'); 35 34 trAlliance: result:=Phrases.Lookup('FRENDTREATY_ALLIANCE'); 36 35 end 37 else} result:=Phrases.Lookup('TREATY',Price-opTreaty); 38 opShipParts: 39 case Price shr 16 and $f of 40 0: result:=Format(Phrases.Lookup('PRICE_SHIPCOMP'),[Price and $FFFF]); 41 1: result:=Format(Phrases.Lookup('PRICE_SHIPPOW'),[Price and $FFFF]); 42 2: result:=Format(Phrases.Lookup('PRICE_SHIPHAB'),[Price and $FFFF]); 43 end; 44 opMoney: 45 result:=Format('%d%%c',[Price-opMoney]); 46 opTribute: 47 result:=Format(Phrases.Lookup('PRICE_TRIBUTE'),[Price-opTribute]); 48 opTech: 49 result:=Phrases.Lookup('ADVANCES',Price-opTech); 50 opAllTech: 51 result:=Tribe[p].TPhrase('PRICE_ALLTECH'); 52 opModel: 53 result:=Tribe[p].ModelName[Price-opModel]; 54 opAllModel: 55 result:=Tribe[p].TPhrase('PRICE_ALLMODEL'); 56 { opCity: 57 result:=Format(TPhrase('PRICE_CITY',p),[CityName(Price-opCity)]);} 36 else } result := Phrases.Lookup('TREATY', Price - opTreaty); 37 opShipParts: 38 case Price shr 16 and $F of 39 0: 40 result := Format(Phrases.Lookup('PRICE_SHIPCOMP'), 41 [Price and $FFFF]); 42 1: 43 result := Format(Phrases.Lookup('PRICE_SHIPPOW'), 44 [Price and $FFFF]); 45 2: 46 result := Format(Phrases.Lookup('PRICE_SHIPHAB'), 47 [Price and $FFFF]); 48 end; 49 opMoney: 50 result := Format('%d%%c', [Price - opMoney]); 51 opTribute: 52 result := Format(Phrases.Lookup('PRICE_TRIBUTE'), [Price - opTribute]); 53 opTech: 54 result := Phrases.Lookup('ADVANCES', Price - opTech); 55 opAllTech: 56 result := Tribe[p].TPhrase('PRICE_ALLTECH'); 57 opModel: 58 result := Tribe[p].ModelName[Price - opModel]; 59 opAllModel: 60 result := Tribe[p].TPhrase('PRICE_ALLMODEL'); 61 { opCity: 62 result:=Format(TPhrase('PRICE_CITY',p),[CityName(Price-opCity)]); } 58 63 end 59 64 end; 60 65 61 66 var 62 i: integer;63 sAdd,sDeliver, sCost: string;64 DoIntro: boolean;67 i: integer; 68 sAdd, sDeliver, sCost: string; 69 DoIntro: boolean; 65 70 begin 66 DoIntro:= OppCommand=scDipStart; 67 case Command of 68 scDipCancelTreaty: 69 begin 70 case Treaty of 71 trPeace: result:=Phrases.Lookup('FRCANCELTREATY_PEACE'); 72 trFriendlyContact: result:=Phrases.Lookup('FRCANCELTREATY_FRIENDLY'); 73 trAlliance: result:=Phrases.Lookup('FRCANCELTREATY_ALLIANCE'); 74 end; 75 DoIntro:=false; 76 end; 77 scDipNotice: result:=Phrases.Lookup('FRNOTICE'); 78 scDipAccept: 79 begin 80 if (OppOffer.nDeliver+OppOffer.nCost=1) 81 and (OppOffer.Price[0] and opMask=opTreaty) 82 and (integer(OppOffer.Price[0]-opTreaty)>Treaty) then // simple treaty offer 83 {if OppOffer.Price[0]-opTreaty=trCeaseFire then 84 result:=Tribe[pTarget].TPhrase('FRACCEPTCEASEFIRE') 85 else} result:=Tribe[pTarget].TPhrase('FRACCEPTTREATY') 86 else if OppOffer.nDeliver=0 then 87 result:=Tribe[pSender].TPhrase('FRACCEPTDEMAND_STRONG') 88 else if OppOffer.nCost=0 then 89 result:=Tribe[pSender].TPhrase('FRACCEPTPRESENT') 90 else result:=Tribe[pSender].TPhrase('FRACCEPTOFFER'); 91 end; 92 scDipBreak: 93 begin 94 result:=Tribe[pTarget].TPhrase('FRBREAK'); 95 DoIntro:=false; 96 end; 97 scDipOffer: 98 begin 99 result:=''; 100 if (OppCommand=scDipOffer) and ((OppOffer.nDeliver>0) or (OppOffer.nCost>0)) 101 and (Offer.nCost+Offer.nDeliver<=2) then 102 begin // respond to made offer before making own one 103 if (OppOffer.nDeliver+OppOffer.nCost=1) 104 and (OppOffer.Price[0] and opMask=opTreaty) 105 and (integer(OppOffer.Price[0]-opTreaty)>Treaty) then // simple treaty offer 106 result:=Tribe[pSender].TPhrase('FRNOTACCEPTTREATY')+'\' 107 else if OppOffer.nDeliver=0 then 108 result:=Tribe[pSender].TPhrase('FRNOTACCEPTDEMAND_STRONG')+'\' 109 else if OppOffer.nCost=0 then 110 result:=Tribe[pSender].TPhrase('FRNOTACCEPTPRESENT')+'\'; 111 end; 112 113 sDeliver:=''; 114 for i:=0 to Offer.nDeliver-1 do 115 begin 116 sAdd:=PriceToString(pSender,Offer.Price[i]); 117 if i=0 then sDeliver:=sAdd 118 else sDeliver:=Format(Phrases.Lookup('PRICE_CONCAT'),[sDeliver,sAdd]) 119 end; 120 sCost:=''; 121 for i:=0 to Offer.nCost-1 do 122 begin 123 sAdd:=PriceToString(pTarget,Offer.Price[Offer.nDeliver+i]); 124 if i=0 then sCost:=sAdd 125 else sCost:=Format(Phrases.Lookup('PRICE_CONCAT'),[sCost,sAdd]) 126 end; 127 128 if (Offer.nDeliver=0) and (Offer.nCost=0) then 129 begin // no offer made 130 if (OppCommand=scDipOffer) and ((OppOffer.nDeliver=0) and (OppOffer.nCost=0)) then 131 result:=Tribe[pTarget].TPhrase('FRBYE') 132 else 133 begin 134 if (result='') and (OppCommand=scDipOffer) 135 and ((OppOffer.nDeliver>0) or (OppOffer.nCost>0)) then 71 DoIntro := OppCommand = scDipStart; 72 case Command of 73 scDipCancelTreaty: 74 begin 75 case Treaty of 76 trPeace: 77 result := Phrases.Lookup('FRCANCELTREATY_PEACE'); 78 trFriendlyContact: 79 result := Phrases.Lookup('FRCANCELTREATY_FRIENDLY'); 80 trAlliance: 81 result := Phrases.Lookup('FRCANCELTREATY_ALLIANCE'); 82 end; 83 DoIntro := false; 84 end; 85 scDipNotice: 86 result := Phrases.Lookup('FRNOTICE'); 87 scDipAccept: 88 begin 89 if (OppOffer.nDeliver + OppOffer.nCost = 1) and 90 (OppOffer.Price[0] and opMask = opTreaty) and 91 (integer(OppOffer.Price[0] - opTreaty) > Treaty) then 92 // simple treaty offer 93 { if OppOffer.Price[0]-opTreaty=trCeaseFire then 94 result:=Tribe[pTarget].TPhrase('FRACCEPTCEASEFIRE') 95 else } result := Tribe[pTarget].TPhrase('FRACCEPTTREATY') 96 else if OppOffer.nDeliver = 0 then 97 result := Tribe[pSender].TPhrase('FRACCEPTDEMAND_STRONG') 98 else if OppOffer.nCost = 0 then 99 result := Tribe[pSender].TPhrase('FRACCEPTPRESENT') 100 else 101 result := Tribe[pSender].TPhrase('FRACCEPTOFFER'); 102 end; 103 scDipBreak: 104 begin 105 result := Tribe[pTarget].TPhrase('FRBREAK'); 106 DoIntro := false; 107 end; 108 scDipOffer: 109 begin 110 result := ''; 111 if (OppCommand = scDipOffer) and 112 ((OppOffer.nDeliver > 0) or (OppOffer.nCost > 0)) and 113 (Offer.nCost + Offer.nDeliver <= 2) then 114 begin // respond to made offer before making own one 115 if (OppOffer.nDeliver + OppOffer.nCost = 1) and 116 (OppOffer.Price[0] and opMask = opTreaty) and 117 (integer(OppOffer.Price[0] - opTreaty) > Treaty) then 118 // simple treaty offer 119 result := Tribe[pSender].TPhrase('FRNOTACCEPTTREATY') + '\' 120 else if OppOffer.nDeliver = 0 then 121 result := Tribe[pSender].TPhrase('FRNOTACCEPTDEMAND_STRONG') + '\' 122 else if OppOffer.nCost = 0 then 123 result := Tribe[pSender].TPhrase('FRNOTACCEPTPRESENT') + '\'; 124 end; 125 126 sDeliver := ''; 127 for i := 0 to Offer.nDeliver - 1 do 128 begin 129 sAdd := PriceToString(pSender, Offer.Price[i]); 130 if i = 0 then 131 sDeliver := sAdd 132 else 133 sDeliver := Format(Phrases.Lookup('PRICE_CONCAT'), [sDeliver, sAdd]) 134 end; 135 sCost := ''; 136 for i := 0 to Offer.nCost - 1 do 137 begin 138 sAdd := PriceToString(pTarget, Offer.Price[Offer.nDeliver + i]); 139 if i = 0 then 140 sCost := sAdd 141 else 142 sCost := Format(Phrases.Lookup('PRICE_CONCAT'), [sCost, sAdd]) 143 end; 144 145 if (Offer.nDeliver = 0) and (Offer.nCost = 0) then 146 begin // no offer made 147 if (OppCommand = scDipOffer) and 148 ((OppOffer.nDeliver = 0) and (OppOffer.nCost = 0)) then 149 result := Tribe[pTarget].TPhrase('FRBYE') 150 else 136 151 begin 137 if (OppOffer.nDeliver=1) and (OppOffer.Price[0]=opChoose) 138 and not Phrases2FallenBackToEnglish then 139 result:=Tribe[pSender].TString(Phrases2.Lookup('FRNOTACCEPTANYOFFER'))+' ' 140 else if (OppOffer.nCost=1) and (OppOffer.Price[OppOffer.nDeliver]=opChoose) 141 and not Phrases2FallenBackToEnglish then 142 result:=Tribe[pSender].TString(Phrases2.Lookup('FRNOTACCEPTANYWANT'))+' ' 143 else result:=Tribe[pSender].TPhrase('FRNOTACCEPTOFFER')+' '; 144 end; 145 result:=result+Phrases.Lookup('FRDONE'); 146 DoIntro:=false 152 if (result = '') and (OppCommand = scDipOffer) and 153 ((OppOffer.nDeliver > 0) or (OppOffer.nCost > 0)) then 154 begin 155 if (OppOffer.nDeliver = 1) and (OppOffer.Price[0] = opChoose) and 156 not Phrases2FallenBackToEnglish then 157 result := Tribe[pSender].TString 158 (Phrases2.Lookup('FRNOTACCEPTANYOFFER')) + ' ' 159 else if (OppOffer.nCost = 1) and 160 (OppOffer.Price[OppOffer.nDeliver] = opChoose) and not Phrases2FallenBackToEnglish 161 then 162 result := Tribe[pSender].TString 163 (Phrases2.Lookup('FRNOTACCEPTANYWANT')) + ' ' 164 else 165 result := Tribe[pSender].TPhrase('FRNOTACCEPTOFFER') + ' '; 166 end; 167 result := result + Phrases.Lookup('FRDONE'); 168 DoIntro := false 169 end 147 170 end 148 end 149 else if (Offer.nDeliver+Offer.nCost=1) 150 and (Offer.Price[0] and opMask=opTreaty) 151 and (integer(Offer.Price[0]-opTreaty)>Treaty) then // simple treaty offer 152 begin 153 case Offer.Price[0]-opTreaty of 154 //trCeaseFire: result:=result+Tribe[pTarget].TPhrase('FRCEASEFIRE'); 155 trPeace: result:=result+Tribe[pTarget].TPhrase('FRPEACE'); 156 trFriendlyContact: result:=result+Tribe[pTarget].TPhrase('FRFRIENDLY'); 157 trAlliance: result:=result+Tribe[pTarget].TPhrase('FRALLIANCE'); 171 else if (Offer.nDeliver + Offer.nCost = 1) and 172 (Offer.Price[0] and opMask = opTreaty) and 173 (integer(Offer.Price[0] - opTreaty) > Treaty) then 174 // simple treaty offer 175 begin 176 case Offer.Price[0] - opTreaty of 177 // trCeaseFire: result:=result+Tribe[pTarget].TPhrase('FRCEASEFIRE'); 178 trPeace: 179 result := result + Tribe[pTarget].TPhrase('FRPEACE'); 180 trFriendlyContact: 181 result := result + Tribe[pTarget].TPhrase('FRFRIENDLY'); 182 trAlliance: 183 result := result + Tribe[pTarget].TPhrase('FRALLIANCE'); 184 end 158 185 end 159 end 160 else if Offer.nDeliver=0 then // demand 161 begin 162 if (Treaty>=trFriendlyContact) and not Phrases2FallenBackToEnglish then 163 result:=result+Format(Tribe[pTarget].TString(Phrases2.Lookup('FRDEMAND_SOFT')),[sCost]) 164 else 165 begin 166 result:=result+Format(Tribe[pTarget].TPhrase('FRDEMAND_STRONG'),[sCost]); 167 DoIntro:=false 186 else if Offer.nDeliver = 0 then // demand 187 begin 188 if (Treaty >= trFriendlyContact) and not Phrases2FallenBackToEnglish 189 then 190 result := result + 191 Format(Tribe[pTarget].TString(Phrases2.Lookup('FRDEMAND_SOFT') 192 ), [sCost]) 193 else 194 begin 195 result := result + 196 Format(Tribe[pTarget].TPhrase('FRDEMAND_STRONG'), [sCost]); 197 DoIntro := false 198 end 168 199 end 169 end 170 else if Offer.nCost=0 then // present 171 result:=result+Format(Tribe[pTarget].TPhrase('FRPRESENT'),[sDeliver]) 172 else if (Offer.nDeliver=1) and (Offer.Price[0]=opChoose) then 173 result:=result+Format(Phrases.Lookup('FRDELCHOICE'),[sCost]) 174 else if (Offer.nCost=1) and (Offer.Price[Offer.nDeliver]=opChoose) then 175 result:=result+Format(Phrases.Lookup('FRCOSTCHOICE'),[sDeliver]) 176 else result:=result+Format(Phrases.Lookup('FROFFER'),[sDeliver,sCost]); 177 end; 200 else if Offer.nCost = 0 then // present 201 result := result + Format(Tribe[pTarget].TPhrase('FRPRESENT'), 202 [sDeliver]) 203 else if (Offer.nDeliver = 1) and (Offer.Price[0] = opChoose) then 204 result := result + Format(Phrases.Lookup('FRDELCHOICE'), [sCost]) 205 else if (Offer.nCost = 1) and (Offer.Price[Offer.nDeliver] = opChoose) 206 then 207 result := result + Format(Phrases.Lookup('FRCOSTCHOICE'), [sDeliver]) 208 else 209 result := result + Format(Phrases.Lookup('FROFFER'), 210 [sDeliver, sCost]); 211 end; 178 212 end; 179 if DoIntro then 180 if Treaty<trPeace then 181 result:=Tribe[pSender].TPhrase('FRSTART_NOTREATY')+' '+result 182 else result:=Tribe[pSender].TPhrase('FRSTART_PEACE')+' '+result 213 if DoIntro then 214 if Treaty < trPeace then 215 result := Tribe[pSender].TPhrase('FRSTART_NOTREATY') + ' ' + result 216 else 217 result := Tribe[pSender].TPhrase('FRSTART_PEACE') + ' ' + result 183 218 end; 184 219 185 220 end. 186 -
trunk/LocalPlayer/Draft.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit Draft; 4 3 … … 6 5 7 6 uses 8 Protocol,ClientTools,Term,ScreenTools,PVSB,BaseWin, 9 10 Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,ExtCtrls,ButtonA, 7 Protocol, ClientTools, Term, ScreenTools, PVSB, BaseWin, 8 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, 10 ButtonA, 11 11 ButtonB, ButtonBase, Area; 12 12 … … 28 28 procedure FormDestroy(Sender: TObject); 29 29 public 30 procedure ShowNewContent(NewMode: integer); 30 procedure ShowNewContent(NewMode: integer); 31 31 protected 32 32 procedure OffscreenPaint; override; 33 33 private 34 Domain, MaxLines,Lines,Cut,yDomain,yFeature,yWeight,yTotal,yView,IncCap,35 DecCap: integer;36 code: array [0..nFeature-1] of integer;37 Template, Back: TBitmap;38 function IsFeatureInList(d, i: integer): boolean;34 Domain, MaxLines, Lines, Cut, yDomain, yFeature, yWeight, yTotal, yView, 35 IncCap, DecCap: integer; 36 code: array [0 .. nFeature - 1] of integer; 37 Template, Back: TBitmap; 38 function IsFeatureInList(d, i: integer): boolean; 39 39 procedure SetDomain(d: integer); 40 40 end; … … 45 45 implementation 46 46 47 uses Help, Tribes,Directories;47 uses Help, Tribes, Directories; 48 48 49 49 {$R *.DFM} 50 50 51 51 const 52 MaxLines0=11; LinePitch=20; 53 xDomain=30; yDomain0=464; DomainPitch=40; 54 xFeature=38; yFeature0=42; 55 xWeight=100; yWeight0=271; 56 xTotal=20; xTotal2=34; yTotal0=354; 57 xView=17; yView0=283; 52 MaxLines0 = 11; 53 LinePitch = 20; 54 xDomain = 30; 55 yDomain0 = 464; 56 DomainPitch = 40; 57 xFeature = 38; 58 yFeature0 = 42; 59 xWeight = 100; 60 yWeight0 = 271; 61 xTotal = 20; 62 xTotal2 = 34; 63 yTotal0 = 354; 64 xView = 17; 65 yView0 = 283; 58 66 59 67 procedure TDraftDlg.FormCreate(Sender: TObject); 60 68 begin 61 inherited;62 InitButtons();63 HelpContext:='CLASSES';64 Caption:=Phrases.Lookup('TITLE_DRAFT');65 OKBtn.Caption:=Phrases.Lookup('BTN_OK');66 67 if not Phrases2FallenBackToEnglish then68 begin 69 GroundArea.Hint:=Phrases2.Lookup('DRAFTDOMAIN',0);70 SeaArea.Hint:=Phrases2.Lookup('DRAFTDOMAIN',1);71 AirArea.Hint:=Phrases2.Lookup('DRAFTDOMAIN',2);69 inherited; 70 InitButtons(); 71 HelpContext := 'CLASSES'; 72 Caption := Phrases.Lookup('TITLE_DRAFT'); 73 OKBtn.Caption := Phrases.Lookup('BTN_OK'); 74 75 if not Phrases2FallenBackToEnglish then 76 begin 77 GroundArea.Hint := Phrases2.Lookup('DRAFTDOMAIN', 0); 78 SeaArea.Hint := Phrases2.Lookup('DRAFTDOMAIN', 1); 79 AirArea.Hint := Phrases2.Lookup('DRAFTDOMAIN', 2); 72 80 end 73 else 74 begin 75 GroundArea.Hint:=Phrases.Lookup('DOMAIN',0); 76 SeaArea.Hint:=Phrases.Lookup('DOMAIN',1); 77 AirArea.Hint:=Phrases.Lookup('DOMAIN',2); 78 end; 79 80 Back:=TBitmap.Create; 81 Back.PixelFormat:=pf24bit; 82 Back.Width:=ClientWidth; Back.Height:=ClientHeight; 83 Template:=TBitmap.Create; 84 LoadGraphicFile(Template, HomeDir+'Graphics\MiliRes', gfNoGamma); 85 Template.PixelFormat:=pf8bit; 81 else 82 begin 83 GroundArea.Hint := Phrases.Lookup('DOMAIN', 0); 84 SeaArea.Hint := Phrases.Lookup('DOMAIN', 1); 85 AirArea.Hint := Phrases.Lookup('DOMAIN', 2); 86 end; 87 88 Back := TBitmap.Create; 89 Back.PixelFormat := pf24bit; 90 Back.Width := ClientWidth; 91 Back.Height := ClientHeight; 92 Template := TBitmap.Create; 93 LoadGraphicFile(Template, HomeDir + 'Graphics\MiliRes', gfNoGamma); 94 Template.PixelFormat := pf8bit; 86 95 end; 87 96 88 97 procedure TDraftDlg.FormDestroy(Sender: TObject); 89 98 begin 90 Template.Free;99 Template.Free; 91 100 end; 92 101 93 102 procedure TDraftDlg.CloseBtnClick(Sender: TObject); 94 103 begin 95 ModalResult:=mrCancel;104 ModalResult := mrCancel; 96 105 end; 97 106 … … 100 109 function DomainAvailable(d: integer): boolean; 101 110 begin 102 result:=(upgrade[d,0].Preq=preNone)103 or (MyRO.Tech[upgrade[d,0].Preq]>=tsApplicable);111 result := (upgrade[d, 0].Preq = preNone) or 112 (MyRO.Tech[upgrade[d, 0].Preq] >= tsApplicable); 104 113 end; 105 114 106 115 procedure PaintTotalBars; 107 116 var 108 i,y,dx,num,w: integer; 109 s: string; 110 begin 111 with offscreen.Canvas do 112 begin 113 // strength bar 114 y:=yTotal; 115 DarkGradient(Offscreen.Canvas,xTotal-6,y+1,184,2); 116 DarkGradient(Offscreen.Canvas,xTotal2+172,y+1,95,2); 117 RisedTextOut(Offscreen.Canvas,xTotal-2,y,Phrases.Lookup('UNITSTRENGTH')); 118 RisedTextOut(Offscreen.Canvas,xTotal+112+30,y,'x'+IntToStr(MyRO.DevModel.MStrength)); 119 RisedTextOut(Offscreen.Canvas,xTotal2+148+30,y,'='); 120 s:=IntToStr(MyRO.DevModel.Attack)+'/'+IntToStr(MyRO.DevModel.Defense); 121 RisedTextOut(Offscreen.Canvas,xTotal2+170+64+30-BiColorTextWidth(Offscreen.Canvas,s),y,s); 122 123 // transport bar 124 if MyRO.DevModel.MTrans>0 then 117 i, y, dx, num, w: integer; 118 s: string; 119 begin 120 with offscreen.Canvas do 121 begin 122 // strength bar 123 y := yTotal; 124 DarkGradient(offscreen.Canvas, xTotal - 6, y + 1, 184, 2); 125 DarkGradient(offscreen.Canvas, xTotal2 + 172, y + 1, 95, 2); 126 RisedTextOut(offscreen.Canvas, xTotal - 2, y, 127 Phrases.Lookup('UNITSTRENGTH')); 128 RisedTextOut(offscreen.Canvas, xTotal + 112 + 30, y, 129 'x' + IntToStr(MyRO.DevModel.MStrength)); 130 RisedTextOut(offscreen.Canvas, xTotal2 + 148 + 30, y, '='); 131 s := IntToStr(MyRO.DevModel.Attack) + '/' + 132 IntToStr(MyRO.DevModel.Defense); 133 RisedTextOut(offscreen.Canvas, xTotal2 + 170 + 64 + 30 - 134 BiColorTextWidth(offscreen.Canvas, s), y, s); 135 136 // transport bar 137 if MyRO.DevModel.MTrans > 0 then 125 138 begin 126 y:=yTotal+19; 127 DarkGradient(Offscreen.Canvas,xTotal-6,y+1,184,1); 128 DarkGradient(Offscreen.Canvas,xTotal2+172,y+1,95,1); 129 RisedTextOut(Offscreen.Canvas,xTotal-2,y,Phrases.Lookup('UNITTRANSPORT')); 130 RisedTextOut(Offscreen.Canvas,xTotal+112+30,y,'x'+IntToStr(MyRO.DevModel.MTrans)); 131 RisedTextOut(Offscreen.Canvas,xTotal2+148+30,y,'='); 132 133 Font.Color:=$000000; 134 dx:=-237-30; 135 for i:=mcFirstNonCap-1 downto 3 do 136 if i in [mcSeaTrans,mcCarrier,mcAirTrans] then 139 y := yTotal + 19; 140 DarkGradient(offscreen.Canvas, xTotal - 6, y + 1, 184, 1); 141 DarkGradient(offscreen.Canvas, xTotal2 + 172, y + 1, 95, 1); 142 RisedTextOut(offscreen.Canvas, xTotal - 2, y, 143 Phrases.Lookup('UNITTRANSPORT')); 144 RisedTextOut(offscreen.Canvas, xTotal + 112 + 30, y, 145 'x' + IntToStr(MyRO.DevModel.MTrans)); 146 RisedTextOut(offscreen.Canvas, xTotal2 + 148 + 30, y, '='); 147 148 Font.Color := $000000; 149 dx := -237 - 30; 150 for i := mcFirstNonCap - 1 downto 3 do 151 if i in [mcSeaTrans, mcCarrier, mcAirTrans] then 137 152 begin 138 num:=MyRO.DevModel.Cap[i]*MyRO.DevModel.MTrans;139 if num>0 then153 num := MyRO.DevModel.Cap[i] * MyRO.DevModel.MTrans; 154 if num > 0 then 140 155 begin 141 inc(dx,15); 142 Brush.Color:=$C0C0C0; 143 FrameRect(Rect(xTotal2-3-dx,y+2,xTotal2+11-dx,y+16)); 144 Brush.Style:=bsClear; 145 Sprite(Offscreen,HGrSystem,xTotal2-1-dx,y+4,10,10,66+i mod 11 *11,137+i div 11 *11); 146 if num>1 then 156 inc(dx, 15); 157 Brush.Color := $C0C0C0; 158 FrameRect(Rect(xTotal2 - 3 - dx, y + 2, 159 xTotal2 + 11 - dx, y + 16)); 160 Brush.Style := bsClear; 161 Sprite(offscreen, HGrSystem, xTotal2 - 1 - dx, y + 4, 10, 10, 162 66 + i mod 11 * 11, 137 + i div 11 * 11); 163 if num > 1 then 147 164 begin 148 s:=IntToStr(num); 149 w:=TextWidth(s); 150 inc(dx,w+1); 151 Brush.Color:=$FFFFFF; 152 FillRect(Rect(xTotal2-3-dx,y+2,xTotal2+w-1-dx,y+16)); 153 Brush.Style:=bsClear; 154 Textout(xTotal2-3-dx+1,y,s); 165 s := IntToStr(num); 166 w := TextWidth(s); 167 inc(dx, w + 1); 168 Brush.Color := $FFFFFF; 169 FillRect(Rect(xTotal2 - 3 - dx, y + 2, 170 xTotal2 + w - 1 - dx, y + 16)); 171 Brush.Style := bsClear; 172 Textout(xTotal2 - 3 - dx + 1, y, s); 155 173 end; 156 174 end; … … 158 176 end; 159 177 160 // speed bar 161 y:=yTotal+38; 162 LoweredTextOut(offscreen.Canvas,-1,MainTexture,xTotal-2,y,Phrases.Lookup('UNITSPEED')); 163 DLine(offscreen.Canvas,xTotal-2,xTotal+174,y+16,MainTexture.clBevelShade, 164 MainTexture.clBevelLight); 165 DLine(offscreen.Canvas,xTotal2+176,xTotal2+263,y+16,MainTexture.clBevelShade, 166 MainTexture.clBevelLight); 167 s:=MovementToString(MyRO.DevModel.Speed); 168 RisedTextOut(offscreen.Canvas,xTotal2+170+64+30-TextWidth(s),y,s); 169 170 // cost bar 171 y:=yTotal+57; 172 LoweredTextOut(offscreen.Canvas,-1,MainTexture,xTotal-2,y,Phrases.Lookup('UNITCOST')); 173 LoweredTextOut(Offscreen.Canvas,-1,MainTexture,xTotal+112+30,y,'x'+IntToStr(MyRO.DevModel.MCost)); 174 LoweredTextOut(Offscreen.Canvas,-1,MainTexture,xTotal2+148+30,y,'='); 175 DLine(offscreen.Canvas,xTotal-2,xTotal+174,y+16,MainTexture.clBevelShade, 176 MainTexture.clBevelLight); 177 DLine(offscreen.Canvas,xTotal2+176,xTotal2+263,y+16,MainTexture.clBevelShade, 178 MainTexture.clBevelLight); 179 s:=IntToStr(MyRO.DevModel.Cost); 180 RisedTextOut(offscreen.Canvas,xTotal2+170+64+30-12-TextWidth(s),y,s); 181 Sprite(offscreen,HGrSystem,xTotal2+170+54+30,y+4,10,10,88,115); 182 183 if G.Difficulty[me]<>2 then 178 // speed bar 179 y := yTotal + 38; 180 LoweredTextOut(offscreen.Canvas, -1, MainTexture, xTotal - 2, y, 181 Phrases.Lookup('UNITSPEED')); 182 DLine(offscreen.Canvas, xTotal - 2, xTotal + 174, y + 16, 183 MainTexture.clBevelShade, MainTexture.clBevelLight); 184 DLine(offscreen.Canvas, xTotal2 + 176, xTotal2 + 263, y + 16, 185 MainTexture.clBevelShade, MainTexture.clBevelLight); 186 s := MovementToString(MyRO.DevModel.Speed); 187 RisedTextOut(offscreen.Canvas, xTotal2 + 170 + 64 + 30 - 188 TextWidth(s), y, s); 189 190 // cost bar 191 y := yTotal + 57; 192 LoweredTextOut(offscreen.Canvas, -1, MainTexture, xTotal - 2, y, 193 Phrases.Lookup('UNITCOST')); 194 LoweredTextOut(offscreen.Canvas, -1, MainTexture, xTotal + 112 + 30, y, 195 'x' + IntToStr(MyRO.DevModel.MCost)); 196 LoweredTextOut(offscreen.Canvas, -1, MainTexture, 197 xTotal2 + 148 + 30, y, '='); 198 DLine(offscreen.Canvas, xTotal - 2, xTotal + 174, y + 16, 199 MainTexture.clBevelShade, MainTexture.clBevelLight); 200 DLine(offscreen.Canvas, xTotal2 + 176, xTotal2 + 263, y + 16, 201 MainTexture.clBevelShade, MainTexture.clBevelLight); 202 s := IntToStr(MyRO.DevModel.Cost); 203 RisedTextOut(offscreen.Canvas, xTotal2 + 170 + 64 + 30 - 12 - 204 TextWidth(s), y, s); 205 Sprite(offscreen, HGrSystem, xTotal2 + 170 + 54 + 30, y + 4, 10, 206 10, 88, 115); 207 208 if G.Difficulty[me] <> 2 then 184 209 begin // corrected cost bar 185 y:=yTotal+76; 186 LoweredTextOut(offscreen.Canvas,-1,MainTexture,xTotal-2,y, 187 Phrases.Lookup('COSTDIFF'+char(48+G.Difficulty[me]))); 188 LoweredTextOut(Offscreen.Canvas,-1,MainTexture,xTotal2+148+30,y,'='); 189 DLine(offscreen.Canvas,xTotal-2,xTotal+174,y+16,MainTexture.clBevelShade, 190 MainTexture.clBevelLight); 191 DLine(offscreen.Canvas,xTotal2+176,xTotal2+263,y+16,MainTexture.clBevelShade, 192 MainTexture.clBevelLight); 193 s:=IntToStr(MyRO.DevModel.Cost*BuildCostMod[G.Difficulty[me]] div 12); 194 RisedTextOut(offscreen.Canvas,xTotal2+170+64+30-12-TextWidth(s),y,s); 195 Sprite(offscreen,HGrSystem,xTotal2+170+54+30,y+4,10,10,88,115); 210 y := yTotal + 76; 211 LoweredTextOut(offscreen.Canvas, -1, MainTexture, xTotal - 2, y, 212 Phrases.Lookup('COSTDIFF' + char(48 + G.Difficulty[me]))); 213 LoweredTextOut(offscreen.Canvas, -1, MainTexture, 214 xTotal2 + 148 + 30, y, '='); 215 DLine(offscreen.Canvas, xTotal - 2, xTotal + 174, y + 16, 216 MainTexture.clBevelShade, MainTexture.clBevelLight); 217 DLine(offscreen.Canvas, xTotal2 + 176, xTotal2 + 263, y + 16, 218 MainTexture.clBevelShade, MainTexture.clBevelLight); 219 s := IntToStr(MyRO.DevModel.Cost * BuildCostMod 220 [G.Difficulty[me]] div 12); 221 RisedTextOut(offscreen.Canvas, xTotal2 + 170 + 64 + 30 - 12 - 222 TextWidth(s), y, s); 223 Sprite(offscreen, HGrSystem, xTotal2 + 170 + 54 + 30, y + 4, 10, 224 10, 88, 115); 196 225 end; 197 226 end; … … 199 228 200 229 var 201 i,j,x,d,n,TextColor,CapWeight,DomainCount: integer; 202 begin 203 inherited; 204 205 ClientHeight:=Template.Height-Cut; 206 if ClientHeight>hMainTexture then // assemble background from 2 texture tiles 207 begin 208 bitblt(Back.Canvas.Handle,0,0,ClientWidth,64,MainTexture.Image.Canvas.Handle, 209 (wMainTexture-ClientWidth) div 2,hMainTexture-64,SRCCOPY); 210 bitblt(Back.Canvas.Handle,0,64,ClientWidth,ClientHeight-64, 211 MainTexture.Image.Canvas.Handle,(wMainTexture-ClientWidth) div 2,0,SRCCOPY); 230 i, j, x, d, n, TextColor, CapWeight, DomainCount: integer; 231 begin 232 inherited; 233 234 ClientHeight := Template.Height - Cut; 235 if ClientHeight > hMainTexture then 236 // assemble background from 2 texture tiles 237 begin 238 bitblt(Back.Canvas.Handle, 0, 0, ClientWidth, 64, 239 MainTexture.Image.Canvas.Handle, (wMainTexture - ClientWidth) div 2, 240 hMainTexture - 64, SRCCOPY); 241 bitblt(Back.Canvas.Handle, 0, 64, ClientWidth, ClientHeight - 64, 242 MainTexture.Image.Canvas.Handle, (wMainTexture - ClientWidth) div 2, 243 0, SRCCOPY); 212 244 end 213 else bitblt(Back.Canvas.Handle,0,0,ClientWidth,ClientHeight,MainTexture.Image.Canvas.Handle, 214 (wMainTexture-ClientWidth) div 2,(hMainTexture-ClientHeight) div 2,SRCCOPY); 215 ImageOp_B(Back,Template,0,0,0,0,Template.Width,64); 216 ImageOp_B(Back,Template,0,64,0,64+Cut,Template.Width,Template.Height-64-Cut); 217 218 bitblt(offscreen.canvas.handle,0,0,ClientWidth,ClientHeight,Back.Canvas.handle,0,0,SRCCOPY); 219 220 offscreen.Canvas.Font.Assign(UniFont[ftCaption]); 221 RisedTextout(offscreen.Canvas,10,7,Caption); 222 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 223 224 with MyRO.DevModel do 225 begin 226 DomainCount:=0; 227 for d:=0 to nDomains-1 do 228 if DomainAvailable(d) then 229 inc(DomainCount); 230 if DomainCount>1 then 231 begin 232 for d:=0 to nDomains-1 do 245 else 246 bitblt(Back.Canvas.Handle, 0, 0, ClientWidth, ClientHeight, 247 MainTexture.Image.Canvas.Handle, (wMainTexture - ClientWidth) div 2, 248 (hMainTexture - ClientHeight) div 2, SRCCOPY); 249 ImageOp_B(Back, Template, 0, 0, 0, 0, Template.Width, 64); 250 ImageOp_B(Back, Template, 0, 64, 0, 64 + Cut, Template.Width, 251 Template.Height - 64 - Cut); 252 253 bitblt(offscreen.Canvas.Handle, 0, 0, ClientWidth, ClientHeight, 254 Back.Canvas.Handle, 0, 0, SRCCOPY); 255 256 offscreen.Canvas.Font.Assign(UniFont[ftCaption]); 257 RisedTextOut(offscreen.Canvas, 10, 7, Caption); 258 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 259 260 with MyRO.DevModel do 261 begin 262 DomainCount := 0; 263 for d := 0 to nDomains - 1 do 233 264 if DomainAvailable(d) then 265 inc(DomainCount); 266 if DomainCount > 1 then 267 begin 268 for d := 0 to nDomains - 1 do 269 if DomainAvailable(d) then 234 270 begin 235 x:=xDomain+d*DomainPitch; 236 if d=Domain then 237 ImageOp_BCC(Offscreen,Templates,x,yDomain,142,246+37*d,36,36,0,$00C0FF) 238 else ImageOp_BCC(Offscreen,Templates,x,yDomain,142,246+37*d,36,36,0,$606060); 271 x := xDomain + d * DomainPitch; 272 if d = Domain then 273 ImageOp_BCC(offscreen, Templates, x, yDomain, 142, 246 + 37 * d, 36, 274 36, 0, $00C0FF) 275 else 276 ImageOp_BCC(offscreen, Templates, x, yDomain, 142, 246 + 37 * d, 36, 277 36, 0, $606060); 239 278 end; 240 Frame(Offscreen.Canvas,xDomain-11,yDomain-3,xDomain+2*DomainPitch+46,241 yDomain+38,$B0B0B0,$FFFFFF);242 RFrame(Offscreen.Canvas,xDomain-12,yDomain-4,xDomain+2*DomainPitch+47,243 yDomain+39,$FFFFFF,$B0B0B0);244 end; 245 GroundArea.Top:=yDomain;246 GroundArea.Visible:=DomainAvailable(dGround);247 SeaArea.Top:=yDomain;248 SeaArea.Visible:=DomainAvailable(dSea);249 AirArea.Top:=yDomain;250 AirArea.Visible:=DomainAvailable(dAir);251 252 PaintTotalBars;253 254 // display weight255 with offscreen.Canvas do256 begin 257 for i:=0 to MaxWeight-1 do258 if i<Weight then259 ImageOp_BCC(Offscreen,Templates,xWeight+20*i,260 yWeight,123,400,18,20,0,$949494)261 else ImageOp_BCC(Offscreen,Templates,xWeight+20*i,262 yWeight,105,400,18,20,0,$949494);263 end;264 265 with offscreen.Canvas do for i:=0 to Lines-1 do 266 begin267 if not (code[i] in AutoFeature) then279 Frame(offscreen.Canvas, xDomain - 11, yDomain - 3, 280 xDomain + 2 * DomainPitch + 46, yDomain + 38, $B0B0B0, $FFFFFF); 281 RFrame(offscreen.Canvas, xDomain - 12, yDomain - 4, 282 xDomain + 2 * DomainPitch + 47, yDomain + 39, $FFFFFF, $B0B0B0); 283 end; 284 GroundArea.Top := yDomain; 285 GroundArea.Visible := DomainAvailable(dGround); 286 SeaArea.Top := yDomain; 287 SeaArea.Visible := DomainAvailable(dSea); 288 AirArea.Top := yDomain; 289 AirArea.Visible := DomainAvailable(dAir); 290 291 PaintTotalBars; 292 293 // display weight 294 with offscreen.Canvas do 295 begin 296 for i := 0 to MaxWeight - 1 do 297 if i < Weight then 298 ImageOp_BCC(offscreen, Templates, xWeight + 20 * i, yWeight, 123, 400, 299 18, 20, 0, $949494) 300 else 301 ImageOp_BCC(offscreen, Templates, xWeight + 20 * i, yWeight, 105, 400, 302 18, 20, 0, $949494); 303 end; 304 305 with offscreen.Canvas do 306 for i := 0 to Lines - 1 do 268 307 begin 269 // paint +/- butttons 270 if code[i]<mcFirstNonCap then 308 if not(code[i] in AutoFeature) then 271 309 begin 272 Dump(offscreen,HGrSystem,xFeature-21,yFeature+2+LinePitch*i, 273 12,12,169,172); 274 Dump(offscreen,HGrSystem,xFeature-9,yFeature+2+LinePitch*i, 275 12,12,169,159); 276 RFrame(offscreen.Canvas,xFeature-(21+1),yFeature+2+LinePitch*i-1, 277 xFeature-(21-24),yFeature+2+LinePitch*i+12, 278 MainTexture.clBevelShade,MainTexture.clBevelLight); 279 end 280 else 281 begin 282 Dump(offscreen,HGrSystem,xFeature-9,yFeature+2+LinePitch*i, 283 12,12,169,185+13*MyRO.DevModel.Cap[code[i]]); 284 RFrame(offscreen.Canvas,xFeature-(9+1),yFeature+2+LinePitch*i-1, 285 xFeature-(21-24),yFeature+2+LinePitch*i+12, 286 MainTexture.clBevelShade,MainTexture.clBevelLight); 287 end; 288 289 // paint cost 290 LightGradient(offscreen.Canvas,xFeature+34,yFeature+LinePitch*i,50, 291 GrExt[HGrSystem].Data.Canvas.Pixels[187,137]); 292 if (Domain=dGround) and (code[i]=mcDefense) then CapWeight:=2 293 else CapWeight:=Feature[code[i]].Weight; 294 n:=CapWeight+Feature[code[i]].Cost; 295 d:=6; 296 while (n-1)*d*2>48-10 do dec(d); 297 for j:=0 to n-1 do 298 if j<CapWeight then 299 Sprite(offscreen,HGrSystem,xFeature+54+(j*2+1-n)*d, 300 yFeature+2+LinePitch*i+1,10,10,88,126) 301 else Sprite(offscreen,HGrSystem,xFeature+54+(j*2+1-n)*d, 302 yFeature+2+LinePitch*i+1,10,10,88,115); 303 end; // if not (code[i] in AutoFeature) 304 DarkGradient(offscreen.Canvas,xFeature+17,yFeature+LinePitch*i,16,1); 305 Frame(offscreen.canvas,xFeature+18,yFeature+1+LinePitch*i, 306 xFeature+20-2+13,yFeature+2+1-2+13+LinePitch*i,$C0C0C0,$C0C0C0); 307 Sprite(offscreen,HGrSystem,xFeature+20,yFeature+2+1+LinePitch*i, 308 10,10,66+code[i] mod 11 *11,137+code[i] div 11 *11); 309 310 if MyRO.DevModel.Cap[code[i]]>0 then TextColor:=MainTexture.clLitText 311 else TextColor:=-1; 312 313 if code[i]<mcFirstNonCap then 314 LoweredTextOut(offscreen.Canvas,TextColor,MainTexture,xFeature+7, 315 yFeature+LinePitch*i-1,IntToStr(MyRO.DevModel.Cap[code[i]])); 316 LoweredTextOut(offscreen.Canvas,TextColor,MainTexture,xFeature+88, 317 yFeature+LinePitch*i-1,Phrases.Lookup('FEATURES',code[i])); 318 end; 319 end; 320 321 // free features 322 j:=0; 323 for i:=0 to nFeature-1 do 324 if (i in AutoFeature) 325 and (1 shl Domain and Feature[i].Domains<>0) and (Feature[i].Preq<>preNA) 326 and ((Feature[i].Preq=preSun) and (MyRO.Wonder[woSun].EffectiveOwner=me) 327 or (Feature[i].Preq>=0) and (MyRO.Tech[Feature[i].Preq]>=tsApplicable)) 328 and not ((Feature[i].Preq=adSteamEngine) 329 and (MyRO.Tech[adNuclearPower]>=tsApplicable)) then 330 begin 331 DarkGradient(offscreen.Canvas,xWeight+4,yWeight+32+LinePitch*j,16,1); 332 Frame(offscreen.canvas,xWeight+5,yWeight+33+LinePitch*j, 333 xWeight+18,yWeight+47+LinePitch*j,$C0C0C0,$C0C0C0); 334 Sprite(offscreen,HGrSystem,xWeight+7,yWeight+36+LinePitch*j, 335 10,10,66+i mod 11 *11,137+i div 11 *11); 336 LoweredTextOut(offscreen.Canvas,-1,MainTexture,xWeight+26, 337 yWeight+31+LinePitch*j,Phrases.Lookup('FEATURES',i)); 338 inc(j); 339 end; 340 341 with Tribe[me].ModelPicture[MyRO.nModel] do 342 begin 343 FrameImage(offscreen.canvas,BigImp,xView+4,yView+4,xSizeBig,ySizeBig,0,0); 344 Sprite(offscreen,HGr,xView,yView,64,44,pix mod 10 *65+1,pix div 10*49+1); 345 end; 346 MarkUsedOffscreen(ClientWidth,ClientHeight); 347 end;{MainPaint} 310 // paint +/- butttons 311 if code[i] < mcFirstNonCap then 312 begin 313 Dump(offscreen, HGrSystem, xFeature - 21, yFeature + 2 + LinePitch * 314 i, 12, 12, 169, 172); 315 Dump(offscreen, HGrSystem, xFeature - 9, yFeature + 2 + LinePitch * 316 i, 12, 12, 169, 159); 317 RFrame(offscreen.Canvas, xFeature - (21 + 1), 318 yFeature + 2 + LinePitch * i - 1, xFeature - (21 - 24), 319 yFeature + 2 + LinePitch * i + 12, MainTexture.clBevelShade, 320 MainTexture.clBevelLight); 321 end 322 else 323 begin 324 Dump(offscreen, HGrSystem, xFeature - 9, yFeature + 2 + LinePitch * 325 i, 12, 12, 169, 185 + 13 * MyRO.DevModel.Cap[code[i]]); 326 RFrame(offscreen.Canvas, xFeature - (9 + 1), 327 yFeature + 2 + LinePitch * i - 1, xFeature - (21 - 24), 328 yFeature + 2 + LinePitch * i + 12, MainTexture.clBevelShade, 329 MainTexture.clBevelLight); 330 end; 331 332 // paint cost 333 LightGradient(offscreen.Canvas, xFeature + 34, 334 yFeature + LinePitch * i, 50, GrExt[HGrSystem].Data.Canvas.Pixels 335 [187, 137]); 336 if (Domain = dGround) and (code[i] = mcDefense) then 337 CapWeight := 2 338 else 339 CapWeight := Feature[code[i]].Weight; 340 n := CapWeight + Feature[code[i]].Cost; 341 d := 6; 342 while (n - 1) * d * 2 > 48 - 10 do 343 dec(d); 344 for j := 0 to n - 1 do 345 if j < CapWeight then 346 Sprite(offscreen, HGrSystem, xFeature + 54 + (j * 2 + 1 - n) * d, 347 yFeature + 2 + LinePitch * i + 1, 10, 10, 88, 126) 348 else 349 Sprite(offscreen, HGrSystem, xFeature + 54 + (j * 2 + 1 - n) * d, 350 yFeature + 2 + LinePitch * i + 1, 10, 10, 88, 115); 351 end; // if not (code[i] in AutoFeature) 352 DarkGradient(offscreen.Canvas, xFeature + 17, 353 yFeature + LinePitch * i, 16, 1); 354 Frame(offscreen.Canvas, xFeature + 18, yFeature + 1 + LinePitch * i, 355 xFeature + 20 - 2 + 13, yFeature + 2 + 1 - 2 + 13 + LinePitch * i, 356 $C0C0C0, $C0C0C0); 357 Sprite(offscreen, HGrSystem, xFeature + 20, yFeature + 2 + 1 + LinePitch 358 * i, 10, 10, 66 + code[i] mod 11 * 11, 137 + code[i] div 11 * 11); 359 360 if MyRO.DevModel.Cap[code[i]] > 0 then 361 TextColor := MainTexture.clLitText 362 else 363 TextColor := -1; 364 365 if code[i] < mcFirstNonCap then 366 LoweredTextOut(offscreen.Canvas, TextColor, MainTexture, xFeature + 7, 367 yFeature + LinePitch * i - 1, IntToStr(MyRO.DevModel.Cap[code[i]])); 368 LoweredTextOut(offscreen.Canvas, TextColor, MainTexture, xFeature + 88, 369 yFeature + LinePitch * i - 1, Phrases.Lookup('FEATURES', code[i])); 370 end; 371 end; 372 373 // free features 374 j := 0; 375 for i := 0 to nFeature - 1 do 376 if (i in AutoFeature) and (1 shl Domain and Feature[i].Domains <> 0) and 377 (Feature[i].Preq <> preNA) and 378 ((Feature[i].Preq = preSun) and (MyRO.Wonder[woSun].EffectiveOwner = me) 379 or (Feature[i].Preq >= 0) and (MyRO.Tech[Feature[i].Preq] >= tsApplicable) 380 ) and not((Feature[i].Preq = adSteamEngine) and 381 (MyRO.Tech[adNuclearPower] >= tsApplicable)) then 382 begin 383 DarkGradient(offscreen.Canvas, xWeight + 4, yWeight + 32 + LinePitch 384 * j, 16, 1); 385 Frame(offscreen.Canvas, xWeight + 5, yWeight + 33 + LinePitch * j, 386 xWeight + 18, yWeight + 47 + LinePitch * j, $C0C0C0, $C0C0C0); 387 Sprite(offscreen, HGrSystem, xWeight + 7, yWeight + 36 + LinePitch * j, 388 10, 10, 66 + i mod 11 * 11, 137 + i div 11 * 11); 389 LoweredTextOut(offscreen.Canvas, -1, MainTexture, xWeight + 26, 390 yWeight + 31 + LinePitch * j, Phrases.Lookup('FEATURES', i)); 391 inc(j); 392 end; 393 394 with Tribe[me].ModelPicture[MyRO.nModel] do 395 begin 396 FrameImage(offscreen.Canvas, BigImp, xView + 4, yView + 4, xSizeBig, 397 ySizeBig, 0, 0); 398 Sprite(offscreen, HGr, xView, yView, 64, 44, pix mod 10 * 65 + 1, 399 pix div 10 * 49 + 1); 400 end; 401 MarkUsedOffscreen(ClientWidth, ClientHeight); 402 end; { MainPaint } 348 403 349 404 procedure TDraftDlg.SetDomain(d: integer); … … 351 406 function Prio(fix: integer): integer; 352 407 var 353 FeaturePreq: integer; 354 begin 355 FeaturePreq:=Feature[fix].Preq; 356 assert(FeaturePreq<>preNA); 357 if fix<mcFirstNonCap then result:=10000+fix 358 else if FeaturePreq=preNone then result:=20000 359 else if FeaturePreq<0 then result:=40000 360 else result:=30000+AdvValue[FeaturePreq]; 361 if not (fix in AutoFeature) then inc(result,90000); 408 FeaturePreq: integer; 409 begin 410 FeaturePreq := Feature[fix].Preq; 411 assert(FeaturePreq <> preNA); 412 if fix < mcFirstNonCap then 413 result := 10000 + fix 414 else if FeaturePreq = preNone then 415 result := 20000 416 else if FeaturePreq < 0 then 417 result := 40000 418 else 419 result := 30000 + AdvValue[FeaturePreq]; 420 if not(fix in AutoFeature) then 421 inc(result, 90000); 362 422 end; 363 423 364 424 var 365 i,j,x: integer; 366 begin 367 Domain:=d; 368 Lines:=0; 369 for i:=0 to nFeature-1 do 370 if IsFeatureInList(Domain,i) then 371 begin code[Lines]:=i; inc(Lines) end; 372 yFeature:=yFeature0+(MaxLines-Lines)*LinePitch div 2; 373 374 // sort features 375 for i:=0 to Lines-2 do for j:=i+1 to Lines-1 do 376 if Prio(code[i])>Prio(code[j]) then 377 begin // exchange 378 x:=code[i]; 379 code[i]:=code[j]; 380 code[j]:=x 381 end; 382 end; 383 384 function TDraftDlg.IsFeatureInList(d,i: integer): boolean; 385 begin 386 result:= not (i in AutoFeature) 387 and (1 shl d and Feature[i].Domains<>0) and (Feature[i].Preq<>preNA) 388 and ((Feature[i].Preq=preNone) 389 or (Feature[i].Preq=preSun) and (MyRO.Wonder[woSun].EffectiveOwner=me) 390 or (Feature[i].Preq>=0) and (MyRO.Tech[Feature[i].Preq]>=tsApplicable)); 425 i, j, x: integer; 426 begin 427 Domain := d; 428 Lines := 0; 429 for i := 0 to nFeature - 1 do 430 if IsFeatureInList(Domain, i) then 431 begin 432 code[Lines] := i; 433 inc(Lines) 434 end; 435 yFeature := yFeature0 + (MaxLines - Lines) * LinePitch div 2; 436 437 // sort features 438 for i := 0 to Lines - 2 do 439 for j := i + 1 to Lines - 1 do 440 if Prio(code[i]) > Prio(code[j]) then 441 begin // exchange 442 x := code[i]; 443 code[i] := code[j]; 444 code[j] := x 445 end; 446 end; 447 448 function TDraftDlg.IsFeatureInList(d, i: integer): boolean; 449 begin 450 result := not(i in AutoFeature) and (1 shl d and Feature[i].Domains <> 0) and 451 (Feature[i].Preq <> preNA) and 452 ((Feature[i].Preq = preNone) or (Feature[i].Preq = preSun) and 453 (MyRO.Wonder[woSun].EffectiveOwner = me) or (Feature[i].Preq >= 0) and 454 (MyRO.Tech[Feature[i].Preq] >= tsApplicable)); 391 455 end; 392 456 393 457 procedure TDraftDlg.FormShow(Sender: TObject); 394 458 var 395 count,d,i: integer; 396 begin 397 Domain:=dGround; 398 while (Domain<dAir) and (upgrade[Domain,0].Preq<>preNone) 399 and (MyRO.Tech[upgrade[Domain,0].Preq]<tsApplicable) do inc(Domain); 400 401 // count max number of features in any domain 402 MaxLines:=0; 403 for d:=0 to nDomains-1 do 404 if (upgrade[d,0].Preq=preNone) 405 or (MyRO.Tech[upgrade[d,0].Preq]>=tsApplicable) then 406 begin 407 count:=0; 408 for i:=0 to nFeature-1 do 409 if IsFeatureInList(d,i) then 410 inc(count); 411 if count>MaxLines then 412 MaxLines:=count; 413 end; 414 Cut:=(MaxLines0-MaxLines)*LinePitch; 415 OKBtn.Top:=477-Cut; 416 yDomain:=yDomain0-Cut; 417 yWeight:=yWeight0-Cut; 418 yTotal:=yTotal0-Cut; 419 yView:=yView0-Cut; 420 421 if WindowMode=wmModal then 422 begin {center on screen} 423 Left:=(Screen.Width-Template.Width) div 2; 424 Top:=(Screen.Height-(Template.Height-Cut)) div 2; 425 end; 426 427 SetDomain(Domain); 428 Server(sCreateDevModel,me,Domain,nil^); 429 MyModel[MyRO.nModel]:=MyRO.DevModel; 430 InitMyModel(MyRO.nModel,false); 431 OffscreenPaint; 432 IncCap:=-1; DecCap:=-1; 459 count, d, i: integer; 460 begin 461 Domain := dGround; 462 while (Domain < dAir) and (upgrade[Domain, 0].Preq <> preNone) and 463 (MyRO.Tech[upgrade[Domain, 0].Preq] < tsApplicable) do 464 inc(Domain); 465 466 // count max number of features in any domain 467 MaxLines := 0; 468 for d := 0 to nDomains - 1 do 469 if (upgrade[d, 0].Preq = preNone) or 470 (MyRO.Tech[upgrade[d, 0].Preq] >= tsApplicable) then 471 begin 472 count := 0; 473 for i := 0 to nFeature - 1 do 474 if IsFeatureInList(d, i) then 475 inc(count); 476 if count > MaxLines then 477 MaxLines := count; 478 end; 479 Cut := (MaxLines0 - MaxLines) * LinePitch; 480 OKBtn.Top := 477 - Cut; 481 yDomain := yDomain0 - Cut; 482 yWeight := yWeight0 - Cut; 483 yTotal := yTotal0 - Cut; 484 yView := yView0 - Cut; 485 486 if WindowMode = wmModal then 487 begin { center on screen } 488 Left := (Screen.Width - Template.Width) div 2; 489 Top := (Screen.Height - (Template.Height - Cut)) div 2; 490 end; 491 492 SetDomain(Domain); 493 Server(sCreateDevModel, me, Domain, nil^); 494 MyModel[MyRO.nModel] := MyRO.DevModel; 495 InitMyModel(MyRO.nModel, false); 496 OffscreenPaint; 497 IncCap := -1; 498 DecCap := -1; 433 499 end; 434 500 435 501 procedure TDraftDlg.ShowNewContent(NewMode: integer); 436 502 begin 437 inherited ShowNewContent(NewMode);503 inherited ShowNewContent(NewMode); 438 504 end; 439 505 … … 441 507 Shift: TShiftState; x, y: integer); 442 508 var 443 i,d: integer; 444 begin 445 if Button=mbLeft then 446 begin 447 for d:=0 to nDomains-1 do 448 if (d<>Domain) and ((upgrade[d,0].Preq=preNone) 449 or (MyRO.Tech[upgrade[d,0].Preq]>=tsApplicable)) 450 and (x>=xDomain+d*DomainPitch) and (x<xDomain+d*DomainPitch+36) 451 and (y>=yDomain) and (y<yDomain+36) then 509 i, d: integer; 510 begin 511 if Button = mbLeft then 512 begin 513 for d := 0 to nDomains - 1 do 514 if (d <> Domain) and ((upgrade[d, 0].Preq = preNone) or 515 (MyRO.Tech[upgrade[d, 0].Preq] >= tsApplicable)) and 516 (x >= xDomain + d * DomainPitch) and 517 (x < xDomain + d * DomainPitch + 36) and (y >= yDomain) and 518 (y < yDomain + 36) then 452 519 begin 453 SetDomain(d);454 Server(sCreateDevModel,me,Domain,nil^);455 MyModel[MyRO.nModel]:=MyRO.DevModel;456 InitMyModel(MyRO.nModel,false);457 SmartUpdateContent;520 SetDomain(d); 521 Server(sCreateDevModel, me, Domain, nil^); 522 MyModel[MyRO.nModel] := MyRO.DevModel; 523 InitMyModel(MyRO.nModel, false); 524 SmartUpdateContent; 458 525 end; 459 526 460 if (y>=yFeature) and (y<yFeature+LinePitch*Lines) then461 begin 462 i:=(y-yFeature) div LinePitch;463 if (x>=xFeature-21) and (x<ClientWidth) and (ssShift in Shift) then464 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkFeature, code[i])465 else if not(code[i] in AutoFeature) then527 if (y >= yFeature) and (y < yFeature + LinePitch * Lines) then 528 begin 529 i := (y - yFeature) div LinePitch; 530 if (x >= xFeature - 21) and (x < ClientWidth) and (ssShift in Shift) then 531 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkFeature, code[i]) 532 else if not(code[i] in AutoFeature) then 466 533 begin 467 if (code[i]<mcFirstNonCap) and (x>=xFeature-21) and (x<xFeature-21+12) then 534 if (code[i] < mcFirstNonCap) and (x >= xFeature - 21) and 535 (x < xFeature - 21 + 12) then 468 536 begin 469 IncCap:=code[i]; 470 Dump(offscreen,HGrSystem,xFeature-21,yFeature+2+LinePitch*i,12,12,182,172); 471 SmartInvalidate; 537 IncCap := code[i]; 538 Dump(offscreen, HGrSystem, xFeature - 21, yFeature + 2 + LinePitch * 539 i, 12, 12, 182, 172); 540 SmartInvalidate; 472 541 end 473 else if (x>=xFeature-9) and (x<xFeature-9+12) then542 else if (x >= xFeature - 9) and (x < xFeature - 9 + 12) then 474 543 begin 475 DecCap:=code[i]; 476 if code[i]<mcFirstNonCap then 477 Dump(offscreen,HGrSystem,xFeature-9,yFeature+2+LinePitch*i,12,12,182,159) 478 else Dump(offscreen,HGrSystem,xFeature-9,yFeature+2+LinePitch*i, 479 12,12,182,185+13*MyRO.DevModel.Cap[code[i]]); 480 SmartInvalidate; 544 DecCap := code[i]; 545 if code[i] < mcFirstNonCap then 546 Dump(offscreen, HGrSystem, xFeature - 9, yFeature + 2 + LinePitch * 547 i, 12, 12, 182, 159) 548 else 549 Dump(offscreen, HGrSystem, xFeature - 9, yFeature + 2 + LinePitch * 550 i, 12, 12, 182, 185 + 13 * MyRO.DevModel.Cap[code[i]]); 551 SmartInvalidate; 481 552 end; 482 553 end … … 488 559 Shift: TShiftState; x, y: integer); 489 560 var 490 NewValue: integer;491 begin 492 if IncCap>=0 then493 begin 494 NewValue:=MyRO.DevModel.Cap[IncCap]+1;495 Server(sSetDevModelCap+NewValue shl 4,me,IncCap,nil^);496 MyModel[MyRO.nModel]:=MyRO.DevModel;497 InitMyModel(MyRO.nModel,false);498 SmartUpdateContent;499 IncCap:=-1;561 NewValue: integer; 562 begin 563 if IncCap >= 0 then 564 begin 565 NewValue := MyRO.DevModel.Cap[IncCap] + 1; 566 Server(sSetDevModelCap + NewValue shl 4, me, IncCap, nil^); 567 MyModel[MyRO.nModel] := MyRO.DevModel; 568 InitMyModel(MyRO.nModel, false); 569 SmartUpdateContent; 570 IncCap := -1; 500 571 end 501 else if DecCap>=0 then 502 begin 503 if (DecCap>=mcFirstNonCap) or (MyRO.DevModel.Cap[DecCap]>0) then 504 begin 505 NewValue:=MyRO.DevModel.Cap[DecCap]-1; 506 if DecCap>=mcFirstNonCap then NewValue:=-NewValue; 507 Server(sSetDevModelCap+NewValue shl 4,me,DecCap,nil^); 508 MyModel[MyRO.nModel]:=MyRO.DevModel; 509 InitMyModel(MyRO.nModel,false); 510 end; 511 SmartUpdateContent; 512 DecCap:=-1; 572 else if DecCap >= 0 then 573 begin 574 if (DecCap >= mcFirstNonCap) or (MyRO.DevModel.Cap[DecCap] > 0) then 575 begin 576 NewValue := MyRO.DevModel.Cap[DecCap] - 1; 577 if DecCap >= mcFirstNonCap then 578 NewValue := -NewValue; 579 Server(sSetDevModelCap + NewValue shl 4, me, DecCap, nil^); 580 MyModel[MyRO.nModel] := MyRO.DevModel; 581 InitMyModel(MyRO.nModel, false); 582 end; 583 SmartUpdateContent; 584 DecCap := -1; 513 585 end; 514 586 end; … … 516 588 procedure TDraftDlg.OKBtnClick(Sender: TObject); 517 589 begin 518 ModalResult:=mrOK;590 ModalResult := mrOK; 519 591 end; 520 592 521 593 end. 522 -
trunk/LocalPlayer/Enhance.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit Enhance; 4 3 … … 6 5 7 6 uses 8 ScreenTools, BaseWin,Protocol,ClientTools,Term,7 ScreenTools, BaseWin, Protocol, ClientTools, Term, 9 8 10 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, … … 31 30 procedure TerrClick(Sender: TObject); 32 31 procedure JobClick(Sender: TObject); 33 procedure FormKeyDown(Sender: TObject; var Key: Word; 34 Shift: TShiftState); 32 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 35 33 public 36 34 procedure ShowNewContent(NewMode: integer; TerrType: integer = -1); … … 51 49 procedure TEnhanceDlg.FormCreate(Sender: TObject); 52 50 var 53 TerrType: integer; 54 m: TMenuItem; 55 begin 56 inherited; 57 CaptionRight:=CloseBtn.Left; 58 CaptionLeft:=ToggleBtn.Left+ToggleBtn.Width; 59 InitButtons(); 60 HelpContext:='MACRO'; 61 Caption:=Phrases.Lookup('TITLE_ENHANCE'); 62 ToggleBtn.Hint:=Phrases.Lookup('BTN_SELECT'); 63 64 for TerrType:=fGrass to fMountains do if TerrType<>fJungle then 51 TerrType: integer; 52 m: TMenuItem; 53 begin 54 inherited; 55 CaptionRight := CloseBtn.Left; 56 CaptionLeft := ToggleBtn.Left + ToggleBtn.Width; 57 InitButtons(); 58 HelpContext := 'MACRO'; 59 Caption := Phrases.Lookup('TITLE_ENHANCE'); 60 ToggleBtn.Hint := Phrases.Lookup('BTN_SELECT'); 61 62 for TerrType := fGrass to fMountains do 63 if TerrType <> fJungle then 64 begin 65 m := TMenuItem.Create(Popup); 66 m.RadioItem := true; 67 if TerrType = fGrass then 68 m.Caption := Format(Phrases.Lookup('TWOTERRAINS'), 69 [Phrases.Lookup('TERRAIN', fGrass), Phrases.Lookup('TERRAIN', 70 fGrass + 12)]) 71 else if TerrType = fForest then 72 m.Caption := Format(Phrases.Lookup('TWOTERRAINS'), 73 [Phrases.Lookup('TERRAIN', fForest), Phrases.Lookup('TERRAIN', 74 fJungle)]) 75 else 76 m.Caption := Phrases.Lookup('TERRAIN', TerrType); 77 m.Tag := TerrType; 78 m.OnClick := TerrClick; 79 Popup.Items.Add(m); 80 end; 81 end; 82 83 procedure TEnhanceDlg.FormPaint(Sender: TObject); 84 var 85 i: integer; 86 begin 87 inherited; 88 BtnFrame(Canvas, Rect(job1.Left, job1.Top, job7.Left + job7.Width, 89 job1.Top + job1.Height), MainTexture); 90 BtnFrame(Canvas, Rect(job3.Left, job3.Top, job9.Left + job9.Width, 91 job3.Top + job3.Height), MainTexture); 92 for i := 0 to ControlCount - 1 do 93 if Controls[i] is TButtonC then 94 BitBlt(Canvas.Handle, Controls[i].Left + 2, Controls[i].Top - 11, 8, 8, 95 GrExt[HGrSystem].Data.Canvas.Handle, 121 + Controls[i].Tag mod 7 * 9, 96 1 + Controls[i].Tag div 7 * 9, SRCCOPY); 97 end; 98 99 procedure TEnhanceDlg.FormShow(Sender: TObject); 100 begin 101 OffscreenPaint; 102 end; 103 104 procedure TEnhanceDlg.ShowNewContent(NewMode, TerrType: integer); 105 begin 106 if (TerrType < fGrass) or (TerrType > fMountains) then 107 Page := fGrass 108 else 109 Page := TerrType; 110 inherited ShowNewContent(NewMode); 111 end; 112 113 procedure TEnhanceDlg.OffscreenPaint; 114 var 115 i, stage, TerrType, TileImp, x, EndStage, Cost, LastJob: integer; 116 s: string; 117 Done: Set of jNone .. jTrans; 118 TypeChanged: boolean; 119 begin 120 OffscreenUser := self; 121 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 122 FillOffscreen(0, 0, InnerWidth, InnerHeight); 123 124 EndStage := 0; 125 while (EndStage < 5) and (MyData.EnhancementJobs[Page, EndStage] <> jNone) do 126 inc(EndStage); 127 x := InnerWidth div 2 - xxt - (xxt + 3) * EndStage; 128 129 TerrType := Page; 130 TileImp := 0; 131 Done := []; 132 Cost := 0; 133 for stage := 0 to EndStage do 65 134 begin 66 m:=TMenuItem.Create(Popup); 67 m.RadioItem:=true; 68 if TerrType=fGrass then 69 m.Caption:=Format(Phrases.Lookup('TWOTERRAINS'), 70 [Phrases.Lookup('TERRAIN',fGrass), Phrases.Lookup('TERRAIN',fGrass+12)]) 71 else if TerrType=fForest then 72 m.Caption:=Format(Phrases.Lookup('TWOTERRAINS'), 73 [Phrases.Lookup('TERRAIN',fForest), Phrases.Lookup('TERRAIN',fJungle)]) 74 else m.Caption:=Phrases.Lookup('TERRAIN',TerrType); 75 m.Tag:=TerrType; 76 m.OnClick:=TerrClick; 77 Popup.Items.Add(m); 78 end; 79 end; 80 81 procedure TEnhanceDlg.FormPaint(Sender: TObject); 82 var 83 i: integer; 84 begin 85 inherited; 86 BtnFrame(Canvas,Rect(job1.Left,job1.Top,job7.Left+job7.Width,job1.Top+job1.Height),MainTexture); 87 BtnFrame(Canvas,Rect(job3.Left,job3.Top,job9.Left+job9.Width,job3.Top+job3.Height),MainTexture); 88 for i:=0 to ControlCount-1 do if Controls[i] is TButtonC then 89 BitBlt(Canvas.Handle,Controls[i].Left+2,Controls[i].Top-11,8,8, 90 GrExt[HGrSystem].Data.Canvas.Handle,121+Controls[i].Tag mod 7 *9, 91 1+Controls[i].Tag div 7 *9,SRCCOPY); 92 end; 93 94 procedure TEnhanceDlg.FormShow(Sender: TObject); 95 begin 96 OffscreenPaint; 97 end; 98 99 procedure TEnhanceDlg.ShowNewContent(NewMode,TerrType: integer); 100 begin 101 if (TerrType<fGrass) or (TerrType>fMountains) then Page:=fGrass 102 else Page:=TerrType; 103 inherited ShowNewContent(NewMode); 104 end; 105 106 procedure TEnhanceDlg.OffscreenPaint; 107 var 108 i,stage,TerrType,TileImp,x,EndStage,Cost,LastJob: integer; 109 s: string; 110 Done: Set of jNone..jTrans; 111 TypeChanged: boolean; 112 begin 113 OffscreenUser:=self; 114 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 115 FillOffscreen(0,0,InnerWidth,InnerHeight); 116 117 EndStage:=0; 118 while (EndStage<5) and (MyData.EnhancementJobs[Page,EndStage]<>jNone) do 119 inc(EndStage); 120 x:=InnerWidth div 2-xxt-(xxt+3)*EndStage; 121 122 TerrType:=Page; 123 TileImp:=0; 124 Done:=[]; 125 Cost:=0; 126 for stage:=0 to EndStage do 127 begin 128 if stage>0 then 129 begin 130 Sprite(offscreen,HGrSystem,x-10,66,14,14,80,1); 131 case MyData.EnhancementJobs[Page,stage-1] of 132 jRoad: 133 begin 134 inc(Cost,Terrain[TerrType].MoveCost*RoadWork); 135 TileImp:=TileImp or fRoad; 136 end; 137 jRR: 138 begin 139 inc(Cost,Terrain[TerrType].MoveCost*RRWork); 140 TileImp:=TileImp or fRR; 141 end; 142 jIrr: 143 begin 144 inc(Cost,Terrain[TerrType].IrrClearWork); 145 TileImp:=TileImp and not fTerImp or tiIrrigation; 146 end; 147 jFarm: 148 begin 149 inc(Cost,Terrain[TerrType].IrrClearWork*FarmWork); 150 TileImp:=TileImp and not fTerImp or tiFarm; 151 end; 152 jMine: 153 begin 154 inc(Cost,Terrain[TerrType].MineAfforestWork); 155 TileImp:=TileImp and not fTerImp or tiMine; 156 end; 157 jClear: 158 begin 159 inc(Cost,Terrain[TerrType].IrrClearWork); 160 TerrType:=Terrain[TerrType].ClearTerrain; 161 end; 162 jAfforest: 163 begin 164 inc(Cost,Terrain[TerrType].MineAfforestWork); 165 TerrType:=Terrain[TerrType].AfforestTerrain; 166 end; 167 jTrans: 168 begin 169 inc(Cost,Terrain[TerrType].TransWork); 170 TerrType:=Terrain[TerrType].TransTerrain; 171 end; 135 if stage > 0 then 136 begin 137 Sprite(offscreen, HGrSystem, x - 10, 66, 14, 14, 80, 1); 138 case MyData.EnhancementJobs[Page, stage - 1] of 139 jRoad: 140 begin 141 inc(Cost, Terrain[TerrType].MoveCost * RoadWork); 142 TileImp := TileImp or fRoad; 143 end; 144 jRR: 145 begin 146 inc(Cost, Terrain[TerrType].MoveCost * RRWork); 147 TileImp := TileImp or fRR; 148 end; 149 jIrr: 150 begin 151 inc(Cost, Terrain[TerrType].IrrClearWork); 152 TileImp := TileImp and not fTerImp or tiIrrigation; 153 end; 154 jFarm: 155 begin 156 inc(Cost, Terrain[TerrType].IrrClearWork * FarmWork); 157 TileImp := TileImp and not fTerImp or tiFarm; 158 end; 159 jMine: 160 begin 161 inc(Cost, Terrain[TerrType].MineAfforestWork); 162 TileImp := TileImp and not fTerImp or tiMine; 163 end; 164 jClear: 165 begin 166 inc(Cost, Terrain[TerrType].IrrClearWork); 167 TerrType := Terrain[TerrType].ClearTerrain; 168 end; 169 jAfforest: 170 begin 171 inc(Cost, Terrain[TerrType].MineAfforestWork); 172 TerrType := Terrain[TerrType].AfforestTerrain; 173 end; 174 jTrans: 175 begin 176 inc(Cost, Terrain[TerrType].TransWork); 177 TerrType := Terrain[TerrType].TransTerrain; 178 end; 172 179 end; 173 include(Done,MyData.EnhancementJobs[Page,stage-1]); 174 end; 175 176 if TerrType<fForest then 177 Sprite(offscreen,HGrTerrain,x,64-yyt,xxt*2,yyt*2,1+TerrType*(xxt*2+1),1+yyt) 178 else 179 begin 180 Sprite(offscreen,HGrTerrain,x,64-yyt,xxt*2,yyt*2,1+2*(xxt*2+1),1+yyt+2*(yyt*3+1)); 181 Sprite(offscreen,HGrTerrain,x,64-yyt,xxt*2,yyt*2,1+7*(xxt*2+1),1+yyt+2*(2+TerrType-fForest)*(yyt*3+1)); 182 end; 183 if TileImp and fTerImp=tiFarm then 184 Sprite(offscreen,HGrTerrain,x,64-yyt,xxt*2,yyt*2,1+(xxt*2+1),1+yyt+12*(yyt*3+1)) 185 else if TileImp and fTerImp=tiIrrigation then 186 Sprite(offscreen,HGrTerrain,x,64-yyt,xxt*2,yyt*2,1,1+yyt+12*(yyt*3+1)); 187 if TileImp and fRR<>0 then 188 begin 189 Sprite(offscreen,HGrTerrain,x,64-yyt,xxt*2,yyt*2,1+6*(xxt*2+1),1+yyt+10*(yyt*3+1)); 190 Sprite(offscreen,HGrTerrain,x,64-yyt,xxt*2,yyt*2,1+2*(xxt*2+1),1+yyt+10*(yyt*3+1)); 180 include(Done, MyData.EnhancementJobs[Page, stage - 1]); 181 end; 182 183 if TerrType < fForest then 184 Sprite(offscreen, HGrTerrain, x, 64 - yyt, xxt * 2, yyt * 2, 185 1 + TerrType * (xxt * 2 + 1), 1 + yyt) 186 else 187 begin 188 Sprite(offscreen, HGrTerrain, x, 64 - yyt, xxt * 2, yyt * 2, 189 1 + 2 * (xxt * 2 + 1), 1 + yyt + 2 * (yyt * 3 + 1)); 190 Sprite(offscreen, HGrTerrain, x, 64 - yyt, xxt * 2, yyt * 2, 191 1 + 7 * (xxt * 2 + 1), 1 + yyt + 2 * (2 + TerrType - fForest) * 192 (yyt * 3 + 1)); 193 end; 194 if TileImp and fTerImp = tiFarm then 195 Sprite(offscreen, HGrTerrain, x, 64 - yyt, xxt * 2, yyt * 2, 196 1 + (xxt * 2 + 1), 1 + yyt + 12 * (yyt * 3 + 1)) 197 else if TileImp and fTerImp = tiIrrigation then 198 Sprite(offscreen, HGrTerrain, x, 64 - yyt, xxt * 2, yyt * 2, 1, 199 1 + yyt + 12 * (yyt * 3 + 1)); 200 if TileImp and fRR <> 0 then 201 begin 202 Sprite(offscreen, HGrTerrain, x, 64 - yyt, xxt * 2, yyt * 2, 203 1 + 6 * (xxt * 2 + 1), 1 + yyt + 10 * (yyt * 3 + 1)); 204 Sprite(offscreen, HGrTerrain, x, 64 - yyt, xxt * 2, yyt * 2, 205 1 + 2 * (xxt * 2 + 1), 1 + yyt + 10 * (yyt * 3 + 1)); 191 206 end 192 else if TileImp and fRoad<>0 then 193 begin 194 Sprite(offscreen,HGrTerrain,x,64-yyt,xxt*2,yyt*2,1+6*(xxt*2+1),1+yyt+9*(yyt*3+1)); 195 Sprite(offscreen,HGrTerrain,x,64-yyt,xxt*2,yyt*2,1+2*(xxt*2+1),1+yyt+9*(yyt*3+1)); 196 end; 197 if TileImp and fTerImp=tiMine then 198 Sprite(offscreen,HGrTerrain,x,64-yyt,xxt*2,yyt*2,1+2*(xxt*2+1),1+yyt+12*(yyt*3+1)); 199 inc(x,xxt*2+6) 200 end; 201 202 for i:=0 to Popup.Items.Count-1 do 203 if Popup.Items[i].Tag=Page then 204 s:=Popup.Items[i].Caption; 205 if Cost>0 then s:=Format(Phrases.Lookup('ENHANCE'),[s,MovementToString(Cost)]); 206 LoweredTextOut(offscreen.Canvas,-1,MainTexture, 207 (InnerWidth-BiColorTextWidth(Offscreen.Canvas,s)) div 2,12,s); 208 209 if EndStage>0 then LastJob:=MyData.EnhancementJobs[Page,EndStage-1] 210 else LastJob:=jNone; 211 if jRoad in Done then job1.ButtonIndex:=3 else job1.ButtonIndex:=2; 212 if jRR in Done then job2.ButtonIndex:=3 else job2.ButtonIndex:=2; 213 if jIrr in Done then job4.ButtonIndex:=3 else job4.ButtonIndex:=2; 214 if jFarm in Done then job5.ButtonIndex:=3 else job5.ButtonIndex:=2; 215 if jMine in Done then job7.ButtonIndex:=3 else job7.ButtonIndex:=2; 216 if LastJob=jClear then job3.ButtonIndex:=3 else job3.ButtonIndex:=2; 217 if LastJob=jAfforest then job6.ButtonIndex:=3 else job6.ButtonIndex:=2; 218 if LastJob=jTrans then job9.ButtonIndex:=3 else job9.ButtonIndex:=2; 219 220 TypeChanged:= LastJob in [jClear, jAfforest, jTrans]; 221 job1.Visible:=(jRoad in Done) or not TypeChanged; 222 job2.Visible:=(jRR in Done) or not TypeChanged; 223 job4.Visible:=(jIrr in Done) or not TypeChanged and (Terrain[TerrType].IrrEff>0); 224 job5.Visible:=(jFarm in Done) or not TypeChanged and (Terrain[TerrType].IrrEff>0); 225 job7.Visible:=(jMine in Done) or not TypeChanged and (Terrain[TerrType].MineEff>0); 226 job3.Visible:=not TypeChanged and (Terrain[TerrType].ClearTerrain>=0) 227 and ((TerrType<>fDesert) or (MyRO.Wonder[woGardens].EffectiveOwner=me)) 228 or (LastJob=jClear); 229 job6.Visible:=not TypeChanged and (Terrain[TerrType].AfforestTerrain>=0) 230 or (LastJob=jAfforest); 231 job9.Visible:=not TypeChanged and (Terrain[TerrType].TransTerrain>=0) 232 or (LastJob=jTrans); 233 234 MarkUsedOffscreen(InnerWidth,InnerHeight); 235 end; {OffscreenPaint} 207 else if TileImp and fRoad <> 0 then 208 begin 209 Sprite(offscreen, HGrTerrain, x, 64 - yyt, xxt * 2, yyt * 2, 210 1 + 6 * (xxt * 2 + 1), 1 + yyt + 9 * (yyt * 3 + 1)); 211 Sprite(offscreen, HGrTerrain, x, 64 - yyt, xxt * 2, yyt * 2, 212 1 + 2 * (xxt * 2 + 1), 1 + yyt + 9 * (yyt * 3 + 1)); 213 end; 214 if TileImp and fTerImp = tiMine then 215 Sprite(offscreen, HGrTerrain, x, 64 - yyt, xxt * 2, yyt * 2, 216 1 + 2 * (xxt * 2 + 1), 1 + yyt + 12 * (yyt * 3 + 1)); 217 inc(x, xxt * 2 + 6) 218 end; 219 220 for i := 0 to Popup.Items.Count - 1 do 221 if Popup.Items[i].Tag = Page then 222 s := Popup.Items[i].Caption; 223 if Cost > 0 then 224 s := Format(Phrases.Lookup('ENHANCE'), [s, MovementToString(Cost)]); 225 LoweredTextOut(offscreen.Canvas, -1, MainTexture, 226 (InnerWidth - BiColorTextWidth(offscreen.Canvas, s)) div 2, 12, s); 227 228 if EndStage > 0 then 229 LastJob := MyData.EnhancementJobs[Page, EndStage - 1] 230 else 231 LastJob := jNone; 232 if jRoad in Done then 233 job1.ButtonIndex := 3 234 else 235 job1.ButtonIndex := 2; 236 if jRR in Done then 237 job2.ButtonIndex := 3 238 else 239 job2.ButtonIndex := 2; 240 if jIrr in Done then 241 job4.ButtonIndex := 3 242 else 243 job4.ButtonIndex := 2; 244 if jFarm in Done then 245 job5.ButtonIndex := 3 246 else 247 job5.ButtonIndex := 2; 248 if jMine in Done then 249 job7.ButtonIndex := 3 250 else 251 job7.ButtonIndex := 2; 252 if LastJob = jClear then 253 job3.ButtonIndex := 3 254 else 255 job3.ButtonIndex := 2; 256 if LastJob = jAfforest then 257 job6.ButtonIndex := 3 258 else 259 job6.ButtonIndex := 2; 260 if LastJob = jTrans then 261 job9.ButtonIndex := 3 262 else 263 job9.ButtonIndex := 2; 264 265 TypeChanged := LastJob in [jClear, jAfforest, jTrans]; 266 job1.Visible := (jRoad in Done) or not TypeChanged; 267 job2.Visible := (jRR in Done) or not TypeChanged; 268 job4.Visible := (jIrr in Done) or not TypeChanged and 269 (Terrain[TerrType].IrrEff > 0); 270 job5.Visible := (jFarm in Done) or not TypeChanged and 271 (Terrain[TerrType].IrrEff > 0); 272 job7.Visible := (jMine in Done) or not TypeChanged and 273 (Terrain[TerrType].MineEff > 0); 274 job3.Visible := not TypeChanged and (Terrain[TerrType].ClearTerrain >= 0) and 275 ((TerrType <> fDesert) or (MyRO.Wonder[woGardens].EffectiveOwner = me)) or 276 (LastJob = jClear); 277 job6.Visible := not TypeChanged and (Terrain[TerrType].AfforestTerrain >= 0) 278 or (LastJob = jAfforest); 279 job9.Visible := not TypeChanged and (Terrain[TerrType].TransTerrain >= 0) or 280 (LastJob = jTrans); 281 282 MarkUsedOffscreen(InnerWidth, InnerHeight); 283 end; { OffscreenPaint } 236 284 237 285 procedure TEnhanceDlg.CloseBtnClick(Sender: TObject); 238 286 begin 239 Close287 Close 240 288 end; 241 289 242 290 procedure TEnhanceDlg.ToggleBtnClick(Sender: TObject); 243 291 var 244 i: integer;245 begin 246 for i:=0 to Popup.Items.Count-1 do247 Popup.Items[i].Checked:= Popup.Items[i].Tag=Page;248 Popup.Popup(Left+ToggleBtn.Left, Top+ToggleBtn.Top+ToggleBtn.Height);292 i: integer; 293 begin 294 for i := 0 to Popup.Items.Count - 1 do 295 Popup.Items[i].Checked := Popup.Items[i].Tag = Page; 296 Popup.Popup(Left + ToggleBtn.Left, Top + ToggleBtn.Top + ToggleBtn.Height); 249 297 end; 250 298 251 299 procedure TEnhanceDlg.TerrClick(Sender: TObject); 252 300 begin 253 Page:=TComponent(Sender).Tag;254 SmartUpdateContent301 Page := TComponent(Sender).Tag; 302 SmartUpdateContent 255 303 end; 256 304 257 305 procedure TEnhanceDlg.JobClick(Sender: TObject); 258 306 var 259 stage, NewJob: integer;260 Done: Set of jNone..jTrans;307 stage, NewJob: integer; 308 Done: Set of jNone .. jTrans; 261 309 262 310 procedure RemoveJob(j: integer); 263 311 begin // remove job 264 stage:=0;265 while (stage<5) and (MyData.EnhancementJobs[Page,stage]<>jNone) do266 begin 267 if (MyData.EnhancementJobs[Page,stage]=j) or (j=jRoad)268 and (MyData.EnhancementJobs[Page,stage]=jRR)269 or (j=jIrr) and (MyData.EnhancementJobs[Page,stage]=jFarm) then312 stage := 0; 313 while (stage < 5) and (MyData.EnhancementJobs[Page, stage] <> jNone) do 314 begin 315 if (MyData.EnhancementJobs[Page, stage] = j) or (j = jRoad) and 316 (MyData.EnhancementJobs[Page, stage] = jRR) or (j = jIrr) and 317 (MyData.EnhancementJobs[Page, stage] = jFarm) then 270 318 begin 271 if stage<4 then272 move(MyData.EnhancementJobs[Page,stage+1],273 MyData.EnhancementJobs[Page,stage],4-stage);274 MyData.EnhancementJobs[Page,4]:=jNone319 if stage < 4 then 320 move(MyData.EnhancementJobs[Page, stage + 1], 321 MyData.EnhancementJobs[Page, stage], 4 - stage); 322 MyData.EnhancementJobs[Page, 4] := jNone 275 323 end 276 else inc(stage); 277 end; 278 end; 279 280 begin 281 NewJob:=TButtonC(Sender).Tag; 282 Done:=[]; 283 stage:=0; 284 while (stage<5) and (MyData.EnhancementJobs[Page,stage]<>jNone) do 324 else 325 inc(stage); 326 end; 327 end; 328 329 begin 330 NewJob := TButtonC(Sender).Tag; 331 Done := []; 332 stage := 0; 333 while (stage < 5) and (MyData.EnhancementJobs[Page, stage] <> jNone) do 285 334 begin 286 include(Done, MyData.EnhancementJobs[Page,stage]); 287 inc(stage); 288 end; 289 if NewJob in Done then RemoveJob(NewJob) 290 else 335 include(Done, MyData.EnhancementJobs[Page, stage]); 336 inc(stage); 337 end; 338 if NewJob in Done then 339 RemoveJob(NewJob) 340 else 291 341 begin // add job 292 if NewJob in [jMine,jAfforest] then RemoveJob(jIrr); 293 if NewJob in [jIrr,jFarm,jTrans] then RemoveJob(jMine); 294 if (NewJob=jRR) and not (jRoad in Done) then 295 begin MyData.EnhancementJobs[Page,stage]:=jRoad; inc(stage) end; 296 if (NewJob=jFarm) and not (jIrr in Done) then 297 begin MyData.EnhancementJobs[Page,stage]:=jIrr; inc(stage) end; 298 MyData.EnhancementJobs[Page,stage]:=NewJob 299 end; 300 SmartUpdateContent 342 if NewJob in [jMine, jAfforest] then 343 RemoveJob(jIrr); 344 if NewJob in [jIrr, jFarm, jTrans] then 345 RemoveJob(jMine); 346 if (NewJob = jRR) and not(jRoad in Done) then 347 begin 348 MyData.EnhancementJobs[Page, stage] := jRoad; 349 inc(stage) 350 end; 351 if (NewJob = jFarm) and not(jIrr in Done) then 352 begin 353 MyData.EnhancementJobs[Page, stage] := jIrr; 354 inc(stage) 355 end; 356 MyData.EnhancementJobs[Page, stage] := NewJob 357 end; 358 SmartUpdateContent 301 359 end; 302 360 … … 304 362 Shift: TShiftState); 305 363 begin 306 if Key=VK_ESCAPE then Close 307 else if Key=VK_F1 then 308 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkText, HelpDlg.TextIndex('MACRO')) 364 if Key = VK_ESCAPE then 365 Close 366 else if Key = VK_F1 then 367 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkText, 368 HelpDlg.TextIndex('MACRO')) 309 369 end; 310 370 311 371 end. 312 -
trunk/LocalPlayer/Help.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit Help; 4 3 … … 6 5 7 6 uses 8 Protocol, ScreenTools,BaseWin,StringTables,7 Protocol, ScreenTools, BaseWin, StringTables, 9 8 10 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, … … 12 11 13 12 const 14 MaxHist=16; 15 16 {link categories} 17 hkNoLink=0;hkAdv=1;hkImp=2;hkTer=3;hkFeature=4;hkInternet=5;hkModel=6;hkMisc=7; 18 hkCrossLink=$40; 19 hkText=$80; 20 21 liInvalid=$3FFF; // link index indicates invalid link 22 23 {link indices for category hkMisc} 24 miscMain=0; miscCredits=1; miscGovList=2; miscJobList=3; miscSearchResult=7; 25 26 fJungle=8; // pseudo terrain 27 13 MaxHist = 16; 14 15 { link categories } 16 hkNoLink = 0; 17 hkAdv = 1; 18 hkImp = 2; 19 hkTer = 3; 20 hkFeature = 4; 21 hkInternet = 5; 22 hkModel = 6; 23 hkMisc = 7; 24 hkCrossLink = $40; 25 hkText = $80; 26 27 liInvalid = $3FFF; // link index indicates invalid link 28 29 { link indices for category hkMisc } 30 miscMain = 0; 31 miscCredits = 1; 32 miscGovList = 2; 33 miscJobList = 3; 34 miscSearchResult = 7; 35 36 fJungle = 8; // pseudo terrain 28 37 29 38 type 30 THyperText =class(TStringList)31 procedure AddLine(s: String = ''; Format: integer =0; Picpix: integer =0;32 LinkCategory: integer = 0; LinkIndex: integer =0);39 THyperText = class(TStringList) 40 procedure AddLine(s: String = ''; Format: integer = 0; Picpix: integer = 0; 41 LinkCategory: integer = 0; LinkIndex: integer = 0); 33 42 procedure LF; 34 43 end; 35 44 36 45 THelpDlg = class(TFramedDlg) … … 39 48 TopBtn: TButtonB; 40 49 SearchBtn: TButtonB; 41 procedure FormCreate(Sender: TObject);42 procedure FormDestroy(Sender: TObject);43 procedure FormPaint(Sender: TObject);44 procedure CloseBtnClick(Sender: TObject);45 procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; x,46 y: integer);50 procedure FormCreate(Sender: TObject); 51 procedure FormDestroy(Sender: TObject); 52 procedure FormPaint(Sender: TObject); 53 procedure CloseBtnClick(Sender: TObject); 54 procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; 55 x, y: integer); 47 56 procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; 48 57 Shift: TShiftState; x, y: integer); … … 50 59 procedure TopBtnClick(Sender: TObject); 51 60 procedure FormClose(Sender: TObject; var Action: TCloseAction); 52 procedure FormKeyDown(Sender: TObject; var Key: Word; 53 Shift: TShiftState); 61 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 54 62 procedure SearchBtnClick(Sender: TObject); 55 63 public 56 64 Difficulty: integer; 57 procedure ShowNewContent(NewMode, Category,Index: integer);65 procedure ShowNewContent(NewMode, Category, Index: integer); 58 66 procedure ClearHistory; 59 67 function TextIndex(Item: string): integer; … … 61 69 procedure OffscreenPaint; override; 62 70 private 63 Kind,no,Sel,nHist,CaptionColor: integer; 64 hADVHELP, hIMPHELP, hFEATUREHELP, hGOVHELP, hSPECIALMODEL, hJOBHELP: integer; 71 Kind, no, Sel, nHist, CaptionColor: integer; 72 hADVHELP, hIMPHELP, hFEATUREHELP, hGOVHELP, hSPECIALMODEL, 73 hJOBHELP: integer; 65 74 SearchContent, NewSearchContent: string; 66 75 CaptionFont: TFont; 67 76 MainText, SearchResult: THyperText; 68 77 HelpText: TStringTable; 69 ExtPic, TerrIcon: TBitmap;70 sb: TPVScrollbar;71 x0: array [-2..18] of integer;72 HistKind: array [0..MaxHist-1] of integer;73 HistNo: array [0..MaxHist-1] of integer;74 HistPos: array [0..MaxHist-1] of integer;75 HistSearchContent: array [0..MaxHist-1] of shortstring;78 ExtPic, TerrIcon: TBitmap; 79 sb: TPVScrollbar; 80 x0: array [-2 .. 18] of integer; 81 HistKind: array [0 .. MaxHist - 1] of integer; 82 HistNo: array [0 .. MaxHist - 1] of integer; 83 HistPos: array [0 .. MaxHist - 1] of integer; 84 HistSearchContent: array [0 .. MaxHist - 1] of shortstring; 76 85 procedure line(ca: TCanvas; i: integer; lit: boolean); 77 86 procedure Prepare(sbPos: integer = 0); 78 procedure WaterSign(x0, y0,iix: integer);87 procedure WaterSign(x0, y0, iix: integer); 79 88 procedure Search(SearchString: string); 80 procedure OnScroll(var m: TMessage); message WM_VSCROLL;81 procedure OnMouseWheel(var m: TMessage); message WM_MOUSEWHEEL;82 procedure OnMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;89 procedure OnScroll(var m: TMessage); message WM_VSCROLL; 90 procedure OnMouseWheel(var m: TMessage); message WM_MOUSEWHEEL; 91 procedure OnMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE; 83 92 end; 84 93 … … 89 98 90 99 uses 91 Directories,ClientTools,Term,Tribes,ShellAPI, Inp,Messg;100 Directories, ClientTools, Term, Tribes, ShellAPI, Inp, Messg; 92 101 93 102 {$R *.DFM} 94 103 95 104 type 96 THelpLineInfo=packed record97 Format, Picpix: Byte;98 Link: Word;105 THelpLineInfo = packed record 106 Format, Picpix: Byte; 107 Link: Word; 99 108 end; 100 109 … … 102 111 LinkCategory: integer; LinkIndex: integer); 103 112 var 104 HelpLineInfo: THelpLineInfo;113 HelpLineInfo: THelpLineInfo; 105 114 begin 106 if LinkIndex<0 then LinkIndex:=liInvalid; 107 HelpLineInfo.Format:=Format; 108 HelpLineInfo.Picpix:=Picpix; 109 HelpLineInfo.Link:=LinkCategory shl 8+LinkIndex; 110 AddObject(s,TObject(HelpLineInfo)); 115 if LinkIndex < 0 then 116 LinkIndex := liInvalid; 117 HelpLineInfo.Format := Format; 118 HelpLineInfo.Picpix := Picpix; 119 HelpLineInfo.Link := LinkCategory shl 8 + LinkIndex; 120 AddObject(s, TObject(HelpLineInfo)); 111 121 end; 112 122 113 123 procedure THyperText.LF; 114 124 begin 115 AddLine;125 AddLine; 116 126 end; 117 127 118 119 128 const 120 {text formats} 121 pkNormal=0;pkCaption=1;pkSmallIcon=2;pkBigIcon=3;pkAdvIcon=4;pkTer=5; 122 pkBigTer=6;pkFeature=7;pkDot=8;pkNormal_Dot=9;pkDomain=10;pkSection=11; 123 pkBigFeature=12;pkExp=13;pkAITStat=14;pkExternal=15;pkModel=16;pkNormal_64=17; 124 pkIllu=18;pkLogo=19;pkTerImp=20;pkRightIcon=21;pkAdvIcon_AsPreq=22; 125 pkSmallIcon_AsPreq=23;pkSpecialIcon=24;pkGov=25; 126 127 nSeeAlso=14; 128 SeeAlso: array[0..nSeeAlso-1] of record Kind,no,SeeKind,SeeNo: integer end= 129 ((Kind:hkImp;no:imWalls;SeeKind:hkFeature;SeeNo:mcArtillery), 130 (Kind:hkImp;no:imHydro;SeeKind:hkImp;SeeNo:woHoover), 131 (Kind:hkImp;no:imWalls;SeeKind:hkImp;SeeNo:imGrWall), 132 (Kind:hkImp;no:imHighways;SeeKind:hkAdv;SeeNo:adWheel), 133 (Kind:hkImp;no:imCathedral;SeeKind:hkImp;SeeNo:woBach), 134 (Kind:hkImp;no:imBank;SeeKind:hkImp;SeeNo:imStockEx), 135 (Kind:hkImp;no:imShipComp;SeeKind:hkImp;SeeNo:imSpacePort), 136 (Kind:hkImp;no:imShipPow;SeeKind:hkImp;SeeNo:imSpacePort), 137 (Kind:hkImp;no:imShipHab;SeeKind:hkImp;SeeNo:imSpacePort), 138 (Kind:hkFeature;no:mcSub;SeeKind:hkFeature;SeeNo:mcRadar), 139 (Kind:hkFeature;no:mcDefense;SeeKind:hkAdv;SeeNo:adSteel), 140 (Kind:hkFeature;no:mcSE;SeeKind:hkFeature;SeeNo:mcNP), 141 (Kind:hkAdv;no:adWheel;SeeKind:hkImp;SeeNo:imHighways), 142 (Kind:hkAdv;no:adSteel;SeeKind:hkFeature;SeeNo:mcDefense)); 143 144 nTerrainHelp=14; 145 TerrainHelp: array[0..nTerrainHelp-1] of integer= 146 (fGrass,fGrass+12,fPrairie,fForest,fJungle,fHills,fMountains,fSwamp,fTundra,fArctic, 147 fDesert,3*12{DeadLands},fShore,fOcean); 148 149 nJobHelp=8; 150 JobHelp: array[0..nJobHelp-1] of integer= 151 (jRoad,jRR,jCanal,jIrr,jFarm,jMine,jFort,jBase); 152 153 154 procedure THelpDlg.FormCreate(Sender:TObject); 129 { text formats } 130 pkNormal = 0; 131 pkCaption = 1; 132 pkSmallIcon = 2; 133 pkBigIcon = 3; 134 pkAdvIcon = 4; 135 pkTer = 5; 136 pkBigTer = 6; 137 pkFeature = 7; 138 pkDot = 8; 139 pkNormal_Dot = 9; 140 pkDomain = 10; 141 pkSection = 11; 142 pkBigFeature = 12; 143 pkExp = 13; 144 pkAITStat = 14; 145 pkExternal = 15; 146 pkModel = 16; 147 pkNormal_64 = 17; 148 pkIllu = 18; 149 pkLogo = 19; 150 pkTerImp = 20; 151 pkRightIcon = 21; 152 pkAdvIcon_AsPreq = 22; 153 pkSmallIcon_AsPreq = 23; 154 pkSpecialIcon = 24; 155 pkGov = 25; 156 157 nSeeAlso = 14; 158 SeeAlso: array [0 .. nSeeAlso - 1] of record Kind, no, SeeKind, 159 SeeNo: integer end = ((Kind: hkImp; no: imWalls; SeeKind: hkFeature; 160 SeeNo: mcArtillery), (Kind: hkImp; no: imHydro; SeeKind: hkImp; 161 SeeNo: woHoover), (Kind: hkImp; no: imWalls; SeeKind: hkImp; 162 SeeNo: imGrWall), (Kind: hkImp; no: imHighways; SeeKind: hkAdv; 163 SeeNo: adWheel), (Kind: hkImp; no: imCathedral; SeeKind: hkImp; 164 SeeNo: woBach), (Kind: hkImp; no: imBank; SeeKind: hkImp; SeeNo: imStockEx), 165 (Kind: hkImp; no: imShipComp; SeeKind: hkImp; SeeNo: imSpacePort), 166 (Kind: hkImp; no: imShipPow; SeeKind: hkImp; SeeNo: imSpacePort), 167 (Kind: hkImp; no: imShipHab; SeeKind: hkImp; SeeNo: imSpacePort), 168 (Kind: hkFeature; no: mcSub; SeeKind: hkFeature; SeeNo: mcRadar), 169 (Kind: hkFeature; no: mcDefense; SeeKind: hkAdv; SeeNo: adSteel), 170 (Kind: hkFeature; no: mcSE; SeeKind: hkFeature; SeeNo: mcNP), (Kind: hkAdv; 171 no: adWheel; SeeKind: hkImp; SeeNo: imHighways), (Kind: hkAdv; no: adSteel; 172 SeeKind: hkFeature; SeeNo: mcDefense)); 173 174 nTerrainHelp = 14; 175 TerrainHelp: array [0 .. nTerrainHelp - 1] of integer = (fGrass, fGrass + 12, 176 fPrairie, fForest, fJungle, fHills, fMountains, fSwamp, fTundra, fArctic, 177 fDesert, 3 * 12 { DeadLands } , fShore, fOcean); 178 179 nJobHelp = 8; 180 JobHelp: array [0 .. nJobHelp - 1] of integer = (jRoad, jRR, jCanal, jIrr, 181 jFarm, jMine, jFort, jBase); 182 183 procedure THelpDlg.FormCreate(Sender: TObject); 155 184 begin 156 inherited; 157 CaptionLeft:=BackBtn.Left+BackBtn.Width; 158 CaptionRight:=SearchBtn.Left; 159 inc(ModalFrameIndent,29); 160 MainText:=THyperText.Create; 161 SearchResult:=THyperText.Create; 162 CreatePVSB(sb,Handle,36,551,36+432); 163 164 HelpText:=TStringTable.Create; 165 HelpText.LoadFromFile(LocalizedFilePath('Help\help.txt')); 166 hADVHELP:=HelpText.Gethandle('ADVHELP'); 167 hIMPHELP:=HelpText.Gethandle('IMPHELP'); 168 hFEATUREHELP:=HelpText.Gethandle('FEATUREHELP'); 169 hGOVHELP:=HelpText.Gethandle('GOVHELP'); 170 hSPECIALMODEL:=HelpText.Gethandle('SPECIALMODEL'); 171 hJOBHELP:=HelpText.Gethandle('JOBHELP'); 172 173 CaptionFont:=Font.Create; 174 CaptionFont.Assign(UniFont[ftNormal]); 175 CaptionFont.Style:=CaptionFont.Style+[fsItalic,fsBold]; 176 InitButtons(); 177 178 TopBtn.Hint:=Phrases.Lookup('BTN_CONTENTS'); 179 BackBtn.Hint:=Phrases.Lookup('BTN_BACK'); 180 SearchBtn.Hint:=Phrases.Lookup('BTN_SEARCH'); 181 182 ExtPic:=TBitmap.Create; 183 TerrIcon:=TBitmap.Create; 184 TerrIcon.PixelFormat:=pf24bit; 185 TerrIcon.Width:=xSizeBig; TerrIcon.Height:=ySizeBig; 186 SearchContent:=''; 187 nHist:=-1; 185 inherited; 186 CaptionLeft := BackBtn.Left + BackBtn.Width; 187 CaptionRight := SearchBtn.Left; 188 inc(ModalFrameIndent, 29); 189 MainText := THyperText.Create; 190 SearchResult := THyperText.Create; 191 CreatePVSB(sb, Handle, 36, 551, 36 + 432); 192 193 HelpText := TStringTable.Create; 194 HelpText.LoadFromFile(LocalizedFilePath('Help\help.txt')); 195 hADVHELP := HelpText.Gethandle('ADVHELP'); 196 hIMPHELP := HelpText.Gethandle('IMPHELP'); 197 hFEATUREHELP := HelpText.Gethandle('FEATUREHELP'); 198 hGOVHELP := HelpText.Gethandle('GOVHELP'); 199 hSPECIALMODEL := HelpText.Gethandle('SPECIALMODEL'); 200 hJOBHELP := HelpText.Gethandle('JOBHELP'); 201 202 CaptionFont := Font.Create; 203 CaptionFont.Assign(UniFont[ftNormal]); 204 CaptionFont.Style := CaptionFont.Style + [fsItalic, fsBold]; 205 InitButtons(); 206 207 TopBtn.Hint := Phrases.Lookup('BTN_CONTENTS'); 208 BackBtn.Hint := Phrases.Lookup('BTN_BACK'); 209 SearchBtn.Hint := Phrases.Lookup('BTN_SEARCH'); 210 211 ExtPic := TBitmap.Create; 212 TerrIcon := TBitmap.Create; 213 TerrIcon.PixelFormat := pf24bit; 214 TerrIcon.Width := xSizeBig; 215 TerrIcon.Height := ySizeBig; 216 SearchContent := ''; 217 nHist := -1; 188 218 end; 189 219 190 220 procedure THelpDlg.ClearHistory; 191 221 begin 192 nHist:=-1;222 nHist := -1; 193 223 end; 194 224 195 procedure THelpDlg.FormDestroy(Sender: TObject);225 procedure THelpDlg.FormDestroy(Sender: TObject); 196 226 begin 197 MainText.Free;198 SearchResult.Free;199 ExtPic.Free;200 TerrIcon.Free;201 HelpText.Free;202 //CaptionFont.Free;227 MainText.Free; 228 SearchResult.Free; 229 ExtPic.Free; 230 TerrIcon.Free; 231 HelpText.Free; 232 // CaptionFont.Free; 203 233 end; 204 234 205 procedure THelpDlg.CloseBtnClick(Sender: TObject);235 procedure THelpDlg.CloseBtnClick(Sender: TObject); 206 236 begin 207 Close237 Close 208 238 end; 209 239 210 procedure THelpDlg.OnScroll(var m: TMessage);240 procedure THelpDlg.OnScroll(var m: TMessage); 211 241 begin 212 if ProcessPVSB(sb,m) then 213 begin Sel:=-1; SmartUpdateContent(true) end 214 end; 215 216 procedure THelpDlg.OnMouseWheel(var m:TMessage); 217 begin 218 if ProcessMouseWheel(sb,m) then 219 begin 220 Sel:=-1; 221 SmartUpdateContent(true); 222 PaintBox1MouseMove(nil, [], m.lParam and $FFFF-Left, m.lParam shr 16-Top); 242 if ProcessPVSB(sb, m) then 243 begin 244 Sel := -1; 245 SmartUpdateContent(true) 223 246 end 224 247 end; 225 248 226 procedure THelpDlg.OnMouse Leave(var Msg:TMessage);249 procedure THelpDlg.OnMouseWheel(var m: TMessage); 227 250 begin 228 if Sel<>-1 then 229 begin 230 line(Canvas,Sel,false); 231 Sel:=-1 251 if ProcessMouseWheel(sb, m) then 252 begin 253 Sel := -1; 254 SmartUpdateContent(true); 255 PaintBox1MouseMove(nil, [], m.lParam and $FFFF - Left, 256 m.lParam shr 16 - Top); 232 257 end 233 258 end; 234 259 235 procedure THelpDlg. FormPaint(Sender:TObject);260 procedure THelpDlg.OnMouseLeave(var Msg: TMessage); 236 261 begin 237 inherited; 238 Canvas.Font.Assign(UniFont[ftNormal]); 262 if Sel <> -1 then 263 begin 264 line(Canvas, Sel, false); 265 Sel := -1 266 end 267 end; 268 269 procedure THelpDlg.FormPaint(Sender: TObject); 270 begin 271 inherited; 272 Canvas.Font.Assign(UniFont[ftNormal]); 239 273 end; 240 274 241 275 procedure THelpDlg.line(ca: TCanvas; i: integer; lit: boolean); 242 276 var 243 TextColor,x,y: integer;244 TextSize: TSize;245 s: string;277 TextColor, x, y: integer; 278 TextSize: TSize; 279 s: string; 246 280 begin 247 s:=MainText[sb.si.npos+i]; 248 if s='' then exit; 249 x:=x0[i]; y:=2+i*24; 250 if ca=Canvas then 251 begin x:=x+SideFrame; y:=y+WideFrame end; 252 if THelpLineInfo(MainText.Objects[sb.si.npos+i]).Format 253 in [pkCaption,pkBigTer,pkRightIcon,pkBigFeature] then 254 begin 255 ca.Font.Assign(CaptionFont); 256 { ca.brush.color:=CaptionColor; 257 ca.FillRect(rect(x,i*24,x+24,i*24+24)); 258 ca.brush.color:=$FFFFFF; 259 ca.FrameRect(rect(x+1,i*24+1,x+24-1,i*24+24-1)); 260 ca.Brush.Style:=bsClear;} 261 BitBlt(ca.handle,x,y-4,24,24,GrExt[HGrSystem].Data.Canvas.Handle,1,146,SRCCOPY); 262 BiColorTextOut(ca,$FFFFFF,$7F007F,x+10-ca.Textwidth(s[1]) div 2,y-3,s[1]); 263 BiColorTextOut(ca,CaptionColor,$7F007F,x+24,y-3,copy(s,2,255)); 264 ca.Font.Assign(UniFont[ftNormal]); 265 end 266 else if THelpLineInfo(MainText.Objects[sb.si.npos+i]).Format=pkSection then 267 begin 268 ca.Font.Assign(CaptionFont); 269 BiColorTextOut(ca,CaptionColor,$7F007F,x,y-3,s); 270 ca.Font.Assign(UniFont[ftNormal]); 271 end 272 else 273 begin 274 if (Kind=hkMisc) and (no=miscMain) then 281 s := MainText[sb.si.npos + i]; 282 if s = '' then 283 exit; 284 x := x0[i]; 285 y := 2 + i * 24; 286 if ca = Canvas then 287 begin 288 x := x + SideFrame; 289 y := y + WideFrame 290 end; 291 if THelpLineInfo(MainText.Objects[sb.si.npos + i]).Format 292 in [pkCaption, pkBigTer, pkRightIcon, pkBigFeature] then 293 begin 275 294 ca.Font.Assign(CaptionFont); 276 TextColor:=Colors.Canvas.Pixels[clkMisc,cliPaperText]; 277 if ca=Canvas then 278 begin 279 TextSize.cx:=BiColorTextWidth(ca,s); 280 TextSize.cy:=ca.TextHeight(s); 281 if y+TextSize.cy>=WideFrame+InnerHeight then 282 TextSize.cy:=WideFrame+InnerHeight-y; 283 FillSeamless(ca,x,y,TextSize.cx,TextSize.cy,-SideFrame,sb.si.npos*24-WideFrame, 284 Paper); 285 end; 286 BiColorTextOut(ca,TextColor,$7F007F,x,y,s); 287 if lit then with ca do 288 begin 289 assert(ca=Canvas); 290 pen.color:=TextColor; 291 moveto(x+1,y+TextSize.cy-2); 292 lineto(x+TextSize.cx,y+TextSize.cy-2); 293 end; 294 if (Kind=hkMisc) and (no=miscMain) then 295 { ca.brush.color:=CaptionColor; 296 ca.FillRect(rect(x,i*24,x+24,i*24+24)); 297 ca.brush.color:=$FFFFFF; 298 ca.FrameRect(rect(x+1,i*24+1,x+24-1,i*24+24-1)); 299 ca.Brush.Style:=bsClear; } 300 BitBlt(ca.Handle, x, y - 4, 24, 24, GrExt[HGrSystem].Data.Canvas.Handle, 1, 301 146, SRCCOPY); 302 BiColorTextOut(ca, $FFFFFF, $7F007F, x + 10 - ca.Textwidth(s[1]) div 2, 303 y - 3, s[1]); 304 BiColorTextOut(ca, CaptionColor, $7F007F, x + 24, y - 3, copy(s, 2, 255)); 295 305 ca.Font.Assign(UniFont[ftNormal]); 296 306 end 307 else if THelpLineInfo(MainText.Objects[sb.si.npos + i]).Format = pkSection 308 then 309 begin 310 ca.Font.Assign(CaptionFont); 311 BiColorTextOut(ca, CaptionColor, $7F007F, x, y - 3, s); 312 ca.Font.Assign(UniFont[ftNormal]); 313 end 314 else 315 begin 316 if (Kind = hkMisc) and (no = miscMain) then 317 ca.Font.Assign(CaptionFont); 318 TextColor := Colors.Canvas.Pixels[clkMisc, cliPaperText]; 319 if ca = Canvas then 320 begin 321 TextSize.cx := BiColorTextWidth(ca, s); 322 TextSize.cy := ca.TextHeight(s); 323 if y + TextSize.cy >= WideFrame + InnerHeight then 324 TextSize.cy := WideFrame + InnerHeight - y; 325 FillSeamless(ca, x, y, TextSize.cx, TextSize.cy, -SideFrame, 326 sb.si.npos * 24 - WideFrame, Paper); 327 end; 328 BiColorTextOut(ca, TextColor, $7F007F, x, y, s); 329 if lit then 330 with ca do 331 begin 332 assert(ca = Canvas); 333 pen.color := TextColor; 334 moveto(x + 1, y + TextSize.cy - 2); 335 lineto(x + TextSize.cx, y + TextSize.cy - 2); 336 end; 337 if (Kind = hkMisc) and (no = miscMain) then 338 ca.Font.Assign(UniFont[ftNormal]); 339 end 297 340 end; 298 341 299 procedure THelpDlg.WaterSign(x0, y0,iix: integer);342 procedure THelpDlg.WaterSign(x0, y0, iix: integer); 300 343 const 301 nHeaven=28;302 maxsum=9*9*255 *75 div 100;344 nHeaven = 28; 345 maxsum = 9 * 9 * 255 * 75 div 100; 303 346 type 304 TLine=array[0..649,0..2] of Byte;347 TLine = array [0 .. 649, 0 .. 2] of Byte; 305 348 var 306 x,y,dx,dy,xSrc,ySrc,sum,xx: integer;307 Heaven: array[0..nHeaven] of integer;308 PaintLine,CoalLine: ^TLine;309 ImpLine: array[-1..1] of ^TLine;349 x, y, dx, dy, xSrc, ySrc, sum, xx: integer; 350 Heaven: array [0 .. nHeaven] of integer; 351 PaintLine, CoalLine: ^TLine; 352 ImpLine: array [-1 .. 1] of ^TLine; 310 353 begin 311 // assume eiffel tower has free common heaven 312 for dy:=0 to nHeaven-1 do 313 Heaven[dy]:=BigImp.Canvas.Pixels[woEiffel mod 7 *xSizeBig, 314 (SystemIconLines+woEiffel div 7)*ySizeBig+dy]; 315 316 xSrc:=iix mod 7 *xSizeBig; 317 ySrc:=(iix div 7+1) *ySizeBig; 318 for y:=0 to ySizeBig*2-1 do if (y0+y>=0) and (y0+y<InnerHeight) then 319 begin 320 PaintLine:=OffScreen.ScanLine[y0+y]; 321 CoalLine:=Templates.ScanLine[yCoal+y]; 322 for dy:=-1 to 1 do 323 if ((y+dy) shr 1>=0) and ((y+dy) shr 1<ySizeBig) then 324 ImpLine[dy]:=BigImp.ScanLine[ySrc+(y+dy) shr 1]; 325 for x:=0 to xSizeBig*2-1 do 326 begin 327 sum:=0; 328 for dx:=-1 to 1 do 354 // assume eiffel tower has free common heaven 355 for dy := 0 to nHeaven - 1 do 356 Heaven[dy] := BigImp.Canvas.Pixels[woEiffel mod 7 * xSizeBig, 357 (SystemIconLines + woEiffel div 7) * ySizeBig + dy]; 358 359 xSrc := iix mod 7 * xSizeBig; 360 ySrc := (iix div 7 + 1) * ySizeBig; 361 for y := 0 to ySizeBig * 2 - 1 do 362 if (y0 + y >= 0) and (y0 + y < InnerHeight) then 363 begin 364 PaintLine := OffScreen.ScanLine[y0 + y]; 365 CoalLine := Templates.ScanLine[yCoal + y]; 366 for dy := -1 to 1 do 367 if ((y + dy) shr 1 >= 0) and ((y + dy) shr 1 < ySizeBig) then 368 ImpLine[dy] := BigImp.ScanLine[ySrc + (y + dy) shr 1]; 369 for x := 0 to xSizeBig * 2 - 1 do 329 370 begin 330 xx:=xSrc+(x+dx) shr 1; 331 for dy:=-1 to 1 do 332 if ((y+dy) shr 1<0) or ((y+dy) shr 1>=ySizeBig) 333 or ((x+dx) shr 1<0) or ((x+dx) shr 1>=xSizeBig) 334 or ((y+dy) shr 1<nHeaven) 335 and (ImpLine[dy,xx,0] shl 16+ImpLine[dy,xx,1] shl 8+ImpLine[dy,xx,2]=Heaven[(y+dy) shr 1]) then 336 sum:=sum+9*255 337 else sum:=sum+ImpLine[dy,xx,0]+5*ImpLine[dy,xx,1]+3*ImpLine[dy,xx,2]; 371 sum := 0; 372 for dx := -1 to 1 do 373 begin 374 xx := xSrc + (x + dx) shr 1; 375 for dy := -1 to 1 do 376 if ((y + dy) shr 1 < 0) or ((y + dy) shr 1 >= ySizeBig) or 377 ((x + dx) shr 1 < 0) or ((x + dx) shr 1 >= xSizeBig) or 378 ((y + dy) shr 1 < nHeaven) and 379 (ImpLine[dy, xx, 0] shl 16 + ImpLine[dy, xx, 1] shl 8 + 380 ImpLine[dy, xx, 2] = Heaven[(y + dy) shr 1]) then 381 sum := sum + 9 * 255 382 else 383 sum := sum + ImpLine[dy, xx, 0] + 5 * ImpLine[dy, xx, 1] + 3 * 384 ImpLine[dy, xx, 2]; 385 end; 386 if sum < maxsum then 387 begin // no saturation 388 sum := 1 shl 22 - (maxsum - sum) * (256 - CoalLine[xCoal + x, 0] * 2); 389 PaintLine[x0 + x, 0] := PaintLine[x0 + x, 0] * sum shr 22; 390 PaintLine[x0 + x, 1] := PaintLine[x0 + x, 1] * sum shr 22; 391 PaintLine[x0 + x, 2] := PaintLine[x0 + x, 2] * sum shr 22; 392 end 393 end 394 end; 395 end; 396 397 procedure THelpDlg.OffscreenPaint; 398 399 procedure PaintTerrIcon(x, y, xSrc, ySrc: integer); 400 begin 401 Frame(OffScreen.Canvas, x - 1, y - 1, x + xSizeBig, y + ySizeBig, 402 $000000, $000000); 403 if 2 * yyt < 40 then 404 begin 405 Sprite(OffScreen, HGrTerrain, x, y, 56, 2 * yyt, xSrc, ySrc); 406 Sprite(OffScreen, HGrTerrain, x, y + 2 * yyt, 56, 40 - 2 * yyt, 407 xSrc, ySrc); 408 end 409 else 410 Sprite(OffScreen, HGrTerrain, x, y, 56, 40, xSrc, ySrc); 411 Sprite(OffScreen, HGrTerrain, x, y, xxt, yyt, xSrc + xxt, ySrc + yyt); 412 Sprite(OffScreen, HGrTerrain, x, y + yyt, xxt, 40 - yyt, xSrc + xxt, ySrc); 413 Sprite(OffScreen, HGrTerrain, x + xxt, y, 56 - xxt, yyt, xSrc, ySrc + yyt); 414 Sprite(OffScreen, HGrTerrain, x + xxt, y + yyt, 56 - xxt, 40 - yyt, 415 xSrc, ySrc); 416 end; 417 418 var 419 i, j, yl, srcno, ofs, cnt, y: integer; 420 s: string; 421 HelpLineInfo: THelpLineInfo; 422 begin 423 inherited; 424 CaptionColor := Colors.Canvas.Pixels[clkMisc, cliPaperCaption]; 425 FillSeamless(OffScreen.Canvas, 0, 0, InnerWidth, InnerHeight, 0, 426 sb.si.npos * 24, Paper); 427 with OffScreen.Canvas do 428 begin 429 Font.Assign(UniFont[ftNormal]); 430 for i := -sb.si.npos to InnerHeight div 24 do 431 if sb.si.npos + i < MainText.Count then 432 begin 433 HelpLineInfo := THelpLineInfo(MainText.Objects[sb.si.npos + i]); 434 if HelpLineInfo.Format = pkExternal then 435 begin 436 yl := ExtPic.Height; 437 if 4 + i * 24 + yl > InnerHeight then 438 yl := InnerHeight - (4 + i * 24); 439 BitBlt(Handle, 8, 4 + i * 24, ExtPic.Width, yl, ExtPic.Canvas.Handle, 440 0, 0, SRCCOPY); 441 end 338 442 end; 339 if sum<maxsum then 340 begin // no saturation 341 sum:=1 shl 22 - (maxsum-sum)*(256-CoalLine[xCoal+x,0]*2); 342 PaintLine[x0+x,0]:=PaintLine[x0+x,0]*sum shr 22; 343 PaintLine[x0+x,1]:=PaintLine[x0+x,1]*sum shr 22; 344 PaintLine[x0+x,2]:=PaintLine[x0+x,2]*sum shr 22; 443 for i := -2 to InnerHeight div 24 do 444 if (sb.si.npos + i >= 0) and (sb.si.npos + i < MainText.Count) then 445 begin 446 HelpLineInfo := THelpLineInfo(MainText.Objects[sb.si.npos + i]); 447 if HelpLineInfo.Link <> 0 then 448 begin 449 if (Kind = hkMisc) and (no = miscSearchResult) then 450 Sprite(OffScreen, HGrSystem, 18, 9 + i * 24, 8, 8, 90, 16) 451 else if HelpLineInfo.Format in [pkSmallIcon_AsPreq, pkAdvIcon_AsPreq] 452 then 453 Sprite(OffScreen, HGrSystem, 12, i * 24 + 5, 14, 14, 65, 20) 454 else if HelpLineInfo.Link and (hkCrossLink shl 8) <> 0 then 455 Sprite(OffScreen, HGrSystem, 12, i * 24 + 5, 14, 14, 80, 1) 456 else if not((Kind = hkMisc) and (no = miscMain)) then 457 Sprite(OffScreen, HGrSystem, 10, i * 24 + 6, 14, 14, 65, 1); 458 x0[i] := 24; 459 end 460 else 461 x0[i] := 0; 462 case HelpLineInfo.Format of 463 pkLogo: 464 begin 465 Server(sGetVersion, 0, 0, j); 466 s := Format('%d.%d.%d', [j shr 16 and $FF, j shr 8 and $FF, 467 j and $FF]); 468 PaintLogo(OffScreen.Canvas, (InnerWidth - 122) div 2, i * 24 + 1, 469 GrExt[HGrSystem].Data.Canvas.Pixels[95, 1], $000000); 470 Font.Assign(UniFont[ftSmall]); 471 BiColorTextOut(OffScreen.Canvas, $000000, $7F007F, 472 (InnerWidth - Textwidth(s)) div 2, i * 24 + 26, s); 473 Font.Assign(UniFont[ftNormal]); 474 end; 475 pkSmallIcon, pkSmallIcon_AsPreq: 476 begin 477 Frame(OffScreen.Canvas, 8 - 1 + x0[i], 2 - 1 + i * 24, 478 8 + xSizeSmall + x0[i], 2 + 20 + i * 24, $000000, $000000); 479 if HelpLineInfo.Picpix = imPalace then 480 BitBlt(OffScreen.Canvas.Handle, 8 + x0[i], 2 + i * 24, 481 xSizeSmall, ySizeSmall, SmallImp.Canvas.Handle, 482 0 * xSizeSmall, 1 * ySizeSmall, SRCCOPY) 483 else 484 BitBlt(OffScreen.Canvas.Handle, 8 + x0[i], 2 + i * 24, 485 xSizeSmall, ySizeSmall, SmallImp.Canvas.Handle, 486 HelpLineInfo.Picpix mod 7 * xSizeSmall, 487 (HelpLineInfo.Picpix + SystemIconLines * 7) div 7 * 488 ySizeSmall, SRCCOPY); 489 x0[i] := x0[i] + (8 + 8 + 36); 490 end; 491 pkBigIcon: 492 begin 493 FrameImage(OffScreen.Canvas, BigImp, x0[i] + 12, i * 24 - 7, 56, 494 40, HelpLineInfo.Picpix mod 7 * xSizeBig, 495 HelpLineInfo.Picpix div 7 * ySizeBig); 496 x0[i] := 64 + 8 + 8 + x0[i]; 497 end; 498 pkSpecialIcon: 499 begin 500 case HelpLineInfo.Picpix of 501 0: 502 FrameImage(OffScreen.Canvas, GrExt[HGrSystem2].Data, 503 12 + x0[i], -7 + i * 24, 56, 40, 137, 127); 504 1: 505 begin 506 PaintTerrIcon(12 + x0[i], -7 + i * 24, 507 1 + 3 * (xxt * 2 + 1), 1 + yyt); 508 if 2 * yyt < 40 then 509 Sprite(OffScreen, HGrTerrain, 12 + x0[i], -7 + 4 + i * 24, 510 56, 2 * yyt, 1 + 3 * (xxt * 2 + 1) + xxt - 28, 511 1 + yyt + 1 * (yyt * 3 + 1)) 512 else 513 Sprite(OffScreen, HGrTerrain, 12 + x0[i], 514 -7 + 4 + i * 24 - 4, 56, 40, 1 + 3 * (xxt * 2 + 1) + xxt 515 - 28, 1 + yyt + 1 * (yyt * 3 + 1) + yyt - 20); 516 end; 517 2: 518 begin 519 PaintTerrIcon(12 + x0[i], -7 + i * 24, 520 1 + 7 * (xxt * 2 + 1), 1 + yyt + 4 * (yyt * 3 + 1)); 521 if 2 * yyt < 40 then 522 Sprite(OffScreen, HGrTerrain, 12 + x0[i], -7 + 4 + i * 24, 523 56, 32, 1 + 4 * (xxt * 2 + 1) + xxt - 28, 524 1 + yyt + 12 * (yyt * 3 + 1) + yyt - 16) 525 else 526 Sprite(OffScreen, HGrTerrain, 12 + x0[i], -7 + 4 + i * 24, 527 56, 32, 1 + 4 * (xxt * 2 + 1) + xxt - 28, 528 1 + yyt + 12 * (yyt * 3 + 1) + yyt - 16) 529 end; 530 end; 531 x0[i] := 64 + 8 + 8 + x0[i]; 532 end; 533 pkDomain: 534 begin 535 Frame(OffScreen.Canvas, 8 - 1 + x0[i], 2 - 1 + i * 24, 536 8 + 36 + x0[i], 2 + 20 + i * 24, $000000, $000000); 537 Dump(OffScreen, HGrSystem, 8 + x0[i], 2 + i * 24, 36, 20, 538 75 + HelpLineInfo.Picpix * 37, 295); 539 x0[i] := x0[i] + (8 + 8 + 36); 540 end; 541 pkAdvIcon, pkAdvIcon_AsPreq: 542 begin 543 Frame(OffScreen.Canvas, 8 - 1 + x0[i], 2 - 1 + i * 24, 544 8 + xSizeSmall + x0[i], 2 + ySizeSmall + i * 24, 545 $000000, $000000); 546 if AdvIcon[HelpLineInfo.Picpix] < 84 then 547 BitBlt(OffScreen.Canvas.Handle, 8 + x0[i], 2 + i * 24, 548 xSizeSmall, ySizeSmall, SmallImp.Canvas.Handle, 549 (AdvIcon[HelpLineInfo.Picpix] + SystemIconLines * 7) mod 7 * 550 xSizeSmall, (AdvIcon[HelpLineInfo.Picpix] + SystemIconLines * 551 7) div 7 * ySizeSmall, SRCCOPY) 552 else 553 Dump(OffScreen, HGrSystem, 8 + x0[i], 2 + i * 24, 36, 20, 554 1 + (AdvIcon[HelpLineInfo.Picpix] - 84) mod 8 * 37, 555 295 + (AdvIcon[HelpLineInfo.Picpix] - 84) div 8 * 21); 556 j := AdvValue[HelpLineInfo.Picpix] div 1000; 557 BitBlt(Handle, x0[i] + 4, 4 + i * 24, 14, 14, 558 GrExt[HGrSystem].Mask.Canvas.Handle, 127 + j * 15, 85, SRCAND); 559 Sprite(OffScreen, HGrSystem, x0[i] + 3, 3 + i * 24, 14, 14, 560 127 + j * 15, 85); 561 x0[i] := x0[i] + (8 + 8 + 36); 562 end; 563 pkRightIcon: 564 begin 565 if Imp[HelpLineInfo.Picpix].Kind <> ikWonder then 566 ImpImage(OffScreen.Canvas, InnerWidth - (40 + xSizeBig), i * 24, 567 HelpLineInfo.Picpix, gDespotism) 568 else 569 WaterSign(InnerWidth - (40 + 2 * xSizeBig), i * 24 - 8, 570 HelpLineInfo.Picpix + 7); 571 x0[i] := x0[i] + 8; 572 end; 573 pkIllu: 574 WaterSign(8, i * 24 - 8, HelpLineInfo.Picpix); 575 pkBigFeature: 576 begin 577 cnt := 0; 578 for j := nDomains - 1 downto 0 do 579 if 1 shl j and Feature[HelpLineInfo.Picpix].Domains <> 0 then 580 begin 581 inc(cnt); 582 Dump(OffScreen, HGrSystem, InnerWidth - 38 - 38 * cnt, 583 i * 24 + 1, 36, 20, 75 + j * 37, 295); 584 Frame(OffScreen.Canvas, InnerWidth - 39 - 38 * cnt, i * 24, 585 InnerWidth - 2 - 38 * cnt, i * 24 + 21, $000000, $000000); 586 end; 587 DarkGradient(OffScreen.Canvas, InnerWidth - 38 - 38 * cnt, 588 i * 24 + 23, cnt * 38 - 2, 1); 589 ofs := InnerWidth - (39 + 7) - 19 * cnt; 590 with OffScreen.Canvas do 591 begin 592 Brush.color := $C0C0C0; 593 FrameRect(Rect(ofs, 1 + 23 + i * 24, ofs + 14, 594 15 + 23 + i * 24)); 595 Brush.Style := bsClear; 596 Sprite(OffScreen, HGrSystem, ofs + 2, 3 + 23 + i * 24, 10, 10, 597 66 + HelpLineInfo.Picpix mod 11 * 11, 598 137 + HelpLineInfo.Picpix div 11 * 11); 599 end; 600 x0[i] := x0[i] + 8; 601 end; 602 pkTer, pkBigTer: 603 begin 604 if HelpLineInfo.Format = pkBigTer then 605 y := i * 24 - 3 + yyt 606 else 607 y := i * 24 + 13; 608 if HelpLineInfo.Picpix >= 3 * 12 then 609 srcno := 2 * 9 + 6 610 else if HelpLineInfo.Picpix mod 12 = fJungle then 611 srcno := 18 * 9 612 else if HelpLineInfo.Picpix mod 12 < fJungle then 613 srcno := HelpLineInfo.Picpix mod 12 614 else 615 srcno := 27 + (HelpLineInfo.Picpix mod 12 - 9) * 18; 616 if HelpLineInfo.Format = pkTer then 617 begin 618 ofs := x0[i] + 8; 619 x0[i] := 2 * xxt + 8 + ofs; 620 end 621 else 622 begin 623 ofs := InnerWidth - (2 * xxt + 38); 624 x0[i] := x0[i] + 8; 625 end; 626 if srcno >= fJungle then 627 begin 628 Sprite(OffScreen, HGrTerrain, ofs + 4, y - yyt + 2, xxt * 2 - 8, 629 yyt * 2 - 4, 5 + 2 * (xxt * 2 + 1), 630 3 + yyt + 2 * (yyt * 3 + 1)); 631 Sprite(OffScreen, HGrTerrain, ofs, y - 2 * yyt, xxt * 2, 632 yyt * 3 - 2, 1 + srcno mod 9 * (xxt * 2 + 1), 633 1 + srcno div 9 * (yyt * 3 + 1)); 634 end 635 else 636 Sprite(OffScreen, HGrTerrain, ofs + 4, y - yyt + 2, xxt * 2 - 8, 637 yyt * 2 - 4, 5 + srcno mod 9 * (xxt * 2 + 1), 638 3 + yyt + srcno div 9 * (yyt * 3 + 1)); 639 if HelpLineInfo.Picpix >= 3 * 12 then { rare resource } 640 Sprite(OffScreen, HGrTerrain, ofs, y - 2 * yyt, xxt * 2, 641 yyt * 3, 1 + 8 * (xxt * 2 + 1), 642 1 + (HelpLineInfo.Picpix - 2 * 12) * (yyt * 3 + 1)) 643 else if HelpLineInfo.Picpix >= 12 then { special tile } 644 begin 645 if HelpLineInfo.Picpix mod 12 = fJungle then 646 srcno := 17 * 9 + 8 647 else if HelpLineInfo.Picpix mod 12 < fJungle then 648 srcno := HelpLineInfo.Picpix mod 12 649 else 650 srcno := 18 + 8 + (HelpLineInfo.Picpix mod 12 - 9) * 18; 651 srcno := srcno + HelpLineInfo.Picpix div 12 * 9; 652 Sprite(OffScreen, HGrTerrain, ofs, y - 2 * yyt, xxt * 2, 653 yyt * 3, 1 + srcno mod 9 * (xxt * 2 + 1), 654 1 + srcno div 9 * (yyt * 3 + 1)); 655 end; 656 end; 657 pkTerImp: 658 begin 659 ofs := 8; 660 if HelpLineInfo.Picpix = 5 then 661 begin // display mine on hills 662 Sprite(OffScreen, HGrTerrain, ofs + 4, i * 24 + 13 - yyt, 663 xxt * 2 - 8, yyt * 2 - 4, 5 + 2 * (xxt * 2 + 1), 664 3 + yyt + 2 * (yyt * 3 + 1)); 665 srcno := 45 666 end 667 else 668 srcno := fPrairie; // display on prairie 669 Sprite(OffScreen, HGrTerrain, ofs + 4, i * 24 + 13 - yyt, 670 xxt * 2 - 8, yyt * 2 - 4, 5 + srcno mod 9 * (xxt * 2 + 1), 671 3 + yyt + srcno div 9 * (yyt * 3 + 1)); 672 if HelpLineInfo.Picpix = 12 then { river } 673 Sprite(OffScreen, HGrTerrain, ofs, i * 24 + 11 - yyt, xxt * 2, 674 yyt * 2, 1 + 5 * (xxt * 2 + 1), 1 + yyt + 13 * (yyt * 3 + 1)) 675 else if HelpLineInfo.Picpix >= 3 then { improvement 2 } 676 begin 677 if HelpLineInfo.Picpix = 6 then 678 Sprite(OffScreen, HGrTerrain, ofs, i * 24 + 11 - 2 * yyt, 679 xxt * 2, yyt * 3, 1 + 7 * (xxt * 2 + 1), 680 1 + 12 * (yyt * 3 + 1)); 681 Sprite(OffScreen, HGrTerrain, ofs, i * 24 + 11 - 2 * yyt, 682 xxt * 2, yyt * 3, 1 + (HelpLineInfo.Picpix - 3) * 683 (xxt * 2 + 1), 1 + 12 * (yyt * 3 + 1)) 684 end 685 else { improvement 1 } 686 begin 687 Sprite(OffScreen, HGrTerrain, ofs, i * 24 + 11 - 2 * yyt, 688 xxt * 2, yyt * 3, 1 + 2 * (xxt * 2 + 1), 689 1 + (9 + HelpLineInfo.Picpix) * (yyt * 3 + 1)); 690 Sprite(OffScreen, HGrTerrain, ofs, i * 24 + 11 - 2 * yyt, 691 xxt * 2, yyt * 3, 1 + 5 * (xxt * 2 + 1), 692 1 + (9 + HelpLineInfo.Picpix) * (yyt * 3 + 1)) 693 end; 694 x0[i] := x0[i] + 8; 695 end; 696 pkModel: 697 begin 698 FrameImage(OffScreen.Canvas, BigImp, x0[i] + 12, i * 24 - 7, 699 56, 40, 0, 0); 700 Sprite(OffScreen, HGrStdUnits, x0[i] + 8, i * 24 - 11, 64, 44, 701 1 + HelpLineInfo.Picpix mod 10 * 65, 702 1 + HelpLineInfo.Picpix div 10 * 49); 703 x0[i] := 64 + 8 + 8 + x0[i]; 704 end; 705 pkFeature: 706 begin 707 DarkGradient(OffScreen.Canvas, x0[i] + 8 - 1, 708 7 + i * 24 - 3, 16, 1); 709 Frame(OffScreen.Canvas, x0[i] + 8, 7 + i * 24 - 2, x0[i] + 8 + 13, 710 7 + i * 24 - 2 + 13, $C0C0C0, $C0C0C0); 711 Sprite(OffScreen, HGrSystem, x0[i] + 8 + 2, 7 + i * 24, 10, 10, 712 66 + HelpLineInfo.Picpix mod 11 * 11, 713 137 + HelpLineInfo.Picpix div 11 * 11); 714 x0[i] := x0[i] + 8 + 8 + 2 + 13; 715 end; 716 pkExp: 717 begin 718 Frame(OffScreen.Canvas, 20 - 1, 8 - 4 + i * 24, 20 + 12, 719 8 + 11 + i * 24, $000000, $000000); 720 Dump(OffScreen, HGrSystem, 20, 8 - 3 + i * 24, 12, 14, 721 121 + HelpLineInfo.Picpix * 13, 28); 722 x0[i] := 20 + 8 + 11; 723 end; 724 pkAITStat: 725 begin 726 Sprite(OffScreen, HGrSystem, 20, 6 + i * 24, 14, 14, 727 1 + HelpLineInfo.Picpix * 15, 316); 728 x0[i] := 20 + 8 + 11; 729 end; 730 pkGov: 731 begin 732 Frame(OffScreen.Canvas, 8 - 1 + x0[i], 2 - 1 + i * 24, 733 8 + xSizeSmall + x0[i], 2 + 20 + i * 24, $000000, $000000); 734 BitBlt(OffScreen.Canvas.Handle, 8 + x0[i], 2 + i * 24, xSizeSmall, 735 ySizeSmall, SmallImp.Canvas.Handle, (HelpLineInfo.Picpix - 1) * 736 xSizeSmall, ySizeSmall, SRCCOPY); 737 x0[i] := x0[i] + (8 + 8 + 36); 738 end; 739 pkDot: 740 begin 741 Sprite(OffScreen, HGrSystem, x0[i] + 18, 9 + i * 24, 8, 742 8, 81, 16); 743 x0[i] := 20 + 8 + 4; 744 end; 745 pkNormal_Dot: 746 x0[i] := 20 + 8 + 4; 747 pkNormal_64: 748 x0[i] := 64 + 8 + 8; 749 else 750 x0[i] := x0[i] + 8 751 end; 752 line(OffScreen.Canvas, i, false) 753 end 754 end; 755 MarkUsedOffscreen(InnerWidth, InnerHeight + 13 + 48); 756 end; { OffscreenPaint } 757 758 procedure THelpDlg.Prepare(sbPos: integer = 0); 759 var 760 i, j, special, Domain, Headline, TerrType, TerrSubType: integer; 761 s: string; 762 ps: pchar; 763 List: THyperText; 764 CheckSeeAlso: boolean; 765 766 procedure AddAdv(i: integer); 767 begin 768 MainText.AddLine(Phrases.Lookup('ADVANCES', i), pkAdvIcon, i, 769 hkAdv + hkCrossLink, i); 770 end; 771 772 procedure AddPreqAdv(i: integer); 773 begin 774 MainText.AddLine(Phrases.Lookup('ADVANCES', i), pkAdvIcon_AsPreq, i, 775 hkAdv + hkCrossLink, i); 776 end; 777 778 procedure AddImp(i: integer); 779 begin 780 MainText.AddLine(Phrases.Lookup('IMPROVEMENTS', i), pkSmallIcon, i, 781 hkImp + hkCrossLink, i); 782 end; 783 784 procedure AddPreqImp(i: integer); 785 begin 786 MainText.AddLine(Phrases.Lookup('IMPROVEMENTS', i), pkSmallIcon_AsPreq, i, 787 hkImp + hkCrossLink, i); 788 end; 789 790 procedure AddTer(i: integer); 791 begin 792 if MainText.Count > 1 then 793 begin 794 MainText.LF; 795 end; 796 MainText.AddLine(Phrases.Lookup('TERRAIN', i), pkTer, i, hkTer, i); 797 end; 798 799 procedure AddFeature(i: integer); 800 begin 801 MainText.AddLine(Phrases.Lookup('FEATURES', i), pkFeature, i, 802 hkFeature + hkCrossLink, i); 803 end; 804 805 procedure AddModel(i: integer); 806 var 807 pix: integer; 808 Name: string; 809 begin 810 if MainText.Count > 1 then 811 MainText.LF; 812 FindStdModelPicture(SpecialModelPictureCode[i], pix, Name); 813 MainText.AddLine(Name, pkModel, pix, hkModel + hkCrossLink, i) 814 end; 815 816 procedure AddStandardBlock(Item: string); 817 var 818 i: integer; 819 begin 820 with MainText do 821 begin 822 if Item = 'LOGO' then 823 begin 824 AddLine('', pkLogo); 825 LF; 826 end 827 else if Item = 'TECHFORMULA' then 828 begin 829 i := Difficulty; 830 if i = 0 then 831 i := 2; 832 AddLine(Format(HelpText.Lookup('TECHFORMULA'), [TechFormula_M[i], 833 TechFormula_D[i]])) 834 end 835 else if Item = 'EXPERIENCE' then 836 for i := 0 to nExp - 1 do 837 AddLine(Phrases.Lookup('EXPERIENCE', i), pkExp, i) 838 else if Item = 'MODERN' then 839 for i := 1 to 3 do 840 begin 841 LF; 842 AddLine(Phrases.Lookup('TERRAIN', 3 * 12 + i), pkTer, 3 * 12 + i); 843 end 844 else if Item = 'SAVED' then 845 AddLine(DataDir + 'Saved', pkNormal) 846 else if Item = 'AITSTAT' then 847 for i := 0 to 3 do 848 AddLine(Phrases2.Lookup('AITSTAT', i), pkAITStat, i) 849 end 850 end; 851 852 procedure DecodeItem(s: string; var Category, Index: integer); 853 var 854 i: integer; 855 begin 856 if (length(s) > 0) and (s[1] = ':') then 857 begin 858 Category := hkMisc; 859 Index := 0; 860 for i := 3 to length(s) do 861 Index := Index * 10 + ord(s[i]) - 48; 862 case s[2] of 863 'A': 864 Category := hkAdv; 865 'B': 866 Category := hkImp; 867 'T': 868 Category := hkTer; 869 'F': 870 Category := hkFeature; 871 'E': 872 Category := hkInternet; 873 'S': 874 Category := hkModel; 875 'C': 876 Index := miscCredits; 877 'J': 878 Index := miscJobList; 879 'G': 880 Index := miscGovList; 881 end; 882 if (Category <> hkMisc) and (Index = 0) then 883 Index := 200; 884 end 885 else 886 begin 887 Category := hkText; 888 Index := HelpText.Gethandle(copy(s, 1, 255)); 889 end; 890 end; 891 892 procedure AddText(s: string); 893 var 894 i, p, l, ofs, CurrentFormat, FollowFormat, Picpix, LinkCategory, LinkIndex, 895 RightMargin: integer; 896 Name: string; 897 begin 898 RightMargin := InnerWidth - 16 - GetSystemMetrics(SM_CXVSCROLL); 899 FollowFormat := pkNormal; 900 while s <> '' do 901 begin 902 Picpix := 0; 903 LinkCategory := 0; 904 LinkIndex := 0; 905 if s[1] = '$' then 906 begin // window caption 907 p := 1; 908 repeat 909 inc(p) 910 until (p > length(s)) or (s[p] = '\'); 911 Caption := copy(s, 2, p - 2); 912 Delete(s, 1, p); 913 end 914 else if s[1] = '&' then 915 begin // standard block 916 p := 1; 917 repeat 918 inc(p) 919 until (p > length(s)) or (s[p] = '\'); 920 AddStandardBlock(copy(s, 2, p - 2)); 921 Delete(s, 1, p); 922 end 923 else if s[1] = '@' then 924 begin // image 925 if (length(s) >= 2) and (s[2] = '@') then 926 begin // generate from icon 927 Picpix := 0; 928 p := 3; 929 while (p <= length(s)) and (s[p] <> '\') do 930 begin 931 Picpix := Picpix * 10 + ord(s[p]) - 48; 932 inc(p) 933 end; 934 if (Picpix < 0) or (Picpix >= nImp) then 935 Picpix := 0; 936 MainText.AddLine('', pkIllu, Picpix); 937 MainText.LF; 938 MainText.LF; 939 end 940 else 941 begin // external image 942 p := 1; 943 repeat 944 inc(p) 945 until (p > length(s)) or (s[p] = '\'); 946 if LoadLocalizedGraphicFile(ExtPic, 'Help\' + copy(s, 2, p - 2)) then 947 begin 948 MainText.AddLine('', pkExternal); 949 for i := 0 to (ExtPic.Height - 12) div 24 do 950 MainText.LF; 951 end; 952 end; 953 Delete(s, 1, p); 954 end 955 else 956 begin 957 case s[1] of 958 ':', ';': 959 begin // link 960 p := 1; 961 repeat 962 inc(p) 963 until (p > length(s)) or (s[p] = '\') or (s[p] = ' '); 964 DecodeItem(copy(s, 2, p - 2), LinkCategory, LinkIndex); 965 CurrentFormat := 0; 966 if (LinkCategory <> hkText) and (LinkIndex < 200) then 967 // show icon 968 case LinkCategory of 969 hkAdv: 970 begin 971 CurrentFormat := pkAdvIcon; 972 Picpix := LinkIndex 973 end; 974 hkImp: 975 begin 976 CurrentFormat := pkSmallIcon; 977 Picpix := LinkIndex 978 end; 979 hkTer: 980 begin 981 CurrentFormat := pkTer; 982 Picpix := LinkIndex 983 end; 984 hkFeature: 985 begin 986 CurrentFormat := pkFeature; 987 Picpix := LinkIndex 988 end; 989 hkModel: 990 begin 991 CurrentFormat := pkModel; 992 FindStdModelPicture(SpecialModelPictureCode[LinkIndex], 993 Picpix, Name); 994 end; 995 end; 996 if s[1] = ':' then 997 LinkCategory := LinkCategory + hkCrossLink; 998 if (p > length(s)) or (s[p] = ' ') then 999 Delete(s, 1, p) 1000 else 1001 Delete(s, 1, p - 1) 1002 end; 1003 '!': // highlited 1004 if (length(s) >= 2) and (s[2] = '!') then 1005 begin 1006 if MainText.Count > 1 then 1007 MainText.LF; 1008 FollowFormat := pkCaption; 1009 CurrentFormat := pkCaption; 1010 Delete(s, 1, 2); 1011 end 1012 else 1013 begin 1014 FollowFormat := pkSection; 1015 CurrentFormat := pkSection; 1016 Delete(s, 1, 1); 1017 end; 1018 '-': 1019 begin // list 1020 FollowFormat := pkNormal_Dot; 1021 CurrentFormat := pkDot; 1022 Delete(s, 1, 1); 1023 end; 1024 else 1025 CurrentFormat := FollowFormat; 1026 end; 1027 if FollowFormat = pkNormal_Dot then 1028 ofs := 20 + 4 + 8 1029 else 1030 ofs := 8; 1031 p := 0; 1032 repeat 1033 repeat 1034 inc(p) 1035 until (p > length(s)) or (s[p] = ' ') or (s[p] = '\'); 1036 if (BiColorTextWidth(OffScreen.Canvas, copy(s, 1, p - 1)) <= 1037 RightMargin - ofs) then 1038 l := p - 1 1039 else 1040 Break; 1041 until (p >= length(s)) or (s[l + 1] = '\'); 1042 MainText.AddLine(copy(s, 1, l), CurrentFormat, Picpix, LinkCategory, 1043 LinkIndex); 1044 if (l < length(s)) and (s[l + 1] = '\') then 1045 FollowFormat := pkNormal; 1046 Delete(s, 1, l + 1); 345 1047 end 346 1048 end 347 1049 end; 348 end;349 350 procedure THelpDlg.OffscreenPaint;351 352 procedure PaintTerrIcon(x,y,xSrc,ySrc: integer);353 begin354 Frame(offscreen.canvas,x-1,y-1,x+xSizeBig,y+ySizeBig,$000000,$000000);355 if 2*yyt<40 then356 begin357 Sprite(Offscreen, HGrTerrain, x, y, 56, 2*yyt, xSrc, ySrc);358 Sprite(Offscreen, HGrTerrain, x, y+2*yyt, 56, 40-2*yyt, xSrc, ySrc);359 end360 else Sprite(Offscreen, HGrTerrain, x, y, 56, 40, xSrc, ySrc);361 Sprite(Offscreen, HGrTerrain, x, y, xxt, yyt, xSrc+xxt, ySrc+yyt);362 Sprite(Offscreen, HGrTerrain, x, y+yyt, xxt, 40-yyt, xSrc+xxt, ySrc);363 Sprite(Offscreen, HGrTerrain, x+xxt, y, 56-xxt, yyt, xSrc, ySrc+yyt);364 Sprite(Offscreen, HGrTerrain, x+xxt, y+yyt, 56-xxt, 40-yyt, xSrc, ySrc);365 end;366 367 var368 i,j,yl,srcno,ofs,cnt,y: integer;369 s: string;370 HelpLineInfo: THelpLineInfo;371 begin372 inherited;373 CaptionColor:=Colors.Canvas.Pixels[clkMisc,cliPaperCaption];374 FillSeamless(offscreen.Canvas,0,0,InnerWidth,InnerHeight,0,sb.si.npos*24,375 Paper);376 with offscreen.Canvas do377 begin378 Font.Assign(UniFont[ftNormal]);379 for i:=-sb.si.npos to InnerHeight div 24 do380 if sb.si.npos+i<MainText.Count then381 begin382 HelpLineInfo:=THelpLineInfo(MainText.Objects[sb.si.npos+i]);383 if HelpLineInfo.Format=pkExternal then384 begin385 yl:=ExtPic.Height;386 if 4+i*24+yl>InnerHeight then yl:=InnerHeight-(4+i*24);387 BitBlt(Handle,8,4+i*24,ExtPic.Width,yl,388 ExtPic.Canvas.Handle,0,0,SRCCOPY);389 end390 end;391 for i:=-2 to InnerHeight div 24 do392 if (sb.si.npos+i>=0) and (sb.si.npos+i<MainText.Count) then393 begin394 HelpLineInfo:=THelpLineInfo(MainText.Objects[sb.si.npos+i]);395 if HelpLineInfo.Link<>0 then396 begin397 if (Kind=hkMisc) and (no=miscSearchResult) then398 Sprite(offscreen,HGrSystem,18,9+i*24,8,8,90,16)399 else if HelpLineInfo.Format in [pkSmallIcon_AsPreq,pkAdvIcon_AsPreq] then400 Sprite(offscreen,HGrSystem,12,i*24+5,14,14,65,20)401 else if HelpLineInfo.Link and (hkCrossLink shl 8)<>0 then402 Sprite(offscreen,HGrSystem,12,i*24+5,14,14,80,1)403 else if not ((Kind=hkMisc) and (no=miscMain)) then404 Sprite(offscreen,HGrSystem,10,i*24+6,14,14,65,1);405 x0[i]:=24;406 end407 else x0[i]:=0;408 case HelpLineInfo.Format of409 pkLogo:410 begin411 Server(sGetVersion,0,0,j);412 s:=Format('%d.%d.%d',[j shr 16 and $FF, j shr 8 and $FF, j and $FF]);413 PaintLogo(offscreen.canvas,(InnerWidth-122) div 2,i*24+1,414 GrExt[HGrSystem].Data.Canvas.Pixels[95,1],$000000);415 Font.Assign(UniFont[ftSmall]);416 BiColorTextout(offscreen.Canvas,$000000,$7F007F,417 (InnerWidth-TextWidth(s)) div 2,i*24+26,s);418 Font.Assign(UniFont[ftNormal]);419 end;420 pkSmallIcon,pkSmallIcon_AsPreq:421 begin422 Frame(offscreen.Canvas,8-1+x0[i],2-1+i*24,8+xSizeSmall+x0[i],2+20+i*24,423 $000000,$000000);424 if HelpLineInfo.Picpix=imPalace then425 BitBlt(offscreen.Canvas.Handle,8+x0[i],2+i*24,xSizeSmall,ySizeSmall,SmallImp.Canvas.Handle,426 0*xSizeSmall,1*ySizeSmall,SRCCOPY)427 else BitBlt(offscreen.Canvas.Handle,8+x0[i],2+i*24,xSizeSmall,ySizeSmall,SmallImp.Canvas.Handle,428 HelpLineInfo.Picpix mod 7*xSizeSmall,(HelpLineInfo.Picpix+SystemIconLines*7) div 7*ySizeSmall,SRCCOPY);429 x0[i]:=x0[i]+(8+8+36);430 end;431 pkBigIcon:432 begin433 FrameImage(offscreen.canvas,BigImp,x0[i]+12,i*24-7,56,40,434 HelpLineInfo.Picpix mod 7*xSizeBig,435 HelpLineInfo.Picpix div 7*ySizeBig);436 x0[i]:=64+8+8+x0[i];437 end;438 pkSpecialIcon:439 begin440 case HelpLineInfo.Picpix of441 0:442 FrameImage(Offscreen.Canvas, GrExt[HGrSystem2].Data, 12+x0[i],-7+i*24, 56, 40, 137, 127);443 1:444 begin445 PaintTerrIcon(12+x0[i],-7+i*24, 1+3*(xxt*2+1), 1+yyt);446 if 2*yyt<40 then447 Sprite(Offscreen, HGrTerrain, 12+x0[i],-7+4+i*24, 56, 2*yyt, 1+3*(xxt*2+1)+xxt-28, 1+yyt+1*(yyt*3+1))448 else Sprite(Offscreen, HGrTerrain, 12+x0[i],-7+4+i*24-4, 56, 40, 1+3*(xxt*2+1)+xxt-28, 1+yyt+1*(yyt*3+1)+yyt-20);449 end;450 2:451 begin452 PaintTerrIcon(12+x0[i],-7+i*24, 1+7*(xxt*2+1), 1+yyt+4*(yyt*3+1));453 if 2*yyt<40 then454 Sprite(Offscreen, HGrTerrain, 12+x0[i],-7+4+i*24, 56, 32, 1+4*(xxt*2+1)+xxt-28, 1+yyt+12*(yyt*3+1)+yyt-16)455 else Sprite(Offscreen, HGrTerrain, 12+x0[i],-7+4+i*24, 56, 32, 1+4*(xxt*2+1)+xxt-28, 1+yyt+12*(yyt*3+1)+yyt-16)456 end;457 end;458 x0[i]:=64+8+8+x0[i];459 end;460 pkDomain:461 begin462 Frame(offscreen.Canvas,8-1+x0[i],2-1+i*24,8+36+x0[i],2+20+i*24,463 $000000,$000000);464 Dump(offscreen,HGrSystem,8+x0[i],2+i*24,36,20,465 75+HelpLineInfo.Picpix*37,295);466 x0[i]:=x0[i]+(8+8+36);467 end;468 pkAdvIcon,pkAdvIcon_AsPreq:469 begin470 Frame(offscreen.Canvas,8-1+x0[i],2-1+i*24,8+xSizeSmall+x0[i],2+ySizeSmall+i*24,471 $000000,$000000);472 if AdvIcon[HelpLineInfo.Picpix]<84 then473 BitBlt(offscreen.Canvas.Handle,8+x0[i],2+i*24,xSizeSmall,ySizeSmall,474 SmallImp.Canvas.Handle, (AdvIcon[HelpLineInfo.Picpix]+SystemIconLines*7) mod 7*xSizeSmall,475 (AdvIcon[HelpLineInfo.Picpix]+SystemIconLines*7) div 7*ySizeSmall,SRCCOPY)476 else477 Dump(offscreen,HGrSystem,8+x0[i],2+i*24,36,20,478 1+(AdvIcon[HelpLineInfo.Picpix]-84) mod 8*37,479 295+(AdvIcon[HelpLineInfo.Picpix]-84) div 8*21);480 j:=AdvValue[HelpLineInfo.Picpix] div 1000;481 BitBlt(Handle,x0[i]+4,4+i*24,14,14,482 GrExt[HGrSystem].Mask.Canvas.Handle,127+j*15,85,SRCAND);483 Sprite(offscreen,HGrSystem,x0[i]+3,3+i*24,14,14,127+j*15,85);484 x0[i]:=x0[i]+(8+8+36);485 end;486 pkRightIcon:487 begin488 if Imp[HelpLineInfo.Picpix].Kind<>ikWonder then489 ImpImage(Offscreen.Canvas,InnerWidth-(40+xSizeBig),i*24,490 HelpLineInfo.Picpix, gDespotism)491 else WaterSign(InnerWidth-(40+2*xSizeBig),i*24-8,HelpLineInfo.Picpix+7);492 x0[i]:=x0[i]+8;493 end;494 pkIllu:495 WaterSign(8,i*24-8,HelpLineInfo.Picpix);496 pkBigFeature:497 begin498 cnt:=0;499 for j:=nDomains-1 downto 0 do500 if 1 shl j and Feature[HelpLineInfo.Picpix].Domains<>0 then501 begin502 inc(cnt);503 Dump(offscreen,HGrSystem,InnerWidth-38-38*cnt,i*24+1,36,20,75+j*37,295);504 Frame(offscreen.canvas,InnerWidth-39-38*cnt,i*24,505 InnerWidth-2-38*cnt,i*24+21,506 $000000,$000000);507 end;508 DarkGradient(offscreen.Canvas,InnerWidth-38-38*cnt,i*24+23,cnt*38-2,1);509 ofs:=InnerWidth-(39+7)-19*cnt;510 with offscreen.Canvas do511 begin512 Brush.Color:=$C0C0C0;513 FrameRect(Rect(ofs,1+23+i*24,ofs+14,15+23+i*24));514 Brush.Style:=bsClear;515 Sprite(offscreen,HGrSystem,ofs+2,3+23+i*24,10,10,516 66+HelpLineInfo.Picpix mod 11 *11,517 137+HelpLineInfo.Picpix div 11 *11);518 end;519 x0[i]:=x0[i]+8;520 end;521 pkTer,pkBigTer:522 begin523 if HelpLineInfo.Format=pkBigTer then524 y:=i*24-3+yyt525 else y:=i*24+13;526 if HelpLineInfo.Picpix>=3*12 then srcno:=2*9+6527 else if HelpLineInfo.Picpix mod 12=fJungle then srcno:=18*9528 else if HelpLineInfo.Picpix mod 12<fJungle then529 srcno:=HelpLineInfo.Picpix mod 12530 else srcno:=27+(HelpLineInfo.Picpix mod 12-9)*18;531 if HelpLineInfo.Format=pkTer then532 begin ofs:=x0[i]+8; x0[i]:=2*xxt+8+ofs; end533 else begin ofs:=InnerWidth-(2*xxt+38); x0[i]:=x0[i]+8; end;534 if srcno>=fJungle then535 begin536 Sprite(offscreen,HGrTerrain,ofs+4,y-yyt+2,xxt*2-8,yyt*2-4,537 5+2*(xxt*2+1),3+yyt+2*(yyt*3+1));538 Sprite(offscreen,HGrTerrain,ofs,y-2*yyt,xxt*2,yyt*3-2,539 1+srcno mod 9 *(xxt*2+1),1+srcno div 9 *(yyt*3+1));540 end541 else Sprite(offscreen,HGrTerrain,ofs+4,y-yyt+2,xxt*2-8,yyt*2-4,542 5+srcno mod 9 *(xxt*2+1),3+yyt+srcno div 9 *(yyt*3+1));543 if HelpLineInfo.Picpix>=3*12 then {rare resource}544 Sprite(offscreen,HGrTerrain,ofs,y-2*yyt,xxt*2,yyt*3,545 1+8*(xxt*2+1), 1+(HelpLineInfo.Picpix-2*12)*(yyt*3+1))546 else if HelpLineInfo.Picpix>=12 then {special tile}547 begin548 if HelpLineInfo.Picpix mod 12=fJungle then srcno:=17*9+8549 else if HelpLineInfo.Picpix mod 12<fJungle then550 srcno:=HelpLineInfo.Picpix mod 12551 else srcno:=18+8+(HelpLineInfo.Picpix mod 12-9)*18;552 srcno:=srcno+HelpLineInfo.Picpix div 12*9;553 Sprite(offscreen,HGrTerrain,ofs,y-2*yyt,xxt*2,yyt*3,554 1+srcno mod 9 *(xxt*2+1),1+srcno div 9 *(yyt*3+1));555 end;556 end;557 pkTerImp:558 begin559 ofs:=8;560 if HelpLineInfo.Picpix=5 then561 begin // display mine on hills562 Sprite(offscreen,HGrTerrain,ofs+4,i*24+13-yyt,xxt*2-8,yyt*2-4,563 5+2*(xxt*2+1),3+yyt+2*(yyt*3+1));564 srcno:=45565 end566 else srcno:=fPrairie; // display on prairie567 Sprite(offscreen,HGrTerrain,ofs+4,i*24+13-yyt,xxt*2-8,yyt*2-4,568 5+srcno mod 9 *(xxt*2+1),3+yyt+srcno div 9 *(yyt*3+1));569 if HelpLineInfo.Picpix=12 then {river}570 Sprite(offscreen,HGrTerrain,ofs,i*24+11-yyt,xxt*2,yyt*2,1+5*(xxt*2+1),571 1+yyt+13*(yyt*3+1))572 else if HelpLineInfo.Picpix>=3 then {improvement 2}573 begin574 if HelpLineInfo.Picpix=6 then575 Sprite(offscreen,HGrTerrain,ofs,i*24+11-2*yyt,xxt*2,yyt*3,576 1+7 *(xxt*2+1),1+12 *(yyt*3+1));577 Sprite(offscreen,HGrTerrain,ofs,i*24+11-2*yyt,xxt*2,yyt*3,578 1+(HelpLineInfo.Picpix-3)*(xxt*2+1), 1+12*(yyt*3+1))579 end580 else {improvement 1}581 begin582 Sprite(offscreen,HGrTerrain,ofs,i*24+11-2*yyt,xxt*2,yyt*3,583 1+2*(xxt*2+1),1+(9+HelpLineInfo.Picpix)*(yyt*3+1));584 Sprite(offscreen,HGrTerrain,ofs,i*24+11-2*yyt,xxt*2,yyt*3,585 1+5*(xxt*2+1),1+(9+HelpLineInfo.Picpix)*(yyt*3+1))586 end;587 x0[i]:=x0[i]+8;588 end;589 pkModel:590 begin591 FrameImage(offscreen.canvas,BigImp,x0[i]+12,i*24-7,56,40,0,0);592 Sprite(offscreen,HGrStdUnits,x0[i]+8,i*24-11,64,44,593 1+HelpLineInfo.Picpix mod 10 *65,1+HelpLineInfo.Picpix div 10 *49);594 x0[i]:=64+8+8+x0[i];595 end;596 pkFeature:597 begin598 DarkGradient(offscreen.Canvas,x0[i]+8-1,7+i*24-3,16,1);599 Frame(offscreen.canvas,x0[i]+8,7+i*24-2,x0[i]+8+13,7+i*24-2+13,600 $C0C0C0,$C0C0C0);601 Sprite(offscreen,HGrSystem,x0[i]+8+2,7+i*24,10,10,602 66+HelpLineInfo.Picpix mod 11*11,137+HelpLineInfo.Picpix div 11*11);603 x0[i]:=x0[i]+8+8+2+13;604 end;605 pkExp:606 begin607 Frame(offscreen.Canvas,20-1,8-4+i*24,20+12,8+11+i*24,$000000,$000000);608 Dump(offscreen,HGrSystem,20,8-3+i*24,12,14,121+HelpLineInfo.Picpix*13,28);609 x0[i]:=20+8+11;610 end;611 pkAITStat:612 begin613 Sprite(offscreen,HGrSystem,20,6+i*24,14,14,1+HelpLineInfo.Picpix*15,316);614 x0[i]:=20+8+11;615 end;616 pkGov:617 begin618 Frame(offscreen.Canvas,8-1+x0[i],2-1+i*24,8+xSizeSmall+x0[i],2+20+i*24,619 $000000,$000000);620 BitBlt(offscreen.Canvas.Handle,8+x0[i],2+i*24,xSizeSmall,ySizeSmall,SmallImp.Canvas.Handle,621 (HelpLineInfo.Picpix-1)*xSizeSmall,ySizeSmall,SRCCOPY);622 x0[i]:=x0[i]+(8+8+36);623 end;624 pkDot:625 begin626 Sprite(offscreen,HGrSystem,x0[i]+18,9+i*24,8,8,81,16);627 x0[i]:=20+8+4;628 end;629 pkNormal_Dot:630 x0[i]:=20+8+4;631 pkNormal_64:632 x0[i]:=64+8+8;633 else x0[i]:=x0[i]+8634 end;635 line(offscreen.Canvas,i,false)636 end637 end;638 MarkUsedOffscreen(InnerWidth,InnerHeight+13+48);639 end; {OffscreenPaint}640 641 procedure THelpDlg.Prepare(sbPos: integer = 0);642 var643 i,j,special,Domain,Headline,TerrType,TerrSubType: integer;644 s: string;645 ps: pchar;646 List: THyperText;647 CheckSeeAlso: boolean;648 649 procedure AddAdv(i: integer);650 begin651 MainText.AddLine(Phrases.Lookup('ADVANCES',i),pkAdvIcon,i,hkAdv+hkCrossLink,i);652 end;653 654 procedure AddPreqAdv(i: integer);655 begin656 MainText.AddLine(Phrases.Lookup('ADVANCES',i),pkAdvIcon_AsPreq,i,hkAdv+hkCrossLink,i);657 end;658 659 procedure AddImp(i: integer);660 begin661 MainText.AddLine(Phrases.Lookup('IMPROVEMENTS',i),pkSmallIcon,i,hkImp+hkCrossLink,i);662 end;663 664 procedure AddPreqImp(i: integer);665 begin666 MainText.AddLine(Phrases.Lookup('IMPROVEMENTS',i),pkSmallIcon_AsPreq,i,hkImp+hkCrossLink,i);667 end;668 669 procedure AddTer(i: integer);670 begin671 if MainText.Count>1 then begin MainText.LF; end;672 MainText.AddLine(Phrases.Lookup('TERRAIN',i),pkTer,i,hkTer,i);673 end;674 675 procedure AddFeature(i: integer);676 begin677 MainText.AddLine(Phrases.Lookup('FEATURES',i),pkFeature,i,hkFeature+hkCrossLink,i);678 end;679 680 procedure AddModel(i: integer);681 var682 pix: integer;683 Name: string;684 begin685 if MainText.Count>1 then MainText.LF;686 FindStdModelPicture(SpecialModelPictureCode[i],pix,Name);687 MainText.AddLine(Name,pkModel,pix,hkModel+hkCrossLink,i)688 end;689 690 procedure AddStandardBlock(Item: string);691 var692 i: integer;693 begin694 with MainText do695 begin696 if Item='LOGO' then697 begin AddLine('',pkLogo); LF; end698 else if Item='TECHFORMULA' then699 begin700 i:=Difficulty;701 if i=0 then i:=2;702 AddLine(Format(HelpText.Lookup('TECHFORMULA'),[TechFormula_M[i],TechFormula_D[i]]))703 end704 else if Item='EXPERIENCE' then705 for i:=0 to nExp-1 do AddLine(Phrases.Lookup('EXPERIENCE',i),pkExp,i)706 else if Item='MODERN' then707 for i:=1 to 3 do708 begin709 LF;710 AddLine(Phrases.Lookup('TERRAIN',3*12+i),pkTer,3*12+i);711 end712 else if Item='SAVED' then713 AddLine(DataDir+'Saved',pkNormal)714 else if Item='AITSTAT' then715 for i:=0 to 3 do AddLine(Phrases2.Lookup('AITSTAT',i),pkAITStat,i)716 end717 end;718 719 procedure DecodeItem(s: string; var Category, Index: integer);720 var721 i: integer;722 begin723 if (length(s)>0) and (s[1]=':') then724 begin725 Category:=hkMisc;726 Index:=0;727 for i:=3 to Length(s) do Index:=Index*10+ord(s[i])-48;728 case s[2] of729 'A': Category:=hkAdv;730 'B': Category:=hkImp;731 'T': Category:=hkTer;732 'F': Category:=hkFeature;733 'E': Category:=hkInternet;734 'S': Category:=hkModel;735 'C': Index:=miscCredits;736 'J': Index:=miscJobList;737 'G': Index:=miscGovList;738 end;739 if (Category<>hkMisc) and (Index=0) then740 Index:=200;741 end742 else743 begin744 Category:=hkText;745 Index:=HelpText.GetHandle(copy(s,1,255));746 end;747 end;748 749 procedure AddText(s: string);750 var751 i,p,l,ofs,CurrentFormat,FollowFormat,Picpix,LinkCategory,LinkIndex,RightMargin: integer;752 Name: string;753 begin754 RightMargin:=InnerWidth-16-GetSystemMetrics(SM_CXVSCROLL);755 FollowFormat:=pkNormal;756 while s<>'' do757 begin758 Picpix:=0;759 LinkCategory:=0;760 LinkIndex:=0;761 if s[1]='$' then762 begin // window caption763 p:=1;764 repeat inc(p) until (p>Length(s)) or (s[p]='\');765 Caption:=Copy(s,2,p-2);766 Delete(s,1,p);767 end768 else if s[1]='&' then769 begin // standard block770 p:=1;771 repeat inc(p) until (p>Length(s)) or (s[p]='\');772 AddStandardBlock(Copy(s,2,p-2));773 Delete(s,1,p);774 end775 else if s[1]='@' then776 begin // image777 if (Length(s)>=2) and (s[2]='@') then778 begin // generate from icon779 Picpix:=0;780 p:=3;781 while (p<=Length(s)) and (s[p]<>'\') do782 begin Picpix:=Picpix*10+ord(s[p])-48; inc(p) end;783 if (Picpix<0) or (Picpix>=nImp) then Picpix:=0;784 MainText.AddLine('',pkIllu,Picpix);785 MainText.LF;786 MainText.LF;787 end788 else789 begin // external image790 p:=1;791 repeat inc(p) until (p>Length(s)) or (s[p]='\');792 if LoadLocalizedGraphicFile(ExtPic, 'Help\'+Copy(s,2,p-2)) then793 begin794 MainText.AddLine('',pkExternal);795 for i:=0 to (ExtPic.Height-12) div 24 do MainText.LF;796 end;797 end;798 Delete(s,1,p);799 end800 else801 begin802 case s[1] of803 ':',';':804 begin // link805 p:=1;806 repeat inc(p) until (p>Length(s)) or (s[p]='\') or (s[p]=' ');807 DecodeItem(copy(s,2,p-2), LinkCategory, LinkIndex);808 CurrentFormat:=0;809 if (LinkCategory<>hkText) and (LinkIndex<200) then // show icon810 case LinkCategory of811 hkAdv:812 begin CurrentFormat:=pkAdvIcon; Picpix:=LinkIndex end;813 hkImp:814 begin CurrentFormat:=pkSmallIcon; Picpix:=LinkIndex end;815 hkTer:816 begin CurrentFormat:=pkTer; Picpix:=LinkIndex end;817 hkFeature:818 begin CurrentFormat:=pkFeature; Picpix:=LinkIndex end;819 hkModel:820 begin821 CurrentFormat:=pkModel;822 FindStdModelPicture(SpecialModelPictureCode[LinkIndex],Picpix,Name);823 end;824 end;825 if s[1]=':' then LinkCategory:=LinkCategory+hkCrossLink;826 if (p>Length(s)) or (s[p]=' ') then Delete(s,1,p)827 else Delete(s,1,p-1)828 end;829 '!': // highlited830 if (length(s)>=2) and (s[2]='!') then831 begin832 if MainText.Count>1 then MainText.LF;833 FollowFormat:=pkCaption;834 CurrentFormat:=pkCaption;835 Delete(s,1,2);836 end837 else838 begin839 FollowFormat:=pkSection;840 CurrentFormat:=pkSection;841 Delete(s,1,1);842 end;843 '-':844 begin // list845 FollowFormat:=pkNormal_Dot;846 CurrentFormat:=pkDot;847 Delete(s,1,1);848 end;849 else CurrentFormat:=FollowFormat;850 end;851 if FollowFormat=pkNormal_Dot then ofs:=20+4+8852 else ofs:=8;853 p:=0;854 repeat855 repeat inc(p) until (p>Length(s)) or (s[p]=' ') or (s[p]='\');856 if (BiColorTextWidth(Offscreen.Canvas,Copy(s,1,p-1))<=RightMargin-ofs) then857 l:=p-1858 else Break;859 until (p>=Length(s)) or (s[l+1]='\');860 MainText.AddLine(Copy(s,1,l),CurrentFormat,Picpix,LinkCategory,LinkIndex);861 if (l<Length(s)) and (s[l+1]='\') then FollowFormat:=pkNormal;862 Delete(s,1,l+1);863 end864 end865 end;866 1050 867 1051 procedure AddItem(Item: string); 868 1052 begin 869 AddText(HelpText.Lookup(Item));1053 AddText(HelpText.Lookup(Item)); 870 1054 end; 871 1055 872 1056 procedure AddModelText(i: integer); 873 1057 var 874 pix: integer; 875 s: string; 876 begin 877 with MainText do 878 begin 879 if Count>1 then begin LF; LF; end; 880 FindStdModelPicture(SpecialModelPictureCode[i],pix,s); 881 AddLine(s,pkSection); 882 AddLine(Format(HelpText.Lookup('STRENGTH'), 883 [SpecialModel[i].Attack,SpecialModel[i].Defense]),pkNormal_64); 884 AddLine(Format(HelpText.Lookup('SPEED'), 885 [MovementToString(SpecialModel[i].Speed)]),pkModel,pix); 886 if Difficulty=0 then 887 AddLine(Format(HelpText.Lookup('BUILDCOST'), 888 [SpecialModel[i].Cost]),pkNormal_64) 889 else AddLine(Format(HelpText.Lookup('BUILDCOST'), 890 [SpecialModel[i].Cost*BuildCostMod[Difficulty] div 12]),pkNormal_64); 891 s:=HelpText.LookupByHandle(hSPECIALMODEL,i); 892 if (s<>'') and (s<>'*') then AddText(s); 893 if SpecialModelPreq[i]>=0 then AddPreqAdv(SpecialModelPreq[i]) 894 else if SpecialModelPreq[i]=preLighthouse then AddPreqImp(woLighthouse) 895 else if SpecialModelPreq[i]=preBuilder then AddPreqImp(woPyramids) 896 else if SpecialModelPreq[i]=preLeo then AddPreqImp(woLeo); 897 if SpecialModelPreq[i]<>preNone then 898 MainText[Count-1]:=Format(HelpText.Lookup('REQUIRED'),[MainText[Count-1]]); 1058 pix: integer; 1059 s: string; 1060 begin 1061 with MainText do 1062 begin 1063 if Count > 1 then 1064 begin 1065 LF; 1066 LF; 1067 end; 1068 FindStdModelPicture(SpecialModelPictureCode[i], pix, s); 1069 AddLine(s, pkSection); 1070 AddLine(Format(HelpText.Lookup('STRENGTH'), [SpecialModel[i].Attack, 1071 SpecialModel[i].Defense]), pkNormal_64); 1072 AddLine(Format(HelpText.Lookup('SPEED'), 1073 [MovementToString(SpecialModel[i].Speed)]), pkModel, pix); 1074 if Difficulty = 0 then 1075 AddLine(Format(HelpText.Lookup('BUILDCOST'), [SpecialModel[i].Cost]), 1076 pkNormal_64) 1077 else 1078 AddLine(Format(HelpText.Lookup('BUILDCOST'), 1079 [SpecialModel[i].Cost * BuildCostMod[Difficulty] div 12]), 1080 pkNormal_64); 1081 s := HelpText.LookupByHandle(hSPECIALMODEL, i); 1082 if (s <> '') and (s <> '*') then 1083 AddText(s); 1084 if SpecialModelPreq[i] >= 0 then 1085 AddPreqAdv(SpecialModelPreq[i]) 1086 else if SpecialModelPreq[i] = preLighthouse then 1087 AddPreqImp(woLighthouse) 1088 else if SpecialModelPreq[i] = preBuilder then 1089 AddPreqImp(woPyramids) 1090 else if SpecialModelPreq[i] = preLeo then 1091 AddPreqImp(woLeo); 1092 if SpecialModelPreq[i] <> preNone then 1093 MainText[Count - 1] := Format(HelpText.Lookup('REQUIRED'), 1094 [MainText[Count - 1]]); 899 1095 end 900 1096 end; … … 902 1098 procedure AddJobList; 903 1099 var 904 i,JobCost: integer;905 begin 906 with MainText do907 begin 908 for i:=0 to nJobHelp-1 do1100 i, JobCost: integer; 1101 begin 1102 with MainText do 1103 begin 1104 for i := 0 to nJobHelp - 1 do 909 1105 begin 910 if i>0 then begin LF; LF end; 911 AddLine(Phrases.Lookup('JOBRESULT',JobHelp[i]),pkSection); 912 AddLine; 913 AddLine('',pkTerImp,i); 914 AddLine; 915 AddText(HelpText.LookupByHandle(hJOBHELP,i)); 916 JobCost:=-1; 917 case JobHelp[i] of 918 jCanal: JobCost:=CanalWork; 919 jFort: JobCost:=FortWork; 920 jBase: JobCost:=BaseWork; 1106 if i > 0 then 1107 begin 1108 LF; 1109 LF 921 1110 end; 922 if JobCost>=0 then 923 AddText(Format(HelpText.Lookup('JOBCOST'),[MovementToString(JobCost)])) 924 else AddText(HelpText.Lookup('JOBCOSTVAR')); 925 if JobPreq[JobHelp[i]]<>preNone then 1111 AddLine(Phrases.Lookup('JOBRESULT', JobHelp[i]), pkSection); 1112 AddLine; 1113 AddLine('', pkTerImp, i); 1114 AddLine; 1115 AddText(HelpText.LookupByHandle(hJOBHELP, i)); 1116 JobCost := -1; 1117 case JobHelp[i] of 1118 jCanal: 1119 JobCost := CanalWork; 1120 jFort: 1121 JobCost := FortWork; 1122 jBase: 1123 JobCost := BaseWork; 1124 end; 1125 if JobCost >= 0 then 1126 AddText(Format(HelpText.Lookup('JOBCOST'), 1127 [MovementToString(JobCost)])) 1128 else 1129 AddText(HelpText.Lookup('JOBCOSTVAR')); 1130 if JobPreq[JobHelp[i]] <> preNone then 926 1131 begin 927 AddPreqAdv(JobPreq[JobHelp[i]]); 928 MainText[Count-1]:=Format(HelpText.Lookup('REQUIRED'),[MainText[Count-1]]); 1132 AddPreqAdv(JobPreq[JobHelp[i]]); 1133 MainText[Count - 1] := Format(HelpText.Lookup('REQUIRED'), 1134 [MainText[Count - 1]]); 929 1135 end 930 1136 end; … … 934 1140 procedure AddGraphicCredits; 935 1141 var 936 i: integer; 937 s: string; 938 sr: TSearchRec; 939 List, plus: tstringlist; 940 begin 941 List:=tstringlist.Create; 942 plus:=tstringlist.Create; 943 if FindFirst(HomeDir+'Graphics\*.credits.txt',$27,sr)=0 then 944 repeat 945 plus.LoadFromFile(HomeDir+'Graphics\'+sr.Name); 946 List.AddStrings(plus); 947 until FindNext(sr)<>0; 948 FindClose(sr); 949 plus.Free; 950 951 List.Sort; 952 i:=1; 953 while i<List.Count do 954 if List[i]=List[i-1] then List.Delete(i) 955 else inc(i); 956 957 for i:=0 to List.Count-1 do 958 begin 959 s:=List[i]; 960 while BiColorTextWidth(Offscreen.Canvas,s)>InnerWidth-16 961 -GetSystemMetrics(SM_CXVSCROLL) do 962 Delete(s,Length(s),1); 963 MainText.AddLine(s); 1142 i: integer; 1143 s: string; 1144 sr: TSearchRec; 1145 List, plus: TStringList; 1146 begin 1147 List := TStringList.Create; 1148 plus := TStringList.Create; 1149 if FindFirst(HomeDir + 'Graphics\*.credits.txt', $27, sr) = 0 then 1150 repeat 1151 plus.LoadFromFile(HomeDir + 'Graphics\' + sr.Name); 1152 List.AddStrings(plus); 1153 until FindNext(sr) <> 0; 1154 FindClose(sr); 1155 plus.Free; 1156 1157 List.Sort; 1158 i := 1; 1159 while i < List.Count do 1160 if List[i] = List[i - 1] then 1161 List.Delete(i) 1162 else 1163 inc(i); 1164 1165 for i := 0 to List.Count - 1 do 1166 begin 1167 s := List[i]; 1168 while BiColorTextWidth(OffScreen.Canvas, s) > InnerWidth - 16 - 1169 GetSystemMetrics(SM_CXVSCROLL) do 1170 Delete(s, length(s), 1); 1171 MainText.AddLine(s); 964 1172 end; 965 List.Free;1173 List.Free; 966 1174 end; 967 1175 968 1176 procedure AddSoundCredits; 969 1177 var 970 i: integer;971 s: string;972 List: tstringlist;973 begin 974 List:=tstringlist.Create;975 List.LoadFromFile(HomeDir+'Sounds\sound.credits.txt');976 for i:=0 to List.Count-1 do977 begin 978 s:=List[i];979 while BiColorTextWidth(Offscreen.Canvas,s)>InnerWidth-16980 -GetSystemMetrics(SM_CXVSCROLL) do981 Delete(s,Length(s),1);982 MainText.AddLine(s);1178 i: integer; 1179 s: string; 1180 List: TStringList; 1181 begin 1182 List := TStringList.Create; 1183 List.LoadFromFile(HomeDir + 'Sounds\sound.credits.txt'); 1184 for i := 0 to List.Count - 1 do 1185 begin 1186 s := List[i]; 1187 while BiColorTextWidth(OffScreen.Canvas, s) > InnerWidth - 16 - 1188 GetSystemMetrics(SM_CXVSCROLL) do 1189 Delete(s, length(s), 1); 1190 MainText.AddLine(s); 983 1191 end; 984 List.Free;1192 List.Free; 985 1193 end; 986 1194 987 1195 procedure NextSection(Item: string); 988 1196 begin 989 if MainText.Count>1 then 990 if MainText.Count=Headline+1 then MainText.Delete(Headline) 991 else MainText.LF; 992 MainText.AddLine(HelpText.Lookup(Item),pkSection); 993 Headline:=MainText.Count-1; 994 end; 995 996 begin {Prepare} 997 with MainText do 998 begin 999 offscreen.Canvas.Font.Assign(UniFont[ftNormal]); 1000 CheckSeeAlso:=false; 1001 Clear; 1002 Headline:=-1; 1003 if (no>=200) or not (Kind in [hkAdv,hkImp,hkTer,hkFeature]) then 1004 LF; 1005 case Kind of 1006 hkText: AddText(HelpText.LookupByHandle(no)); 1007 hkMisc: 1008 begin 1009 case no of 1010 miscMain: 1197 if MainText.Count > 1 then 1198 if MainText.Count = Headline + 1 then 1199 MainText.Delete(Headline) 1200 else 1201 MainText.LF; 1202 MainText.AddLine(HelpText.Lookup(Item), pkSection); 1203 Headline := MainText.Count - 1; 1204 end; 1205 1206 begin { Prepare } 1207 with MainText do 1208 begin 1209 OffScreen.Canvas.Font.Assign(UniFont[ftNormal]); 1210 CheckSeeAlso := false; 1211 Clear; 1212 Headline := -1; 1213 if (no >= 200) or not(Kind in [hkAdv, hkImp, hkTer, hkFeature]) then 1214 LF; 1215 case Kind of 1216 hkText: 1217 AddText(HelpText.LookupByHandle(no)); 1218 hkMisc: 1219 begin 1220 case no of 1221 miscMain: 1222 begin 1223 Caption := HelpText.Lookup('HELPTITLE_MAIN'); 1224 AddLine(HelpText.Lookup('HELPTITLE_QUICKSTART'), pkSpecialIcon, 1225 0, { pkBigIcon,22, } hkText, HelpText.Gethandle('QUICK')); 1226 LF; 1227 AddLine(HelpText.Lookup('HELPTITLE_CONCEPTS'), pkBigIcon, 6, 1228 hkText, HelpText.Gethandle('CONCEPTS')); 1229 LF; 1230 AddLine(HelpText.Lookup('HELPTITLE_TERLIST'), pkSpecialIcon, 1, 1231 hkTer, 200); 1232 LF; 1233 AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'), pkSpecialIcon, 2, 1234 hkMisc, miscJobList); 1235 LF; 1236 AddLine(HelpText.Lookup('HELPTITLE_TECHLIST'), pkBigIcon, 39, 1237 hkAdv, 200); 1238 LF; 1239 FindStdModelPicture(SpecialModelPictureCode[6], i, s); 1240 AddLine(HelpText.Lookup('HELPTITLE_MODELLIST'), pkModel, i, 1241 hkModel, 0); 1242 LF; 1243 AddLine(HelpText.Lookup('HELPTITLE_FEATURELIST'), pkBigIcon, 28, 1244 hkFeature, 200); 1245 LF; 1246 AddLine(HelpText.Lookup('HELPTITLE_IMPLIST'), pkBigIcon, 1247 7 * SystemIconLines + imCourt, hkImp, 200); 1248 LF; 1249 AddLine(HelpText.Lookup('HELPTITLE_UNIQUELIST'), pkBigIcon, 1250 7 * SystemIconLines + imStockEx, hkImp, 201); 1251 LF; 1252 AddLine(HelpText.Lookup('HELPTITLE_WONDERLIST'), pkBigIcon, 1253 7 * SystemIconLines, hkImp, 202); 1254 LF; 1255 AddLine(HelpText.Lookup('HELPTITLE_GOVLIST'), pkBigIcon, 1256 gDemocracy + 6, hkMisc, miscGovList); 1257 LF; 1258 AddLine(HelpText.Lookup('HELPTITLE_KEYS'), pkBigIcon, 2, hkText, 1259 HelpText.Gethandle('HOTKEYS')); 1260 LF; 1261 AddLine(HelpText.Lookup('HELPTITLE_ABOUT'), pkBigIcon, 1, 1262 hkText, HelpText.Gethandle('ABOUT')); 1263 LF; 1264 AddLine(HelpText.Lookup('HELPTITLE_CREDITS'), pkBigIcon, 22, 1265 hkMisc, miscCredits); 1266 end; 1267 miscCredits: 1268 begin 1269 AddItem('CREDITS'); 1270 LF; 1271 AddGraphicCredits; 1272 NextSection('CRED_CAPSOUND'); 1273 AddSoundCredits; 1274 NextSection('CRED_CAPAI'); 1275 Server(sGetAICredits, 0, 0, ps); 1276 AddText(ps); 1277 NextSection('CRED_CAPLANG'); 1278 AddItem('AUTHOR'); 1279 end; 1280 miscJobList: 1281 begin 1282 Caption := HelpText.Lookup('HELPTITLE_JOBLIST'); 1283 AddJobList; 1284 LF; 1285 AddItem('TERIMPEXCLUDE'); 1286 LF; 1287 AddItem('TERIMPCITY'); 1288 end; 1289 miscGovList: 1290 begin 1291 Caption := HelpText.Lookup('HELPTITLE_GOVLIST'); 1292 for i := 1 to nGov do 1293 begin 1294 AddLine(Phrases.Lookup('GOVERNMENT', i mod nGov), pkSection); 1295 LF; 1296 if i = nGov then 1297 AddLine('', pkBigIcon, 7 * SystemIconLines + imPalace) 1298 else 1299 AddLine('', pkBigIcon, i + 6); 1300 LF; 1301 AddText(HelpText.LookupByHandle(hGOVHELP, i mod nGov)); 1302 if i mod nGov >= 2 then 1303 begin 1304 AddPreqAdv(GovPreq[i mod nGov]); 1305 MainText[Count - 1] := Format(HelpText.Lookup('REQUIRED'), 1306 [MainText[Count - 1]]); 1307 end; 1308 if i < nGov then 1309 begin 1310 LF; 1311 LF; 1312 end 1313 end 1314 end; 1315 miscSearchResult: 1316 begin 1317 Caption := HelpText.Lookup('HELPTITLE_SEARCHRESULTS'); 1318 AddText(Format(HelpText.Lookup('MATCHES'), [SearchContent])); 1319 MainText.AddStrings(SearchResult); 1320 end 1321 end; // case no 1322 end; 1323 1324 hkAdv: 1325 if no = 200 then 1326 begin // complete advance list 1327 Caption := HelpText.Lookup('HELPTITLE_TECHLIST'); 1328 List := THyperText.Create; 1329 for j := 0 to 3 do 1011 1330 begin 1012 Caption:=HelpText.Lookup('HELPTITLE_MAIN'); 1013 AddLine(HelpText.Lookup('HELPTITLE_QUICKSTART'),pkSpecialIcon,0,{pkBigIcon,22,}hkText,HelpText.GetHandle('QUICK')); LF; 1014 AddLine(HelpText.Lookup('HELPTITLE_CONCEPTS'),pkBigIcon,6,hkText,HelpText.GetHandle('CONCEPTS')); LF; 1015 AddLine(HelpText.Lookup('HELPTITLE_TERLIST'),pkSpecialIcon,1,hkTer,200); LF; 1016 AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'),pkSpecialIcon,2,hkMisc,miscJobList); LF; 1017 AddLine(HelpText.Lookup('HELPTITLE_TECHLIST'),pkBigIcon,39,hkAdv,200); LF; 1018 FindStdModelPicture(SpecialModelPictureCode[6],i,s); 1019 AddLine(HelpText.Lookup('HELPTITLE_MODELLIST'),pkModel,i,hkModel,0); LF; 1020 AddLine(HelpText.Lookup('HELPTITLE_FEATURELIST'),pkBigIcon,28,hkFeature,200); LF; 1021 AddLine(HelpText.Lookup('HELPTITLE_IMPLIST'),pkBigIcon,7*SystemIconLines+imCourt,hkImp,200); LF; 1022 AddLine(HelpText.Lookup('HELPTITLE_UNIQUELIST'),pkBigIcon,7*SystemIconLines+imStockEx,hkImp,201); LF; 1023 AddLine(HelpText.Lookup('HELPTITLE_WONDERLIST'),pkBigIcon,7*SystemIconLines,hkImp,202); LF; 1024 AddLine(HelpText.Lookup('HELPTITLE_GOVLIST'),pkBigIcon,gDemocracy+6,hkMisc,miscGovList); LF; 1025 AddLine(HelpText.Lookup('HELPTITLE_KEYS'),pkBigIcon,2,hkText,HelpText.GetHandle('HOTKEYS')); LF; 1026 AddLine(HelpText.Lookup('HELPTITLE_ABOUT'),pkBigIcon,1,hkText,HelpText.GetHandle('ABOUT')); LF; 1027 AddLine(HelpText.Lookup('HELPTITLE_CREDITS'),pkBigIcon,22,hkMisc,miscCredits); 1331 if j > 0 then 1332 begin 1333 LF; 1334 LF; 1335 end; 1336 AddLine(HelpText.Lookup('TECHAGE', j), pkSection); 1337 if j = 1 then 1338 AddLine(Phrases.Lookup('ADVANCES', adScience) + ' ' + 1339 HelpText.Lookup('BASETECH'), pkAdvIcon, adScience, hkAdv, 1340 adScience); 1341 if j = 2 then 1342 AddLine(Phrases.Lookup('ADVANCES', adMassProduction) + ' ' + 1343 HelpText.Lookup('BASETECH'), pkAdvIcon, adMassProduction, hkAdv, 1344 adMassProduction); 1345 List.Clear; 1346 for i := 0 to nAdv - 1 do 1347 if (i <> adScience) and (i <> adMassProduction) and 1348 (AdvValue[i] div 1000 = j) then 1349 List.AddLine(Phrases.Lookup('ADVANCES', i), pkAdvIcon, i, 1350 hkAdv, i); 1351 List.Sort; 1352 AddStrings(List); 1028 1353 end; 1029 miscCredits: 1354 List.Free 1355 end 1356 else // single advance 1357 begin 1358 Caption := Phrases.Lookup('ADVANCES', no); 1359 LF; 1360 AddLine(Phrases.Lookup('ADVANCES', no), pkCaption); 1361 if no in FutureTech then 1030 1362 begin 1031 AddItem('CREDITS'); 1032 LF; 1033 AddGraphicCredits; 1034 NextSection('CRED_CAPSOUND'); 1035 AddSoundCredits; 1036 NextSection('CRED_CAPAI'); 1037 Server(sGetAICredits,0,0,ps); 1038 AddText(ps); 1039 NextSection('CRED_CAPLANG'); 1040 AddItem('AUTHOR'); 1041 end; 1042 miscJobList: 1043 begin 1044 Caption:=HelpText.Lookup('HELPTITLE_JOBLIST'); 1045 AddJobList; 1046 LF; 1047 AddItem('TERIMPEXCLUDE'); 1048 LF; 1049 AddItem('TERIMPCITY'); 1050 end; 1051 miscGovList: 1052 begin 1053 Caption:=HelpText.Lookup('HELPTITLE_GOVLIST'); 1054 for i:=1 to nGov do 1055 begin 1056 AddLine(Phrases.Lookup('GOVERNMENT',i mod nGov),pkSection); 1363 AddLine(HelpText.Lookup('HELPSPEC_FUTURE')); 1057 1364 LF; 1058 if i=nGov then 1059 AddLine('',pkBigIcon,7*SystemIconLines+imPalace) 1060 else AddLine('',pkBigIcon,i+6); 1061 LF; 1062 AddText(HelpText.LookupByHandle(hGOVHELP,i mod nGov)); 1063 if i mod nGov>=2 then 1365 if no = futResearchTechnology then 1366 AddItem('FUTURETECHHELP100') 1367 else 1368 AddItem('FUTURETECHHELP25'); 1369 end 1370 else 1371 AddLine(HelpText.Lookup('HELPSPEC_ADV')); 1372 if AdvPreq[no, 2] <> preNone then 1373 NextSection('PREREQALT') 1374 else 1375 NextSection('PREREQ'); 1376 for i := 0 to 2 do 1377 if AdvPreq[no, i] <> preNone then 1378 AddPreqAdv(AdvPreq[no, i]); 1379 NextSection('GOVALLOW'); 1380 for i := 2 to nGov - 1 do 1381 if GovPreq[i] = no then 1382 AddLine(Phrases.Lookup('GOVERNMENT', i), pkGov, i, 1383 hkMisc + hkCrossLink, miscGovList); 1384 NextSection('BUILDALLOW'); 1385 for i := 0 to 27 do 1386 if Imp[i].Preq = no then 1387 AddImp(i); 1388 for i := 28 to nImp - 1 do 1389 if (Imp[i].Preq = no) and (Imp[i].Kind <> ikCommon) then 1390 AddImp(i); 1391 for i := 28 to nImp - 1 do 1392 if (Imp[i].Preq = no) and (Imp[i].Kind = ikCommon) then 1393 AddImp(i); 1394 NextSection('MODELALLOW'); 1395 for i := 0 to nSpecialModel - 1 do 1396 if SpecialModelPreq[i] = no then 1397 AddModel(i); 1398 NextSection('FEATALLOW'); 1399 for i := 0 to nFeature - 1 do 1400 if Feature[i].Preq = no then 1401 AddFeature(i); 1402 NextSection('FOLLOWADV'); 1403 for i := 0 to nAdv - 1 do 1404 if (AdvPreq[i, 0] = no) or (AdvPreq[i, 1] = no) or 1405 (AdvPreq[i, 2] = no) then 1406 AddAdv(i); 1407 NextSection('UPGRADEALLOW'); 1408 for Domain := 0 to nDomains - 1 do 1409 for i := 1 to nUpgrade - 1 do 1410 if upgrade[Domain, i].Preq = no then 1064 1411 begin 1065 AddPreqAdv(GovPreq[i mod nGov]); 1066 MainText[Count-1]:=Format(HelpText.Lookup('REQUIRED'),[MainText[Count-1]]); 1412 if upgrade[Domain, i].Strength > 0 then 1413 AddLine(Format(HelpText.Lookup('STRENGTHUP'), 1414 [Phrases.Lookup('DOMAIN', Domain), upgrade[Domain, 1415 i].Strength]), pkDomain, Domain); 1416 if upgrade[Domain, i].Trans > 0 then 1417 AddLine(Format(HelpText.Lookup('TRANSUP'), 1418 [Phrases.Lookup('DOMAIN', Domain), upgrade[Domain, i].Trans] 1419 ), pkDomain, Domain); 1420 if no in FutureTech then 1421 AddLine(Format(HelpText.Lookup('COSTUP'), 1422 [upgrade[Domain, i].Cost]), pkNormal_Dot) 1423 else 1424 AddLine(Format(HelpText.Lookup('COSTMIN'), 1425 [upgrade[Domain, i].Cost]), pkNormal_Dot) 1067 1426 end; 1068 if i<nGov then begin LF; LF; end 1069 end 1070 end; 1071 miscSearchResult: 1072 begin 1073 Caption:=HelpText.Lookup('HELPTITLE_SEARCHRESULTS'); 1074 AddText(Format(HelpText.Lookup('MATCHES'), [SearchContent])); 1075 MainText.AddStrings(SearchResult); 1076 end 1077 end; // case no 1078 end; 1079 1080 hkAdv: 1081 if no=200 then 1082 begin // complete advance list 1083 Caption:=HelpText.Lookup('HELPTITLE_TECHLIST'); 1084 List:=THyperText.Create; 1085 for j:=0 to 3 do 1086 begin 1087 if j>0 then begin LF; LF; end; 1088 AddLine(HelpText.Lookup('TECHAGE',j),pkSection); 1089 if j=1 then 1090 AddLine(Phrases.Lookup('ADVANCES',adScience)+' ' 1091 +HelpText.Lookup('BASETECH'), 1092 pkAdvIcon,adScience,hkAdv,adScience); 1093 if j=2 then 1094 AddLine(Phrases.Lookup('ADVANCES',adMassProduction)+' ' 1095 +HelpText.Lookup('BASETECH'), 1096 pkAdvIcon,adMassProduction,hkAdv,adMassProduction); 1097 List.Clear; 1098 for i:=0 to nAdv-1 do 1099 if (i<>adScience) and (i<>adMassProduction) and (AdvValue[i] div 1000=j) then 1100 List.AddLine(Phrases.Lookup('ADVANCES',i),pkAdvIcon,i,hkAdv,i); 1427 NextSection('EXPIRATION'); 1428 for i := 0 to 27 do 1429 if (Imp[i].Preq <> preNA) and (Imp[i].Expiration = no) then 1430 AddImp(i); 1431 NextSection('ADVEFFECT'); 1432 s := HelpText.LookupByHandle(hADVHELP, no); 1433 if s <> '*' then 1434 AddText(s); 1435 NextSection('SEEALSO'); 1436 CheckSeeAlso := true 1437 end; 1438 1439 hkImp: 1440 if no = 200 then 1441 begin // complete city improvement list 1442 Caption := HelpText.Lookup('HELPTITLE_IMPLIST'); 1443 // AddLine(HelpText.Lookup('HELPTITLE_IMPLIST'),pkSection); 1444 List := THyperText.Create; 1445 for i := 28 to nImp - 1 do 1446 if (i <> imTrGoods) and (Imp[i].Preq <> preNA) and 1447 (Imp[i].Kind = ikCommon) then 1448 List.AddLine(Phrases.Lookup('IMPROVEMENTS', i), pkSmallIcon, 1449 i, hkImp, i); 1101 1450 List.Sort; 1102 1451 AddStrings(List); 1452 List.Free 1453 end 1454 else if no = 201 then 1455 begin // complete nat. project list 1456 Caption := HelpText.Lookup('HELPTITLE_UNIQUELIST'); 1457 // AddLine(HelpText.Lookup('HELPTITLE_UNIQUELIST'),pkSection); 1458 for i := 28 to nImp - 1 do 1459 if (Imp[i].Preq <> preNA) and 1460 ((Imp[i].Kind = ikNatLocal) or (Imp[i].Kind = ikNatGlobal)) then 1461 AddLine(Phrases.Lookup('IMPROVEMENTS', i), pkSmallIcon, i, 1462 hkImp, i); 1463 { LF; 1464 LF; 1465 AddLine(HelpText.Lookup('HELPTITLE_SHIPPARTLIST'),pkSection); 1466 for i:=28 to nImp-1 do 1467 if (Imp[i].Preq<>preNA) and (Imp[i].Kind=ikShipPart) then 1468 AddLine(Phrases.Lookup('IMPROVEMENTS',i),pkSmallIcon,i,hkImp,i); } 1469 end 1470 else if no = 202 then 1471 begin // complete wonder list 1472 Caption := HelpText.Lookup('HELPTITLE_WONDERLIST'); 1473 // AddLine(HelpText.Lookup('HELPTITLE_WONDERLIST'),pkSection); 1474 for i := 0 to 27 do 1475 if Imp[i].Preq <> preNA then 1476 AddLine(Phrases.Lookup('IMPROVEMENTS', i), pkSmallIcon, i, 1477 hkImp, i); 1478 end 1479 else 1480 begin // single building 1481 Caption := Phrases.Lookup('IMPROVEMENTS', no); 1482 LF; 1483 AddLine(Phrases.Lookup('IMPROVEMENTS', no), pkRightIcon, no); 1484 case Imp[no].Kind of 1485 ikWonder: 1486 AddLine(HelpText.Lookup('HELPSPEC_WONDER')); 1487 ikCommon: 1488 AddLine(HelpText.Lookup('HELPSPEC_IMP')); 1489 ikShipPart: 1490 AddLine(HelpText.Lookup('HELPSPEC_SHIPPART')); 1491 else 1492 AddLine(HelpText.Lookup('HELPSPEC_NAT')) 1103 1493 end; 1104 List.Free 1494 if Imp[no].Kind <> ikShipPart then 1495 begin 1496 NextSection('EFFECT'); 1497 AddText(HelpText.LookupByHandle(hIMPHELP, no)); 1498 end; 1499 if no = woSun then 1500 begin 1501 AddFeature(mcFirst); 1502 AddFeature(mcWill); 1503 AddFeature(mcAcademy); 1504 end; 1505 if (no < 28) and not Phrases2FallenBackToEnglish then 1506 begin 1507 LF; 1508 if Imp[no].Expiration >= 0 then 1509 AddText(Phrases2.Lookup('HELP_WONDERMORALE1')) 1510 else 1511 AddText(Phrases2.Lookup('HELP_WONDERMORALE2')); 1512 end; 1513 if Imp[no].Preq <> preNone then 1514 begin 1515 NextSection('PREREQ'); 1516 AddPreqAdv(Imp[no].Preq); 1517 end; 1518 NextSection('COSTS'); 1519 if Difficulty = 0 then 1520 s := Format(HelpText.Lookup('BUILDCOST'), [Imp[no].Cost]) 1521 else 1522 s := Format(HelpText.Lookup('BUILDCOST'), 1523 [Imp[no].Cost * BuildCostMod[Difficulty] div 12]); 1524 AddLine(s); 1525 if Imp[no].Maint > 0 then 1526 AddLine(Format(HelpText.Lookup('MAINTCOST'), [Imp[no].Maint])); 1527 j := 0; 1528 for i := 0 to nImpReplacement - 1 do 1529 if ImpReplacement[i].NewImp = no then 1530 begin 1531 if j = 0 then 1532 begin 1533 NextSection('REPLACE'); 1534 AddItem('REPLACETEXT'); 1535 j := 1 1536 end; 1537 AddImp(ImpReplacement[i].OldImp); 1538 end; 1539 if Imp[no].Kind = ikShipPart then 1540 begin 1541 LF; 1542 if no = imShipComp then 1543 i := 1 1544 else if no = imShipPow then 1545 i := 2 1546 else { if no=imShipHab then } 1547 i := 3; 1548 AddLine(Format(HelpText.Lookup('RAREREQUIRED'), 1549 [Phrases.Lookup('TERRAIN', 3 * 12 + i)]), pkTer, 3 * 12 + i); 1550 end; 1551 if (no < 28) and (Imp[no].Expiration >= 0) then 1552 begin 1553 NextSection('EXPIRATION'); 1554 s := Format(HelpText.Lookup('EXPWITH'), 1555 [Phrases.Lookup('ADVANCES', Imp[no].Expiration)]); 1556 if no = woPyramids then 1557 s := s + ' ' + HelpText.Lookup('EXPSLAVE'); 1558 AddText(s); 1559 end; 1560 NextSection('SEEALSO'); 1561 if (no < 28) and (Imp[no].Expiration >= 0) then 1562 AddImp(woEiffel); 1563 for i := 0 to nImpReplacement - 1 do 1564 if ImpReplacement[i].OldImp = no then 1565 AddImp(ImpReplacement[i].NewImp); 1566 if no = imSupermarket then 1567 AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'), pkNormal, 0, 1568 hkMisc + hkCrossLink, miscJobList); 1569 CheckSeeAlso := true 1570 end; 1571 1572 hkTer: 1573 if no = 200 then 1574 begin // complete terrain type list 1575 Caption := HelpText.Lookup('HELPTITLE_TERLIST'); 1576 // AddLine(HelpText.Lookup('HELPTITLE_TERLIST'),pkSection); 1577 for i := 0 to nTerrainHelp - 1 do 1578 AddTer(TerrainHelp[i]); 1105 1579 end 1106 else // single advance 1107 begin 1108 Caption:=Phrases.Lookup('ADVANCES',no); 1109 LF; 1110 AddLine(Phrases.Lookup('ADVANCES',no),pkCaption); 1111 if no in FutureTech then 1580 else 1581 begin // sigle terrain type 1582 TerrType := no mod 12; 1583 if TerrType = fJungle then 1584 TerrType := fForest; 1585 TerrSubType := no div 12; 1586 if no = 3 * 12 then 1112 1587 begin 1113 AddLine(HelpText.Lookup('HELPSPEC_FUTURE')); 1114 LF; 1115 if no=futResearchTechnology then 1116 AddItem('FUTURETECHHELP100') 1117 else AddItem('FUTURETECHHELP25'); 1118 end 1119 else AddLine(HelpText.Lookup('HELPSPEC_ADV')); 1120 if AdvPreq[no,2]<>preNone then NextSection('PREREQALT') 1121 else NextSection('PREREQ'); 1122 for i:=0 to 2 do 1123 if AdvPreq[no,i]<>preNone then AddPreqAdv(AdvPreq[no,i]); 1124 NextSection('GOVALLOW'); 1125 for i:=2 to nGov-1 do 1126 if GovPreq[i]=no then 1127 AddLine(Phrases.Lookup('GOVERNMENT',i),pkGov,i, 1128 hkMisc+hkCrossLink,miscGovList); 1129 NextSection('BUILDALLOW'); 1130 for i:=0 to 27 do 1131 if Imp[i].Preq=no then AddImp(i); 1132 for i:=28 to nImp-1 do 1133 if (Imp[i].Preq=no) and (Imp[i].Kind<>ikCommon) then AddImp(i); 1134 for i:=28 to nImp-1 do 1135 if (Imp[i].Preq=no) and (Imp[i].Kind=ikCommon) then AddImp(i); 1136 NextSection('MODELALLOW'); 1137 for i:=0 to nSpecialModel-1 do 1138 if SpecialModelPreq[i]=no then AddModel(i); 1139 NextSection('FEATALLOW'); 1140 for i:=0 to nFeature-1 do if Feature[i].Preq=no then AddFeature(i); 1141 NextSection('FOLLOWADV'); 1142 for i:=0 to nAdv-1 do 1143 if (AdvPreq[i,0]=no) or (AdvPreq[i,1]=no) or (AdvPreq[i,2]=no) then 1144 AddAdv(i); 1145 NextSection('UPGRADEALLOW'); 1146 for Domain:=0 to nDomains-1 do for i:=1 to nUpgrade-1 do 1147 if upgrade[Domain,i].Preq=no then 1148 begin 1149 if upgrade[Domain,i].Strength>0 then 1150 AddLine(Format(HelpText.Lookup('STRENGTHUP'), 1151 [Phrases.Lookup('DOMAIN',Domain),upgrade[Domain,i].Strength]), 1152 pkDomain,Domain); 1153 if upgrade[Domain,i].Trans>0 then 1154 AddLine(Format(HelpText.Lookup('TRANSUP'), 1155 [Phrases.Lookup('DOMAIN',Domain),upgrade[Domain,i].Trans]), 1156 pkDomain,Domain); 1157 if no in FutureTech then 1158 AddLine(Format(HelpText.Lookup('COSTUP'), 1159 [upgrade[Domain,i].Cost]),pkNormal_Dot) 1160 else 1161 AddLine(Format(HelpText.Lookup('COSTMIN'), 1162 [upgrade[Domain,i].Cost]),pkNormal_Dot) 1163 end; 1164 NextSection('EXPIRATION'); 1165 for i:=0 to 27 do 1166 if (Imp[i].Preq<>preNA) and (Imp[i].Expiration=no) then AddImp(i); 1167 NextSection('ADVEFFECT'); 1168 s:=HelpText.LookupByHandle(hADVHELP,no); 1169 if s<>'*' then AddText(s); 1170 NextSection('SEEALSO'); 1171 CheckSeeAlso:=true 1172 end; 1173 1174 hkImp: 1175 if no=200 then 1176 begin // complete city improvement list 1177 Caption:=HelpText.Lookup('HELPTITLE_IMPLIST'); 1178 // AddLine(HelpText.Lookup('HELPTITLE_IMPLIST'),pkSection); 1179 List:=THyperText.Create; 1180 for i:=28 to nImp-1 do 1181 if (i<>imTrGoods) and (Imp[i].Preq<>preNA) and (Imp[i].Kind=ikCommon) then 1182 List.AddLine(Phrases.Lookup('IMPROVEMENTS',i),pkSmallIcon,i,hkImp,i); 1183 List.Sort; 1184 AddStrings(List); 1185 List.Free 1186 end 1187 else if no=201 then 1188 begin // complete nat. project list 1189 Caption:=HelpText.Lookup('HELPTITLE_UNIQUELIST'); 1190 // AddLine(HelpText.Lookup('HELPTITLE_UNIQUELIST'),pkSection); 1191 for i:=28 to nImp-1 do 1192 if (Imp[i].Preq<>preNA) 1193 and ((Imp[i].Kind=ikNatLocal) or (Imp[i].Kind=ikNatGlobal)) then 1194 AddLine(Phrases.Lookup('IMPROVEMENTS',i),pkSmallIcon,i,hkImp,i); 1195 { LF; 1196 LF; 1197 AddLine(HelpText.Lookup('HELPTITLE_SHIPPARTLIST'),pkSection); 1198 for i:=28 to nImp-1 do 1199 if (Imp[i].Preq<>preNA) and (Imp[i].Kind=ikShipPart) then 1200 AddLine(Phrases.Lookup('IMPROVEMENTS',i),pkSmallIcon,i,hkImp,i);} 1201 end 1202 else if no=202 then 1203 begin // complete wonder list 1204 Caption:=HelpText.Lookup('HELPTITLE_WONDERLIST'); 1205 // AddLine(HelpText.Lookup('HELPTITLE_WONDERLIST'),pkSection); 1206 for i:=0 to 27 do if Imp[i].Preq<>preNA then 1207 AddLine(Phrases.Lookup('IMPROVEMENTS',i),pkSmallIcon,i,hkImp,i); 1208 end 1209 else 1210 begin // single building 1211 Caption:=Phrases.Lookup('IMPROVEMENTS',no); 1212 LF; 1213 AddLine(Phrases.Lookup('IMPROVEMENTS',no),pkRightIcon,no); 1214 case Imp[no].Kind of 1215 ikWonder: AddLine(HelpText.Lookup('HELPSPEC_WONDER')); 1216 ikCommon: AddLine(HelpText.Lookup('HELPSPEC_IMP')); 1217 ikShipPart: AddLine(HelpText.Lookup('HELPSPEC_SHIPPART')); 1218 else AddLine(HelpText.Lookup('HELPSPEC_NAT')) 1588 TerrType := fDesert; 1589 TerrSubType := 0 1219 1590 end; 1220 if Imp[no].Kind<>ikShipPart then1591 with Terrain[TerrType] do 1221 1592 begin 1222 NextSection('EFFECT'); 1223 AddText(HelpText.LookupByHandle(hIMPHELP,no)); 1224 end; 1225 if no=woSun then 1226 begin 1227 AddFeature(mcFirst); 1228 AddFeature(mcWill); 1229 AddFeature(mcAcademy); 1230 end; 1231 if (no<28) and not Phrases2FallenBackToEnglish then 1232 begin 1233 LF; 1234 if Imp[no].Expiration>=0 then 1235 AddText(Phrases2.Lookup('HELP_WONDERMORALE1')) 1236 else AddText(Phrases2.Lookup('HELP_WONDERMORALE2')); 1237 end; 1238 if Imp[no].Preq<>preNone then 1239 begin 1240 NextSection('PREREQ'); 1241 AddPreqAdv(Imp[no].Preq); 1242 end; 1243 NextSection('COSTS'); 1244 if Difficulty=0 then 1245 s:=Format(HelpText.Lookup('BUILDCOST'),[Imp[no].Cost]) 1246 else s:=Format(HelpText.Lookup('BUILDCOST'), 1247 [Imp[no].Cost*BuildCostMod[Difficulty] div 12]); 1248 AddLine(s); 1249 if Imp[no].Maint>0 then 1250 AddLine(Format(HelpText.Lookup('MAINTCOST'),[Imp[no].Maint])); 1251 j:=0; 1252 for i:=0 to nImpReplacement-1 do if ImpReplacement[i].NewImp=no then 1253 begin 1254 if j=0 then 1255 begin NextSection('REPLACE'); AddItem('REPLACETEXT'); j:=1 end; 1256 AddImp(ImpReplacement[i].OldImp); 1257 end; 1258 if Imp[no].Kind=ikShipPart then 1259 begin 1260 LF; 1261 if no=imShipComp then i:=1 1262 else if no=imShipPow then i:=2 1263 else {if no=imShipHab then} i:=3; 1264 AddLine(Format(HelpText.Lookup('RAREREQUIRED'), 1265 [Phrases.Lookup('TERRAIN',3*12+i)]),pkTer,3*12+i); 1266 end; 1267 if (no<28) and (Imp[no].Expiration>=0) then 1268 begin 1269 NextSection('EXPIRATION'); 1270 s:=Format(HelpText.Lookup('EXPWITH'),[Phrases.Lookup('ADVANCES',Imp[no].Expiration)]); 1271 if no=woPyramids then s:=s+' '+HelpText.Lookup('EXPSLAVE'); 1272 AddText(s); 1273 end; 1274 NextSection('SEEALSO'); 1275 if (no<28) and (Imp[no].Expiration>=0) then AddImp(woEiffel); 1276 for i:=0 to nImpReplacement-1 do if ImpReplacement[i].OldImp=no then 1277 AddImp(ImpReplacement[i].NewImp); 1278 if no=imSupermarket then 1279 AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'),pkNormal,0,hkMisc+hkCrossLink,miscJobList); 1280 CheckSeeAlso:=true 1281 end; 1282 1283 hkTer: 1284 if no=200 then 1285 begin // complete terrain type list 1286 Caption:=HelpText.Lookup('HELPTITLE_TERLIST'); 1287 // AddLine(HelpText.Lookup('HELPTITLE_TERLIST'),pkSection); 1288 for i:=0 to nTerrainHelp-1 do AddTer(TerrainHelp[i]); 1289 end 1290 else 1291 begin // sigle terrain type 1292 TerrType:=no mod 12; 1293 if TerrType=fJungle then TerrType:=fForest; 1294 TerrSubType:=no div 12; 1295 if no=3*12 then 1296 begin TerrType:=fDesert; TerrSubType:=0 end; 1297 with Terrain[TerrType] do 1298 begin 1299 Caption:=Phrases.Lookup('TERRAIN',no); 1300 LF; 1301 AddLine(Phrases.Lookup('TERRAIN',no), pkBigTer, no); 1302 AddLine(HelpText.Lookup('HELPSPEC_TER')); 1303 LF; 1304 if (ProdRes[TerrSubType]>0) or (MineEff>0) then 1305 AddLine(Format(HelpText.Lookup('RESPROD'),[ProdRes[TerrSubType]])); 1306 if (no<3*12) and (MineEff>0) then 1307 MainText[Count-1]:=MainText[Count-1]+' ' 1308 +Format(HelpText.Lookup('MOREMINE'),[MineEff]); 1309 if (FoodRes[TerrSubType]>0) or (IrrEff>0) then 1310 AddLine(Format(HelpText.Lookup('RESFOOD'),[FoodRes[TerrSubType]])); 1311 if (no<3*12) and (IrrEff>0) then 1312 MainText[Count-1]:=MainText[Count-1]+' ' 1313 +Format(HelpText.Lookup('MOREIRR'),[IrrEff]); 1314 if TradeRes[TerrSubType]>0 then 1315 AddLine(Format(HelpText.Lookup('RESTRADE'),[TradeRes[TerrSubType]])); 1316 if Defense>4 then 1317 AddLine(Format(HelpText.Lookup('DEFBONUS'),[(Defense-4)*25])); 1318 if (TerrType>=fGrass) and (TerrType<>fMountains) then 1319 if MoveCost=2 then 1320 AddLine(HelpText.Lookup('MOVEHEAVY')) 1321 else AddLine(HelpText.Lookup('MOVEPLAIN')); 1322 if no=3*12 then 1323 begin 1593 Caption := Phrases.Lookup('TERRAIN', no); 1324 1594 LF; 1325 AddText(HelpText.Lookup('DEADLANDS')); 1326 end; 1327 if (TerrType=fDesert) and (no<>fDesert+12) then 1328 begin 1595 AddLine(Phrases.Lookup('TERRAIN', no), pkBigTer, no); 1596 AddLine(HelpText.Lookup('HELPSPEC_TER')); 1329 1597 LF; 1330 AddText(Format(HelpText.Lookup('HOSTILE'),[DesertThurst])); 1331 end; 1332 if TerrType=fArctic then 1333 begin 1334 LF; 1335 AddText(Format(HelpText.Lookup('HOSTILE'),[ArcticThurst])); 1336 end; 1337 if (no<3*12) and (TransTerrain>=0) then 1338 begin 1339 LF; 1340 i:=TransTerrain; 1341 if (TerrType<>fGrass) and (i<>fGrass) then 1342 i:=i+TerrSubType*12; // trafo to same special resource group 1343 AddLine(Format(HelpText.Lookup('TRAFO'), 1344 [Phrases.Lookup('TERRAIN',i)]),pkTer,i,hkTer+hkCrossLink,i); 1345 if no=fSwamp+12 then 1598 if (ProdRes[TerrSubType] > 0) or (MineEff > 0) then 1599 AddLine(Format(HelpText.Lookup('RESPROD'), 1600 [ProdRes[TerrSubType]])); 1601 if (no < 3 * 12) and (MineEff > 0) then 1602 MainText[Count - 1] := MainText[Count - 1] + ' ' + 1603 Format(HelpText.Lookup('MOREMINE'), [MineEff]); 1604 if (FoodRes[TerrSubType] > 0) or (IrrEff > 0) then 1605 AddLine(Format(HelpText.Lookup('RESFOOD'), 1606 [FoodRes[TerrSubType]])); 1607 if (no < 3 * 12) and (IrrEff > 0) then 1608 MainText[Count - 1] := MainText[Count - 1] + ' ' + 1609 Format(HelpText.Lookup('MOREIRR'), [IrrEff]); 1610 if TradeRes[TerrSubType] > 0 then 1611 AddLine(Format(HelpText.Lookup('RESTRADE'), 1612 [TradeRes[TerrSubType]])); 1613 if Defense > 4 then 1614 AddLine(Format(HelpText.Lookup('DEFBONUS'), 1615 [(Defense - 4) * 25])); 1616 if (TerrType >= fGrass) and (TerrType <> fMountains) then 1617 if MoveCost = 2 then 1618 AddLine(HelpText.Lookup('MOVEHEAVY')) 1619 else 1620 AddLine(HelpText.Lookup('MOVEPLAIN')); 1621 if no = 3 * 12 then 1622 begin 1623 LF; 1624 AddText(HelpText.Lookup('DEADLANDS')); 1625 end; 1626 if (TerrType = fDesert) and (no <> fDesert + 12) then 1627 begin 1628 LF; 1629 AddText(Format(HelpText.Lookup('HOSTILE'), [DesertThurst])); 1630 end; 1631 if TerrType = fArctic then 1632 begin 1633 LF; 1634 AddText(Format(HelpText.Lookup('HOSTILE'), [ArcticThurst])); 1635 end; 1636 if (no < 3 * 12) and (TransTerrain >= 0) then 1637 begin 1638 LF; 1639 i := TransTerrain; 1640 if (TerrType <> fGrass) and (i <> fGrass) then 1641 i := i + TerrSubType * 12; 1642 // trafo to same special resource group 1643 AddLine(Format(HelpText.Lookup('TRAFO'), 1644 [Phrases.Lookup('TERRAIN', i)]), pkTer, i, 1645 hkTer + hkCrossLink, i); 1646 if no = fSwamp + 12 then 1346 1647 begin 1648 LF; 1649 AddLine(Format(HelpText.Lookup('TRAFO'), 1650 [Phrases.Lookup('TERRAIN', TransTerrain + 24)]), pkTer, 1651 TransTerrain + 24, hkTer + hkCrossLink, TransTerrain + 24); 1652 end 1653 else if i = fGrass then 1654 begin 1655 LF; 1656 AddLine(Format(HelpText.Lookup('TRAFO'), 1657 [Phrases.Lookup('TERRAIN', fGrass + 12)]), pkTer, fGrass + 12, 1658 hkTer + hkCrossLink, fGrass + 12); 1659 end 1660 end; 1661 NextSection('SPECIAL'); 1662 if no = 3 * 12 then 1663 begin 1347 1664 LF; 1348 AddLine(Format(HelpText.Lookup('TRAFO'), 1349 [Phrases.Lookup('TERRAIN',TransTerrain+24)]),pkTer,TransTerrain+24, 1350 hkTer+hkCrossLink,TransTerrain+24); 1351 end 1352 else if i=fGrass then 1665 for special := 1 to 3 do 1353 1666 begin 1354 LF; 1355 AddLine(Format(HelpText.Lookup('TRAFO'), 1356 [Phrases.Lookup('TERRAIN',fGrass+12)]),pkTer,fGrass+12, 1357 hkTer+hkCrossLink,fGrass+12); 1358 end 1359 end; 1360 NextSection('SPECIAL'); 1361 if no=3*12 then 1362 begin 1363 LF; 1364 for special:=1 to 3 do 1365 begin 1366 if special>1 then LF; 1367 AddLine(Phrases.Lookup('TERRAIN',3*12+special),pkTer,3*12+special); 1667 if special > 1 then 1668 LF; 1669 AddLine(Phrases.Lookup('TERRAIN', 3 * 12 + special), pkTer, 1670 3 * 12 + special); 1368 1671 end 1369 1672 end 1370 else if (no<12) and (no<>fGrass) and (no<>fOcean) then1371 begin 1372 LF;1373 for special:=1 to 2 do1374 if (no<>fArctic) and (no<>fSwamp) or (special<2) then1673 else if (no < 12) and (no <> fGrass) and (no <> fOcean) then 1674 begin 1675 LF; 1676 for special := 1 to 2 do 1677 if (no <> fArctic) and (no <> fSwamp) or (special < 2) then 1375 1678 begin 1376 if special>1 then LF; 1377 AddLine(Phrases.Lookup('TERRAIN',no+special*12),pkTer,no+special*12); 1378 i:=FoodRes[special]-FoodRes[0]; 1379 if i<>0 then 1380 MainText[Count-1]:=MainText[Count-1]+Format(HelpText.Lookup('SPECIALFOOD'),[i]); 1381 i:=ProdRes[special]-ProdRes[0]; 1382 if i<>0 then 1383 MainText[Count-1]:=MainText[Count-1]+Format(HelpText.Lookup('SPECIALPROD'),[i]); 1384 i:=TradeRes[special]-TradeRes[0]; 1385 if i<>0 then 1386 MainText[Count-1]:=MainText[Count-1]+Format(HelpText.Lookup('SPECIALTRADE'),[i]); 1679 if special > 1 then 1680 LF; 1681 AddLine(Phrases.Lookup('TERRAIN', no + special * 12), pkTer, 1682 no + special * 12); 1683 i := FoodRes[special] - FoodRes[0]; 1684 if i <> 0 then 1685 MainText[Count - 1] := MainText[Count - 1] + 1686 Format(HelpText.Lookup('SPECIALFOOD'), [i]); 1687 i := ProdRes[special] - ProdRes[0]; 1688 if i <> 0 then 1689 MainText[Count - 1] := MainText[Count - 1] + 1690 Format(HelpText.Lookup('SPECIALPROD'), [i]); 1691 i := TradeRes[special] - TradeRes[0]; 1692 if i <> 0 then 1693 MainText[Count - 1] := MainText[Count - 1] + 1694 Format(HelpText.Lookup('SPECIALTRADE'), [i]); 1387 1695 end; 1388 1696 end; 1389 if no=3*12 then1390 begin 1391 LF;1392 AddText(HelpText.Lookup('RARE'));1393 end; 1394 if (no<3*12) and (TerrType in [fDesert,fArctic]) then1395 begin 1396 NextSection('SEEALSO');1397 AddImp(woGardens);1398 CheckSeeAlso:=true1697 if no = 3 * 12 then 1698 begin 1699 LF; 1700 AddText(HelpText.Lookup('RARE')); 1701 end; 1702 if (no < 3 * 12) and (TerrType in [fDesert, fArctic]) then 1703 begin 1704 NextSection('SEEALSO'); 1705 AddImp(woGardens); 1706 CheckSeeAlso := true 1399 1707 end 1400 1708 end 1401 1709 end; 1402 1710 1403 hkFeature:1404 if no=200 then1711 hkFeature: 1712 if no = 200 then 1405 1713 begin // complete feature list 1406 Caption:=HelpText.Lookup('HELPTITLE_FEATURELIST');1407 List:=THyperText.Create;1408 for special:=0 to 2 do1714 Caption := HelpText.Lookup('HELPTITLE_FEATURELIST'); 1715 List := THyperText.Create; 1716 for special := 0 to 2 do 1409 1717 begin 1410 if special>0 then begin LF; LF end; 1411 case special of 1412 0: AddLine(HelpText.Lookup('HELPTITLE_FEATURE1LIST'),pkSection); 1413 1: AddLine(HelpText.Lookup('HELPTITLE_FEATURE2LIST'),pkSection); 1414 2: AddLine(HelpText.Lookup('HELPTITLE_FEATURE3LIST'),pkSection); 1415 end; 1416 List.Clear; 1417 for i:=0 to nFeature-1 do if Feature[i].Preq<>preNA then 1418 begin 1419 if i<mcFirstNonCap then j:=0 1420 else if i in AutoFeature then j:=2 1421 else j:=1; 1422 if j=special then 1423 List.AddLine(Phrases.Lookup('FEATURES',i),pkFeature,i,hkFeature,i); 1424 end; 1425 List.Sort; 1426 AddStrings(List); 1718 if special > 0 then 1719 begin 1720 LF; 1721 LF 1722 end; 1723 case special of 1724 0: 1725 AddLine(HelpText.Lookup('HELPTITLE_FEATURE1LIST'), pkSection); 1726 1: 1727 AddLine(HelpText.Lookup('HELPTITLE_FEATURE2LIST'), pkSection); 1728 2: 1729 AddLine(HelpText.Lookup('HELPTITLE_FEATURE3LIST'), pkSection); 1730 end; 1731 List.Clear; 1732 for i := 0 to nFeature - 1 do 1733 if Feature[i].Preq <> preNA then 1734 begin 1735 if i < mcFirstNonCap then 1736 j := 0 1737 else if i in AutoFeature then 1738 j := 2 1739 else 1740 j := 1; 1741 if j = special then 1742 List.AddLine(Phrases.Lookup('FEATURES', i), pkFeature, i, 1743 hkFeature, i); 1744 end; 1745 List.Sort; 1746 AddStrings(List); 1427 1747 end; 1428 List.Free1748 List.Free 1429 1749 end 1430 else1750 else 1431 1751 begin // single feature 1432 Caption:=Phrases.Lookup('FEATURES',no); 1433 LF; 1434 AddLine(Phrases.Lookup('FEATURES',no),pkBigFeature,no); 1435 if no<mcFirstNonCap then 1436 AddLine(HelpText.Lookup('HELPSPEC_CAP')) 1437 else if no in AutoFeature then 1438 AddLine(HelpText.Lookup('HELPSPEC_STANDARD')) 1439 else AddLine(HelpText.Lookup('HELPSPEC_FEATURE')); 1440 NextSection('EFFECT'); 1441 AddText(HelpText.LookupByHandle(hFEATUREHELP,no)); 1442 if (Feature[no].Weight<>0) or (Feature[no].Cost<>0) then 1752 Caption := Phrases.Lookup('FEATURES', no); 1753 LF; 1754 AddLine(Phrases.Lookup('FEATURES', no), pkBigFeature, no); 1755 if no < mcFirstNonCap then 1756 AddLine(HelpText.Lookup('HELPSPEC_CAP')) 1757 else if no in AutoFeature then 1758 AddLine(HelpText.Lookup('HELPSPEC_STANDARD')) 1759 else 1760 AddLine(HelpText.Lookup('HELPSPEC_FEATURE')); 1761 NextSection('EFFECT'); 1762 AddText(HelpText.LookupByHandle(hFEATUREHELP, no)); 1763 if (Feature[no].Weight <> 0) or (Feature[no].Cost <> 0) then 1443 1764 begin 1444 NextSection('COSTS'); 1445 s:=IntToStr(Feature[no].Cost); 1446 if Feature[no].Cost>=0 then s:='+'+s; 1447 AddLine(Format(HelpText.Lookup('COSTBASE'),[s])); 1448 if Feature[no].Weight>0 then 1449 begin 1450 AddLine(Format(HelpText.Lookup('WEIGHT'), 1451 ['+'+IntToStr(Feature[no].Weight)])); 1452 if no=mcDefense then 1453 AddLine(Format(HelpText.Lookup('WEIGHT'),['+2']),pkDomain,dGround); 1765 NextSection('COSTS'); 1766 s := IntToStr(Feature[no].Cost); 1767 if Feature[no].Cost >= 0 then 1768 s := '+' + s; 1769 AddLine(Format(HelpText.Lookup('COSTBASE'), [s])); 1770 if Feature[no].Weight > 0 then 1771 begin 1772 AddLine(Format(HelpText.Lookup('WEIGHT'), 1773 ['+' + IntToStr(Feature[no].Weight)])); 1774 if no = mcDefense then 1775 AddLine(Format(HelpText.Lookup('WEIGHT'), ['+2']), 1776 pkDomain, dGround); 1454 1777 end 1455 1778 end; 1456 if Feature[no].Preq<>preNone then1779 if Feature[no].Preq <> preNone then 1457 1780 begin 1781 LF; 1782 if Feature[no].Preq = preSun then 1783 AddPreqImp(woSun) // sun tsu feature 1784 else 1785 AddPreqAdv(Feature[no].Preq); 1786 MainText[Count - 1] := Format(HelpText.Lookup('REQUIRED'), 1787 [MainText[Count - 1]]); 1788 end; 1789 NextSection('SEEALSO'); 1790 CheckSeeAlso := true 1791 end; 1792 1793 hkModel: 1794 begin 1795 Caption := HelpText.Lookup('HELPTITLE_MODELLIST'); 1796 for i := 0 to nSpecialModel - 1 do 1797 if i <> 2 then 1798 AddModelText(i); 1458 1799 LF; 1459 if Feature[no].Preq=preSun then AddPreqImp(woSun) // sun tsu feature 1460 else AddPreqAdv(Feature[no].Preq); 1461 MainText[Count-1]:=Format(HelpText.Lookup('REQUIRED'),[MainText[Count-1]]); 1800 AddItem('MODELNOTE'); 1801 end; 1802 1803 end; 1804 if CheckSeeAlso then 1805 for i := 0 to nSeeAlso - 1 do 1806 if (SeeAlso[i].Kind = Kind) and (SeeAlso[i].no = no) then 1807 case SeeAlso[i].SeeKind of 1808 hkImp: 1809 AddImp(SeeAlso[i].SeeNo); 1810 hkAdv: 1811 AddAdv(SeeAlso[i].SeeNo); 1812 hkFeature: 1813 AddFeature(SeeAlso[i].SeeNo); 1462 1814 end; 1463 NextSection('SEEALSO'); 1464 CheckSeeAlso:=true 1465 end; 1466 1467 hkModel: 1468 begin 1469 Caption:=HelpText.Lookup('HELPTITLE_MODELLIST'); 1470 for i:=0 to nSpecialModel-1 do if i<>2 then AddModelText(i); 1471 LF; 1472 AddItem('MODELNOTE'); 1473 end; 1474 1815 if (Headline >= 0) and (Count = Headline + 1) then 1816 Delete(Headline) 1817 else 1818 LF; 1819 1820 InitPVSB(sb, Count - 1, InnerHeight div 24); 1821 if sbPos <> 0 then 1822 begin 1823 sb.si.npos := sbPos; 1824 sb.si.FMask := SIF_POS; 1825 SetScrollInfo(sb.h, SB_CTL, sb.si, true); 1475 1826 end; 1476 if CheckSeeAlso then 1477 for i:=0 to nSeeAlso-1 do 1478 if (SeeAlso[i].Kind=Kind) and (SeeAlso[i].no=no) then 1479 case SeeAlso[i].SeeKind of 1480 hkImp: AddImp(SeeAlso[i].SeeNo); 1481 hkAdv: AddAdv(SeeAlso[i].SeeNo); 1482 hkFeature: AddFeature(SeeAlso[i].SeeNo); 1483 end; 1484 if (Headline>=0) and (Count=Headline+1) then Delete(Headline) 1485 else LF; 1486 1487 InitPVSB(sb,Count-1,InnerHeight div 24); 1488 if sbPos<>0 then 1489 begin 1490 sb.si.npos:=sbPos; 1491 sb.si.FMask:=SIF_POS; 1492 SetScrollInfo(sb.h,SB_CTL,sb.si,true); 1493 end; 1494 BackBtn.Visible:= nHist>0; 1495 TopBtn.Visible:= (nHist>0) or (Kind<>hkMisc) or (no<>miscMain); 1496 Sel:=-1; 1827 BackBtn.Visible := nHist > 0; 1828 TopBtn.Visible := (nHist > 0) or (Kind <> hkMisc) or (no <> miscMain); 1829 Sel := -1; 1497 1830 end; // with MainText 1498 end; { Prepare}1831 end; { Prepare } 1499 1832 1500 1833 procedure THelpDlg.ShowNewContent(NewMode, Category, Index: integer); 1501 1834 begin 1502 if (Category<>Kind) or (Index<>no) 1503 or (Category=hkMisc) and (Index=miscSearchResult) then 1504 begin 1505 if nHist=MaxHist then 1506 begin 1507 move(HistKind[2],HistKind[1],4*(nHist-2)); 1508 move(HistNo[2],HistNo[1],4*(nHist-2)); 1509 move(HistPos[2],HistPos[1],4*(nHist-2)); 1510 move(HistSearchContent[2],HistSearchContent[1],sizeof(shortstring)*(nHist-2)); 1835 if (Category <> Kind) or (Index <> no) or (Category = hkMisc) and 1836 (Index = miscSearchResult) then 1837 begin 1838 if nHist = MaxHist then 1839 begin 1840 move(HistKind[2], HistKind[1], 4 * (nHist - 2)); 1841 move(HistNo[2], HistNo[1], 4 * (nHist - 2)); 1842 move(HistPos[2], HistPos[1], 4 * (nHist - 2)); 1843 move(HistSearchContent[2], HistSearchContent[1], 1844 sizeof(shortstring) * (nHist - 2)); 1511 1845 end 1512 else inc(nHist); 1513 if nHist>0 then 1514 begin 1515 HistKind[nHist-1]:=Kind; 1516 HistNo[nHist-1]:=no; 1517 HistPos[nHist-1]:=sb.si.npos; 1518 HistSearchContent[nHist-1]:=SearchContent 1846 else 1847 inc(nHist); 1848 if nHist > 0 then 1849 begin 1850 HistKind[nHist - 1] := Kind; 1851 HistNo[nHist - 1] := no; 1852 HistPos[nHist - 1] := sb.si.npos; 1853 HistSearchContent[nHist - 1] := SearchContent 1519 1854 end 1520 1855 end; 1521 Kind:=Category;1522 no:=Index;1523 SearchContent:=NewSearchContent;1524 Prepare;1525 OffscreenPaint;1526 inherited ShowNewContent(NewMode);1856 Kind := Category; 1857 no := Index; 1858 SearchContent := NewSearchContent; 1859 Prepare; 1860 OffscreenPaint; 1861 inherited ShowNewContent(NewMode); 1527 1862 end; 1528 1863 … … 1530 1865 x, y: integer); 1531 1866 var 1532 i0,Sel0:integer;1867 i0, Sel0: integer; 1533 1868 begin 1534 y:=y-WideFrame; 1535 i0:=sb.si.npos; 1536 Sel0:=Sel; 1537 if (x>=SideFrame) and (x<SideFrame+InnerWidth) and (y>=0) and (y<InnerHeight) 1538 and (y mod 24>=8) then 1539 Sel:=y div 24 1540 else Sel:=-1; 1541 if (Sel+i0>=MainText.Count) or (Sel>=0) 1542 and (THelpLineInfo(MainText.Objects[Sel+i0]).Link=0) then Sel:=-1; 1543 if Sel<>Sel0 then 1544 begin 1545 if Sel0<>-1 then line(Canvas,Sel0,false); 1546 if Sel<>-1 then line(Canvas,Sel,true) 1869 y := y - WideFrame; 1870 i0 := sb.si.npos; 1871 Sel0 := Sel; 1872 if (x >= SideFrame) and (x < SideFrame + InnerWidth) and (y >= 0) and 1873 (y < InnerHeight) and (y mod 24 >= 8) then 1874 Sel := y div 24 1875 else 1876 Sel := -1; 1877 if (Sel + i0 >= MainText.Count) or (Sel >= 0) and 1878 (THelpLineInfo(MainText.Objects[Sel + i0]).Link = 0) then 1879 Sel := -1; 1880 if Sel <> Sel0 then 1881 begin 1882 if Sel0 <> -1 then 1883 line(Canvas, Sel0, false); 1884 if Sel <> -1 then 1885 line(Canvas, Sel, true) 1547 1886 end 1548 1887 end; 1549 1888 1550 procedure THelpDlg.PaintBox1MouseDown(Sender: TObject; 1551 Button: TMouseButton;Shift: TShiftState; x, y: integer);1889 procedure THelpDlg.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; 1890 Shift: TShiftState; x, y: integer); 1552 1891 begin 1553 if Sel>=0 then with THelpLineInfo(MainText.Objects[Sel+sb.si.npos]) do 1554 if Link shr 8 and $3F=hkInternet then 1555 case Link and $FF of 1556 1: ShellExecute(Handle,'open',pchar(HomeDir+'AI Template\AI development manual.html'),'','', 1557 SW_SHOWNORMAL); 1558 2: ShellExecute(Handle,'open','http://c-evo.org','','', 1559 SW_SHOWNORMAL); 1560 3: ShellExecute(Handle,'open','http://c-evo.org/_sg/contact','','', 1561 SW_SHOWNORMAL); 1892 if Sel >= 0 then 1893 with THelpLineInfo(MainText.Objects[Sel + sb.si.npos]) do 1894 if Link shr 8 and $3F = hkInternet then 1895 case Link and $FF of 1896 1: 1897 ShellExecute(Handle, 'open', 1898 pchar(HomeDir + 'AI Template\AI development manual.html'), '', '', 1899 SW_SHOWNORMAL); 1900 2: 1901 ShellExecute(Handle, 'open', 'http://c-evo.org', '', '', 1902 SW_SHOWNORMAL); 1903 3: 1904 ShellExecute(Handle, 'open', 'http://c-evo.org/_sg/contact', '', '', 1905 SW_SHOWNORMAL); 1906 end 1907 else 1908 begin 1909 if (Link >= $8000) and (Link and $3FFF = liInvalid) then 1910 exit; // invalid link; 1911 if Link >= $8000 then 1912 ShowNewContent(FWindowMode, hkText, Link and $3FFF) 1913 else 1914 ShowNewContent(FWindowMode, Link shr 8 and $3F, Link and $FF); 1562 1915 end 1563 else1564 begin1565 if (Link>=$8000) and (Link and $3FFF=liInvalid) then1566 exit; // invalid link;1567 if Link>=$8000 then1568 ShowNewContent(FWindowMode, hkText, Link and $3FFF)1569 else ShowNewContent(FWindowMode, Link shr 8 and $3F, Link and $FF);1570 end1571 1916 end; 1572 1917 1573 1918 procedure THelpDlg.BackBtnClick(Sender: TObject); 1574 1919 begin 1575 if nHist>0 then1576 begin 1577 dec(nHist);1578 if (HistKind[nHist]=hkMisc) and (HistNo[nHist]=miscSearchResult)1579 and (HistSearchContent[nHist]<>SearchContent) then1580 begin 1581 SearchContent:=HistSearchContent[nHist];1582 Search(SearchContent);1920 if nHist > 0 then 1921 begin 1922 dec(nHist); 1923 if (HistKind[nHist] = hkMisc) and (HistNo[nHist] = miscSearchResult) and 1924 (HistSearchContent[nHist] <> SearchContent) then 1925 begin 1926 SearchContent := HistSearchContent[nHist]; 1927 Search(SearchContent); 1583 1928 end; 1584 Kind:=HistKind[nHist]; 1585 no:=HistNo[nHist]; 1586 Prepare(HistPos[nHist]); 1929 Kind := HistKind[nHist]; 1930 no := HistNo[nHist]; 1931 Prepare(HistPos[nHist]); 1932 OffscreenPaint; 1933 Invalidate; 1934 end 1935 end; 1936 1937 procedure THelpDlg.TopBtnClick(Sender: TObject); 1938 begin 1939 nHist := 0; 1940 Kind := hkMisc; 1941 no := miscMain; 1942 Prepare; 1587 1943 OffscreenPaint; 1588 1944 Invalidate; 1589 end1590 end;1591 1592 procedure THelpDlg.TopBtnClick(Sender: TObject);1593 begin1594 nHist:=0;1595 Kind:=hkMisc;1596 no:=miscMain;1597 Prepare;1598 OffscreenPaint;1599 Invalidate;1600 1945 end; 1601 1946 1602 1947 procedure THelpDlg.FormClose(Sender: TObject; var Action: TCloseAction); 1603 1948 begin 1604 ExtPic.Height:=0;1605 inherited;1949 ExtPic.Height := 0; 1950 inherited; 1606 1951 end; 1607 1952 1608 1953 function THelpDlg.TextIndex(Item: string): integer; 1609 1954 begin 1610 result:=HelpText.GetHandle(Item)1955 result := HelpText.Gethandle(Item) 1611 1956 end; 1612 1957 … … 1614 1959 Shift: TShiftState); 1615 1960 begin 1616 if Key=VK_F1 then // my key 1617 else inherited 1961 if Key = VK_F1 then // my key 1962 else 1963 inherited 1618 1964 end; 1619 1965 1620 1966 procedure THelpDlg.SearchBtnClick(Sender: TObject); 1621 1967 begin 1622 InputDlg.Caption:=Phrases.Lookup('SEARCH'); 1623 InputDlg.EInput.Text:=SearchContent; 1624 InputDlg.CenterToRect(BoundsRect); 1625 InputDlg.ShowModal; 1626 if (InputDlg.ModalResult=mrOK) and (length(InputDlg.EInput.Text)>=2) then 1627 begin 1628 Search(InputDlg.EInput.Text); 1629 case SearchResult.Count of 1630 0: SimpleMessage(Format(HelpText.Lookup('NOMATCHES'), [InputDlg.EInput.Text])); 1631 1: 1632 with THelpLineInfo(SearchResult.Objects[0]) do 1633 if Link>=$8000 then 1634 ShowNewContent(FWindowMode, hkText, Link and $3FFF) 1635 else ShowNewContent(FWindowMode, Link shr 8 and $3F, Link and $FF); 1968 InputDlg.Caption := Phrases.Lookup('SEARCH'); 1969 InputDlg.EInput.Text := SearchContent; 1970 InputDlg.CenterToRect(BoundsRect); 1971 InputDlg.ShowModal; 1972 if (InputDlg.ModalResult = mrOK) and (length(InputDlg.EInput.Text) >= 2) then 1973 begin 1974 Search(InputDlg.EInput.Text); 1975 case SearchResult.Count of 1976 0: 1977 SimpleMessage(Format(HelpText.Lookup('NOMATCHES'), 1978 [InputDlg.EInput.Text])); 1979 1: 1980 with THelpLineInfo(SearchResult.Objects[0]) do 1981 if Link >= $8000 then 1982 ShowNewContent(FWindowMode, hkText, Link and $3FFF) 1983 else 1984 ShowNewContent(FWindowMode, Link shr 8 and $3F, Link and $FF); 1636 1985 else 1637 1986 begin 1638 NewSearchContent:=InputDlg.EInput.Text;1639 ShowNewContent(FWindowMode, hkMisc, miscSearchResult);1987 NewSearchContent := InputDlg.EInput.Text; 1988 ShowNewContent(FWindowMode, hkMisc, miscSearchResult); 1640 1989 end 1641 1990 end … … 1645 1994 procedure THelpDlg.Search(SearchString: string); 1646 1995 var 1647 h, i, PrevHandle, PrevIndex, p, RightMargin: integer;1648 s: string;1649 mADVHELP, mIMPHELP, mFEATUREHELP: set of 0..255;1650 bGOVHELP, bSPECIALMODEL, bJOBHELP: boolean;1996 h, i, PrevHandle, PrevIndex, p, RightMargin: integer; 1997 s: string; 1998 mADVHELP, mIMPHELP, mFEATUREHELP: set of 0 .. 255; 1999 bGOVHELP, bSPECIALMODEL, bJOBHELP: boolean; 1651 2000 begin 1652 SearchResult.Clear;1653 mADVHELP:=[];1654 mIMPHELP:=[];1655 mFEATUREHELP:=[];1656 bGOVHELP:=false;1657 bSPECIALMODEL:=false;1658 bJOBHELP:=false;1659 1660 // search in generic reference1661 SearchString:=UpperCase(SearchString);1662 for i:=0 to 35+4 do1663 begin 1664 s:=Phrases.Lookup('TERRAIN',i);1665 if pos(SearchString,UpperCase(s))>0 then1666 if i<36 then1667 SearchResult.AddLine(s+' '+HelpText.Lookup('HELPSPEC_TER'),pkNormal,0,1668 hkTer+hkCrossLink,i)1669 else2001 SearchResult.Clear; 2002 mADVHELP := []; 2003 mIMPHELP := []; 2004 mFEATUREHELP := []; 2005 bGOVHELP := false; 2006 bSPECIALMODEL := false; 2007 bJOBHELP := false; 2008 2009 // search in generic reference 2010 SearchString := UpperCase(SearchString); 2011 for i := 0 to 35 + 4 do 2012 begin 2013 s := Phrases.Lookup('TERRAIN', i); 2014 if pos(SearchString, UpperCase(s)) > 0 then 2015 if i < 36 then 2016 SearchResult.AddLine(s + ' ' + HelpText.Lookup('HELPSPEC_TER'), 2017 pkNormal, 0, hkTer + hkCrossLink, i) 2018 else 1670 2019 begin 1671 SearchResult.AddLine(Phrases.Lookup('TERRAIN',36)+' ' 1672 +HelpText.Lookup('HELPSPEC_TER'),pkNormal,0,hkTer+hkCrossLink,36); 1673 if i>36 then 1674 SearchResult.AddLine(Phrases.Lookup('IMPROVEMENTS',imShipComp+i-37) 1675 +' '+HelpText.Lookup('HELPSPEC_SHIPPART'), 1676 pkNormal,0,hkImp+hkCrossLink,imShipComp+i-37); 1677 break 2020 SearchResult.AddLine(Phrases.Lookup('TERRAIN', 36) + ' ' + 2021 HelpText.Lookup('HELPSPEC_TER'), pkNormal, 0, 2022 hkTer + hkCrossLink, 36); 2023 if i > 36 then 2024 SearchResult.AddLine(Phrases.Lookup('IMPROVEMENTS', 2025 imShipComp + i - 37) + ' ' + HelpText.Lookup('HELPSPEC_SHIPPART'), 2026 pkNormal, 0, hkImp + hkCrossLink, imShipComp + i - 37); 2027 Break 1678 2028 end 1679 2029 end; 1680 for i:=0 to nJobHelp-1 do 1681 if pos(SearchString,UpperCase(Phrases.Lookup('JOBRESULT',JobHelp[i])))>0 then 1682 begin 1683 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'),pkNormal,0, 1684 hkMisc+hkCrossLink,miscJobList); 1685 bJOBHELP:=true; 1686 break 2030 for i := 0 to nJobHelp - 1 do 2031 if pos(SearchString, UpperCase(Phrases.Lookup('JOBRESULT', JobHelp[i]))) > 0 2032 then 2033 begin 2034 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'), pkNormal, 0, 2035 hkMisc + hkCrossLink, miscJobList); 2036 bJOBHELP := true; 2037 Break 1687 2038 end; 1688 for i:=0 to nAdv-1 do 1689 begin 1690 s:=Phrases.Lookup('ADVANCES',i); 1691 if pos(SearchString,UpperCase(s))>0 then 1692 begin 1693 if i in FutureTech then s:=s+' '+HelpText.Lookup('HELPSPEC_FUTURE') 1694 else s:=s+' '+HelpText.Lookup('HELPSPEC_ADV'); 1695 SearchResult.AddLine(s,pkNormal,0,hkAdv+hkCrossLink,i); 1696 include(mADVHELP,i); 2039 for i := 0 to nAdv - 1 do 2040 begin 2041 s := Phrases.Lookup('ADVANCES', i); 2042 if pos(SearchString, UpperCase(s)) > 0 then 2043 begin 2044 if i in FutureTech then 2045 s := s + ' ' + HelpText.Lookup('HELPSPEC_FUTURE') 2046 else 2047 s := s + ' ' + HelpText.Lookup('HELPSPEC_ADV'); 2048 SearchResult.AddLine(s, pkNormal, 0, hkAdv + hkCrossLink, i); 2049 include(mADVHELP, i); 1697 2050 end 1698 2051 end; 1699 for i:=0 to nSpecialModel-1 do1700 begin 1701 FindStdModelPicture(SpecialModelPictureCode[i],h,s);1702 if pos(SearchString,UpperCase(s))>0 then1703 begin 1704 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_MODELLIST'),pkNormal,0,1705 hkModel+hkCrossLink,0);1706 bSPECIALMODEL:=true;1707 break2052 for i := 0 to nSpecialModel - 1 do 2053 begin 2054 FindStdModelPicture(SpecialModelPictureCode[i], h, s); 2055 if pos(SearchString, UpperCase(s)) > 0 then 2056 begin 2057 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_MODELLIST'), pkNormal, 0, 2058 hkModel + hkCrossLink, 0); 2059 bSPECIALMODEL := true; 2060 Break 1708 2061 end; 1709 2062 end; 1710 for i:=0 to nFeature-1 do 1711 begin 1712 s:=Phrases.Lookup('FEATURES',i); 1713 if pos(SearchString,UpperCase(s))>0 then 1714 begin 1715 if i<mcFirstNonCap then s:=s+' '+HelpText.Lookup('HELPSPEC_CAP') 1716 else if i in AutoFeature then s:=s+' '+HelpText.Lookup('HELPSPEC_STANDARD') 1717 else s:=s+' '+HelpText.Lookup('HELPSPEC_FEATURE'); 1718 SearchResult.AddLine(s,pkNormal,0,hkFeature+hkCrossLink,i); 1719 include(mFEATUREHELP,i); 2063 for i := 0 to nFeature - 1 do 2064 begin 2065 s := Phrases.Lookup('FEATURES', i); 2066 if pos(SearchString, UpperCase(s)) > 0 then 2067 begin 2068 if i < mcFirstNonCap then 2069 s := s + ' ' + HelpText.Lookup('HELPSPEC_CAP') 2070 else if i in AutoFeature then 2071 s := s + ' ' + HelpText.Lookup('HELPSPEC_STANDARD') 2072 else 2073 s := s + ' ' + HelpText.Lookup('HELPSPEC_FEATURE'); 2074 SearchResult.AddLine(s, pkNormal, 0, hkFeature + hkCrossLink, i); 2075 include(mFEATUREHELP, i); 1720 2076 end 1721 2077 end; 1722 for i:=0 to nImp-1 do 1723 begin 1724 s:=Phrases.Lookup('IMPROVEMENTS',i); 1725 if pos(SearchString,UpperCase(s))>0 then 1726 begin 1727 case Imp[i].Kind of 1728 ikWonder: s:=s+' '+HelpText.Lookup('HELPSPEC_WONDER'); 1729 ikCommon: s:=s+' '+HelpText.Lookup('HELPSPEC_IMP'); 1730 ikShipPart: s:=s+' '+HelpText.Lookup('HELPSPEC_SHIPPART'); 1731 else s:=s+' '+HelpText.Lookup('HELPSPEC_NAT') 2078 for i := 0 to nImp - 1 do 2079 begin 2080 s := Phrases.Lookup('IMPROVEMENTS', i); 2081 if pos(SearchString, UpperCase(s)) > 0 then 2082 begin 2083 case Imp[i].Kind of 2084 ikWonder: 2085 s := s + ' ' + HelpText.Lookup('HELPSPEC_WONDER'); 2086 ikCommon: 2087 s := s + ' ' + HelpText.Lookup('HELPSPEC_IMP'); 2088 ikShipPart: 2089 s := s + ' ' + HelpText.Lookup('HELPSPEC_SHIPPART'); 2090 else 2091 s := s + ' ' + HelpText.Lookup('HELPSPEC_NAT') 1732 2092 end; 1733 SearchResult.AddLine(s,pkNormal,0,hkImp+hkCrossLink,i);1734 include(mIMPHELP,i);2093 SearchResult.AddLine(s, pkNormal, 0, hkImp + hkCrossLink, i); 2094 include(mIMPHELP, i); 1735 2095 end 1736 2096 end; 1737 for i:=0 to nGov-1 do1738 if pos(SearchString,UpperCase(Phrases.Lookup('GOVERNMENT',i)))>0 then1739 begin 1740 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_GOVLIST'),pkNormal,0,1741 hkMisc+hkCrossLink,miscGovList);1742 bGOVHELP:=true;1743 break2097 for i := 0 to nGov - 1 do 2098 if pos(SearchString, UpperCase(Phrases.Lookup('GOVERNMENT', i))) > 0 then 2099 begin 2100 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_GOVLIST'), pkNormal, 0, 2101 hkMisc + hkCrossLink, miscGovList); 2102 bGOVHELP := true; 2103 Break 1744 2104 end; 1745 2105 1746 // full text search 1747 h:=-1; 1748 repeat 1749 PrevHandle:=h; 1750 PrevIndex:=i; 1751 if not HelpText.Search(SearchString, h, i) then 1752 break; 1753 if h=hADVHELP then 1754 begin 1755 if (i>=0) and ((i<>PrevIndex) or (h<>PrevHandle)) and not (i in mADVHELP) then 2106 // full text search 2107 h := -1; 2108 repeat 2109 PrevHandle := h; 2110 PrevIndex := i; 2111 if not HelpText.Search(SearchString, h, i) then 2112 Break; 2113 if h = hADVHELP then 2114 begin 2115 if (i >= 0) and ((i <> PrevIndex) or (h <> PrevHandle)) and 2116 not(i in mADVHELP) then 1756 2117 begin 1757 s:=Phrases.Lookup('ADVANCES',i); 1758 if i in FutureTech then s:=s+' '+HelpText.Lookup('HELPSPEC_FUTURE') 1759 else s:=s+' '+HelpText.Lookup('HELPSPEC_ADV'); 1760 SearchResult.AddLine(s,pkNormal,0,hkAdv+hkCrossLink,i) 2118 s := Phrases.Lookup('ADVANCES', i); 2119 if i in FutureTech then 2120 s := s + ' ' + HelpText.Lookup('HELPSPEC_FUTURE') 2121 else 2122 s := s + ' ' + HelpText.Lookup('HELPSPEC_ADV'); 2123 SearchResult.AddLine(s, pkNormal, 0, hkAdv + hkCrossLink, i) 1761 2124 end 1762 2125 end 1763 else if h=hIMPHELP then 1764 begin 1765 if (i>=0) and ((i<>PrevIndex) or (h<>PrevHandle)) and not (i in mIMPHELP) then 2126 else if h = hIMPHELP then 2127 begin 2128 if (i >= 0) and ((i <> PrevIndex) or (h <> PrevHandle)) and 2129 not(i in mIMPHELP) then 1766 2130 begin 1767 s:=Phrases.Lookup('IMPROVEMENTS',i); 1768 case Imp[i].Kind of 1769 ikWonder: s:=s+' '+HelpText.Lookup('HELPSPEC_WONDER'); 1770 ikCommon: s:=s+' '+HelpText.Lookup('HELPSPEC_IMP'); 1771 ikShipPart: s:=s+' '+HelpText.Lookup('HELPSPEC_SHIPPART'); 1772 else s:=s+' '+HelpText.Lookup('HELPSPEC_NAT') 2131 s := Phrases.Lookup('IMPROVEMENTS', i); 2132 case Imp[i].Kind of 2133 ikWonder: 2134 s := s + ' ' + HelpText.Lookup('HELPSPEC_WONDER'); 2135 ikCommon: 2136 s := s + ' ' + HelpText.Lookup('HELPSPEC_IMP'); 2137 ikShipPart: 2138 s := s + ' ' + HelpText.Lookup('HELPSPEC_SHIPPART'); 2139 else 2140 s := s + ' ' + HelpText.Lookup('HELPSPEC_NAT') 1773 2141 end; 1774 SearchResult.AddLine(s,pkNormal,0,hkImp+hkCrossLink,i)2142 SearchResult.AddLine(s, pkNormal, 0, hkImp + hkCrossLink, i) 1775 2143 end 1776 2144 end 1777 else if h=hFEATUREHELP then 1778 begin 1779 if (i>=0) and ((i<>PrevIndex) or (h<>PrevHandle)) and not (i in mFEATUREHELP) then 2145 else if h = hFEATUREHELP then 2146 begin 2147 if (i >= 0) and ((i <> PrevIndex) or (h <> PrevHandle)) and 2148 not(i in mFEATUREHELP) then 1780 2149 begin 1781 s:=Phrases.Lookup('FEATURES',i); 1782 if i<mcFirstNonCap then s:=s+' '+HelpText.Lookup('HELPSPEC_CAP') 1783 else if i in AutoFeature then s:=s+' '+HelpText.Lookup('HELPSPEC_STANDARD') 1784 else s:=s+' '+HelpText.Lookup('HELPSPEC_FEATURE'); 1785 SearchResult.AddLine(s,pkNormal,0,hkFeature+hkCrossLink,i); 2150 s := Phrases.Lookup('FEATURES', i); 2151 if i < mcFirstNonCap then 2152 s := s + ' ' + HelpText.Lookup('HELPSPEC_CAP') 2153 else if i in AutoFeature then 2154 s := s + ' ' + HelpText.Lookup('HELPSPEC_STANDARD') 2155 else 2156 s := s + ' ' + HelpText.Lookup('HELPSPEC_FEATURE'); 2157 SearchResult.AddLine(s, pkNormal, 0, hkFeature + hkCrossLink, i); 1786 2158 end 1787 2159 end 1788 else if h=hGOVHELP then1789 begin 1790 if (i>=0) and (h<>PrevHandle) and not bGOVHELP then1791 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_GOVLIST'),pkNormal,0,1792 hkMisc+hkCrossLink,miscGovList)2160 else if h = hGOVHELP then 2161 begin 2162 if (i >= 0) and (h <> PrevHandle) and not bGOVHELP then 2163 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_GOVLIST'), pkNormal, 0, 2164 hkMisc + hkCrossLink, miscGovList) 1793 2165 end 1794 else if h=hSPECIALMODEL then1795 begin 1796 if (i>=0) and (h<>PrevHandle) and not bSPECIALMODEL then1797 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_MODELLIST'),pkNormal,0,1798 hkModel+hkCrossLink,0)2166 else if h = hSPECIALMODEL then 2167 begin 2168 if (i >= 0) and (h <> PrevHandle) and not bSPECIALMODEL then 2169 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_MODELLIST'), pkNormal, 2170 0, hkModel + hkCrossLink, 0) 1799 2171 end 1800 else if h=hJOBHELP then1801 begin 1802 if (i>=0) and (h<>PrevHandle) and not bJOBHELP then1803 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'),pkNormal,0,1804 hkMisc+hkCrossLink,miscJobList)2172 else if h = hJOBHELP then 2173 begin 2174 if (i >= 0) and (h <> PrevHandle) and not bJOBHELP then 2175 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'), pkNormal, 0, 2176 hkMisc + hkCrossLink, miscJobList) 1805 2177 end 1806 else if {(h<>hMAIN) and} (h<>PrevHandle) then1807 begin 1808 s:=HelpText.LookupByHandle(h);1809 p:=pos('$',s);1810 if p>0 then2178 else if { (h<>hMAIN) and } (h <> PrevHandle) then 2179 begin 2180 s := HelpText.LookupByHandle(h); 2181 p := pos('$', s); 2182 if p > 0 then 1811 2183 begin 1812 s:=copy(s,p+1,maxint);1813 p:=pos('\',s);1814 if p>0 then1815 s:=copy(s,1,p-1);1816 SearchResult.AddLine(s, pkNormal, 0, hkText+hkCrossLink, h);2184 s := copy(s, p + 1, maxint); 2185 p := pos('\', s); 2186 if p > 0 then 2187 s := copy(s, 1, p - 1); 2188 SearchResult.AddLine(s, pkNormal, 0, hkText + hkCrossLink, h); 1817 2189 end 1818 2190 end 1819 until false; 1820 1821 // cut lines to fit to window 1822 RightMargin:=InnerWidth-16-GetSystemMetrics(SM_CXVSCROLL); 1823 Offscreen.Canvas.Font.Assign(UniFont[ftNormal]); 1824 for i:=0 to SearchResult.Count-1 do 1825 begin 1826 while BiColorTextWidth(Offscreen.Canvas, SearchResult[i])>RightMargin-32 do 1827 SearchResult[i]:=copy(SearchResult[i], 1, length(SearchResult[i])-1) 1828 end; 1829 end; 2191 until false; 2192 2193 // cut lines to fit to window 2194 RightMargin := InnerWidth - 16 - GetSystemMetrics(SM_CXVSCROLL); 2195 OffScreen.Canvas.Font.Assign(UniFont[ftNormal]); 2196 for i := 0 to SearchResult.Count - 1 do 2197 begin 2198 while BiColorTextWidth(OffScreen.Canvas, SearchResult[i]) > 2199 RightMargin - 32 do 2200 SearchResult[i] := copy(SearchResult[i], 1, length(SearchResult[i]) - 1) 2201 end; 2202 end; 1830 2203 1831 2204 end. 1832 -
trunk/LocalPlayer/IsoEngine.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit IsoEngine; 4 3 … … 6 5 7 6 uses 8 Protocol,ClientTools,ScreenTools,Tribes, 9 {$IFNDEF SCR}Term,{$ENDIF} 10 11 Windows,SysUtils,Classes,Graphics; 7 Protocol, ClientTools, ScreenTools, Tribes, 8 {$IFNDEF SCR}Term, {$ENDIF} 9 Windows, SysUtils, Classes, Graphics; 12 10 13 11 type 14 TInitEnemyModelEvent=function(emix: integer): boolean; 15 16 TIsoMap = class 17 constructor Create; 18 procedure SetOutput(Output: TBitmap); 19 procedure SetPaintBounds(Left, Top, Right, Bottom: integer); 20 procedure Paint(x,y,Loc,nx,ny,CityLoc,CityOwner:integer; UseBlink: boolean = false; CityAllowClick: boolean = false); 21 procedure PaintUnit(x,y:integer;const UnitInfo:TUnitInfo;Status:integer); 22 procedure PaintCity(x,y:integer;const CityInfo:TCityInfo; accessory: boolean = true); 23 procedure BitBlt(Src: TBitmap; x,y,Width,Height,xSrc,ySrc,Rop: integer); 24 25 procedure AttackBegin(const ShowMove: TShowMove); 26 procedure AttackEffect(const ShowMove: TShowMove); 27 procedure AttackEnd; 28 29 protected 30 FOutput: TBitmap; 31 FLeft, FTop, FRight, FBottom, RealTop, RealBottom, AttLoc, DefLoc, DefHealth, FAdviceLoc: integer; 32 OutDC, DataDC, MaskDC: Cardinal; 33 function Connection4(Loc,Mask,Value:integer):integer; 34 function Connection8(Loc,Mask:integer):integer; 35 function OceanConnection(Loc: integer): integer; 36 procedure PaintShore(x,y,Loc:integer); 37 procedure PaintTileExtraTerrain(x,y,Loc: integer); 38 procedure PaintTileObjects(x,y,Loc,CityLoc,CityOwner:integer; UseBlink: boolean); 39 procedure PaintGrid(x,y,nx,ny: integer); 40 procedure FillRect(x,y,Width,Height,Color: integer); 41 procedure Textout(x,y,Color: integer; const s: string); 42 procedure Sprite(HGr,xDst,yDst,Width,Height,xGr,yGr: integer); 43 procedure TSprite(xDst,yDst,grix: integer; PureBlack: boolean = false); 44 45 public 46 property AdviceLoc: integer read FAdviceLoc write FAdviceLoc; 12 TInitEnemyModelEvent = function(emix: integer): boolean; 13 14 TIsoMap = class 15 constructor Create; 16 procedure SetOutput(Output: TBitmap); 17 procedure SetPaintBounds(Left, Top, Right, Bottom: integer); 18 procedure Paint(x, y, Loc, nx, ny, CityLoc, CityOwner: integer; 19 UseBlink: boolean = false; CityAllowClick: boolean = false); 20 procedure PaintUnit(x, y: integer; const UnitInfo: TUnitInfo; 21 Status: integer); 22 procedure PaintCity(x, y: integer; const CityInfo: TCityInfo; 23 accessory: boolean = true); 24 procedure BitBlt(Src: TBitmap; x, y, Width, Height, xSrc, ySrc, 25 Rop: integer); 26 27 procedure AttackBegin(const ShowMove: TShowMove); 28 procedure AttackEffect(const ShowMove: TShowMove); 29 procedure AttackEnd; 30 31 protected 32 FOutput: TBitmap; 33 FLeft, FTop, FRight, FBottom, RealTop, RealBottom, AttLoc, DefLoc, 34 DefHealth, FAdviceLoc: integer; 35 OutDC, DataDC, MaskDC: Cardinal; 36 function Connection4(Loc, Mask, Value: integer): integer; 37 function Connection8(Loc, Mask: integer): integer; 38 function OceanConnection(Loc: integer): integer; 39 procedure PaintShore(x, y, Loc: integer); 40 procedure PaintTileExtraTerrain(x, y, Loc: integer); 41 procedure PaintTileObjects(x, y, Loc, CityLoc, CityOwner: integer; 42 UseBlink: boolean); 43 procedure PaintGrid(x, y, nx, ny: integer); 44 procedure FillRect(x, y, Width, Height, Color: integer); 45 procedure Textout(x, y, Color: integer; const s: string); 46 procedure Sprite(HGr, xDst, yDst, Width, Height, xGr, yGr: integer); 47 procedure TSprite(xDst, yDst, grix: integer; PureBlack: boolean = false); 48 49 public 50 property AdviceLoc: integer read FAdviceLoc write FAdviceLoc; 47 51 end; 48 52 49 50 53 const 51 // options switched by buttons 52 moPolitical=0; moCityNames=1; moGreatWall=4; moGrid=5; moBareTerrain=6; 53 54 // other options 55 moEditMode=16; moLocCodes=17; 56 54 // options switched by buttons 55 moPolitical = 0; 56 moCityNames = 1; 57 moGreatWall = 4; 58 moGrid = 5; 59 moBareTerrain = 6; 60 61 // other options 62 moEditMode = 16; 63 moLocCodes = 17; 57 64 58 65 var 59 NoMap: TIsoMap; 60 Options: integer; 61 pDebugMap: integer; //-1 for off 62 66 NoMap: TIsoMap; 67 Options: integer; 68 pDebugMap: integer; // -1 for off 63 69 64 70 function IsJungle(y: integer): boolean; … … 68 74 procedure Reset; 69 75 70 71 76 implementation 72 77 73 78 const 74 ShoreDither=fGrass;75 TerrainIconLines=21;79 ShoreDither = fGrass; 80 TerrainIconLines = 21; 76 81 77 82 var 78 BordersOK: integer;79 OnInitEnemyModel: TInitEnemyModelEvent;80 LandPatch,OceanPatch, Borders: TBitmap;81 TSpriteSize: array[0..TerrainIconLines*9-1] of TRect;82 DebugMap: ^TTileList;83 CitiesPictures: array[2..3,0..3] of TCityPicture;84 FoW, ShowLoc, ShowCityNames, ShowObjects, ShowBorder, ShowMyBorder,85 ShowGrWall, ShowDebug: boolean;83 BordersOK: integer; 84 OnInitEnemyModel: TInitEnemyModelEvent; 85 LandPatch, OceanPatch, Borders: TBitmap; 86 TSpriteSize: array [0 .. TerrainIconLines * 9 - 1] of TRect; 87 DebugMap: ^TTileList; 88 CitiesPictures: array [2 .. 3, 0 .. 3] of TCityPicture; 89 FoW, ShowLoc, ShowCityNames, ShowObjects, ShowBorder, ShowMyBorder, 90 ShowGrWall, ShowDebug: boolean; 86 91 87 92 function IsJungle(y: integer): boolean; 88 93 begin 89 result:= (y>(G.ly-2) div 4) and (G.ly-1-y>(G.ly-2) div 4)94 result := (y > (G.ly - 2) div 4) and (G.ly - 1 - y > (G.ly - 2) div 4) 90 95 end; 91 96 92 97 procedure Init(InitEnemyModelHandler: TInitEnemyModelEvent); 93 98 begin 94 OnInitEnemyModel:=InitEnemyModelHandler;95 if NoMap<>nil then96 NoMap.Free;97 NoMap:=TIsoMap.Create;99 OnInitEnemyModel := InitEnemyModelHandler; 100 if NoMap <> nil then 101 NoMap.Free; 102 NoMap := TIsoMap.Create; 98 103 end; 99 104 100 105 function ApplyTileSize(xxtNew, yytNew: integer): boolean; 101 106 type 102 TLine=array[0..INFIN,0..2] of Byte;107 TLine = array [0 .. INFIN, 0 .. 2] of Byte; 103 108 var 104 i,x,y,xSrc,ySrc,HGrTerrainNew,HGrCitiesNew,age,size:integer;105 LandMore,OceanMore,DitherMask,Mask24: TBitmap;106 MaskLine: array[0..32*3-1] of ^TLine; // 32 = assumed maximum for yyt107 Border: boolean;109 i, x, y, xSrc, ySrc, HGrTerrainNew, HGrCitiesNew, age, size: integer; 110 LandMore, OceanMore, DitherMask, Mask24: TBitmap; 111 MaskLine: array [0 .. 32 * 3 - 1] of ^TLine; // 32 = assumed maximum for yyt 112 Border: boolean; 108 113 begin 109 result:=false; 110 HGrTerrainNew:=LoadGraphicSet(Format('Terrain%dx%d',[xxtNew*2,yytNew*2])); 111 if HGrTerrainNew<0 then 112 exit; 113 HGrCitiesNew:=LoadGraphicSet(Format('Cities%dx%d',[xxtNew*2,yytNew*2])); 114 if HGrCitiesNew<0 then 115 exit; 116 xxt:=xxtNew; yyt:=yytNew; 117 HGrTerrain:=HGrTerrainNew; 118 HGrCities:=HGrCitiesNew; 119 result:=true; 120 121 // prepare age 2+3 cities 122 for age:=2 to 3 do 123 for size:=0 to 3 do with CitiesPictures[age,size] do 124 FindPosition(HGrCities,size*(xxt*2+1),(age-2)*(yyt*3+1),xxt*2-1,yyt*3-1, 125 $00FFFF,xShield,yShield); 126 127 {prepare dithered ground tiles} 128 if LandPatch<>nil then 129 LandPatch.Free; 130 LandPatch:=TBitmap.Create; 131 LandPatch.PixelFormat:=pf24bit; 132 LandPatch.Canvas.Brush.Color:=0; 133 LandPatch.Width:=xxt*18; LandPatch.Height:=yyt*9; 134 if OceanPatch<>nil then 135 OceanPatch.Free; 136 OceanPatch:=TBitmap.Create; 137 OceanPatch.PixelFormat:=pf24bit; 138 OceanPatch.Canvas.Brush.Color:=0; 139 OceanPatch.Width:=xxt*8; OceanPatch.Height:=yyt*4; 140 LandMore:=TBitmap.Create; 141 LandMore.PixelFormat:=pf24bit; 142 LandMore.Canvas.Brush.Color:=0; 143 LandMore.Width:=xxt*18; LandMore.Height:=yyt*9; 144 OceanMore:=TBitmap.Create; 145 OceanMore.PixelFormat:=pf24bit; 146 OceanMore.Canvas.Brush.Color:=0; 147 OceanMore.Width:=xxt*8; OceanMore.Height:=yyt*4; 148 DitherMask:=TBitmap.Create; 149 DitherMask.PixelFormat:=pf24bit; 150 DitherMask.Width:=xxt*2; DitherMask.Height:=yyt*2; 151 BitBlt(DitherMask.Canvas.Handle,0,0,xxt*2,yyt*2, 152 GrExt[HGrTerrain].Mask.Canvas.Handle,1+7*(xxt*2+1),1+yyt+15*(yyt*3+1),SRCAND); 153 154 for x:=-1 to 6 do 114 result := false; 115 HGrTerrainNew := LoadGraphicSet(Format('Terrain%dx%d', 116 [xxtNew * 2, yytNew * 2])); 117 if HGrTerrainNew < 0 then 118 exit; 119 HGrCitiesNew := LoadGraphicSet(Format('Cities%dx%d', 120 [xxtNew * 2, yytNew * 2])); 121 if HGrCitiesNew < 0 then 122 exit; 123 xxt := xxtNew; 124 yyt := yytNew; 125 HGrTerrain := HGrTerrainNew; 126 HGrCities := HGrCitiesNew; 127 result := true; 128 129 // prepare age 2+3 cities 130 for age := 2 to 3 do 131 for size := 0 to 3 do 132 with CitiesPictures[age, size] do 133 FindPosition(HGrCities, size * (xxt * 2 + 1), (age - 2) * (yyt * 3 + 1), 134 xxt * 2 - 1, yyt * 3 - 1, $00FFFF, xShield, yShield); 135 136 { prepare dithered ground tiles } 137 if LandPatch <> nil then 138 LandPatch.Free; 139 LandPatch := TBitmap.Create; 140 LandPatch.PixelFormat := pf24bit; 141 LandPatch.Canvas.Brush.Color := 0; 142 LandPatch.Width := xxt * 18; 143 LandPatch.Height := yyt * 9; 144 if OceanPatch <> nil then 145 OceanPatch.Free; 146 OceanPatch := TBitmap.Create; 147 OceanPatch.PixelFormat := pf24bit; 148 OceanPatch.Canvas.Brush.Color := 0; 149 OceanPatch.Width := xxt * 8; 150 OceanPatch.Height := yyt * 4; 151 LandMore := TBitmap.Create; 152 LandMore.PixelFormat := pf24bit; 153 LandMore.Canvas.Brush.Color := 0; 154 LandMore.Width := xxt * 18; 155 LandMore.Height := yyt * 9; 156 OceanMore := TBitmap.Create; 157 OceanMore.PixelFormat := pf24bit; 158 OceanMore.Canvas.Brush.Color := 0; 159 OceanMore.Width := xxt * 8; 160 OceanMore.Height := yyt * 4; 161 DitherMask := TBitmap.Create; 162 DitherMask.PixelFormat := pf24bit; 163 DitherMask.Width := xxt * 2; 164 DitherMask.Height := yyt * 2; 165 BitBlt(DitherMask.Canvas.Handle, 0, 0, xxt * 2, yyt * 2, 166 GrExt[HGrTerrain].Mask.Canvas.Handle, 1 + 7 * (xxt * 2 + 1), 167 1 + yyt + 15 * (yyt * 3 + 1), SRCAND); 168 169 for x := -1 to 6 do 155 170 begin 156 if x=-1 then begin xSrc:=ShoreDither*(xxt*2+1)+1; ySrc:=1+yyt end 157 else if x=6 then begin xSrc:=1+(xxt*2+1)*2; ySrc:=1+yyt+(yyt*3+1)*2 end 158 else begin xSrc:=(x+2)*(xxt*2+1)+1; ySrc:=1+yyt end; 159 for y:=-1 to 6 do 160 BitBlt(LandPatch.Canvas.Handle,(x+2)*(xxt*2),(y+2)*yyt,xxt*2,yyt, 161 GrExt[HGrTerrain].Data.Canvas.Handle,xSrc,ySrc,SRCCOPY); 162 for y:=-2 to 6 do 163 BitBlt(LandPatch.Canvas.Handle,(x+2)*(xxt*2),(y+2)*yyt,xxt,yyt, 164 GrExt[HGrTerrain].Data.Canvas.Handle,xSrc+xxt,ySrc+yyt,SRCPAINT); 165 for y:=-2 to 6 do 166 BitBlt(LandPatch.Canvas.Handle,(x+2)*(xxt*2)+xxt,(y+2)*yyt,xxt,yyt, 167 GrExt[HGrTerrain].Data.Canvas.Handle,xSrc,ySrc+yyt,SRCPAINT); 168 for y:=-2 to 6 do 169 BitBlt(LandPatch.Canvas.Handle,(x+2)*(xxt*2),(y+2)*yyt,xxt,yyt, 170 DitherMask.Canvas.Handle,xxt,yyt,SRCAND); 171 for y:=-2 to 6 do 172 BitBlt(LandPatch.Canvas.Handle,(x+2)*(xxt*2)+xxt,(y+2)*yyt,xxt,yyt, 173 DitherMask.Canvas.Handle,0,yyt,SRCAND); 171 if x = -1 then 172 begin 173 xSrc := ShoreDither * (xxt * 2 + 1) + 1; 174 ySrc := 1 + yyt 175 end 176 else if x = 6 then 177 begin 178 xSrc := 1 + (xxt * 2 + 1) * 2; 179 ySrc := 1 + yyt + (yyt * 3 + 1) * 2 180 end 181 else 182 begin 183 xSrc := (x + 2) * (xxt * 2 + 1) + 1; 184 ySrc := 1 + yyt 185 end; 186 for y := -1 to 6 do 187 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2), (y + 2) * yyt, 188 xxt * 2, yyt, GrExt[HGrTerrain].Data.Canvas.Handle, xSrc, ySrc, 189 SRCCOPY); 190 for y := -2 to 6 do 191 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2), (y + 2) * yyt, xxt, 192 yyt, GrExt[HGrTerrain].Data.Canvas.Handle, xSrc + xxt, ySrc + yyt, 193 SRCPAINT); 194 for y := -2 to 6 do 195 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2) + xxt, (y + 2) * yyt, 196 xxt, yyt, GrExt[HGrTerrain].Data.Canvas.Handle, xSrc, ySrc + yyt, 197 SRCPAINT); 198 for y := -2 to 6 do 199 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2), (y + 2) * yyt, xxt, 200 yyt, DitherMask.Canvas.Handle, xxt, yyt, SRCAND); 201 for y := -2 to 6 do 202 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2) + xxt, (y + 2) * yyt, 203 xxt, yyt, DitherMask.Canvas.Handle, 0, yyt, SRCAND); 174 204 end; 175 205 176 for y:=-1 to 6 do206 for y := -1 to 6 do 177 207 begin 178 if y=-1 then begin xSrc:=ShoreDither*(xxt*2+1)+1; ySrc:=1+yyt end 179 else if y=6 then begin xSrc:=1+2*(xxt*2+1); ySrc:=1+yyt+2*(yyt*3+1) end 180 else begin xSrc:=(y+2)*(xxt*2+1)+1; ySrc:=1+yyt end; 181 for x:=-2 to 6 do 182 BitBlt(LandMore.Canvas.Handle,(x+2)*(xxt*2),(y+2)*yyt,xxt*2,yyt, 183 GrExt[HGrTerrain].Data.Canvas.Handle,xSrc,ySrc,SRCCOPY); 184 BitBlt(LandMore.Canvas.Handle,xxt*2,(y+2)*yyt,xxt,yyt, 185 GrExt[HGrTerrain].Data.Canvas.Handle,xSrc+xxt,ySrc+yyt,SRCPAINT); 186 for x:=0 to 7 do 187 BitBlt(LandMore.Canvas.Handle,(x+2)*(xxt*2)-xxt,(y+2)*yyt,xxt*2,yyt, 188 GrExt[HGrTerrain].Data.Canvas.Handle,xSrc,ySrc+yyt,SRCPAINT); 189 for x:=-2 to 6 do 190 BitBlt(LandMore.Canvas.Handle,(x+2)*(xxt*2),(y+2)*yyt,xxt*2,yyt, 191 DitherMask.Canvas.Handle,0,0,SRCAND); 208 if y = -1 then 209 begin 210 xSrc := ShoreDither * (xxt * 2 + 1) + 1; 211 ySrc := 1 + yyt 212 end 213 else if y = 6 then 214 begin 215 xSrc := 1 + 2 * (xxt * 2 + 1); 216 ySrc := 1 + yyt + 2 * (yyt * 3 + 1) 217 end 218 else 219 begin 220 xSrc := (y + 2) * (xxt * 2 + 1) + 1; 221 ySrc := 1 + yyt 222 end; 223 for x := -2 to 6 do 224 BitBlt(LandMore.Canvas.Handle, (x + 2) * (xxt * 2), (y + 2) * yyt, 225 xxt * 2, yyt, GrExt[HGrTerrain].Data.Canvas.Handle, xSrc, ySrc, 226 SRCCOPY); 227 BitBlt(LandMore.Canvas.Handle, xxt * 2, (y + 2) * yyt, xxt, yyt, 228 GrExt[HGrTerrain].Data.Canvas.Handle, xSrc + xxt, ySrc + yyt, SRCPAINT); 229 for x := 0 to 7 do 230 BitBlt(LandMore.Canvas.Handle, (x + 2) * (xxt * 2) - xxt, (y + 2) * yyt, 231 xxt * 2, yyt, GrExt[HGrTerrain].Data.Canvas.Handle, xSrc, ySrc + yyt, 232 SRCPAINT); 233 for x := -2 to 6 do 234 BitBlt(LandMore.Canvas.Handle, (x + 2) * (xxt * 2), (y + 2) * yyt, 235 xxt * 2, yyt, DitherMask.Canvas.Handle, 0, 0, SRCAND); 192 236 end; 193 237 194 for x:=0 to 3 do for y:=0 to 3 do 238 for x := 0 to 3 do 239 for y := 0 to 3 do 240 begin 241 if (x = 1) and (y = 1) then 242 xSrc := 1 243 else 244 xSrc := (x mod 2) * (xxt * 2 + 1) + 1; 245 ySrc := 1 + yyt; 246 if (x >= 1) = (y >= 2) then 247 BitBlt(OceanPatch.Canvas.Handle, x * (xxt * 2), y * yyt, xxt * 2, yyt, 248 GrExt[HGrTerrain].Data.Canvas.Handle, xSrc, ySrc, SRCCOPY); 249 if (x >= 1) and ((y < 2) or (x >= 2)) then 250 begin 251 BitBlt(OceanPatch.Canvas.Handle, x * (xxt * 2), y * yyt, xxt, yyt, 252 GrExt[HGrTerrain].Data.Canvas.Handle, xSrc + xxt, ySrc + yyt, 253 SRCPAINT); 254 BitBlt(OceanPatch.Canvas.Handle, x * (xxt * 2) + xxt, y * yyt, xxt, yyt, 255 GrExt[HGrTerrain].Data.Canvas.Handle, xSrc, ySrc + yyt, SRCPAINT); 256 end; 257 BitBlt(OceanPatch.Canvas.Handle, x * (xxt * 2), y * yyt, xxt, yyt, 258 DitherMask.Canvas.Handle, xxt, yyt, SRCAND); 259 BitBlt(OceanPatch.Canvas.Handle, x * (xxt * 2) + xxt, y * yyt, xxt, yyt, 260 DitherMask.Canvas.Handle, 0, yyt, SRCAND); 261 end; 262 263 for y := 0 to 3 do 264 for x := 0 to 3 do 265 begin 266 if (x = 1) and (y = 1) then 267 xSrc := 1 268 else 269 xSrc := (y mod 2) * (xxt * 2 + 1) + 1; 270 ySrc := 1 + yyt; 271 if (x < 1) or (y >= 2) then 272 BitBlt(OceanMore.Canvas.Handle, x * (xxt * 2), y * yyt, xxt * 2, yyt, 273 GrExt[HGrTerrain].Data.Canvas.Handle, xSrc, ySrc, SRCCOPY); 274 if (x = 1) and (y < 2) or (x >= 2) and (y >= 1) then 275 begin 276 BitBlt(OceanMore.Canvas.Handle, x * (xxt * 2), y * yyt, xxt, yyt, 277 GrExt[HGrTerrain].Data.Canvas.Handle, xSrc + xxt, ySrc + yyt, 278 SRCPAINT); 279 BitBlt(OceanMore.Canvas.Handle, x * (xxt * 2) + xxt, y * yyt, xxt, yyt, 280 GrExt[HGrTerrain].Data.Canvas.Handle, xSrc, ySrc + yyt, SRCPAINT); 281 end; 282 BitBlt(OceanMore.Canvas.Handle, x * (xxt * 2), y * yyt, xxt * 2, yyt, 283 DitherMask.Canvas.Handle, 0, 0, SRCAND); 284 end; 285 286 BitBlt(DitherMask.Canvas.Handle, 0, 0, xxt * 2, yyt * 2, 287 DitherMask.Canvas.Handle, 0, 0, DSTINVERT); { invert dither mask } 288 BitBlt(DitherMask.Canvas.Handle, 0, 0, xxt * 2, yyt * 2, 289 GrExt[HGrTerrain].Mask.Canvas.Handle, 1, 1 + yyt, SRCPAINT); 290 291 for x := -1 to 6 do 292 for y := -2 to 6 do 293 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2), (y + 2) * yyt, 294 xxt * 2, yyt, DitherMask.Canvas.Handle, 0, 0, SRCAND); 295 296 for y := -1 to 6 do 297 for x := -2 to 7 do 298 BitBlt(LandMore.Canvas.Handle, (x + 2) * (xxt * 2) - xxt, (y + 2) * yyt, 299 xxt * 2, yyt, DitherMask.Canvas.Handle, 0, yyt, SRCAND); 300 301 BitBlt(LandPatch.Canvas.Handle, 0, 0, (xxt * 2) * 9, yyt * 9, 302 LandMore.Canvas.Handle, 0, 0, SRCPAINT); 303 304 for x := 0 to 3 do 305 for y := 0 to 3 do 306 BitBlt(OceanPatch.Canvas.Handle, x * (xxt * 2), y * yyt, xxt * 2, yyt, 307 DitherMask.Canvas.Handle, 0, 0, SRCAND); 308 309 for y := 0 to 3 do 310 for x := 0 to 4 do 311 BitBlt(OceanMore.Canvas.Handle, x * (xxt * 2) - xxt, y * yyt, xxt * 2, 312 yyt, DitherMask.Canvas.Handle, 0, yyt, SRCAND); 313 314 BitBlt(OceanPatch.Canvas.Handle, 0, 0, (xxt * 2) * 4, yyt * 4, 315 OceanMore.Canvas.Handle, 0, 0, SRCPAINT); 316 317 with DitherMask.Canvas do 195 318 begin 196 if (x=1) and (y=1) then xSrc:=1 197 else xSrc:=(x mod 2)*(xxt*2+1)+1; 198 ySrc:=1+yyt; 199 if (x>=1)=(y>=2) then 200 BitBlt(OceanPatch.Canvas.Handle,x*(xxt*2),y*yyt,xxt*2,yyt, 201 GrExt[HGrTerrain].Data.Canvas.Handle,xSrc,ySrc,SRCCOPY); 202 if (x>=1) and ((y<2) or (x>=2)) then 319 Brush.Color := $FFFFFF; 320 FillRect(Rect(0, 0, xxt * 2, yyt)); 321 end; 322 BitBlt(DitherMask.Canvas.Handle, 0, 0, xxt * 2, yyt, 323 GrExt[HGrTerrain].Mask.Canvas.Handle, 1, 1 + yyt, SRCCOPY); 324 325 for x := 0 to 6 do 326 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2), yyt, xxt * 2, yyt, 327 DitherMask.Canvas.Handle, 0, 0, SRCAND); 328 329 BitBlt(DitherMask.Canvas.Handle, 0, 0, xxt * 2, yyt, DitherMask.Canvas.Handle, 330 0, 0, DSTINVERT); 331 332 for y := 0 to 6 do 333 BitBlt(LandPatch.Canvas.Handle, xxt * 2, (y + 2) * yyt, xxt * 2, yyt, 334 DitherMask.Canvas.Handle, 0, 0, SRCAND); 335 336 LandMore.Free; 337 OceanMore.Free; 338 DitherMask.Free; 339 // LandPatch.Savetofile('landpatch.bmp'); 340 341 // reduce size of terrain icons 342 Mask24 := TBitmap.Create; 343 Mask24.Assign(GrExt[HGrTerrain].Mask); 344 Mask24.PixelFormat := pf24bit; 345 for ySrc := 0 to TerrainIconLines - 1 do 346 begin 347 for i := 0 to yyt * 3 - 1 do 348 MaskLine[i] := Mask24.ScanLine[1 + ySrc * (yyt * 3 + 1) + i]; 349 for xSrc := 0 to 9 - 1 do 203 350 begin 204 BitBlt(OceanPatch.Canvas.Handle,x*(xxt*2),y*yyt,xxt,yyt, 205 GrExt[HGrTerrain].Data.Canvas.Handle,xSrc+xxt,ySrc+yyt,SRCPAINT); 206 BitBlt(OceanPatch.Canvas.Handle,x*(xxt*2)+xxt,y*yyt,xxt,yyt, 207 GrExt[HGrTerrain].Data.Canvas.Handle,xSrc,ySrc+yyt,SRCPAINT); 208 end; 209 BitBlt(OceanPatch.Canvas.Handle,x*(xxt*2),y*yyt,xxt,yyt, 210 DitherMask.Canvas.Handle,xxt,yyt,SRCAND); 211 BitBlt(OceanPatch.Canvas.Handle,x*(xxt*2)+xxt,y*yyt,xxt,yyt, 212 DitherMask.Canvas.Handle,0,yyt,SRCAND); 213 end; 214 215 for y:=0 to 3 do for x:=0 to 3 do 216 begin 217 if (x=1) and (y=1) then xSrc:=1 218 else xSrc:=(y mod 2)*(xxt*2+1)+1; 219 ySrc:=1+yyt; 220 if (x<1) or (y>=2) then 221 BitBlt(OceanMore.Canvas.Handle,x*(xxt*2),y*yyt,xxt*2,yyt, 222 GrExt[HGrTerrain].Data.Canvas.Handle,xSrc,ySrc,SRCCOPY); 223 if (x=1) and (y<2) or (x>=2) and (y>=1) then 224 begin 225 BitBlt(OceanMore.Canvas.Handle,x*(xxt*2),y*yyt,xxt,yyt, 226 GrExt[HGrTerrain].Data.Canvas.Handle,xSrc+xxt,ySrc+yyt,SRCPAINT); 227 BitBlt(OceanMore.Canvas.Handle,x*(xxt*2)+xxt,y*yyt,xxt,yyt, 228 GrExt[HGrTerrain].Data.Canvas.Handle,xSrc,ySrc+yyt,SRCPAINT); 229 end; 230 BitBlt(OceanMore.Canvas.Handle,x*(xxt*2),y*yyt,xxt*2,yyt, 231 DitherMask.Canvas.Handle,0,0,SRCAND); 232 end; 233 234 BitBlt(DitherMask.Canvas.Handle,0,0,xxt*2,yyt*2, 235 DitherMask.Canvas.Handle,0,0,DSTINVERT); {invert dither mask} 236 BitBlt(DitherMask.Canvas.Handle,0,0,xxt*2,yyt*2, 237 GrExt[HGrTerrain].Mask.Canvas.Handle,1,1+yyt,SRCPAINT); 238 239 for x:=-1 to 6 do 240 for y:=-2 to 6 do 241 BitBlt(LandPatch.Canvas.Handle,(x+2)*(xxt*2),(y+2)*yyt,xxt*2,yyt, 242 DitherMask.Canvas.Handle,0,0,SRCAND); 243 244 for y:=-1 to 6 do 245 for x:=-2 to 7 do 246 BitBlt(LandMore.Canvas.Handle,(x+2)*(xxt*2)-xxt,(y+2)*yyt,xxt*2,yyt, 247 DitherMask.Canvas.Handle,0,yyt,SRCAND); 248 249 BitBlt(LandPatch.Canvas.Handle,0,0,(xxt*2)*9,yyt*9,LandMore.Canvas.Handle,0,0, 250 SRCPAINT); 251 252 for x:=0 to 3 do 253 for y:=0 to 3 do 254 BitBlt(OceanPatch.Canvas.Handle,x*(xxt*2),y*yyt,xxt*2,yyt, 255 DitherMask.Canvas.Handle,0,0,SRCAND); 256 257 for y:=0 to 3 do 258 for x:=0 to 4 do 259 BitBlt(OceanMore.Canvas.Handle,x*(xxt*2)-xxt,y*yyt,xxt*2,yyt, 260 DitherMask.Canvas.Handle,0,yyt,SRCAND); 261 262 BitBlt(OceanPatch.Canvas.Handle,0,0,(xxt*2)*4,yyt*4,OceanMore.Canvas.Handle,0,0, 263 SRCPAINT); 264 265 with DitherMask.Canvas do 266 begin 267 Brush.Color:=$FFFFFF; 268 FillRect(Rect(0,0,xxt*2,yyt)); 269 end; 270 BitBlt(DitherMask.Canvas.Handle,0,0,xxt*2,yyt, 271 GrExt[HGrTerrain].Mask.Canvas.Handle,1,1+yyt,SRCCOPY); 272 273 for x:=0 to 6 do 274 BitBlt(LandPatch.Canvas.Handle,(x+2)*(xxt*2),yyt,xxt*2,yyt, 275 DitherMask.Canvas.Handle,0,0,SRCAND); 276 277 BitBlt(DitherMask.Canvas.Handle,0,0,xxt*2,yyt, 278 DitherMask.Canvas.Handle,0,0,DSTINVERT); 279 280 for y:=0 to 6 do 281 BitBlt(LandPatch.Canvas.Handle,xxt*2,(y+2)*yyt,xxt*2,yyt, 282 DitherMask.Canvas.Handle,0,0,SRCAND); 283 284 LandMore.Free; OceanMore.Free; DitherMask.Free; 285 //LandPatch.Savetofile('landpatch.bmp'); 286 287 // reduce size of terrain icons 288 Mask24:=TBitmap.Create; 289 Mask24.Assign(GrExt[HGrTerrain].Mask); 290 Mask24.PixelFormat:=pf24bit; 291 for ySrc:=0 to TerrainIconLines-1 do 292 begin 293 for i:=0 to yyt*3-1 do 294 MaskLine[i]:=Mask24.ScanLine[1+ySrc*(yyt*3+1)+i]; 295 for xSrc:=0 to 9-1 do 296 begin 297 i:=ySrc*9+xSrc; 298 TSpriteSize[i].Left:=0; 299 repeat 300 Border:=true; 301 for y:=0 to yyt*3-1 do 302 if MaskLine[y]^[1+xSrc*(xxt*2+1)+TSpriteSize[i].Left,0]=0 then 303 Border:=false; 304 if Border then inc(TSpriteSize[i].Left) 305 until not Border or (TSpriteSize[i].Left=xxt*2-1); 306 TSpriteSize[i].Top:=0; 307 repeat 308 Border:=true; 309 for x:=0 to xxt*2-1 do 310 if MaskLine[TSpriteSize[i].Top]^[1+xSrc*(xxt*2+1)+x,0]=0 then 311 Border:=false; 312 if Border then inc(TSpriteSize[i].Top) 313 until not Border or (TSpriteSize[i].Top=yyt*3-1); 314 TSpriteSize[i].Right:=xxt*2; 315 repeat 316 Border:=true; 317 for y:=0 to yyt*3-1 do 318 if MaskLine[y]^[xSrc*(xxt*2+1)+TSpriteSize[i].Right,0]=0 then 319 Border:=false; 320 if Border then dec(TSpriteSize[i].Right) 321 until not Border or (TSpriteSize[i].Right=TSpriteSize[i].Left); 322 TSpriteSize[i].Bottom:=yyt*3; 323 repeat 324 Border:=true; 325 for x:=0 to xxt*2-1 do 326 if MaskLine[TSpriteSize[i].Bottom-1]^[1+xSrc*(xxt*2+1)+x,0]=0 then 327 Border:=false; 328 if Border then dec(TSpriteSize[i].Bottom) 329 until not Border or (TSpriteSize[i].Bottom=TSpriteSize[i].Top); 330 end 331 end; 332 Mask24.Free; 333 334 if Borders<>nil then 335 Borders.Free; 336 Borders:=TBitmap.Create; 337 Borders.PixelFormat:=pf24bit; 338 Borders.Width:=xxt*2; Borders.Height:=(yyt*2)*nPl; 339 BordersOK:=0; 340 end; 341 342 procedure Done; 343 begin 344 NoMap.Free; 345 NoMap:=nil; 346 LandPatch.Free; 347 LandPatch:=nil; 348 OceanPatch.Free; 349 OceanPatch:=nil; 350 Borders.Free; 351 Borders:=nil; 352 end; 353 354 procedure Reset; 355 begin 356 BordersOK:=0; 357 end; 358 359 constructor TIsoMap.Create; 360 begin 361 inherited; 362 FLeft:=0; 363 FTop:=0; 364 FRight:=0; 365 FBottom:=0; 366 AttLoc:=-1; 367 DefLoc:=-1; 368 FAdviceLoc:=-1; 369 end; 370 371 procedure TIsoMap.SetOutput(Output: TBitmap); 372 begin 373 FOutput:=Output; 374 FLeft:=0; 375 FTop:=0; 376 FRight:=FOutput.Width; 377 FBottom:=FOutput.Height; 378 end; 379 380 procedure TIsoMap.SetPaintBounds(Left, Top, Right, Bottom: integer); 381 begin 382 FLeft:=Left; FTop:=Top; FRight:=Right; FBottom:=Bottom; 383 end; 384 385 procedure TIsoMap.FillRect(x,y,Width,Height,Color: integer); 386 begin 387 if x<FLeft then 388 begin Width:=Width-(FLeft-x); x:=FLeft end; 389 if y<FTop then 390 begin Height:=Height-(FTop-y); y:=FTop end; 391 if x+Width>=FRight then Width:=FRight-x; 392 if y+Height>=FBottom then Height:=FBottom-y; 393 if (Width<=0) or (Height<=0) then 394 exit; 395 396 with FOutput.Canvas do 397 begin 398 Brush.Color:=Color; 399 FillRect(Rect(x,y,x+Width,y+Height)); 400 Brush.Style:=bsClear; 401 end 402 end; 403 404 procedure TIsoMap.Textout(x,y,Color: integer; const s: string); 405 begin 406 FOutput.Canvas.Font.Color:=Color; 407 FOutput.Canvas.TextRect(Rect(FLeft,FTop,FRight,FBottom), x, y, s) 408 end; 409 410 procedure TIsoMap.BitBlt(Src: TBitmap; x,y,Width,Height,xSrc,ySrc,Rop: integer); 411 begin 412 if x<FLeft then 413 begin Width:=Width-(FLeft-x); xSrc:=xSrc+(FLeft-x); x:=FLeft end; 414 if y<FTop then 415 begin Height:=Height-(FTop-y); ySrc:=ySrc+(FTop-y); y:=FTop end; 416 if x+Width>=FRight then Width:=FRight-x; 417 if y+Height>=FBottom then Height:=FBottom-y; 418 if (Width<=0) or (Height<=0) then 419 exit; 420 421 Windows.BitBlt(FOutput.Canvas.Handle,x,y,Width,Height,Src.Canvas.Handle,xSrc, 422 ySrc,Rop); 423 end; 424 425 procedure TIsoMap.Sprite(HGr,xDst,yDst,Width,Height,xGr,yGr: integer); 426 begin 427 BitBlt(GrExt[HGr].Mask,xDst,yDst,Width,Height,xGr,yGr,SRCAND); 428 BitBlt(GrExt[HGr].Data,xDst,yDst,Width,Height,xGr,yGr,SRCPAINT); 429 end; 430 431 procedure TIsoMap.TSprite(xDst,yDst,grix: integer; PureBlack: boolean = false); 432 var 433 Width, Height, xSrc, ySrc: integer; 434 begin 435 Width:=TSpriteSize[grix].Right-TSpriteSize[grix].Left; 436 Height:=TSpriteSize[grix].Bottom-TSpriteSize[grix].Top; 437 xSrc:=1+grix mod 9 *(xxt*2+1)+TSpriteSize[grix].Left; 438 ySrc:=1+grix div 9 *(yyt*3+1)+TSpriteSize[grix].Top; 439 xDst:=xDst+TSpriteSize[grix].Left; 440 yDst:=yDst-yyt+TSpriteSize[grix].Top; 441 if xDst<FLeft then 442 begin Width:=Width-(FLeft-xDst); xSrc:=xSrc+(FLeft-xDst); xDst:=FLeft end; 443 if yDst<FTop then 444 begin Height:=Height-(FTop-yDst); ySrc:=ySrc+(FTop-yDst); yDst:=FTop end; 445 if xDst+Width>=FRight then Width:=FRight-xDst; 446 if yDst+Height>=FBottom then Height:=FBottom-yDst; 447 if (Width<=0) or (Height<=0) then 448 exit; 449 450 Windows.BitBlt(OutDC,xDst,yDst,Width,Height,MaskDC,xSrc,ySrc,SRCAND); 451 if not PureBlack then 452 Windows.BitBlt(OutDC,xDst,yDst,Width,Height,DataDC,xSrc,ySrc,SRCPAINT); 453 end; 454 455 procedure TIsoMap.PaintUnit(x,y:integer;const UnitInfo:TUnitInfo;Status:integer); 456 var 457 xsh,ysh,xGr,yGr,j,mixShow: integer; 458 begin 459 with UnitInfo do if (Owner=me) or (emix<>$FFFF) then 460 begin 461 if Job=jCity then mixShow:=-1 // building site 462 else mixShow:=mix; 463 if (Tribe[Owner].ModelPicture[mixShow].HGr=0) and (@OnInitEnemyModel<>nil) then 464 if not OnInitEnemyModel(emix) then 465 exit; 466 xsh:=Tribe[Owner].ModelPicture[mixShow].xShield; 467 ysh:=Tribe[Owner].ModelPicture[mixShow].yShield; 468 {$IFNDEF SCR}if Status and usStay<>0 then j:=19 469 else if Status and usRecover<>0 then j:=16 470 else if Status and (usGoto or usEnhance)=usGoto or usEnhance then j:=18 471 else if Status and usEnhance<>0 then j:=17 472 else if Status and usGoto<>0 then j:=20 473 else{$ENDIF} if Job=jCity then j:=jNone 474 else j:=Job; 475 if Flags and unMulti<>0 then 476 Sprite(Tribe[Owner].symHGr,x+xsh-1+4,y+ysh-2,14,12, 477 33+Tribe[Owner].sympix mod 10 *65,1+Tribe[Owner].sympix div 10 *49); 478 Sprite(Tribe[Owner].symHGr,x+xsh-1,y+ysh-2,14,12, 479 18+Tribe[Owner].sympix mod 10 *65,1+Tribe[Owner].sympix div 10 *49); 480 FillRect(x+xsh,y+ysh+5,1+Health*11 div 100,3,ColorOfHealth(Health)); 481 if j>0 then 482 begin 483 xGr:=121+j mod 7 *9; yGr:=1+j div 7 *9; 484 BitBlt(GrExt[HGrSystem].Mask,x+xsh+3,y+ysh+9,8,8,xGr,yGr,SRCAND); 485 Sprite(HGrSystem,x+xsh+2,y+ysh+8,8,8,xGr,yGr); 486 end; 487 with Tribe[Owner].ModelPicture[mixShow] do 488 Sprite(HGr,x,y,64,48,pix mod 10 *65+1,pix div 10 *49+1); 489 if Flags and unFortified<>0 then 490 begin 491 { OutDC:=FOutput.Canvas.Handle; 492 DataDC:=GrExt[HGrTerrain].Data.Canvas.Handle; 493 MaskDC:=GrExt[HGrTerrain].Mask.Canvas.Handle; 494 TSprite(x,y+16,12*9+7);} 495 Sprite(HGrStdUnits,x,y,xxu*2,yyu*2,1+6*(xxu*2+1),1); 496 end 497 end 498 end;{PaintUnit} 499 500 procedure TIsoMap.PaintCity(x,y:integer; const CityInfo:TCityInfo; 501 accessory: boolean); 502 var 503 age,cHGr,cpix,xGr,xShield,yShield,LabelTextColor,LabelLength: integer; 504 cpic:TCityPicture; 505 s:string; 506 begin 507 age:=GetAge(CityInfo.Owner); 508 if CityInfo.Size<5 then xGr:=0 509 else if CityInfo.Size<9 then xGr:=1 510 else if CityInfo.Size<13 then xGr:=2 511 else xGr:=3; 512 Tribe[CityInfo.Owner].InitAge(age); 513 if age<2 then 514 begin 515 cHGr:=Tribe[CityInfo.Owner].cHGr; 516 cpix:=Tribe[CityInfo.Owner].cpix; 517 if (ciWalled and CityInfo.Flags=0) 518 or (GrExt[cHGr].Data.Canvas.Pixels[(xGr+4)*65,cpix*49+48]=$00FFFF) then 519 Sprite(cHGr,x-xxc,y-2*yyc,xxc*2,yyc*3,xGr*(xxc*2+1)+1,1+cpix*(yyc*3+1)); 520 if ciWalled and CityInfo.Flags<>0 then 521 Sprite(cHGr,x-xxc,y-2*yyc,xxc*2,yyc*3,(xGr+4)*(xxc*2+1)+1,1+cpix*(yyc*3+1)); 522 end 523 else 524 begin 525 if ciWalled and CityInfo.Flags<>0 then 526 Sprite(HGrCities,x-xxt,y-2*yyt,2*xxt,3*yyt,(xGr+4)*(2*xxt+1)+1,1+(age-2)*(3*yyt+1)) 527 else Sprite(HGrCities,x-xxt,y-2*yyt,2*xxt,3*yyt,xGr*(2*xxt+1)+1,1+(age-2)*(3*yyt+1)); 528 end; 529 530 if not Accessory then exit; 531 532 {if ciCapital and CityInfo.Flags<>0 then 533 Sprite(Tribe[CityInfo.Owner].symHGr,x+cpic.xf,y-13+cpic.yf,13,14, 534 1+Tribe[CityInfo.Owner].sympix mod 10 *65, 535 1+Tribe[CityInfo.Owner].sympix div 10 *49); {capital -- paint flag} 536 537 if MyMap[CityInfo.Loc] and fObserved<>0 then 538 begin 539 if age<2 then 540 begin 541 cpic:=Tribe[CityInfo.Owner].CityPicture[xGr]; 542 xShield:=x-xxc+cpic.xShield; 543 yShield:=y-2*yyc+cpic.yShield; 544 end 545 else 546 begin 547 cpic:=CitiesPictures[age,xGr]; 548 xShield:=x-xxt+cpic.xShield; 549 yShield:=y-2*yyt+cpic.yShield; 550 end; 551 s:=IntToStr(CityInfo.Size); 552 LabelLength:=FOutput.Canvas.TextWidth(s); 553 FillRect(xShield,yShield,LabelLength+4,16,$000000); 554 if MyMap[CityInfo.Loc] and (fUnit or fObserved)=fObserved then 555 // empty city 556 LabelTextColor:=Tribe[CityInfo.Owner].Color 557 else 558 begin 559 FillRect(xShield+1,yShield+1,LabelLength+2,14,Tribe[CityInfo.Owner].Color); 560 LabelTextColor:=$000000; 561 end; 562 Textout(xShield+2,yShield-1,LabelTextColor,s); 563 end 564 end;{PaintCity} 565 566 function PoleTile(Loc: integer): integer; 567 begin {virtual pole tile} 568 result:=fUNKNOWN; 569 if Loc<-2*G.lx then 570 else if Loc<-G.lx then 571 begin 572 if (MyMap[dLoc(Loc,0,2)] and fTerrain<>fUNKNOWN) 573 and (MyMap[dLoc(Loc,-2,2)] and fTerrain<>fUNKNOWN) 574 and (MyMap[dLoc(Loc,2,2)] and fTerrain<>fUNKNOWN) then result:=fArctic; 575 if (MyMap[dLoc(Loc,0,2)] and fObserved<>0) 576 and (MyMap[dLoc(Loc,-2,2)] and fObserved<>0) 577 and (MyMap[dLoc(Loc,2,2)] and fObserved<>0) then 578 result:=result or fObserved 579 end 580 else if Loc<0 then 581 begin 582 if (MyMap[dLoc(Loc,-1,1)] and fTerrain<>fUNKNOWN) 583 and (MyMap[dLoc(Loc,1,1)] and fTerrain<>fUNKNOWN) then result:=fArctic; 584 if (MyMap[dLoc(Loc,-1,1)] and fObserved<>0) 585 and (MyMap[dLoc(Loc,1,1)] and fObserved<>0) then 586 result:=result or fObserved 587 end 588 else if Loc<G.lx*(G.ly+1) then 589 begin 590 if (MyMap[dLoc(Loc,-1,-1)] and fTerrain<>fUNKNOWN) 591 and (MyMap[dLoc(Loc,1,-1)] and fTerrain<>fUNKNOWN) then result:=fArctic; 592 if (MyMap[dLoc(Loc,-1,-1)] and fObserved<>0) 593 and (MyMap[dLoc(Loc,1,-1)] and fObserved<>0) then 594 result:=result or fObserved 595 end 596 else if Loc<G.lx*(G.ly+2) then 597 begin 598 if (MyMap[dLoc(Loc,0,-2)] and fTerrain<>fUNKNOWN) 599 and (MyMap[dLoc(Loc,-2,-2)] and fTerrain<>fUNKNOWN) 600 and (MyMap[dLoc(Loc,2,-2)] and fTerrain<>fUNKNOWN) then result:=fArctic; 601 if (MyMap[dLoc(Loc,0,-2)] and fObserved<>0) 602 and (MyMap[dLoc(Loc,-2,-2)] and fObserved<>0) 603 and (MyMap[dLoc(Loc,2,-2)] and fObserved<>0) then 604 result:=result or fObserved 605 end 606 end; 607 608 const 609 Dirx: array[0..7] of integer=(1,2,1,0,-1,-2,-1,0); 610 Diry: array[0..7] of integer=(-1,0,1,2,1,0,-1,-2); 611 612 function TIsoMap.Connection4(Loc,Mask,Value:integer):integer; 613 begin 614 result:=0; 615 if dLoc(Loc,1,-1)>=0 then 616 begin 617 if MyMap[dLoc(Loc,1,-1)] and Mask=Cardinal(Value) then inc(result,1); 618 if MyMap[dLoc(Loc,-1,-1)] and Mask=Cardinal(Value) then inc(result,8); 619 end; 620 if dLoc(Loc,1,1)<G.lx*G.ly then 621 begin 622 if MyMap[dLoc(Loc,1,1)] and Mask=Cardinal(Value) then inc(result,2); 623 if MyMap[dLoc(Loc,-1,1)] and Mask=Cardinal(Value) then inc(result,4); 624 end 625 end; 626 627 function TIsoMap.Connection8(Loc,Mask:integer):integer; 628 var 629 Dir, ConnLoc: integer; 630 begin 631 result:=0; 632 for Dir:=0 to 7 do 633 begin 634 ConnLoc:=dLoc(Loc,Dirx[Dir],Diry[Dir]); 635 if (ConnLoc>=0) and (ConnLoc<G.lx*G.ly) and (MyMap[ConnLoc] and Mask<>0) then 636 inc(result,1 shl Dir); 637 end 638 end; 639 640 function TIsoMap.OceanConnection(Loc: integer): integer; 641 var 642 Dir,ConnLoc: integer; 643 begin 644 result:=0; 645 for Dir:=0 to 7 do 646 begin 647 ConnLoc:=dLoc(Loc,Dirx[Dir],Diry[Dir]); 648 if (ConnLoc<0) or (ConnLoc>=G.lx*G.ly) 649 or ((MyMap[ConnLoc]-2) and fTerrain<13) then 650 inc(result,1 shl Dir); 651 end 652 end; 653 654 procedure TIsoMap.PaintShore(x,y,Loc:integer); 655 var 656 Conn,Tile:integer; 657 begin 658 if (y<=FTop-yyt*2) or (y>FBottom) or (x<=FLeft-xxt*2) or (x>FRight) then exit; 659 if (Loc<0) or (Loc>=G.lx*G.ly) then exit; 660 Tile:=MyMap[Loc]; 661 if Tile and fTerrain>=fGrass then exit; 662 Conn:=OceanConnection(Loc); 663 if Conn=0 then exit; 664 665 BitBlt(GrExt[HGrTerrain].Data,x+xxt div 2,y,xxt,yyt, 666 1+(Conn shr 6 +Conn and 1 shl 2)*(xxt*2+1), 667 1+yyt+(16+Tile and fTerrain)*(yyt*3+1),SRCPAINT); 668 BitBlt(GrExt[HGrTerrain].Data,x+xxt,y+yyt div 2,xxt,yyt, 669 1+(Conn and 7)*(xxt*2+1)+xxt, 670 1+yyt*2+(16+Tile and fTerrain)*(yyt*3+1),SRCPAINT); 671 BitBlt(GrExt[HGrTerrain].Data,x+xxt div 2,y+yyt,xxt,yyt, 672 1+(Conn shr 2 and 7)*(xxt*2+1)+xxt, 673 1+yyt+(16+Tile and fTerrain)*(yyt*3+1),SRCPAINT); 674 BitBlt(GrExt[HGrTerrain].Data,x,y+yyt div 2,xxt,yyt, 675 1+(Conn shr 4 and 7)*(xxt*2+1), 676 1+yyt*2+(16+Tile and fTerrain)*(yyt*3+1),SRCPAINT); 677 Conn:=Connection4(Loc,fTerrain,fUNKNOWN); {dither to black} 678 if Conn and 1<>0 then 679 BitBlt(GrExt[HGrTerrain].Mask,x+xxt,y,xxt,yyt,1+7*(xxt*2+1)+xxt, 680 1+yyt+15*(yyt*3+1),SRCAND); 681 if Conn and 2<>0 then 682 BitBlt(GrExt[HGrTerrain].Mask,x+xxt,y+yyt,xxt,yyt,1+7*(xxt*2+1)+xxt, 683 1+yyt*2+15*(yyt*3+1),SRCAND); 684 if Conn and 4<>0 then 685 BitBlt(GrExt[HGrTerrain].Mask,x,y+yyt,xxt,yyt,1+7*(xxt*2+1), 686 1+yyt*2+15*(yyt*3+1),SRCAND); 687 if Conn and 8<>0 then 688 BitBlt(GrExt[HGrTerrain].Mask,x,y,xxt,yyt,1+7*(xxt*2+1), 689 1+yyt+15*(yyt*3+1),SRCAND); 690 end; 691 692 procedure TIsoMap.PaintTileExtraTerrain(x,y,Loc: integer); 693 var 694 Dir,Conn,RRConn,yGr,Tile,yLoc:integer; 695 begin 696 if (Loc<0) or (Loc>=G.lx*G.ly) or (y<=-yyt*2) or (y>FOutput.Height) 697 or (x<=-xxt*2) or (x>FOutput.Width) then exit; 698 Tile:=MyMap[Loc]; 699 if Tile and fTerrain=fForest then 700 begin 701 yLoc:=Loc div G.lx; 702 if IsJungle(yLoc) then yGr:=18 703 else yGr:=3; 704 Conn:=Connection4(Loc,fTerrain,Tile and fTerrain); 705 if (yLoc=(G.ly-2) div 4) or (G.ly-1-yLoc=(G.ly+2) div 4) then 706 Conn:=Conn and not 6 // no connection to south 707 else if (yLoc=(G.ly+2) div 4) or (G.ly-1-yLoc=(G.ly-2) div 4) then 708 Conn:=Conn and not 9; // no connection to north 709 TSprite(x,y,Conn mod 8+(yGr+Conn div 8)*9); 710 end 711 else if Tile and fTerrain in [fHills,fMountains,fForest] then 712 begin 713 yGr:=3+2*(Tile and fTerrain-fForest); 714 Conn:=Connection4(Loc,fTerrain,Tile and fTerrain); 715 TSprite(x,y,Conn mod 8+(yGr+Conn div 8)*9); 716 end 717 else if Tile and fDeadLands<>0 then 718 TSprite(x,y,2*9+6); 719 720 if ShowObjects then 721 begin 722 if Tile and fTerImp=tiFarm then TSprite(x,y,109) {farmland} 723 else if Tile and fTerImp=tiIrrigation then TSprite(x,y,108); // irrigation 724 end; 725 if Tile and fRiver<>0 then 726 begin 727 Conn:=Connection4(Loc,fRiver,fRiver) or Connection4(Loc,fTerrain,fShore) 728 or Connection4(Loc,fTerrain,fUNKNOWN); 729 TSprite(x,y,Conn mod 8+(13+Conn div 8)*9); 730 end; 731 732 if Tile and fTerrain<fGrass then 733 begin 734 Conn:=Connection4(Loc,fRiver,fRiver); 735 for Dir:=0 to 3 do if Conn and (1 shl Dir)<>0 then {river mouths} 736 TSprite(x,y,15*9+Dir); 737 if ShowObjects then 738 begin 739 Conn:=Connection8(Loc,fCanal); 740 for Dir:=0 to 7 do if Conn and (1 shl Dir)<>0 then {canal mouths} 741 TSprite(x,y,20*9+1+Dir); 742 end 743 end; 744 745 if ShowObjects then 746 begin 747 if (Tile and fCanal<>0) or (Tile and fCity<>0) then 748 begin // paint canal connections 749 Conn:=Connection8(Loc,fCanal or fCity); 750 if Tile and fCanal<>0 then Conn:=Conn or ($FF-OceanConnection(Loc)); 751 if Conn=0 then 752 begin 753 if Tile and fCanal<>0 then TSprite(x,y,99) 754 end 755 else for Dir:=0 to 7 do if (1 shl Dir) and Conn<>0 then 756 TSprite(x,y,100+Dir); 757 end; 758 if Tile and (fRR or fCity)<>0 then RRConn:=Connection8(Loc,fRR or fCity) 759 else RRConn:=0; 760 if Tile and (fRoad or fRR or fCity)<>0 then 761 begin // paint road connections 762 Conn:=Connection8(Loc,fRoad or fRR or fCity) and not RRConn; 763 if (Conn=0) and (Tile and (fRR or fCity)=0) then TSprite(x,y,81) 764 else if Conn>0 then 765 for Dir:=0 to 7 do if (1 shl Dir) and Conn<>0 then TSprite(x,y,82+Dir); 766 end; 767 // paint railroad connections 768 if (Tile and fRR<>0) and (RRConn=0) then TSprite(x,y,90) 769 else if RRConn>0 then 770 for Dir:=0 to 7 do if (1 shl Dir) and RRConn<>0 then TSprite(x,y,91+Dir); 771 end; 772 end; 773 774 // (x,y) is top left pixel of (2*xxt,3*yyt) rectangle 775 procedure TIsoMap.PaintTileObjects(x,y,Loc,CityLoc,CityOwner:integer; 776 UseBlink: boolean); 777 type 778 TLine=array[0..9*65,0..2] of Byte; 779 var 780 p1,p2,uix,cix,dy,Loc1,Tile,Multi,Destination: integer; 781 CityInfo:TCityInfo; 782 UnitInfo:TUnitInfo; 783 fog: boolean; 784 785 procedure NameCity; 786 var 787 cix,xs,w: integer; 788 BehindCityInfo:TCityInfo; 789 s: string; 790 IsCapital: boolean; 791 begin 792 BehindCityInfo.Loc:=Loc-2*G.lx; 793 if ShowCityNames and (Options and (1 shl moEditMode)=0) 794 and (BehindCityInfo.Loc>=0) and (BehindCityInfo.Loc<G.lx*G.ly) 795 and (MyMap[BehindCityInfo.Loc] and fCity<>0) then 796 begin 797 GetCityInfo(BehindCityInfo.Loc,cix,BehindCityInfo); 798 IsCapital:= BehindCityInfo.Flags and ciCapital<>0; 799 {if Showuix and (cix>=0) then s:=IntToStr(cix) 800 else} s:=CityName(BehindCityInfo.ID); 801 w:=FOutput.Canvas.TextWidth(s); 802 xs:=x+xxt-(w+1) div 2; 803 if IsCapital then 804 FOutput.Canvas.Font.Style:=FOutput.Canvas.Font.Style+[fsUnderline]; 805 Textout(xs+1,y-9,$000000,s); 806 Textout(xs,y-10,$FFFFFF,s); 807 if IsCapital then 808 FOutput.Canvas.Font.Style:=FOutput.Canvas.Font.Style-[fsUnderline]; 809 end; 810 end; 811 812 procedure ShowSpacePort; 813 begin 814 if ShowObjects and (Options and (1 shl moEditMode)=0) and (Tile and fCity<>0) 815 and (CityInfo.Flags and ciSpacePort<>0) then 816 TSprite(x+xxt,y-6,12*9+5); 817 end; 818 819 procedure PaintBorder; 820 var 821 dx,dy: integer; 822 Line: ^TLine; 823 begin 824 if ShowBorder and (Loc>=0) and (Loc<G.lx*G.ly) 825 and (Tile and fTerrain<>fUNKNOWN) then 826 begin 827 p1:=MyRO.Territory[Loc]; 828 if (p1>=0) and (ShowMyBorder or (p1<>me)) then 829 begin 830 if BordersOK and (1 shl p1)=0 then 831 begin 832 Windows.BitBlt(Borders.Canvas.Handle,0,p1*(yyt*2),xxt*2,yyt*2, 833 GrExt[HGrTerrain].Data.Canvas.Handle,1+8*(xxt*2+1),1+yyt+16*(yyt*3+1),SRCCOPY); 834 for dy:=0 to yyt*2-1 do 835 begin 836 Line:=Borders.ScanLine[p1*(yyt*2)+dy]; 837 for dx:=0 to xxt*2-1 do if Line[dx,0]=99 then 351 i := ySrc * 9 + xSrc; 352 TSpriteSize[i].Left := 0; 353 repeat 354 Border := true; 355 for y := 0 to yyt * 3 - 1 do 356 if MaskLine[y]^[1 + xSrc * (xxt * 2 + 1) + TSpriteSize[i].Left, 0] = 0 357 then 358 Border := false; 359 if Border then 360 inc(TSpriteSize[i].Left) until not Border or 361 (TSpriteSize[i].Left = xxt * 2 - 1); 362 TSpriteSize[i].Top := 0; 363 repeat 364 Border := true; 365 for x := 0 to xxt * 2 - 1 do 366 if MaskLine[TSpriteSize[i].Top]^[1 + xSrc * (xxt * 2 + 1) + x, 0] = 0 367 then 368 Border := false; 369 if Border then 370 inc(TSpriteSize[i].Top) until not Border or 371 (TSpriteSize[i].Top = yyt * 3 - 1); 372 TSpriteSize[i].Right := xxt * 2; 373 repeat 374 Border := true; 375 for y := 0 to yyt * 3 - 1 do 376 if MaskLine[y]^[xSrc * (xxt * 2 + 1) + TSpriteSize[i].Right, 0] = 0 377 then 378 Border := false; 379 if Border then 380 dec(TSpriteSize[i].Right) until not Border or 381 (TSpriteSize[i].Right = TSpriteSize[i].Left); 382 TSpriteSize[i].Bottom := yyt * 3; 383 repeat 384 Border := true; 385 for x := 0 to xxt * 2 - 1 do 386 if MaskLine[TSpriteSize[i].Bottom - 1]^ 387 [1 + xSrc * (xxt * 2 + 1) + x, 0] = 0 then 388 Border := false; 389 if Border then 390 dec(TSpriteSize[i].Bottom) until not Border or 391 (TSpriteSize[i].Bottom = TSpriteSize[i].Top); 392 end 393 end; 394 Mask24.Free; 395 396 if Borders <> nil then 397 Borders.Free; 398 Borders := TBitmap.Create; 399 Borders.PixelFormat := pf24bit; 400 Borders.Width := xxt * 2; 401 Borders.Height := (yyt * 2) * nPl; 402 BordersOK := 0; 403 end; 404 405 procedure Done; 406 begin 407 NoMap.Free; 408 NoMap := nil; 409 LandPatch.Free; 410 LandPatch := nil; 411 OceanPatch.Free; 412 OceanPatch := nil; 413 Borders.Free; 414 Borders := nil; 415 end; 416 417 procedure Reset; 418 begin 419 BordersOK := 0; 420 end; 421 422 constructor TIsoMap.Create; 423 begin 424 inherited; 425 FLeft := 0; 426 FTop := 0; 427 FRight := 0; 428 FBottom := 0; 429 AttLoc := -1; 430 DefLoc := -1; 431 FAdviceLoc := -1; 432 end; 433 434 procedure TIsoMap.SetOutput(Output: TBitmap); 435 begin 436 FOutput := Output; 437 FLeft := 0; 438 FTop := 0; 439 FRight := FOutput.Width; 440 FBottom := FOutput.Height; 441 end; 442 443 procedure TIsoMap.SetPaintBounds(Left, Top, Right, Bottom: integer); 444 begin 445 FLeft := Left; 446 FTop := Top; 447 FRight := Right; 448 FBottom := Bottom; 449 end; 450 451 procedure TIsoMap.FillRect(x, y, Width, Height, Color: integer); 452 begin 453 if x < FLeft then 454 begin 455 Width := Width - (FLeft - x); 456 x := FLeft 457 end; 458 if y < FTop then 459 begin 460 Height := Height - (FTop - y); 461 y := FTop 462 end; 463 if x + Width >= FRight then 464 Width := FRight - x; 465 if y + Height >= FBottom then 466 Height := FBottom - y; 467 if (Width <= 0) or (Height <= 0) then 468 exit; 469 470 with FOutput.Canvas do 471 begin 472 Brush.Color := Color; 473 FillRect(Rect(x, y, x + Width, y + Height)); 474 Brush.Style := bsClear; 475 end 476 end; 477 478 procedure TIsoMap.Textout(x, y, Color: integer; const s: string); 479 begin 480 FOutput.Canvas.Font.Color := Color; 481 FOutput.Canvas.TextRect(Rect(FLeft, FTop, FRight, FBottom), x, y, s) 482 end; 483 484 procedure TIsoMap.BitBlt(Src: TBitmap; x, y, Width, Height, xSrc, ySrc, 485 Rop: integer); 486 begin 487 if x < FLeft then 488 begin 489 Width := Width - (FLeft - x); 490 xSrc := xSrc + (FLeft - x); 491 x := FLeft 492 end; 493 if y < FTop then 494 begin 495 Height := Height - (FTop - y); 496 ySrc := ySrc + (FTop - y); 497 y := FTop 498 end; 499 if x + Width >= FRight then 500 Width := FRight - x; 501 if y + Height >= FBottom then 502 Height := FBottom - y; 503 if (Width <= 0) or (Height <= 0) then 504 exit; 505 506 Windows.BitBlt(FOutput.Canvas.Handle, x, y, Width, Height, 507 Src.Canvas.Handle, xSrc, ySrc, Rop); 508 end; 509 510 procedure TIsoMap.Sprite(HGr, xDst, yDst, Width, Height, xGr, 511 yGr: integer); 512 begin 513 BitBlt(GrExt[HGr].Mask, xDst, yDst, Width, Height, xGr, yGr, SRCAND); 514 BitBlt(GrExt[HGr].Data, xDst, yDst, Width, Height, xGr, yGr, 515 SRCPAINT); 516 end; 517 518 procedure TIsoMap.TSprite(xDst, yDst, grix: integer; 519 PureBlack: boolean = false); 520 var 521 Width, Height, xSrc, ySrc: integer; 522 begin 523 Width := TSpriteSize[grix].Right - TSpriteSize[grix].Left; 524 Height := TSpriteSize[grix].Bottom - TSpriteSize[grix].Top; 525 xSrc := 1 + grix mod 9 * (xxt * 2 + 1) + TSpriteSize[grix].Left; 526 ySrc := 1 + grix div 9 * (yyt * 3 + 1) + TSpriteSize[grix].Top; 527 xDst := xDst + TSpriteSize[grix].Left; 528 yDst := yDst - yyt + TSpriteSize[grix].Top; 529 if xDst < FLeft then 530 begin 531 Width := Width - (FLeft - xDst); 532 xSrc := xSrc + (FLeft - xDst); 533 xDst := FLeft 534 end; 535 if yDst < FTop then 536 begin 537 Height := Height - (FTop - yDst); 538 ySrc := ySrc + (FTop - yDst); 539 yDst := FTop 540 end; 541 if xDst + Width >= FRight then 542 Width := FRight - xDst; 543 if yDst + Height >= FBottom then 544 Height := FBottom - yDst; 545 if (Width <= 0) or (Height <= 0) then 546 exit; 547 548 Windows.BitBlt(OutDC, xDst, yDst, Width, Height, MaskDC, xSrc, 549 ySrc, SRCAND); 550 if not PureBlack then 551 Windows.BitBlt(OutDC, xDst, yDst, Width, Height, DataDC, xSrc, ySrc, 552 SRCPAINT); 553 end; 554 555 procedure TIsoMap.PaintUnit(x, y: integer; const UnitInfo: TUnitInfo; 556 Status: integer); 557 var 558 xsh, ysh, xGr, yGr, j, mixShow: integer; 559 begin 560 with UnitInfo do 561 if (Owner = me) or (emix <> $FFFF) then 838 562 begin 839 Line[dx,0]:=Tribe[p1].Color shr 16 and $FF; 840 Line[dx,1]:=Tribe[p1].Color shr 8 and $FF; 841 Line[dx,2]:=Tribe[p1].Color and $FF; 563 if Job = jCity then 564 mixShow := -1 // building site 565 else 566 mixShow := mix; 567 if (Tribe[Owner].ModelPicture[mixShow].HGr = 0) and 568 (@OnInitEnemyModel <> nil) then 569 if not OnInitEnemyModel(emix) then 570 exit; 571 xsh := Tribe[Owner].ModelPicture[mixShow].xShield; 572 ysh := Tribe[Owner].ModelPicture[mixShow].yShield; 573 {$IFNDEF SCR} if Status and usStay <> 0 then 574 j := 19 575 else if Status and usRecover <> 0 then 576 j := 16 577 else if Status and (usGoto or usEnhance) = usGoto or usEnhance 578 then 579 j := 18 580 else if Status and usEnhance <> 0 then 581 j := 17 582 else if Status and usGoto <> 0 then 583 j := 20 584 else {$ENDIF} if Job = jCity then 585 j := jNone 586 else 587 j := Job; 588 if Flags and unMulti <> 0 then 589 Sprite(Tribe[Owner].symHGr, x + xsh - 1 + 4, y + ysh - 2, 14, 590 12, 33 + Tribe[Owner].sympix mod 10 * 65, 591 1 + Tribe[Owner].sympix div 10 * 49); 592 Sprite(Tribe[Owner].symHGr, x + xsh - 1, y + ysh - 2, 14, 12, 593 18 + Tribe[Owner].sympix mod 10 * 65, 594 1 + Tribe[Owner].sympix div 10 * 49); 595 FillRect(x + xsh, y + ysh + 5, 1 + Health * 11 div 100, 3, 596 ColorOfHealth(Health)); 597 if j > 0 then 598 begin 599 xGr := 121 + j mod 7 * 9; 600 yGr := 1 + j div 7 * 9; 601 BitBlt(GrExt[HGrSystem].Mask, x + xsh + 3, y + ysh + 9, 8, 8, 602 xGr, yGr, SRCAND); 603 Sprite(HGrSystem, x + xsh + 2, y + ysh + 8, 8, 8, xGr, yGr); 604 end; 605 with Tribe[Owner].ModelPicture[mixShow] do 606 Sprite(HGr, x, y, 64, 48, pix mod 10 * 65 + 1, 607 pix div 10 * 49 + 1); 608 if Flags and unFortified <> 0 then 609 begin 610 { OutDC:=FOutput.Canvas.Handle; 611 DataDC:=GrExt[HGrTerrain].Data.Canvas.Handle; 612 MaskDC:=GrExt[HGrTerrain].Mask.Canvas.Handle; 613 TSprite(x,y+16,12*9+7); } 614 Sprite(HGrStdUnits, x, y, xxu * 2, yyu * 2, 615 1 + 6 * (xxu * 2 + 1), 1); 616 end 842 617 end 843 end; 844 BordersOK:=BordersOK or 1 shl p1; 845 end; 846 for dy:=0 to 1 do for dx:=0 to 1 do 847 begin 848 Loc1:=dLoc(Loc,dx*2-1,dy*2-1); 849 begin 850 if (Loc1<0) or (Loc1>=G.lx*G.ly) then p2:=-1 851 else if MyMap[Loc1] and fTerrain=fUNKNOWN then 852 p2:=p1 853 else p2:=MyRO.Territory[Loc1]; 854 if p2<>p1 then 618 end; { PaintUnit } 619 620 procedure TIsoMap.PaintCity(x, y: integer; const CityInfo: TCityInfo; 621 accessory: boolean); 622 var 623 age, cHGr, cpix, xGr, xShield, yShield, LabelTextColor, 624 LabelLength: integer; 625 cpic: TCityPicture; 626 s: string; 627 begin 628 age := GetAge(CityInfo.Owner); 629 if CityInfo.size < 5 then 630 xGr := 0 631 else if CityInfo.size < 9 then 632 xGr := 1 633 else if CityInfo.size < 13 then 634 xGr := 2 635 else 636 xGr := 3; 637 Tribe[CityInfo.Owner].InitAge(age); 638 if age < 2 then 639 begin 640 cHGr := Tribe[CityInfo.Owner].cHGr; 641 cpix := Tribe[CityInfo.Owner].cpix; 642 if (ciWalled and CityInfo.Flags = 0) or 643 (GrExt[cHGr].Data.Canvas.Pixels[(xGr + 4) * 65, cpix * 49 + 48] 644 = $00FFFF) then 645 Sprite(cHGr, x - xxc, y - 2 * yyc, xxc * 2, yyc * 3, 646 xGr * (xxc * 2 + 1) + 1, 1 + cpix * (yyc * 3 + 1)); 647 if ciWalled and CityInfo.Flags <> 0 then 648 Sprite(cHGr, x - xxc, y - 2 * yyc, xxc * 2, yyc * 3, 649 (xGr + 4) * (xxc * 2 + 1) + 1, 1 + cpix * (yyc * 3 + 1)); 650 end 651 else 652 begin 653 if ciWalled and CityInfo.Flags <> 0 then 654 Sprite(HGrCities, x - xxt, y - 2 * yyt, 2 * xxt, 3 * yyt, 655 (xGr + 4) * (2 * xxt + 1) + 1, 1 + (age - 2) * (3 * yyt + 1)) 656 else 657 Sprite(HGrCities, x - xxt, y - 2 * yyt, 2 * xxt, 3 * yyt, 658 xGr * (2 * xxt + 1) + 1, 1 + (age - 2) * (3 * yyt + 1)); 659 end; 660 661 if not accessory then 662 exit; 663 664 { if ciCapital and CityInfo.Flags<>0 then 665 Sprite(Tribe[CityInfo.Owner].symHGr,x+cpic.xf,y-13+cpic.yf,13,14, 666 1+Tribe[CityInfo.Owner].sympix mod 10 *65, 667 1+Tribe[CityInfo.Owner].sympix div 10 *49); {capital -- paint flag } 668 669 if MyMap[CityInfo.Loc] and fObserved <> 0 then 670 begin 671 if age < 2 then 855 672 begin 856 BitBlt(GrExt[HGrTerrain].Mask,x+dx*xxt,y+dy*yyt,xxt,yyt,857 1+8*(xxt*2+1)+dx*xxt,1+yyt+16*(yyt*3+1)+dy*yyt,SRCAND);858 BitBlt(Borders,x+dx*xxt,y+dy*yyt,xxt,yyt,dx*xxt,p1*(yyt*2)+dy*yyt,SRCPAINT);673 cpic := Tribe[CityInfo.Owner].CityPicture[xGr]; 674 xShield := x - xxc + cpic.xShield; 675 yShield := y - 2 * yyc + cpic.yShield; 859 676 end 860 end; 861 end 862 end 863 end; 864 end; 865 866 begin 867 if (Loc<0) or (Loc>=G.lx*G.ly) then Tile:=PoleTile(Loc) 868 else Tile:=MyMap[Loc]; 869 if ShowObjects and (Options and (1 shl moEditMode)=0) and (Tile and fCity<>0) then 870 GetCityInfo(Loc,cix,CityInfo); 871 if (y<=FTop-yyt*2) or (y>FBottom) or (x<=FLeft-xxt*2) or (x>FRight) then 872 begin NameCity; ShowSpacePort; exit; end; 873 if Tile and fTerrain=fUNKNOWN then 874 begin NameCity; ShowSpacePort; exit end;{square not discovered} 875 876 if not (FoW and (Tile and fObserved=0)) then 877 PaintBorder; 878 879 if (Loc>=0) and (Loc<G.lx*G.ly) and (Loc=FAdviceLoc) then 880 TSprite(x,y,7+9*2); 881 882 if (Loc>=0) and (Loc<G.lx*G.ly) and (Tile and fSpecial<>0) then {special ressources} 883 begin 884 dy:=Loc div G.lx; 885 if Tile and fTerrain<fForest then 886 TSprite(x,y,Tile and fTerrain+(Tile and fSpecial shr 5)*9) 887 else if (Tile and fTerrain=fForest) and IsJungle(dy) then 888 TSprite(x,y,8+17*9+(Tile and fSpecial shr 5)*9) 889 else TSprite(x,y,8+2*9+((Tile and fTerrain-fForest)*2+Tile and fSpecial shr 5)*9); 890 end; 891 892 if ShowObjects then 893 begin 894 if Tile and fTerImp=tiMine then 895 TSprite(x,y,2+9*12); 896 if Tile and fTerImp=tiBase then 897 TSprite(x,y,4+9*12); 898 if Tile and fPoll<>0 then 899 TSprite(x,y,6+9*12); 900 if Tile and fTerImp=tiFort then 901 begin 902 TSprite(x,y,7+9*12); 903 if Tile and fObserved=0 then 904 TSprite(x,y,3+9*12); 905 end; 906 end; 907 if Tile and fDeadLands<>0 then TSprite(x,y,(12+Tile shr 25 and 3)*9+8); 908 909 if Options and (1 shl moEditMode)<>0 then 910 fog:= (Loc<0) or (Loc>=G.lx*G.ly) 911 //else if CityLoc>=0 then 912 // fog:= (Loc<0) or (Loc>=G.lx*G.ly) or (Distance(Loc,CityLoc)>5) 913 else if ShowGrWall then fog:= Tile and fGrWall=0 914 else fog:=FoW and (Tile and fObserved=0); 915 if fog and ShowObjects then 916 if Loc<-G.lx then 917 Sprite(HGrTerrain,x,y+yyt,xxt*2,yyt,1+6*(xxt*2+1),1+yyt*2+15*(yyt*3+1)) 918 else if Loc>=G.lx*(G.ly+1) then 919 Sprite(HGrTerrain,x,y,xxt*2,yyt,1+6*(xxt*2+1),1+yyt+15*(yyt*3+1)) 920 else TSprite(x,y,6+9*15,xxt<>33); 921 922 if FoW and (Tile and fObserved=0) then 923 PaintBorder; 677 else 678 begin 679 cpic := CitiesPictures[age, xGr]; 680 xShield := x - xxt + cpic.xShield; 681 yShield := y - 2 * yyt + cpic.yShield; 682 end; 683 s := IntToStr(CityInfo.size); 684 LabelLength := FOutput.Canvas.TextWidth(s); 685 FillRect(xShield, yShield, LabelLength + 4, 16, $000000); 686 if MyMap[CityInfo.Loc] and (fUnit or fObserved) = fObserved then 687 // empty city 688 LabelTextColor := Tribe[CityInfo.Owner].Color 689 else 690 begin 691 FillRect(xShield + 1, yShield + 1, LabelLength + 2, 14, 692 Tribe[CityInfo.Owner].Color); 693 LabelTextColor := $000000; 694 end; 695 Textout(xShield + 2, yShield - 1, LabelTextColor, s); 696 end 697 end; { PaintCity } 698 699 function PoleTile(Loc: integer): integer; 700 begin { virtual pole tile } 701 result := fUNKNOWN; 702 if Loc < -2 * G.lx then 703 else if Loc < -G.lx then 704 begin 705 if (MyMap[dLoc(Loc, 0, 2)] and fTerrain <> fUNKNOWN) and 706 (MyMap[dLoc(Loc, -2, 2)] and fTerrain <> fUNKNOWN) and 707 (MyMap[dLoc(Loc, 2, 2)] and fTerrain <> fUNKNOWN) then 708 result := fArctic; 709 if (MyMap[dLoc(Loc, 0, 2)] and fObserved <> 0) and 710 (MyMap[dLoc(Loc, -2, 2)] and fObserved <> 0) and 711 (MyMap[dLoc(Loc, 2, 2)] and fObserved <> 0) then 712 result := result or fObserved 713 end 714 else if Loc < 0 then 715 begin 716 if (MyMap[dLoc(Loc, -1, 1)] and fTerrain <> fUNKNOWN) and 717 (MyMap[dLoc(Loc, 1, 1)] and fTerrain <> fUNKNOWN) then 718 result := fArctic; 719 if (MyMap[dLoc(Loc, -1, 1)] and fObserved <> 0) and 720 (MyMap[dLoc(Loc, 1, 1)] and fObserved <> 0) then 721 result := result or fObserved 722 end 723 else if Loc < G.lx * (G.ly + 1) then 724 begin 725 if (MyMap[dLoc(Loc, -1, -1)] and fTerrain <> fUNKNOWN) and 726 (MyMap[dLoc(Loc, 1, -1)] and fTerrain <> fUNKNOWN) then 727 result := fArctic; 728 if (MyMap[dLoc(Loc, -1, -1)] and fObserved <> 0) and 729 (MyMap[dLoc(Loc, 1, -1)] and fObserved <> 0) then 730 result := result or fObserved 731 end 732 else if Loc < G.lx * (G.ly + 2) then 733 begin 734 if (MyMap[dLoc(Loc, 0, -2)] and fTerrain <> fUNKNOWN) and 735 (MyMap[dLoc(Loc, -2, -2)] and fTerrain <> fUNKNOWN) and 736 (MyMap[dLoc(Loc, 2, -2)] and fTerrain <> fUNKNOWN) then 737 result := fArctic; 738 if (MyMap[dLoc(Loc, 0, -2)] and fObserved <> 0) and 739 (MyMap[dLoc(Loc, -2, -2)] and fObserved <> 0) and 740 (MyMap[dLoc(Loc, 2, -2)] and fObserved <> 0) then 741 result := result or fObserved 742 end 743 end; 744 745 const 746 Dirx: array [0 .. 7] of integer = (1, 2, 1, 0, -1, -2, -1, 0); 747 Diry: array [0 .. 7] of integer = (-1, 0, 1, 2, 1, 0, -1, -2); 748 749 function TIsoMap.Connection4(Loc, Mask, Value: integer): integer; 750 begin 751 result := 0; 752 if dLoc(Loc, 1, -1) >= 0 then 753 begin 754 if MyMap[dLoc(Loc, 1, -1)] and Mask = Cardinal(Value) then 755 inc(result, 1); 756 if MyMap[dLoc(Loc, -1, -1)] and Mask = Cardinal(Value) then 757 inc(result, 8); 758 end; 759 if dLoc(Loc, 1, 1) < G.lx * G.ly then 760 begin 761 if MyMap[dLoc(Loc, 1, 1)] and Mask = Cardinal(Value) then 762 inc(result, 2); 763 if MyMap[dLoc(Loc, -1, 1)] and Mask = Cardinal(Value) then 764 inc(result, 4); 765 end 766 end; 767 768 function TIsoMap.Connection8(Loc, Mask: integer): integer; 769 var 770 Dir, ConnLoc: integer; 771 begin 772 result := 0; 773 for Dir := 0 to 7 do 774 begin 775 ConnLoc := dLoc(Loc, Dirx[Dir], Diry[Dir]); 776 if (ConnLoc >= 0) and (ConnLoc < G.lx * G.ly) and 777 (MyMap[ConnLoc] and Mask <> 0) then 778 inc(result, 1 shl Dir); 779 end 780 end; 781 782 function TIsoMap.OceanConnection(Loc: integer): integer; 783 var 784 Dir, ConnLoc: integer; 785 begin 786 result := 0; 787 for Dir := 0 to 7 do 788 begin 789 ConnLoc := dLoc(Loc, Dirx[Dir], Diry[Dir]); 790 if (ConnLoc < 0) or (ConnLoc >= G.lx * G.ly) or 791 ((MyMap[ConnLoc] - 2) and fTerrain < 13) then 792 inc(result, 1 shl Dir); 793 end 794 end; 795 796 procedure TIsoMap.PaintShore(x, y, Loc: integer); 797 var 798 Conn, Tile: integer; 799 begin 800 if (y <= FTop - yyt * 2) or (y > FBottom) or (x <= FLeft - xxt * 2) or 801 (x > FRight) then 802 exit; 803 if (Loc < 0) or (Loc >= G.lx * G.ly) then 804 exit; 805 Tile := MyMap[Loc]; 806 if Tile and fTerrain >= fGrass then 807 exit; 808 Conn := OceanConnection(Loc); 809 if Conn = 0 then 810 exit; 811 812 BitBlt(GrExt[HGrTerrain].Data, x + xxt div 2, y, xxt, yyt, 813 1 + (Conn shr 6 + Conn and 1 shl 2) * (xxt * 2 + 1), 814 1 + yyt + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT); 815 BitBlt(GrExt[HGrTerrain].Data, x + xxt, y + yyt div 2, xxt, yyt, 816 1 + (Conn and 7) * (xxt * 2 + 1) + xxt, 817 1 + yyt * 2 + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT); 818 BitBlt(GrExt[HGrTerrain].Data, x + xxt div 2, y + yyt, xxt, yyt, 819 1 + (Conn shr 2 and 7) * (xxt * 2 + 1) + xxt, 820 1 + yyt + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT); 821 BitBlt(GrExt[HGrTerrain].Data, x, y + yyt div 2, xxt, yyt, 822 1 + (Conn shr 4 and 7) * (xxt * 2 + 1), 823 1 + yyt * 2 + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT); 824 Conn := Connection4(Loc, fTerrain, fUNKNOWN); { dither to black } 825 if Conn and 1 <> 0 then 826 BitBlt(GrExt[HGrTerrain].Mask, x + xxt, y, xxt, yyt, 827 1 + 7 * (xxt * 2 + 1) + xxt, 828 1 + yyt + 15 * (yyt * 3 + 1), SRCAND); 829 if Conn and 2 <> 0 then 830 BitBlt(GrExt[HGrTerrain].Mask, x + xxt, y + yyt, xxt, yyt, 831 1 + 7 * (xxt * 2 + 1) + xxt, 1 + yyt * 2 + 15 * 832 (yyt * 3 + 1), SRCAND); 833 if Conn and 4 <> 0 then 834 BitBlt(GrExt[HGrTerrain].Mask, x, y + yyt, xxt, yyt, 835 1 + 7 * (xxt * 2 + 1), 1 + yyt * 2 + 15 * (yyt * 3 + 1), SRCAND); 836 if Conn and 8 <> 0 then 837 BitBlt(GrExt[HGrTerrain].Mask, x, y, xxt, yyt, 838 1 + 7 * (xxt * 2 + 1), 1 + yyt + 15 * (yyt * 3 + 1), SRCAND); 839 end; 840 841 procedure TIsoMap.PaintTileExtraTerrain(x, y, Loc: integer); 842 var 843 Dir, Conn, RRConn, yGr, Tile, yLoc: integer; 844 begin 845 if (Loc < 0) or (Loc >= G.lx * G.ly) or (y <= -yyt * 2) or 846 (y > FOutput.Height) or (x <= -xxt * 2) or (x > FOutput.Width) then 847 exit; 848 Tile := MyMap[Loc]; 849 if Tile and fTerrain = fForest then 850 begin 851 yLoc := Loc div G.lx; 852 if IsJungle(yLoc) then 853 yGr := 18 854 else 855 yGr := 3; 856 Conn := Connection4(Loc, fTerrain, Tile and fTerrain); 857 if (yLoc = (G.ly - 2) div 4) or (G.ly - 1 - yLoc = (G.ly + 2) div 4) 858 then 859 Conn := Conn and not 6 // no connection to south 860 else if (yLoc = (G.ly + 2) div 4) or 861 (G.ly - 1 - yLoc = (G.ly - 2) div 4) then 862 Conn := Conn and not 9; // no connection to north 863 TSprite(x, y, Conn mod 8 + (yGr + Conn div 8) * 9); 864 end 865 else if Tile and fTerrain in [fHills, fMountains, fForest] then 866 begin 867 yGr := 3 + 2 * (Tile and fTerrain - fForest); 868 Conn := Connection4(Loc, fTerrain, Tile and fTerrain); 869 TSprite(x, y, Conn mod 8 + (yGr + Conn div 8) * 9); 870 end 871 else if Tile and fDeadLands <> 0 then 872 TSprite(x, y, 2 * 9 + 6); 873 874 if ShowObjects then 875 begin 876 if Tile and fTerImp = tiFarm then 877 TSprite(x, y, 109) { farmland } 878 else if Tile and fTerImp = tiIrrigation then 879 TSprite(x, y, 108); // irrigation 880 end; 881 if Tile and fRiver <> 0 then 882 begin 883 Conn := Connection4(Loc, fRiver, fRiver) or 884 Connection4(Loc, fTerrain, fShore) or 885 Connection4(Loc, fTerrain, fUNKNOWN); 886 TSprite(x, y, Conn mod 8 + (13 + Conn div 8) * 9); 887 end; 888 889 if Tile and fTerrain < fGrass then 890 begin 891 Conn := Connection4(Loc, fRiver, fRiver); 892 for Dir := 0 to 3 do 893 if Conn and (1 shl Dir) <> 0 then { river mouths } 894 TSprite(x, y, 15 * 9 + Dir); 895 if ShowObjects then 896 begin 897 Conn := Connection8(Loc, fCanal); 898 for Dir := 0 to 7 do 899 if Conn and (1 shl Dir) <> 0 then { canal mouths } 900 TSprite(x, y, 20 * 9 + 1 + Dir); 901 end 902 end; 903 904 if ShowObjects then 905 begin 906 if (Tile and fCanal <> 0) or (Tile and fCity <> 0) then 907 begin // paint canal connections 908 Conn := Connection8(Loc, fCanal or fCity); 909 if Tile and fCanal <> 0 then 910 Conn := Conn or ($FF - OceanConnection(Loc)); 911 if Conn = 0 then 912 begin 913 if Tile and fCanal <> 0 then 914 TSprite(x, y, 99) 915 end 916 else 917 for Dir := 0 to 7 do 918 if (1 shl Dir) and Conn <> 0 then 919 TSprite(x, y, 100 + Dir); 920 end; 921 if Tile and (fRR or fCity) <> 0 then 922 RRConn := Connection8(Loc, fRR or fCity) 923 else 924 RRConn := 0; 925 if Tile and (fRoad or fRR or fCity) <> 0 then 926 begin // paint road connections 927 Conn := Connection8(Loc, fRoad or fRR or fCity) and not RRConn; 928 if (Conn = 0) and (Tile and (fRR or fCity) = 0) then 929 TSprite(x, y, 81) 930 else if Conn > 0 then 931 for Dir := 0 to 7 do 932 if (1 shl Dir) and Conn <> 0 then 933 TSprite(x, y, 82 + Dir); 934 end; 935 // paint railroad connections 936 if (Tile and fRR <> 0) and (RRConn = 0) then 937 TSprite(x, y, 90) 938 else if RRConn > 0 then 939 for Dir := 0 to 7 do 940 if (1 shl Dir) and RRConn <> 0 then 941 TSprite(x, y, 91 + Dir); 942 end; 943 end; 944 945 // (x,y) is top left pixel of (2*xxt,3*yyt) rectangle 946 procedure TIsoMap.PaintTileObjects(x, y, Loc, CityLoc, 947 CityOwner: integer; UseBlink: boolean); 948 type 949 TLine = array [0 .. 9 * 65, 0 .. 2] of Byte; 950 var 951 p1, p2, uix, cix, dy, Loc1, Tile, Multi, Destination: integer; 952 CityInfo: TCityInfo; 953 UnitInfo: TUnitInfo; 954 fog: boolean; 955 956 procedure NameCity; 957 var 958 cix, xs, w: integer; 959 BehindCityInfo: TCityInfo; 960 s: string; 961 IsCapital: boolean; 962 begin 963 BehindCityInfo.Loc := Loc - 2 * G.lx; 964 if ShowCityNames and (Options and (1 shl moEditMode) = 0) and 965 (BehindCityInfo.Loc >= 0) and (BehindCityInfo.Loc < G.lx * G.ly) 966 and (MyMap[BehindCityInfo.Loc] and fCity <> 0) then 967 begin 968 GetCityInfo(BehindCityInfo.Loc, cix, BehindCityInfo); 969 IsCapital := BehindCityInfo.Flags and ciCapital <> 0; 970 { if Showuix and (cix>=0) then s:=IntToStr(cix) 971 else } s := CityName(BehindCityInfo.ID); 972 w := FOutput.Canvas.TextWidth(s); 973 xs := x + xxt - (w + 1) div 2; 974 if IsCapital then 975 FOutput.Canvas.Font.Style := FOutput.Canvas.Font.Style + 976 [fsUnderline]; 977 Textout(xs + 1, y - 9, $000000, s); 978 Textout(xs, y - 10, $FFFFFF, s); 979 if IsCapital then 980 FOutput.Canvas.Font.Style := FOutput.Canvas.Font.Style - 981 [fsUnderline]; 982 end; 983 end; 984 985 procedure ShowSpacePort; 986 begin 987 if ShowObjects and (Options and (1 shl moEditMode) = 0) and 988 (Tile and fCity <> 0) and (CityInfo.Flags and ciSpacePort <> 0) 989 then 990 TSprite(x + xxt, y - 6, 12 * 9 + 5); 991 end; 992 993 procedure PaintBorder; 994 var 995 dx, dy: integer; 996 Line: ^TLine; 997 begin 998 if ShowBorder and (Loc >= 0) and (Loc < G.lx * G.ly) and 999 (Tile and fTerrain <> fUNKNOWN) then 1000 begin 1001 p1 := MyRO.Territory[Loc]; 1002 if (p1 >= 0) and (ShowMyBorder or (p1 <> me)) then 1003 begin 1004 if BordersOK and (1 shl p1) = 0 then 1005 begin 1006 Windows.BitBlt(Borders.Canvas.Handle, 0, p1 * (yyt * 2), 1007 xxt * 2, yyt * 2, GrExt[HGrTerrain].Data.Canvas.Handle, 1008 1 + 8 * (xxt * 2 + 1), 1009 1 + yyt + 16 * (yyt * 3 + 1), SRCCOPY); 1010 for dy := 0 to yyt * 2 - 1 do 1011 begin 1012 Line := Borders.ScanLine[p1 * (yyt * 2) + dy]; 1013 for dx := 0 to xxt * 2 - 1 do 1014 if Line[dx, 0] = 99 then 1015 begin 1016 Line[dx, 0] := Tribe[p1].Color shr 16 and $FF; 1017 Line[dx, 1] := Tribe[p1].Color shr 8 and $FF; 1018 Line[dx, 2] := Tribe[p1].Color and $FF; 1019 end 1020 end; 1021 BordersOK := BordersOK or 1 shl p1; 1022 end; 1023 for dy := 0 to 1 do 1024 for dx := 0 to 1 do 1025 begin 1026 Loc1 := dLoc(Loc, dx * 2 - 1, dy * 2 - 1); 1027 begin 1028 if (Loc1 < 0) or (Loc1 >= G.lx * G.ly) then 1029 p2 := -1 1030 else if MyMap[Loc1] and fTerrain = fUNKNOWN then 1031 p2 := p1 1032 else 1033 p2 := MyRO.Territory[Loc1]; 1034 if p2 <> p1 then 1035 begin 1036 BitBlt(GrExt[HGrTerrain].Mask, x + dx * xxt, 1037 y + dy * yyt, xxt, yyt, 1 + 8 * (xxt * 2 + 1) + dx * 1038 xxt, 1 + yyt + 16 * (yyt * 3 + 1) + dy * yyt, SRCAND); 1039 BitBlt(Borders, x + dx * xxt, y + dy * yyt, xxt, yyt, 1040 dx * xxt, p1 * (yyt * 2) + dy * yyt, SRCPAINT); 1041 end 1042 end; 1043 end 1044 end 1045 end; 1046 end; 1047 1048 begin 1049 if (Loc < 0) or (Loc >= G.lx * G.ly) then 1050 Tile := PoleTile(Loc) 1051 else 1052 Tile := MyMap[Loc]; 1053 if ShowObjects and (Options and (1 shl moEditMode) = 0) and 1054 (Tile and fCity <> 0) then 1055 GetCityInfo(Loc, cix, CityInfo); 1056 if (y <= FTop - yyt * 2) or (y > FBottom) or (x <= FLeft - xxt * 2) or 1057 (x > FRight) then 1058 begin 1059 NameCity; 1060 ShowSpacePort; 1061 exit; 1062 end; 1063 if Tile and fTerrain = fUNKNOWN then 1064 begin 1065 NameCity; 1066 ShowSpacePort; 1067 exit 1068 end; { square not discovered } 1069 1070 if not(FoW and (Tile and fObserved = 0)) then 1071 PaintBorder; 1072 1073 if (Loc >= 0) and (Loc < G.lx * G.ly) and (Loc = FAdviceLoc) then 1074 TSprite(x, y, 7 + 9 * 2); 1075 1076 if (Loc >= 0) and (Loc < G.lx * G.ly) and (Tile and fSpecial <> 0) 1077 then { special ressources } 1078 begin 1079 dy := Loc div G.lx; 1080 if Tile and fTerrain < fForest then 1081 TSprite(x, y, Tile and fTerrain + (Tile and fSpecial shr 5) * 9) 1082 else if (Tile and fTerrain = fForest) and IsJungle(dy) then 1083 TSprite(x, y, 8 + 17 * 9 + (Tile and fSpecial shr 5) * 9) 1084 else 1085 TSprite(x, y, 8 + 2 * 9 + ((Tile and fTerrain - fForest) * 2 + 1086 Tile and fSpecial shr 5) * 9); 1087 end; 1088 1089 if ShowObjects then 1090 begin 1091 if Tile and fTerImp = tiMine then 1092 TSprite(x, y, 2 + 9 * 12); 1093 if Tile and fTerImp = tiBase then 1094 TSprite(x, y, 4 + 9 * 12); 1095 if Tile and fPoll <> 0 then 1096 TSprite(x, y, 6 + 9 * 12); 1097 if Tile and fTerImp = tiFort then 1098 begin 1099 TSprite(x, y, 7 + 9 * 12); 1100 if Tile and fObserved = 0 then 1101 TSprite(x, y, 3 + 9 * 12); 1102 end; 1103 end; 1104 if Tile and fDeadLands <> 0 then 1105 TSprite(x, y, (12 + Tile shr 25 and 3) * 9 + 8); 1106 1107 if Options and (1 shl moEditMode) <> 0 then 1108 fog := (Loc < 0) or (Loc >= G.lx * G.ly) 1109 // else if CityLoc>=0 then 1110 // fog:= (Loc<0) or (Loc>=G.lx*G.ly) or (Distance(Loc,CityLoc)>5) 1111 else if ShowGrWall then 1112 fog := Tile and fGrWall = 0 1113 else 1114 fog := FoW and (Tile and fObserved = 0); 1115 if fog and ShowObjects then 1116 if Loc < -G.lx then 1117 Sprite(HGrTerrain, x, y + yyt, xxt * 2, yyt, 1118 1 + 6 * (xxt * 2 + 1), 1 + yyt * 2 + 15 * (yyt * 3 + 1)) 1119 else if Loc >= G.lx * (G.ly + 1) then 1120 Sprite(HGrTerrain, x, y, xxt * 2, yyt, 1 + 6 * (xxt * 2 + 1), 1121 1 + yyt + 15 * (yyt * 3 + 1)) 1122 else 1123 TSprite(x, y, 6 + 9 * 15, xxt <> 33); 1124 1125 if FoW and (Tile and fObserved = 0) then 1126 PaintBorder; 924 1127 925 1128 {$IFNDEF SCR} 926 // paint goto destination mark 927 if DestinationMarkON and (CityOwner<0) and (UnFocus>=0) 928 and (MyUn[UnFocus].Status and usGoto<>0) then 929 begin 930 Destination:=MyUn[UnFocus].Status shr 16; 931 if (Destination=Loc) and (Destination<>MyUn[UnFocus].Loc) then 932 if not UseBlink or BlinkOn then TSprite(x,y,8+9*1) 933 else TSprite(x,y,8+9*2) 934 end; 1129 // paint goto destination mark 1130 if DestinationMarkON and (CityOwner < 0) and (UnFocus >= 0) and 1131 (MyUn[UnFocus].Status and usGoto <> 0) then 1132 begin 1133 Destination := MyUn[UnFocus].Status shr 16; 1134 if (Destination = Loc) and (Destination <> MyUn[UnFocus].Loc) then 1135 if not UseBlink or BlinkOn then 1136 TSprite(x, y, 8 + 9 * 1) 1137 else 1138 TSprite(x, y, 8 + 9 * 2) 1139 end; 935 1140 {$ENDIF} 936 937 if Options and (1 shl moEditMode)<>0 then 938 begin 939 if Tile and fPrefStartPos<>0 then TSprite(x,y,0+9*1) 940 else if Tile and fStartPos<>0 then TSprite(x,y,0+9*2); 941 end 942 else if ShowObjects then 943 begin 944 { if (CityLoc<0) and (UnFocus>=0) and (Loc=MyUn[UnFocus].Loc) then 945 if BlinkOn then TSprite(x,y,8+9*0) 946 else TSprite(x,y,8+9*1);} 947 948 NameCity; 949 ShowSpacePort; 950 if Tile and fCity<>0 then 951 PaintCity(x+xxt,y+yyt,CityInfo,CityOwner<0); 952 953 if (Tile and fUnit<>0) and (Loc<>AttLoc) 954 and ((Loc<>DefLoc) or (DefHealth<>0)) 955 {$IFNDEF SCR}and ((CityOwner>=0) or (UnFocus<0) or not UseBlink or BlinkON 956 or (Loc<>MyUn[UnFocus].Loc)){$ENDIF} 957 and ((Tile and fCity<>fCity) or (Loc=DefLoc) 958 {$IFNDEF SCR}or (not UseBlink or BlinkON) and (UnFocus>=0) 959 and (Loc=MyUn[UnFocus].Loc){$ENDIF}) then 960 begin {unit} 961 GetUnitInfo(Loc,uix,UnitInfo); 962 if (Loc=DefLoc) and (DefHealth>=0) then 963 UnitInfo.Health:=DefHealth; 964 if (UnitInfo.Owner<>CityOwner) 965 and not ((CityOwner=me) and (MyRO.Treaty[UnitInfo.Owner]=trAlliance)) then 966 {$IFNDEF SCR}if (UnFocus>=0) and (Loc=MyUn[UnFocus].Loc) then {active unit} 967 begin 968 Multi:=UnitInfo.Flags and unMulti; 969 MakeUnitInfo(me,MyUn[UnFocus],UnitInfo); 970 UnitInfo.Flags:=UnitInfo.Flags or Multi; 971 PaintUnit(x+(xxt-xxu),y+(yyt-yyu_anchor),UnitInfo,MyUn[UnFocus].Status); 972 end 973 else if UnitInfo.Owner=me then 974 begin 975 if ClientMode=cMovieTurn then 976 PaintUnit(x+(xxt-xxu),y+(yyt-yyu_anchor),UnitInfo,0) 977 // status is not set with precise timing during loading 978 else PaintUnit(x+(xxt-xxu),y+(yyt-yyu_anchor),UnitInfo,MyUn[uix].Status); 979 // if Showuix then Textout(x+16,y+5,$80FF00,IntToStr(uix)); 980 end 981 else{$ENDIF} PaintUnit(x+(xxt-xxu),y+(yyt-yyu_anchor),UnitInfo,0); 982 end 983 else if Tile and fHiddenUnit<>0 then 984 Sprite(HGrStdUnits,x+(xxt-xxu),y+(yyt-yyu_anchor),xxu*2,yyu*2, 985 1+5*(xxu*2+1),1) 986 else if Tile and fStealthUnit<>0 then 987 Sprite(HGrStdUnits,x+(xxt-xxu),y+(yyt-yyu_anchor),xxu*2,yyu*2, 988 1+5*(xxu*2+1),1+1*(yyu*2+1)) 989 end; 990 991 if ShowObjects and (Tile and fTerImp=tiFort) and (Tile and fObserved<>0) then 992 TSprite(x,y,3+9*12); 993 994 if (Loc>=0) and (Loc<G.lx*G.ly) then 995 if ShowLoc then Textout(x+xxt-16,y+yyt-9,$FFFF00,IntToStr(Loc)) 996 else if ShowDebug and (DebugMap<>nil) 997 and (Loc>=0) and (Loc<G.lx*G.ly) and (DebugMap[Loc]<>0) then 998 Textout(x+xxt-16,y+yyt-9,$00E0FF,IntToStr(integer(DebugMap[Loc]))) 999 end;{PaintTileObjects} 1000 1001 procedure TIsoMap.PaintGrid(x,y,nx,ny: integer); 1002 1003 procedure ClippedLine(dx0,dy0: integer; mirror: boolean); 1004 var 1005 x0,x1,dxmin,dymin,dxmax,dymax,n: integer; 1006 begin 1007 with FOutput.Canvas do 1008 begin 1009 dxmin:=(FLeft-x) div xxt; 1010 dymin:=(RealTop-y) div yyt; 1011 dxmax:=(FRight-x-1) div xxt+1; 1012 dymax:=(RealBottom-y-1) div yyt+1; 1013 n:=dymax-dy0; 1014 if mirror then 1015 begin 1016 if dx0-dxmin<n then n:=dx0-dxmin; 1017 if dx0>dxmax then 1018 begin n:=n-(dx0-dxmax); dy0:=dy0+(dx0-dxmax); dx0:=dxmax end; 1019 if dy0<dymin then 1020 begin n:=n-(dymin-dy0); dx0:=dx0-(dymin-dy0); dy0:=dymin end; 1021 end 1022 else 1023 begin 1024 if dxmax-dx0<n then n:=dxmax-dx0; 1025 if dx0<dxmin then 1026 begin n:=n-(dxmin-dx0); dy0:=dy0+(dxmin-dx0); dx0:=dxmin end; 1027 if dy0<dymin then 1028 begin n:=n-(dymin-dy0); dx0:=dx0+(dymin-dy0); dy0:=dymin end; 1029 end; 1030 if n<=0 then exit; 1031 if mirror then begin x0:=x+dx0*xxt-1; x1:=x+(dx0-n)*xxt-1; end 1032 else begin x0:=x+dx0*xxt; x1:=x+(dx0+n)*xxt; end; 1033 moveto(x0,y+dy0*yyt); 1034 lineto(x1,y+(dy0+n)*yyt); 1035 end 1036 end; 1037 1038 var 1039 i: integer; 1040 begin 1041 FOutput.Canvas.pen.color:=$000000; //$FF shl (8*random(3)); 1042 for i:=0 to nx div 2 do ClippedLine(i*2,0,false); 1043 for i:=1 to (nx+1) div 2 do ClippedLine(i*2,0,true); 1044 for i:=0 to ny div 2 do 1045 begin 1046 ClippedLine(0,2*i+2,false); 1047 ClippedLine(nx+1,2*i+1+nx and 1,true); 1048 end; 1049 end; 1050 1051 procedure TIsoMap.Paint(x,y,Loc,nx,ny,CityLoc,CityOwner:integer; 1052 UseBlink: boolean; CityAllowClick: boolean); 1053 1054 function IsShoreTile(Loc: integer):boolean; 1055 const 1056 Dirx: array[0..7] of integer=(1,2,1,0,-1,-2,-1,0); 1057 Diry: array[0..7] of integer=(-1,0,1,2,1,0,-1,-2); 1058 var 1059 Dir,ConnLoc: integer; 1060 begin 1061 result:=false; 1062 for Dir:=0 to 7 do 1063 begin 1064 ConnLoc:=dLoc(Loc,Dirx[Dir],Diry[Dir]); 1065 if (ConnLoc<0) or (ConnLoc>=G.lx*G.ly) 1066 or ((MyMap[ConnLoc]-2) and fTerrain<13) then 1067 result:=true 1068 end 1069 end; 1070 1071 procedure ShadeOutside(x0,y0,x1,y1,xm,ym: integer); 1072 const 1073 rShade=3.75; 1074 1075 procedure MakeDark(line: pointer; length: integer); 1076 type 1077 TCardArray=array[0..9999] of cardinal; 1078 PCardArray=^TCardArray; 1079 TByteArray=array[0..9999] of byte; 1080 PByteArray=^TByteArray; 1081 var 1082 i,rest: integer; 1083 begin 1084 for i:=length*3 div 4-1 downto 0 do 1085 PCardArray(line)[i]:=PCardArray(line)[i] shr 1 and $7F7F7F7F; 1086 rest:=(length*3 div 4)*4; 1087 for i:=length*3 mod 4-1 downto 0 do 1088 PByteArray(line)[rest+i]:=PByteArray(line)[rest+i] shr 1 and $7F; 1089 end; 1090 1091 type 1092 TLine=array[0..99999,0..2] of Byte; 1093 var 1094 y,wBright: integer; 1095 y_n,w_n: single; 1096 line: ^TLine; 1097 begin 1098 for y:=y0 to y1-1 do 1099 begin 1100 line:=FOutput.ScanLine[y]; 1101 y_n:=(y-ym)/yyt; 1102 if abs(y_n)<rShade then 1103 begin 1104 w_n:=sqrt(sqr(rShade)-sqr(y_n)); 1105 wBright:=trunc(w_n*xxt+0.5); 1106 MakeDark(@line[x0],xm-x0-wBright); 1107 MakeDark(@line[xm+wBright],x1-xm-wBright); 1108 end 1109 else MakeDark(@line[x0],x1-x0); 1110 end 1111 end; 1112 1113 procedure CityGrid(xm,ym: integer); 1114 var 1115 i: integer; 1116 begin 1117 with FOutput.Canvas do 1118 begin 1119 if CityAllowClick then pen.Color:=$FFFFFF 1120 else pen.color:=$000000; 1121 pen.width:=1; 1122 for i:=0 to 3 do 1123 begin 1124 moveto(xm-xxt*(4-i),ym+yyt*(1+i)); lineto(xm+xxt*(1+i),ym-yyt*(4-i)); 1125 moveto(xm-xxt*(4-i),ym-yyt*(1+i)); lineto(xm+xxt*(1+i),ym+yyt*(4-i)); 1126 end; 1127 moveto(xm-xxt*4,ym+yyt*1); lineto(xm-xxt*1,ym+yyt*4); 1128 moveto(xm+xxt*1,ym+yyt*4); lineto(xm+xxt*4,ym+yyt*1); 1129 moveto(xm-xxt*4,ym-yyt*1); lineto(xm-xxt*1,ym-yyt*4); 1130 moveto(xm+xxt*1,ym-yyt*4); lineto(xm+xxt*4,ym-yyt*1); 1131 pen.width:=1; 1132 end 1133 end; 1134 1135 var 1136 dx,dy,xm,ym,ALoc,BLoc,ATer,BTer,Aix,bix:integer; 1137 begin 1138 FoW:=true; 1139 ShowLoc:=Options and (1 shl moLocCodes)<>0; 1140 ShowDebug:= pDebugMap>=0; 1141 ShowObjects:= (CityOwner>=0) or (Options and (1 shl moBareTerrain)=0); 1142 ShowCityNames:= ShowObjects and (CityOwner<0) and (Options and (1 shl moCityNames)<>0); 1143 ShowBorder:=true; 1144 ShowMyBorder:= CityOwner<0; 1145 ShowGrWall:= (CityOwner<0) and (Options and (1 shl moGreatWall)<>0); 1146 if ShowDebug then 1147 Server(sGetDebugMap,me,pDebugMap,DebugMap) 1148 else DebugMap:=nil; 1149 with FOutput.Canvas do 1150 begin 1151 RealTop:=y-((Loc+12345*G.lx) div G.lx-12345)*yyt; 1152 RealBottom:=y+(G.ly-((Loc+12345*G.lx) div G.lx-12345)+3)*yyt; 1153 Brush.Color:=EmptySpaceColor; 1154 if RealTop>FTop then 1155 FillRect(Rect(FLeft,FTop,FRight,RealTop)) 1156 else RealTop:=FTop; 1157 if RealBottom<FBottom then 1158 FillRect(Rect(FLeft,RealBottom,FRight,FBottom)) 1159 else RealBottom:=FBottom; 1160 Brush.Color:=$000000; 1161 FillRect(Rect(FLeft,RealTop,FRight,RealBottom)); 1162 Brush.Style:=bsClear; 1163 end; 1164 1165 for dy:=0 to ny+1 do if (Loc+dy*G.lx>=0) and (Loc+(dy-3)*G.lx<G.lx*G.ly) then 1166 for dx:=0 to nx do 1167 begin 1168 ALoc:=dLoc(Loc,dx-(dy+dx) and 1,dy-2); 1169 BLoc:=dLoc(Loc,dx-(dy+dx+1) and 1,dy-1); 1170 if (ALoc<0) or (ALoc>=G.lx*G.ly) then ATer:=PoleTile(ALoc) and fTerrain 1171 else ATer:=MyMap[ALoc] and fTerrain; 1172 if (BLoc<0) or (BLoc>=G.lx*G.ly) then BTer:=PoleTile(BLoc) and fTerrain 1173 else BTer:=MyMap[BLoc] and fTerrain; 1174 1175 if (ATer<>fUNKNOWN) or (BTer<>fUNKNOWN) then 1176 if ((ATer<fGrass) or (ATer=fUNKNOWN)) and ((BTer<fGrass) or (BTer=fUNKNOWN)) then 1177 begin 1178 if ATer=fUNKNOWN then Aix:=0 1179 else if IsShoreTile(ALoc) then 1180 if ATer=fOcean then Aix:=-1 1181 else Aix:=1 1182 else Aix:=ATer+2; 1183 if BTer=fUNKNOWN then bix:=0 1184 else if IsShoreTile(BLoc) then 1185 if BTer=fOcean then bix:=-1 1186 else bix:=1 1187 else bix:=BTer+2; 1188 if (Aix>1) or (bix>1) then 1189 begin 1190 if aix=-1 then 1191 if bix=fOcean+2 then begin aix:=0; bix:=0 end 1192 else begin aix:=0; bix:=1 end 1193 else if bix=-1 then 1194 if aix=fOcean+2 then begin aix:=1; bix:=1 end 1195 else begin aix:=1; bix:=0 end; 1196 BitBlt(OceanPatch,x+dx*xxt,y+dy*yyt,xxt,yyt, 1197 Aix*(xxt*2)+(dx+dy+1) and 1 *xxt,bix*yyt,SRCCOPY) 1141 if Options and (1 shl moEditMode) <> 0 then 1142 begin 1143 if Tile and fPrefStartPos <> 0 then 1144 TSprite(x, y, 0 + 9 * 1) 1145 else if Tile and fStartPos <> 0 then 1146 TSprite(x, y, 0 + 9 * 2); 1198 1147 end 1199 end 1200 else 1201 begin 1202 if ATer=fUNKNOWN then Aix:=0 1203 else if (ALoc>=0) and (ALoc<G.lx*G.ly) and (MyMap[ALoc] and fDeadLands<>0) then 1204 Aix:=-2 1205 else if ATer=fOcean then Aix:=-1 1206 else if ATer=fShore then Aix:=1 1207 else if ATer>=fForest then Aix:=8 1208 else Aix:=ATer; 1209 if BTer=fUNKNOWN then bix:=0 1210 else if (BLoc>=0) and (BLoc<G.lx*G.ly) and (MyMap[BLoc] and fDeadLands<>0) then 1211 Bix:=-2 1212 else if BTer=fOcean then bix:=-1 1213 else if BTer=fShore then bix:=1 1214 else if BTer>=fForest then bix:=8 1215 else bix:=BTer; 1216 if (Aix=-2) and (Bix=-2) then 1217 begin Aix:=fDesert; Bix:=fDesert end 1218 else if Aix=-2 then 1219 if Bix<2 then Aix:=8 else Aix:=Bix 1220 else if Bix=-2 then 1221 if Aix<2 then Bix:=8 else Bix:=Aix; 1222 if Aix=-1 then BitBlt(GrExt[HGrTerrain].Data,x+dx*xxt,y+dy*yyt,xxt,yyt, 1223 1+6*(xxt*2+1)+(dx+dy+1) and 1 *xxt,1+yyt,SRCCOPY) // arctic <-> ocean 1224 else if bix=-1 then BitBlt(GrExt[HGrTerrain].Data,x+dx*xxt,y+dy*yyt,xxt, 1225 yyt,1+6*(xxt*2+1)+xxt-(dx+dy+1) and 1 *xxt,1+yyt*2,SRCCOPY) // arctic <-> ocean 1226 else BitBlt(LandPatch,x+dx*xxt,y+dy*yyt,xxt,yyt, 1227 Aix*(xxt*2)+(dx+dy+1) and 1 *xxt,bix*yyt,SRCCOPY) 1228 end 1229 end; 1230 1231 OutDC:=FOutput.Canvas.Handle; 1232 DataDC:=GrExt[HGrTerrain].Data.Canvas.Handle; 1233 MaskDC:=GrExt[HGrTerrain].Mask.Canvas.Handle; 1234 for dy:=-2 to ny+1 do for dx:=-1 to nx do if (dx+dy) and 1=0 then 1235 PaintShore(x+xxt*dx,y+yyt+yyt*dy,dLoc(Loc,dx,dy)); 1236 for dy:=-2 to ny+1 do for dx:=-1 to nx do if (dx+dy) and 1=0 then 1237 PaintTileExtraTerrain(x+xxt*dx,y+yyt+yyt*dy,dLoc(Loc,dx,dy)); 1238 if CityOwner>=0 then 1239 begin 1240 for dy:=-2 to ny+1 do for dx:=-2 to nx+1 do if (dx+dy) and 1=0 then 1241 begin 1242 ALoc:=dLoc(Loc,dx,dy); 1243 if Distance(ALoc,CityLoc)>5 then 1244 PaintTileObjects(x+xxt*dx,y+yyt+yyt*dy,ALoc,CityLoc,CityOwner,UseBlink); 1245 end; 1246 dx:=((CityLoc mod G.lx *2 +CityLoc div G.lx and 1) 1247 -((Loc+666*G.lx) mod G.lx *2 1248 +(Loc+666*G.lx) div G.lx and 1)+3*G.lx) mod (2*G.lx) -G.lx; 1249 dy:=CityLoc div G.lx-(Loc+666*G.lx) div G.lx+666; 1250 xm:=x+(dx+1)*xxt; 1251 ym:=y+(dy+1)*yyt+yyt; 1252 ShadeOutside(FLeft,FTop,FRight,FBottom,xm,ym); 1253 CityGrid(xm,ym); 1254 for dy:=-2 to ny+1 do for dx:=-2 to nx+1 do if (dx+dy) and 1=0 then 1255 begin 1256 ALoc:=dLoc(Loc,dx,dy); 1257 if Distance(ALoc,CityLoc)<=5 then 1258 PaintTileObjects(x+xxt*dx,y+yyt+yyt*dy,ALoc,CityLoc,CityOwner,UseBlink); 1259 end; 1260 end 1261 else 1262 begin 1263 if ShowLoc or (Options and (1 shl moEditMode)<>0) 1264 or (Options and (1 shl moGrid)<>0) then 1265 PaintGrid(x,y,nx,ny); 1266 for dy:=-2 to ny+1 do for dx:=-2 to nx+1 do if (dx+dy) and 1=0 then 1267 PaintTileObjects(x+xxt*dx,y+yyt+yyt*dy,dLoc(Loc,dx,dy),CityLoc,CityOwner,UseBlink); 1268 end; 1269 1270 //frame(FOutput.Canvas,x+1,y+1,x+nx*33+33-2,y+ny*16+32-2,$FFFF,$FFFF); 1271 end; {Paint} 1272 1273 procedure TIsoMap.AttackBegin(const ShowMove: TShowMove); 1274 begin 1275 AttLoc:=ShowMove.FromLoc; 1276 DefLoc:=dLoc(AttLoc,ShowMove.dx,ShowMove.dy); 1277 DefHealth:=-1; 1278 end; 1279 1280 procedure TIsoMap.AttackEffect(const ShowMove: TShowMove); 1281 begin 1282 DefHealth:=ShowMove.EndHealthDef; 1283 end; 1284 1285 procedure TIsoMap.AttackEnd; 1286 begin 1287 AttLoc:=-1; 1288 DefLoc:=-1; 1289 end; 1290 1148 else if ShowObjects then 1149 begin 1150 { if (CityLoc<0) and (UnFocus>=0) and (Loc=MyUn[UnFocus].Loc) then 1151 if BlinkOn then TSprite(x,y,8+9*0) 1152 else TSprite(x,y,8+9*1); } 1153 1154 NameCity; 1155 ShowSpacePort; 1156 if Tile and fCity <> 0 then 1157 PaintCity(x + xxt, y + yyt, CityInfo, CityOwner < 0); 1158 1159 if (Tile and fUnit <> 0) and (Loc <> AttLoc) and 1160 ((Loc <> DefLoc) or (DefHealth <> 0)) 1161 {$IFNDEF SCR} and ((CityOwner >= 0) or (UnFocus < 0) or not UseBlink or 1162 BlinkOn or (Loc <> MyUn[UnFocus].Loc)){$ENDIF} 1163 and ((Tile and fCity <> fCity) or (Loc = DefLoc) 1164 {$IFNDEF SCR} or (not UseBlink or BlinkOn) and (UnFocus >= 0) and 1165 (Loc = MyUn[UnFocus].Loc){$ENDIF}) then 1166 begin { unit } 1167 GetUnitInfo(Loc, uix, UnitInfo); 1168 if (Loc = DefLoc) and (DefHealth >= 0) then 1169 UnitInfo.Health := DefHealth; 1170 if (UnitInfo.Owner <> CityOwner) and 1171 not((CityOwner = me) and 1172 (MyRO.Treaty[UnitInfo.Owner] = trAlliance)) then 1173 {$IFNDEF SCR} if (UnFocus >= 0) and (Loc = MyUn[UnFocus].Loc) then { active unit } 1174 begin 1175 Multi := UnitInfo.Flags and unMulti; 1176 MakeUnitInfo(me, MyUn[UnFocus], UnitInfo); 1177 UnitInfo.Flags := UnitInfo.Flags or Multi; 1178 PaintUnit(x + (xxt - xxu), y + (yyt - yyu_anchor), UnitInfo, 1179 MyUn[UnFocus].Status); 1180 end 1181 else if UnitInfo.Owner = me then 1182 begin 1183 if ClientMode = cMovieTurn then 1184 PaintUnit(x + (xxt - xxu), y + (yyt - yyu_anchor), 1185 UnitInfo, 0) 1186 // status is not set with precise timing during loading 1187 else 1188 PaintUnit(x + (xxt - xxu), y + (yyt - yyu_anchor), UnitInfo, 1189 MyUn[uix].Status); 1190 // if Showuix then Textout(x+16,y+5,$80FF00,IntToStr(uix)); 1191 end 1192 else {$ENDIF} PaintUnit(x + (xxt - xxu), y + (yyt - yyu_anchor), UnitInfo, 0); 1193 end 1194 else if Tile and fHiddenUnit <> 0 then 1195 Sprite(HGrStdUnits, x + (xxt - xxu), y + (yyt - yyu_anchor), 1196 xxu * 2, yyu * 2, 1 + 5 * (xxu * 2 + 1), 1) 1197 else if Tile and fStealthUnit <> 0 then 1198 Sprite(HGrStdUnits, x + (xxt - xxu), y + (yyt - yyu_anchor), 1199 xxu * 2, yyu * 2, 1 + 5 * (xxu * 2 + 1), 1 + 1 * (yyu * 2 + 1)) 1200 end; 1201 1202 if ShowObjects and (Tile and fTerImp = tiFort) and 1203 (Tile and fObserved <> 0) then 1204 TSprite(x, y, 3 + 9 * 12); 1205 1206 if (Loc >= 0) and (Loc < G.lx * G.ly) then 1207 if ShowLoc then 1208 Textout(x + xxt - 16, y + yyt - 9, $FFFF00, IntToStr(Loc)) 1209 else if ShowDebug and (DebugMap <> nil) and (Loc >= 0) and 1210 (Loc < G.lx * G.ly) and (DebugMap[Loc] <> 0) then 1211 Textout(x + xxt - 16, y + yyt - 9, $00E0FF, 1212 IntToStr(integer(DebugMap[Loc]))) 1213 end; { PaintTileObjects } 1214 1215 procedure TIsoMap.PaintGrid(x, y, nx, ny: integer); 1216 1217 procedure ClippedLine(dx0, dy0: integer; mirror: boolean); 1218 var 1219 x0, x1, dxmin, dymin, dxmax, dymax, n: integer; 1220 begin 1221 with FOutput.Canvas do 1222 begin 1223 dxmin := (FLeft - x) div xxt; 1224 dymin := (RealTop - y) div yyt; 1225 dxmax := (FRight - x - 1) div xxt + 1; 1226 dymax := (RealBottom - y - 1) div yyt + 1; 1227 n := dymax - dy0; 1228 if mirror then 1229 begin 1230 if dx0 - dxmin < n then 1231 n := dx0 - dxmin; 1232 if dx0 > dxmax then 1233 begin 1234 n := n - (dx0 - dxmax); 1235 dy0 := dy0 + (dx0 - dxmax); 1236 dx0 := dxmax 1237 end; 1238 if dy0 < dymin then 1239 begin 1240 n := n - (dymin - dy0); 1241 dx0 := dx0 - (dymin - dy0); 1242 dy0 := dymin 1243 end; 1244 end 1245 else 1246 begin 1247 if dxmax - dx0 < n then 1248 n := dxmax - dx0; 1249 if dx0 < dxmin then 1250 begin 1251 n := n - (dxmin - dx0); 1252 dy0 := dy0 + (dxmin - dx0); 1253 dx0 := dxmin 1254 end; 1255 if dy0 < dymin then 1256 begin 1257 n := n - (dymin - dy0); 1258 dx0 := dx0 + (dymin - dy0); 1259 dy0 := dymin 1260 end; 1261 end; 1262 if n <= 0 then 1263 exit; 1264 if mirror then 1265 begin 1266 x0 := x + dx0 * xxt - 1; 1267 x1 := x + (dx0 - n) * xxt - 1; 1268 end 1269 else 1270 begin 1271 x0 := x + dx0 * xxt; 1272 x1 := x + (dx0 + n) * xxt; 1273 end; 1274 moveto(x0, y + dy0 * yyt); 1275 lineto(x1, y + (dy0 + n) * yyt); 1276 end 1277 end; 1278 1279 var 1280 i: integer; 1281 begin 1282 FOutput.Canvas.pen.Color := $000000; // $FF shl (8*random(3)); 1283 for i := 0 to nx div 2 do 1284 ClippedLine(i * 2, 0, false); 1285 for i := 1 to (nx + 1) div 2 do 1286 ClippedLine(i * 2, 0, true); 1287 for i := 0 to ny div 2 do 1288 begin 1289 ClippedLine(0, 2 * i + 2, false); 1290 ClippedLine(nx + 1, 2 * i + 1 + nx and 1, true); 1291 end; 1292 end; 1293 1294 procedure TIsoMap.Paint(x, y, Loc, nx, ny, CityLoc, CityOwner: integer; 1295 UseBlink: boolean; CityAllowClick: boolean); 1296 1297 function IsShoreTile(Loc: integer): boolean; 1298 const 1299 Dirx: array [0 .. 7] of integer = (1, 2, 1, 0, -1, -2, -1, 0); 1300 Diry: array [0 .. 7] of integer = (-1, 0, 1, 2, 1, 0, -1, -2); 1301 var 1302 Dir, ConnLoc: integer; 1303 begin 1304 result := false; 1305 for Dir := 0 to 7 do 1306 begin 1307 ConnLoc := dLoc(Loc, Dirx[Dir], Diry[Dir]); 1308 if (ConnLoc < 0) or (ConnLoc >= G.lx * G.ly) or 1309 ((MyMap[ConnLoc] - 2) and fTerrain < 13) then 1310 result := true 1311 end 1312 end; 1313 1314 procedure ShadeOutside(x0, y0, x1, y1, xm, ym: integer); 1315 const 1316 rShade = 3.75; 1317 1318 procedure MakeDark(Line: pointer; length: integer); 1319 type 1320 TCardArray = array [0 .. 9999] of Cardinal; 1321 PCardArray = ^TCardArray; 1322 TByteArray = array [0 .. 9999] of Byte; 1323 PByteArray = ^TByteArray; 1324 var 1325 i, rest: integer; 1326 begin 1327 for i := length * 3 div 4 - 1 downto 0 do 1328 PCardArray(Line)[i] := PCardArray(Line)[i] shr 1 and $7F7F7F7F; 1329 rest := (length * 3 div 4) * 4; 1330 for i := length * 3 mod 4 - 1 downto 0 do 1331 PByteArray(Line)[rest + i] := PByteArray(Line) 1332 [rest + i] shr 1 and $7F; 1333 end; 1334 1335 type 1336 TLine = array [0 .. 99999, 0 .. 2] of Byte; 1337 var 1338 y, wBright: integer; 1339 y_n, w_n: single; 1340 Line: ^TLine; 1341 begin 1342 for y := y0 to y1 - 1 do 1343 begin 1344 Line := FOutput.ScanLine[y]; 1345 y_n := (y - ym) / yyt; 1346 if abs(y_n) < rShade then 1347 begin 1348 w_n := sqrt(sqr(rShade) - sqr(y_n)); 1349 wBright := trunc(w_n * xxt + 0.5); 1350 MakeDark(@Line[x0], xm - x0 - wBright); 1351 MakeDark(@Line[xm + wBright], x1 - xm - wBright); 1352 end 1353 else 1354 MakeDark(@Line[x0], x1 - x0); 1355 end 1356 end; 1357 1358 procedure CityGrid(xm, ym: integer); 1359 var 1360 i: integer; 1361 begin 1362 with FOutput.Canvas do 1363 begin 1364 if CityAllowClick then 1365 pen.Color := $FFFFFF 1366 else 1367 pen.Color := $000000; 1368 pen.Width := 1; 1369 for i := 0 to 3 do 1370 begin 1371 moveto(xm - xxt * (4 - i), ym + yyt * (1 + i)); 1372 lineto(xm + xxt * (1 + i), ym - yyt * (4 - i)); 1373 moveto(xm - xxt * (4 - i), ym - yyt * (1 + i)); 1374 lineto(xm + xxt * (1 + i), ym + yyt * (4 - i)); 1375 end; 1376 moveto(xm - xxt * 4, ym + yyt * 1); 1377 lineto(xm - xxt * 1, ym + yyt * 4); 1378 moveto(xm + xxt * 1, ym + yyt * 4); 1379 lineto(xm + xxt * 4, ym + yyt * 1); 1380 moveto(xm - xxt * 4, ym - yyt * 1); 1381 lineto(xm - xxt * 1, ym - yyt * 4); 1382 moveto(xm + xxt * 1, ym - yyt * 4); 1383 lineto(xm + xxt * 4, ym - yyt * 1); 1384 pen.Width := 1; 1385 end 1386 end; 1387 1388 var 1389 dx, dy, xm, ym, ALoc, BLoc, ATer, BTer, Aix, bix: integer; 1390 begin 1391 FoW := true; 1392 ShowLoc := Options and (1 shl moLocCodes) <> 0; 1393 ShowDebug := pDebugMap >= 0; 1394 ShowObjects := (CityOwner >= 0) or 1395 (Options and (1 shl moBareTerrain) = 0); 1396 ShowCityNames := ShowObjects and (CityOwner < 0) and 1397 (Options and (1 shl moCityNames) <> 0); 1398 ShowBorder := true; 1399 ShowMyBorder := CityOwner < 0; 1400 ShowGrWall := (CityOwner < 0) and 1401 (Options and (1 shl moGreatWall) <> 0); 1402 if ShowDebug then 1403 Server(sGetDebugMap, me, pDebugMap, DebugMap) 1404 else 1405 DebugMap := nil; 1406 with FOutput.Canvas do 1407 begin 1408 RealTop := y - ((Loc + 12345 * G.lx) div G.lx - 12345) * yyt; 1409 RealBottom := y + 1410 (G.ly - ((Loc + 12345 * G.lx) div G.lx - 12345) + 3) * yyt; 1411 Brush.Color := EmptySpaceColor; 1412 if RealTop > FTop then 1413 FillRect(Rect(FLeft, FTop, FRight, RealTop)) 1414 else 1415 RealTop := FTop; 1416 if RealBottom < FBottom then 1417 FillRect(Rect(FLeft, RealBottom, FRight, FBottom)) 1418 else 1419 RealBottom := FBottom; 1420 Brush.Color := $000000; 1421 FillRect(Rect(FLeft, RealTop, FRight, RealBottom)); 1422 Brush.Style := bsClear; 1423 end; 1424 1425 for dy := 0 to ny + 1 do 1426 if (Loc + dy * G.lx >= 0) and (Loc + (dy - 3) * G.lx < G.lx * G.ly) 1427 then 1428 for dx := 0 to nx do 1429 begin 1430 ALoc := dLoc(Loc, dx - (dy + dx) and 1, dy - 2); 1431 BLoc := dLoc(Loc, dx - (dy + dx + 1) and 1, dy - 1); 1432 if (ALoc < 0) or (ALoc >= G.lx * G.ly) then 1433 ATer := PoleTile(ALoc) and fTerrain 1434 else 1435 ATer := MyMap[ALoc] and fTerrain; 1436 if (BLoc < 0) or (BLoc >= G.lx * G.ly) then 1437 BTer := PoleTile(BLoc) and fTerrain 1438 else 1439 BTer := MyMap[BLoc] and fTerrain; 1440 1441 if (ATer <> fUNKNOWN) or (BTer <> fUNKNOWN) then 1442 if ((ATer < fGrass) or (ATer = fUNKNOWN)) and 1443 ((BTer < fGrass) or (BTer = fUNKNOWN)) then 1444 begin 1445 if ATer = fUNKNOWN then 1446 Aix := 0 1447 else if IsShoreTile(ALoc) then 1448 if ATer = fOcean then 1449 Aix := -1 1450 else 1451 Aix := 1 1452 else 1453 Aix := ATer + 2; 1454 if BTer = fUNKNOWN then 1455 bix := 0 1456 else if IsShoreTile(BLoc) then 1457 if BTer = fOcean then 1458 bix := -1 1459 else 1460 bix := 1 1461 else 1462 bix := BTer + 2; 1463 if (Aix > 1) or (bix > 1) then 1464 begin 1465 if Aix = -1 then 1466 if bix = fOcean + 2 then 1467 begin 1468 Aix := 0; 1469 bix := 0 1470 end 1471 else 1472 begin 1473 Aix := 0; 1474 bix := 1 1475 end 1476 else if bix = -1 then 1477 if Aix = fOcean + 2 then 1478 begin 1479 Aix := 1; 1480 bix := 1 1481 end 1482 else 1483 begin 1484 Aix := 1; 1485 bix := 0 1486 end; 1487 BitBlt(OceanPatch, x + dx * xxt, y + dy * yyt, xxt, yyt, 1488 Aix * (xxt * 2) + (dx + dy + 1) and 1 * xxt, 1489 bix * yyt, SRCCOPY) 1490 end 1491 end 1492 else 1493 begin 1494 if ATer = fUNKNOWN then 1495 Aix := 0 1496 else if (ALoc >= 0) and (ALoc < G.lx * G.ly) and 1497 (MyMap[ALoc] and fDeadLands <> 0) then 1498 Aix := -2 1499 else if ATer = fOcean then 1500 Aix := -1 1501 else if ATer = fShore then 1502 Aix := 1 1503 else if ATer >= fForest then 1504 Aix := 8 1505 else 1506 Aix := ATer; 1507 if BTer = fUNKNOWN then 1508 bix := 0 1509 else if (BLoc >= 0) and (BLoc < G.lx * G.ly) and 1510 (MyMap[BLoc] and fDeadLands <> 0) then 1511 bix := -2 1512 else if BTer = fOcean then 1513 bix := -1 1514 else if BTer = fShore then 1515 bix := 1 1516 else if BTer >= fForest then 1517 bix := 8 1518 else 1519 bix := BTer; 1520 if (Aix = -2) and (bix = -2) then 1521 begin 1522 Aix := fDesert; 1523 bix := fDesert 1524 end 1525 else if Aix = -2 then 1526 if bix < 2 then 1527 Aix := 8 1528 else 1529 Aix := bix 1530 else if bix = -2 then 1531 if Aix < 2 then 1532 bix := 8 1533 else 1534 bix := Aix; 1535 if Aix = -1 then 1536 BitBlt(GrExt[HGrTerrain].Data, x + dx * xxt, y + dy * yyt, 1537 xxt, yyt, 1 + 6 * (xxt * 2 + 1) + (dx + dy + 1) and 1538 1 * xxt, 1 + yyt, SRCCOPY) // arctic <-> ocean 1539 else if bix = -1 then 1540 BitBlt(GrExt[HGrTerrain].Data, x + dx * xxt, y + dy * yyt, 1541 xxt, yyt, 1 + 6 * (xxt * 2 + 1) + xxt - (dx + dy + 1) 1542 and 1 * xxt, 1 + yyt * 2, SRCCOPY) // arctic <-> ocean 1543 else 1544 BitBlt(LandPatch, x + dx * xxt, y + dy * yyt, xxt, yyt, 1545 Aix * (xxt * 2) + (dx + dy + 1) and 1 * xxt, 1546 bix * yyt, SRCCOPY) 1547 end 1548 end; 1549 1550 OutDC := FOutput.Canvas.Handle; 1551 DataDC := GrExt[HGrTerrain].Data.Canvas.Handle; 1552 MaskDC := GrExt[HGrTerrain].Mask.Canvas.Handle; 1553 for dy := -2 to ny + 1 do 1554 for dx := -1 to nx do 1555 if (dx + dy) and 1 = 0 then 1556 PaintShore(x + xxt * dx, y + yyt + yyt * dy, dLoc(Loc, dx, dy)); 1557 for dy := -2 to ny + 1 do 1558 for dx := -1 to nx do 1559 if (dx + dy) and 1 = 0 then 1560 PaintTileExtraTerrain(x + xxt * dx, y + yyt + yyt * dy, 1561 dLoc(Loc, dx, dy)); 1562 if CityOwner >= 0 then 1563 begin 1564 for dy := -2 to ny + 1 do 1565 for dx := -2 to nx + 1 do 1566 if (dx + dy) and 1 = 0 then 1567 begin 1568 ALoc := dLoc(Loc, dx, dy); 1569 if Distance(ALoc, CityLoc) > 5 then 1570 PaintTileObjects(x + xxt * dx, y + yyt + yyt * dy, ALoc, 1571 CityLoc, CityOwner, UseBlink); 1572 end; 1573 dx := ((CityLoc mod G.lx * 2 + CityLoc div G.lx and 1) - 1574 ((Loc + 666 * G.lx) mod G.lx * 2 + (Loc + 666 * G.lx) div G.lx and 1575 1) + 3 * G.lx) mod (2 * G.lx) - G.lx; 1576 dy := CityLoc div G.lx - (Loc + 666 * G.lx) div G.lx + 666; 1577 xm := x + (dx + 1) * xxt; 1578 ym := y + (dy + 1) * yyt + yyt; 1579 ShadeOutside(FLeft, FTop, FRight, FBottom, xm, ym); 1580 CityGrid(xm, ym); 1581 for dy := -2 to ny + 1 do 1582 for dx := -2 to nx + 1 do 1583 if (dx + dy) and 1 = 0 then 1584 begin 1585 ALoc := dLoc(Loc, dx, dy); 1586 if Distance(ALoc, CityLoc) <= 5 then 1587 PaintTileObjects(x + xxt * dx, y + yyt + yyt * dy, ALoc, 1588 CityLoc, CityOwner, UseBlink); 1589 end; 1590 end 1591 else 1592 begin 1593 if ShowLoc or (Options and (1 shl moEditMode) <> 0) or 1594 (Options and (1 shl moGrid) <> 0) then 1595 PaintGrid(x, y, nx, ny); 1596 for dy := -2 to ny + 1 do 1597 for dx := -2 to nx + 1 do 1598 if (dx + dy) and 1 = 0 then 1599 PaintTileObjects(x + xxt * dx, y + yyt + yyt * dy, 1600 dLoc(Loc, dx, dy), CityLoc, CityOwner, UseBlink); 1601 end; 1602 1603 // frame(FOutput.Canvas,x+1,y+1,x+nx*33+33-2,y+ny*16+32-2,$FFFF,$FFFF); 1604 end; { Paint } 1605 1606 procedure TIsoMap.AttackBegin(const ShowMove: TShowMove); 1607 begin 1608 AttLoc := ShowMove.FromLoc; 1609 DefLoc := dLoc(AttLoc, ShowMove.dx, ShowMove.dy); 1610 DefHealth := -1; 1611 end; 1612 1613 procedure TIsoMap.AttackEffect(const ShowMove: TShowMove); 1614 begin 1615 DefHealth := ShowMove.EndHealthDef; 1616 end; 1617 1618 procedure TIsoMap.AttackEnd; 1619 begin 1620 AttLoc := -1; 1621 DefLoc := -1; 1622 end; 1291 1623 1292 1624 initialization 1293 1625 1294 NoMap:=nil; 1295 LandPatch:=nil; 1296 OceanPatch:=nil; 1297 Borders:=nil; 1626 NoMap := nil; 1627 LandPatch := nil; 1628 OceanPatch := nil; 1629 Borders := nil; 1630 1298 1631 end. 1299 -
trunk/LocalPlayer/LocalPlayer.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit LocalPlayer; 4 3 5 4 interface 6 5 7 procedure Client(Command, Player:integer;var Data); stdcall;6 procedure Client(Command, Player: integer; var Data); stdcall; 8 7 9 8 procedure SetAIName(p: integer; Name: string); 10 11 9 12 10 implementation 13 11 14 12 uses 15 Term,CityScreen,Draft,MessgEx,Select,CityType,Help,UnitStat,Diagram,16 NatStat,Wonders,Nego,Enhance,BaseWin,Battle,Rates,TechTree,13 Term, CityScreen, Draft, MessgEx, Select, CityType, Help, UnitStat, Diagram, 14 NatStat, Wonders, Nego, Enhance, BaseWin, Battle, Rates, TechTree, 17 15 18 Forms;16 Forms; 19 17 20 18 var 21 FormsCreated: boolean;19 FormsCreated: boolean; 22 20 23 21 procedure Client; 24 22 begin 25 if not FormsCreated then23 if not FormsCreated then 26 24 begin 27 FormsCreated:=true;28 BaseWin.CreateOffscreen;29 Application.CreateForm(TMainScreen, MainScreen);30 Application.CreateForm(TCityDlg, CityDlg);31 Application.CreateForm(TModalSelectDlg, ModalSelectDlg);32 Application.CreateForm(TListDlg, ListDlg);33 Application.CreateForm(TMessgExDlg, MessgExDlg);34 Application.CreateForm(TDraftDlg, DraftDlg);35 Application.CreateForm(TCityTypeDlg, CityTypeDlg);36 Application.CreateForm(THelpDlg, HelpDlg);37 Application.CreateForm(TUnitStatDlg, UnitStatDlg);38 Application.CreateForm(TDiaDlg, DiaDlg);39 Application.CreateForm(TNatStatDlg, NatStatDlg);40 Application.CreateForm(TWondersDlg, WondersDlg);41 Application.CreateForm(TNegoDlg, NegoDlg);42 Application.CreateForm(TEnhanceDlg, EnhanceDlg);43 Application.CreateForm(TBattleDlg, BattleDlg);44 //Application.CreateForm(TAdvisorDlg, AdvisorDlg);45 Application.CreateForm(TRatesDlg, RatesDlg);46 Application.CreateForm(TTechTreeDlg, TechTreeDlg);25 FormsCreated := true; 26 BaseWin.CreateOffscreen; 27 Application.CreateForm(TMainScreen, MainScreen); 28 Application.CreateForm(TCityDlg, CityDlg); 29 Application.CreateForm(TModalSelectDlg, ModalSelectDlg); 30 Application.CreateForm(TListDlg, ListDlg); 31 Application.CreateForm(TMessgExDlg, MessgExDlg); 32 Application.CreateForm(TDraftDlg, DraftDlg); 33 Application.CreateForm(TCityTypeDlg, CityTypeDlg); 34 Application.CreateForm(THelpDlg, HelpDlg); 35 Application.CreateForm(TUnitStatDlg, UnitStatDlg); 36 Application.CreateForm(TDiaDlg, DiaDlg); 37 Application.CreateForm(TNatStatDlg, NatStatDlg); 38 Application.CreateForm(TWondersDlg, WondersDlg); 39 Application.CreateForm(TNegoDlg, NegoDlg); 40 Application.CreateForm(TEnhanceDlg, EnhanceDlg); 41 Application.CreateForm(TBattleDlg, BattleDlg); 42 // Application.CreateForm(TAdvisorDlg, AdvisorDlg); 43 Application.CreateForm(TRatesDlg, RatesDlg); 44 Application.CreateForm(TTechTreeDlg, TechTreeDlg); 47 45 end; 48 MainScreen.Client(Command,Player,Data);46 MainScreen.Client(Command, Player, Data); 49 47 end; 50 48 51 49 procedure SetAIName(p: integer; Name: string); 52 50 begin 53 MainScreen.SetAIName(p, Name);51 MainScreen.SetAIName(p, Name); 54 52 end; 55 53 56 54 initialization 57 FormsCreated:=false; 55 56 FormsCreated := false; 58 57 59 58 end. 60 -
trunk/LocalPlayer/MessgEx.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit MessgEx; 4 3 … … 6 5 7 6 uses 8 Messg, Protocol,ScreenTools,9 10 Windows, Messages,SysUtils,Classes,Graphics,Controls,Forms,ButtonA,7 Messg, Protocol, ScreenTools, 8 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ButtonA, 11 10 ButtonB, ButtonBase, StdCtrls; 12 11 … … 18 17 RemoveBtn: TButtonB; 19 18 EInput: TEdit; 20 procedure FormCreate(Sender: TObject);21 procedure FormPaint(Sender: TObject);19 procedure FormCreate(Sender: TObject); 20 procedure FormPaint(Sender: TObject); 22 21 procedure FormShow(Sender: TObject); 23 22 procedure Button1Click(Sender: TObject); … … 30 29 Kind, IconKind, IconIndex, HelpKind, HelpNo, CenterTo: integer; 31 30 OpenSound: string; 32 function ShowModal: Integer; override;31 function ShowModal: integer; override; 33 32 procedure CancelMovie; 34 33 private 35 34 MovieCancelled: boolean; 36 procedure PaintBook(ca: TCanvas; x, y,clPage,clCover: integer);35 procedure PaintBook(ca: TCanvas; x, y, clPage, clCover: integer); 37 36 procedure PaintMyArmy; 38 37 procedure PaintEnemyArmy; 39 procedure OnPlaySound(var Msg: TMessage); message WM_PLAYSOUND;38 procedure OnPlaySound(var Msg: TMessage); message WM_PLAYSOUND; 40 39 end; 41 40 42 41 const 43 // extra message kinds 44 mkYesNoCancel=4; mkOkCancelRemove=5; mkOkHelp=6; mkModel=7; 45 46 47 //message icon kinds 48 mikNone=-1; mikImp=0; mikModel=1; mikTribe=2; mikBook=3; mikAge=4; 49 mikPureIcon=5; mikMyArmy=6; mikEnemyArmy=7; mikFullControl=8; mikShip=9; 50 mikBigIcon=10; mikEnemyShipComplete=11; 51 52 53 var 54 MessgExDlg:TMessgExDlg; 42 // extra message kinds 43 mkYesNoCancel = 4; 44 mkOkCancelRemove = 5; 45 mkOkHelp = 6; 46 mkModel = 7; 47 48 // message icon kinds 49 mikNone = -1; 50 mikImp = 0; 51 mikModel = 1; 52 mikTribe = 2; 53 mikBook = 3; 54 mikAge = 4; 55 mikPureIcon = 5; 56 mikMyArmy = 6; 57 mikEnemyArmy = 7; 58 mikFullControl = 8; 59 mikShip = 9; 60 mikBigIcon = 10; 61 mikEnemyShipComplete = 11; 62 63 var 64 MessgExDlg: TMessgExDlg; 55 65 56 66 procedure SoundMessageEx(SimpleText, SoundItem: string); 57 67 procedure TribeMessage(p: integer; SimpleText, SoundItem: string); 58 function SimpleQuery(QueryKind: integer; SimpleText, SoundItem: string): 59 integer; 60 procedure ContextMessage(SimpleText, SoundItem: string; ContextKind, 61 ContextNo: integer); 62 68 function SimpleQuery(QueryKind: integer; SimpleText, SoundItem: string) 69 : integer; 70 procedure ContextMessage(SimpleText, SoundItem: string; 71 ContextKind, ContextNo: integer); 63 72 64 73 implementation 65 74 66 75 uses 67 ClientTools,BaseWin,Term,Help, Select, Diplomacy, Inp, UnitStat, Tribes,68 IsoEngine,Diagram;76 ClientTools, BaseWin, Term, Help, Select, Diplomacy, Inp, UnitStat, Tribes, 77 IsoEngine, Diagram; 69 78 70 79 {$R *.DFM} 71 80 72 81 const 73 LostUnitsPerLine=6; 74 75 var 76 PerfFreq: int64; 77 78 79 procedure TMessgExDlg.FormCreate(Sender:TObject); 80 begin 81 inherited; 82 IconKind:=mikNone; 83 CenterTo:=0; 84 OpenSound:=''; 82 LostUnitsPerLine = 6; 83 84 var 85 PerfFreq: int64; 86 87 procedure TMessgExDlg.FormCreate(Sender: TObject); 88 begin 89 inherited; 90 IconKind := mikNone; 91 CenterTo := 0; 92 OpenSound := ''; 85 93 end; 86 94 87 95 procedure TMessgExDlg.FormShow(Sender: TObject); 88 96 var 89 i: integer; 90 begin 91 if IconKind=mikEnemyArmy then 92 InitAllEnemyModels; 93 94 Button1.Visible:= GameMode<>cMovie; 95 Button2.Visible:= (GameMode<>cMovie) and (Kind<>mkOk); 96 Button3.Visible:= (GameMode<>cMovie) and (Kind=mkYesNoCancel); 97 RemoveBtn.Visible:= (GameMode<>cMovie) and (Kind=mkOkCancelRemove); 98 EInput.Visible:= (GameMode<>cMovie) and (Kind=mkModel); 99 if Button3.Visible then 100 begin Button1.Left:=43; Button2.Left:=159; end 101 else if Button2.Visible then 102 begin Button1.Left:=101; Button2.Left:=217; end 103 else Button1.Left:=159; 104 RemoveBtn.Left:=ClientWidth-38; 105 case Kind of 106 mkYesNo, mkYesNoCancel: 97 i: integer; 98 begin 99 if IconKind = mikEnemyArmy then 100 InitAllEnemyModels; 101 102 Button1.Visible := GameMode <> cMovie; 103 Button2.Visible := (GameMode <> cMovie) and (Kind <> mkOk); 104 Button3.Visible := (GameMode <> cMovie) and (Kind = mkYesNoCancel); 105 RemoveBtn.Visible := (GameMode <> cMovie) and (Kind = mkOkCancelRemove); 106 EInput.Visible := (GameMode <> cMovie) and (Kind = mkModel); 107 if Button3.Visible then 108 begin 109 Button1.Left := 43; 110 Button2.Left := 159; 111 end 112 else if Button2.Visible then 113 begin 114 Button1.Left := 101; 115 Button2.Left := 217; 116 end 117 else 118 Button1.Left := 159; 119 RemoveBtn.Left := ClientWidth - 38; 120 case Kind of 121 mkYesNo, mkYesNoCancel: 122 begin 123 Button1.Caption := Phrases.Lookup('BTN_YES'); 124 Button2.Caption := Phrases.Lookup('BTN_NO') 125 end; 126 mkOKCancel, mkOkCancelRemove: 127 begin 128 Button1.Caption := Phrases.Lookup('BTN_OK'); 129 Button2.Caption := Phrases.Lookup('BTN_CANCEL'); 130 end; 131 else 107 132 begin 108 Button1.Caption:=Phrases.Lookup('BTN_YES');109 Button2.Caption:=Phrases.Lookup('BTN_NO')133 Button1.Caption := Phrases.Lookup('BTN_OK'); 134 Button2.Caption := Phrases.Lookup('BTN_INFO'); 110 135 end; 111 mkOKCancel, mkOkCancelRemove: 136 end; 137 Button3.Caption := Phrases.Lookup('BTN_CANCEL'); 138 RemoveBtn.Hint := Phrases.Lookup('BTN_DELGAME'); 139 140 case IconKind of 141 mikImp, mikModel, mikAge, mikPureIcon: 142 TopSpace := 56; 143 mikBigIcon: 144 TopSpace := 152; 145 mikEnemyShipComplete: 146 TopSpace := 136; 147 mikBook: 148 if IconIndex >= 0 then 149 TopSpace := 84 150 else 151 TopSpace := 47; 152 mikTribe: 153 begin 154 Tribe[IconIndex].InitAge(GetAge(IconIndex)); 155 if Tribe[IconIndex].faceHGr >= 0 then 156 TopSpace := 64 157 end; 158 mikFullControl: 159 TopSpace := 80; 160 mikShip: 161 TopSpace := 240; 162 else 163 TopSpace := 0; 164 end; 165 166 SplitText(true); 167 ClientHeight := 72 + Border + TopSpace + Lines * MessageLineSpacing; 168 if GameMode = cMovie then 169 ClientHeight := ClientHeight - 32; 170 if Kind = mkModel then 171 ClientHeight := ClientHeight + 36; 172 if IconKind in [mikMyArmy, mikEnemyArmy] then 173 begin 174 if nLostArmy > LostUnitsPerLine * 6 then 175 ClientHeight := ClientHeight + 6 * 48 176 else 177 ClientHeight := ClientHeight + ((nLostArmy - 1) div LostUnitsPerLine 178 + 1) * 48; 179 end; 180 case CenterTo of 181 0: 182 begin 183 Left := (Screen.Width - ClientWidth) div 2; 184 Top := (Screen.Height - ClientHeight) div 2 - MapCenterUp; 185 end; 186 1: 187 begin 188 Left := (Screen.Width - ClientWidth) div 4; 189 Top := (Screen.Height - ClientHeight) * 2 div 3 - MapCenterUp; 190 end; 191 -1: 192 begin 193 Left := (Screen.Width - ClientWidth) div 4; 194 Top := (Screen.Height - ClientHeight) div 3 - MapCenterUp; 195 end; 196 end; 197 for i := 0 to ControlCount - 1 do 198 Controls[i].Top := ClientHeight - (34 + Border); 199 if Kind = mkModel then 200 EInput.Top := ClientHeight - (76 + Border); 201 end; 202 203 function TMessgExDlg.ShowModal: integer; 204 var 205 Ticks0, Ticks: int64; 206 begin 207 if GameMode = cMovie then 208 begin 209 if not((GameMode = cMovie) and (MovieSpeed = 4)) then 112 210 begin 113 Button1.Caption:=Phrases.Lookup('BTN_OK'); 114 Button2.Caption:=Phrases.Lookup('BTN_CANCEL'); 211 MovieCancelled := false; 212 Show; 213 QueryPerformanceCounter(Ticks0); 214 repeat 215 Application.ProcessMessages; 216 Sleep(1); 217 QueryPerformanceCounter(Ticks); 218 until MovieCancelled or ((Ticks - Ticks0) * 1000 >= 1500 * PerfFreq); 219 Hide; 115 220 end; 116 else 221 result := mrOk; 222 end 223 else 224 result := inherited ShowModal; 225 end; 226 227 procedure TMessgExDlg.CancelMovie; 228 begin 229 MovieCancelled := true; 230 end; 231 232 procedure TMessgExDlg.PaintBook(ca: TCanvas; x, y, clPage, clCover: integer); 233 const 234 xScrewed = 77; 235 yScrewed = 10; 236 wScrewed = 43; 237 hScrewed = 27; 238 type 239 TLine = array [0 .. 9999, 0 .. 2] of Byte; 240 var 241 ix, iy, xDst, yDst, dx, dy, xIcon, yIcon, xb, yb, wb, hb: integer; 242 x1, xR, yR, share: single; 243 Screwed: array [0 .. wScrewed - 1, 0 .. hScrewed - 1, 0 .. 3] of single; 244 SrcLine: ^TLine; 245 246 begin 247 if IconIndex >= 0 then 248 begin 249 xIcon := IconIndex mod 7 * xSizeBig; 250 yIcon := (IconIndex + SystemIconLines * 7) div 7 * ySizeBig; 251 // prepare screwed icon 252 fillchar(Screwed, sizeof(Screwed), 0); 253 for iy := 0 to 39 do 117 254 begin 118 Button1.Caption:=Phrases.Lookup('BTN_OK'); 119 Button2.Caption:=Phrases.Lookup('BTN_INFO'); 255 SrcLine := BigImp.ScanLine[iy + yIcon]; 256 for ix := 0 to 55 do 257 begin 258 xR := ix * (37 + iy * 5 / 40) / 56; 259 xDst := Trunc(xR); 260 xR := Frac(xR); 261 x1 := (120 - ix) * (120 - ix) - 10000; 262 yR := iy * 18 / 40 + x1 * x1 / 4000000; 263 yDst := Trunc(yR); 264 yR := Frac(yR); 265 for dx := 0 to 1 do 266 for dy := 0 to 1 do 267 begin 268 if dx = 0 then 269 share := 1 - xR 270 else 271 share := xR; 272 if dy = 0 then 273 share := share * (1 - yR) 274 else 275 share := share * yR; 276 Screwed[xDst + dx, yDst + dy, 0] := Screwed[xDst + dx, yDst + dy, 0] 277 + share * SrcLine[ix + xIcon, 0]; 278 Screwed[xDst + dx, yDst + dy, 1] := Screwed[xDst + dx, yDst + dy, 1] 279 + share * SrcLine[ix + xIcon, 1]; 280 Screwed[xDst + dx, yDst + dy, 2] := Screwed[xDst + dx, yDst + dy, 2] 281 + share * SrcLine[ix + xIcon, 2]; 282 Screwed[xDst + dx, yDst + dy, 3] := Screwed[xDst + dx, yDst + dy, 283 3] + share; 284 end 285 end; 120 286 end; 121 end; 122 Button3.Caption:=Phrases.Lookup('BTN_CANCEL'); 123 RemoveBtn.Hint:=Phrases.Lookup('BTN_DELGAME'); 124 125 case IconKind of 126 mikImp,mikModel,mikAge,mikPureIcon: 127 TopSpace:=56; 128 mikBigIcon: 129 TopSpace:=152; 130 mikEnemyShipComplete: 131 TopSpace:=136; 132 mikBook: 133 if IconIndex>=0 then TopSpace:=84 134 else TopSpace:=47; 135 mikTribe: 287 xb := xBBook; 288 yb := yBBook; 289 wb := wBBook; 290 hb := hBBook; 291 end 292 else 293 begin 294 xb := xSBook; 295 yb := ySBook; 296 wb := wSBook; 297 hb := hSBook; 298 end; 299 x := x - wb div 2; 300 301 // paint 302 BitBlt(LogoBuffer.Canvas.Handle, 0, 0, wb, hb, ca.Handle, x, y, SRCCOPY); 303 304 if IconIndex >= 0 then 305 for iy := 0 to hScrewed - 1 do 306 for ix := 0 to wScrewed - 1 do 307 if Screwed[ix, iy, 3] > 0.01 then 308 LogoBuffer.Canvas.Pixels[xScrewed + ix, yScrewed + iy] := 309 Trunc(Screwed[ix, iy, 2] / Screwed[ix, iy, 3]) + 310 Trunc(Screwed[ix, iy, 1] / Screwed[ix, iy, 3]) shl 8 + 311 Trunc(Screwed[ix, iy, 0] / Screwed[ix, iy, 3]) shl 16; 312 313 ImageOp_BCC(LogoBuffer, Templates, 0, 0, xb, yb, wb, hb, clCover, clPage); 314 315 BitBlt(ca.Handle, x, y, wb, hb, LogoBuffer.Canvas.Handle, 0, 0, SRCCOPY); 316 end; 317 318 procedure TMessgExDlg.PaintMyArmy; 319 begin 320 end; 321 322 procedure TMessgExDlg.PaintEnemyArmy; 323 var 324 emix, ix, iy, x, y, count, UnitsInLine: integer; 325 begin 326 ix := 0; 327 iy := 0; 328 if nLostArmy > LostUnitsPerLine then 329 UnitsInLine := LostUnitsPerLine 330 else 331 UnitsInLine := nLostArmy; 332 for emix := 0 to MyRO.nEnemyModel - 1 do 333 for count := 0 to LostArmy[emix] - 1 do 136 334 begin 137 Tribe[IconIndex].InitAge(GetAge(IconIndex)); 138 if Tribe[IconIndex].faceHGr>=0 then 139 TopSpace:=64 140 end; 141 mikFullControl: 142 TopSpace:=80; 143 mikShip: 144 TopSpace:=240; 145 else TopSpace:=0; 146 end; 147 148 SplitText(true); 149 ClientHeight:=72+Border+TopSpace+Lines*MessageLineSpacing; 150 if GameMode=cMovie then ClientHeight:=ClientHeight-32; 151 if Kind=mkModel then 152 ClientHeight:=ClientHeight+36; 153 if IconKind in [mikMyArmy,mikEnemyArmy] then 154 begin 155 if nLostArmy>LostUnitsPerLine*6 then ClientHeight:=ClientHeight+6*48 156 else ClientHeight:=ClientHeight+((nLostArmy-1) div LostUnitsPerLine +1)*48; 157 end; 158 case CenterTo of 159 0: 160 begin 161 Left:=(Screen.Width-ClientWidth) div 2; 162 Top:=(Screen.Height-ClientHeight) div 2-MapCenterUp; 163 end; 164 1: 165 begin 166 Left:=(Screen.Width-ClientWidth) div 4; 167 Top:=(Screen.Height-ClientHeight)*2 div 3-MapCenterUp; 168 end; 169 -1: 170 begin 171 Left:=(Screen.Width-ClientWidth) div 4; 172 Top:=(Screen.Height-ClientHeight) div 3-MapCenterUp; 173 end; 174 end; 175 for i:=0 to ControlCount-1 do 176 Controls[i].Top:=ClientHeight-(34+Border); 177 if Kind=mkModel then 178 EInput.Top:=ClientHeight-(76+Border); 179 end; 180 181 function TMessgExDlg.ShowModal: Integer; 182 var 183 Ticks0,Ticks: int64; 184 begin 185 if GameMode=cMovie then 186 begin 187 if not ((GameMode=cMovie) and (MovieSpeed=4)) then 188 begin 189 MovieCancelled:=false; 190 Show; 191 QueryPerformanceCounter(Ticks0); 192 repeat 193 Application.ProcessMessages; 194 Sleep(1); 195 QueryPerformanceCounter(Ticks); 196 until MovieCancelled or ((Ticks-Ticks0)*1000>=1500*PerfFreq); 197 Hide; 198 end; 199 result:=mrOk; 200 end 201 else 202 result:=inherited ShowModal; 203 end; 204 205 procedure TMessgExDlg.CancelMovie; 206 begin 207 MovieCancelled:=true; 208 end; 209 210 procedure TMessgExDlg.PaintBook(ca: TCanvas; x,y,clPage,clCover: integer); 211 const 212 xScrewed=77; yScrewed=10; wScrewed=43; hScrewed=27; 213 type 214 TLine=array[0..9999,0..2] of Byte; 215 var 216 ix,iy,xDst,yDst,dx,dy,xIcon,yIcon,xb,yb,wb,hb: integer; 217 x1,xR,yR,share: single; 218 Screwed: array[0..wScrewed-1,0..hScrewed-1,0..3] of single; 219 SrcLine: ^TLine; 220 221 begin 222 if IconIndex>=0 then 223 begin 224 xIcon:=IconIndex mod 7*xSizeBig; 225 yIcon:=(IconIndex+SystemIconLines*7) div 7*ySizeBig; 226 // prepare screwed icon 227 fillchar(Screwed,sizeof(Screwed),0); 228 for iy:=0 to 39 do 229 begin 230 SrcLine:=BigImp.ScanLine[iy+yIcon]; 231 for ix:=0 to 55 do 232 begin 233 xR:=ix*(37+iy*5/40)/56; 234 xDst:=Trunc(xR); 235 xR:=Frac(xR); 236 x1:=(120-ix)*(120-ix)-10000; 237 yR:=iy*18/40 +x1*x1/4000000; 238 yDst:=Trunc(yR); 239 yR:=Frac(yR); 240 for dx:=0 to 1 do for dy:=0 to 1 do 241 begin 242 if dx=0 then share:=1-xR else share:=xR; 243 if dy=0 then share:=share*(1-yR) else share:=share*yR; 244 Screwed[xDst+dx,yDst+dy,0]:= 245 Screwed[xDst+dx,yDst+dy,0]+share*SrcLine[ix+xIcon,0]; 246 Screwed[xDst+dx,yDst+dy,1]:= 247 Screwed[xDst+dx,yDst+dy,1]+share*SrcLine[ix+xIcon,1]; 248 Screwed[xDst+dx,yDst+dy,2]:= 249 Screwed[xDst+dx,yDst+dy,2]+share*SrcLine[ix+xIcon,2]; 250 Screwed[xDst+dx,yDst+dy,3]:= 251 Screwed[xDst+dx,yDst+dy,3]+share; 252 end 253 end; 254 end; 255 xb:=xBBook; yb:=yBBook; wb:=wBBook; hb:=hBBook; 256 end 257 else begin xb:=xSBook; yb:=ySBook; wb:=wSBook; hb:=hSBook; end; 258 x:=x-wb div 2; 259 260 // paint 261 BitBlt(LogoBuffer.Canvas.Handle,0,0,wb,hb,ca.handle,x,y,SRCCOPY); 262 263 if IconIndex>=0 then 264 for iy:=0 to hScrewed-1 do for ix:=0 to wScrewed-1 do 265 if Screwed[ix,iy,3]>0.01 then 266 LogoBuffer.Canvas.Pixels[xScrewed+ix,yScrewed+iy]:= 267 trunc(Screwed[ix,iy,2]/Screwed[ix,iy,3]) 268 +trunc(Screwed[ix,iy,1]/Screwed[ix,iy,3]) shl 8 269 +trunc(Screwed[ix,iy,0]/Screwed[ix,iy,3]) shl 16; 270 271 ImageOp_BCC(LogoBuffer,Templates,0,0,xb,yb,wb,hb,clCover,clPage); 272 273 BitBlt(ca.handle,x,y,wb,hb,LogoBuffer.Canvas.Handle,0,0,SRCCOPY); 274 end; 275 276 procedure TMessgExDlg.PaintMyArmy; 277 begin 278 end; 279 280 procedure TMessgExDlg.PaintEnemyArmy; 281 var 282 emix,ix,iy,x,y,count,UnitsInLine: integer; 283 begin 284 ix:=0; 285 iy:=0; 286 if nLostArmy>LostUnitsPerLine then 287 UnitsInLine:=LostUnitsPerLine 288 else UnitsInLine:=nLostArmy; 289 for emix:=0 to MyRO.nEnemyModel-1 do 290 for count:=0 to LostArmy[emix]-1 do 291 begin 292 x:=ClientWidth div 2+ix*64-UnitsInLine*32; 293 y:=26+Border+TopSpace+Lines*MessageLineSpacing+iy*48; 294 with MyRO.EnemyModel[emix],Tribe[Owner].ModelPicture[mix] do 295 begin 296 BitBlt(Canvas.Handle,x,y,64,48,GrExt[HGr].Mask.Canvas.Handle, 297 pix mod 10 *65+1,pix div 10 *49+1,SRCAND); 298 BitBlt(Canvas.Handle,x,y,64,48,GrExt[HGr].Data.Canvas.Handle, 299 pix mod 10 *65+1,pix div 10 *49+1,SRCPAINT); 300 end; 301 302 // next position 303 inc(ix); 304 if ix=LostUnitsPerLine then 335 x := ClientWidth div 2 + ix * 64 - UnitsInLine * 32; 336 y := 26 + Border + TopSpace + Lines * MessageLineSpacing + iy * 48; 337 with MyRO.EnemyModel[emix], Tribe[Owner].ModelPicture[mix] do 338 begin 339 BitBlt(Canvas.Handle, x, y, 64, 48, GrExt[HGr].Mask.Canvas.Handle, 340 pix mod 10 * 65 + 1, pix div 10 * 49 + 1, SRCAND); 341 BitBlt(Canvas.Handle, x, y, 64, 48, GrExt[HGr].Data.Canvas.Handle, 342 pix mod 10 * 65 + 1, pix div 10 * 49 + 1, SRCPAINT); 343 end; 344 345 // next position 346 inc(ix); 347 if ix = LostUnitsPerLine then 305 348 begin // next line 306 ix:=0;307 inc(iy);308 if iy=6 then309 exit;310 UnitsInLine:=nLostArmy-LostUnitsPerLine*iy;311 if UnitsInLine>LostUnitsPerLine then312 UnitsInLine:=LostUnitsPerLine;349 ix := 0; 350 inc(iy); 351 if iy = 6 then 352 exit; 353 UnitsInLine := nLostArmy - LostUnitsPerLine * iy; 354 if UnitsInLine > LostUnitsPerLine then 355 UnitsInLine := LostUnitsPerLine; 313 356 end 314 357 end; 315 358 end; 316 359 317 procedure TMessgExDlg.FormPaint(Sender: TObject);318 var 319 p1,clSaveTextLight,clSaveTextShade: integer;320 begin 321 if (IconKind=mikImp) and (IconIndex=27) then360 procedure TMessgExDlg.FormPaint(Sender: TObject); 361 var 362 p1, clSaveTextLight, clSaveTextShade: integer; 363 begin 364 if (IconKind = mikImp) and (IconIndex = 27) then 322 365 begin // "YOU WIN" message 323 clSaveTextLight:=MainTexture.clTextLight; 324 clSaveTextShade:=MainTexture.clTextShade; 325 MainTexture.clTextLight:=$000000; // gold 326 MainTexture.clTextShade:=$0FDBFF; 327 inherited; 328 MainTexture.clTextLight:=clSaveTextLight; 329 MainTexture.clTextShade:=clSaveTextShade; 330 end 331 else 332 inherited; 333 334 case IconKind of 335 mikImp: 336 if Imp[IconIndex].Kind=ikWonder then 337 begin 338 p1:=MyRO.Wonder[IconIndex].EffectiveOwner; 339 BitBlt(Buffer.Canvas.Handle,0,0,xSizeBig+2*GlowRange,ySizeBig+2*GlowRange, 340 Canvas.Handle,ClientWidth div 2-(28+GlowRange),24-GlowRange,SRCCOPY); 341 BitBlt(Buffer.Canvas.Handle,GlowRange,GlowRange,xSizeBig,ySizeBig, 342 BigImp.Canvas.Handle,IconIndex mod 7*xSizeBig, 343 (IconIndex+SystemIconLines*7) div 7*ySizeBig,SRCCOPY); 344 if p1<0 then 345 GlowFrame(Buffer, GlowRange, GlowRange, xSizeBig, ySizeBig, $000000) 346 else GlowFrame(Buffer, GlowRange, GlowRange, xSizeBig, ySizeBig, 347 Tribe[p1].Color); 348 BitBlt(Canvas.Handle,ClientWidth div 2-(28+GlowRange),24-GlowRange, 349 xSizeBig+2*GlowRange,ySizeBig+2*GlowRange,Buffer.Canvas.Handle,0,0, 350 SRCCOPY); 366 clSaveTextLight := MainTexture.clTextLight; 367 clSaveTextShade := MainTexture.clTextShade; 368 MainTexture.clTextLight := $000000; // gold 369 MainTexture.clTextShade := $0FDBFF; 370 inherited; 371 MainTexture.clTextLight := clSaveTextLight; 372 MainTexture.clTextShade := clSaveTextShade; 373 end 374 else 375 inherited; 376 377 case IconKind of 378 mikImp: 379 if Imp[IconIndex].Kind = ikWonder then 380 begin 381 p1 := MyRO.Wonder[IconIndex].EffectiveOwner; 382 BitBlt(Buffer.Canvas.Handle, 0, 0, xSizeBig + 2 * GlowRange, 383 ySizeBig + 2 * GlowRange, Canvas.Handle, 384 ClientWidth div 2 - (28 + GlowRange), 24 - GlowRange, SRCCOPY); 385 BitBlt(Buffer.Canvas.Handle, GlowRange, GlowRange, xSizeBig, ySizeBig, 386 BigImp.Canvas.Handle, IconIndex mod 7 * xSizeBig, 387 (IconIndex + SystemIconLines * 7) div 7 * ySizeBig, SRCCOPY); 388 if p1 < 0 then 389 GlowFrame(Buffer, GlowRange, GlowRange, xSizeBig, ySizeBig, $000000) 390 else 391 GlowFrame(Buffer, GlowRange, GlowRange, xSizeBig, ySizeBig, 392 Tribe[p1].Color); 393 BitBlt(Canvas.Handle, ClientWidth div 2 - (28 + GlowRange), 394 24 - GlowRange, xSizeBig + 2 * GlowRange, ySizeBig + 2 * GlowRange, 395 Buffer.Canvas.Handle, 0, 0, SRCCOPY); 351 396 end 352 else ImpImage(Canvas,ClientWidth div 2-28,24,IconIndex); 353 mikAge: 354 begin 355 if IconIndex=0 then 356 ImpImage(Canvas,ClientWidth div 2-28,24,-7) 357 else ImpImage(Canvas,ClientWidth div 2-28,24,24+IconIndex) 358 end; 359 mikModel: 360 with Tribe[me].ModelPicture[IconIndex] do 361 begin 362 FrameImage(Canvas,BigImp,ClientWidth div 2-28,24,xSizeBig,ySizeBig,0,0); 363 BitBlt(Canvas.Handle,ClientWidth div 2-32,20,64,44, 364 GrExt[HGr].Mask.Canvas.Handle,pix mod 10 *65+1,pix div 10*49+1,SRCAND); 365 BitBlt(Canvas.Handle,ClientWidth div 2-32,20,64,44, 366 GrExt[HGr].Data.Canvas.Handle,pix mod 10 *65+1,pix div 10*49+1,SRCPAINT); 367 end; 368 mikBook: 369 PaintBook(Canvas,ClientWidth div 2,24,MainTexture.clPage,MainTexture.clCover); 370 mikTribe: 371 if Tribe[IconIndex].faceHGr>=0 then 372 begin 373 Frame(Canvas,ClientWidth div 2-32-1,24-1,ClientWidth div 2+32, 374 24+48,$000000,$000000); 375 BitBlt(Canvas.Handle,ClientWidth div 2-32,24,64,48, 376 GrExt[Tribe[IconIndex].faceHGr].Data.Canvas.Handle, 377 1+Tribe[IconIndex].facepix mod 10 *65, 378 1+Tribe[IconIndex].facepix div 10 *49, SRCCOPY) 379 end; 380 mikPureIcon: 381 FrameImage(Canvas, BigImp, ClientWidth div 2-28,24,xSizeBig, ySizeBig, 382 IconIndex mod 7*xSizeBig, 383 IconIndex div 7*ySizeBig); 384 mikBigIcon: 385 FrameImage(Canvas, BigImp, ClientWidth div 2-3*28,32,xSizeBig*3, ySizeBig*3, 386 IconIndex mod 2*3*xSizeBig, 387 IconIndex div 2*3*ySizeBig); 388 mikEnemyShipComplete: 389 begin 390 BitBlt(Buffer.Canvas.Handle,0,0,140,120,Canvas.Handle, 391 (ClientWidth-140) div 2,24,SRCCOPY); 392 ImageOp_BCC(Buffer,Templates,0,0,1,279,140,120,0,$FFFFFF); 393 BitBlt(Canvas.Handle,(ClientWidth-140) div 2,24,140, 394 120,Buffer.Canvas.Handle,0,0,SRCCOPY); 395 end; 396 mikMyArmy: 397 PaintMyArmy; 398 mikEnemyArmy: 399 PaintEnemyArmy; 400 mikFullControl: 401 Sprite(Canvas,HGrSystem2,ClientWidth div 2-31,24,63,63,1,281); 402 mikShip: 403 PaintColonyShip(Canvas,IconIndex,17,ClientWidth-34,38); 404 end; 405 406 if EInput.Visible then EditFrame(Canvas,EInput.BoundsRect,MainTexture); 407 408 if OpenSound<>'' then PostMessage(Handle, WM_PLAYSOUND, 0, 0); 409 end; {FormPaint} 397 else 398 ImpImage(Canvas, ClientWidth div 2 - 28, 24, IconIndex); 399 mikAge: 400 begin 401 if IconIndex = 0 then 402 ImpImage(Canvas, ClientWidth div 2 - 28, 24, -7) 403 else 404 ImpImage(Canvas, ClientWidth div 2 - 28, 24, 24 + IconIndex) 405 end; 406 mikModel: 407 with Tribe[me].ModelPicture[IconIndex] do 408 begin 409 FrameImage(Canvas, BigImp, ClientWidth div 2 - 28, 24, xSizeBig, 410 ySizeBig, 0, 0); 411 BitBlt(Canvas.Handle, ClientWidth div 2 - 32, 20, 64, 44, 412 GrExt[HGr].Mask.Canvas.Handle, pix mod 10 * 65 + 1, 413 pix div 10 * 49 + 1, SRCAND); 414 BitBlt(Canvas.Handle, ClientWidth div 2 - 32, 20, 64, 44, 415 GrExt[HGr].Data.Canvas.Handle, pix mod 10 * 65 + 1, 416 pix div 10 * 49 + 1, SRCPAINT); 417 end; 418 mikBook: 419 PaintBook(Canvas, ClientWidth div 2, 24, MainTexture.clPage, 420 MainTexture.clCover); 421 mikTribe: 422 if Tribe[IconIndex].faceHGr >= 0 then 423 begin 424 Frame(Canvas, ClientWidth div 2 - 32 - 1, 24 - 1, 425 ClientWidth div 2 + 32, 24 + 48, $000000, $000000); 426 BitBlt(Canvas.Handle, ClientWidth div 2 - 32, 24, 64, 48, 427 GrExt[Tribe[IconIndex].faceHGr].Data.Canvas.Handle, 428 1 + Tribe[IconIndex].facepix mod 10 * 65, 429 1 + Tribe[IconIndex].facepix div 10 * 49, SRCCOPY) 430 end; 431 mikPureIcon: 432 FrameImage(Canvas, BigImp, ClientWidth div 2 - 28, 24, xSizeBig, ySizeBig, 433 IconIndex mod 7 * xSizeBig, IconIndex div 7 * ySizeBig); 434 mikBigIcon: 435 FrameImage(Canvas, BigImp, ClientWidth div 2 - 3 * 28, 32, xSizeBig * 3, 436 ySizeBig * 3, IconIndex mod 2 * 3 * xSizeBig, 437 IconIndex div 2 * 3 * ySizeBig); 438 mikEnemyShipComplete: 439 begin 440 BitBlt(Buffer.Canvas.Handle, 0, 0, 140, 120, Canvas.Handle, 441 (ClientWidth - 140) div 2, 24, SRCCOPY); 442 ImageOp_BCC(Buffer, Templates, 0, 0, 1, 279, 140, 120, 0, $FFFFFF); 443 BitBlt(Canvas.Handle, (ClientWidth - 140) div 2, 24, 140, 120, 444 Buffer.Canvas.Handle, 0, 0, SRCCOPY); 445 end; 446 mikMyArmy: 447 PaintMyArmy; 448 mikEnemyArmy: 449 PaintEnemyArmy; 450 mikFullControl: 451 Sprite(Canvas, HGrSystem2, ClientWidth div 2 - 31, 24, 63, 63, 1, 281); 452 mikShip: 453 PaintColonyShip(Canvas, IconIndex, 17, ClientWidth - 34, 38); 454 end; 455 456 if EInput.Visible then 457 EditFrame(Canvas, EInput.BoundsRect, MainTexture); 458 459 if OpenSound <> '' then 460 PostMessage(Handle, WM_PLAYSOUND, 0, 0); 461 end; { FormPaint } 410 462 411 463 procedure TMessgExDlg.Button1Click(Sender: TObject); 412 464 begin 413 ModalResult:=mrOK;465 ModalResult := mrOk; 414 466 end; 415 467 416 468 procedure TMessgExDlg.Button2Click(Sender: TObject); 417 469 begin 418 if Kind=mkOkHelp then 419 HelpDlg.ShowNewContent(wmSubmodal, HelpKind, HelpNo) 420 else if Kind=mkModel then 421 UnitStatDlg.ShowNewContent_OwnModel(wmSubmodal, IconIndex) 422 else ModalResult:=mrIgnore; 470 if Kind = mkOkHelp then 471 HelpDlg.ShowNewContent(wmSubmodal, HelpKind, HelpNo) 472 else if Kind = mkModel then 473 UnitStatDlg.ShowNewContent_OwnModel(wmSubmodal, IconIndex) 474 else 475 ModalResult := mrIgnore; 423 476 end; 424 477 425 478 procedure TMessgExDlg.Button3Click(Sender: TObject); 426 479 begin 427 ModalResult:=mrCancel480 ModalResult := mrCancel 428 481 end; 429 482 430 483 procedure TMessgExDlg.RemoveBtnClick(Sender: TObject); 431 484 begin 432 ModalResult:=mrNo485 ModalResult := mrNo 433 486 end; 434 487 435 488 procedure TMessgExDlg.FormKeyPress(Sender: TObject; var Key: char); 436 489 begin 437 if Key=#13 then ModalResult:=mrOK 438 else if (Key=#27) then 439 if Button3.Visible then ModalResult:=mrCancel 440 else if Button2.Visible then ModalResult:=mrIgnore 490 if Key = #13 then 491 ModalResult := mrOk 492 else if (Key = #27) then 493 if Button3.Visible then 494 ModalResult := mrCancel 495 else if Button2.Visible then 496 ModalResult := mrIgnore 441 497 end; 442 498 … … 444 500 // because Messg.SoundMessage not capable of movie mode 445 501 begin 446 with MessgExDlg do447 begin 448 MessgText:=SimpleText;449 OpenSound:=SoundItem;450 Kind:=mkOK;451 ShowModal;502 with MessgExDlg do 503 begin 504 MessgText := SimpleText; 505 OpenSound := SoundItem; 506 Kind := mkOk; 507 ShowModal; 452 508 end 453 509 end; … … 455 511 procedure TribeMessage(p: integer; SimpleText, SoundItem: string); 456 512 begin 457 with MessgExDlg do458 begin 459 OpenSound:=SoundItem;460 MessgText:=SimpleText;461 Kind:=mkOK;462 IconKind:=mikTribe;463 IconIndex:=p;464 ShowModal;465 end; 466 end; 467 468 function SimpleQuery(QueryKind: integer; SimpleText, SoundItem: string) :469 integer;470 begin 471 with MessgExDlg do472 begin 473 MessgText:=SimpleText;474 OpenSound:=SoundItem;475 Kind:=QueryKind;476 ShowModal;477 result:=ModalResult478 end 479 end; 480 481 procedure ContextMessage(SimpleText, SoundItem: string; ContextKind,482 Context No: integer);483 begin 484 with MessgExDlg do485 begin 486 MessgText:=SimpleText;487 OpenSound:=SoundItem;488 Kind:=mkOkHelp;489 HelpKind:=ContextKind;490 HelpNo:=ContextNo;491 ShowModal;513 with MessgExDlg do 514 begin 515 OpenSound := SoundItem; 516 MessgText := SimpleText; 517 Kind := mkOk; 518 IconKind := mikTribe; 519 IconIndex := p; 520 ShowModal; 521 end; 522 end; 523 524 function SimpleQuery(QueryKind: integer; SimpleText, SoundItem: string) 525 : integer; 526 begin 527 with MessgExDlg do 528 begin 529 MessgText := SimpleText; 530 OpenSound := SoundItem; 531 Kind := QueryKind; 532 ShowModal; 533 result := ModalResult 534 end 535 end; 536 537 procedure ContextMessage(SimpleText, SoundItem: string; 538 ContextKind, ContextNo: integer); 539 begin 540 with MessgExDlg do 541 begin 542 MessgText := SimpleText; 543 OpenSound := SoundItem; 544 Kind := mkOkHelp; 545 HelpKind := ContextKind; 546 HelpNo := ContextNo; 547 ShowModal; 492 548 end 493 549 end; … … 495 551 procedure TMessgExDlg.FormClose(Sender: TObject; var Action: TCloseAction); 496 552 begin 497 IconKind:=mikNone; 498 CenterTo:=0; 499 end; 500 501 procedure TMessgExDlg.OnPlaySound(var Msg:TMessage); 502 begin 503 Play(OpenSound); 504 OpenSound:=''; 505 end; 506 553 IconKind := mikNone; 554 CenterTo := 0; 555 end; 556 557 procedure TMessgExDlg.OnPlaySound(var Msg: TMessage); 558 begin 559 Play(OpenSound); 560 OpenSound := ''; 561 end; 507 562 508 563 initialization 564 509 565 QueryPerformanceFrequency(PerfFreq); 510 566 511 567 end. 512 -
trunk/LocalPlayer/NatStat.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit NatStat; 4 3 … … 6 5 7 6 uses 8 Protocol, ClientTools,Term,ScreenTools,BaseWin,7 Protocol, ClientTools, Term, ScreenTools, BaseWin, 9 8 10 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, … … 12 11 13 12 type 14 PEnemyReport =^TEnemyReport;13 PEnemyReport = ^TEnemyReport; 15 14 16 15 TNatStatDlg = class(TBufferedDrawDlg) … … 28 27 procedure ToggleBtnClick(Sender: TObject); 29 28 procedure PlayerClick(Sender: TObject); 30 procedure FormKeyDown(Sender: TObject; var Key: word; 31 Shift: TShiftState); 29 procedure FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState); 32 30 procedure FormDestroy(Sender: TObject); 33 31 procedure ScrollUpBtnClick(Sender: TObject); … … 45 43 private 46 44 pView, AgePrepared, LinesDown: integer; 47 SelfReport, CurrentReport: PEnemyReport;48 ShowContact, ContactEnabled: boolean;45 SelfReport, CurrentReport: PEnemyReport; 46 ShowContact, ContactEnabled: boolean; 49 47 Back, Template: TBitmap; 50 48 ReportText: TStringList; … … 55 53 NatStatDlg: TNatStatDlg; 56 54 57 58 55 implementation 59 56 … … 61 58 62 59 uses 63 Diagram, Select,Messg,MessgEx, Help,Tribes,Directories;60 Diagram, Select, Messg, MessgEx, Help, Tribes, Directories; 64 61 65 62 const 66 xIcon=326; yIcon=49; 67 xAttrib=96; yAttrib=40; 68 xRelation=16; yRelation=110; 69 PaperShade=3; 70 ReportLines=12; 71 LineSpacing=22; 72 xReport=24; yReport=165; wReport=352; hReport=ReportLines*LineSpacing; 73 63 xIcon = 326; 64 yIcon = 49; 65 xAttrib = 96; 66 yAttrib = 40; 67 xRelation = 16; 68 yRelation = 110; 69 PaperShade = 3; 70 ReportLines = 12; 71 LineSpacing = 22; 72 xReport = 24; 73 yReport = 165; 74 wReport = 352; 75 hReport = ReportLines * LineSpacing; 74 76 75 77 procedure TNatStatDlg.FormCreate(Sender: TObject); 76 78 begin 77 inherited; 78 AgePrepared:=-2; 79 GetMem(SelfReport,SizeOf(TEnemyReport)-2*(INFIN+1)); 80 ReportText:=TStringList.Create; 81 InitButtons(); 82 ContactBtn.Template:=Templates; 83 HelpContext:='DIPLOMACY'; 84 ToggleBtn.Hint:=Phrases.Lookup('BTN_SELECT'); 85 ContactBtn.Hint:=Phrases.Lookup('BTN_DIALOG'); 86 87 Back:=TBitmap.Create; 88 Back.PixelFormat:=pf24bit; 89 Back.Width:=ClientWidth; Back.Height:=ClientHeight; 90 Template:=TBitmap.Create; 91 LoadGraphicFile(Template, HomeDir+'Graphics\Nation', gfNoGamma); 92 Template.PixelFormat:=pf8bit; 79 inherited; 80 AgePrepared := -2; 81 GetMem(SelfReport, SizeOf(TEnemyReport) - 2 * (INFIN + 1)); 82 ReportText := TStringList.Create; 83 InitButtons(); 84 ContactBtn.Template := Templates; 85 HelpContext := 'DIPLOMACY'; 86 ToggleBtn.Hint := Phrases.Lookup('BTN_SELECT'); 87 ContactBtn.Hint := Phrases.Lookup('BTN_DIALOG'); 88 89 Back := TBitmap.Create; 90 Back.PixelFormat := pf24bit; 91 Back.Width := ClientWidth; 92 Back.Height := ClientHeight; 93 Template := TBitmap.Create; 94 LoadGraphicFile(Template, HomeDir + 'Graphics\Nation', gfNoGamma); 95 Template.PixelFormat := pf8bit; 93 96 end; 94 97 95 98 procedure TNatStatDlg.FormDestroy(Sender: TObject); 96 99 begin 97 ReportText.Free;98 FreeMem(SelfReport);99 Template.Free;100 Back.Free;100 ReportText.Free; 101 FreeMem(SelfReport); 102 Template.Free; 103 Back.Free; 101 104 end; 102 105 103 106 procedure TNatStatDlg.CheckAge; 104 107 begin 105 if MainTextureAge<>AgePrepared then106 begin 107 AgePrepared:=MainTextureAge;108 bitblt(Back.Canvas.Handle,0,0,ClientWidth,ClientHeight,109 MainTexture.Image.Canvas.Handle,(wMainTexture-ClientWidth) div 2,110 (hMainTexture-ClientHeight) div 2,SRCCOPY);111 ImageOp_B(Back,Template,0,0,0,0,ClientWidth,ClientHeight);108 if MainTextureAge <> AgePrepared then 109 begin 110 AgePrepared := MainTextureAge; 111 bitblt(Back.Canvas.Handle, 0, 0, ClientWidth, ClientHeight, 112 MainTexture.Image.Canvas.Handle, (wMainTexture - ClientWidth) div 2, 113 (hMainTexture - ClientHeight) div 2, SRCCOPY); 114 ImageOp_B(Back, Template, 0, 0, 0, 0, ClientWidth, ClientHeight); 112 115 end 113 116 end; … … 115 118 procedure TNatStatDlg.FormShow(Sender: TObject); 116 119 begin 117 if pView=me then 118 begin 119 SelfReport.TurnOfCivilReport:=MyRO.Turn; 120 SelfReport.TurnOfMilReport:=MyRO.Turn; 121 move(MyRO.Treaty, SelfReport.Treaty, sizeof(SelfReport.Treaty)); 122 SelfReport.Government:=MyRO.Government; 123 SelfReport.Money:=MyRO.Money; 124 CurrentReport:=pointer(SelfReport); 125 end 126 else CurrentReport:=pointer(MyRO.EnemyReport[pView]); 127 if CurrentReport.TurnOfCivilReport>=0 then 128 GenerateReportText; 129 ShowContact:= (pView<>me) and (not supervising or (me<>0)); 130 ContactEnabled:= ShowContact and not supervising 131 and (1 shl pView and MyRO.Alive<>0); 132 ContactBtn.Visible:=ContactEnabled and (MyRO.Happened and phGameEnd=0) 133 and (ClientMode<scContact); 134 ScrollUpBtn.Visible:=(CurrentReport.TurnOfCivilReport>=0) 135 and (ReportText.Count>ReportLines); 136 ScrollDownBtn.Visible:=(CurrentReport.TurnOfCivilReport>=0) 137 and (ReportText.Count>ReportLines); 138 if OptionChecked and (1 shl soTellAI)<>0 then 139 TellAIBtn.ButtonIndex:=3 140 else TellAIBtn.ButtonIndex:=2; 141 Caption:=Tribe[pView].TPhrase('TITLE_NATION'); 142 LinesDown:=0; 143 144 OffscreenPaint; 145 end; 146 147 procedure TNatStatDlg.ShowNewContent(NewMode,p: integer); 148 begin 149 if p<0 then 150 if ClientMode>=scContact then 151 pView:=DipMem[me].pContact 120 if pView = me then 121 begin 122 SelfReport.TurnOfCivilReport := MyRO.Turn; 123 SelfReport.TurnOfMilReport := MyRO.Turn; 124 move(MyRO.Treaty, SelfReport.Treaty, SizeOf(SelfReport.Treaty)); 125 SelfReport.Government := MyRO.Government; 126 SelfReport.Money := MyRO.Money; 127 CurrentReport := pointer(SelfReport); 128 end 152 129 else 153 begin 154 pView:=0; 155 while (pView<nPl) and ((MyRO.Treaty[pView]<trNone) 156 or (1 shl pView and MyRO.Alive=0)) do 157 inc(pView); 158 if pView>=nPl then pView:=me; 130 CurrentReport := pointer(MyRO.EnemyReport[pView]); 131 if CurrentReport.TurnOfCivilReport >= 0 then 132 GenerateReportText; 133 ShowContact := (pView <> me) and (not supervising or (me <> 0)); 134 ContactEnabled := ShowContact and not supervising and 135 (1 shl pView and MyRO.Alive <> 0); 136 ContactBtn.Visible := ContactEnabled and (MyRO.Happened and phGameEnd = 0) and 137 (ClientMode < scContact); 138 ScrollUpBtn.Visible := (CurrentReport.TurnOfCivilReport >= 0) and 139 (ReportText.Count > ReportLines); 140 ScrollDownBtn.Visible := (CurrentReport.TurnOfCivilReport >= 0) and 141 (ReportText.Count > ReportLines); 142 if OptionChecked and (1 shl soTellAI) <> 0 then 143 TellAIBtn.ButtonIndex := 3 144 else 145 TellAIBtn.ButtonIndex := 2; 146 Caption := Tribe[pView].TPhrase('TITLE_NATION'); 147 LinesDown := 0; 148 149 OffscreenPaint; 150 end; 151 152 procedure TNatStatDlg.ShowNewContent(NewMode, p: integer); 153 begin 154 if p < 0 then 155 if ClientMode >= scContact then 156 pView := DipMem[me].pContact 157 else 158 begin 159 pView := 0; 160 while (pView < nPl) and ((MyRO.Treaty[pView] < trNone) or 161 (1 shl pView and MyRO.Alive = 0)) do 162 inc(pView); 163 if pView >= nPl then 164 pView := me; 159 165 end 160 else pView:=p; 161 inherited ShowNewContent(NewMode); 166 else 167 pView := p; 168 inherited ShowNewContent(NewMode); 162 169 end; 163 170 164 171 procedure TNatStatDlg.PlayerClick(Sender: TObject); 165 172 begin 166 ShowNewContent(FWindowMode, TComponent(Sender).Tag);173 ShowNewContent(FWindowMode, TComponent(Sender).Tag); 167 174 end; 168 175 169 176 procedure TNatStatDlg.GenerateReportText; 170 177 var 171 List: ^TChart;178 List: ^TChart; 172 179 173 180 function StatText(no: integer): string; 174 181 var 175 i: integer; 176 begin 177 if (CurrentReport.TurnOfCivilReport>=0) and (Server(sGetChart+no shl 4,me,pView,List^)>=rExecuted) then 178 begin 179 i:=List[CurrentReport.TurnOfCivilReport]; 180 case no of 181 stPop: result:=Format(Phrases.Lookup('FRSTATPOP'),[i]); 182 stTerritory: result:=Format(Phrases.Lookup('FRSTATTER'),[i]); 183 stScience: result:=Format(Phrases.Lookup('FRSTATTECH'),[i div nAdv]); 184 stExplore: result:=Format(Phrases.Lookup('FRSTATEXP'),[i*100 div (G.lx*G.ly)]); 182 i: integer; 183 begin 184 if (CurrentReport.TurnOfCivilReport >= 0) and 185 (Server(sGetChart + no shl 4, me, pView, List^) >= rExecuted) then 186 begin 187 i := List[CurrentReport.TurnOfCivilReport]; 188 case no of 189 stPop: 190 result := Format(Phrases.Lookup('FRSTATPOP'), [i]); 191 stTerritory: 192 result := Format(Phrases.Lookup('FRSTATTER'), [i]); 193 stScience: 194 result := Format(Phrases.Lookup('FRSTATTECH'), [i div nAdv]); 195 stExplore: 196 result := Format(Phrases.Lookup('FRSTATEXP'), 197 [i * 100 div (G.lx * G.ly)]); 185 198 end; 186 199 end … … 188 201 189 202 var 190 p1,Treaty: integer; 191 s: string; 192 HasContact,ExtinctPart: boolean; 193 begin 194 GetMem(List,4*(MyRO.Turn+2)); 195 196 ReportText.Clear; 197 ReportText.Add(''); 198 if (MyRO.Turn-CurrentReport.TurnOfCivilReport>1) 199 and (1 shl pView and MyRO.Alive<>0) then 200 begin 201 s:=Format(Phrases.Lookup('FROLDCIVILREP'), 202 [TurnToString(CurrentReport.TurnOfCivilReport)]); 203 ReportText.Add('C'+s); 203 p1, Treaty: integer; 204 s: string; 205 HasContact, ExtinctPart: boolean; 206 begin 207 GetMem(List, 4 * (MyRO.Turn + 2)); 208 209 ReportText.Clear; 204 210 ReportText.Add(''); 205 end; 206 207 if (1 shl pView and MyRO.Alive<>0) then 208 begin 209 ReportText.Add('M'+Format(Phrases.Lookup('FRTREASURY'),[CurrentReport.Money])); 210 ReportText.Add('P'+StatText(stPop)); 211 ReportText.Add('T'+StatText(stTerritory)); 212 end; 213 ReportText.Add('S'+StatText(stScience)); 214 ReportText.Add('E'+StatText(stExplore)); 215 HasContact:=false; 216 for p1:=0 to nPl-1 do 217 if (p1<>me) and (CurrentReport.Treaty[p1]>trNoContact) then 218 HasContact:=true; 219 if HasContact then 220 begin 211 if (MyRO.Turn - CurrentReport.TurnOfCivilReport > 1) and 212 (1 shl pView and MyRO.Alive <> 0) then 213 begin 214 s := Format(Phrases.Lookup('FROLDCIVILREP'), 215 [TurnToString(CurrentReport.TurnOfCivilReport)]); 216 ReportText.Add('C' + s); 217 ReportText.Add(''); 218 end; 219 220 if (1 shl pView and MyRO.Alive <> 0) then 221 begin 222 ReportText.Add('M' + Format(Phrases.Lookup('FRTREASURY'), 223 [CurrentReport.Money])); 224 ReportText.Add('P' + StatText(stPop)); 225 ReportText.Add('T' + StatText(stTerritory)); 226 end; 227 ReportText.Add('S' + StatText(stScience)); 228 ReportText.Add('E' + StatText(stExplore)); 229 HasContact := false; 230 for p1 := 0 to nPl - 1 do 231 if (p1 <> me) and (CurrentReport.Treaty[p1] > trNoContact) then 232 HasContact := true; 233 if HasContact then 234 begin 235 ReportText.Add(''); 236 ReportText.Add(' ' + Phrases.Lookup('FRRELATIONS')); 237 for ExtinctPart := false to true do 238 for Treaty := trAlliance downto trNone do 239 for p1 := 0 to nPl - 1 do 240 if (p1 <> me) and (CurrentReport.Treaty[p1] = Treaty) and 241 ((1 shl p1 and MyRO.Alive = 0) = ExtinctPart) then 242 begin 243 s := Tribe[p1].TString(Phrases.Lookup('HAVETREATY', Treaty)); 244 if ExtinctPart then 245 s := '(' + s + ')'; 246 ReportText.Add(char(48 + Treaty) + s); 247 end; 248 end; 221 249 ReportText.Add(''); 222 ReportText.Add(' '+Phrases.Lookup('FRRELATIONS')); 223 for ExtinctPart:=false to true do 224 for Treaty:=trAlliance downto trNone do 225 for p1:=0 to nPl-1 do 226 if (p1<>me) and (CurrentReport.Treaty[p1]=Treaty) 227 and ((1 shl p1 and MyRO.Alive=0)=ExtinctPart) then 228 begin 229 s:=Tribe[p1].TString(Phrases.Lookup('HAVETREATY', Treaty)); 230 if ExtinctPart then s:='('+s+')'; 231 ReportText.Add(char(48+Treaty)+s); 232 end; 233 end; 234 ReportText.Add(''); 235 236 FreeMem(List); 250 251 FreeMem(List); 237 252 end; 238 253 239 254 procedure TNatStatDlg.OffscreenPaint; 240 255 var 241 i, y: integer; 242 s: string; 243 ps: pchar; 244 Extinct: boolean; 245 246 begin 247 inherited; 248 249 Extinct:= 1 shl pView and MyRO.Alive=0; 250 251 bitblt(offscreen.canvas.handle,0,0,ClientWidth,ClientHeight,Back.Canvas.handle,0,0,SRCCOPY); 252 253 offscreen.Canvas.Font.Assign(UniFont[ftCaption]); 254 RisedTextout(offscreen.Canvas,40{(ClientWidth-BiColorTextWidth(offscreen.canvas,caption)) div 2},7,Caption); 255 256 offscreen.Canvas.Font.Assign(UniFont[ftNormal]); 257 258 with offscreen do 259 begin 260 // show leader picture 261 Tribe[pView].InitAge(GetAge(pView)); 262 if Tribe[pView].faceHGr>=0 then 263 begin 264 Dump(offscreen,Tribe[pView].faceHGr,18,yIcon-4,64,48, 265 1+Tribe[pView].facepix mod 10 *65,1+Tribe[pView].facepix div 10 *49); 266 frame(offscreen.Canvas,18-1,yIcon-4-1,18+64,yIcon-4+48,$000000,$000000); 256 i, y: integer; 257 s: string; 258 ps: pchar; 259 Extinct: boolean; 260 261 begin 262 inherited; 263 264 Extinct := 1 shl pView and MyRO.Alive = 0; 265 266 bitblt(offscreen.Canvas.Handle, 0, 0, ClientWidth, ClientHeight, 267 Back.Canvas.Handle, 0, 0, SRCCOPY); 268 269 offscreen.Canvas.Font.Assign(UniFont[ftCaption]); 270 RisedTextout(offscreen.Canvas, 271 40 { (ClientWidth-BiColorTextWidth(offscreen.canvas,caption)) div 2 } , 272 7, Caption); 273 274 offscreen.Canvas.Font.Assign(UniFont[ftNormal]); 275 276 with offscreen do 277 begin 278 // show leader picture 279 Tribe[pView].InitAge(GetAge(pView)); 280 if Tribe[pView].faceHGr >= 0 then 281 begin 282 Dump(offscreen, Tribe[pView].faceHGr, 18, yIcon - 4, 64, 48, 283 1 + Tribe[pView].facepix mod 10 * 65, 284 1 + Tribe[pView].facepix div 10 * 49); 285 frame(offscreen.Canvas, 18 - 1, yIcon - 4 - 1, 18 + 64, yIcon - 4 + 48, 286 $000000, $000000); 267 287 end; 268 288 269 if (pView=me) or not Extinct then 270 LoweredTextOut(Canvas,-1,MainTexture,xAttrib,yAttrib, 271 Phrases.Lookup('GOVERNMENT',CurrentReport.Government)+Phrases.Lookup('FRAND')); 272 if pView=me then 273 begin 274 LoweredTextOut(Canvas,-1,MainTexture,xAttrib,yAttrib+19, 275 Phrases.Lookup('CREDIBILITY',RoughCredibility(MyRO.Credibility))); 276 LoweredTextOut(Canvas,-1,MainTexture,xAttrib,yAttrib+38, 277 Format(Phrases.Lookup('FRCREDIBILITY'),[MyRO.Credibility])); 289 if (pView = me) or not Extinct then 290 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib, 291 Phrases.Lookup('GOVERNMENT', CurrentReport.Government) + 292 Phrases.Lookup('FRAND')); 293 if pView = me then 294 begin 295 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib + 19, 296 Phrases.Lookup('CREDIBILITY', RoughCredibility(MyRO.Credibility))); 297 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib + 38, 298 Format(Phrases.Lookup('FRCREDIBILITY'), [MyRO.Credibility])); 278 299 end 279 else280 begin 281 if Extinct then282 begin 283 LoweredTextOut(Canvas,-1,MainTexture,xAttrib,yAttrib+9,284 Phrases.Lookup('FREXTINCT'));285 LoweredTextOut(Canvas,-1,MainTexture,xAttrib,yAttrib+28,286 TurnToString(CurrentReport.TurnOfCivilReport))300 else 301 begin 302 if Extinct then 303 begin 304 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib + 9, 305 Phrases.Lookup('FREXTINCT')); 306 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib + 28, 307 TurnToString(CurrentReport.TurnOfCivilReport)) 287 308 end 288 else 289 begin 290 LoweredTextOut(Canvas,-1,MainTexture,xAttrib,yAttrib+19, 291 Phrases.Lookup('CREDIBILITY',RoughCredibility(CurrentReport.Credibility))); 292 LoweredTextOut(Canvas,-1,MainTexture,xAttrib,yAttrib+38, 293 Format(Phrases.Lookup('FRCREDIBILITY'),[CurrentReport.Credibility])); 309 else 310 begin 311 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib + 19, 312 Phrases.Lookup('CREDIBILITY', 313 RoughCredibility(CurrentReport.Credibility))); 314 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib + 38, 315 Format(Phrases.Lookup('FRCREDIBILITY'), [CurrentReport.Credibility])); 294 316 end; 295 317 296 if MyRO.Treaty[pView]=trNoContact then297 begin 298 s:=Phrases.Lookup('FRNOCONTACT');299 LoweredTextOut(Canvas,-1,MainTexture,300 (ClientWidth-BiColorTextWidth(canvas,s)) div 2,yRelation+9,s)318 if MyRO.Treaty[pView] = trNoContact then 319 begin 320 s := Phrases.Lookup('FRNOCONTACT'); 321 LoweredTextOut(Canvas, -1, MainTexture, 322 (ClientWidth - BiColorTextWidth(Canvas, s)) div 2, yRelation + 9, s) 301 323 end 302 else if ShowContact then303 begin 304 LoweredTextOut(Canvas,-1,MainTexture,xRelation,yRelation,305 Phrases.Lookup('FRTREATY'));306 LoweredTextOut(Canvas,-1,MainTexture,ClientWidth div 2,yRelation,307 Phrases.Lookup('TREATY',MyRO.Treaty[pView]));308 if CurrentReport.TurnOfContact<0 then309 LoweredTextOut(Canvas,-1,MainTexture,ClientWidth div 2,yRelation+19,310 Phrases.Lookup('FRNOVISIT'))311 else324 else if ShowContact then 325 begin 326 LoweredTextOut(Canvas, -1, MainTexture, xRelation, yRelation, 327 Phrases.Lookup('FRTREATY')); 328 LoweredTextOut(Canvas, -1, MainTexture, ClientWidth div 2, yRelation, 329 Phrases.Lookup('TREATY', MyRO.Treaty[pView])); 330 if CurrentReport.TurnOfContact < 0 then 331 LoweredTextOut(Canvas, -1, MainTexture, ClientWidth div 2, 332 yRelation + 19, Phrases.Lookup('FRNOVISIT')) 333 else 312 334 begin 313 LoweredTextOut(Canvas,-1,MainTexture,xRelation,yRelation+19,314 Phrases.Lookup('FRLASTCONTACT'));315 if CurrentReport.TurnOfContact>=0 then316 LoweredTextOut(Canvas,-1,MainTexture,ClientWidth div 2,yRelation+19,317 TurnToString(CurrentReport.TurnOfContact));335 LoweredTextOut(Canvas, -1, MainTexture, xRelation, yRelation + 19, 336 Phrases.Lookup('FRLASTCONTACT')); 337 if CurrentReport.TurnOfContact >= 0 then 338 LoweredTextOut(Canvas, -1, MainTexture, ClientWidth div 2, 339 yRelation + 19, TurnToString(CurrentReport.TurnOfContact)); 318 340 end; 319 341 end; 320 342 321 if Extinct then322 FrameImage(canvas,BigImp,xIcon,yIcon,xSizeBig,ySizeBig,0,200)323 {else if CurrentReport.Government=gAnarchy then324 FrameImage(canvas,BigImp,xIcon,yIcon,xSizeBig,ySizeBig,112,400,325 ContactEnabled and (MyRO.Happened and phGameEnd=0) and (ClientMode<scContact))326 else327 FrameImage(canvas,BigImp,xIcon,yIcon,xSizeBig,ySizeBig,328 56*(CurrentReport.Government-1),40,329 ContactEnabled and (MyRO.Happened and phGameEnd=0) and (ClientMode<scContact))};343 if Extinct then 344 FrameImage(Canvas, BigImp, xIcon, yIcon, xSizeBig, ySizeBig, 0, 200) 345 { else if CurrentReport.Government=gAnarchy then 346 FrameImage(canvas,BigImp,xIcon,yIcon,xSizeBig,ySizeBig,112,400, 347 ContactEnabled and (MyRO.Happened and phGameEnd=0) and (ClientMode<scContact)) 348 else 349 FrameImage(canvas,BigImp,xIcon,yIcon,xSizeBig,ySizeBig, 350 56*(CurrentReport.Government-1),40, 351 ContactEnabled and (MyRO.Happened and phGameEnd=0) and (ClientMode<scContact)) }; 330 352 end; 331 353 332 if CurrentReport.TurnOfCivilReport>=0 then354 if CurrentReport.TurnOfCivilReport >= 0 then 333 355 begin // print state report 334 FillSeamless(Canvas, xReport, yReport, wReport, hReport, 0, 0, Paper);335 with canvas do336 begin 337 Brush.Color:=MainTexture.clBevelShade;338 FillRect(Rect(xReport+wReport, yReport+PaperShade,339 xReport+wReport+PaperShade, yReport+hReport+PaperShade));340 FillRect(Rect(xReport+PaperShade, yReport+hReport,341 xReport+wReport+PaperShade, yReport+hReport+PaperShade));342 Brush.Style:=bsClear;356 FillSeamless(Canvas, xReport, yReport, wReport, hReport, 0, 0, Paper); 357 with Canvas do 358 begin 359 Brush.Color := MainTexture.clBevelShade; 360 FillRect(Rect(xReport + wReport, yReport + PaperShade, 361 xReport + wReport + PaperShade, yReport + hReport + PaperShade)); 362 FillRect(Rect(xReport + PaperShade, yReport + hReport, 363 xReport + wReport + PaperShade, yReport + hReport + PaperShade)); 364 Brush.Style := bsClear; 343 365 end; 344 366 345 y:=0;346 for i:=0 to ReportText.Count-1 do347 begin 348 if (i>=LinesDown) and (i<LinesDown+ReportLines) then367 y := 0; 368 for i := 0 to ReportText.Count - 1 do 369 begin 370 if (i >= LinesDown) and (i < LinesDown + ReportLines) then 349 371 begin 350 s:=ReportText[i];351 if s<>'' then372 s := ReportText[i]; 373 if s <> '' then 352 374 begin 353 //LineType:=s[1];354 delete(s,1,1);355 BiColorTextOut(canvas,Colors.Canvas.Pixels[clkMisc,cliPaperText],356 $7F007F,xReport+8,yReport+LineSpacing*y,s);375 // LineType:=s[1]; 376 delete(s, 1, 1); 377 BiColorTextOut(Canvas, Colors.Canvas.Pixels[clkMisc, cliPaperText], 378 $7F007F, xReport + 8, yReport + LineSpacing * y, s); 357 379 end; 358 inc(y);380 inc(y); 359 381 end 360 382 end; 361 383 end 384 else 385 begin 386 s := Phrases.Lookup('FRNOCIVILREP'); 387 RisedTextout(Canvas, (ClientWidth - BiColorTextWidth(Canvas, s)) div 2, 388 yReport + hReport div 2 - 10, s); 389 end; 390 391 if OptionChecked and (1 shl soTellAI) <> 0 then 392 begin 393 Server(sGetAIInfo, me, pView, ps); 394 LoweredTextOut(Canvas, -1, MainTexture, 42, 445, ps); 395 end 396 else 397 LoweredTextOut(Canvas, -2, MainTexture, 42, 445, 398 Phrases2.Lookup('MENU_TELLAI')); 399 end; 400 ContactBtn.SetBack(offscreen.Canvas, ContactBtn.Left, ContactBtn.Top); 401 402 MarkUsedOffscreen(ClientWidth, ClientHeight); 403 end; { OffscreenPaint } 404 405 procedure TNatStatDlg.CloseBtnClick(Sender: TObject); 406 begin 407 Close 408 end; 409 410 procedure TNatStatDlg.DialogBtnClick(Sender: TObject); 411 var 412 ContactResult: integer; 413 begin 414 ContactResult := MainScreen.DipCall(scContact + pView shl 4); 415 if ContactResult < rExecuted then 416 begin 417 if ContactResult = eColdWar then 418 SoundMessage(Phrases.Lookup('FRCOLDWAR'), 'MSG_DEFAULT') 419 else if MyRO.Government = gAnarchy then 420 SoundMessage(Tribe[me].TPhrase('FRMYANARCHY'), 'MSG_DEFAULT') 421 else if ContactResult = eAnarchy then 422 if MyRO.Treaty[pView] >= trPeace then 423 begin 424 if MainScreen.ContactRefused(pView, 'FRANARCHY') then 425 SmartUpdateContent 426 end 427 else 428 SoundMessage(Tribe[pView].TPhrase('FRANARCHY'), 'MSG_DEFAULT'); 429 end 362 430 else 363 begin 364 s:=Phrases.Lookup('FRNOCIVILREP'); 365 RisedTextOut(Canvas,(ClientWidth-BiColorTextWidth(Canvas,s)) div 2, 366 yReport+hReport div 2-10,s); 431 Close 432 end; 433 434 procedure TNatStatDlg.ToggleBtnClick(Sender: TObject); 435 var 436 p1, StartCount: integer; 437 m: TMenuItem; 438 ExtinctPart: boolean; 439 begin 440 EmptyMenu(Popup.Items); 441 442 // own nation 443 if G.Difficulty[me] <> 0 then 444 begin 445 m := TMenuItem.Create(Popup); 446 m.RadioItem := true; 447 m.Caption := Tribe[me].TPhrase('TITLE_NATION'); 448 m.Tag := me; 449 m.OnClick := PlayerClick; 450 if me = pView then 451 m.Checked := true; 452 Popup.Items.Add(m); 453 end; 454 455 // foreign nations 456 for ExtinctPart := false to true do 457 begin 458 StartCount := Popup.Items.Count; 459 for p1 := 0 to nPl - 1 do 460 if ExtinctPart and (G.Difficulty[p1] > 0) and 461 (1 shl p1 and MyRO.Alive = 0) or not ExtinctPart and 462 (1 shl p1 and MyRO.Alive <> 0) and (MyRO.Treaty[p1] >= trNone) then 463 begin 464 m := TMenuItem.Create(Popup); 465 m.RadioItem := true; 466 m.Caption := Tribe[p1].TPhrase('TITLE_NATION'); 467 if ExtinctPart then 468 m.Caption := '(' + m.Caption + ')'; 469 m.Tag := p1; 470 m.OnClick := PlayerClick; 471 if p1 = pView then 472 m.Checked := true; 473 Popup.Items.Add(m); 474 end; 475 if (StartCount > 0) and (Popup.Items.Count > StartCount) then 476 begin // seperator 477 m := TMenuItem.Create(Popup); 478 m.Caption := '-'; 479 Popup.Items.Insert(StartCount, m); 367 480 end; 368 369 if OptionChecked and (1 shl soTellAI)<>0 then 370 begin 371 Server(sGetAIInfo,me,pView,ps); 372 LoweredTextOut(Canvas,-1,MainTexture,42,445,ps); 373 end 374 else LoweredTextOut(Canvas,-2,MainTexture,42,445,Phrases2.Lookup('MENU_TELLAI')); 375 end; 376 ContactBtn.SetBack(Offscreen.Canvas,ContactBtn.Left,ContactBtn.Top); 377 378 MarkUsedOffscreen(ClientWidth,ClientHeight); 379 end; {OffscreenPaint} 380 381 procedure TNatStatDlg.CloseBtnClick(Sender: TObject); 382 begin 383 Close 384 end; 385 386 procedure TNatStatDlg.DialogBtnClick(Sender: TObject); 387 var 388 ContactResult: integer; 389 begin 390 ContactResult:=MainScreen.DipCall(scContact+pView shl 4); 391 if ContactResult<rExecuted then 392 begin 393 if ContactResult=eColdWar then 394 SoundMessage(Phrases.Lookup('FRCOLDWAR'),'MSG_DEFAULT') 395 else if MyRO.Government=gAnarchy then 396 SoundMessage(Tribe[me].TPhrase('FRMYANARCHY'),'MSG_DEFAULT') 397 else if ContactResult=eAnarchy then 398 if MyRO.Treaty[pView]>=trPeace then 399 begin 400 if MainScreen.ContactRefused(pView, 'FRANARCHY') then 401 SmartUpdateContent 402 end 403 else SoundMessage(Tribe[pView].TPhrase('FRANARCHY'),'MSG_DEFAULT'); 404 end 405 else Close 406 end; 407 408 procedure TNatStatDlg.ToggleBtnClick(Sender: TObject); 409 var 410 p1,StartCount: integer; 411 m: TMenuItem; 412 ExtinctPart: boolean; 413 begin 414 EmptyMenu(Popup.Items); 415 416 // own nation 417 if G.Difficulty[me]<>0 then 418 begin 419 m:=TMenuItem.Create(Popup); 420 m.RadioItem:=true; 421 m.Caption:=Tribe[me].TPhrase('TITLE_NATION'); 422 m.Tag:=me; 423 m.OnClick:=PlayerClick; 424 if me=pView then m.Checked:=true; 425 Popup.Items.Add(m); 426 end; 427 428 // foreign nations 429 for ExtinctPart:=false to true do 430 begin 431 StartCount:=Popup.Items.Count; 432 for p1:=0 to nPl-1 do 433 if ExtinctPart and (G.Difficulty[p1]>0) and (1 shl p1 and MyRO.Alive=0) 434 or not ExtinctPart and (1 shl p1 and MyRO.Alive<>0) 435 and (MyRO.Treaty[p1]>=trNone) then 436 begin 437 m:=TMenuItem.Create(Popup); 438 m.RadioItem:=true; 439 m.Caption:=Tribe[p1].TPhrase('TITLE_NATION'); 440 if ExtinctPart then 441 m.Caption:='('+m.Caption+')'; 442 m.Tag:=p1; 443 m.OnClick:=PlayerClick; 444 if p1=pView then m.Checked:=true; 445 Popup.Items.Add(m); 446 end; 447 if (StartCount>0) and (Popup.Items.Count>StartCount) then 448 begin //seperator 449 m:=TMenuItem.Create(Popup); 450 m.Caption:='-'; 451 Popup.Items.Insert(StartCount,m); 452 end; 453 end; 454 455 Popup.Popup(Left+ToggleBtn.Left, Top+ToggleBtn.Top+ToggleBtn.Height); 481 end; 482 483 Popup.Popup(Left + ToggleBtn.Left, Top + ToggleBtn.Top + ToggleBtn.Height); 456 484 end; 457 485 … … 459 487 Shift: TShiftState); 460 488 var 461 i: integer;462 begin 463 if Key=VK_F9 then // my key489 i: integer; 490 begin 491 if Key = VK_F9 then // my key 464 492 begin // toggle nation 465 i:=0; 466 repeat 467 pView:=(pView+1) mod nPl; 468 inc(i); 469 until (i>=nPl) 470 or (1 shl pView and MyRO.Alive<>0) and (MyRO.Treaty[pView]>=trNone); 471 if i>=nPl then pView:=me; 472 Tag:=pView; 473 PlayerClick(self); // no, this is not nice 474 end 475 else inherited 493 i := 0; 494 repeat 495 pView := (pView + 1) mod nPl; 496 inc(i); 497 until (i >= nPl) or (1 shl pView and MyRO.Alive <> 0) and 498 (MyRO.Treaty[pView] >= trNone); 499 if i >= nPl then 500 pView := me; 501 Tag := pView; 502 PlayerClick(self); // no, this is not nice 503 end 504 else 505 inherited 476 506 end; 477 507 478 508 procedure TNatStatDlg.EcoChange; 479 509 begin 480 if Visible and (pView=me) then 481 begin 482 SelfReport.Government:=MyRO.Government; 483 SelfReport.Money:=MyRO.Money; 510 if Visible and (pView = me) then 511 begin 512 SelfReport.Government := MyRO.Government; 513 SelfReport.Money := MyRO.Money; 514 SmartUpdateContent 515 end 516 end; 517 518 procedure TNatStatDlg.ScrollUpBtnClick(Sender: TObject); 519 begin 520 if LinesDown > 0 then 521 begin 522 dec(LinesDown); 523 SmartUpdateContent; 524 end 525 end; 526 527 procedure TNatStatDlg.ScrollDownBtnClick(Sender: TObject); 528 begin 529 if LinesDown + ReportLines < ReportText.Count then 530 begin 531 inc(LinesDown); 532 SmartUpdateContent; 533 end 534 end; 535 536 procedure TNatStatDlg.TellAIBtnClick(Sender: TObject); 537 begin 538 OptionChecked := OptionChecked xor (1 shl soTellAI); 539 if OptionChecked and (1 shl soTellAI) <> 0 then 540 TellAIBtn.ButtonIndex := 3 541 else 542 TellAIBtn.ButtonIndex := 2; 484 543 SmartUpdateContent 485 end486 end;487 488 procedure TNatStatDlg.ScrollUpBtnClick(Sender: TObject);489 begin490 if LinesDown>0 then491 begin492 dec(LinesDown);493 SmartUpdateContent;494 end495 end;496 497 procedure TNatStatDlg.ScrollDownBtnClick(Sender: TObject);498 begin499 if LinesDown+ReportLines<ReportText.Count then500 begin501 inc(LinesDown);502 SmartUpdateContent;503 end504 end;505 506 procedure TNatStatDlg.TellAIBtnClick(Sender: TObject);507 begin508 OptionChecked:=OptionChecked xor (1 shl soTellAI);509 if OptionChecked and (1 shl soTellAI)<>0 then510 TellAIBtn.ButtonIndex:=3511 else TellAIBtn.ButtonIndex:=2;512 SmartUpdateContent513 544 end; 514 545 515 546 end. 516 -
trunk/LocalPlayer/Nego.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit Nego; 4 3 … … 6 5 7 6 uses 8 ScreenTools, BaseWin,Protocol,Term,7 ScreenTools, BaseWin, Protocol, Term, 9 8 10 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ButtonA, 11 10 ButtonBase, ButtonB, ButtonC, ButtonN; 12 11 13 14 12 const 15 MaxHistory=62;13 MaxHistory = 62; 16 14 17 15 type 18 THistory =record16 THistory = record 19 17 n: integer; 20 Text: array [0..MaxHistory-1] of ansistring;21 18 Text: array [0 .. MaxHistory - 1] of ansistring; 19 end; 22 20 23 21 TNegoDlg = class(TBufferedDrawDlg) … … 56 54 procedure FormCreate(Sender: TObject); 57 55 procedure FormMouseDown(Sender: TObject; Button: TMouseButton; 58 Shift: TShiftState; X, Y: Integer);56 Shift: TShiftState; X, Y: integer); 59 57 procedure OkBtnClick(Sender: TObject); 60 58 procedure BwdBtnClick(Sender: TObject); 61 59 procedure FwdBtnClick(Sender: TObject); 62 60 procedure CloseBtnClick(Sender: TObject); 63 procedure FormKeyDown(Sender: TObject; var Key: Word; 64 Shift: TShiftState); 61 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 65 62 procedure FormShow(Sender: TObject); 66 63 procedure WantClick(Sender: TObject); … … 79 76 CurrentOffer: TOffer; 80 77 MyAllowed, OppoAllowed: TPriceSet; 81 CommandAllowed: set of scDipNotice -scDipStart..scDipBreak-scDipStart;82 History: array [0..nPl-1] of THistory;78 CommandAllowed: set of scDipNotice - scDipStart .. scDipBreak - scDipStart; 79 History: array [0 .. nPl - 1] of THistory; 83 80 RomanFont: TFont; 84 Costs, Delivers: array[0..11] of cardinal;81 Costs, Delivers: array [0 .. 11] of cardinal; 85 82 procedure ResetCurrentOffer; 86 83 procedure BuildCurrentOffer; 87 84 procedure FindAllowed; 88 85 procedure SplitText(Text: string; Bounds: TRect); 89 procedure PaintNationPicture( x,y,p: integer);86 procedure PaintNationPicture(X, Y, p: integer); 90 87 procedure SetButtonStates; 91 88 end; … … 97 94 98 95 uses 99 Messg,ClientTools,Diplomacy, Inp, Select, NatStat, Help,Tribes, MessgEx;96 Messg, ClientTools, Diplomacy, Inp, Select, NatStat, Help, Tribes, MessgEx; 100 97 101 98 {$R *.DFM} 102 99 103 100 const 104 xPadC=140; yPadC=427; 105 xPad0=140; yPad0=13; 106 xPad1=334; yPad1=13; 107 wIcon=40; hIcon=40; 108 wText=300; hText=256; 109 xText0=14; yText0=154; 110 xText1=326; yText1=154; 111 xNationPicture0=20; xNationPicture1=556; 112 yNationPicture=40; 113 yAttitude=148; 114 xCred0=42; yCred0=92; 115 xCred1=578; yCred1=92; 116 PaperShade=3; 117 PaperBorder_Left=12; PaperBorder_Right=8; 118 ListIndent=24; 119 120 opLowTreaty=$FE000000; 121 122 RomanNo: array[0..15] of string= 123 ('I','II','III','IV','V','VI','VII','VIII','IX','X','XI','XII','XIII','XIV','XV','XVI'); 124 125 ButtonPrice: array[0..11] of cardinal= 126 (opChoose,opCivilReport,opMilReport,opMap,opAllTech,opAllTech,opAllModel,opMoney, 127 opTreaty,opLowTreaty,opShipParts,opShipParts); 128 101 xPadC = 140; 102 yPadC = 427; 103 xPad0 = 140; 104 yPad0 = 13; 105 xPad1 = 334; 106 yPad1 = 13; 107 wIcon = 40; 108 hIcon = 40; 109 wText = 300; 110 hText = 256; 111 xText0 = 14; 112 yText0 = 154; 113 xText1 = 326; 114 yText1 = 154; 115 xNationPicture0 = 20; 116 xNationPicture1 = 556; 117 yNationPicture = 40; 118 yAttitude = 148; 119 xCred0 = 42; 120 yCred0 = 92; 121 xCred1 = 578; 122 yCred1 = 92; 123 PaperShade = 3; 124 PaperBorder_Left = 12; 125 PaperBorder_Right = 8; 126 ListIndent = 24; 127 128 opLowTreaty = $FE000000; 129 130 RomanNo: array [0 .. 15] of string = ('I', 'II', 'III', 'IV', 'V', 'VI', 131 'VII', 'VIII', 'IX', 'X', 'XI', 'XII', 'XIII', 'XIV', 'XV', 'XVI'); 132 133 ButtonPrice: array [0 .. 11] of cardinal = (opChoose, opCivilReport, 134 opMilReport, opMap, opAllTech, opAllTech, opAllModel, opMoney, opTreaty, 135 opLowTreaty, opShipParts, opShipParts); 129 136 130 137 procedure TNegoDlg.FormCreate(Sender: TObject); 131 138 var 132 cix: integer; 133 begin 134 InitButtons(); 135 for cix:=0 to ComponentCount-1 do 136 if Components[cix] is TButtonN then with TButtonN(Components[cix]) do 137 begin 138 Graphic:=GrExt[HGrSystem].Data; 139 Mask:=GrExt[HGrSystem].Mask; 140 BackGraphic:=GrExt[HGrSystem2].Data; 141 case Tag shr 8 of 142 1: SmartHint:=Phrases.Lookup('WANT', ButtonIndex-6); 143 2: SmartHint:=Phrases.Lookup('OFFER', ButtonIndex-6); 139 cix: integer; 140 begin 141 InitButtons(); 142 for cix := 0 to ComponentCount - 1 do 143 if Components[cix] is TButtonN then 144 with TButtonN(Components[cix]) do 145 begin 146 Graphic := GrExt[HGrSystem].Data; 147 Mask := GrExt[HGrSystem].Mask; 148 BackGraphic := GrExt[HGrSystem2].Data; 149 case Tag shr 8 of 150 1: 151 SmartHint := Phrases.Lookup('WANT', ButtonIndex - 6); 152 2: 153 SmartHint := Phrases.Lookup('OFFER', ButtonIndex - 6); 154 end; 144 155 end; 156 157 fillchar(History, sizeof(History), 0); 158 RomanFont := TFont.Create; 159 RomanFont.Name := 'Times New Roman'; 160 RomanFont.Size := Round(144 * 72 / RomanFont.PixelsPerInch); 161 RomanFont.Color := Colors.Canvas.Pixels[clkMisc, cliPaper]; 162 HelpContext := 'DIPLOMACY'; 163 OkBtn.Caption := Phrases.Lookup('BTN_OK'); 164 AcceptBtn.SmartHint := Phrases.Lookup('BTN_ACCEPT'); 165 ExitBtn.SmartHint := Phrases.Lookup('BTN_BREAK'); 166 CancelTreatyBtn.SmartHint := Phrases.Lookup('BTN_CNTREATY'); 167 end; 168 169 procedure TNegoDlg.FormShow(Sender: TObject); 170 begin 171 OffscreenPaint; 172 end; 173 174 procedure TNegoDlg.ResetCurrentOffer; 175 var 176 i: integer; 177 begin 178 CurrentOffer.nDeliver := 0; 179 CurrentOffer.nCost := 0; 180 for i := 0 to 11 do 181 Costs[i] := $FFFFFFFF; 182 for i := 0 to 11 do 183 Delivers[i] := $FFFFFFFF; 184 end; 185 186 procedure TNegoDlg.ShowNewContent(NewMode: integer); 187 begin 188 inherited ShowNewContent(NewMode); 189 SetButtonStates; 190 if (ClientMode = scDipCancelTreaty) or (ClientMode = scDipBreak) then 191 PassBtn.SmartHint := Phrases.Lookup('BTN_NOTICE') 192 else 193 PassBtn.SmartHint := Phrases.Lookup('BTN_PASS'); 194 case MyRO.Treaty[DipMem[me].pContact] of 195 trNone: 196 begin 197 WantHiTreatyBtn.SmartHint := Phrases.Lookup('BTN_WANTPEACE'); 198 OfferHiTreatyBtn.SmartHint := Phrases.Lookup('BTN_OFFERPEACE'); 199 // WantLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_WANTCEASEFIRE'); 200 // OfferLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_OFFERCEASEFIRE'); 201 end; 202 { trCeasefire: 203 begin 204 WantHiTreatyBtn.SmartHint:=Phrases.Lookup('BTN_WANTPEACE'); 205 OfferHiTreatyBtn.SmartHint:=Phrases.Lookup('BTN_OFFERPEACE'); 206 end; } 207 trPeace: 208 begin 209 WantHiTreatyBtn.SmartHint := Phrases.Lookup('BTN_WANTFRIENDLY'); 210 OfferHiTreatyBtn.SmartHint := Phrases.Lookup('BTN_OFFERFRIENDLY'); 211 // WantLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_WANTENDPEACE'); 212 // OfferLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_OFFERENDPEACE'); 213 end; 214 trFriendlyContact: 215 begin 216 WantHiTreatyBtn.SmartHint := Phrases.Lookup('BTN_WANTALLIANCE'); 217 OfferHiTreatyBtn.SmartHint := Phrases.Lookup('BTN_OFFERALLIANCE'); 218 end; 219 { trAlliance: 220 begin 221 WantLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_WANTENDALLIANCE'); 222 OfferLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_OFFERENDALLIANCE'); 223 end; } 224 end; 225 end; 226 227 procedure TNegoDlg.Start; 228 begin 229 if ClientMode <> scDipStart then 230 with History[me] do 231 begin 232 if n = MaxHistory then 233 begin 234 move(Text[2], Text[0], (MaxHistory - 2) * sizeof(integer)); 235 dec(n, 2); 236 end; 237 Text[n] := copy(DipCommandToString(DipMem[me].pContact, me, 238 DipMem[me].FormerTreaty, DipMem[me].SentCommand, ClientMode, 239 DipMem[me].SentOffer, ReceivedOffer), 1, 255); 240 inc(n); 145 241 end; 146 147 fillchar(History, sizeof(History), 0); 148 RomanFont:=TFont.Create; 149 RomanFont.Name:='Times New Roman'; 150 RomanFont.Size:=Round(144 * 72/RomanFont.PixelsPerInch); 151 RomanFont.Color:=Colors.Canvas.Pixels[clkMisc,cliPaper]; 152 HelpContext:='DIPLOMACY'; 153 OkBtn.Caption:=Phrases.Lookup('BTN_OK'); 154 AcceptBtn.SmartHint:=Phrases.Lookup('BTN_ACCEPT'); 155 ExitBtn.SmartHint:=Phrases.Lookup('BTN_BREAK'); 156 CancelTreatyBtn.SmartHint:=Phrases.Lookup('BTN_CNTREATY'); 157 end; 158 159 procedure TNegoDlg.FormShow(Sender: TObject); 160 begin 161 OffscreenPaint; 162 end; 163 164 procedure TNegoDlg.ResetCurrentOffer; 165 var 166 i: integer; 167 begin 168 CurrentOffer.nDeliver:=0; 169 CurrentOffer.nCost:=0; 170 for i:=0 to 11 do 171 Costs[i]:=$FFFFFFFF; 172 for i:=0 to 11 do 173 Delivers[i]:=$FFFFFFFF; 174 end; 175 176 procedure TNegoDlg.ShowNewContent(NewMode: integer); 177 begin 178 inherited ShowNewContent(NewMode); 179 SetButtonStates; 180 if (ClientMode=scDipCancelTreaty) or (ClientMode=scDipBreak) then 181 PassBtn.SmartHint:=Phrases.Lookup('BTN_NOTICE') 182 else PassBtn.SmartHint:=Phrases.Lookup('BTN_PASS'); 183 case MyRO.Treaty[DipMem[me].pContact] of 184 trNone: 185 begin 186 WantHiTreatyBtn.SmartHint:=Phrases.Lookup('BTN_WANTPEACE'); 187 OfferHiTreatyBtn.SmartHint:=Phrases.Lookup('BTN_OFFERPEACE'); 188 //WantLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_WANTCEASEFIRE'); 189 //OfferLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_OFFERCEASEFIRE'); 190 end; 191 {trCeasefire: 192 begin 193 WantHiTreatyBtn.SmartHint:=Phrases.Lookup('BTN_WANTPEACE'); 194 OfferHiTreatyBtn.SmartHint:=Phrases.Lookup('BTN_OFFERPEACE'); 195 end;} 196 trPeace: 197 begin 198 WantHiTreatyBtn.SmartHint:=Phrases.Lookup('BTN_WANTFRIENDLY'); 199 OfferHiTreatyBtn.SmartHint:=Phrases.Lookup('BTN_OFFERFRIENDLY'); 200 //WantLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_WANTENDPEACE'); 201 //OfferLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_OFFERENDPEACE'); 202 end; 203 trFriendlyContact: 204 begin 205 WantHiTreatyBtn.SmartHint:=Phrases.Lookup('BTN_WANTALLIANCE'); 206 OfferHiTreatyBtn.SmartHint:=Phrases.Lookup('BTN_OFFERALLIANCE'); 207 end; 208 {trAlliance: 209 begin 210 WantLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_WANTENDALLIANCE'); 211 OfferLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_OFFERENDALLIANCE'); 212 end;} 213 end; 214 end; 215 216 procedure TNegoDlg.Start; 217 begin 218 if ClientMode<>scDipStart then with History[me] do 219 begin 220 if n=MaxHistory then 221 begin 222 move(Text[2], Text[0], (MaxHistory-2)*sizeof(integer)); 223 dec(n,2); 224 end; 225 Text[n]:=copy(DipCommandToString(DipMem[me].pContact,me, 226 DipMem[me].FormerTreaty, DipMem[me].SentCommand, ClientMode, 227 DipMem[me].SentOffer, ReceivedOffer),1,255); 228 inc(n); 229 end; 230 assert(History[me].n mod 2=1); 231 232 Page:=History[me].n; 233 FindAllowed; 234 ResetCurrentOffer; 235 236 (*if (ClientMode=scDipOffer) and (ReceivedOffer.nDeliver=1) 237 and (ReceivedOffer.nCost=0) and (ReceivedOffer.Price[0] and opMask=opTreaty) then 238 begin // prepare to demand price for treaty 239 CurrentOffer.nDeliver:=1; 240 CurrentOffer.Price[0]:=ReceivedOffer.Price[0]; 241 CurrentOffer.nCost:=0; 242 end 243 else 244 begin 245 if (ClientMode=scDipOffer) and (ReceivedOffer.nCost>0) then 242 assert(History[me].n mod 2 = 1); 243 244 Page := History[me].n; 245 FindAllowed; 246 ResetCurrentOffer; 247 248 (* if (ClientMode=scDipOffer) and (ReceivedOffer.nDeliver=1) 249 and (ReceivedOffer.nCost=0) and (ReceivedOffer.Price[0] and opMask=opTreaty) then 250 begin // prepare to demand price for treaty 251 CurrentOffer.nDeliver:=1; 252 CurrentOffer.Price[0]:=ReceivedOffer.Price[0]; 253 CurrentOffer.nCost:=0; 254 end 255 else 256 begin 257 if (ClientMode=scDipOffer) and (ReceivedOffer.nCost>0) then 246 258 begin 247 259 CurrentOffer.nDeliver:=1; 248 260 CurrentOffer.Price[0]:=ReceivedOffer.Price[ReceivedOffer.nDeliver] 249 261 end 250 else CurrentOffer.nDeliver:=0;251 if (ClientMode=scDipOffer) and (ReceivedOffer.nDeliver>0) then262 else CurrentOffer.nDeliver:=0; 263 if (ClientMode=scDipOffer) and (ReceivedOffer.nDeliver>0) then 252 264 begin 253 265 CurrentOffer.nCost:=1; 254 266 CurrentOffer.Price[CurrentOffer.nDeliver]:=ReceivedOffer.Price[0] 255 267 end 256 else CurrentOffer.nCost:=0257 end;*)258 DipCommand:=-1;259 ShowNewContent(wmPersistent);268 else CurrentOffer.nCost:=0 269 end; *) 270 DipCommand := -1; 271 ShowNewContent(wmPersistent); 260 272 end; 261 273 262 274 procedure TNegoDlg.SplitText(Text: string; Bounds: TRect); 263 275 var 264 nLines,Line,Start,Stop,OrdinaryStop,Indent,y: integer;265 s: string;266 preview, Dot: boolean;267 begin 268 for preview:=true downto false do269 begin 270 Start:=1;271 Line:=0;272 Indent:=0;273 while Start<Length(Text) do274 begin 275 Dot:=false;276 if (Start=1) or (Text[Start-1]='\') then277 if Text[Start]='-' then276 nLines, Line, Start, Stop, OrdinaryStop, Indent, Y: integer; 277 s: string; 278 preview, Dot: boolean; 279 begin 280 for preview := true downto false do 281 begin 282 Start := 1; 283 Line := 0; 284 Indent := 0; 285 while Start < Length(Text) do 286 begin 287 Dot := false; 288 if (Start = 1) or (Text[Start - 1] = '\') then 289 if Text[Start] = '-' then 278 290 begin 279 Indent:=ListIndent; 280 inc(Start); 281 if Start=Length(Text) then break; 282 Dot:=true; 291 Indent := ListIndent; 292 inc(Start); 293 if Start = Length(Text) then 294 break; 295 Dot := true; 283 296 end 284 else Indent:=0; 285 Stop:=Start; 286 while (Stop<Length(Text)) and (Text[Stop]<>'\') do 287 begin 288 inc(Stop); 289 if BiColorTextWidth(Offscreen.Canvas,Copy(Text,Start,Stop-Start+1)) 290 >Bounds.Right-Bounds.Left-PaperBorder_Left-PaperBorder_Right-Indent then 291 begin dec(Stop); break end; 297 else 298 Indent := 0; 299 Stop := Start; 300 while (Stop < Length(Text)) and (Text[Stop] <> '\') do 301 begin 302 inc(Stop); 303 if BiColorTextWidth(Offscreen.Canvas, 304 copy(Text, Start, Stop - Start + 1)) > Bounds.Right - Bounds.Left - 305 PaperBorder_Left - PaperBorder_Right - Indent then 306 begin 307 dec(Stop); 308 break 309 end; 292 310 end; 293 if Stop<>Length(Text) then 294 begin 295 OrdinaryStop:=Stop; 296 while (Text[OrdinaryStop+1]<>' ') and (Text[OrdinaryStop+1]<>'\') do 297 dec(OrdinaryStop); 298 if (OrdinaryStop+1-Start)*2>=Stop-Start then 299 Stop:=OrdinaryStop 311 if Stop <> Length(Text) then 312 begin 313 OrdinaryStop := Stop; 314 while (Text[OrdinaryStop + 1] <> ' ') and 315 (Text[OrdinaryStop + 1] <> '\') do 316 dec(OrdinaryStop); 317 if (OrdinaryStop + 1 - Start) * 2 >= Stop - Start then 318 Stop := OrdinaryStop 300 319 end; 301 if not preview then 302 begin 303 y:=(Bounds.Top+Bounds.Bottom) div 2-10*nLines+20*Line-1; 304 if Dot then 305 Sprite(offscreen,HGrSystem,Bounds.Left+PaperBorder_Left+(ListIndent-14), 306 y+7,8,8,90,16); 307 s:=Copy(Text,Start,Stop-Start+1); 308 BiColorTextOut(Offscreen.Canvas,Colors.Canvas.Pixels[clkMisc,cliPaperText], 309 $7F007F,Bounds.Left+PaperBorder_Left+Indent,y,s); 320 if not preview then 321 begin 322 Y := (Bounds.Top + Bounds.Bottom) div 2 - 10 * nLines + 20 * Line - 1; 323 if Dot then 324 Sprite(Offscreen, HGrSystem, Bounds.Left + PaperBorder_Left + 325 (ListIndent - 14), Y + 7, 8, 8, 90, 16); 326 s := copy(Text, Start, Stop - Start + 1); 327 BiColorTextOut(Offscreen.Canvas, Colors.Canvas.Pixels[clkMisc, 328 cliPaperText], $7F007F, Bounds.Left + PaperBorder_Left + 329 Indent, Y, s); 310 330 end; 311 inc(Line);312 Start:=Stop+2;331 inc(Line); 332 Start := Stop + 2; 313 333 end; 314 nLines:=Line;334 nLines := Line; 315 335 end 316 336 end; … … 318 338 procedure TNegoDlg.FindAllowed; 319 339 var 320 i: integer; 321 begin 322 CommandAllowed:=[scDipOffer-scDipStart]; 323 if ClientMode<>scDipBreak then include(CommandAllowed,scDipBreak-scDipStart); 324 if MyRO.Treaty[DipMem[me].pContact]>=trPeace then 325 include(CommandAllowed,scDipCancelTreaty-scDipStart); 326 if (ClientMode=scDipOffer) 327 and (Server(scDipAccept-sExecute,me,0,nil^)>=rExecuted) then 328 include(CommandAllowed,scDipAccept-scDipStart); 329 330 MyAllowed:=[opChoose shr 24, opMoney shr 24]; 331 OppoAllowed:=[opChoose shr 24, opMoney shr 24]; 332 if not IsCivilReportNew(DipMem[me].pContact) then 340 i: integer; 341 begin 342 CommandAllowed := [scDipOffer - scDipStart]; 343 if ClientMode <> scDipBreak then 344 include(CommandAllowed, scDipBreak - scDipStart); 345 if MyRO.Treaty[DipMem[me].pContact] >= trPeace then 346 include(CommandAllowed, scDipCancelTreaty - scDipStart); 347 if (ClientMode = scDipOffer) and (Server(scDipAccept - sExecute, me, 0, nil^) 348 >= rExecuted) then 349 include(CommandAllowed, scDipAccept - scDipStart); 350 351 MyAllowed := [opChoose shr 24, opMoney shr 24]; 352 OppoAllowed := [opChoose shr 24, opMoney shr 24]; 353 if not IsCivilReportNew(DipMem[me].pContact) then 333 354 begin // no up-to-date civil report 334 MyAllowed:=MyAllowed+[opCivilReport shr 24]; 335 for i:=0 to nAdv-1 do if MyRO.Tech[i]>=tsApplicable then 336 begin MyAllowed:=MyAllowed+[opAllTech shr 24]; break end; 337 OppoAllowed:=OppoAllowed+[opCivilReport shr 24,opAllTech shr 24]; 355 MyAllowed := MyAllowed + [opCivilReport shr 24]; 356 for i := 0 to nAdv - 1 do 357 if MyRO.Tech[i] >= tsApplicable then 358 begin 359 MyAllowed := MyAllowed + [opAllTech shr 24]; 360 break 361 end; 362 OppoAllowed := OppoAllowed + [opCivilReport shr 24, opAllTech shr 24]; 338 363 end 339 else364 else 340 365 begin // check techs 341 for i:=0 to nAdv-1 do if not (i in FutureTech) then 342 if (MyRO.Tech[i]<tsSeen) 343 and (MyRO.EnemyReport[DipMem[me].pContact].Tech[i]>=tsApplicable) then 344 OppoAllowed:=OppoAllowed+[opAllTech shr 24] 345 else if (MyRO.EnemyReport[DipMem[me].pContact].Tech[i]<tsSeen) 346 and (MyRO.Tech[i]>=tsApplicable) then 347 MyAllowed:=MyAllowed+[opAllTech shr 24]; 348 end; 349 if not IsMilReportNew(DipMem[me].pContact) then 366 for i := 0 to nAdv - 1 do 367 if not(i in FutureTech) then 368 if (MyRO.Tech[i] < tsSeen) and 369 (MyRO.EnemyReport[DipMem[me].pContact].Tech[i] >= tsApplicable) then 370 OppoAllowed := OppoAllowed + [opAllTech shr 24] 371 else if (MyRO.EnemyReport[DipMem[me].pContact].Tech[i] < tsSeen) and 372 (MyRO.Tech[i] >= tsApplicable) then 373 MyAllowed := MyAllowed + [opAllTech shr 24]; 374 end; 375 if not IsMilReportNew(DipMem[me].pContact) then 350 376 begin // no up-to-date military report 351 MyAllowed:=MyAllowed+[opMilReport shr 24];352 if MyRO.nModel>3 then353 MyAllowed:=MyAllowed+[opAllModel shr 24];354 OppoAllowed:=OppoAllowed+[opMilReport shr 24,opAllModel shr 24];377 MyAllowed := MyAllowed + [opMilReport shr 24]; 378 if MyRO.nModel > 3 then 379 MyAllowed := MyAllowed + [opAllModel shr 24]; 380 OppoAllowed := OppoAllowed + [opMilReport shr 24, opAllModel shr 24]; 355 381 end 356 else 357 begin 358 if ModalSelectDlg.OnlyChoice(kChooseModel)<>mixAll then 359 MyAllowed:=MyAllowed+[opAllModel shr 24]; 360 if ModalSelectDlg.OnlyChoice(kChooseEModel)<>mixAll then 361 OppoAllowed:=OppoAllowed+[opAllModel shr 24]; 362 end; 363 if MyRO.Treaty[DipMem[me].pContact]<trAlliance then 364 begin 365 MyAllowed:=MyAllowed+[opTreaty shr 24,opMap shr 24]; 366 OppoAllowed:=OppoAllowed+[opTreaty shr 24,opMap shr 24]; 367 end; 368 {if MyRO.Treaty[DipMem[me].pContact] in [trNone,trPeace,trAlliance] then 369 begin 370 MyAllowed:=MyAllowed+[opLowTreaty shr 24]; 371 OppoAllowed:=OppoAllowed+[opLowTreaty shr 24]; 372 end;} 373 for i:=0 to nShipPart-1 do 374 begin 375 if MyRO.Ship[me].Parts[i]>0 then 376 include(MyAllowed, opShipParts shr 24); 377 if MyRO.Ship[DipMem[me].pContact].Parts[i]>0 then 378 include(OppoAllowed, opShipParts shr 24); 379 end; 380 MyAllowed:=MyAllowed-DipMem[me].DeliveredPrices*[opAllTech shr 24,opAllModel shr 24,opCivilReport shr 24,opMilReport shr 24,opMap shr 24]; 381 OppoAllowed:=OppoAllowed-DipMem[me].ReceivedPrices*[opAllTech shr 24,opAllModel shr 24,opCivilReport shr 24,opMilReport shr 24,opMap shr 24]; 382 end; 383 384 procedure TNegoDlg.PaintNationPicture(x,y,p: integer); 385 begin 386 with Offscreen.Canvas do 387 begin 388 Pen.Color:=$000000; 389 Brush.Color:=Tribe[p].Color; 390 Rectangle(x-6,y-1,x+70,y+49); 391 Brush.Color:=$000000; 392 Tribe[p].InitAge(GetAge(p)); 393 if Tribe[p].faceHGr>=0 then 394 Dump(offscreen,Tribe[p].faceHGr,x,y,64,48, 395 1+Tribe[p].facepix mod 10 *65,1+Tribe[p].facepix div 10 *49) 396 else FillRect(Rect(x,y,x+64,y+48)); 397 Brush.Style:=bsClear; 398 Frame(Offscreen.Canvas,x-1,y-1,x+64,y+48,$000000,$000000); 382 else 383 begin 384 if ModalSelectDlg.OnlyChoice(kChooseModel) <> mixAll then 385 MyAllowed := MyAllowed + [opAllModel shr 24]; 386 if ModalSelectDlg.OnlyChoice(kChooseEModel) <> mixAll then 387 OppoAllowed := OppoAllowed + [opAllModel shr 24]; 388 end; 389 if MyRO.Treaty[DipMem[me].pContact] < trAlliance then 390 begin 391 MyAllowed := MyAllowed + [opTreaty shr 24, opMap shr 24]; 392 OppoAllowed := OppoAllowed + [opTreaty shr 24, opMap shr 24]; 393 end; 394 { if MyRO.Treaty[DipMem[me].pContact] in [trNone,trPeace,trAlliance] then 395 begin 396 MyAllowed:=MyAllowed+[opLowTreaty shr 24]; 397 OppoAllowed:=OppoAllowed+[opLowTreaty shr 24]; 398 end; } 399 for i := 0 to nShipPart - 1 do 400 begin 401 if MyRO.Ship[me].Parts[i] > 0 then 402 include(MyAllowed, opShipParts shr 24); 403 if MyRO.Ship[DipMem[me].pContact].Parts[i] > 0 then 404 include(OppoAllowed, opShipParts shr 24); 405 end; 406 MyAllowed := MyAllowed - DipMem[me].DeliveredPrices * 407 [opAllTech shr 24, opAllModel shr 24, opCivilReport shr 24, 408 opMilReport shr 24, opMap shr 24]; 409 OppoAllowed := OppoAllowed - DipMem[me].ReceivedPrices * 410 [opAllTech shr 24, opAllModel shr 24, opCivilReport shr 24, 411 opMilReport shr 24, opMap shr 24]; 412 end; 413 414 procedure TNegoDlg.PaintNationPicture(X, Y, p: integer); 415 begin 416 with Offscreen.Canvas do 417 begin 418 Pen.Color := $000000; 419 Brush.Color := Tribe[p].Color; 420 Rectangle(X - 6, Y - 1, X + 70, Y + 49); 421 Brush.Color := $000000; 422 Tribe[p].InitAge(GetAge(p)); 423 if Tribe[p].faceHGr >= 0 then 424 Dump(Offscreen, Tribe[p].faceHGr, X, Y, 64, 48, 425 1 + Tribe[p].facepix mod 10 * 65, 1 + Tribe[p].facepix div 10 * 49) 426 else 427 FillRect(Rect(X, Y, X + 64, Y + 48)); 428 Brush.Style := bsClear; 429 Frame(Offscreen.Canvas, X - 1, Y - 1, X + 64, Y + 48, $000000, $000000); 399 430 end 400 431 end; … … 402 433 procedure TNegoDlg.SetButtonStates; 403 434 var 404 cix: integer; 405 IsActionPage: boolean; 406 begin 407 IsActionPage:= Page=History[me].n; 408 409 AcceptBtn.Possible:= IsActionPage and (scDipAccept-scDipStart in CommandAllowed); 410 AcceptBtn.Lit:= DipCommand=scDipAccept; 411 PassBtn.Possible:= IsActionPage and (scDipOffer-scDipStart in CommandAllowed); 412 PassBtn.Lit:= (DipCommand=scDipNotice) 413 or (DipCommand=scDipOffer) and (CurrentOffer.nDeliver=0) and (CurrentOffer.nCost=0); 414 ExitBtn.Possible:= IsActionPage and (scDipBreak-scDipStart in CommandAllowed); 415 ExitBtn.Lit:= DipCommand=scDipBreak; 416 CancelTreatyBtn.Possible:= IsActionPage and (scDipCancelTreaty-scDipStart in CommandAllowed); 417 CancelTreatyBtn.Lit:= DipCommand=scDipCancelTreaty; 418 419 for cix:=0 to ComponentCount-1 do 420 if Components[cix] is TButtonN then 421 with TButtonN(Components[cix]) do 422 case Tag shr 8 of 423 1: // Costs 424 begin 425 Possible:= IsActionPage and (ButtonPrice[Tag and $FF] shr 24 in OppoAllowed); 426 Lit:=Costs[Tag and $FF]<>$FFFFFFFF; 427 end; 428 2: // Delivers 429 begin 430 Possible:= IsActionPage and (ButtonPrice[Tag and $FF] shr 24 in MyAllowed); 431 Lit:=Delivers[Tag and $FF]<>$FFFFFFFF; 432 end 435 cix: integer; 436 IsActionPage: boolean; 437 begin 438 IsActionPage := Page = History[me].n; 439 440 AcceptBtn.Possible := IsActionPage and 441 (scDipAccept - scDipStart in CommandAllowed); 442 AcceptBtn.Lit := DipCommand = scDipAccept; 443 PassBtn.Possible := IsActionPage and 444 (scDipOffer - scDipStart in CommandAllowed); 445 PassBtn.Lit := (DipCommand = scDipNotice) or (DipCommand = scDipOffer) and 446 (CurrentOffer.nDeliver = 0) and (CurrentOffer.nCost = 0); 447 ExitBtn.Possible := IsActionPage and 448 (scDipBreak - scDipStart in CommandAllowed); 449 ExitBtn.Lit := DipCommand = scDipBreak; 450 CancelTreatyBtn.Possible := IsActionPage and 451 (scDipCancelTreaty - scDipStart in CommandAllowed); 452 CancelTreatyBtn.Lit := DipCommand = scDipCancelTreaty; 453 454 for cix := 0 to ComponentCount - 1 do 455 if Components[cix] is TButtonN then 456 with TButtonN(Components[cix]) do 457 case Tag shr 8 of 458 1: // Costs 459 begin 460 Possible := IsActionPage and 461 (ButtonPrice[Tag and $FF] shr 24 in OppoAllowed); 462 Lit := Costs[Tag and $FF] <> $FFFFFFFF; 463 end; 464 2: // Delivers 465 begin 466 Possible := IsActionPage and 467 (ButtonPrice[Tag and $FF] shr 24 in MyAllowed); 468 Lit := Delivers[Tag and $FF] <> $FFFFFFFF; 469 end 433 470 end; 434 471 end; … … 436 473 procedure TNegoDlg.OffscreenPaint; 437 474 var 438 i,cred: integer; 439 s: string; 440 OkEnabled: boolean; 441 begin 442 if (OffscreenUser<>nil) and (OffscreenUser<>self) then OffscreenUser.Update; 475 i, cred: integer; 476 s: string; 477 OkEnabled: boolean; 478 begin 479 if (OffscreenUser <> nil) and (OffscreenUser <> self) then 480 OffscreenUser.Update; 443 481 // complete working with old owner to prevent rebound 444 OffscreenUser:=self; 445 446 if (DipCommand>=0) and (Page=History[me].n) then 447 History[me].Text[History[me].n]:=copy(DipCommandToString(me,DipMem[me].pContact, 448 MyRO.Treaty[DipMem[me].pContact],ClientMode, DipCommand, ReceivedOffer, CurrentOffer),1,255); 449 450 FwdBtn.Visible:= Page<History[me].n; 451 BwdBtn.Visible:= Page>=2; 452 if Page<History[me].n then OkEnabled:=false 453 else if DipCommand=scDipOffer then 454 OkEnabled:= Server(scDipOffer-sExecute,me,0,CurrentOffer)>=rExecuted 455 else OkEnabled:= DipCommand>=0; 456 OkBtn.Visible:=OkEnabled; 457 458 Fill(Offscreen.Canvas,3,3,ClientWidth-6,ClientHeight-6, 459 (wMaintexture-ClientWidth) div 2,(hMaintexture-ClientHeight) div 2); 460 Frame(Offscreen.Canvas,0,0,ClientWidth-1,ClientHeight-1,0,0); 461 Frame(Offscreen.Canvas,1,1,ClientWidth-2,ClientHeight-2,MainTexture.clBevelLight,MainTexture.clBevelShade); 462 Frame(Offscreen.Canvas,2,2,ClientWidth-3,ClientHeight-3,MainTexture.clBevelLight,MainTexture.clBevelShade); 463 Corner(Offscreen.Canvas,1,1,0,MainTexture); 464 Corner(Offscreen.Canvas,ClientWidth-9,1,1,MainTexture); 465 Corner(Offscreen.Canvas,1,ClientHeight-9,2,MainTexture); 466 Corner(Offscreen.Canvas,ClientWidth-9,ClientHeight-9,3,MainTexture); 467 468 BtnFrame(Offscreen.Canvas,OkBtn.BoundsRect,MainTexture); 469 BtnFrame(Offscreen.Canvas,BwdBtn.BoundsRect,MainTexture); 470 BtnFrame(Offscreen.Canvas,FwdBtn.BoundsRect,MainTexture); 471 BtnFrame(Offscreen.Canvas,CloseBtn.BoundsRect,MainTexture); 472 473 RFrame(Offscreen.Canvas,xPadC-2, yPadC-2, xPadC+41+42*3,yPadC+41, 474 $FFFFFF,$B0B0B0); 475 RFrame(Offscreen.Canvas,xPad0-2, yPad0-2,xPad0+41+42*3, 476 yPad0+41+42*2,$FFFFFF,$B0B0B0); 477 RFrame(Offscreen.Canvas,xPad1-2, yPad1-2,xPad1+41+42*3, 478 yPad1+41+42*2,$FFFFFF,$B0B0B0); 479 480 PaintNationPicture(xNationPicture0,yNationPicture,DipMem[me].pContact); 481 PaintNationPicture(xNationPicture1,yNationPicture,me); 482 483 if History[me].Text[Page-1]<>'' then 484 begin 485 FillSeamless(Offscreen.Canvas, xText0, yText0, wText, hText, 0, 0, Paper); 486 i:=Page-1; 487 if History[me].Text[0]='' then dec(i); 488 if i<16 then 489 begin 482 OffscreenUser := self; 483 484 if (DipCommand >= 0) and (Page = History[me].n) then 485 History[me].Text[History[me].n] := 486 copy(DipCommandToString(me, DipMem[me].pContact, 487 MyRO.Treaty[DipMem[me].pContact], ClientMode, DipCommand, ReceivedOffer, 488 CurrentOffer), 1, 255); 489 490 FwdBtn.Visible := Page < History[me].n; 491 BwdBtn.Visible := Page >= 2; 492 if Page < History[me].n then 493 OkEnabled := false 494 else if DipCommand = scDipOffer then 495 OkEnabled := Server(scDipOffer - sExecute, me, 0, CurrentOffer) >= rExecuted 496 else 497 OkEnabled := DipCommand >= 0; 498 OkBtn.Visible := OkEnabled; 499 500 Fill(Offscreen.Canvas, 3, 3, ClientWidth - 6, ClientHeight - 6, 501 (wMaintexture - ClientWidth) div 2, (hMaintexture - ClientHeight) div 2); 502 Frame(Offscreen.Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0); 503 Frame(Offscreen.Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2, 504 MainTexture.clBevelLight, MainTexture.clBevelShade); 505 Frame(Offscreen.Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3, 506 MainTexture.clBevelLight, MainTexture.clBevelShade); 507 Corner(Offscreen.Canvas, 1, 1, 0, MainTexture); 508 Corner(Offscreen.Canvas, ClientWidth - 9, 1, 1, MainTexture); 509 Corner(Offscreen.Canvas, 1, ClientHeight - 9, 2, MainTexture); 510 Corner(Offscreen.Canvas, ClientWidth - 9, ClientHeight - 9, 3, MainTexture); 511 512 BtnFrame(Offscreen.Canvas, OkBtn.BoundsRect, MainTexture); 513 BtnFrame(Offscreen.Canvas, BwdBtn.BoundsRect, MainTexture); 514 BtnFrame(Offscreen.Canvas, FwdBtn.BoundsRect, MainTexture); 515 BtnFrame(Offscreen.Canvas, CloseBtn.BoundsRect, MainTexture); 516 517 RFrame(Offscreen.Canvas, xPadC - 2, yPadC - 2, xPadC + 41 + 42 * 3, 518 yPadC + 41, $FFFFFF, $B0B0B0); 519 RFrame(Offscreen.Canvas, xPad0 - 2, yPad0 - 2, xPad0 + 41 + 42 * 3, 520 yPad0 + 41 + 42 * 2, $FFFFFF, $B0B0B0); 521 RFrame(Offscreen.Canvas, xPad1 - 2, yPad1 - 2, xPad1 + 41 + 42 * 3, 522 yPad1 + 41 + 42 * 2, $FFFFFF, $B0B0B0); 523 524 PaintNationPicture(xNationPicture0, yNationPicture, DipMem[me].pContact); 525 PaintNationPicture(xNationPicture1, yNationPicture, me); 526 527 if History[me].Text[Page - 1] <> '' then 528 begin 529 FillSeamless(Offscreen.Canvas, xText0, yText0, wText, hText, 0, 0, Paper); 530 i := Page - 1; 531 if History[me].Text[0] = '' then 532 dec(i); 533 if i < 16 then 534 begin 535 Offscreen.Canvas.Font.Assign(RomanFont); 536 Offscreen.Canvas.TextOut 537 (xText0 + (wText - Offscreen.Canvas.TextWidth(RomanNo[i])) div 2, 538 yText0 + (hText - Offscreen.Canvas.TextHeight(RomanNo[i])) div 2, 539 RomanNo[i]); 540 end 541 end; 542 FillSeamless(Offscreen.Canvas, xText1, yText1, wText, hText, 0, 0, Paper); 543 i := Page; 544 if History[me].Text[0] = '' then 545 dec(i); 546 if i < 16 then 547 begin 490 548 Offscreen.Canvas.Font.Assign(RomanFont); 491 Offscreen.Canvas.TextOut(xText0+(wText-Offscreen.Canvas.TextWidth(RomanNo[i])) div 2, 492 yText0+(hText-Offscreen.Canvas.TextHeight(RomanNo[i])) div 2,RomanNo[i]); 493 end 494 end; 495 FillSeamless(Offscreen.Canvas, xText1, yText1, wText, hText, 0, 0, Paper); 496 i:=Page; 497 if History[me].Text[0]='' then dec(i); 498 if i<16 then 499 begin 500 Offscreen.Canvas.Font.Assign(RomanFont); 501 Offscreen.Canvas.TextOut(xText1+(wText-Offscreen.Canvas.TextWidth(RomanNo[i])) div 2, 502 yText1+(hText-Offscreen.Canvas.TextHeight(RomanNo[i])) div 2,RomanNo[i]); 503 end; 504 with Offscreen.Canvas do 505 begin 506 Brush.Color:=MainTexture.clBevelShade; 507 if History[me].Text[Page-1]<>'' then 508 begin 509 FillRect(Rect(xText0+wText, yText0+PaperShade, xText0+wText+PaperShade, 510 yText0+hText+PaperShade)); 511 FillRect(Rect(xText0+PaperShade, yText0+hText, xText0+wText+PaperShade, 512 yText0+hText+PaperShade)); 549 Offscreen.Canvas.TextOut 550 (xText1 + (wText - Offscreen.Canvas.TextWidth(RomanNo[i])) div 2, 551 yText1 + (hText - Offscreen.Canvas.TextHeight(RomanNo[i])) div 2, 552 RomanNo[i]); 553 end; 554 with Offscreen.Canvas do 555 begin 556 Brush.Color := MainTexture.clBevelShade; 557 if History[me].Text[Page - 1] <> '' then 558 begin 559 FillRect(Rect(xText0 + wText, yText0 + PaperShade, 560 xText0 + wText + PaperShade, yText0 + hText + PaperShade)); 561 FillRect(Rect(xText0 + PaperShade, yText0 + hText, 562 xText0 + wText + PaperShade, yText0 + hText + PaperShade)); 513 563 end; 514 FillRect(Rect(xText1+wText, yText1+PaperShade, xText1+wText+PaperShade,515 yText1+hText+PaperShade));516 FillRect(Rect(xText1+PaperShade, yText1+hText, xText1+wText+PaperShade,517 yText1+hText+PaperShade));518 Brush.Style:=bsClear;519 end; 520 521 Offscreen.Canvas.Font.Assign(UniFont[ftNormal]);522 523 {if Page=History[me].n then524 begin // show attitude525 s:=Phrases.Lookup('ATTITUDE',MyRO.EnemyReport[DipMem[me].pContact].Attitude);526 //LoweredTextOut(Offscreen.Canvas,-1,MainTexture,527 RisedTextOut(Offscreen.Canvas,xText0+wText div 2-564 FillRect(Rect(xText1 + wText, yText1 + PaperShade, 565 xText1 + wText + PaperShade, yText1 + hText + PaperShade)); 566 FillRect(Rect(xText1 + PaperShade, yText1 + hText, 567 xText1 + wText + PaperShade, yText1 + hText + PaperShade)); 568 Brush.Style := bsClear; 569 end; 570 571 Offscreen.Canvas.Font.Assign(UniFont[ftNormal]); 572 573 { if Page=History[me].n then 574 begin // show attitude 575 s:=Phrases.Lookup('ATTITUDE',MyRO.EnemyReport[DipMem[me].pContact].Attitude); 576 //LoweredTextOut(Offscreen.Canvas,-1,MainTexture, 577 RisedTextOut(Offscreen.Canvas,xText0+wText div 2- 528 578 BiColorTextWidth(Offscreen.Canvas,s) div 2,yAttitude,s); 529 s:=Phrases.Lookup('ATTITUDE',MyRO.Attitude[DipMem[me].pContact]);530 //LoweredTextOut(Offscreen.Canvas,-1,MainTexture,531 RisedTextOut(Offscreen.Canvas,xText1+wText div 2-579 s:=Phrases.Lookup('ATTITUDE',MyRO.Attitude[DipMem[me].pContact]); 580 //LoweredTextOut(Offscreen.Canvas,-1,MainTexture, 581 RisedTextOut(Offscreen.Canvas,xText1+wText div 2- 532 582 BiColorTextWidth(Offscreen.Canvas,s) div 2,yAttitude,s); 533 end;} 534 535 if History[me].Text[Page-1]<>'' then 536 SplitText(History[me].Text[Page-1], 537 Rect(xText0, yText0, xText0+wText, yText0+hText)); 538 if (Page<History[me].n) or OkEnabled then 539 SplitText(History[me].Text[Page], Rect(xText1, yText1, xText1+wText, yText1+hText)); 540 541 // show credibility 542 Offscreen.Canvas.Font.Assign(UniFont[ftTiny]); 543 cred:=MyRO.EnemyReport[DipMem[me].pContact].Credibility; 544 case cred of 545 0..49: i:= 3; 50..90: i:=0; 91..100: i:=1; end; 546 PaintProgressBar(Offscreen.Canvas,i,xCred0,yCred0+17,(cred+2) div 5,0,20,MainTexture); 547 s:=IntToStr(cred); 548 RisedTextOut(Offscreen.Canvas,xCred0+10-(BiColorTextWidth(Offscreen.Canvas,s)+1) div 2,yCred0,s); 549 case MyRO.Credibility of 550 0..49: i:= 3; 50..90: i:=0; 91..100: i:=1; end; 551 PaintProgressBar(Offscreen.Canvas,i,xCred1,yCred1+17,(MyRO.Credibility+2) div 5,0,20,MainTexture); 552 s:=IntToStr(MyRO.Credibility); 553 RisedTextOut(Offscreen.Canvas,xCred1+10-(BiColorTextWidth(Offscreen.Canvas,s)+1) div 2,yCred1,s); 554 555 MarkUsedOffscreen(ClientWidth,ClientHeight); 556 end; {OffscreenPaint} 583 end; } 584 585 if History[me].Text[Page - 1] <> '' then 586 SplitText(History[me].Text[Page - 1], Rect(xText0, yText0, xText0 + wText, 587 yText0 + hText)); 588 if (Page < History[me].n) or OkEnabled then 589 SplitText(History[me].Text[Page], Rect(xText1, yText1, xText1 + wText, 590 yText1 + hText)); 591 592 // show credibility 593 Offscreen.Canvas.Font.Assign(UniFont[ftTiny]); 594 cred := MyRO.EnemyReport[DipMem[me].pContact].Credibility; 595 case cred of 596 0 .. 49: 597 i := 3; 598 50 .. 90: 599 i := 0; 600 91 .. 100: 601 i := 1; 602 end; 603 PaintProgressBar(Offscreen.Canvas, i, xCred0, yCred0 + 17, (cred + 2) div 5, 604 0, 20, MainTexture); 605 s := IntToStr(cred); 606 RisedTextOut(Offscreen.Canvas, xCred0 + 10 - 607 (BiColorTextWidth(Offscreen.Canvas, s) + 1) div 2, yCred0, s); 608 case MyRO.Credibility of 609 0 .. 49: 610 i := 3; 611 50 .. 90: 612 i := 0; 613 91 .. 100: 614 i := 1; 615 end; 616 PaintProgressBar(Offscreen.Canvas, i, xCred1, yCred1 + 17, 617 (MyRO.Credibility + 2) div 5, 0, 20, MainTexture); 618 s := IntToStr(MyRO.Credibility); 619 RisedTextOut(Offscreen.Canvas, xCred1 + 10 - 620 (BiColorTextWidth(Offscreen.Canvas, s) + 1) div 2, yCred1, s); 621 622 MarkUsedOffscreen(ClientWidth, ClientHeight); 623 end; { OffscreenPaint } 557 624 558 625 procedure TNegoDlg.Initiate; 559 626 begin 560 History[me].n:=1;561 History[me].Text[0]:='';627 History[me].n := 1; 628 History[me].Text[0] := ''; 562 629 end; 563 630 564 631 procedure TNegoDlg.Respond; 565 632 begin 566 History[me].n:=0;633 History[me].n := 0; 567 634 end; 568 635 569 636 procedure TNegoDlg.FormMouseDown(Sender: TObject; Button: TMouseButton; 570 Shift: TShiftState; X, Y: Integer);571 begin 572 if (x>=xNationPicture0) and (x<xNationPicture0+64) 573 and (y>=yNationPicture) and (y<yNationPicture+48) then574 NatStatDlg.ShowNewContent(FWindowMode or wmPersistent, DipMem[me].pContact)575 else if (x>=xNationPicture1) and (x<xNationPicture1+64) 576 and (y>=yNationPicture) and (y<yNationPicture+48) then577 NatStatDlg.ShowNewContent(FWindowMode or wmPersistent,me)637 Shift: TShiftState; X, Y: integer); 638 begin 639 if (X >= xNationPicture0) and (X < xNationPicture0 + 64) and 640 (Y >= yNationPicture) and (Y < yNationPicture + 48) then 641 NatStatDlg.ShowNewContent(FWindowMode or wmPersistent, DipMem[me].pContact) 642 else if (X >= xNationPicture1) and (X < xNationPicture1 + 64) and 643 (Y >= yNationPicture) and (Y < yNationPicture + 48) then 644 NatStatDlg.ShowNewContent(FWindowMode or wmPersistent, me) 578 645 end; 579 646 580 647 procedure TNegoDlg.BwdBtnClick(Sender: TObject); 581 648 begin 582 dec(Page,2);583 SetButtonStates;584 SmartUpdateContent;649 dec(Page, 2); 650 SetButtonStates; 651 SmartUpdateContent; 585 652 end; 586 653 587 654 procedure TNegoDlg.FwdBtnClick(Sender: TObject); 588 655 begin 589 inc(Page,2);590 SetButtonStates;591 SmartUpdateContent;656 inc(Page, 2); 657 SetButtonStates; 658 SmartUpdateContent; 592 659 end; 593 660 594 661 procedure TNegoDlg.OkBtnClick(Sender: TObject); 595 662 begin 596 inc(History[me].n); 597 if DipCommand=scDipOffer then 598 MainScreen.OfferCall(CurrentOffer) 599 else MainScreen.DipCall(DipCommand); 663 inc(History[me].n); 664 if DipCommand = scDipOffer then 665 MainScreen.OfferCall(CurrentOffer) 666 else 667 MainScreen.DipCall(DipCommand); 600 668 end; 601 669 602 670 procedure TNegoDlg.CloseBtnClick(Sender: TObject); 603 671 begin 604 Close672 Close 605 673 end; 606 674 … … 608 676 Shift: TShiftState); 609 677 begin 610 if Key=VK_RETURN then 611 begin 612 if OkBtn.Visible then OkBtnClick(nil) 678 if Key = VK_RETURN then 679 begin 680 if OkBtn.Visible then 681 OkBtnClick(nil) 613 682 end 614 else inherited 683 else 684 inherited 615 685 end; 616 686 617 687 procedure TNegoDlg.BuildCurrentOffer; 618 688 var 619 i: integer; 620 begin 621 CurrentOffer.nDeliver:=0; 622 CurrentOffer.nCost:=0; 623 for i:=0 to 11 do if Delivers[i]<>$FFFFFFFF then 624 begin 625 CurrentOffer.Price[CurrentOffer.nDeliver]:=Delivers[i]; 626 inc(CurrentOffer.nDeliver); 627 end; 628 for i:=0 to 11 do if Costs[i]<>$FFFFFFFF then 629 begin 630 CurrentOffer.Price[CurrentOffer.nDeliver+CurrentOffer.nCost]:=Costs[i]; 631 inc(CurrentOffer.nCost); 632 end; 689 i: integer; 690 begin 691 CurrentOffer.nDeliver := 0; 692 CurrentOffer.nCost := 0; 693 for i := 0 to 11 do 694 if Delivers[i] <> $FFFFFFFF then 695 begin 696 CurrentOffer.Price[CurrentOffer.nDeliver] := Delivers[i]; 697 inc(CurrentOffer.nDeliver); 698 end; 699 for i := 0 to 11 do 700 if Costs[i] <> $FFFFFFFF then 701 begin 702 CurrentOffer.Price[CurrentOffer.nDeliver + CurrentOffer.nCost] := 703 Costs[i]; 704 inc(CurrentOffer.nCost); 705 end; 633 706 end; 634 707 635 708 procedure TNegoDlg.WantClick(Sender: TObject); 636 709 var 637 a,i,max: integer;638 Price: cardinal;639 begin 640 if (Page<>History[me].n) 641 or (ClientMode=scDipCancelTreaty) or (ClientMode=scDipBreak) then642 exit;643 if Costs[TButtonN(Sender).Tag and $FF]<>$FFFFFFFF then644 Price:=$FFFFFFFF // toggle off645 else646 begin 647 if CurrentOffer.nCost>=2 then648 begin 649 SimpleMessage(Phrases.Lookup('MAX2WANTS'));650 exit710 a, i, max: integer; 711 Price: cardinal; 712 begin 713 if (Page <> History[me].n) or (ClientMode = scDipCancelTreaty) or 714 (ClientMode = scDipBreak) then 715 exit; 716 if Costs[TButtonN(Sender).Tag and $FF] <> $FFFFFFFF then 717 Price := $FFFFFFFF // toggle off 718 else 719 begin 720 if CurrentOffer.nCost >= 2 then 721 begin 722 SimpleMessage(Phrases.Lookup('MAX2WANTS')); 723 exit 651 724 end; 652 Price:=ButtonPrice[TButtonN(Sender).Tag and $FF]; 653 if not (Price shr 24 in OppoAllowed) then exit; 654 case Price of 655 opCivilReport, opMilReport: 656 inc(Price,DipMem[me].pContact shl 16+MyRO.Turn); // !!! choose player and year! 657 opMoney: 658 begin // choose amount 659 InputDlg.Caption:=Phrases.Lookup('TITLE_AMOUNT'); 660 InputDlg.EInput.Text:=''; 661 InputDlg.CenterToRect(BoundsRect); 662 InputDlg.ShowModal; 663 if InputDlg.ModalResult<>mrOK then exit; 664 val(InputDlg.EInput.Text,a,i); 665 if (i<>0) or (a<=0) or (a>=MaxMoneyPrice) then exit; 666 inc(Price,a); 667 end; 668 opShipParts: 669 begin // choose type and number 670 if MyRO.NatBuilt[imSpacePort]=0 then with MessgExDlg do 725 Price := ButtonPrice[TButtonN(Sender).Tag and $FF]; 726 if not(Price shr 24 in OppoAllowed) then 727 exit; 728 case Price of 729 opCivilReport, opMilReport: 730 inc(Price, DipMem[me].pContact shl 16 + MyRO.Turn); 731 // !!! choose player and year! 732 opMoney: 733 begin // choose amount 734 InputDlg.Caption := Phrases.Lookup('TITLE_AMOUNT'); 735 InputDlg.EInput.Text := ''; 736 InputDlg.CenterToRect(BoundsRect); 737 InputDlg.ShowModal; 738 if InputDlg.ModalResult <> mrOK then 739 exit; 740 val(InputDlg.EInput.Text, a, i); 741 if (i <> 0) or (a <= 0) or (a >= MaxMoneyPrice) then 742 exit; 743 inc(Price, a); 744 end; 745 opShipParts: 746 begin // choose type and number 747 if MyRO.NatBuilt[imSpacePort] = 0 then 748 with MessgExDlg do 749 begin 750 OpenSound := 'WARNING_LOWSUPPORT'; 751 MessgText := Phrases.Lookup('NOSPACEPORT'); 752 Kind := mkYesNo; 753 IconKind := mikImp; 754 IconIndex := imSpacePort; 755 ShowModal; 756 if ModalResult <> mrOK then 757 exit 758 end; 759 ModalSelectDlg.ShowNewContent(wmModal, kEShipPart); 760 if ModalSelectDlg.result < 0 then 761 exit; 762 inc(Price, ModalSelectDlg.result shl 16); 763 max := MyRO.Ship[DipMem[me].pContact].Parts[ModalSelectDlg.result]; 764 InputDlg.Caption := Phrases.Lookup('TITLE_NUMBER'); 765 InputDlg.EInput.Text := ''; 766 InputDlg.CenterToRect(BoundsRect); 767 InputDlg.ShowModal; 768 if InputDlg.ModalResult <> mrOK then 769 exit; 770 val(InputDlg.EInput.Text, a, i); 771 if (i <> 0) or (a <= 0) then 772 exit; 773 if a > max then 774 a := max; 775 if a > MaxShipPartPrice then 776 a := MaxShipPartPrice; 777 inc(Price, a) 778 end; 779 opAllTech: 780 begin // choose technology 781 ModalSelectDlg.ShowNewContent(wmModal, kChooseETech); 782 if ModalSelectDlg.result < 0 then 783 exit; 784 if ModalSelectDlg.result = adAll then 785 Price := opAllTech 786 else 787 Price := OpTech + ModalSelectDlg.result; 788 end; 789 opAllModel: 790 begin // choose model 791 ModalSelectDlg.ShowNewContent(wmModal, kChooseEModel); 792 if ModalSelectDlg.result < 0 then 793 exit; 794 if ModalSelectDlg.result = mixAll then 795 Price := opAllModel 796 else 797 Price := OpModel + MyRO.EnemyModel[ModalSelectDlg.result].mix; 798 end; 799 opTreaty: 671 800 begin 672 OpenSound:='WARNING_LOWSUPPORT'; 673 MessgText:=Phrases.Lookup('NOSPACEPORT'); 674 Kind:=mkYesNo; 675 IconKind:=mikImp; 676 IconIndex:=imSpacePort; 677 ShowModal; 678 if ModalResult<>mrOK then exit 679 end; 680 ModalSelectDlg.ShowNewContent(wmModal,kEShipPart); 681 if ModalSelectDlg.result<0 then exit; 682 inc(Price, ModalSelectDlg.result shl 16); 683 max:=MyRO.Ship[DipMem[me].pContact].Parts[ModalSelectDlg.result]; 684 InputDlg.Caption:=Phrases.Lookup('TITLE_NUMBER'); 685 InputDlg.EInput.Text:=''; 686 InputDlg.CenterToRect(BoundsRect); 687 InputDlg.ShowModal; 688 if InputDlg.ModalResult<>mrOK then exit; 689 val(InputDlg.EInput.Text,a,i); 690 if (i<>0) or (a<=0) then exit; 691 if a>max then a:=max; 692 if a>MaxShipPartPrice then a:=MaxShipPartPrice; 693 inc(Price,a) 694 end; 695 opAllTech: 696 begin // choose technology 697 ModalSelectDlg.ShowNewContent(wmModal,kChooseETech); 698 if ModalSelectDlg.result<0 then exit; 699 if ModalSelectDlg.result=adAll then Price:=opAllTech 700 else Price:=OpTech+ModalSelectDlg.result; 701 end; 702 opAllModel: 703 begin // choose model 704 ModalSelectDlg.ShowNewContent(wmModal,kChooseEModel); 705 if ModalSelectDlg.result<0 then exit; 706 if ModalSelectDlg.result=mixAll then Price:=opAllModel 707 else Price:=OpModel+MyRO.EnemyModel[ModalSelectDlg.result].mix; 708 end; 709 opTreaty: 710 begin 711 if MyRO.Treaty[DipMem[me].pContact]<trPeace then Price:=opTreaty+trPeace 712 else Price:=opTreaty+MyRO.Treaty[DipMem[me].pContact]+1; 713 end; 714 { opLowTreaty: 715 begin 716 if MyRO.Treaty[DipMem[me].pContact]=trNone then Price:=opTreaty+trCeaseFire 717 else Price:=opTreaty+MyRO.Treaty[DipMem[me].pContact]-1; 718 end} 801 if MyRO.Treaty[DipMem[me].pContact] < trPeace then 802 Price := opTreaty + trPeace 803 else 804 Price := opTreaty + MyRO.Treaty[DipMem[me].pContact] + 1; 805 end; 806 { opLowTreaty: 807 begin 808 if MyRO.Treaty[DipMem[me].pContact]=trNone then Price:=opTreaty+trCeaseFire 809 else Price:=opTreaty+MyRO.Treaty[DipMem[me].pContact]-1; 810 end } 719 811 end; 720 812 end; 721 813 722 Costs[TButtonN(Sender).Tag and $FF]:=Price;723 BuildCurrentOffer;724 DipCommand:=scDipOffer;725 SetButtonStates;726 SmartUpdateContent;814 Costs[TButtonN(Sender).Tag and $FF] := Price; 815 BuildCurrentOffer; 816 DipCommand := scDipOffer; 817 SetButtonStates; 818 SmartUpdateContent; 727 819 end; 728 820 729 821 procedure TNegoDlg.OfferClick(Sender: TObject); 730 822 var 731 a,i,max: integer;732 Price: cardinal;733 begin 734 if (Page<>History[me].n) 735 or (ClientMode=scDipCancelTreaty) or (ClientMode=scDipBreak) then736 exit;737 if Delivers[TButtonN(Sender).Tag and $FF]<>$FFFFFFFF then738 Price:=$FFFFFFFF // toggle off739 else740 begin 741 if CurrentOffer.nDeliver>=2 then742 begin 743 SimpleMessage(Phrases.Lookup('MAX2OFFERS'));744 exit823 a, i, max: integer; 824 Price: cardinal; 825 begin 826 if (Page <> History[me].n) or (ClientMode = scDipCancelTreaty) or 827 (ClientMode = scDipBreak) then 828 exit; 829 if Delivers[TButtonN(Sender).Tag and $FF] <> $FFFFFFFF then 830 Price := $FFFFFFFF // toggle off 831 else 832 begin 833 if CurrentOffer.nDeliver >= 2 then 834 begin 835 SimpleMessage(Phrases.Lookup('MAX2OFFERS')); 836 exit 745 837 end; 746 Price:=ButtonPrice[TButtonN(Sender).Tag and $FF]; 747 if not (Price shr 24 in MyAllowed) then exit; 748 case Price of 749 opCivilReport, opMilReport: 750 inc(Price,me shl 16+MyRO.Turn); // !!! choose player and year! 751 opMoney: 752 begin // choose amount 753 InputDlg.Caption:=Phrases.Lookup('TITLE_AMOUNT'); 754 InputDlg.EInput.Text:=''; 755 InputDlg.CenterToRect(BoundsRect); 756 InputDlg.ShowModal; 757 if InputDlg.ModalResult<>mrOK then exit; 758 val(InputDlg.EInput.Text,a,i); 759 if (i<>0) or (a<=0) or (a>=MaxMoneyPrice) then exit; 760 if (Price=opMoney) and (a>MyRO.Money) then 761 a:=MyRO.Money; 762 inc(Price,a); 763 end; 764 opShipParts: 765 begin // choose type and number 766 ModalSelectDlg.ShowNewContent(wmModal,kShipPart); 767 if ModalSelectDlg.result<0 then exit; 768 inc(Price, ModalSelectDlg.result shl 16); 769 max:=MyRO.Ship[me].Parts[ModalSelectDlg.result]; 770 InputDlg.Caption:=Phrases.Lookup('TITLE_NUMBER'); 771 InputDlg.EInput.Text:=''; 772 InputDlg.CenterToRect(BoundsRect); 773 InputDlg.ShowModal; 774 if InputDlg.ModalResult<>mrOK then exit; 775 val(InputDlg.EInput.Text,a,i); 776 if (i<>0) or (a<=0) then exit; 777 if a>max then a:=max; 778 if a>MaxShipPartPrice then a:=MaxShipPartPrice; 779 inc(Price,a) 780 end; 781 opAllTech: 782 begin // choose technology 783 ModalSelectDlg.ShowNewContent(wmModal,kChooseTech); 784 if ModalSelectDlg.result<0 then exit; 785 if ModalSelectDlg.result=adAll then Price:=opAllTech 786 else Price:=OpTech+ModalSelectDlg.result; 787 end; 788 opAllModel: 789 begin // choose model 790 ModalSelectDlg.ShowNewContent(wmModal,kChooseModel); 791 if ModalSelectDlg.result<0 then exit; 792 if ModalSelectDlg.result=mixAll then Price:=opAllModel 793 else Price:=opModel+ModalSelectDlg.result 794 end; 795 opTreaty: 796 begin 797 if MyRO.Treaty[DipMem[me].pContact]<trPeace then Price:=opTreaty+trPeace 798 else Price:=opTreaty+MyRO.Treaty[DipMem[me].pContact]+1; 799 end; 800 { opLowTreaty: 801 begin 802 if MyRO.Treaty[DipMem[me].pContact]=trNone then Price:=opTreaty+trCeaseFire 803 else Price:=opTreaty+MyRO.Treaty[DipMem[me].pContact]-1; 804 end} 838 Price := ButtonPrice[TButtonN(Sender).Tag and $FF]; 839 if not(Price shr 24 in MyAllowed) then 840 exit; 841 case Price of 842 opCivilReport, opMilReport: 843 inc(Price, me shl 16 + MyRO.Turn); // !!! choose player and year! 844 opMoney: 845 begin // choose amount 846 InputDlg.Caption := Phrases.Lookup('TITLE_AMOUNT'); 847 InputDlg.EInput.Text := ''; 848 InputDlg.CenterToRect(BoundsRect); 849 InputDlg.ShowModal; 850 if InputDlg.ModalResult <> mrOK then 851 exit; 852 val(InputDlg.EInput.Text, a, i); 853 if (i <> 0) or (a <= 0) or (a >= MaxMoneyPrice) then 854 exit; 855 if (Price = opMoney) and (a > MyRO.Money) then 856 a := MyRO.Money; 857 inc(Price, a); 858 end; 859 opShipParts: 860 begin // choose type and number 861 ModalSelectDlg.ShowNewContent(wmModal, kShipPart); 862 if ModalSelectDlg.result < 0 then 863 exit; 864 inc(Price, ModalSelectDlg.result shl 16); 865 max := MyRO.Ship[me].Parts[ModalSelectDlg.result]; 866 InputDlg.Caption := Phrases.Lookup('TITLE_NUMBER'); 867 InputDlg.EInput.Text := ''; 868 InputDlg.CenterToRect(BoundsRect); 869 InputDlg.ShowModal; 870 if InputDlg.ModalResult <> mrOK then 871 exit; 872 val(InputDlg.EInput.Text, a, i); 873 if (i <> 0) or (a <= 0) then 874 exit; 875 if a > max then 876 a := max; 877 if a > MaxShipPartPrice then 878 a := MaxShipPartPrice; 879 inc(Price, a) 880 end; 881 opAllTech: 882 begin // choose technology 883 ModalSelectDlg.ShowNewContent(wmModal, kChooseTech); 884 if ModalSelectDlg.result < 0 then 885 exit; 886 if ModalSelectDlg.result = adAll then 887 Price := opAllTech 888 else 889 Price := OpTech + ModalSelectDlg.result; 890 end; 891 opAllModel: 892 begin // choose model 893 ModalSelectDlg.ShowNewContent(wmModal, kChooseModel); 894 if ModalSelectDlg.result < 0 then 895 exit; 896 if ModalSelectDlg.result = mixAll then 897 Price := opAllModel 898 else 899 Price := OpModel + ModalSelectDlg.result 900 end; 901 opTreaty: 902 begin 903 if MyRO.Treaty[DipMem[me].pContact] < trPeace then 904 Price := opTreaty + trPeace 905 else 906 Price := opTreaty + MyRO.Treaty[DipMem[me].pContact] + 1; 907 end; 908 { opLowTreaty: 909 begin 910 if MyRO.Treaty[DipMem[me].pContact]=trNone then Price:=opTreaty+trCeaseFire 911 else Price:=opTreaty+MyRO.Treaty[DipMem[me].pContact]-1; 912 end } 805 913 end; 806 914 end; 807 915 808 Delivers[TButtonN(Sender).Tag and $FF]:=Price;809 BuildCurrentOffer;810 DipCommand:=scDipOffer;811 SetButtonStates;812 SmartUpdateContent;916 Delivers[TButtonN(Sender).Tag and $FF] := Price; 917 BuildCurrentOffer; 918 DipCommand := scDipOffer; 919 SetButtonStates; 920 SmartUpdateContent; 813 921 end; 814 922 815 923 procedure TNegoDlg.FastBtnClick(Sender: TObject); 816 924 var 817 NewCommand: cardinal; 818 begin 819 if Page<>History[me].n then exit; 820 NewCommand:=TButtonN(Sender).Tag and $FF+scDipStart; 821 if not (NewCommand-scDipStart in CommandAllowed) then exit; 822 if (NewCommand=scDipCancelTreaty) 823 and (MyRO.Turn<MyRO.LastCancelTreaty[DipMem[me].pContact]+CancelTreatyTurns) then 824 begin 825 SimpleMessage(Phrases.Lookup('CANCELTREATYRUSH')); 826 exit; 827 end; 828 if (NewCommand=scDipOffer) 829 and ((ClientMode=scDipCancelTreaty) or (ClientMode=scDipBreak)) then 830 DipCommand:=scDipNotice 831 else DipCommand:=NewCommand; 832 ResetCurrentOffer; 833 SetButtonStates; 834 SmartUpdateContent; 925 NewCommand: cardinal; 926 begin 927 if Page <> History[me].n then 928 exit; 929 NewCommand := TButtonN(Sender).Tag and $FF + scDipStart; 930 if not(NewCommand - scDipStart in CommandAllowed) then 931 exit; 932 if (NewCommand = scDipCancelTreaty) and 933 (MyRO.Turn < MyRO.LastCancelTreaty[DipMem[me].pContact] + CancelTreatyTurns) 934 then 935 begin 936 SimpleMessage(Phrases.Lookup('CANCELTREATYRUSH')); 937 exit; 938 end; 939 if (NewCommand = scDipOffer) and ((ClientMode = scDipCancelTreaty) or 940 (ClientMode = scDipBreak)) then 941 DipCommand := scDipNotice 942 else 943 DipCommand := NewCommand; 944 ResetCurrentOffer; 945 SetButtonStates; 946 SmartUpdateContent; 835 947 end; 836 948 837 949 end. 838 -
trunk/LocalPlayer/PVSB.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit PVSB; 4 3 … … 6 5 7 6 uses 8 Windows, Messages,SysUtils;7 Windows, Messages, SysUtils; 9 8 10 9 type 11 TPVScrollbar=record h:integer;si:TScrollInfo end; 10 TPVScrollbar = record 11 h: integer; 12 si: TScrollInfo end; 12 13 13 procedure CreatePVSB(var sb:TPVScrollbar;Handle,y0,x1,y1:integer); 14 procedure InitPVSB(var sb:TPVScrollbar;max,Page:integer); 15 function ProcessPVSB(var sb:TPVScrollbar;const m:TMessage):boolean; 16 function ProcessMouseWheel(var sb:TPVScrollbar;const m:TMessage):boolean; 17 procedure ShowPVSB(var sb:TPVScrollbar; Visible: boolean); 18 procedure EndPVSB(var sb:TPVScrollbar); 14 procedure CreatePVSB(var sb: TPVScrollbar; Handle, y0, x1, y1: integer); 15 procedure InitPVSB(var sb: TPVScrollbar; max, Page: integer); 16 function ProcessPVSB(var sb: TPVScrollbar; const m: TMessage): boolean; 17 function ProcessMouseWheel(var sb: TPVScrollbar; const m: TMessage) 18 : boolean; 19 procedure ShowPVSB(var sb: TPVScrollbar; Visible: boolean); 20 procedure EndPVSB(var sb: TPVScrollbar); 19 21 20 22 implementation 21 23 22 24 const 23 Count:integer= 0;25 Count: integer = 0; 24 26 25 27 procedure CreatePVSB; 26 28 begin 27 inc(Count); 28 sb.h:=CreateWindowEx(0,'SCROLLBAR',pchar('PVSB'+IntToStr(Count)), 29 SBS_VERT or WS_CHILD or SBS_RIGHTALIGN,x1-100,y0,100,y1-y0,Handle,0,0,nil); 30 sb.si.cbSize:=28; 29 inc(Count); 30 sb.h := CreateWindowEx(0, 'SCROLLBAR', pchar('PVSB' + IntToStr(Count)), 31 SBS_VERT or WS_CHILD or SBS_RIGHTALIGN, x1 - 100, y0, 100, y1 - y0, 32 Handle, 0, 0, nil); 33 sb.si.cbSize := 28; 31 34 end; 32 35 33 36 procedure InitPVSB; 34 37 begin 35 with sb.si do38 with sb.si do 36 39 begin 37 nMin:=0;nMax:=max;npos:=0;nPage:=Page; 38 FMask:=SIF_PAGE or SIF_POS or SIF_RANGE; 40 nMin := 0; 41 nMax := max; 42 npos := 0; 43 nPage := Page; 44 FMask := SIF_PAGE or SIF_POS or SIF_RANGE; 39 45 end; 40 SetScrollInfo(sb.h,SB_CTL,sb.si,true); 41 if max<Page then ShowWindow(sb.h,SW_HIDE) else ShowWindow(sb.h,SW_SHOW) 46 SetScrollInfo(sb.h, SB_CTL, sb.si, true); 47 if max < Page then 48 ShowWindow(sb.h, SW_HIDE) 49 else 50 ShowWindow(sb.h, SW_SHOW) 42 51 end; 43 52 44 53 function ProcessPVSB; 45 54 var 46 NewPos:integer;55 NewPos: integer; 47 56 begin 48 with sb.si do 49 if nMax<integer(nPage) then result:=false 50 else 57 with sb.si do 58 if nMax < integer(nPage) then 59 result := false 60 else 51 61 begin 52 if m.wParamLo in[SB_THUMBPOSITION,SB_THUMBTRACK] then 53 begin result:=m.wParamHi<>npos;npos:=m.wParamHi;end 54 else 62 if m.wParamLo in [SB_THUMBPOSITION, SB_THUMBTRACK] then 55 63 begin 56 case m.wParamLo of 57 SB_LINEUP:NewPos:=npos-1;SB_LINEDOWN:NewPos:=npos+1; 58 SB_PAGEUP:NewPos:=npos-integer(nPage);SB_PAGEDOWN:NewPos:=npos+integer(nPage); 59 else NewPos:=npos 64 result := m.wParamHi <> npos; 65 npos := m.wParamHi; 66 end 67 else 68 begin 69 case m.wParamLo of 70 SB_LINEUP: 71 NewPos := npos - 1; 72 SB_LINEDOWN: 73 NewPos := npos + 1; 74 SB_PAGEUP: 75 NewPos := npos - integer(nPage); 76 SB_PAGEDOWN: 77 NewPos := npos + integer(nPage); 78 else 79 NewPos := npos 60 80 end; 61 if NewPos<0 then NewPos:=0; 62 if NewPos>nMax-integer(nPage)+1 then NewPos:=nMax-integer(nPage)+1; 63 result:=NewPos<>npos; 64 if (NewPos<>npos) or (m.wParamLo=SB_ENDSCROLL) then 81 if NewPos < 0 then 82 NewPos := 0; 83 if NewPos > nMax - integer(nPage) + 1 then 84 NewPos := nMax - integer(nPage) + 1; 85 result := NewPos <> npos; 86 if (NewPos <> npos) or (m.wParamLo = SB_ENDSCROLL) then 65 87 begin 66 npos:=NewPos;FMask:=SIF_POS; 67 SetScrollInfo(sb.h,SB_CTL,sb.si,true); 88 npos := NewPos; 89 FMask := SIF_POS; 90 SetScrollInfo(sb.h, SB_CTL, sb.si, true); 68 91 end; 69 92 end … … 73 96 function ProcessMouseWheel; 74 97 var 75 NewPos:integer;98 NewPos: integer; 76 99 begin 77 with sb.si do 78 if nMax<integer(nPage) then result:=false 79 else 100 with sb.si do 101 if nMax < integer(nPage) then 102 result := false 103 else 80 104 begin 81 NewPos:=npos-m.wParam div (1 shl 16*40); 82 if NewPos<0 then NewPos:=0; 83 if NewPos>nMax-integer(nPage)+1 then NewPos:=nMax-integer(nPage)+1; 84 result:=NewPos<>npos; 85 if NewPos<>npos then 105 NewPos := npos - m.wParam div (1 shl 16 * 40); 106 if NewPos < 0 then 107 NewPos := 0; 108 if NewPos > nMax - integer(nPage) + 1 then 109 NewPos := nMax - integer(nPage) + 1; 110 result := NewPos <> npos; 111 if NewPos <> npos then 86 112 begin 87 npos:=NewPos;FMask:=SIF_POS; 88 SetScrollInfo(sb.h,SB_CTL,sb.si,true); 113 npos := NewPos; 114 FMask := SIF_POS; 115 SetScrollInfo(sb.h, SB_CTL, sb.si, true); 89 116 end 90 117 end 91 118 end; 92 119 93 procedure ShowPVSB(var sb: TPVScrollbar; Visible: boolean);120 procedure ShowPVSB(var sb: TPVScrollbar; Visible: boolean); 94 121 begin 95 if not Visible or (sb.si.nMax<integer(sb.si.nPage)) then 96 ShowWindow(sb.h,SW_HIDE) 97 else ShowWindow(sb.h,SW_SHOW) 122 if not Visible or (sb.si.nMax < integer(sb.si.nPage)) then 123 ShowWindow(sb.h, SW_HIDE) 124 else 125 ShowWindow(sb.h, SW_SHOW) 98 126 end; 99 127 100 procedure EndPVSB(var sb: TPVScrollbar);128 procedure EndPVSB(var sb: TPVScrollbar); 101 129 begin 102 with sb.si do130 with sb.si do 103 131 begin 104 if nMax<integer(nPage) then npos:=0 // hidden 105 else 132 if nMax < integer(nPage) then 133 npos := 0 // hidden 134 else 106 135 begin 107 sb.si.npos:=nMax-integer(nPage)+1;108 sb.si.FMask:=SIF_POS;109 SetScrollInfo(sb.h,SB_CTL,sb.si,true);136 sb.si.npos := nMax - integer(nPage) + 1; 137 sb.si.FMask := SIF_POS; 138 SetScrollInfo(sb.h, SB_CTL, sb.si, true); 110 139 end 111 140 end … … 113 142 114 143 end. 115 -
trunk/LocalPlayer/Rates.pas
r2 r6 5 5 6 6 uses 7 Protocol, ScreenTools,BaseWin,7 Protocol, ScreenTools, BaseWin, 8 8 9 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, … … 32 32 33 33 uses 34 ClientTools, Term,Tribes;34 ClientTools, Term, Tribes; 35 35 36 36 {$R *.DFM} 37 37 38 38 const 39 MessageLineSpacing=20; 40 39 MessageLineSpacing = 20; 41 40 42 41 procedure TRatesDlg.FormCreate(Sender: TObject); 43 42 begin 44 TitleHeight:=Screen.Height;45 InitButtons();43 TitleHeight := Screen.Height; 44 InitButtons(); 46 45 end; 47 46 48 47 procedure TRatesDlg.OffscreenPaint; 49 48 var 50 p,x,y,current,max,i: integer; 51 s,s1: string; 52 begin 53 if (OffscreenUser<>nil) and (OffscreenUser<>self) then OffscreenUser.Update; 49 p, x, y, current, max, i: integer; 50 s, s1: string; 51 begin 52 if (OffscreenUser <> nil) and (OffscreenUser <> self) then 53 OffscreenUser.Update; 54 54 // complete working with old owner to prevent rebound 55 OffscreenUser:=self; 56 57 Fill(Offscreen.Canvas, 0,0,ClientWidth,ClientHeight, 58 (wMaintexture-ClientWidth) div 2,(hMaintexture-ClientHeight) div 2); 59 Frame(Offscreen.Canvas,0,0,ClientWidth-1,ClientHeight-1,0,0); 60 Frame(Offscreen.Canvas,1,1,ClientWidth-2,ClientHeight-2,MainTexture.clBevelLight,MainTexture.clBevelShade); 61 Frame(Offscreen.Canvas,2,2,ClientWidth-3,ClientHeight-3,MainTexture.clBevelLight,MainTexture.clBevelShade); 62 63 BtnFrame(Offscreen.Canvas,CloseBtn.BoundsRect,MainTexture); 64 Offscreen.Canvas.Font.Assign(UniFont[ftCaption]); 65 s:=Phrases.Lookup('TITLE_RATES'); 66 RisedTextOut(Offscreen.Canvas,(ClientWidth-BiColorTextWidth(Offscreen.Canvas,s)) div 2-1,7,s); 67 68 if MyRO.Wonder[woLiberty].EffectiveOwner=me then 69 s:=Phrases.Lookup('NORATES') 70 else s:=Phrases.Lookup('RATES'); 71 Offscreen.Canvas.Font.Assign(UniFont[ftNormal]); 72 p:=pos('\',s); 73 if p=0 then 74 RisedTextout(Offscreen.Canvas,(ClientWidth-BiColorTextWidth(Canvas,s)) div 2, 114, s) 75 else 76 begin 77 s1:=copy(s,1,p-1); 78 RisedTextout(Offscreen.Canvas,(ClientWidth-BiColorTextWidth(Offscreen.Canvas,s1)) div 2, 79 114-MessageLineSpacing div 2, s1); 80 s1:=copy(s,p+1,255); 81 RisedTextout(Offscreen.Canvas,(ClientWidth-BiColorTextWidth(Offscreen.Canvas,s1)) div 2, 82 114+(MessageLineSpacing-MessageLineSpacing div 2), s1); 83 end; 84 Offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 85 86 if MyRO.Wonder[woLiberty].EffectiveOwner=me then 87 begin 88 GlowFrame(Offscreen, ClientWidth div 2-xSizeBig div 2, 89 52,xSizeBig, ySizeBig, Tribe[me].Color); 90 BitBlt(Offscreen.Canvas.Handle, ClientWidth div 2-xSizeBig div 2, 91 52, xSizeBig, ySizeBig,BigImp.Canvas.Handle, 92 (woLiberty mod 7)*xSizeBig, (woLiberty div 7+SystemIconLines)*ySizeBig, SRCCOPY); 93 end 94 else 95 begin 96 // ImageOp_CBC(Offscreen,Templates,260,40,145,112,36,36,$404000,$8B8BEB); 97 98 s:=Phrases.Lookup('SCIENCE'); 99 RisedTextOut(Offscreen.Canvas,16+120-BiColorTextWidth(Offscreen.Canvas,s),44,s); 100 s:=Format('%d%%',[100-MyRO.TaxRate-MyRO.LuxRate]); 101 RisedTextOut(Offscreen.Canvas,16+120-BiColorTextWidth(Offscreen.Canvas,s),60,s); 102 //PaintProgressBar(Offscreen.Canvas,2,16,81,(100-MyRO.LuxRate-MyRO.TaxRate)*120 div 100,0,120,MainTexture); 103 104 // reverse progress bar for science 105 x:=16; 106 y:=81; 107 current:=(100-MyRO.LuxRate-MyRO.TaxRate)*120 div 100; 108 max:=120; 109 Frame(Offscreen.Canvas,x-1,y-1,x+max,y+7,$000000,$000000); 110 RFrame(Offscreen.Canvas,x-2,y-2,x+max+1,y+8,MainTexture.clBevelShade,MainTexture.clBevelLight); 111 with Offscreen.Canvas do 55 OffscreenUser := self; 56 57 Fill(Offscreen.Canvas, 0, 0, ClientWidth, ClientHeight, 58 (wMaintexture - ClientWidth) div 2, (hMaintexture - ClientHeight) div 2); 59 Frame(Offscreen.Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0); 60 Frame(Offscreen.Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2, 61 MainTexture.clBevelLight, MainTexture.clBevelShade); 62 Frame(Offscreen.Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3, 63 MainTexture.clBevelLight, MainTexture.clBevelShade); 64 65 BtnFrame(Offscreen.Canvas, CloseBtn.BoundsRect, MainTexture); 66 Offscreen.Canvas.Font.Assign(UniFont[ftCaption]); 67 s := Phrases.Lookup('TITLE_RATES'); 68 RisedTextOut(Offscreen.Canvas, 69 (ClientWidth - BiColorTextWidth(Offscreen.Canvas, s)) div 2 - 1, 7, s); 70 71 if MyRO.Wonder[woLiberty].EffectiveOwner = me then 72 s := Phrases.Lookup('NORATES') 73 else 74 s := Phrases.Lookup('RATES'); 75 Offscreen.Canvas.Font.Assign(UniFont[ftNormal]); 76 p := pos('\', s); 77 if p = 0 then 78 RisedTextOut(Offscreen.Canvas, (ClientWidth - BiColorTextWidth(Canvas, s)) 79 div 2, 114, s) 80 else 81 begin 82 s1 := copy(s, 1, p - 1); 83 RisedTextOut(Offscreen.Canvas, 84 (ClientWidth - BiColorTextWidth(Offscreen.Canvas, s1)) div 2, 85 114 - MessageLineSpacing div 2, s1); 86 s1 := copy(s, p + 1, 255); 87 RisedTextOut(Offscreen.Canvas, 88 (ClientWidth - BiColorTextWidth(Offscreen.Canvas, s1)) div 2, 89 114 + (MessageLineSpacing - MessageLineSpacing div 2), s1); 90 end; 91 Offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 92 93 if MyRO.Wonder[woLiberty].EffectiveOwner = me then 94 begin 95 GlowFrame(Offscreen, ClientWidth div 2 - xSizeBig div 2, 52, xSizeBig, 96 ySizeBig, Tribe[me].Color); 97 BitBlt(Offscreen.Canvas.Handle, ClientWidth div 2 - xSizeBig div 2, 52, 98 xSizeBig, ySizeBig, BigImp.Canvas.Handle, (woLiberty mod 7) * xSizeBig, 99 (woLiberty div 7 + SystemIconLines) * ySizeBig, SRCCOPY); 100 end 101 else 102 begin 103 // ImageOp_CBC(Offscreen,Templates,260,40,145,112,36,36,$404000,$8B8BEB); 104 105 s := Phrases.Lookup('SCIENCE'); 106 RisedTextOut(Offscreen.Canvas, 107 16 + 120 - BiColorTextWidth(Offscreen.Canvas, s), 44, s); 108 s := Format('%d%%', [100 - MyRO.TaxRate - MyRO.LuxRate]); 109 RisedTextOut(Offscreen.Canvas, 110 16 + 120 - BiColorTextWidth(Offscreen.Canvas, s), 60, s); 111 // PaintProgressBar(Offscreen.Canvas,2,16,81,(100-MyRO.LuxRate-MyRO.TaxRate)*120 div 100,0,120,MainTexture); 112 113 // reverse progress bar for science 114 x := 16; 115 y := 81; 116 current := (100 - MyRO.LuxRate - MyRO.TaxRate) * 120 div 100; 117 max := 120; 118 Frame(Offscreen.Canvas, x - 1, y - 1, x + max, y + 7, $000000, $000000); 119 RFrame(Offscreen.Canvas, x - 2, y - 2, x + max + 1, y + 8, 120 MainTexture.clBevelShade, MainTexture.clBevelLight); 121 with Offscreen.Canvas do 112 122 begin 113 for i:=0 to current div 8-1 do114 BitBlt(Handle,x+max-8-i*8,y,8,7,GrExt[HGrSystem].Data.Canvas.Handle,104,115 9+8*2,SRCCOPY);116 BitBlt(Handle,x+max-current,y,117 current-8*(current div 8),7,GrExt[HGrSystem].Data.Canvas.Handle,104,9+8*2,SRCCOPY);118 Brush.Color:=$000000;119 FillRect(Rect(x,y,x+max-current,y+7));120 Brush.Style:=bsClear;123 for i := 0 to current div 8 - 1 do 124 BitBlt(Handle, x + max - 8 - i * 8, y, 8, 7, 125 GrExt[HGrSystem].Data.Canvas.Handle, 104, 9 + 8 * 2, SRCCOPY); 126 BitBlt(Handle, x + max - current, y, current - 8 * (current div 8), 7, 127 GrExt[HGrSystem].Data.Canvas.Handle, 104, 9 + 8 * 2, SRCCOPY); 128 Brush.Color := $000000; 129 FillRect(Rect(x, y, x + max - current, y + 7)); 130 Brush.Style := bsClear; 121 131 end; 122 132 123 RisedTextOut(Offscreen.Canvas,16+160,44,Phrases.Lookup('LUX')); 124 s:=Format('%d%%',[MyRO.LuxRate]); 125 RisedTextOut(Offscreen.Canvas,16+160{+120-BiColorTextWidth(Offscreen.Canvas,s)},60,s); 126 PaintProgressBar(Offscreen.Canvas,5,16+160,81,MyRO.LuxRate*120 div 100,0,120,MainTexture); 127 RFrame(Offscreen.Canvas,ScienceBtn.Left-1,LuxBtn.Top-1,LuxBtn.Left+12, 128 LuxBtn.Top+12,MainTexture.clBevelShade,MainTexture.clBevelLight); 129 end; 130 131 DLine(Offscreen.Canvas,1,ClientWidth-2,154, MainTexture.clBevelShade, MainTexture.clBevelLight); 132 RisedTextOut(Offscreen.Canvas,16+80,164,Phrases.Lookup('TAXRATE')); 133 s:=Format('%d%%',[MyRO.TaxRate]); 134 RisedTextOut(Offscreen.Canvas,16+80{+120-BiColorTextWidth(Offscreen.Canvas,s)},180,s); 135 PaintProgressBar(Offscreen.Canvas,0,16+80,201,MyRO.TaxRate*120 div 100,0,120,MainTexture); 136 RFrame(Offscreen.Canvas,TaxUpBtn.Left-1,TaxUpBtn.Top-1,TaxUpBtn.Left+12, 137 TaxDownBtn.Top+12,MainTexture.clBevelShade,MainTexture.clBevelLight); 138 139 MarkUsedOffscreen(ClientWidth,ClientHeight); 133 RisedTextOut(Offscreen.Canvas, 16 + 160, 44, Phrases.Lookup('LUX')); 134 s := Format('%d%%', [MyRO.LuxRate]); 135 RisedTextOut(Offscreen.Canvas, 136 16 + 160 { +120-BiColorTextWidth(Offscreen.Canvas,s) } , 60, s); 137 PaintProgressBar(Offscreen.Canvas, 5, 16 + 160, 81, 138 MyRO.LuxRate * 120 div 100, 0, 120, MainTexture); 139 RFrame(Offscreen.Canvas, ScienceBtn.Left - 1, LuxBtn.Top - 1, 140 LuxBtn.Left + 12, LuxBtn.Top + 12, MainTexture.clBevelShade, 141 MainTexture.clBevelLight); 142 end; 143 144 DLine(Offscreen.Canvas, 1, ClientWidth - 2, 154, MainTexture.clBevelShade, 145 MainTexture.clBevelLight); 146 RisedTextOut(Offscreen.Canvas, 16 + 80, 164, Phrases.Lookup('TAXRATE')); 147 s := Format('%d%%', [MyRO.TaxRate]); 148 RisedTextOut(Offscreen.Canvas, 149 16 + 80 { +120-BiColorTextWidth(Offscreen.Canvas,s) } , 180, s); 150 PaintProgressBar(Offscreen.Canvas, 0, 16 + 80, 201, 151 MyRO.TaxRate * 120 div 100, 0, 120, MainTexture); 152 RFrame(Offscreen.Canvas, TaxUpBtn.Left - 1, TaxUpBtn.Top - 1, 153 TaxUpBtn.Left + 12, TaxDownBtn.Top + 12, MainTexture.clBevelShade, 154 MainTexture.clBevelLight); 155 156 MarkUsedOffscreen(ClientWidth, ClientHeight); 140 157 end; 141 158 142 159 procedure TRatesDlg.ShowNewContent(NewMode: integer); 143 160 begin 144 inherited ShowNewContent(NewMode);161 inherited ShowNewContent(NewMode); 145 162 end; 146 163 147 164 procedure TRatesDlg.FormShow(Sender: TObject); 148 165 begin 149 if MyRO.Wonder[woLiberty].EffectiveOwner=me then150 begin 151 ScienceBtn.Visible:=false;152 LuxBtn.Visible:=false;153 end 154 else155 begin 156 ScienceBtn.Visible:=true;157 LuxBtn.Visible:=true;158 end; 159 OffscreenPaint;166 if MyRO.Wonder[woLiberty].EffectiveOwner = me then 167 begin 168 ScienceBtn.Visible := false; 169 LuxBtn.Visible := false; 170 end 171 else 172 begin 173 ScienceBtn.Visible := true; 174 LuxBtn.Visible := true; 175 end; 176 OffscreenPaint; 160 177 end; 161 178 162 179 procedure TRatesDlg.CloseBtnClick(Sender: TObject); 163 180 begin 164 Close;181 Close; 165 182 end; 166 183 167 184 procedure TRatesDlg.TaxLuxBtnClick(Sender: TObject); 168 185 var 169 NewTax, NewLux: integer; 170 begin 171 NewTax:=MyRO.TaxRate div 10; 172 NewLux:=MyRO.LuxRate div 10; 173 if Sender=TaxUpBtn then 174 begin 175 if NewTax<10 then inc(NewTax); 176 if NewTax+NewLux>10 then dec(NewLux); 177 end 178 else if (Sender=TaxDownBtn) and (NewTax>0) then 179 dec(NewTax) 180 else if (Sender=ScienceBtn) and (NewLux>0) then 181 dec(NewLux) 182 else if (Sender=LuxBtn) and (NewLux+NewTax<100) then 183 inc(NewLux); 184 if Server(sSetRates,me,NewTax+NewLux shl 4,nil^)<>eNotChanged then 185 begin 186 CityOptimizer_BeginOfTurn; 187 SmartUpdateContent; 188 MainScreen.UpdateViews(true); 186 NewTax, NewLux: integer; 187 begin 188 NewTax := MyRO.TaxRate div 10; 189 NewLux := MyRO.LuxRate div 10; 190 if Sender = TaxUpBtn then 191 begin 192 if NewTax < 10 then 193 inc(NewTax); 194 if NewTax + NewLux > 10 then 195 dec(NewLux); 196 end 197 else if (Sender = TaxDownBtn) and (NewTax > 0) then 198 dec(NewTax) 199 else if (Sender = ScienceBtn) and (NewLux > 0) then 200 dec(NewLux) 201 else if (Sender = LuxBtn) and (NewLux + NewTax < 100) then 202 inc(NewLux); 203 if Server(sSetRates, me, NewTax + NewLux shl 4, nil^) <> eNotChanged then 204 begin 205 CityOptimizer_BeginOfTurn; 206 SmartUpdateContent; 207 MainScreen.UpdateViews(true); 189 208 end 190 209 end; 191 210 192 211 end. 193 -
trunk/LocalPlayer/Select.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit Select; 4 3 … … 6 5 7 6 uses 8 Protocol, ClientTools,Term,ScreenTools,IsoEngine,PVSB,BaseWin,9 10 Windows, Messages,SysUtils,Classes,Graphics,Controls,Forms,11 ExtCtrls, ButtonB, ButtonBase, Menus;7 Protocol, ClientTools, Term, ScreenTools, IsoEngine, PVSB, BaseWin, 8 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, 10 ExtCtrls, ButtonB, ButtonBase, Menus; 12 11 13 12 const 14 MaxLayer=3;13 MaxLayer = 3; 15 14 16 15 type 17 TListKind =(kProject,kAdvance,kFarAdvance,kCities,kCityEvents,kModels,kEModels,18 k AllEModels,kTribe,kScience,kShipPart,kEShipPart,kChooseTech,19 kChooseETech, kChooseModel,kChooseEModel,kChooseCity,kChooseECity,20 kStealTech, kGov,kMission);16 TListKind = (kProject, kAdvance, kFarAdvance, kCities, kCityEvents, kModels, 17 kEModels, kAllEModels, kTribe, kScience, kShipPart, kEShipPart, kChooseTech, 18 kChooseETech, kChooseModel, kChooseEModel, kChooseCity, kChooseECity, 19 kStealTech, kGov, kMission); 21 20 22 21 TListDlg = class(TFramedDlg) … … 27 26 ToggleBtn: TButtonB; 28 27 Popup: TPopupMenu; 29 procedure PaintBox1MouseMove(Sender: TObject;Shift:TShiftState;x,30 y:integer);31 procedure FormCreate(Sender: TObject);32 procedure PaintBox1MouseDown(Sender: TObject;Button:TMouseButton;33 Shift: TShiftState;x,y:integer);34 procedure FormPaint(Sender: TObject);35 procedure CloseBtnClick(Sender: TObject);28 procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; 29 x, y: integer); 30 procedure FormCreate(Sender: TObject); 31 procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; 32 Shift: TShiftState; x, y: integer); 33 procedure FormPaint(Sender: TObject); 34 procedure CloseBtnClick(Sender: TObject); 36 35 procedure FormCloseQuery(Sender: TObject; var CanClose: boolean); 37 36 procedure FormShow(Sender: TObject); 38 37 procedure ModeBtnClick(Sender: TObject); 39 38 procedure ToggleBtnClick(Sender: TObject); 40 procedure FormKeyDown(Sender: TObject; var Key: word; 41 Shift: TShiftState); 39 procedure FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState); 42 40 procedure PlayerClick(Sender: TObject); 43 41 procedure FormDestroy(Sender: TObject); … … 45 43 public 46 44 result: integer; 47 function OnlyChoice(TestKind: TListKind): integer; // -2=empty, -1=ambiguous, other=only choice 45 function OnlyChoice(TestKind: TListKind): integer; 46 // -2=empty, -1=ambiguous, other=only choice 48 47 procedure OffscreenPaint; override; 49 48 procedure ShowNewContent(NewMode: integer; ListKind: TListKind); … … 57 56 private 58 57 Kind: TListKind; 59 LineDistance, MaxLines,cixProject,pView,Sel,DispLines,Layer,nColumn,60 TechNameSpace, ScienceNation: integer;61 sb: TPVScrollbar;62 Lines, FirstShrinkedLine: array [0..MaxLayer-1] of integer;63 code: array [0..MaxLayer-1,0..4095] of integer;64 Column: array [0..nPl-1] of integer;65 Closable, MultiPage: boolean;58 LineDistance, MaxLines, cixProject, pView, Sel, DispLines, Layer, nColumn, 59 TechNameSpace, ScienceNation: integer; 60 sb: TPVScrollbar; 61 Lines, FirstShrinkedLine: array [0 .. MaxLayer - 1] of integer; 62 code: array [0 .. MaxLayer - 1, 0 .. 4095] of integer; 63 Column: array [0 .. nPl - 1] of integer; 64 Closable, MultiPage: boolean; 66 65 ScienceNationDot: TBitmap; 67 66 procedure InitLines; … … 69 68 function RenameCity(cix: integer): boolean; 70 69 function RenameModel(mix: integer): boolean; 71 procedure OnScroll(var m: TMessage); message WM_VSCROLL;72 procedure OnMouseWheel(var m: TMessage); message WM_MOUSEWHEEL;73 procedure OnMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;74 end; 75 76 TModalSelectDlg =TListDlg;70 procedure OnScroll(var m: TMessage); message WM_VSCROLL; 71 procedure OnMouseWheel(var m: TMessage); message WM_MOUSEWHEEL; 72 procedure OnMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE; 73 end; 74 75 TModalSelectDlg = TListDlg; 77 76 78 77 const 79 cpType=$10000;80 mixAll=$10000;81 adAll=$10000;78 cpType = $10000; 79 mixAll = $10000; 80 adAll = $10000; 82 81 83 82 var … … 88 87 89 88 uses 90 CityScreen, Help, UnitStat, Tribes, Inp;89 CityScreen, Help, UnitStat, Tribes, Inp; 91 90 92 91 {$R *.DFM} 93 92 94 93 const 95 CityNameSpace=127;96 97 MustChooseKind=[kTribe,kStealTech,kGov];98 99 100 procedure TListDlg.FormCreate(Sender:TObject); 101 begin 102 inherited;103 Canvas.Font.Assign(UniFont[ftNormal]);104 CreatePVSB(sb,Handle,2,361,2+422);105 InitButtons();106 Kind:=kMission;107 Layer0Btn.Hint:=Phrases.Lookup('BTN_IMPRS');108 Layer1Btn.Hint:=Phrases.Lookup('BTN_WONDERS');109 Layer2Btn.Hint:=Phrases.Lookup('BTN_CLASSES');110 ScienceNationDot:=TBitmap.Create;111 ScienceNationDot.PixelFormat:=pf24bit;112 ScienceNationDot.Width:=17; ScienceNationDot.Height:=17;94 CityNameSpace = 127; 95 96 MustChooseKind = [kTribe, kStealTech, kGov]; 97 98 procedure TListDlg.FormCreate(Sender: TObject); 99 begin 100 inherited; 101 Canvas.Font.Assign(UniFont[ftNormal]); 102 CreatePVSB(sb, Handle, 2, 361, 2 + 422); 103 InitButtons(); 104 Kind := kMission; 105 Layer0Btn.Hint := Phrases.Lookup('BTN_IMPRS'); 106 Layer1Btn.Hint := Phrases.Lookup('BTN_WONDERS'); 107 Layer2Btn.Hint := Phrases.Lookup('BTN_CLASSES'); 108 ScienceNationDot := TBitmap.Create; 109 ScienceNationDot.PixelFormat := pf24bit; 110 ScienceNationDot.Width := 17; 111 ScienceNationDot.Height := 17; 113 112 end; 114 113 115 114 procedure TListDlg.FormDestroy(Sender: TObject); 116 115 begin 117 ScienceNationDot.Free; 118 end; 119 120 procedure TListDlg.CloseBtnClick(Sender:TObject); 121 begin 122 Closable:=true; Close 123 end; 124 125 procedure TListDlg.FormCloseQuery(Sender: TObject; 126 var CanClose: boolean); 127 begin 128 CanClose:=Closable or not(Kind in MustChooseKind) 129 end; 130 131 procedure TListDlg.OnScroll(var m:TMessage); 132 begin 133 if ProcessPVSB(sb,m) then 134 begin Sel:=-2; SmartUpdateContent(true) end 135 end; 136 137 procedure TListDlg.OnMouseWheel(var m:TMessage); 138 begin 139 if ProcessMouseWheel(sb,m) then 140 begin 141 Sel:=-2; 142 SmartUpdateContent(true); 143 PaintBox1MouseMove(nil, [], m.lParam and $FFFF-Left, m.lParam shr 16-Top); 116 ScienceNationDot.Free; 117 end; 118 119 procedure TListDlg.CloseBtnClick(Sender: TObject); 120 begin 121 Closable := true; 122 Close 123 end; 124 125 procedure TListDlg.FormCloseQuery(Sender: TObject; var CanClose: boolean); 126 begin 127 CanClose := Closable or not(Kind in MustChooseKind) 128 end; 129 130 procedure TListDlg.OnScroll(var m: TMessage); 131 begin 132 if ProcessPVSB(sb, m) then 133 begin 134 Sel := -2; 135 SmartUpdateContent(true) 144 136 end 145 137 end; 146 138 147 procedure TListDlg.OnMouseLeave(var Msg:TMessage); 148 begin 149 if not Closable and (Sel<>-2) then 150 begin 151 line(Canvas,Sel,false,false); 152 Sel:=-2; 139 procedure TListDlg.OnMouseWheel(var m: TMessage); 140 begin 141 if ProcessMouseWheel(sb, m) then 142 begin 143 Sel := -2; 144 SmartUpdateContent(true); 145 PaintBox1MouseMove(nil, [], m.lParam and $FFFF - Left, 146 m.lParam shr 16 - Top); 153 147 end 154 148 end; 155 149 156 procedure TListDlg.FormPaint(Sender:TObject); 150 procedure TListDlg.OnMouseLeave(var Msg: TMessage); 151 begin 152 if not Closable and (Sel <> -2) then 153 begin 154 line(Canvas, Sel, false, false); 155 Sel := -2; 156 end 157 end; 158 159 procedure TListDlg.FormPaint(Sender: TObject); 157 160 var 158 s: string; 159 begin 160 inherited; 161 Canvas.Font.Assign(UniFont[ftNormal]); 162 if Sel<>-2 then line(Canvas,Sel,false,true); 163 s:=''; 164 if (Kind=kAdvance) and (MyData.FarTech<>adNone) then 165 s:=Format(Phrases.Lookup('TECHFOCUS'), 166 [Phrases.Lookup('ADVANCES',MyData.FarTech)]) 167 else if Kind=kModels then s:=Tribe[me].TPhrase('SHORTNAME') 168 else if Kind=kEModels then 169 s:=Tribe[pView].TPhrase('SHORTNAME') 170 +' ('+TurnToString(MyRO.EnemyReport[pView].TurnOfMilReport)+')'; 171 if s<>'' then 172 LoweredTextOut(Canvas, -1, MainTexture, 173 (ClientWidth-BiColorTextWidth(Canvas,s)) div 2, 31, s); 174 if not MultiPage and (Kind in [kProject,kAdvance,kFarAdvance]) 175 and not Phrases2FallenBackToEnglish then 176 begin 177 s:=Phrases2.Lookup('SHIFTCLICK'); 178 LoweredTextOut(Canvas, -2, MainTexture, 179 (ClientWidth-BiColorTextWidth(Canvas,s)) div 2, ClientHeight-29, s); 161 s: string; 162 begin 163 inherited; 164 Canvas.Font.Assign(UniFont[ftNormal]); 165 if Sel <> -2 then 166 line(Canvas, Sel, false, true); 167 s := ''; 168 if (Kind = kAdvance) and (MyData.FarTech <> adNone) then 169 s := Format(Phrases.Lookup('TECHFOCUS'), 170 [Phrases.Lookup('ADVANCES', MyData.FarTech)]) 171 else if Kind = kModels then 172 s := Tribe[me].TPhrase('SHORTNAME') 173 else if Kind = kEModels then 174 s := Tribe[pView].TPhrase('SHORTNAME') + ' (' + 175 TurnToString(MyRO.EnemyReport[pView].TurnOfMilReport) + ')'; 176 if s <> '' then 177 LoweredTextOut(Canvas, -1, MainTexture, 178 (ClientWidth - BiColorTextWidth(Canvas, s)) div 2, 31, s); 179 if not MultiPage and (Kind in [kProject, kAdvance, kFarAdvance]) and not Phrases2FallenBackToEnglish 180 then 181 begin 182 s := Phrases2.Lookup('SHIFTCLICK'); 183 LoweredTextOut(Canvas, -2, MainTexture, 184 (ClientWidth - BiColorTextWidth(Canvas, s)) div 2, ClientHeight - 29, s); 180 185 end 181 186 end; … … 184 189 // paint a line 185 190 186 procedure DisplayProject(x,y,pix: integer); 187 begin 188 if pix and (cpType or cpImp)=0 then 189 with Tribe[me].ModelPicture[pix and cpIndex] do 190 Sprite(offscreen,HGr,x,y,64,48,pix mod 10*65+1, pix div 10 *49+1) 191 else 191 procedure DisplayProject(x, y, pix: integer); 192 begin 193 if pix and (cpType or cpImp) = 0 then 194 with Tribe[me].ModelPicture[pix and cpIndex] do 195 Sprite(offscreen, HGr, x, y, 64, 48, pix mod 10 * 65 + 1, 196 pix div 10 * 49 + 1) 197 else 192 198 begin 193 Frame(offscreen.Canvas,x+(16-1),y+(16-2),x+(16+xSizeSmall), 194 y+(16-1+ySizeSmall),MainTexture.clBevelLight,MainTexture.clBevelShade); 195 if pix and cpType=0 then 196 if (pix and cpIndex=imPalace) and (MyRO.Government<>gAnarchy) then 197 BitBlt(offscreen.Canvas.Handle,x+16,y+(16-1),xSizeSmall,ySizeSmall, 198 SmallImp.Canvas.Handle,(MyRO.Government-1)*xSizeSmall, 199 ySizeSmall,SRCCOPY) 200 else BitBlt(offscreen.Canvas.Handle,x+16,y+(16-1),xSizeSmall,ySizeSmall, 201 SmallImp.Canvas.Handle,pix and cpIndex mod 7*xSizeSmall, 202 (pix and cpIndex+SystemIconLines*7) div 7*ySizeSmall,SRCCOPY) 203 else BitBlt(offscreen.Canvas.Handle,x+16,y+(16-1),xSizeSmall,ySizeSmall, 204 SmallImp.Canvas.Handle,(3+pix and cpIndex)*xSizeSmall, 0,SRCCOPY) 199 Frame(offscreen.Canvas, x + (16 - 1), y + (16 - 2), x + (16 + xSizeSmall), 200 y + (16 - 1 + ySizeSmall), MainTexture.clBevelLight, 201 MainTexture.clBevelShade); 202 if pix and cpType = 0 then 203 if (pix and cpIndex = imPalace) and (MyRO.Government <> gAnarchy) then 204 BitBlt(offscreen.Canvas.Handle, x + 16, y + (16 - 1), xSizeSmall, 205 ySizeSmall, SmallImp.Canvas.Handle, (MyRO.Government - 1) * 206 xSizeSmall, ySizeSmall, SRCCOPY) 207 else 208 BitBlt(offscreen.Canvas.Handle, x + 16, y + (16 - 1), xSizeSmall, 209 ySizeSmall, SmallImp.Canvas.Handle, pix and cpIndex mod 7 * 210 xSizeSmall, (pix and cpIndex + SystemIconLines * 7) div 7 * 211 ySizeSmall, SRCCOPY) 212 else 213 BitBlt(offscreen.Canvas.Handle, x + 16, y + (16 - 1), xSizeSmall, 214 ySizeSmall, SmallImp.Canvas.Handle, (3 + pix and cpIndex) * 215 xSizeSmall, 0, SRCCOPY) 205 216 end; 206 217 end; 207 218 208 procedure ReplaceText(x, y,Color: integer; s: string);219 procedure ReplaceText(x, y, Color: integer; s: string); 209 220 var 210 TextSize: TSize;211 begin 212 if ca=Canvas then221 TextSize: TSize; 222 begin 223 if ca = Canvas then 213 224 begin 214 TextSize.cx:=BiColorTextWidth(ca,s);215 TextSize.cy:=ca.TextHeight(s);216 if y+TextSize.cy>=TitleHeight+InnerHeight then217 TextSize.cy:=TitleHeight+InnerHeight-y;218 Fill(ca,x,y,TextSize.cx,TextSize.cy,(wMaintexture-ClientWidth) div 2,219 (hMaintexture-ClientHeight) div 2);225 TextSize.cx := BiColorTextWidth(ca, s); 226 TextSize.cy := ca.TextHeight(s); 227 if y + TextSize.cy >= TitleHeight + InnerHeight then 228 TextSize.cy := TitleHeight + InnerHeight - y; 229 Fill(ca, x, y, TextSize.cx, TextSize.cy, (wMaintexture - ClientWidth) 230 div 2, (hMaintexture - ClientHeight) div 2); 220 231 end; 221 LoweredTextOut(ca,Color,MainTexture,x,y,s);232 LoweredTextOut(ca, Color, MainTexture, x, y, s); 222 233 end; 223 234 224 235 var 225 icon,ofs,x,y,y0,lix,i,j,TextColor,Available,first,test,FutureCount, 226 growth,TrueFood,TrueProd:integer; 227 CityReport: TCityReportNew; 228 mox: ^TModelInfo; 229 s,number: string; 230 CanGrow: boolean; 231 begin 232 lix:=code[Layer,sb.si.npos+l]; 233 y0:=2+(l+1)*LineDistance; 234 if sb.si.npos+l>=FirstShrinkedLine[Layer] then 235 ofs:=(sb.si.npos+l-FirstShrinkedLine[Layer]) and 1 *33 236 else {if FirstShrinkedLine[Layer]<Lines[Layer] then} ofs:=33; 237 238 if Kind in [kCities,kCityEvents] then with MyCity[lix] do 239 begin 240 x:=104-76; y:=y0; 241 if ca=Canvas then 242 begin x:=x+SideFrame; y:=y+TitleHeight end; 243 if lit then TextColor:=MainTexture.clLitText else TextColor:=-1; 244 s:=CityName(ID); 245 while BiColorTextWidth(ca,s)>CityNameSpace do 246 delete(s,length(s),1); 247 ReplaceText(x+15,y,TextColor,s); 248 249 if NonText then with offscreen.canvas do 250 begin // city size 251 brush.color:=$000000; 252 fillrect(rect(x-4-11,y+1,x-4+13,y+21)); 253 brush.color:=$FFFFFF; 254 fillrect(rect(x-4-12,y,x-4+12,y+20)); 255 brush.style:=bsClear; 256 font.color:=$000000; 257 s:=inttostr(MyCity[lix].Size); 258 TextOut(x-4-textwidth(s) div 2, y, s); 259 end; 260 261 if Kind=kCityEvents then 236 icon, ofs, x, y, y0, lix, i, j, TextColor, Available, first, test, 237 FutureCount, growth, TrueFood, TrueProd: integer; 238 CityReport: TCityReportNew; 239 mox: ^TModelInfo; 240 s, number: string; 241 CanGrow: boolean; 242 begin 243 lix := code[Layer, sb.si.npos + l]; 244 y0 := 2 + (l + 1) * LineDistance; 245 if sb.si.npos + l >= FirstShrinkedLine[Layer] then 246 ofs := (sb.si.npos + l - FirstShrinkedLine[Layer]) and 1 * 33 247 else { if FirstShrinkedLine[Layer]<Lines[Layer] then } 248 ofs := 33; 249 250 if Kind in [kCities, kCityEvents] then 251 with MyCity[lix] do 262 252 begin 263 first:=-1;264 for j:=0 to nCityEventPriority-1 do265 if (Flags and CityRepMask and CityEventPriority[j]<>0)then266 begin first:=j; Break end;267 if first>=0 then268 begin269 i:=0;270 test:=1;271 while test<CityEventPriority[first] do272 begin inc(i); inc(test,test) end;273 s:=CityEventName(i);274 { if CityEventPriority[first]=chNoGrowthWarning then 275 if Built[imAqueduct]=0 then276 s:=Format(s,[Phrases.Lookup('IMPROVEMENTS',imAqueduct)])277 else begin s:=Format(s,[Phrases.Lookup('IMPROVEMENTS',imSewer)]); i:=17 end;}278 ReplaceText(x+(CityNameSpace+4+40+18+8),y,TextColor,s); 253 x := 104 - 76; 254 y := y0; 255 if ca = Canvas then 256 begin 257 x := x + SideFrame; 258 y := y + TitleHeight 259 end; 260 if lit then 261 TextColor := MainTexture.clLitText 262 else 263 TextColor := -1; 264 s := CityName(ID); 265 while BiColorTextWidth(ca, s) > CityNameSpace do 266 delete(s, length(s), 1); 267 ReplaceText(x + 15, y, TextColor, s); 268 279 269 if NonText then 280 begin 281 Sprite(offscreen,HGrSystem,105-76+CityNameSpace+4+40,y0+1,18,18, 282 1+i mod 3 *19,1+i div 3 *19); 283 x:=InnerWidth-26; 284 for j:=nCityEventPriority-1 downto first+1 do 285 if (Flags and CityRepMask and CityEventPriority[j]<>0) then 286 begin 287 i:=0; 288 test:=1; 289 while test<CityEventPriority[j] do 290 begin inc(i); inc(test,test) end; 291 if (CityEventPriority[j]=chNoGrowthWarning) 292 and (Built[imAqueduct]>0) then 293 i:=17; 294 Sprite(offscreen,HGrSystem,x,y0+1,18,18,1+i mod 3 *19, 295 1+i div 3 *19); 296 dec(x,20) 297 end 270 with offscreen.Canvas do 271 begin // city size 272 brush.Color := $000000; 273 fillrect(rect(x - 4 - 11, y + 1, x - 4 + 13, y + 21)); 274 brush.Color := $FFFFFF; 275 fillrect(rect(x - 4 - 12, y, x - 4 + 12, y + 20)); 276 brush.style := bsClear; 277 Font.Color := $000000; 278 s := inttostr(MyCity[lix].Size); 279 TextOut(x - 4 - textwidth(s) div 2, y, s); 280 end; 281 282 if Kind = kCityEvents then 283 begin 284 first := -1; 285 for j := 0 to nCityEventPriority - 1 do 286 if (Flags and CityRepMask and CityEventPriority[j] <> 0) then 287 begin 288 first := j; 289 Break 290 end; 291 if first >= 0 then 292 begin 293 i := 0; 294 test := 1; 295 while test < CityEventPriority[first] do 296 begin 297 inc(i); 298 inc(test, test) 299 end; 300 s := CityEventName(i); 301 { if CityEventPriority[first]=chNoGrowthWarning then 302 if Built[imAqueduct]=0 then 303 s:=Format(s,[Phrases.Lookup('IMPROVEMENTS',imAqueduct)]) 304 else begin s:=Format(s,[Phrases.Lookup('IMPROVEMENTS',imSewer)]); i:=17 end; } 305 ReplaceText(x + (CityNameSpace + 4 + 40 + 18 + 8), y, TextColor, s); 306 if NonText then 307 begin 308 Sprite(offscreen, HGrSystem, 105 - 76 + CityNameSpace + 4 + 40, 309 y0 + 1, 18, 18, 1 + i mod 3 * 19, 1 + i div 3 * 19); 310 x := InnerWidth - 26; 311 for j := nCityEventPriority - 1 downto first + 1 do 312 if (Flags and CityRepMask and CityEventPriority[j] <> 0) then 313 begin 314 i := 0; 315 test := 1; 316 while test < CityEventPriority[j] do 317 begin 318 inc(i); 319 inc(test, test) 320 end; 321 if (CityEventPriority[j] = chNoGrowthWarning) and 322 (Built[imAqueduct] > 0) then 323 i := 17; 324 Sprite(offscreen, HGrSystem, x, y0 + 1, 18, 18, 325 1 + i mod 3 * 19, 1 + i div 3 * 19); 326 dec(x, 20) 327 end 328 end 298 329 end 299 330 end 331 else 332 begin 333 CityReport.HypoTiles := -1; 334 CityReport.HypoTaxRate := -1; 335 CityReport.HypoLuxuryRate := -1; 336 Server(sGetCityReportNew, me, lix, CityReport); 337 TrueFood := Food; 338 TrueProd := Prod; 339 if supervising then 340 begin // normalize city from after-turn state 341 dec(TrueFood, CityReport.FoodSurplus); 342 if TrueFood < 0 then 343 TrueFood := 0; // shouldn't happen 344 dec(TrueProd, CityReport.Production); 345 if TrueProd < 0 then 346 TrueProd := 0; // shouldn't happen 347 end; 348 349 s := ''; // disorder info 350 if Flags and chCaptured <> 0 then 351 s := Phrases.Lookup('CITYEVENTS', 14) 352 else if CityReport.HappinessBalance < 0 then 353 s := Phrases.Lookup('CITYEVENTS', 0); 354 if s <> '' then 355 begin { disorder } 356 if NonText then 357 begin 358 DarkGradient(offscreen.Canvas, 99 + 31 + CityNameSpace + 4, 359 y0 + 2, 131, 3); 360 ca.Font.Assign(UniFont[ftSmall]); 361 RisedTextout(offscreen.Canvas, 103 + CityNameSpace + 4 + 31, 362 y0 + 1, s); 363 ca.Font.Assign(UniFont[ftNormal]); 364 end 365 end 366 else 367 begin 368 { s:=IntToStr(CityReport.FoodSurplus); 369 ReplaceText(x+(CityNameSpace+4+48)-BiColorTextWidth(ca,s),y,TextColor,s); } 370 s := inttostr(CityReport.Science); 371 ReplaceText(x + CityNameSpace + 4 + 370 + 48 - BiColorTextWidth(ca, 372 s), y, TextColor, s); 373 s := inttostr(CityReport.Production); 374 ReplaceText(x + CityNameSpace + 4 + 132 - BiColorTextWidth(ca, s), y, 375 TextColor, s); 376 if NonText then 377 begin 378 // Sprite(offscreen,HGrSystem,x+CityNameSpace+4+333+1,y+6,10,10,66,115); 379 Sprite(offscreen, HGrSystem, x + CityNameSpace + 4 + 370 + 48 + 1, 380 y + 6, 10, 10, 77, 126); 381 Sprite(offscreen, HGrSystem, x + CityNameSpace + 4 + 132 + 1, y + 6, 382 10, 10, 88, 115); 383 end 384 end; 385 s := inttostr(CityTaxBalance(lix, CityReport)); 386 ReplaceText(x + CityNameSpace + 4 + 370 - BiColorTextWidth(ca, s), y, 387 TextColor, s); 388 // if Project and (cpImp+cpIndex)<>cpImp+imTrGoods then 389 // ReplaceText(x+CityNameSpace+4+333+1,y,TextColor,Format('%d/%d',[TrueProd,CityReport.ProjectCost])); 390 if NonText then 391 begin 392 Sprite(offscreen, HGrSystem, x + CityNameSpace + 4 + 370 + 1, y + 6, 393 10, 10, 132, 115); 394 395 // food progress 396 CanGrow := (Size < MaxCitySize) and (MyRO.Government <> gFuture) and 397 (CityReport.FoodSurplus > 0) and 398 ((Size < NeedAqueductSize) or (Built[imAqueduct] = 1) and 399 (Size < NeedSewerSize) or (Built[imSewer] = 1)); 400 PaintRelativeProgressBar(offscreen.Canvas, 1, x + 15 + CityNameSpace + 401 4, y + 7, 68, TrueFood, CutCityFoodSurplus(CityReport.FoodSurplus, 402 (MyRO.Government <> gAnarchy) and (Flags and chCaptured = 0), 403 MyRO.Government, Size), CityReport.Storage, CanGrow, MainTexture); 404 405 if Project <> cpImp + imTrGoods then 406 begin 407 DisplayProject(ofs + 104 - 76 + x - 28 + CityNameSpace + 4 + 206 - 408 60, y0 - 15, Project); 409 410 // production progress 411 growth := CityReport.Production; 412 if (growth < 0) or (MyRO.Government = gAnarchy) or 413 (Flags and chCaptured <> 0) then 414 growth := 0; 415 PaintRelativeProgressBar(offscreen.Canvas, 4, 416 x + CityNameSpace + 4 + 304 - 60 + 9, y + 7, 68, TrueProd, growth, 417 CityReport.ProjectCost, true, MainTexture); 418 end; 419 end 420 end; 300 421 end 422 else if Kind in [kModels, kEModels] then 423 begin 424 x := 104; 425 y := y0; 426 if ca = Canvas then 427 begin 428 x := x + SideFrame; 429 y := y + TitleHeight 430 end; 431 if lit then 432 TextColor := MainTexture.clLitText 433 else 434 TextColor := -1; 435 if Kind = kModels then 436 begin 437 Available := 0; 438 for j := 0 to MyRO.nUn - 1 do 439 if (MyUn[j].Loc >= 0) and (MyUn[j].mix = lix) then 440 inc(Available); 441 if MainScreen.mNames.Checked then 442 s := Tribe[me].ModelName[lix] 443 else 444 s := Format(Tribe[me].TPhrase('GENMODEL'), [lix]); 445 if NonText then 446 DisplayProject(8 + ofs, y0 - 15, lix); 447 end 448 else 449 begin 450 Available := MyRO.EnemyReport[pView].UnCount[lix]; 451 if MainScreen.mNames.Checked then 452 s := Tribe[pView].ModelName[lix] 453 else 454 s := Format(Tribe[pView].TPhrase('GENMODEL'), [lix]); 455 if NonText then 456 with Tribe[pView].ModelPicture[lix] do 457 Sprite(offscreen, HGr, 8 + ofs, y0 - 15, 64, 48, pix mod 10 * 65 + 1, 458 pix div 10 * 49 + 1); 459 end; 460 if Available > 0 then 461 ReplaceText(x + 32 - BiColorTextWidth(ca, inttostr(Available)), y, 462 TextColor, inttostr(Available)); 463 ReplaceText(x + 40, y, TextColor, s); 464 end 301 465 else 302 begin 303 CityReport.HypoTiles:=-1; 304 CityReport.HypoTaxRate:=-1; 305 CityReport.HypoLuxuryRate:=-1; 306 Server(sGetCityReportNew,me,lix,CityReport); 307 TrueFood:=Food; 308 TrueProd:=Prod; 309 if supervising then 310 begin // normalize city from after-turn state 311 dec(TrueFood,CityReport.FoodSurplus); 312 if TrueFood<0 then 313 TrueFood:=0; // shouldn't happen 314 dec(TrueProd,CityReport.Production); 315 if TrueProd<0 then 316 TrueProd:=0; // shouldn't happen 317 end; 318 319 s:=''; // disorder info 320 if Flags and chCaptured<>0 then 321 s:=Phrases.Lookup('CITYEVENTS',14) 322 else if CityReport.HappinessBalance<0 then 323 s:=Phrases.Lookup('CITYEVENTS',0); 324 if s<>'' then 325 begin {disorder} 326 if NonText then 327 begin 328 DarkGradient(offscreen.Canvas,99+31+CityNameSpace+4,y0+2,131,3); 329 ca.Font.Assign(UniFont[ftSmall]); 330 RisedTextout(offscreen.canvas,103+CityNameSpace+4+31,y0+1,s); 331 ca.Font.Assign(UniFont[ftNormal]); 332 end 333 end 334 else 335 begin 336 { s:=IntToStr(CityReport.FoodSurplus); 337 ReplaceText(x+(CityNameSpace+4+48)-BiColorTextWidth(ca,s),y,TextColor,s);} 338 s:=IntToStr(CityReport.Science); 339 ReplaceText(x+CityNameSpace+4+370+48-BiColorTextWidth(ca,s),y,TextColor,s); 340 s:=IntToStr(CityReport.Production); 341 ReplaceText(x+CityNameSpace+4+132-BiColorTextWidth(ca,s),y,TextColor,s); 342 if NonText then 343 begin 344 //Sprite(offscreen,HGrSystem,x+CityNameSpace+4+333+1,y+6,10,10,66,115); 345 Sprite(offscreen,HGrSystem,x+CityNameSpace+4+370+48+1,y+6,10,10,77,126); 346 Sprite(offscreen,HGrSystem,x+CityNameSpace+4+132+1,y+6,10,10,88,115); 347 end 348 end; 349 s:=IntToStr(CityTaxBalance(lix, CityReport)); 350 ReplaceText(x+CityNameSpace+4+370-BiColorTextWidth(ca,s),y,TextColor,s); 351 //if Project and (cpImp+cpIndex)<>cpImp+imTrGoods then 352 // ReplaceText(x+CityNameSpace+4+333+1,y,TextColor,Format('%d/%d',[TrueProd,CityReport.ProjectCost])); 353 if NonText then 354 begin 355 Sprite(offscreen,HGrSystem,x+CityNameSpace+4+370+1,y+6,10,10,132,115); 356 357 // food progress 358 CanGrow:=(Size<MaxCitySize) and (MyRO.Government<>gFuture) 359 and (CityReport.FoodSurplus>0) 360 and ((Size<NeedAqueductSize) 361 or (Built[imAqueduct]=1) and (Size<NeedSewerSize) 362 or (Built[imSewer]=1)); 363 PaintRelativeProgressBar(offscreen.canvas,1,x+15+CityNameSpace+4,y+7,68,TrueFood, 364 CutCityFoodSurplus(CityReport.FoodSurplus, 365 (MyRO.Government<>gAnarchy) and (Flags and chCaptured=0), 366 MyRO.Government,Size),CityReport.Storage,CanGrow,MainTexture); 367 368 if Project<>cpImp+imTrGoods then 369 begin 370 DisplayProject(ofs+104-76+x-28+CityNameSpace+4+206-60,y0-15,Project); 371 372 // production progress 373 growth:=CityReport.Production; 374 if (growth<0) or (MyRO.Government=gAnarchy) 375 or (Flags and chCaptured<>0) then 376 growth:=0; 377 PaintRelativeProgressBar(offscreen.canvas,4,x+CityNameSpace+4+304-60+9,y+7,68, 378 TrueProd,growth,CityReport.ProjectCost,true,MainTexture); 379 end; 380 end 381 end; 382 end 383 else if Kind in [kModels,kEModels] then 384 begin 385 x:=104; y:=y0; 386 if ca=Canvas then 387 begin x:=x+SideFrame; y:=y+TitleHeight end; 388 if lit then TextColor:=MainTexture.clLitText else TextColor:=-1; 389 if Kind=kModels then 390 begin 391 Available:=0; 392 for j:=0 to MyRO.nUn-1 do 393 if (MyUn[j].Loc>=0) and (MyUn[j].mix=lix) then inc(Available); 394 if MainScreen.mNames.Checked then 395 s:=Tribe[me].ModelName[lix] 396 else s:=Format(Tribe[me].TPhrase('GENMODEL'),[lix]); 397 if NonText then DisplayProject(8+ofs,y0-15,lix); 398 end 399 else 400 begin 401 Available:=MyRO.EnemyReport[pView].UnCount[lix]; 402 if MainScreen.mNames.Checked then 403 s:=Tribe[pView].ModelName[lix] 404 else s:=Format(Tribe[pView].TPhrase('GENMODEL'),[lix]); 405 if NonText then 406 with Tribe[pView].ModelPicture[lix] do 407 Sprite(offscreen,HGr,8+ofs,y0-15,64,48,pix mod 10*65+1, pix div 10 *49+1); 408 end; 409 if Available>0 then 410 ReplaceText(x+32-BiColorTextWidth(ca,IntToStr(Available)),y,TextColor, 411 IntToStr(Available)); 412 ReplaceText(x+40,y,TextColor,s); 413 end 414 else 415 begin 416 case Kind of 417 kAllEModels, kChooseEModel: 418 if lix=mixAll then s:=Phrases.Lookup('PRICECAT_ALLMODEL') 419 else 420 begin 421 mox:=@MyRO.EnemyModel[lix]; 422 if MainScreen.mNames.Checked then 423 begin 424 s:=Tribe[mox.Owner].ModelName[mox.mix]; 425 if (Kind=kAllEModels) and (code[1,sb.si.npos+l]=0) then 426 s:=Format(Tribe[mox.Owner].TPhrase('OWNED'), [s]); 466 begin 467 case Kind of 468 kAllEModels, kChooseEModel: 469 if lix = mixAll then 470 s := Phrases.Lookup('PRICECAT_ALLMODEL') 471 else 472 begin 473 mox := @MyRO.EnemyModel[lix]; 474 if MainScreen.mNames.Checked then 475 begin 476 s := Tribe[mox.Owner].ModelName[mox.mix]; 477 if (Kind = kAllEModels) and (code[1, sb.si.npos + l] = 0) then 478 s := Format(Tribe[mox.Owner].TPhrase('OWNED'), [s]); 427 479 end 428 else s:=Format(Tribe[mox.Owner].TPhrase('GENMODEL'),[mox.mix]); 429 if NonText then 430 with Tribe[mox.Owner].ModelPicture[mox.mix] do 431 Sprite(offscreen,HGr,8+ofs,y0-15,64,48,pix mod 10*65+1, pix div 10 *49+1); 432 end; 433 kChooseModel: 434 if lix=mixAll then s:=Phrases.Lookup('PRICECAT_ALLMODEL') 435 else 436 begin 437 s:=Tribe[me].ModelName[lix]; 438 if NonText then DisplayProject(8+ofs,y0-15,lix); 439 end; 440 kProject: 441 begin 442 if lix and cpType<>0 then s:=Phrases.Lookup('CITYTYPE',lix and cpIndex) 443 else if lix and cpImp=0 then with MyModel[lix and cpIndex] do 444 begin 445 s:=Tribe[me].ModelName[lix and cpIndex]; 446 if lix and cpConscripts<>0 then 447 s:=Format(Phrases.Lookup('CONSCRIPTS'),[s]); 448 end 449 else 450 begin 451 s:=Phrases.Lookup('IMPROVEMENTS',lix and cpIndex); 452 if (Imp[lix and cpIndex].Kind in [ikNatLocal,ikNatGlobal]) 453 and (MyRO.NatBuilt[lix and cpIndex]>0) 454 or (lix and cpIndex in [imPower,imHydro,imNuclear]) 455 and (MyCity[cixProject].Built[imPower] 456 +MyCity[cixProject].Built[imHydro] 457 +MyCity[cixProject].Built[imNuclear]>0) then 458 s:=Format(Phrases.Lookup('NATEXISTS'),[s]); 459 end; 460 if NonText then DisplayProject(8+ofs,y0-15,lix); 461 end; 462 kAdvance, kFarAdvance, kScience, kChooseTech, kChooseETech, kStealTech: 463 begin 464 if lix=adAll then s:=Phrases.Lookup('PRICECAT_ALLTECH') 465 else 466 begin 467 if lix=adNexus then s:=Phrases.Lookup('NEXUS') 468 else if lix=adNone then s:=Phrases.Lookup('NOFARTECH') 469 else if lix=adMilitary then s:=Phrases.Lookup('INITUNIT') 480 else 481 s := Format(Tribe[mox.Owner].TPhrase('GENMODEL'), [mox.mix]); 482 if NonText then 483 with Tribe[mox.Owner].ModelPicture[mox.mix] do 484 Sprite(offscreen, HGr, 8 + ofs, y0 - 15, 64, 48, 485 pix mod 10 * 65 + 1, pix div 10 * 49 + 1); 486 end; 487 kChooseModel: 488 if lix = mixAll then 489 s := Phrases.Lookup('PRICECAT_ALLMODEL') 470 490 else 471 begin 472 s:=Phrases.Lookup('ADVANCES',lix); 473 if (Kind=kAdvance) and (lix in FutureTech) then 474 if MyRO.Tech[lix]<tsApplicable then s:=s+' 1' 475 else s:=s+' '+IntToStr(MyRO.Tech[lix]+1); 476 end; 477 if BiColorTextWidth(ca,s)>TechNameSpace+8 then 478 begin 479 repeat 480 delete(s,length(s),1); 481 until BiColorTextWidth(ca,s)<=TechNameSpace+5; 482 s:=s+'.'; 483 end; 484 485 if NonText then 486 begin // show tech icon 487 if lix=adNexus then 491 begin 492 s := Tribe[me].ModelName[lix]; 493 if NonText then 494 DisplayProject(8 + ofs, y0 - 15, lix); 495 end; 496 kProject: 497 begin 498 if lix and cpType <> 0 then 499 s := Phrases.Lookup('CITYTYPE', lix and cpIndex) 500 else if lix and cpImp = 0 then 501 with MyModel[lix and cpIndex] do 488 502 begin 489 Frame(offscreen.Canvas,(8+16-1),y0-1,(8+16+36), 490 y0+20,MainTexture.clBevelLight,MainTexture.clBevelShade); 491 Dump(offscreen,HGrSystem,(8+16),y0,36,20,223,295) 492 end 493 else if lix=adNone then 494 begin 495 Frame(offscreen.Canvas,(8+16-1),y0-1,(8+16+36), 496 y0+20,MainTexture.clBevelLight,MainTexture.clBevelShade); 497 Dump(offscreen,HGrSystem,(8+16),y0,36,20,260,295) 498 end 499 else if lix=adMilitary then 500 begin 501 Frame(offscreen.Canvas,(8+16-1),y0-1,(8+16+36), 502 y0+20,MainTexture.clBevelLight,MainTexture.clBevelShade); 503 Dump(offscreen,HGrSystem,(8+16),y0,36,20,38,295) 503 s := Tribe[me].ModelName[lix and cpIndex]; 504 if lix and cpConscripts <> 0 then 505 s := Format(Phrases.Lookup('CONSCRIPTS'), [s]); 504 506 end 505 507 else 508 begin 509 s := Phrases.Lookup('IMPROVEMENTS', lix and cpIndex); 510 if (Imp[lix and cpIndex].Kind in [ikNatLocal, ikNatGlobal]) and 511 (MyRO.NatBuilt[lix and cpIndex] > 0) or 512 (lix and cpIndex in [imPower, imHydro, imNuclear]) and 513 (MyCity[cixProject].Built[imPower] + MyCity[cixProject].Built 514 [imHydro] + MyCity[cixProject].Built[imNuclear] > 0) then 515 s := Format(Phrases.Lookup('NATEXISTS'), [s]); 516 end; 517 if NonText then 518 DisplayProject(8 + ofs, y0 - 15, lix); 519 end; 520 kAdvance, kFarAdvance, kScience, kChooseTech, kChooseETech, kStealTech: 521 begin 522 if lix = adAll then 523 s := Phrases.Lookup('PRICECAT_ALLTECH') 524 else 525 begin 526 if lix = adNexus then 527 s := Phrases.Lookup('NEXUS') 528 else if lix = adNone then 529 s := Phrases.Lookup('NOFARTECH') 530 else if lix = adMilitary then 531 s := Phrases.Lookup('INITUNIT') 532 else 506 533 begin 507 Frame(offscreen.Canvas,(8+16-1),y0-1,(8+16+xSizeSmall), 508 y0+ySizeSmall,MainTexture.clBevelLight,MainTexture.clBevelShade); 509 if AdvIcon[lix]<84 then 510 BitBlt(offscreen.Canvas.Handle,(8+16),y0,xSizeSmall,ySizeSmall, 511 SmallImp.Canvas.Handle,(AdvIcon[lix]+SystemIconLines*7) mod 7*xSizeSmall, 512 (AdvIcon[lix]+SystemIconLines*7) div 7*ySizeSmall,SRCCOPY) 513 else Dump(offscreen,HGrSystem,(8+16),y0,36,20, 514 1+(AdvIcon[lix]-84) mod 8*37,295+(AdvIcon[lix]-84) div 8*21); 515 j:=AdvValue[lix] div 1000; 516 BitBlt(Handle,(8+16-4),y0+2,14,14, 517 GrExt[HGrSystem].Mask.Canvas.Handle,127+j*15,85,SRCAND); 518 Sprite(offscreen,HGrSystem,(8+16-5),y0+1,14,14, 519 127+j*15,85); 534 s := Phrases.Lookup('ADVANCES', lix); 535 if (Kind = kAdvance) and (lix in FutureTech) then 536 if MyRO.Tech[lix] < tsApplicable then 537 s := s + ' 1' 538 else 539 s := s + ' ' + inttostr(MyRO.Tech[lix] + 1); 520 540 end; 521 end; 522 end; 523 524 if NonText and (Kind in [kAdvance, kScience]) then 525 begin // show research state 526 for j:=0 to nColumn-1 do 527 begin 528 FutureCount:=0; 529 if j=0 then // own science 530 if lix=MyRO.ResearchTech then 541 if BiColorTextWidth(ca, s) > TechNameSpace + 8 then 542 begin 543 repeat 544 delete(s, length(s), 1); 545 until BiColorTextWidth(ca, s) <= TechNameSpace + 5; 546 s := s + '.'; 547 end; 548 549 if NonText then 550 begin // show tech icon 551 if lix = adNexus then 531 552 begin 532 Server(sGetTechCost,me,0,icon);533 icon:=4+MyRO.Research*4 div icon;534 if icon>4+3 then icon:=4+3553 Frame(offscreen.Canvas, (8 + 16 - 1), y0 - 1, (8 + 16 + 36), 554 y0 + 20, MainTexture.clBevelLight, MainTexture.clBevelShade); 555 Dump(offscreen, HGrSystem, (8 + 16), y0, 36, 20, 223, 295) 535 556 end 536 else if (lix>=adMilitary) then 537 icon:=-1 538 else if lix in FutureTech then 557 else if lix = adNone then 539 558 begin 540 icon:=-1; 541 FutureCount:=MyRO.Tech[lix]; 559 Frame(offscreen.Canvas, (8 + 16 - 1), y0 - 1, (8 + 16 + 36), 560 y0 + 20, MainTexture.clBevelLight, MainTexture.clBevelShade); 561 Dump(offscreen, HGrSystem, (8 + 16), y0, 36, 20, 260, 295) 542 562 end 543 else if MyRO.Tech[lix]=tsSeen then icon:=1 544 else if MyRO.Tech[lix]>=tsApplicable then icon:=2 545 else icon:=-1 546 else with MyRO.EnemyReport[Column[j]]^ do // enemy science 547 if (MyRO.Alive and (1 shl Column[j])<>0) 548 and (TurnOfCivilReport>=0) and (lix=ResearchTech) 549 and ((lix=adMilitary) or (lix in FutureTech) 550 or (Tech[lix]<tsApplicable)) then 563 else if lix = adMilitary then 551 564 begin 552 icon:=4+ResearchDone div 25; 553 if icon>4+3 then icon:=4+3 565 Frame(offscreen.Canvas, (8 + 16 - 1), y0 - 1, (8 + 16 + 36), 566 y0 + 20, MainTexture.clBevelLight, MainTexture.clBevelShade); 567 Dump(offscreen, HGrSystem, (8 + 16), y0, 36, 20, 38, 295) 554 568 end 555 else if lix=adMilitary then 556 icon:=-1 557 else if lix in FutureTech then 569 else 558 570 begin 559 icon:=-1; 560 FutureCount:=Tech[lix] 571 Frame(offscreen.Canvas, (8 + 16 - 1), y0 - 1, 572 (8 + 16 + xSizeSmall), y0 + ySizeSmall, 573 MainTexture.clBevelLight, MainTexture.clBevelShade); 574 if AdvIcon[lix] < 84 then 575 BitBlt(offscreen.Canvas.Handle, (8 + 16), y0, xSizeSmall, 576 ySizeSmall, SmallImp.Canvas.Handle, 577 (AdvIcon[lix] + SystemIconLines * 7) mod 7 * xSizeSmall, 578 (AdvIcon[lix] + SystemIconLines * 7) div 7 * 579 ySizeSmall, SRCCOPY) 580 else 581 Dump(offscreen, HGrSystem, (8 + 16), y0, 36, 20, 582 1 + (AdvIcon[lix] - 84) mod 8 * 37, 583 295 + (AdvIcon[lix] - 84) div 8 * 21); 584 j := AdvValue[lix] div 1000; 585 BitBlt(Handle, (8 + 16 - 4), y0 + 2, 14, 14, 586 GrExt[HGrSystem].Mask.Canvas.Handle, 127 + j * 15, 587 85, SRCAND); 588 Sprite(offscreen, HGrSystem, (8 + 16 - 5), y0 + 1, 14, 14, 589 127 + j * 15, 85); 590 end; 591 end; 592 end; 593 594 if NonText and (Kind in [kAdvance, kScience]) then 595 begin // show research state 596 for j := 0 to nColumn - 1 do 597 begin 598 FutureCount := 0; 599 if j = 0 then // own science 600 if lix = MyRO.ResearchTech then 601 begin 602 Server(sGetTechCost, me, 0, icon); 603 icon := 4 + MyRO.Research * 4 div icon; 604 if icon > 4 + 3 then 605 icon := 4 + 3 606 end 607 else if (lix >= adMilitary) then 608 icon := -1 609 else if lix in FutureTech then 610 begin 611 icon := -1; 612 FutureCount := MyRO.Tech[lix]; 613 end 614 else if MyRO.Tech[lix] = tsSeen then 615 icon := 1 616 else if MyRO.Tech[lix] >= tsApplicable then 617 icon := 2 618 else 619 icon := -1 620 else 621 with MyRO.EnemyReport[Column[j]]^ do // enemy science 622 if (MyRO.Alive and (1 shl Column[j]) <> 0) and 623 (TurnOfCivilReport >= 0) and (lix = ResearchTech) and 624 ((lix = adMilitary) or (lix in FutureTech) or 625 (Tech[lix] < tsApplicable)) then 626 begin 627 icon := 4 + ResearchDone div 25; 628 if icon > 4 + 3 then 629 icon := 4 + 3 630 end 631 else if lix = adMilitary then 632 icon := -1 633 else if lix in FutureTech then 634 begin 635 icon := -1; 636 FutureCount := Tech[lix] 637 end 638 else if Tech[lix] >= tsApplicable then 639 icon := 2 640 else if Tech[lix] = tsSeen then 641 icon := 1 642 else 643 icon := -1; 644 if icon >= 0 then 645 Sprite(offscreen, HGrSystem, 104 - 33 + 15 + 3 + TechNameSpace + 646 24 * j, y0 + 3, 14, 14, 67 + icon * 15, 85) 647 else if (Kind = kScience) and (FutureCount > 0) then 648 begin 649 number := inttostr(FutureCount); 650 RisedTextout(ca, 104 - 33 + 15 + 10 + TechNameSpace + 24 * j - 651 BiColorTextWidth(ca, number) div 2, y0, number); 561 652 end 562 else if Tech[lix]>=tsApplicable then563 icon:=2564 else if Tech[lix]=tsSeen then565 icon:=1566 else icon:=-1;567 if icon>=0 then568 Sprite(offscreen,HGrSystem,104-33+15+3+TechNameSpace+24*j,y0+3,569 14,14,67+icon*15,85)570 else if (Kind=kScience) and (FutureCount>0) then571 begin572 number:=inttostr(FutureCount);573 RisedTextOut(ca,104-33+15+10+TechNameSpace+24*j574 -BiColorTextWidth(ca,number) div 2,y0,number);575 653 end 654 end; 655 end; // kAdvance, kScience 656 kTribe: 657 s := TribeNames[lix]; 658 kShipPart: 659 begin 660 s := Phrases.Lookup('IMPROVEMENTS', imShipComp + lix) + ' (' + 661 inttostr(MyRO.Ship[me].Parts[lix]) + ')'; 662 if NonText then 663 DisplayProject(8 + ofs, y0 - 15, cpImp + imShipComp + lix); 664 end; 665 kEShipPart: 666 begin 667 s := Phrases.Lookup('IMPROVEMENTS', imShipComp + lix) + ' (' + 668 inttostr(MyRO.Ship[DipMem[me].pContact].Parts[lix]) + ')'; 669 if NonText then 670 DisplayProject(8 + ofs, y0 - 15, cpImp + imShipComp + lix); 671 end; 672 kGov: 673 begin 674 s := Phrases.Lookup('GOVERNMENT', lix); 675 if NonText then 676 begin 677 Frame(offscreen.Canvas, 8 + 16 - 1, y0 - 15 + (16 - 2), 678 8 + 16 + xSizeSmall, y0 - 15 + (16 - 1 + ySizeSmall), 679 MainTexture.clBevelLight, MainTexture.clBevelShade); 680 BitBlt(offscreen.Canvas.Handle, 8 + 16, y0 - 15 + (16 - 1), 681 xSizeSmall, ySizeSmall, SmallImp.Canvas.Handle, 682 (lix - 1) * xSizeSmall, ySizeSmall, SRCCOPY); 576 683 end 577 684 end; 578 end; // kAdvance, kScience 579 kTribe: 580 s:=TribeNames[lix]; 581 kShipPart: 582 begin 583 s:=Phrases.Lookup('IMPROVEMENTS',imShipComp+lix) 584 +' ('+inttostr(MyRO.Ship[me].Parts[lix])+')'; 585 if NonText then DisplayProject(8+ofs,y0-15,cpImp+imShipComp+lix); 586 end; 587 kEShipPart: 588 begin 589 s:=Phrases.Lookup('IMPROVEMENTS',imShipComp+lix) 590 +' ('+inttostr(MyRO.Ship[DipMem[me].pContact].Parts[lix])+')'; 591 if NonText then DisplayProject(8+ofs,y0-15,cpImp+imShipComp+lix); 592 end; 593 kGov: 594 begin 595 s:=Phrases.Lookup('GOVERNMENT',lix); 596 if NonText then 597 begin 598 Frame(offscreen.Canvas,8+16-1,y0-15+(16-2),8+16+xSizeSmall, 599 y0-15+(16-1+ySizeSmall),MainTexture.clBevelLight,MainTexture.clBevelShade); 600 BitBlt(offscreen.Canvas.Handle,8+16,y0-15+(16-1),xSizeSmall,ySizeSmall, 601 SmallImp.Canvas.Handle,(lix-1)*xSizeSmall,ySizeSmall,SRCCOPY); 602 end 603 end; 604 kMission: 605 s:=Phrases.Lookup('SPYMISSION',lix); 685 kMission: 686 s := Phrases.Lookup('SPYMISSION', lix); 606 687 end; 607 case Kind of 608 kTribe,kMission: // center text 609 if Lines[0]>MaxLines then 610 x:=(InnerWidth-GetSystemMetrics(SM_CXVSCROLL)) div 2-BiColorTextWidth(ca,s) div 2 611 else x:=InnerWidth div 2-BiColorTextWidth(ca,s) div 2; 612 kAdvance, kFarAdvance, kScience, kChooseTech, kChooseETech, kStealTech, kGov: 613 x:=104-33; 614 kAllEModels: x:=104; 615 else x:=104+15; 688 case Kind of 689 kTribe, kMission: // center text 690 if Lines[0] > MaxLines then 691 x := (InnerWidth - GetSystemMetrics(SM_CXVSCROLL)) div 2 - 692 BiColorTextWidth(ca, s) div 2 693 else 694 x := InnerWidth div 2 - BiColorTextWidth(ca, s) div 2; 695 kAdvance, kFarAdvance, kScience, kChooseTech, kChooseETech, 696 kStealTech, kGov: 697 x := 104 - 33; 698 kAllEModels: 699 x := 104; 700 else 701 x := 104 + 15; 616 702 end; 617 y:=y0; 618 if ca=Canvas then 619 begin x:=x+SideFrame; y:=y+TitleHeight end; 620 if lit then TextColor:=MainTexture.clLitText 621 else TextColor:=-1; 622 { if Kind=kTribe then ReplaceText_Tribe(x,y,TextColor, 623 integer(TribeNames.Objects[lix]),s) 624 else} ReplaceText(x,y,TextColor,s); 703 y := y0; 704 if ca = Canvas then 705 begin 706 x := x + SideFrame; 707 y := y + TitleHeight 708 end; 709 if lit then 710 TextColor := MainTexture.clLitText 711 else 712 TextColor := -1; 713 { if Kind=kTribe then ReplaceText_Tribe(x,y,TextColor, 714 integer(TribeNames.Objects[lix]),s) 715 else } ReplaceText(x, y, TextColor, s); 625 716 end 626 717 end; … … 628 719 procedure TListDlg.OffscreenPaint; 629 720 var 630 i,j: integer; 631 begin 632 case Kind of 633 kCities: Caption:=Tribe[me].TPhrase('TITLE_CITIES'); 634 kCityEvents: Caption:=Format(Phrases.Lookup('TITLE_EVENTS'),[TurnToString(MyRO.Turn)]); 635 end; 636 637 inherited; 638 offscreen.Canvas.Font.Assign(UniFont[ftNormal]); 639 FillOffscreen(0,0,InnerWidth,InnerHeight); 640 with offscreen.Canvas do 641 begin 642 if Kind=kScience then 643 for i:=1 to nColumn-1 do 644 begin 645 Pen.Color:=$000000; 646 MoveTo(104-33+15+TechNameSpace+24*i,0); 647 LineTo(104-33+15+TechNameSpace+24*i,InnerHeight); 648 MoveTo(104-33+15+TechNameSpace+9*2+24*i,0); 649 LineTo(104-33+15+TechNameSpace+9*2+24*i,InnerHeight); 650 if MyRO.EnemyReport[Column[i]].TurnOfCivilReport>=MyRO.Turn-1 then 651 begin 652 brush.color:=Tribe[Column[i]].Color; 653 FillRect(Rect(104-33+14+TechNameSpace+24*i+1*2,0, 654 104-33+17+TechNameSpace+24*i+8*2,InnerHeight)); 655 brush.style:=bsClear; 721 i, j: integer; 722 begin 723 case Kind of 724 kCities: 725 Caption := Tribe[me].TPhrase('TITLE_CITIES'); 726 kCityEvents: 727 Caption := Format(Phrases.Lookup('TITLE_EVENTS'), 728 [TurnToString(MyRO.Turn)]); 729 end; 730 731 inherited; 732 offscreen.Canvas.Font.Assign(UniFont[ftNormal]); 733 FillOffscreen(0, 0, InnerWidth, InnerHeight); 734 with offscreen.Canvas do 735 begin 736 if Kind = kScience then 737 for i := 1 to nColumn - 1 do 738 begin 739 Pen.Color := $000000; 740 MoveTo(104 - 33 + 15 + TechNameSpace + 24 * i, 0); 741 LineTo(104 - 33 + 15 + TechNameSpace + 24 * i, InnerHeight); 742 MoveTo(104 - 33 + 15 + TechNameSpace + 9 * 2 + 24 * i, 0); 743 LineTo(104 - 33 + 15 + TechNameSpace + 9 * 2 + 24 * i, InnerHeight); 744 if MyRO.EnemyReport[Column[i]].TurnOfCivilReport >= MyRO.Turn - 1 then 745 begin 746 brush.Color := Tribe[Column[i]].Color; 747 fillrect(rect(104 - 33 + 14 + TechNameSpace + 24 * i + 1 * 2, 0, 748 104 - 33 + 17 + TechNameSpace + 24 * i + 8 * 2, InnerHeight)); 749 brush.style := bsClear; 656 750 end 657 else751 else 658 752 begin // colored player columns 659 Pen.Color:=Tribe[Column[i]].Color;660 for j:=1 to 8 do661 begin 662 MoveTo(104-33+15+TechNameSpace+24*i+j*2,0);663 LineTo(104-33+15+TechNameSpace+24*i+j*2,InnerHeight);753 Pen.Color := Tribe[Column[i]].Color; 754 for j := 1 to 8 do 755 begin 756 MoveTo(104 - 33 + 15 + TechNameSpace + 24 * i + j * 2, 0); 757 LineTo(104 - 33 + 15 + TechNameSpace + 24 * i + j * 2, InnerHeight); 664 758 end 665 759 end; 666 760 end; 667 for i:=-1 to DispLines do if (i+sb.si.npos>=0) and (i+sb.si.npos<Lines[Layer]) then 668 line(offscreen.Canvas,i,true,false) 669 end; 670 MarkUsedOffscreen(InnerWidth,8+48+DispLines*LineDistance); 671 end; 672 673 procedure TListDlg.PaintBox1MouseMove(Sender:TObject; 674 Shift:TShiftState;x,y:integer); 761 for i := -1 to DispLines do 762 if (i + sb.si.npos >= 0) and (i + sb.si.npos < Lines[Layer]) then 763 line(offscreen.Canvas, i, true, false) 764 end; 765 MarkUsedOffscreen(InnerWidth, 8 + 48 + DispLines * LineDistance); 766 end; 767 768 procedure TListDlg.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; 769 x, y: integer); 675 770 var 676 i0,Sel0,iColumn,OldScienceNation,xScreen: integer; 677 s: string; 678 begin 679 y:=y-TitleHeight; 680 i0:=sb.si.npos; 681 Sel0:=Sel; 682 if (x>=SideFrame) and (x<SideFrame+InnerWidth) and (y>=0) and (y<InnerHeight) 683 and (y mod LineDistance>=4) and (y mod LineDistance<20) then 684 Sel:=y div LineDistance-1 685 else Sel:=-2; 686 if (Sel<-1) or (Sel>DispLines) or (Sel+i0<0) or (Sel+i0>=Lines[Layer]) then 687 Sel:=-2; 688 if Sel<>Sel0 then 689 begin 690 if Sel0<>-2 then line(Canvas,Sel0,false,false); 691 if Sel<>-2 then line(Canvas,Sel,false,true) 692 end; 693 694 if Kind=kScience then 771 i0, Sel0, iColumn, OldScienceNation, xScreen: integer; 772 s: string; 773 begin 774 y := y - TitleHeight; 775 i0 := sb.si.npos; 776 Sel0 := Sel; 777 if (x >= SideFrame) and (x < SideFrame + InnerWidth) and (y >= 0) and 778 (y < InnerHeight) and (y mod LineDistance >= 4) and (y mod LineDistance < 20) 779 then 780 Sel := y div LineDistance - 1 781 else 782 Sel := -2; 783 if (Sel < -1) or (Sel > DispLines) or (Sel + i0 < 0) or 784 (Sel + i0 >= Lines[Layer]) then 785 Sel := -2; 786 if Sel <> Sel0 then 787 begin 788 if Sel0 <> -2 then 789 line(Canvas, Sel0, false, false); 790 if Sel <> -2 then 791 line(Canvas, Sel, false, true) 792 end; 793 794 if Kind = kScience then 695 795 begin // show nation under cursor position 696 OldScienceNation:=ScienceNation; 697 ScienceNation:=-1; 698 if (x>=SideFrame+(104-33+15+TechNameSpace)) and ((x-SideFrame-(104-33+15+TechNameSpace)) mod 24<=18) 699 and (y>=0) and (y<InnerHeight) then 796 OldScienceNation := ScienceNation; 797 ScienceNation := -1; 798 if (x >= SideFrame + (104 - 33 + 15 + TechNameSpace)) and 799 ((x - SideFrame - (104 - 33 + 15 + TechNameSpace)) mod 24 <= 18) and 800 (y >= 0) and (y < InnerHeight) then 700 801 begin 701 iColumn:=(x-SideFrame-(104-33+15+TechNameSpace)) div 24;702 if (iColumn>=1) and (iColumn<nColumn) then703 ScienceNation:=Column[iColumn];802 iColumn := (x - SideFrame - (104 - 33 + 15 + TechNameSpace)) div 24; 803 if (iColumn >= 1) and (iColumn < nColumn) then 804 ScienceNation := Column[iColumn]; 704 805 end; 705 if ScienceNation<>OldScienceNation then806 if ScienceNation <> OldScienceNation then 706 807 begin 707 Fill(Canvas,9,ClientHeight-29,ClientWidth-18,24, 708 (wMaintexture-ClientWidth) div 2,(hMaintexture-ClientHeight) div 2); 709 if ScienceNation>=0 then 710 begin 711 s:=Tribe[ScienceNation].TPhrase('SHORTNAME'); 712 if MyRO.Alive and (1 shl ScienceNation)=0 then 713 s:=Format(Phrases.Lookup('SCIENCEREPORT_EXTINCT'),[s]) // extinct 714 else if MyRO.EnemyReport[ScienceNation].TurnOfCivilReport<MyRO.Turn-1 then 715 s:=s+' ('+TurnToString(MyRO.EnemyReport[ScienceNation].TurnOfCivilReport)+')'; // old report 716 xScreen:=(ClientWidth-BiColorTextWidth(Canvas,s)) div 2; 717 LoweredTextOut(Canvas, -1, MainTexture, xScreen+10, ClientHeight-29, s); 718 BitBlt(ScienceNationDot.Canvas.Handle,0,0,17,17,Canvas.Handle,xScreen-10, 719 ClientHeight-27,SRCCOPY); 720 ImageOp_BCC(ScienceNationDot,Templates,0,0,114,211,17,17, 721 MainTexture.clBevelShade,Tribe[ScienceNation].Color); 722 BitBlt(Canvas.Handle,xScreen-10,ClientHeight-27,17,17, 723 ScienceNationDot.Canvas.Handle,0,0,SRCCOPY); 808 Fill(Canvas, 9, ClientHeight - 29, ClientWidth - 18, 24, 809 (wMaintexture - ClientWidth) div 2, 810 (hMaintexture - ClientHeight) div 2); 811 if ScienceNation >= 0 then 812 begin 813 s := Tribe[ScienceNation].TPhrase('SHORTNAME'); 814 if MyRO.Alive and (1 shl ScienceNation) = 0 then 815 s := Format(Phrases.Lookup('SCIENCEREPORT_EXTINCT'), [s]) // extinct 816 else if MyRO.EnemyReport[ScienceNation].TurnOfCivilReport < MyRO.Turn - 1 817 then 818 s := s + ' (' + TurnToString(MyRO.EnemyReport[ScienceNation] 819 .TurnOfCivilReport) + ')'; // old report 820 xScreen := (ClientWidth - BiColorTextWidth(Canvas, s)) div 2; 821 LoweredTextOut(Canvas, -1, MainTexture, xScreen + 10, 822 ClientHeight - 29, s); 823 BitBlt(ScienceNationDot.Canvas.Handle, 0, 0, 17, 17, Canvas.Handle, 824 xScreen - 10, ClientHeight - 27, SRCCOPY); 825 ImageOp_BCC(ScienceNationDot, Templates, 0, 0, 114, 211, 17, 17, 826 MainTexture.clBevelShade, Tribe[ScienceNation].Color); 827 BitBlt(Canvas.Handle, xScreen - 10, ClientHeight - 27, 17, 17, 828 ScienceNationDot.Canvas.Handle, 0, 0, SRCCOPY); 724 829 end; 725 830 end … … 729 834 function TListDlg.RenameCity(cix: integer): boolean; 730 835 var 731 CityNameInfo: TCityNameInfo; 732 begin 733 InputDlg.Caption:=Phrases.Lookup('TITLE_CITYNAME'); 734 InputDlg.EInput.Text:=CityName(MyCity[cix].ID); 735 InputDlg.CenterToRect(BoundsRect); 736 InputDlg.ShowModal; 737 if (InputDlg.ModalResult=mrOK) and (InputDlg.EInput.Text<>'') 738 and (InputDlg.EInput.Text<>CityName(MyCity[cix].ID)) then 739 begin 740 CityNameInfo.ID:=MyCity[cix].ID; 741 CityNameInfo.NewName:=InputDlg.EInput.Text; 742 Server(cSetCityName+(Length(CityNameInfo.NewName)+8) div 4,me,0,CityNameInfo); 743 if CityDlg.Visible then begin CityDlg.FormShow(nil); CityDlg.Invalidate end; 744 result:=true 836 CityNameInfo: TCityNameInfo; 837 begin 838 InputDlg.Caption := Phrases.Lookup('TITLE_CITYNAME'); 839 InputDlg.EInput.Text := CityName(MyCity[cix].ID); 840 InputDlg.CenterToRect(BoundsRect); 841 InputDlg.ShowModal; 842 if (InputDlg.ModalResult = mrOK) and (InputDlg.EInput.Text <> '') and 843 (InputDlg.EInput.Text <> CityName(MyCity[cix].ID)) then 844 begin 845 CityNameInfo.ID := MyCity[cix].ID; 846 CityNameInfo.NewName := InputDlg.EInput.Text; 847 Server(cSetCityName + (length(CityNameInfo.NewName) + 8) div 4, me, 0, 848 CityNameInfo); 849 if CityDlg.Visible then 850 begin 851 CityDlg.FormShow(nil); 852 CityDlg.Invalidate 853 end; 854 result := true 745 855 end 746 else result:=false 856 else 857 result := false 747 858 end; 748 859 749 860 function TListDlg.RenameModel(mix: integer): boolean; 750 861 var 751 ModelNameInfo: TModelNameInfo; 752 begin 753 InputDlg.Caption:=Phrases.Lookup('TITLE_MODELNAME'); 754 InputDlg.EInput.Text:=Tribe[me].ModelName[mix]; 755 InputDlg.CenterToRect(BoundsRect); 756 InputDlg.ShowModal; 757 if (InputDlg.ModalResult=mrOK) and (InputDlg.EInput.Text<>'') 758 and (InputDlg.EInput.Text<>Tribe[me].ModelName[mix]) then 759 begin 760 ModelNameInfo.mix:=mix; 761 ModelNameInfo.NewName:=InputDlg.EInput.Text; 762 Server(cSetModelName+(Length(ModelNameInfo.NewName)+1+4+3) div 4, 763 me,0,ModelNameInfo); 764 if UnitStatDlg.Visible then begin UnitStatDlg.FormShow(nil); UnitStatDlg.Invalidate end; 765 result:=true 862 ModelNameInfo: TModelNameInfo; 863 begin 864 InputDlg.Caption := Phrases.Lookup('TITLE_MODELNAME'); 865 InputDlg.EInput.Text := Tribe[me].ModelName[mix]; 866 InputDlg.CenterToRect(BoundsRect); 867 InputDlg.ShowModal; 868 if (InputDlg.ModalResult = mrOK) and (InputDlg.EInput.Text <> '') and 869 (InputDlg.EInput.Text <> Tribe[me].ModelName[mix]) then 870 begin 871 ModelNameInfo.mix := mix; 872 ModelNameInfo.NewName := InputDlg.EInput.Text; 873 Server(cSetModelName + (length(ModelNameInfo.NewName) + 1 + 4 + 3) div 4, 874 me, 0, ModelNameInfo); 875 if UnitStatDlg.Visible then 876 begin 877 UnitStatDlg.FormShow(nil); 878 UnitStatDlg.Invalidate 879 end; 880 result := true 766 881 end 767 else result:=false 768 end; 769 770 procedure TListDlg.PaintBox1MouseDown(Sender:TObject;Button:TMouseButton; 771 Shift:TShiftState;x,y:integer); 882 else 883 result := false 884 end; 885 886 procedure TListDlg.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; 887 Shift: TShiftState; x, y: integer); 772 888 var 773 lix: integer; 774 begin 775 if sb.si.npos+Sel>=0 then lix:=code[Layer,sb.si.npos+Sel]; 776 if Kind in [kScience,kCities,kCityEvents,kModels,kEModels,kAllEModels] then 777 include(Shift, ssShift); // don't close list window 778 if (ssLeft in Shift) and not(ssShift in Shift) then 779 begin 780 if Sel<>-2 then 781 begin result:=lix; Closable:=true; Close end 889 lix: integer; 890 begin 891 if sb.si.npos + Sel >= 0 then 892 lix := code[Layer, sb.si.npos + Sel]; 893 if Kind in [kScience, kCities, kCityEvents, kModels, kEModels, kAllEModels] 894 then 895 include(Shift, ssShift); // don't close list window 896 if (ssLeft in Shift) and not(ssShift in Shift) then 897 begin 898 if Sel <> -2 then 899 begin 900 result := lix; 901 Closable := true; 902 Close 903 end 782 904 end 783 else if (ssLeft in Shift) and (ssShift in Shift) then905 else if (ssLeft in Shift) and (ssShift in Shift) then 784 906 begin // show help/info popup 785 if Sel<>-2 then 786 case Kind of 787 kCities: 788 MainScreen.ZoomToCity(MyCity[lix].Loc); 789 kCityEvents: 790 MainScreen.ZoomToCity(MyCity[lix].Loc, false, MyCity[lix].Flags and CityRepMask); 791 kModels,kChooseModel: 792 if lix<>mixAll then 793 UnitStatDlg.ShowNewContent_OwnModel(FWindowMode or wmPersistent, lix); 794 kEModels: 795 UnitStatDlg.ShowNewContent_EnemyModel(FWindowMode or wmPersistent, code[1,sb.si.npos+Sel]); 796 kAllEModels,kChooseEModel: 797 if lix<>mixAll then 798 UnitStatDlg.ShowNewContent_EnemyModel(FWindowMode or wmPersistent, lix); 799 kAdvance,kFarAdvance,kScience,kChooseTech,kChooseETech,kStealTech: 800 if lix=adMilitary then 801 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkText, HelpDlg.TextIndex('MILRES')) 802 else if lix<adMilitary then 803 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkAdv, lix); 804 kProject: 805 if lix=cpImp+imTrGoods then 806 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkText,HelpDlg.TextIndex('TRADINGGOODS')) 807 else if lix and (cpImp+cpType)=0 then 808 UnitStatDlg.ShowNewContent_OwnModel(FWindowMode or wmPersistent, lix and cpIndex) 809 else if (lix and cpType=0) and (lix<>cpImp+imTrGoods) then 810 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkImp, lix and cpIndex); 811 kGov: 812 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkMisc, miscGovList); 813 kShipPart,kEShipPart:; 907 if Sel <> -2 then 908 case Kind of 909 kCities: 910 MainScreen.ZoomToCity(MyCity[lix].Loc); 911 kCityEvents: 912 MainScreen.ZoomToCity(MyCity[lix].Loc, false, MyCity[lix].Flags and 913 CityRepMask); 914 kModels, kChooseModel: 915 if lix <> mixAll then 916 UnitStatDlg.ShowNewContent_OwnModel(FWindowMode or 917 wmPersistent, lix); 918 kEModels: 919 UnitStatDlg.ShowNewContent_EnemyModel(FWindowMode or wmPersistent, 920 code[1, sb.si.npos + Sel]); 921 kAllEModels, kChooseEModel: 922 if lix <> mixAll then 923 UnitStatDlg.ShowNewContent_EnemyModel(FWindowMode or 924 wmPersistent, lix); 925 kAdvance, kFarAdvance, kScience, kChooseTech, kChooseETech, kStealTech: 926 if lix = adMilitary then 927 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkText, 928 HelpDlg.TextIndex('MILRES')) 929 else if lix < adMilitary then 930 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkAdv, lix); 931 kProject: 932 if lix = cpImp + imTrGoods then 933 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkText, 934 HelpDlg.TextIndex('TRADINGGOODS')) 935 else if lix and (cpImp + cpType) = 0 then 936 UnitStatDlg.ShowNewContent_OwnModel(FWindowMode or wmPersistent, 937 lix and cpIndex) 938 else if (lix and cpType = 0) and (lix <> cpImp + imTrGoods) then 939 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkImp, 940 lix and cpIndex); 941 kGov: 942 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkMisc, 943 miscGovList); 944 kShipPart, kEShipPart: 945 ; 814 946 end 815 947 end 816 else if ssRight in Shift then 817 begin 818 if Sel<>-2 then 819 case Kind of 820 kCities, kCityEvents: 821 if RenameCity(lix) then SmartUpdateContent; 822 kModels: 823 if RenameModel(lix) then SmartUpdateContent; 948 else if ssRight in Shift then 949 begin 950 if Sel <> -2 then 951 case Kind of 952 kCities, kCityEvents: 953 if RenameCity(lix) then 954 SmartUpdateContent; 955 kModels: 956 if RenameModel(lix) then 957 SmartUpdateContent; 824 958 end 825 959 end … … 828 962 procedure TListDlg.InitLines; 829 963 var 830 required: array[0..nAdv-1] of integer; 831 832 procedure TryAddImpLine(Layer,Project: integer); 833 begin 834 if Server(sSetCityProject-sExecute,me,cixProject,Project)>=rExecuted then 835 begin code[Layer,Lines[Layer]]:=Project; inc(Lines[Layer]); end; 964 required: array [0 .. nAdv - 1] of integer; 965 966 procedure TryAddImpLine(Layer, Project: integer); 967 begin 968 if Server(sSetCityProject - sExecute, me, cixProject, Project) >= rExecuted 969 then 970 begin 971 code[Layer, Lines[Layer]] := Project; 972 inc(Lines[Layer]); 973 end; 836 974 end; 837 975 838 976 procedure SortTechs; 839 977 var 840 i,j,swap: integer;978 i, j, swap: integer; 841 979 begin // sort by advancedness 842 for i:=0 to Lines[0]-2 do if code[0,i]<adMilitary then 843 for j:=i+1 to Lines[0]-1 do 844 if AdvValue[code[0,i]]*nAdv+code[0,i]<AdvValue[code[0,j]]*nAdv+code[0,j] then 845 begin swap:=code[0,i]; code[0,i]:=code[0,j]; code[0,j]:=swap end; 980 for i := 0 to Lines[0] - 2 do 981 if code[0, i] < adMilitary then 982 for j := i + 1 to Lines[0] - 1 do 983 if AdvValue[code[0, i]] * nAdv + code[0, i] < AdvValue[code[0, j]] * 984 nAdv + code[0, j] then 985 begin 986 swap := code[0, i]; 987 code[0, i] := code[0, j]; 988 code[0, j] := swap 989 end; 846 990 end; 847 991 848 992 procedure SortCities; 849 993 var 850 i,j,swap: integer; 851 begin 852 for i:=0 to Lines[0]-2 do 853 for j:=i+1 to Lines[0]-1 do 854 if CityName(MyCity[code[0,i]].ID)>CityName(MyCity[code[0,j]].ID) then 855 begin swap:=code[0,i]; code[0,i]:=code[0,j]; code[0,j]:=swap end; 856 end; 857 858 function ModelSortValue(const mi: TModelInfo; MixPlayers: boolean = false): integer; 859 begin 860 result:=(mi.Domain+1) shl 28 -mi.mix; 861 if MixPlayers then dec(result, ModelCode(mi) shl 16); 994 i, j, swap: integer; 995 begin 996 for i := 0 to Lines[0] - 2 do 997 for j := i + 1 to Lines[0] - 1 do 998 if CityName(MyCity[code[0, i]].ID) > CityName(MyCity[code[0, j]].ID) 999 then 1000 begin 1001 swap := code[0, i]; 1002 code[0, i] := code[0, j]; 1003 code[0, j] := swap 1004 end; 1005 end; 1006 1007 function ModelSortValue(const mi: TModelInfo; 1008 MixPlayers: boolean = false): integer; 1009 begin 1010 result := (mi.Domain + 1) shl 28 - mi.mix; 1011 if MixPlayers then 1012 dec(result, ModelCode(mi) shl 16); 862 1013 end; 863 1014 864 1015 procedure SortModels; 865 1016 var 866 i,j,swap: integer;1017 i, j, swap: integer; 867 1018 begin // sort by code[2] 868 for i:=0 to Lines[0]-2 do for j:=i+1 to Lines[0]-1 do 869 if code[2,i]>code[2,j] then 870 begin 871 swap:=code[0,i]; code[0,i]:=code[0,j]; code[0,j]:=swap; 872 swap:=code[1,i]; code[1,i]:=code[1,j]; code[1,j]:=swap; 873 swap:=code[2,i]; code[2,i]:=code[2,j]; code[2,j]:=swap; 874 end; 1019 for i := 0 to Lines[0] - 2 do 1020 for j := i + 1 to Lines[0] - 1 do 1021 if code[2, i] > code[2, j] then 1022 begin 1023 swap := code[0, i]; 1024 code[0, i] := code[0, j]; 1025 code[0, j] := swap; 1026 swap := code[1, i]; 1027 code[1, i] := code[1, j]; 1028 code[1, j] := swap; 1029 swap := code[2, i]; 1030 code[2, i] := code[2, j]; 1031 code[2, j] := swap; 1032 end; 875 1033 end; 876 1034 877 1035 procedure MarkPreqs(i: integer); 878 1036 begin 879 required[i]:=1;880 if MyRO.Tech[i]<tsSeen then1037 required[i] := 1; 1038 if MyRO.Tech[i] < tsSeen then 881 1039 begin 882 if (AdvPreq[i,0]>=0) then MarkPreqs(AdvPreq[i,0]); 883 if (AdvPreq[i,1]>=0) then MarkPreqs(AdvPreq[i,1]); 1040 if (AdvPreq[i, 0] >= 0) then 1041 MarkPreqs(AdvPreq[i, 0]); 1042 if (AdvPreq[i, 1] >= 0) then 1043 MarkPreqs(AdvPreq[i, 1]); 884 1044 end 885 1045 end; 886 1046 887 1047 var 888 Loc1,i,j,p1,dx,dy,mix,emix,EnemyType,TestEnemyType:integer; 889 mi: TModelInfo; 890 PPicture, PTestPicture: ^TModelPicture; 891 ModelOk: array[0..4095] of boolean; 892 ok: boolean; 893 begin 894 for i:=0 to MaxLayer-1 do 895 begin Lines[i]:=0; FirstShrinkedLine[i]:=MaxInt end; 896 case Kind of 897 kProject: 898 begin 899 // improvements 900 code[0,0]:=cpImp+imTrGoods; 901 Lines[0]:=1; 902 for i:=28 to nImp-1 do 903 if Imp[i].Kind=ikCommon then 904 TryAddImpLine(0,i+cpImp); 905 for i:=28 to nImp-1 do 906 if not (Imp[i].Kind in [ikCommon,ikTrGoods]) 907 and ((MyRO.NatBuilt[i]=0) or (Imp[i].Kind=ikNatLocal)) then 908 TryAddImpLine(0,i+cpImp); 909 for i:=0 to nCityType-1 do if MyData.ImpOrder[i,0]>=0 then 910 begin code[0,Lines[0]]:=cpType+i; inc(Lines[0]); end; 911 912 // wonders 913 for i:=0 to 27 do 914 TryAddImpLine(1,i+cpImp); 915 916 // units 917 for i:=0 to MyRO.nModel-1 do 918 begin 919 { if MyModel[i].Kind=mkSlaves then 920 ok:= MyRO.Wonder[woPyramids].EffectiveOwner=me 921 else} if MyModel[i].Domain=dSea then 922 begin 923 ok:=false; 924 for dx:=-2 to 2 do for dy:=-2 to 2 do if abs(dx)+abs(dy)=2 then 925 begin 926 Loc1:=dLoc(MyCity[cixProject].Loc,dx,dy); 927 if (Loc1>=0) and (Loc1<G.lx*G.ly) 928 and ((MyMap[Loc1] and fTerrain=fShore) or (MyMap[Loc1] and fCanal>0)) then 929 ok:=true; 1048 Loc1, i, j, p1, dx, dy, mix, emix, EnemyType, TestEnemyType: integer; 1049 mi: TModelInfo; 1050 PPicture, PTestPicture: ^TModelPicture; 1051 ModelOk: array [0 .. 4095] of boolean; 1052 ok: boolean; 1053 begin 1054 for i := 0 to MaxLayer - 1 do 1055 begin 1056 Lines[i] := 0; 1057 FirstShrinkedLine[i] := MaxInt 1058 end; 1059 case Kind of 1060 kProject: 1061 begin 1062 // improvements 1063 code[0, 0] := cpImp + imTrGoods; 1064 Lines[0] := 1; 1065 for i := 28 to nImp - 1 do 1066 if Imp[i].Kind = ikCommon then 1067 TryAddImpLine(0, i + cpImp); 1068 for i := 28 to nImp - 1 do 1069 if not(Imp[i].Kind in [ikCommon, ikTrGoods]) and 1070 ((MyRO.NatBuilt[i] = 0) or (Imp[i].Kind = ikNatLocal)) then 1071 TryAddImpLine(0, i + cpImp); 1072 for i := 0 to nCityType - 1 do 1073 if MyData.ImpOrder[i, 0] >= 0 then 1074 begin 1075 code[0, Lines[0]] := cpType + i; 1076 inc(Lines[0]); 1077 end; 1078 1079 // wonders 1080 for i := 0 to 27 do 1081 TryAddImpLine(1, i + cpImp); 1082 1083 // units 1084 for i := 0 to MyRO.nModel - 1 do 1085 begin 1086 { if MyModel[i].Kind=mkSlaves then 1087 ok:= MyRO.Wonder[woPyramids].EffectiveOwner=me 1088 else } if MyModel[i].Domain = dSea then 1089 begin 1090 ok := false; 1091 for dx := -2 to 2 do 1092 for dy := -2 to 2 do 1093 if abs(dx) + abs(dy) = 2 then 1094 begin 1095 Loc1 := dLoc(MyCity[cixProject].Loc, dx, dy); 1096 if (Loc1 >= 0) and (Loc1 < G.lx * G.ly) and 1097 ((MyMap[Loc1] and fTerrain = fShore) or 1098 (MyMap[Loc1] and fCanal > 0)) then 1099 ok := true; 1100 end 930 1101 end 1102 else 1103 ok := true; 1104 if ok then 1105 begin 1106 if MyModel[i].Status and msObsolete = 0 then 1107 begin 1108 code[2, Lines[2]] := i; 1109 inc(Lines[2]) 1110 end; 1111 if MyModel[i].Status and msAllowConscripts <> 0 then 1112 begin 1113 code[2, Lines[2]] := i + cpConscripts; 1114 inc(Lines[2]) 1115 end; 1116 end; 1117 end; 1118 FirstShrinkedLine[2] := 0; 1119 end; 1120 kAdvance: 1121 begin 1122 nColumn := 1; 1123 if MyData.FarTech <> adNone then 1124 begin 1125 FillChar(required, SizeOf(required), 0); 1126 MarkPreqs(MyData.FarTech); 1127 end; 1128 for i := 0 to nAdv - 1 do 1129 if ((i in FutureTech) or (MyRO.Tech[i] < tsApplicable)) and 1130 (Server(sSetResearch - sExecute, me, i, nil^) >= rExecuted) and 1131 ((MyData.FarTech = adNone) or (required[i] > 0)) then 1132 begin 1133 code[0, Lines[0]] := i; 1134 inc(Lines[0]); 1135 end; 1136 SortTechs; 1137 if Lines[0] = 0 then // no more techs -- offer nexus 1138 begin 1139 code[0, Lines[0]] := adNexus; 1140 inc(Lines[0]); 1141 end; 1142 ok := false; 1143 for i := 0 to nDomains - 1 do 1144 if (upgrade[i, 0].Preq = preNone) or 1145 (MyRO.Tech[upgrade[i, 0].Preq] >= tsApplicable) then 1146 ok := true; 1147 if ok then { new unit class } 1148 begin 1149 code[0, Lines[0]] := adMilitary; 1150 inc(Lines[0]) 1151 end; 1152 end; 1153 kFarAdvance: 1154 begin 1155 code[0, Lines[0]] := adNone; 1156 inc(Lines[0]); 1157 for i := 0 to nAdv - 1 do 1158 if not(i in FutureTech) and (MyRO.Tech[i] < tsApplicable) and 1159 ((AdvValue[i] < 2000) or (MyRO.Tech[adMassProduction] > tsNA)) and 1160 ((AdvValue[i] < 1000) or (MyRO.Tech[adScience] > tsNA)) then 1161 begin 1162 code[0, Lines[0]] := i; 1163 inc(Lines[0]); 1164 end; 1165 SortTechs; 1166 end; 1167 kChooseTech: 1168 begin 1169 for i := 0 to nAdv - 1 do 1170 if not(i in FutureTech) and (MyRO.Tech[i] >= tsApplicable) and 1171 (MyRO.EnemyReport[DipMem[me].pContact].Tech[i] < tsSeen) then 1172 begin 1173 code[0, Lines[0]] := i; 1174 inc(Lines[0]); 1175 end; 1176 SortTechs; 1177 // if Lines[0]>1 then 1178 begin 1179 code[0, Lines[0]] := adAll; 1180 inc(Lines[0]); 1181 end; 1182 end; 1183 kChooseETech: 1184 begin 1185 for i := 0 to nAdv - 1 do 1186 if not(i in FutureTech) and (MyRO.Tech[i] < tsSeen) and 1187 (MyRO.EnemyReport[DipMem[me].pContact].Tech[i] >= tsApplicable) then 1188 begin 1189 code[0, Lines[0]] := i; 1190 inc(Lines[0]); 1191 end; 1192 SortTechs; 1193 // if Lines[0]>1 then 1194 begin 1195 code[0, Lines[0]] := adAll; 1196 inc(Lines[0]); 1197 end; 1198 end; 1199 kStealTech: 1200 begin 1201 for i := 0 to nAdv - 1 do 1202 if Server(sStealTech - sExecute, me, i, nil^) >= rExecuted then 1203 begin 1204 code[0, Lines[0]] := i; 1205 inc(Lines[0]); 1206 end; 1207 SortTechs; 1208 end; 1209 kScience: 1210 begin 1211 Column[0] := me; 1212 nColumn := 1; 1213 for EnemyType := 0 to 2 do 1214 for p1 := 0 to nPl - 1 do 1215 if (MyRO.EnemyReport[p1] <> nil) and 1216 ((MyRO.EnemyReport[p1].TurnOfContact >= 0) or 1217 (MyRO.EnemyReport[p1].TurnOfCivilReport >= 0)) then 1218 begin 1219 if MyRO.Alive and (1 shl p1) = 0 then 1220 TestEnemyType := 2 // extinct enemy -- move to right end 1221 else if MyRO.EnemyReport[p1].TurnOfCivilReport >= MyRO.Turn - 1 1222 then 1223 TestEnemyType := 0 // current report -- move to left end 1224 else 1225 TestEnemyType := 1; 1226 if TestEnemyType = EnemyType then 1227 begin 1228 Column[nColumn] := p1; 1229 inc(nColumn); 1230 end; 1231 end; 1232 for i := 0 to nAdv - 1 do 1233 begin 1234 ok := (MyRO.Tech[i] <> tsNA) or (MyRO.ResearchTech = i); 1235 for j := 1 to nColumn - 1 do 1236 with MyRO.EnemyReport[Column[j]]^ do 1237 if (Tech[i] <> tsNA) or (TurnOfCivilReport >= 0) and 1238 (ResearchTech = i) then 1239 ok := true; 1240 if ok then 1241 begin 1242 code[0, Lines[0]] := i; 1243 inc(Lines[0]); 1244 end; 1245 end; 1246 SortTechs; 1247 1248 ok := MyRO.ResearchTech = adMilitary; 1249 for j := 1 to nColumn - 1 do 1250 with MyRO.EnemyReport[Column[j]]^ do 1251 if (MyRO.Alive and (1 shl Column[j]) <> 0) and 1252 (TurnOfCivilReport >= 0) and (ResearchTech = adMilitary) then 1253 ok := true; 1254 if ok then 1255 begin 1256 code[0, Lines[0]] := adMilitary; 1257 inc(Lines[0]); 931 1258 end 932 else ok:=true; 933 if ok then 934 begin 935 if MyModel[i].Status and msObsolete=0 then 936 begin code[2,Lines[2]]:=i; inc(Lines[2]) end; 937 if MyModel[i].Status and msAllowConscripts<>0 then 938 begin code[2,Lines[2]]:=i+cpConscripts; inc(Lines[2]) end; 939 end; 940 end; 941 FirstShrinkedLine[2]:=0; 942 end; 943 kAdvance: 944 begin 945 nColumn:=1; 946 if MyData.FarTech<>adNone then 947 begin 948 FillChar(required,SizeOf(required),0); 949 MarkPreqs(MyData.FarTech); 950 end; 951 for i:=0 to nAdv-1 do 952 if ((i in FutureTech) or (MyRO.Tech[i]<tsApplicable)) 953 and (Server(sSetResearch-sExecute,me,i,nil^)>=rExecuted) 954 and ((MyData.FarTech=adNone) or (required[i]>0)) then 955 begin code[0,Lines[0]]:=i; inc(Lines[0]); end; 956 SortTechs; 957 if Lines[0]=0 then // no more techs -- offer nexus 958 begin code[0,Lines[0]]:=adNexus; inc(Lines[0]); end; 959 ok:=false; 960 for i:=0 to nDomains-1 do 961 if (upgrade[i,0].Preq=preNone) 962 or (MyRO.Tech[upgrade[i,0].Preq]>=tsApplicable) then 963 ok:=true; 964 if ok then {new unit class} 965 begin code[0,Lines[0]]:=adMilitary; inc(Lines[0]) end; 966 end; 967 kFarAdvance: 968 begin 969 code[0,Lines[0]]:=adNone; inc(Lines[0]); 970 for i:=0 to nAdv-1 do 971 if not (i in FutureTech) and (MyRO.Tech[i]<tsApplicable) 972 and ((AdvValue[i]<2000) or (MyRO.Tech[adMassProduction]>tsNA)) 973 and ((AdvValue[i]<1000) or (MyRO.Tech[adScience]>tsNA)) then 974 begin code[0,Lines[0]]:=i; inc(Lines[0]); end; 975 SortTechs; 976 end; 977 kChooseTech: 978 begin 979 for i:=0 to nAdv-1 do 980 if not (i in FutureTech) and (MyRO.Tech[i]>=tsApplicable) 981 and (MyRO.EnemyReport[DipMem[me].pContact].Tech[i]<tsSeen) then 982 begin code[0,Lines[0]]:=i; inc(Lines[0]); end; 983 SortTechs; 984 // if Lines[0]>1 then 985 begin code[0,Lines[0]]:=adAll; inc(Lines[0]); end; 986 end; 987 kChooseETech: 988 begin 989 for i:=0 to nAdv-1 do 990 if not (i in FutureTech) and (MyRO.Tech[i]<tsSeen) 991 and (MyRO.EnemyReport[DipMem[me].pContact].Tech[i]>=tsApplicable) then 992 begin code[0,Lines[0]]:=i; inc(Lines[0]); end; 993 SortTechs; 994 // if Lines[0]>1 then 995 begin code[0,Lines[0]]:=adAll; inc(Lines[0]); end; 996 end; 997 kStealTech: 998 begin 999 for i:=0 to nAdv-1 do 1000 if Server(sStealTech-sExecute, me, i, nil^)>=rExecuted then 1001 begin code[0,Lines[0]]:=i; inc(Lines[0]); end; 1002 SortTechs; 1003 end; 1004 kScience: 1005 begin 1006 Column[0]:=me; 1007 nColumn:=1; 1008 for EnemyType:=0 to 2 do 1009 for p1:=0 to nPl-1 do 1010 if (MyRO.EnemyReport[p1]<>nil) 1011 and ((MyRO.EnemyReport[p1].TurnOfContact>=0) 1012 or (MyRO.EnemyReport[p1].TurnOfCivilReport>=0)) then 1013 begin 1014 if MyRO.Alive and (1 shl p1)=0 then 1015 TestEnemyType:=2 // extinct enemy -- move to right end 1016 else if MyRO.EnemyReport[p1].TurnOfCivilReport>=MyRO.Turn-1 then 1017 TestEnemyType:=0 // current report -- move to left end 1018 else TestEnemyType:=1; 1019 if TestEnemyType=EnemyType then 1020 begin Column[nColumn]:=p1; inc(nColumn); end; 1021 end; 1022 for i:=0 to nAdv-1 do 1023 begin 1024 ok:= (MyRO.Tech[i]<>tsNA) or (MyRO.ResearchTech=i); 1025 for j:=1 to nColumn-1 do with MyRO.EnemyReport[Column[j]]^ do 1026 if (Tech[i]<>tsNA) or (TurnOfCivilReport>=0) and (ResearchTech=i) then 1027 ok:=true; 1028 if ok then 1029 begin code[0,Lines[0]]:=i; inc(Lines[0]); end; 1030 end; 1031 SortTechs; 1032 1033 ok:= MyRO.ResearchTech=adMilitary; 1034 for j:=1 to nColumn-1 do with MyRO.EnemyReport[Column[j]]^ do 1035 if (MyRO.Alive and (1 shl Column[j])<>0) 1036 and (TurnOfCivilReport>=0) and (ResearchTech=adMilitary) then 1037 ok:=true; 1038 if ok then 1039 begin code[0,Lines[0]]:=adMilitary; inc(Lines[0]); end 1040 end; 1041 kCities{, kChooseCity}: 1042 begin 1043 if ClientMode<scContact then 1044 for i:=0 to MyRO.nCity-1 do if MyCity[i].Loc>=0 then 1045 begin code[0,Lines[0]]:=i; inc(Lines[0]) end; 1046 SortCities; 1047 FirstShrinkedLine[0]:=0 1048 end; 1049 kCityEvents: 1050 begin 1051 for i:=0 to MyRO.nCity-1 do 1052 if (MyCity[i].Loc>=0) and (MyCity[i].Flags and CityRepMask<>0) then 1053 begin code[0,Lines[0]]:=i; inc(Lines[0]) end; 1054 SortCities; 1055 FirstShrinkedLine[0]:=0 1056 end; 1057 { kChooseECity: 1058 begin 1059 for i:=0 to MyRO.nEnemyCity-1 do 1259 end; 1260 kCities { , kChooseCity } : 1261 begin 1262 if ClientMode < scContact then 1263 for i := 0 to MyRO.nCity - 1 do 1264 if MyCity[i].Loc >= 0 then 1265 begin 1266 code[0, Lines[0]] := i; 1267 inc(Lines[0]) 1268 end; 1269 SortCities; 1270 FirstShrinkedLine[0] := 0 1271 end; 1272 kCityEvents: 1273 begin 1274 for i := 0 to MyRO.nCity - 1 do 1275 if (MyCity[i].Loc >= 0) and (MyCity[i].Flags and CityRepMask <> 0) 1276 then 1277 begin 1278 code[0, Lines[0]] := i; 1279 inc(Lines[0]) 1280 end; 1281 SortCities; 1282 FirstShrinkedLine[0] := 0 1283 end; 1284 { kChooseECity: 1285 begin 1286 for i:=0 to MyRO.nEnemyCity-1 do 1060 1287 if (MyRO.EnemyCity[i].Loc>=0) 1061 and (MyRO.EnemyCity[i].owner=DipMem[me].pContact) then 1062 begin code[0,Lines[0]]:=i; inc(Lines[0]); end; 1063 FirstShrinkedLine:=0 1064 end;} 1065 kModels: 1066 begin 1067 for mix:=0 to MyRO.nModel-1 do 1068 begin 1069 code[0,mix]:=mix; 1070 MakeModelInfo(me, mix, MyModel[mix], mi); 1071 code[2,mix]:=ModelSortValue(mi); 1072 end; 1073 Lines[0]:=MyRO.nModel; 1074 SortModels; 1075 FirstShrinkedLine[0]:=0 1076 end; 1077 kChooseModel: 1078 begin 1079 for mix:=3 to MyRO.nModel-1 do 1080 begin // check if opponent already has this model 1081 MakeModelInfo(me,mix,MyModel[mix],mi); 1082 ok:=true; 1083 for emix:=0 to MyRO.nEnemyModel-1 do 1084 if (MyRO.EnemyModel[emix].Owner=DipMem[me].pContact) 1085 and IsSameModel(MyRO.EnemyModel[emix],mi) then 1086 ok:=false; 1087 if ok then 1088 begin 1089 code[0,Lines[0]]:=mix; 1090 MakeModelInfo(me, mix, MyModel[mix], mi); 1091 code[2,Lines[0]]:=ModelSortValue(mi); 1092 inc(Lines[0]); 1093 end; 1094 end; 1095 SortModels; 1096 // if Lines[0]>1 then 1097 begin code[0,Lines[0]]:=mixAll; inc(Lines[0]); end; 1098 FirstShrinkedLine[0]:=0 1099 end; 1100 kChooseEModel: 1101 begin 1102 if MyRO.TestFlags and tfUncover<>0 then 1103 Server(sGetModels,me,0,nil^); 1104 for emix:=0 to MyRO.nEnemyModel-1 do 1105 ModelOk[emix]:= MyRO.EnemyModel[emix].Owner=DipMem[me].pContact; 1106 for mix:=0 to MyRO.nModel-1 do 1107 begin // don't list models I already have 1108 MakeModelInfo(me,mix,MyModel[mix],mi); 1109 for emix:=0 to MyRO.nEnemyModel-1 do 1110 ModelOk[emix]:=ModelOk[emix] 1111 and not IsSameModel(MyRO.EnemyModel[emix],mi); 1112 end; 1113 for emix:=0 to MyRO.nEnemyModel-1 do if ModelOk[emix] then 1114 begin 1115 if Tribe[DipMem[me].pContact].ModelPicture[MyRO.EnemyModel[emix].mix].HGr=0 then 1116 InitEnemyModel(emix); 1117 code[0,Lines[0]]:=emix; 1118 code[2,Lines[0]]:=ModelSortValue(MyRO.EnemyModel[emix]); 1119 inc(Lines[0]); 1120 end; 1121 SortModels; 1122 // if not IsMilReportNew(DipMem[me].pContact) or (Lines[0]>1) then 1123 begin code[0,Lines[0]]:=mixAll; inc(Lines[0]); end; 1124 FirstShrinkedLine[0]:=0 1125 end; 1126 kEModels: 1127 begin 1128 for i:=0 to MyRO.EnemyReport[pView].nModelCounted-1 do 1129 begin 1130 code[1,Lines[0]]:=MyRO.nEnemyModel-1; 1131 while (code[1,Lines[0]]>=0) 1132 and not ((MyRO.EnemyModel[code[1,Lines[0]]].Owner=pView) 1133 and (MyRO.EnemyModel[code[1,Lines[0]]].mix=i)) do 1134 dec(code[1,Lines[0]]); 1135 if Tribe[pView].ModelPicture[i].HGr=0 then 1136 InitEnemyModel(code[1,Lines[0]]); 1137 code[0,Lines[0]]:=i; 1138 code[2,Lines[0]]:=ModelSortValue(MyRO.EnemyModel[code[1,Lines[0]]]); 1139 inc(Lines[0]); 1140 end; 1141 SortModels; 1142 FirstShrinkedLine[0]:=0 1143 end; 1144 kAllEModels: 1145 begin 1146 if (MyRO.TestFlags and tfUncover<>0) or (G.Difficulty[me]=0) then 1147 Server(sGetModels,me,0,nil^); 1148 for emix:=0 to MyRO.nEnemyModel-1 do 1149 if (MyRO.EnemyModel[emix].mix>=3) 1150 and (MyRO.EnemyModel[emix].Kind in [mkSelfDeveloped,mkEnemyDeveloped]) then 1151 begin 1152 PPicture:=@Tribe[MyRO.EnemyModel[emix].Owner].ModelPicture[MyRO.EnemyModel[emix].mix]; 1153 if PPicture.HGr=0 then InitEnemyModel(emix); 1154 ok:=true; 1155 if MainScreen.mNames.Checked then 1156 for j:=0 to Lines[0]-1 do 1288 and (MyRO.EnemyCity[i].owner=DipMem[me].pContact) then 1289 begin code[0,Lines[0]]:=i; inc(Lines[0]); end; 1290 FirstShrinkedLine:=0 1291 end; } 1292 kModels: 1293 begin 1294 for mix := 0 to MyRO.nModel - 1 do 1295 begin 1296 code[0, mix] := mix; 1297 MakeModelInfo(me, mix, MyModel[mix], mi); 1298 code[2, mix] := ModelSortValue(mi); 1299 end; 1300 Lines[0] := MyRO.nModel; 1301 SortModels; 1302 FirstShrinkedLine[0] := 0 1303 end; 1304 kChooseModel: 1305 begin 1306 for mix := 3 to MyRO.nModel - 1 do 1307 begin // check if opponent already has this model 1308 MakeModelInfo(me, mix, MyModel[mix], mi); 1309 ok := true; 1310 for emix := 0 to MyRO.nEnemyModel - 1 do 1311 if (MyRO.EnemyModel[emix].Owner = DipMem[me].pContact) and 1312 IsSameModel(MyRO.EnemyModel[emix], mi) then 1313 ok := false; 1314 if ok then 1315 begin 1316 code[0, Lines[0]] := mix; 1317 MakeModelInfo(me, mix, MyModel[mix], mi); 1318 code[2, Lines[0]] := ModelSortValue(mi); 1319 inc(Lines[0]); 1320 end; 1321 end; 1322 SortModels; 1323 // if Lines[0]>1 then 1324 begin 1325 code[0, Lines[0]] := mixAll; 1326 inc(Lines[0]); 1327 end; 1328 FirstShrinkedLine[0] := 0 1329 end; 1330 kChooseEModel: 1331 begin 1332 if MyRO.TestFlags and tfUncover <> 0 then 1333 Server(sGetModels, me, 0, nil^); 1334 for emix := 0 to MyRO.nEnemyModel - 1 do 1335 ModelOk[emix] := MyRO.EnemyModel[emix].Owner = DipMem[me].pContact; 1336 for mix := 0 to MyRO.nModel - 1 do 1337 begin // don't list models I already have 1338 MakeModelInfo(me, mix, MyModel[mix], mi); 1339 for emix := 0 to MyRO.nEnemyModel - 1 do 1340 ModelOk[emix] := ModelOk[emix] and 1341 not IsSameModel(MyRO.EnemyModel[emix], mi); 1342 end; 1343 for emix := 0 to MyRO.nEnemyModel - 1 do 1344 if ModelOk[emix] then 1345 begin 1346 if Tribe[DipMem[me].pContact].ModelPicture 1347 [MyRO.EnemyModel[emix].mix].HGr = 0 then 1348 InitEnemyModel(emix); 1349 code[0, Lines[0]] := emix; 1350 code[2, Lines[0]] := ModelSortValue(MyRO.EnemyModel[emix]); 1351 inc(Lines[0]); 1352 end; 1353 SortModels; 1354 // if not IsMilReportNew(DipMem[me].pContact) or (Lines[0]>1) then 1355 begin 1356 code[0, Lines[0]] := mixAll; 1357 inc(Lines[0]); 1358 end; 1359 FirstShrinkedLine[0] := 0 1360 end; 1361 kEModels: 1362 begin 1363 for i := 0 to MyRO.EnemyReport[pView].nModelCounted - 1 do 1364 begin 1365 code[1, Lines[0]] := MyRO.nEnemyModel - 1; 1366 while (code[1, Lines[0]] >= 0) and 1367 not((MyRO.EnemyModel[code[1, Lines[0]]].Owner = pView) and 1368 (MyRO.EnemyModel[code[1, Lines[0]]].mix = i)) do 1369 dec(code[1, Lines[0]]); 1370 if Tribe[pView].ModelPicture[i].HGr = 0 then 1371 InitEnemyModel(code[1, Lines[0]]); 1372 code[0, Lines[0]] := i; 1373 code[2, Lines[0]] := 1374 ModelSortValue(MyRO.EnemyModel[code[1, Lines[0]]]); 1375 inc(Lines[0]); 1376 end; 1377 SortModels; 1378 FirstShrinkedLine[0] := 0 1379 end; 1380 kAllEModels: 1381 begin 1382 if (MyRO.TestFlags and tfUncover <> 0) or (G.Difficulty[me] = 0) then 1383 Server(sGetModels, me, 0, nil^); 1384 for emix := 0 to MyRO.nEnemyModel - 1 do 1385 if (MyRO.EnemyModel[emix].mix >= 3) and 1386 (MyRO.EnemyModel[emix].Kind in [mkSelfDeveloped, mkEnemyDeveloped]) 1387 then 1388 begin 1389 PPicture := @Tribe[MyRO.EnemyModel[emix].Owner].ModelPicture 1390 [MyRO.EnemyModel[emix].mix]; 1391 if PPicture.HGr = 0 then 1392 InitEnemyModel(emix); 1393 ok := true; 1394 if MainScreen.mNames.Checked then 1395 for j := 0 to Lines[0] - 1 do 1396 begin 1397 PTestPicture := @Tribe[MyRO.EnemyModel[code[0, j]].Owner] 1398 .ModelPicture[MyRO.EnemyModel[code[0, j]].mix]; 1399 if (PPicture.HGr = PTestPicture.HGr) and 1400 (PPicture.pix = PTestPicture.pix) and 1401 (ModelHash(MyRO.EnemyModel[emix]) 1402 = ModelHash(MyRO.EnemyModel[code[0, j]])) then 1403 begin 1404 code[1, j] := 1; 1405 ok := false; 1406 Break 1407 end; 1408 end; 1409 if ok then 1157 1410 begin 1158 PTestPicture:=@Tribe[MyRO.EnemyModel[code[0,j]].Owner].ModelPicture[MyRO.EnemyModel[code[0,j]].mix]; 1159 if (PPicture.HGr=PTestPicture.HGr) and (PPicture.pix=PTestPicture.pix) 1160 and (ModelHash(MyRO.EnemyModel[emix])=ModelHash(MyRO.EnemyModel[code[0,j]])) then 1161 begin code[1,j]:=1; ok:=false; Break end; 1162 end; 1163 if ok then 1164 begin 1165 code[0,Lines[0]]:=emix; 1166 code[1,Lines[0]]:=0; 1167 code[2,Lines[0]]:=ModelSortValue(MyRO.EnemyModel[emix],true); 1168 inc(Lines[0]); 1169 end 1170 end; 1171 SortModels; 1172 FirstShrinkedLine[0]:=0 1173 end; 1174 kTribe: 1175 for i:=0 to TribeNames.Count-1 do 1176 begin code[0,Lines[0]]:=i; inc(Lines[0]) end; 1177 (* kDeliver: 1178 if MyRO.Treaty[DipMem[me].pContact]<trAlliance then 1411 code[0, Lines[0]] := emix; 1412 code[1, Lines[0]] := 0; 1413 code[2, Lines[0]] := ModelSortValue(MyRO.EnemyModel[emix], true); 1414 inc(Lines[0]); 1415 end 1416 end; 1417 SortModels; 1418 FirstShrinkedLine[0] := 0 1419 end; 1420 kTribe: 1421 for i := 0 to TribeNames.Count - 1 do 1422 begin 1423 code[0, Lines[0]] := i; 1424 inc(Lines[0]) 1425 end; 1426 (* kDeliver: 1427 if MyRO.Treaty[DipMem[me].pContact]<trAlliance then 1179 1428 begin // suggest next treaty level 1180 1429 code[0,Lines[0]]:=opTreaty+MyRO.Treaty[DipMem[me].pContact]+1; 1181 1430 inc(Lines[0]); 1182 1431 end; 1183 if MyRO.Treaty[DipMem[me].pContact]=trNone then1432 if MyRO.Treaty[DipMem[me].pContact]=trNone then 1184 1433 begin // suggest peace 1185 1434 code[0,Lines[0]]:=opTreaty+trPeace; 1186 1435 inc(Lines[0]); 1187 1436 end; 1188 if MyRO.Treaty[DipMem[me].pContact]>trNone then1437 if MyRO.Treaty[DipMem[me].pContact]>trNone then 1189 1438 begin // suggest next treaty level 1190 1439 code[0,Lines[0]]:=opTreaty+MyRO.Treaty[DipMem[me].pContact]-1; 1191 1440 inc(Lines[0]); 1192 end;*) 1193 kShipPart: 1441 end; *) 1442 kShipPart: 1443 begin 1444 Lines[0] := 0; 1445 for i := 0 to nShipPart - 1 do 1446 if MyRO.Ship[me].Parts[i] > 0 then 1447 begin 1448 code[0, Lines[0]] := i; 1449 inc(Lines[0]); 1450 end; 1451 end; 1452 kEShipPart: 1453 begin 1454 Lines[0] := 0; 1455 for i := 0 to nShipPart - 1 do 1456 if MyRO.Ship[DipMem[me].pContact].Parts[i] > 0 then 1457 begin 1458 code[0, Lines[0]] := i; 1459 inc(Lines[0]); 1460 end; 1461 end; 1462 kGov: 1463 for i := 1 to nGov - 1 do 1464 if (GovPreq[i] <> preNA) and 1465 ((GovPreq[i] = preNone) or (MyRO.Tech[GovPreq[i]] >= tsApplicable)) 1466 then 1467 begin 1468 code[0, Lines[0]] := i; 1469 inc(Lines[0]) 1470 end; 1471 kMission: 1472 for i := 0 to nSpyMission - 1 do 1473 begin 1474 code[0, Lines[0]] := i; 1475 inc(Lines[0]) 1476 end; 1477 end; 1478 1479 if Kind = kProject then // test if choice fitting to one screen 1480 if Lines[0] + Lines[1] + Lines[2] <= MaxLines then 1194 1481 begin 1195 Lines[0]:=0; 1196 for i:=0 to nShipPart-1 do 1197 if MyRO.Ship[me].Parts[i]>0 then 1198 begin code[0,Lines[0]]:=i; inc(Lines[0]); end; 1199 end; 1200 kEShipPart: 1201 begin 1202 Lines[0]:=0; 1203 for i:=0 to nShipPart-1 do 1204 if MyRO.Ship[DipMem[me].pContact].Parts[i]>0 then 1205 begin code[0,Lines[0]]:=i; inc(Lines[0]); end; 1206 end; 1207 kGov: 1208 for i:=1 to nGov-1 do 1209 if (GovPreq[i]<>preNA) and ((GovPreq[i]=preNone) 1210 or (MyRO.Tech[GovPreq[i]]>=tsApplicable)) then 1211 begin code[0,Lines[0]]:=i; inc(Lines[0]) end; 1212 kMission: 1213 for i:=0 to nSpyMission-1 do 1214 begin code[0,Lines[0]]:=i; inc(Lines[0]) end; 1215 end; 1216 1217 if Kind=kProject then // test if choice fitting to one screen 1218 if Lines[0]+Lines[1]+Lines[2]<=MaxLines then 1219 begin 1220 for i:=0 to Lines[1]-1 do // add wonders to first page 1221 begin code[0,Lines[0]]:=code[1,i]; inc(Lines[0]); end; 1222 Lines[1]:=0; 1223 FirstShrinkedLine[0]:=Lines[0]; 1224 for i:=0 to Lines[2]-1 do // add models to first page 1225 begin code[0,Lines[0]]:=code[2,i]; inc(Lines[0]); end; 1226 Lines[2]:=0; 1482 for i := 0 to Lines[1] - 1 do // add wonders to first page 1483 begin 1484 code[0, Lines[0]] := code[1, i]; 1485 inc(Lines[0]); 1486 end; 1487 Lines[1] := 0; 1488 FirstShrinkedLine[0] := Lines[0]; 1489 for i := 0 to Lines[2] - 1 do // add models to first page 1490 begin 1491 code[0, Lines[0]] := code[2, i]; 1492 inc(Lines[0]); 1493 end; 1494 Lines[2] := 0; 1227 1495 end; 1228 1496 end; // InitLines … … 1230 1498 function TListDlg.OnlyChoice(TestKind: TListKind): integer; 1231 1499 begin 1232 Kind:=TestKind; 1233 InitLines; 1234 if Lines[0]=0 then result:=-2 1235 else if Lines[0]>1 then result:=-1 1236 else result:=code[0,0]; 1500 Kind := TestKind; 1501 InitLines; 1502 if Lines[0] = 0 then 1503 result := -2 1504 else if Lines[0] > 1 then 1505 result := -1 1506 else 1507 result := code[0, 0]; 1237 1508 end; 1238 1509 1239 1510 procedure TListDlg.FormShow(Sender: TObject); 1240 1511 var 1241 i: integer; 1242 begin 1243 result:=-1; 1244 Closable:=false; 1245 1246 if Kind=kTribe then 1247 begin 1248 LineDistance:=21; // looks ugly with scrollbar 1249 MaxLines:=(hMainTexture-(24+TitleHeight+NarrowFrame)) div LineDistance -1; 1512 i: integer; 1513 begin 1514 result := -1; 1515 Closable := false; 1516 1517 if Kind = kTribe then 1518 begin 1519 LineDistance := 21; // looks ugly with scrollbar 1520 MaxLines := (hMaintexture - (24 + TitleHeight + NarrowFrame)) 1521 div LineDistance - 1; 1250 1522 end 1251 else 1252 begin 1253 LineDistance:=24; 1254 MaxLines:=(hMainTexture-(24+TitleHeight+WideFrame)) div LineDistance -1; 1255 end; 1256 InitLines; 1257 1258 MultiPage:=false; 1259 for i:=1 to MaxLayer-1 do if Lines[i]>0 then MultiPage:=true; 1260 WideBottom:=MultiPage or (Kind=kScience) 1261 or not Phrases2FallenBackToEnglish 1262 and (Kind in [kProject,kAdvance,kFarAdvance]); 1263 if (Kind=kAdvance) and (MyData.FarTech<>adNone) 1264 or (Kind=kModels) or (Kind=kEModels) then 1265 TitleHeight:=WideFrame+20 1266 else TitleHeight:=WideFrame; 1267 1268 DispLines:=Lines[0]; 1269 for i:=0 to MaxLayer-1 do if Lines[i]>DispLines then DispLines:=Lines[i]; 1270 if WideBottom then 1271 begin 1272 if DispLines>MaxLines then 1273 DispLines:=MaxLines; 1274 InnerHeight:=LineDistance*(DispLines+1)+24; 1275 ClientHeight:=InnerHeight+TitleHeight+WideFrame 1523 else 1524 begin 1525 LineDistance := 24; 1526 MaxLines := (hMaintexture - (24 + TitleHeight + WideFrame)) 1527 div LineDistance - 1; 1528 end; 1529 InitLines; 1530 1531 MultiPage := false; 1532 for i := 1 to MaxLayer - 1 do 1533 if Lines[i] > 0 then 1534 MultiPage := true; 1535 WideBottom := MultiPage or (Kind = kScience) or 1536 not Phrases2FallenBackToEnglish and 1537 (Kind in [kProject, kAdvance, kFarAdvance]); 1538 if (Kind = kAdvance) and (MyData.FarTech <> adNone) or (Kind = kModels) or 1539 (Kind = kEModels) then 1540 TitleHeight := WideFrame + 20 1541 else 1542 TitleHeight := WideFrame; 1543 1544 DispLines := Lines[0]; 1545 for i := 0 to MaxLayer - 1 do 1546 if Lines[i] > DispLines then 1547 DispLines := Lines[i]; 1548 if WideBottom then 1549 begin 1550 if DispLines > MaxLines then 1551 DispLines := MaxLines; 1552 InnerHeight := LineDistance * (DispLines + 1) + 24; 1553 ClientHeight := InnerHeight + TitleHeight + WideFrame 1276 1554 end 1277 else 1278 begin 1279 if DispLines>MaxLines then 1280 DispLines:=MaxLines; 1281 InnerHeight:=LineDistance*(DispLines+1)+24; 1282 ClientHeight:=InnerHeight+TitleHeight+NarrowFrame; 1283 end; 1284 assert(ClientHeight<=hMainTexture); 1285 1286 TechNameSpace:=224; 1287 case Kind of 1288 kGov: InnerWidth:=272; 1289 kCities, kCityEvents: InnerWidth:=640-18; 1290 kTribe: 1291 if Lines[0]>MaxLines then InnerWidth:=280+GetSystemMetrics(SM_CXVSCROLL) 1292 else InnerWidth:=280; 1293 kScience: 1294 begin 1295 InnerWidth:=104-33+15+8+TechNameSpace+24*nColumn+GetSystemMetrics(SM_CXVSCROLL); 1296 if InnerWidth+2*SideFrame>640 then 1297 begin 1298 TechNameSpace:=TechNameSpace+640-InnerWidth-2*SideFrame; 1299 InnerWidth:=640-2*SideFrame 1300 end 1301 end; 1302 kAdvance,kFarAdvance: 1303 InnerWidth:=104-33+15+8+TechNameSpace+24+GetSystemMetrics(SM_CXVSCROLL); 1304 kChooseTech, kChooseETech, kStealTech: 1305 InnerWidth:=104-33+15+8+TechNameSpace+GetSystemMetrics(SM_CXVSCROLL); 1306 else InnerWidth:=363; 1307 end; 1308 ClientWidth:=InnerWidth+2*SideFrame; 1309 1310 CloseBtn.Left:=ClientWidth-38; 1311 CaptionLeft:=ToggleBtn.Left+ToggleBtn.Width; 1312 CaptionRight:=CloseBtn.Left; 1313 SetWindowPos(sb.h,0,SideFrame+InnerWidth-GetSystemMetrics(SM_CXVSCROLL), 1314 TitleHeight,GetSystemMetrics(SM_CXVSCROLL),LineDistance*DispLines+48, 1315 SWP_NOZORDER or SWP_NOREDRAW); 1316 1317 if WindowMode=wmModal then 1318 begin {center on screen} 1319 if Kind=kTribe then 1320 Left:=(Screen.Width-800)*3 div 8+130 1321 else Left:=(Screen.Width-Width) div 2; 1322 Top:=(Screen.Height-Height) div 2; 1323 if Kind=kProject then 1324 Top:=Top+48; 1325 end; 1326 1327 Layer0Btn.Visible:= MultiPage and (Lines[0]>0); 1328 Layer1Btn.Visible:= MultiPage and (Lines[1]>0); 1329 Layer2Btn.Visible:= MultiPage and (Lines[2]>0); 1330 if Kind=kProject then 1331 begin 1332 Layer0Btn.Top:=ClientHeight-31; 1333 Layer0Btn.Left:=ClientWidth div 2-(12+29); 1334 Layer0Btn.Down:=true; 1335 Layer1Btn.Top:=ClientHeight-31; 1336 Layer1Btn.Left:=ClientWidth div 2-(12-29); 1337 Layer1Btn.Down:=false; 1338 Layer2Btn.Top:=ClientHeight-31; 1339 Layer2Btn.Left:=ClientWidth div 2-12; 1340 Layer2Btn.Down:=false; 1341 end; 1342 1343 Layer:=0; 1344 Sel:=-2; 1345 ScienceNation:=-1; 1346 InitPVSB(sb,Lines[Layer]-1,DispLines); 1347 1348 OffscreenPaint; 1555 else 1556 begin 1557 if DispLines > MaxLines then 1558 DispLines := MaxLines; 1559 InnerHeight := LineDistance * (DispLines + 1) + 24; 1560 ClientHeight := InnerHeight + TitleHeight + NarrowFrame; 1561 end; 1562 assert(ClientHeight <= hMaintexture); 1563 1564 TechNameSpace := 224; 1565 case Kind of 1566 kGov: 1567 InnerWidth := 272; 1568 kCities, kCityEvents: 1569 InnerWidth := 640 - 18; 1570 kTribe: 1571 if Lines[0] > MaxLines then 1572 InnerWidth := 280 + GetSystemMetrics(SM_CXVSCROLL) 1573 else 1574 InnerWidth := 280; 1575 kScience: 1576 begin 1577 InnerWidth := 104 - 33 + 15 + 8 + TechNameSpace + 24 * nColumn + 1578 GetSystemMetrics(SM_CXVSCROLL); 1579 if InnerWidth + 2 * SideFrame > 640 then 1580 begin 1581 TechNameSpace := TechNameSpace + 640 - InnerWidth - 2 * SideFrame; 1582 InnerWidth := 640 - 2 * SideFrame 1583 end 1584 end; 1585 kAdvance, kFarAdvance: 1586 InnerWidth := 104 - 33 + 15 + 8 + TechNameSpace + 24 + 1587 GetSystemMetrics(SM_CXVSCROLL); 1588 kChooseTech, kChooseETech, kStealTech: 1589 InnerWidth := 104 - 33 + 15 + 8 + TechNameSpace + 1590 GetSystemMetrics(SM_CXVSCROLL); 1591 else 1592 InnerWidth := 363; 1593 end; 1594 ClientWidth := InnerWidth + 2 * SideFrame; 1595 1596 CloseBtn.Left := ClientWidth - 38; 1597 CaptionLeft := ToggleBtn.Left + ToggleBtn.Width; 1598 CaptionRight := CloseBtn.Left; 1599 SetWindowPos(sb.h, 0, SideFrame + InnerWidth - GetSystemMetrics(SM_CXVSCROLL), 1600 TitleHeight, GetSystemMetrics(SM_CXVSCROLL), LineDistance * DispLines + 48, 1601 SWP_NOZORDER or SWP_NOREDRAW); 1602 1603 if WindowMode = wmModal then 1604 begin { center on screen } 1605 if Kind = kTribe then 1606 Left := (Screen.Width - 800) * 3 div 8 + 130 1607 else 1608 Left := (Screen.Width - Width) div 2; 1609 Top := (Screen.Height - Height) div 2; 1610 if Kind = kProject then 1611 Top := Top + 48; 1612 end; 1613 1614 Layer0Btn.Visible := MultiPage and (Lines[0] > 0); 1615 Layer1Btn.Visible := MultiPage and (Lines[1] > 0); 1616 Layer2Btn.Visible := MultiPage and (Lines[2] > 0); 1617 if Kind = kProject then 1618 begin 1619 Layer0Btn.Top := ClientHeight - 31; 1620 Layer0Btn.Left := ClientWidth div 2 - (12 + 29); 1621 Layer0Btn.Down := true; 1622 Layer1Btn.Top := ClientHeight - 31; 1623 Layer1Btn.Left := ClientWidth div 2 - (12 - 29); 1624 Layer1Btn.Down := false; 1625 Layer2Btn.Top := ClientHeight - 31; 1626 Layer2Btn.Left := ClientWidth div 2 - 12; 1627 Layer2Btn.Down := false; 1628 end; 1629 1630 Layer := 0; 1631 Sel := -2; 1632 ScienceNation := -1; 1633 InitPVSB(sb, Lines[Layer] - 1, DispLines); 1634 1635 OffscreenPaint; 1349 1636 end; 1350 1637 1351 1638 procedure TListDlg.ShowNewContent(NewMode: integer; ListKind: TListKind); 1352 1639 var 1353 i: integer; 1354 ShowFocus, forceclose: boolean; 1355 begin 1356 forceclose:= (ListKind<>Kind) 1357 and not ((Kind=kCities) and (ListKind=kCityEvents)) 1358 and not ((Kind=kCityEvents) and (ListKind=kCities)) 1359 and not ((Kind=kModels) and (ListKind=kEModels)) 1360 and not ((Kind=kEModels) and (ListKind=kModels)); 1361 1362 Kind:=ListKind; 1363 ModalIndication:= not (Kind in MustChooseKind); 1364 case Kind of 1365 kProject: Caption:=Phrases.Lookup('TITLE_PROJECT'); 1366 kAdvance: Caption:=Phrases.Lookup('TITLE_TECHSELECT'); 1367 kFarAdvance: Caption:=Phrases.Lookup('TITLE_FARTECH'); 1368 kModels, kEModels: Caption:=Phrases.Lookup('FRMILREP'); 1369 kAllEModels: Caption:=Phrases.Lookup('TITLE_EMODELS'); 1370 kTribe: Caption:=Phrases.Lookup('TITLE_TRIBE'); 1371 kScience: Caption:=Phrases.Lookup('TITLE_SCIENCE'); 1372 kShipPart, kEShipPart: Caption:=Phrases.Lookup('TITLE_CHOOSESHIPPART'); 1373 kChooseTech, kChooseETech: Caption:=Phrases.Lookup('TITLE_CHOOSETECH'); 1374 kChooseModel, kChooseEModel: Caption:=Phrases.Lookup('TITLE_CHOOSEMODEL'); 1375 kStealTech: Caption:=Phrases.Lookup('TITLE_CHOOSETECH'); 1376 kGov: Caption:=Phrases.Lookup('TITLE_GOV'); 1377 kMission: Caption:=Phrases.Lookup('TITLE_SPYMISSION'); 1378 end; 1379 1380 case Kind of 1381 kMission: HelpContext:='SPYMISSIONS'; 1382 else HelpContext:='CONCEPTS' 1383 end; 1384 1385 if Kind=kAdvance then 1386 begin 1387 ToggleBtn.ButtonIndex:=13; 1388 ToggleBtn.Hint:=Phrases.Lookup('FARTECH') 1640 i: integer; 1641 ShowFocus, forceclose: boolean; 1642 begin 1643 forceclose := (ListKind <> Kind) and 1644 not((Kind = kCities) and (ListKind = kCityEvents)) and 1645 not((Kind = kCityEvents) and (ListKind = kCities)) and 1646 not((Kind = kModels) and (ListKind = kEModels)) and 1647 not((Kind = kEModels) and (ListKind = kModels)); 1648 1649 Kind := ListKind; 1650 ModalIndication := not(Kind in MustChooseKind); 1651 case Kind of 1652 kProject: 1653 Caption := Phrases.Lookup('TITLE_PROJECT'); 1654 kAdvance: 1655 Caption := Phrases.Lookup('TITLE_TECHSELECT'); 1656 kFarAdvance: 1657 Caption := Phrases.Lookup('TITLE_FARTECH'); 1658 kModels, kEModels: 1659 Caption := Phrases.Lookup('FRMILREP'); 1660 kAllEModels: 1661 Caption := Phrases.Lookup('TITLE_EMODELS'); 1662 kTribe: 1663 Caption := Phrases.Lookup('TITLE_TRIBE'); 1664 kScience: 1665 Caption := Phrases.Lookup('TITLE_SCIENCE'); 1666 kShipPart, kEShipPart: 1667 Caption := Phrases.Lookup('TITLE_CHOOSESHIPPART'); 1668 kChooseTech, kChooseETech: 1669 Caption := Phrases.Lookup('TITLE_CHOOSETECH'); 1670 kChooseModel, kChooseEModel: 1671 Caption := Phrases.Lookup('TITLE_CHOOSEMODEL'); 1672 kStealTech: 1673 Caption := Phrases.Lookup('TITLE_CHOOSETECH'); 1674 kGov: 1675 Caption := Phrases.Lookup('TITLE_GOV'); 1676 kMission: 1677 Caption := Phrases.Lookup('TITLE_SPYMISSION'); 1678 end; 1679 1680 case Kind of 1681 kMission: 1682 HelpContext := 'SPYMISSIONS'; 1683 else 1684 HelpContext := 'CONCEPTS' 1685 end; 1686 1687 if Kind = kAdvance then 1688 begin 1689 ToggleBtn.ButtonIndex := 13; 1690 ToggleBtn.Hint := Phrases.Lookup('FARTECH') 1389 1691 end 1390 else if Kind=kCities then1391 begin 1392 ToggleBtn.ButtonIndex:=15;1393 ToggleBtn.Hint:=Phrases.Lookup('BTN_PAGE')1692 else if Kind = kCities then 1693 begin 1694 ToggleBtn.ButtonIndex := 15; 1695 ToggleBtn.Hint := Phrases.Lookup('BTN_PAGE') 1394 1696 end 1395 else1396 begin1397 ToggleBtn.ButtonIndex:=28;1398 ToggleBtn.Hint:=Phrases.Lookup('BTN_SELECT')1399 end;1400 1401 if Kind=kAdvance then // show focus button?1402 if MyData.FarTech<>adNone then1403 ShowFocus:=true1404 1697 else 1698 begin 1699 ToggleBtn.ButtonIndex := 28; 1700 ToggleBtn.Hint := Phrases.Lookup('BTN_SELECT') 1701 end; 1702 1703 if Kind = kAdvance then // show focus button? 1704 if MyData.FarTech <> adNone then 1705 ShowFocus := true 1706 else 1405 1707 begin 1406 ShowFocus:=false;1407 for i:=0 to nAdv-1 do1408 if not (i in FutureTech) and (MyRO.Tech[i]<tsApplicable)1409 and ((AdvValue[i]<2000) or (MyRO.Tech[adMassProduction]>tsNA))1410 and ((AdvValue[i]<1000) or (MyRO.Tech[adScience]>tsNA))1411 and (Server(sSetResearch-sExecute,me,i,nil^)<rExecuted) then1412 ShowFocus:=true;1708 ShowFocus := false; 1709 for i := 0 to nAdv - 1 do 1710 if not(i in FutureTech) and (MyRO.Tech[i] < tsApplicable) and 1711 ((AdvValue[i] < 2000) or (MyRO.Tech[adMassProduction] > tsNA)) and 1712 ((AdvValue[i] < 1000) or (MyRO.Tech[adScience] > tsNA)) and 1713 (Server(sSetResearch - sExecute, me, i, nil^) < rExecuted) then 1714 ShowFocus := true; 1413 1715 end; 1414 ToggleBtn.Visible:= (Kind=kCities) and not supervising 1415 or (Kind=kAdvance) and ShowFocus 1416 or (Kind=kModels) 1417 or (Kind=kEModels); 1418 CloseBtn.Visible:= not(Kind in MustChooseKind); 1419 1420 inherited ShowNewContent(NewMode, forceclose); 1716 ToggleBtn.Visible := (Kind = kCities) and not supervising or (Kind = kAdvance) 1717 and ShowFocus or (Kind = kModels) or (Kind = kEModels); 1718 CloseBtn.Visible := not(Kind in MustChooseKind); 1719 1720 inherited ShowNewContent(NewMode, forceclose); 1421 1721 end; // ShowNewContent 1422 1722 1423 1723 procedure TListDlg.ShowNewContent_CityProject(NewMode, cix: integer); 1424 1724 begin 1425 cixProject:=cix;1426 ShowNewContent(NewMode, kProject);1725 cixProject := cix; 1726 ShowNewContent(NewMode, kProject); 1427 1727 end; 1428 1728 1429 1729 procedure TListDlg.ShowNewContent_MilReport(NewMode, p: integer); 1430 1730 begin 1431 pView:=p; 1432 if p=me then ShowNewContent(NewMode, kModels) 1433 else ShowNewContent(NewMode, kEModels) 1731 pView := p; 1732 if p = me then 1733 ShowNewContent(NewMode, kModels) 1734 else 1735 ShowNewContent(NewMode, kEModels) 1434 1736 end; 1435 1737 1436 1738 procedure TListDlg.PlayerClick(Sender: TObject); 1437 1739 begin 1438 if TComponent(Sender).Tag=me then Kind:=kModels 1439 else 1440 begin 1441 Kind:=kEModels; 1442 pView:=TComponent(Sender).Tag; 1443 end; 1444 InitLines; 1445 Sel:=-2; 1446 InitPVSB(sb,Lines[Layer]-1,DispLines); 1447 OffscreenPaint; 1448 Invalidate 1740 if TComponent(Sender).Tag = me then 1741 Kind := kModels 1742 else 1743 begin 1744 Kind := kEModels; 1745 pView := TComponent(Sender).Tag; 1746 end; 1747 InitLines; 1748 Sel := -2; 1749 InitPVSB(sb, Lines[Layer] - 1, DispLines); 1750 OffscreenPaint; 1751 Invalidate 1449 1752 end; 1450 1753 1451 1754 procedure TListDlg.ModeBtnClick(Sender: TObject); 1452 1755 begin 1453 Layer0Btn.Down:= Sender=Layer0Btn;1454 Layer1Btn.Down:= Sender=Layer1Btn;1455 Layer2Btn.Down:= Sender=Layer2Btn;1456 Layer:=TComponent(Sender).Tag;1457 1458 Sel:=-2;1459 InitPVSB(sb,Lines[Layer]-1,DispLines);1460 SmartUpdateContent1756 Layer0Btn.Down := Sender = Layer0Btn; 1757 Layer1Btn.Down := Sender = Layer1Btn; 1758 Layer2Btn.Down := Sender = Layer2Btn; 1759 Layer := TComponent(Sender).Tag; 1760 1761 Sel := -2; 1762 InitPVSB(sb, Lines[Layer] - 1, DispLines); 1763 SmartUpdateContent 1461 1764 end; 1462 1765 1463 1766 procedure TListDlg.ToggleBtnClick(Sender: TObject); 1464 1767 var 1465 p1: integer; 1466 m: TMenuItem; 1467 begin 1468 case Kind of 1469 kAdvance: 1470 begin 1471 result:=adFar; 1472 Closable:=true; 1473 Close 1474 end; 1475 kCities, kCityEvents: 1476 begin 1477 if Kind=kCities then Kind:=kCityEvents 1478 else Kind:=kCities; 1479 OffscreenPaint; 1480 Invalidate; 1481 end; 1482 kModels, kEModels: 1483 begin 1484 EmptyMenu(Popup.Items); 1485 if G.Difficulty[me]>0 then 1486 begin 1487 m:=TMenuItem.Create(Popup); 1488 m.RadioItem:=true; 1489 m.Caption:=Tribe[me].TPhrase('SHORTNAME'); 1490 m.Tag:=me; 1491 m.OnClick:=PlayerClick; 1492 if Kind=kModels then m.Checked:=true; 1493 Popup.Items.Add(m); 1494 end; 1495 for p1:=0 to nPl-1 do 1496 if (p1<>me) and (MyRO.EnemyReport[p1]<>nil) 1497 and (MyRO.EnemyReport[p1].TurnOfMilReport>=0) then 1498 begin 1499 m:=TMenuItem.Create(Popup); 1500 m.RadioItem:=true; 1501 m.Caption:=Tribe[p1].TPhrase('SHORTNAME'); 1502 m.Tag:=p1; 1503 m.OnClick:=PlayerClick; 1504 if (Kind=kEModels) and (p1=pView) then m.Checked:=true; 1505 Popup.Items.Add(m); 1506 end; 1507 Popup.Popup(Left+ToggleBtn.Left, Top+ToggleBtn.Top+ToggleBtn.Height); 1508 end 1768 p1: integer; 1769 m: TMenuItem; 1770 begin 1771 case Kind of 1772 kAdvance: 1773 begin 1774 result := adFar; 1775 Closable := true; 1776 Close 1777 end; 1778 kCities, kCityEvents: 1779 begin 1780 if Kind = kCities then 1781 Kind := kCityEvents 1782 else 1783 Kind := kCities; 1784 OffscreenPaint; 1785 Invalidate; 1786 end; 1787 kModels, kEModels: 1788 begin 1789 EmptyMenu(Popup.Items); 1790 if G.Difficulty[me] > 0 then 1791 begin 1792 m := TMenuItem.Create(Popup); 1793 m.RadioItem := true; 1794 m.Caption := Tribe[me].TPhrase('SHORTNAME'); 1795 m.Tag := me; 1796 m.OnClick := PlayerClick; 1797 if Kind = kModels then 1798 m.Checked := true; 1799 Popup.Items.Add(m); 1800 end; 1801 for p1 := 0 to nPl - 1 do 1802 if (p1 <> me) and (MyRO.EnemyReport[p1] <> nil) and 1803 (MyRO.EnemyReport[p1].TurnOfMilReport >= 0) then 1804 begin 1805 m := TMenuItem.Create(Popup); 1806 m.RadioItem := true; 1807 m.Caption := Tribe[p1].TPhrase('SHORTNAME'); 1808 m.Tag := p1; 1809 m.OnClick := PlayerClick; 1810 if (Kind = kEModels) and (p1 = pView) then 1811 m.Checked := true; 1812 Popup.Items.Add(m); 1813 end; 1814 Popup.Popup(Left + ToggleBtn.Left, Top + ToggleBtn.Top + 1815 ToggleBtn.Height); 1816 end 1509 1817 end 1510 1818 end; … … 1513 1821 Shift: TShiftState); 1514 1822 begin 1515 if (Key=VK_F2) and (Kind in [kModels,kEModels]) then // my key 1516 // !!! toggle 1517 else if (Key=VK_F3) and (Kind in [kCities,kCityEvents]) then // my key 1518 ToggleBtnClick(nil) 1519 else if ((Key=VK_ESCAPE) or (Key=VK_RETURN)) and not CloseBtn.Visible then // prevent closing 1520 else inherited 1823 if (Key = VK_F2) and (Kind in [kModels, kEModels]) then // my key 1824 // !!! toggle 1825 else if (Key = VK_F3) and (Kind in [kCities, kCityEvents]) then // my key 1826 ToggleBtnClick(nil) 1827 else if ((Key = VK_ESCAPE) or (Key = VK_RETURN)) and not CloseBtn.Visible then 1828 // prevent closing 1829 else 1830 inherited 1521 1831 end; 1522 1832 1523 1833 procedure TListDlg.EcoChange; 1524 1834 begin 1525 if Visible and (Kind=kCities) then SmartUpdateContent 1835 if Visible and (Kind = kCities) then 1836 SmartUpdateContent 1526 1837 end; 1527 1838 1528 1839 procedure TListDlg.TechChange; 1529 1840 begin 1530 if Visible and (Kind=kScience) then1531 begin 1532 FormShow(nil);1533 Invalidate;1841 if Visible and (Kind = kScience) then 1842 begin 1843 FormShow(nil); 1844 Invalidate; 1534 1845 end; 1535 1846 end; … … 1537 1848 procedure TListDlg.AddCity; 1538 1849 begin 1539 if Visible and (Kind=kCities) then1540 begin 1541 FormShow(nil);1542 Invalidate;1850 if Visible and (Kind = kCities) then 1851 begin 1852 FormShow(nil); 1853 Invalidate; 1543 1854 end; 1544 1855 end; … … 1546 1857 procedure TListDlg.RemoveUnit; 1547 1858 begin 1548 if ListDlg.Visible and (Kind=kModels) then1549 SmartUpdateContent;1859 if ListDlg.Visible and (Kind = kModels) then 1860 SmartUpdateContent; 1550 1861 end; 1551 1862 1552 1863 end. 1553 -
trunk/LocalPlayer/TechTree.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit TechTree; 4 3 … … 6 5 7 6 uses 8 ScreenTools, Messg,7 ScreenTools, Messg, 9 8 10 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, … … 21 20 procedure FormMouseUp(Sender: TObject; Button: TMouseButton; 22 21 Shift: TShiftState; X, Y: Integer); 23 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, 24 Y: Integer); 25 procedure FormKeyDown(Sender: TObject; var Key: Word; 26 Shift: TShiftState); 22 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); 23 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 27 24 procedure CloseBtnClick(Sender: TObject); 28 25 private 29 xOffset, yOffset, xDown, yDown: integer;26 xOffset, yOffset, xDown, yDown: Integer; 30 27 Image: TBitmap; 31 28 dragging: boolean; … … 43 40 44 41 const 45 BlackBorder=4; 46 LeftBorder=72; RightBorder=45; TopBorder=16; BottomBorder=48; 47 xStart=0; yStart=40; 48 xPitch=160; yPitch=90; 49 xLegend=44; yLegend=79; yLegendPitch=32; 50 51 function min(a,b: integer): integer; 52 begin 53 if a<b then 54 result:=a 55 else result:=b; 56 end; 57 58 function max(a,b: integer): integer; 59 begin 60 if a>b then 61 result:=a 62 else result:=b; 42 BlackBorder = 4; 43 LeftBorder = 72; 44 RightBorder = 45; 45 TopBorder = 16; 46 BottomBorder = 48; 47 xStart = 0; 48 yStart = 40; 49 xPitch = 160; 50 yPitch = 90; 51 xLegend = 44; 52 yLegend = 79; 53 yLegendPitch = 32; 54 55 function min(a, b: Integer): Integer; 56 begin 57 if a < b then 58 result := a 59 else 60 result := b; 61 end; 62 63 function max(a, b: Integer): Integer; 64 begin 65 if a > b then 66 result := a 67 else 68 result := b; 63 69 end; 64 70 65 71 procedure TTechTreeDlg.FormCreate(Sender: TObject); 66 72 begin 67 InitButtons;68 Image:=nil;73 InitButtons; 74 Image := nil; 69 75 end; 70 76 71 77 procedure TTechTreeDlg.FormPaint(Sender: TObject); 72 78 var 73 x,w: integer; 74 begin 75 with Canvas do 76 begin 77 // black border 78 brush.color:=$000000; 79 fillrect(rect(0,0,BlackBorder,ClientHeight)); 80 fillrect(rect(BlackBorder,0,ClientWidth-BlackBorder,BlackBorder)); 81 fillrect(rect(ClientWidth-BlackBorder,0,ClientWidth,ClientHeight)); 82 fillrect(rect(BlackBorder,ClientHeight-BlackBorder,ClientWidth-BlackBorder, 83 ClientHeight)); 84 85 // texturize empty space 86 brush.color:=$FFFFFF; 87 if xOffset>0 then 88 FillRectSeamless(Canvas,BlackBorder,BlackBorder,BlackBorder+xOffset, 89 ClientHeight-BlackBorder,-BlackBorder-xOffset,-BlackBorder-yOffset,Paper); 90 if xOffset+Image.width<ClientWidth-2*BlackBorder then 91 FillRectSeamless(Canvas,BlackBorder+xOffset+Image.width,BlackBorder, 92 ClientWidth-BlackBorder,ClientHeight-BlackBorder,-BlackBorder-xOffset, 93 -BlackBorder-yOffset,Paper); 94 x:=max(BlackBorder,BlackBorder+xOffset); 95 w:=min(BlackBorder+xOffset+Image.width,ClientWidth-BlackBorder); 96 if yOffset>0 then 97 FillRectSeamless(Canvas,x,BlackBorder,w,BlackBorder+yOffset, 98 -BlackBorder-xOffset,-BlackBorder-yOffset,Paper); 99 if yOffset+Image.height<ClientHeight-2*BlackBorder then 100 FillRectSeamless(Canvas,x,BlackBorder+yOffset+Image.height,w, 101 ClientHeight-BlackBorder,-BlackBorder-xOffset,-BlackBorder-yOffset,Paper); 79 X, w: Integer; 80 begin 81 with Canvas do 82 begin 83 // black border 84 brush.color := $000000; 85 fillrect(rect(0, 0, BlackBorder, ClientHeight)); 86 fillrect(rect(BlackBorder, 0, ClientWidth - BlackBorder, BlackBorder)); 87 fillrect(rect(ClientWidth - BlackBorder, 0, ClientWidth, ClientHeight)); 88 fillrect(rect(BlackBorder, ClientHeight - BlackBorder, 89 ClientWidth - BlackBorder, ClientHeight)); 90 91 // texturize empty space 92 brush.color := $FFFFFF; 93 if xOffset > 0 then 94 FillRectSeamless(Canvas, BlackBorder, BlackBorder, BlackBorder + xOffset, 95 ClientHeight - BlackBorder, -BlackBorder - xOffset, 96 -BlackBorder - yOffset, Paper); 97 if xOffset + Image.width < ClientWidth - 2 * BlackBorder then 98 FillRectSeamless(Canvas, BlackBorder + xOffset + Image.width, BlackBorder, 99 ClientWidth - BlackBorder, ClientHeight - BlackBorder, 100 -BlackBorder - xOffset, -BlackBorder - yOffset, Paper); 101 X := max(BlackBorder, BlackBorder + xOffset); 102 w := min(BlackBorder + xOffset + Image.width, ClientWidth - BlackBorder); 103 if yOffset > 0 then 104 FillRectSeamless(Canvas, X, BlackBorder, w, BlackBorder + yOffset, 105 -BlackBorder - xOffset, -BlackBorder - yOffset, Paper); 106 if yOffset + Image.height < ClientHeight - 2 * BlackBorder then 107 FillRectSeamless(Canvas, X, BlackBorder + yOffset + Image.height, w, 108 ClientHeight - BlackBorder, -BlackBorder - xOffset, 109 -BlackBorder - yOffset, Paper); 102 110 end; 103 BitBlt(Canvas.Handle,max(BlackBorder,BlackBorder+xOffset), 104 max(BlackBorder,BlackBorder+yOffset), 105 min(Image.width,min(Image.width+xOffset, 106 min(ClientWidth-2*BlackBorder,ClientWidth-2*BlackBorder-xOffset))), 107 min(Image.Height,min(Image.height+yOffset, 108 min(ClientHeight-2*BlackBorder,ClientHeight-2*BlackBorder-yOffset))), 109 Image.Canvas.Handle,max(0,-xOffset),max(0,-yOffset),SRCCOPY); 111 BitBlt(Canvas.Handle, max(BlackBorder, BlackBorder + xOffset), 112 max(BlackBorder, BlackBorder + yOffset), 113 min(Image.width, min(Image.width + xOffset, 114 min(ClientWidth - 2 * BlackBorder, ClientWidth - 2 * BlackBorder - xOffset)) 115 ), min(Image.height, min(Image.height + yOffset, 116 min(ClientHeight - 2 * BlackBorder, ClientHeight - 2 * BlackBorder - 117 yOffset))), Image.Canvas.Handle, max(0, -xOffset), 118 max(0, -yOffset), SRCCOPY); 110 119 end; 111 120 112 121 procedure TTechTreeDlg.FormShow(Sender: TObject); 113 122 type 114 TLine=array[0..9999,0..2] of Byte;123 TLine = array [0 .. 9999, 0 .. 2] of Byte; 115 124 var 116 x,y,ad,TexWidth,TexHeight: integer;117 s: string;118 SrcLine, DstLine: ^TLine;119 begin 120 if Image=nil then121 begin 122 Image:=TBitmap.Create;123 LoadGraphicFile(Image, HomeDir+'Help\AdvTree',gfNoGamma);124 Image.PixelFormat:=pf24bit;125 126 with Image.Canvas do125 X, Y, ad, TexWidth, TexHeight: Integer; 126 s: string; 127 SrcLine, DstLine: ^TLine; 128 begin 129 if Image = nil then 130 begin 131 Image := TBitmap.Create; 132 LoadGraphicFile(Image, HomeDir + 'Help\AdvTree', gfNoGamma); 133 Image.PixelFormat := pf24bit; 134 135 with Image.Canvas do 127 136 begin 128 // write advance names129 Font.Assign(UniFont[ftSmall]);130 Font.Color:=clBlack;131 Brush.Style:=bsClear;132 for x:=0 to (Image.width-xStart) div xPitch do133 for y:=0 to (Image.height-yStart) div yPitch do137 // write advance names 138 Font.Assign(UniFont[ftSmall]); 139 Font.color := clBlack; 140 brush.Style := bsClear; 141 for X := 0 to (Image.width - xStart) div xPitch do 142 for Y := 0 to (Image.height - yStart) div yPitch do 134 143 begin 135 ad:=Pixels[xStart+x*xPitch+10,yStart+y*yPitch-1];136 if ad and $FFFF00=0 then144 ad := Pixels[xStart + X * xPitch + 10, yStart + Y * yPitch - 1]; 145 if ad and $FFFF00 = 0 then 137 146 begin 138 s:=Phrases.Lookup('ADVANCES',ad); 139 while TextWidth(s)>112 do 140 Delete(s,Length(s),1); 141 TextOut(xStart+x*xPitch+2,yStart+y*yPitch,s); 142 Pixels[xStart+x*xPitch+10,yStart+y*yPitch-1]:=$7F007F; 147 s := Phrases.Lookup('ADVANCES', ad); 148 while TextWidth(s) > 112 do 149 Delete(s, Length(s), 1); 150 TextOut(xStart + X * xPitch + 2, yStart + Y * yPitch, s); 151 Pixels[xStart + X * xPitch + 10, yStart + Y * yPitch - 1] 152 := $7F007F; 143 153 end 144 154 end; 145 155 146 // write legend 147 TextOut(xLegend,yLegend,Phrases2.Lookup('ADVTREE_UP0')); 148 TextOut(xLegend,yLegend+yLegendPitch,Phrases2.Lookup('ADVTREE_UP1')); 149 TextOut(xLegend,yLegend+2*yLegendPitch,Phrases2.Lookup('ADVTREE_UP2')); 150 TextOut(xLegend,yLegend+3*yLegendPitch,Phrases2.Lookup('ADVTREE_GOV')); 151 TextOut(xLegend,yLegend+4*yLegendPitch,Phrases2.Lookup('ADVTREE_OTHER')); 156 // write legend 157 TextOut(xLegend, yLegend, Phrases2.Lookup('ADVTREE_UP0')); 158 TextOut(xLegend, yLegend + yLegendPitch, Phrases2.Lookup('ADVTREE_UP1')); 159 TextOut(xLegend, yLegend + 2 * yLegendPitch, 160 Phrases2.Lookup('ADVTREE_UP2')); 161 TextOut(xLegend, yLegend + 3 * yLegendPitch, 162 Phrases2.Lookup('ADVTREE_GOV')); 163 TextOut(xLegend, yLegend + 4 * yLegendPitch, 164 Phrases2.Lookup('ADVTREE_OTHER')); 152 165 end; 153 166 154 // texturize background155 TexWidth:=Paper.width;156 TexHeight:=Paper.height;157 for y:=0 to Image.height-1 do167 // texturize background 168 TexWidth := Paper.width; 169 TexHeight := Paper.height; 170 for Y := 0 to Image.height - 1 do 158 171 begin 159 SrcLine:=Paper.ScanLine[ymod TexHeight];160 DstLine:=Image.ScanLine[y];161 for x:=0 to Image.Width-1 do172 SrcLine := Paper.ScanLine[Y mod TexHeight]; 173 DstLine := Image.ScanLine[Y]; 174 for X := 0 to Image.width - 1 do 162 175 begin 163 if Cardinal((@DstLine[x])^) and $FFFFFF=$7F007F then // transparent164 DstLine[x]:=SrcLine[xmod TexWidth];176 if Cardinal((@DstLine[X])^) and $FFFFFF = $7F007F then // transparent 177 DstLine[X] := SrcLine[X mod TexWidth]; 165 178 end 166 179 end 167 180 end; 168 181 169 // fit window to image, center image in window, center window to screen 170 Width:=min(Screen.Width-40,Image.Width+LeftBorder+RightBorder+2*BlackBorder); 171 Height:=min(Screen.Height-40,Image.Height+TopBorder+BottomBorder+2*BlackBorder); 172 Left:=(Screen.Width-Width) div 2; 173 Top:=(Screen.Height-Height) div 2; 174 CloseBtn.Left:=Width-CloseBtn.Width-BlackBorder-8; 175 CloseBtn.Top:=BlackBorder+8; 176 xOffset:=(ClientWidth-Image.width+LeftBorder-RightBorder) div 2-BlackBorder; 177 yOffset:=ClientHeight-2*BlackBorder-Image.height-BottomBorder; 182 // fit window to image, center image in window, center window to screen 183 width := min(Screen.width - 40, Image.width + LeftBorder + RightBorder + 2 * 184 BlackBorder); 185 height := min(Screen.height - 40, Image.height + TopBorder + BottomBorder + 2 186 * BlackBorder); 187 Left := (Screen.width - width) div 2; 188 Top := (Screen.height - height) div 2; 189 CloseBtn.Left := width - CloseBtn.width - BlackBorder - 8; 190 CloseBtn.Top := BlackBorder + 8; 191 xOffset := (ClientWidth - Image.width + LeftBorder - RightBorder) div 2 - 192 BlackBorder; 193 yOffset := ClientHeight - 2 * BlackBorder - Image.height - BottomBorder; 178 194 end; 179 195 … … 181 197 Shift: TShiftState; X, Y: Integer); 182 198 begin 183 if Button=mbLeft then184 begin 185 dragging:=true;186 xDown:=x;187 yDown:=y;199 if Button = mbLeft then 200 begin 201 dragging := true; 202 xDown := X; 203 yDown := Y; 188 204 end 189 205 end; … … 192 208 Shift: TShiftState; X, Y: Integer); 193 209 begin 194 dragging:=false;210 dragging := false; 195 211 end; 196 212 … … 198 214 X, Y: Integer); 199 215 begin 200 if dragging then 201 begin 202 xOffset:=xOffset+x-xDown; 203 yOffset:=yOffset+y-yDown; 204 xDown:=x; 205 yDown:=y; 206 207 if xOffset>LeftBorder then 208 xOffset:=LeftBorder; 209 if xOffset<ClientWidth-2*BlackBorder-Image.width-RightBorder then 210 xOffset:=ClientWidth-2*BlackBorder-Image.width-RightBorder; 211 if yOffset>TopBorder then 212 yOffset:=TopBorder; 213 if yOffset<ClientHeight-2*BlackBorder-Image.height-BottomBorder then 214 yOffset:=ClientHeight-2*BlackBorder-Image.height-BottomBorder; 215 216 SmartInvalidate; 216 if dragging then 217 begin 218 xOffset := xOffset + X - xDown; 219 yOffset := yOffset + Y - yDown; 220 xDown := X; 221 yDown := Y; 222 223 if xOffset > LeftBorder then 224 xOffset := LeftBorder; 225 if xOffset < ClientWidth - 2 * BlackBorder - Image.width - RightBorder then 226 xOffset := ClientWidth - 2 * BlackBorder - Image.width - RightBorder; 227 if yOffset > TopBorder then 228 yOffset := TopBorder; 229 if yOffset < ClientHeight - 2 * BlackBorder - Image.height - BottomBorder 230 then 231 yOffset := ClientHeight - 2 * BlackBorder - Image.height - BottomBorder; 232 233 SmartInvalidate; 217 234 end 218 235 end; … … 221 238 Shift: TShiftState); 222 239 begin 223 if key=VK_ESCAPE then224 Close;240 if Key = VK_ESCAPE then 241 Close; 225 242 end; 226 243 227 244 procedure TTechTreeDlg.CloseBtnClick(Sender: TObject); 228 245 begin 229 Close();246 Close(); 230 247 end; 231 248 -
trunk/LocalPlayer/Term.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit Term; 4 3 … … 6 5 7 6 uses 8 Protocol,Tribes,PVSB,ClientTools,ScreenTools,BaseWin,Messg,ButtonBase, 9 10 Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Menus,ExtCtrls, 11 ButtonA,ButtonB, ButtonC, EOTButton, Area; 7 Protocol, Tribes, PVSB, ClientTools, ScreenTools, BaseWin, Messg, ButtonBase, 8 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Menus, 10 ExtCtrls, 11 ButtonA, ButtonB, ButtonC, EOTButton, Area; 12 12 13 13 const 14 WM_EOT=WM_USER; 15 16 pltsNormal=0; pltsBlink=1; 14 WM_EOT = WM_USER; 15 16 pltsNormal = 0; 17 pltsBlink = 1; 17 18 18 19 type 19 20 TMainScreen = class(TDrawDlg) 20 Timer1: TTimer;21 Timer1: TTimer; 21 22 GamePopup: TPopupMenu; 22 UnitPopup: TPopupMenu;23 mIrrigation: TMenuItem;24 mCity: TMenuItem;25 mRoad: TMenuItem;26 mMine: TMenuItem;27 mPollution: TMenuItem;28 mHome: TMenuItem;23 UnitPopup: TPopupMenu; 24 mIrrigation: TMenuItem; 25 mCity: TMenuItem; 26 mRoad: TMenuItem; 27 mMine: TMenuItem; 28 mPollution: TMenuItem; 29 mHome: TMenuItem; 29 30 mStay: TMenuItem; 30 mDisband: TMenuItem;31 mWait: TMenuItem;32 mNoOrders: TMenuItem;33 MTrans: TMenuItem;31 mDisband: TMenuItem; 32 mWait: TMenuItem; 33 mNoOrders: TMenuItem; 34 MTrans: TMenuItem; 34 35 UnitBtn: TButtonB; 35 36 mResign: TMenuItem; … … 163 164 N12: TMenuItem; 164 165 mRep14: TMenuItem; 165 procedure FormCreate(Sender:TObject); 166 procedure FormDestroy(Sender:TObject); 167 procedure Timer1Timer(Sender:TObject); 168 procedure MapBoxMouseDown(Sender:TObject;Button:TMouseButton; 169 Shift:TShiftState;x,y:integer); 170 procedure EOTClick(Sender:TObject); 171 procedure PanelBoxMouseDown(Sender:TObject;Button:TMouseButton; 172 Shift:TShiftState;x,y:integer); 173 procedure FormKeyDown(Sender:TObject;var Key:word; 174 Shift:TShiftState); 175 procedure MenuClick(Sender:TObject); 176 procedure FormResize(Sender:TObject); 166 procedure FormCreate(Sender: TObject); 167 procedure FormDestroy(Sender: TObject); 168 procedure Timer1Timer(Sender: TObject); 169 procedure MapBoxMouseDown(Sender: TObject; Button: TMouseButton; 170 Shift: TShiftState; x, y: integer); 171 procedure EOTClick(Sender: TObject); 172 procedure PanelBoxMouseDown(Sender: TObject; Button: TMouseButton; 173 Shift: TShiftState; x, y: integer); 174 procedure FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState); 175 procedure MenuClick(Sender: TObject); 176 procedure FormResize(Sender: TObject); 177 177 procedure PanelBtnClick(Sender: TObject); 178 178 procedure FormCloseQuery(Sender: TObject; var CanClose: boolean); 179 179 procedure Toggle(Sender: TObject); 180 procedure PanelBoxMouseMove(Sender: TObject; Shift: TShiftState; x,181 y: integer);180 procedure PanelBoxMouseMove(Sender: TObject; Shift: TShiftState; 181 x, y: integer); 182 182 procedure PanelBoxMouseUp(Sender: TObject; Button: TMouseButton; 183 183 Shift: TShiftState; x, y: integer); 184 procedure MapBoxMouseMove(Sender: TObject; Shift: TShiftState; x,185 y: integer);184 procedure MapBoxMouseMove(Sender: TObject; Shift: TShiftState; 185 x, y: integer); 186 186 procedure mShowClick(Sender: TObject); 187 187 procedure FormMouseDown(Sender: TObject; Button: TMouseButton; 188 188 Shift: TShiftState; x, y: integer); 189 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; x, 190 y: integer); 189 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; x, y: integer); 191 190 procedure FormMouseUp(Sender: TObject; Button: TMouseButton; 192 191 Shift: TShiftState; x, y: integer); … … 200 199 procedure mNamesClick(Sender: TObject); 201 200 procedure MapBtnClick(Sender: TObject); 202 procedure FormKeyUp(Sender: TObject; var Key: Word; 203 Shift: TShiftState); 201 procedure FormKeyUp(Sender: TObject; var Key: word; Shift: TShiftState); 204 202 procedure CreateUnitClick(Sender: TObject); 205 203 procedure mSoundOffClick(Sender: TObject); … … 217 215 public 218 216 procedure CreateParams(var p: TCreateParams); override; 219 procedure Client(Command, NewPlayer:integer;var Data);217 procedure Client(Command, NewPlayer: integer; var Data); 220 218 procedure SetAIName(p: integer; Name: string); 221 219 function ZoomToCity(Loc: integer; NextUnitOnClose: boolean = false; … … 229 227 230 228 private 231 xw,yw,xwd,ywd,xwMini,ywMini,xMidPanel,xRightPanel,xTroop,xTerrain,xMini, 232 yMini,ywmax,ywcenter,TroopLoc,TrCnt,TrRow,TrPitch,MapWidth,MapOffset, 233 MapHeight,BlinkTime,BrushLoc,EditLoc,xMouse,yMouse: integer; 229 xw, yw, xwd, ywd, xwMini, ywMini, xMidPanel, xRightPanel, xTroop, xTerrain, 230 xMini, yMini, ywmax, ywcenter, TroopLoc, TrCnt, TrRow, TrPitch, MapWidth, 231 MapOffset, MapHeight, BlinkTime, BrushLoc, EditLoc, xMouse, 232 yMouse: integer; 234 233 BrushType: Cardinal; 235 trix: array[0..63] of integer;236 AILogo: array [0..nPl-1] of TBitmap;237 Mini, Panel,TopBar: TBitmap;238 sb: TPVScrollbar;239 Closable, RepaintOnResize,Tracking,TurnComplete,Edited,GoOnPhase,234 trix: array [0 .. 63] of integer; 235 AILogo: array [0 .. nPl - 1] of TBitmap; 236 Mini, Panel, TopBar: TBitmap; 237 sb: TPVScrollbar; 238 Closable, RepaintOnResize, Tracking, TurnComplete, Edited, GoOnPhase, 240 239 HaveStrategyAdvice, FirstMovieTurn: boolean; 241 240 procedure ArrangeMidPanel; … … 246 245 procedure CopyMiniToPanel; 247 246 procedure PanelPaint; 248 procedure NextUnit(NearLoc: integer;AutoTurn:boolean);249 procedure Scroll(dx, dy: integer);250 procedure Centre(Loc: integer);251 procedure SetTroopLoc(Loc: integer);252 procedure ProcessRect(x0, y0,nx,ny,Options: integer);247 procedure NextUnit(NearLoc: integer; AutoTurn: boolean); 248 procedure Scroll(dx, dy: integer); 249 procedure Centre(Loc: integer); 250 procedure SetTroopLoc(Loc: integer); 251 procedure ProcessRect(x0, y0, nx, ny, Options: integer); 253 252 procedure PaintLoc(Loc: integer; Radius: integer = 0); 254 253 procedure PaintLoc_BeforeMove(FromLoc: integer); 255 254 procedure PaintLocTemp(Loc: integer; Style: integer = pltsNormal); 256 procedure PaintBufferToScreen(xMap, yMap,width,height: integer);255 procedure PaintBufferToScreen(xMap, yMap, width, height: integer); 257 256 procedure PaintDestination; 258 procedure SetUnFocus(uix: integer);259 function MoveUnit(dx, dy:integer; Options: integer = 0): integer;257 procedure SetUnFocus(uix: integer); 258 function MoveUnit(dx, dy: integer; Options: integer = 0): integer; 260 259 procedure MoveToLoc(Loc: integer; CheckSuicide: boolean); 261 procedure MoveOnScreen(ShowMove: TShowMove; Step0, Step1,nStep: integer;260 procedure MoveOnScreen(ShowMove: TShowMove; Step0, Step1, nStep: integer; 262 261 Restore: boolean = true); 263 procedure FocusOnLoc(Loc: integer; Options: integer = 0);262 procedure FocusOnLoc(Loc: integer; Options: integer = 0); 264 263 function EndTurn(WasSkipped: boolean = false): boolean; 265 264 procedure EndNego; 266 function IsPanelPixel(x, y: integer): boolean;265 function IsPanelPixel(x, y: integer): boolean; 267 266 procedure InitPopup(Popup: TPopupMenu); 268 267 procedure SetMapOptions; … … 272 271 procedure SetDebugMap(p: integer); 273 272 procedure SetViewpoint(p: integer); 274 function LocationOfScreenPixel(x, y: integer): integer;275 procedure SetTileSize(x, y: integer);276 procedure RectInvalidate(Left, Top,Rigth,Bottom: integer);277 procedure SmartRectInvalidate(Left, Top,Rigth,Bottom: integer);273 function LocationOfScreenPixel(x, y: integer): integer; 274 procedure SetTileSize(x, y: integer); 275 procedure RectInvalidate(Left, Top, Rigth, Bottom: integer); 276 procedure SmartRectInvalidate(Left, Top, Rigth, Bottom: integer); 278 277 procedure SaveSettings; 279 procedure OnScroll(var m: TMessage); message WM_VSCROLL;280 procedure OnEOT(var Msg: TMessage); message WM_EOT;278 procedure OnScroll(var m: TMessage); message WM_VSCROLL; 279 procedure OnEOT(var Msg: TMessage); message WM_EOT; 281 280 end; 282 281 283 282 var 284 MainScreen:TMainScreen;283 MainScreen: TMainScreen; 285 284 286 285 type 287 TTribeInfo=record288 trix: integer;289 FileName: ShortString;286 TTribeInfo = record 287 trix: integer; 288 FileName: ShortString; 290 289 end; 291 TCityNameInfo=record 292 ID: integer; 293 NewName: ShortString 294 end; 295 TModelNameInfo=record 296 mix: integer; 297 NewName: ShortString 298 end; 299 TPriceSet=Set of $00..$FF; 300 301 const 302 crImpDrag=2; 303 crFlatHand=3; 304 305 xxu=32; yyu=24; // half of unit slot size x/y 306 yyu_anchor=32; 307 xxc=32; yyc=16; // 1/2 of city slot size in x, 1/2 of ground tile size in y (=1/3 of slot) 308 309 // layout 310 TopBarHeight=41; 311 PanelHeight=168; 312 MidPanelHeight=120; // TopBarHeight+MidPanelHeight should be same as BaseWin.yUnused 313 MapCenterUp=(MidPanelHeight-TopBarHeight) div 2; 314 315 nCityType=4; 316 317 {client exclusive commands:} 318 cSetTribe=$9000;cSetNewModelPicture=$9100;cSetModelName=$9110; 319 cSetModelPicture=$9120;cSetSlaveIndex=$9131; 320 cSetCityName=$9200; 321 322 // city status flags 323 csTypeMask=$0007; csToldDelay=$0008; csResourceWeightsMask=$00F0; 324 csToldBombard=$0100; 325 326 {unit status flags} 327 usStay=$01; usWaiting=$02; usGoto=$04; usEnhance=$08; usRecover=$10; 328 usToldNoReturn=$100; 329 usPersistent=usStay or usGoto or usEnhance or usRecover or integer($FFFF0000); 330 331 {model status flags} 332 msObsolete=$1; msAllowConscripts=$2; 333 334 {additional city happened flags} 335 chTypeDel=$8000; chAllImpsMade=$4000; 336 337 adNone=$801; adFar=$802; adNexus=$803; 338 339 SpecialModelPictureCode: array[0..nSpecialModel-1] of integer= 340 (10,11,40,41,21,30,{50,51,}64,74,{71,}73); 341 342 pixSlaves=0; pixNoSlaves=1; // index of slaves in StdUnits 343 344 // icons.bmp properties 345 xSizeSmall=36; ySizeSmall=20; 346 SystemIconLines=2; // lines of system icons in icons.bmp before improvements 347 348 // save options apart from what's defined by SaveOption 349 soTellAI=30; 350 soExtraMask=$40000000; 351 352 nCityEventPriority=16; 353 CityEventPriority: array[0..nCityEventPriority-1] of integer= 354 (chDisorder,chImprovementLost,chUnitLost,chAllImpsMade,chProduction, 355 chOldWonder,chNoSettlerProd,chPopDecrease,chProductionSabotaged, 356 chNoGrowthWarning,chPollution,chTypeDel,chFounded,chSiege,chAfterCapture, 357 chPopIncrease); 358 359 CityEventSoundItem: array[0..15] of string= 360 ('CITY_DISORDER','','CITY_POPPLUS','CITY_POPMINUS','CITY_UNITLOST', 361 'CITY_IMPLOST','CITY_SABOTAGE','CITY_GROWTHNEEDSIMP','CITY_POLLUTION', 362 'CITY_SIEGE','CITY_WONDEREX','CITY_EMDELAY','CITY_FOUNDED','CITY_FOUNDED','', 363 'CITY_INVALIDTYPE'); 364 365 type 366 TPersistentData=record 367 FarTech, ToldAge, ToldModels, ToldAlive, ToldContact, ToldOwnCredibility, 368 ColdWarStart, PeaceEvaHappened: integer; 369 EnhancementJobs: TEnhancementJobs; 370 ImpOrder: array[0..nCityType-1] of TImpOrder; 371 ToldWonders: array[0..27] of TWonderInfo; 372 ToldTech: array[0..nAdv-1] of ShortInt; 373 end; 374 375 var 376 MyData: ^TPersistentData; 377 AdvIcon:array[0..nAdv-1] of integer; {icons displayed with the technologies} 378 xxt,yyt, // half of tile size x/y 379 GameMode,ClientMode,Age,UnFocus,OptionChecked,MapOptionChecked,nLostArmy, 380 ScienceSum,TaxSum,SoundPreloadDone,MarkCityLoc,HGrTerrain,HGrCities, 381 MovieSpeed: integer; 382 CityRepMask: cardinal; 383 ReceivedOffer: TOffer; 384 Buffer,SmallImp: TBitmap; 385 BlinkON,DestinationMarkON,StartRunning,StayOnTop_Ensured,supervising: boolean; 386 UnusedTribeFiles, TribeNames: tstringlist; 387 TribeOriginal: array[0..nPl-1] of boolean; 388 LostArmy: array[0..nPl*nMmax-1] of integer; 389 DipMem: array[0..nPl-1] of record 390 pContact, SentCommand, FormerTreaty: integer; 391 SentOffer: TOffer; 392 DeliveredPrices, ReceivedPrices: TPriceSet; 290 291 TCityNameInfo = record 292 ID: integer; 293 NewName: ShortString end; 294 TModelNameInfo = record mix: integer; 295 NewName: ShortString end; 296 TPriceSet = Set of $00 .. $FF; 297 298 const 299 crImpDrag = 2; 300 crFlatHand = 3; 301 302 xxu = 32; 303 yyu = 24; // half of unit slot size x/y 304 yyu_anchor = 32; 305 xxc = 32; 306 yyc = 16; // 1/2 of city slot size in x, 1/2 of ground tile size in y (=1/3 of slot) 307 308 // layout 309 TopBarHeight = 41; 310 PanelHeight = 168; 311 MidPanelHeight = 120; 312 // TopBarHeight+MidPanelHeight should be same as BaseWin.yUnused 313 MapCenterUp = (MidPanelHeight - TopBarHeight) div 2; 314 315 nCityType = 4; 316 317 { client exclusive commands: } 318 cSetTribe = $9000; 319 cSetNewModelPicture = $9100; 320 cSetModelName = $9110; 321 cSetModelPicture = $9120; 322 cSetSlaveIndex = $9131; 323 cSetCityName = $9200; 324 325 // city status flags 326 csTypeMask = $0007; 327 csToldDelay = $0008; 328 csResourceWeightsMask = $00F0; 329 csToldBombard = $0100; 330 331 { unit status flags } 332 usStay = $01; 333 usWaiting = $02; 334 usGoto = $04; 335 usEnhance = $08; 336 usRecover = $10; 337 usToldNoReturn = $100; 338 usPersistent = usStay or usGoto or usEnhance or usRecover or 339 integer($FFFF0000); 340 341 { model status flags } 342 msObsolete = $1; 343 msAllowConscripts = $2; 344 345 { additional city happened flags } 346 chTypeDel = $8000; 347 chAllImpsMade = $4000; 348 349 adNone = $801; 350 adFar = $802; 351 adNexus = $803; 352 353 SpecialModelPictureCode: array [0 .. nSpecialModel - 1] of integer = (10, 354 11, 40, 41, 21, 30, { 50,51, } 64, 74, { 71, } 73); 355 356 pixSlaves = 0; 357 pixNoSlaves = 1; // index of slaves in StdUnits 358 359 // icons.bmp properties 360 xSizeSmall = 36; 361 ySizeSmall = 20; 362 SystemIconLines = 2; 363 // lines of system icons in icons.bmp before improvements 364 365 // save options apart from what's defined by SaveOption 366 soTellAI = 30; 367 soExtraMask = $40000000; 368 369 nCityEventPriority = 16; 370 CityEventPriority: array [0 .. nCityEventPriority - 1] of integer = 371 (chDisorder, chImprovementLost, chUnitLost, chAllImpsMade, chProduction, 372 chOldWonder, chNoSettlerProd, chPopDecrease, chProductionSabotaged, 373 chNoGrowthWarning, chPollution, chTypeDel, chFounded, chSiege, 374 chAfterCapture, chPopIncrease); 375 376 CityEventSoundItem: array [0 .. 15] of string = ('CITY_DISORDER', '', 377 'CITY_POPPLUS', 'CITY_POPMINUS', 'CITY_UNITLOST', 'CITY_IMPLOST', 378 'CITY_SABOTAGE', 'CITY_GROWTHNEEDSIMP', 'CITY_POLLUTION', 'CITY_SIEGE', 379 'CITY_WONDEREX', 'CITY_EMDELAY', 'CITY_FOUNDED', 'CITY_FOUNDED', '', 380 'CITY_INVALIDTYPE'); 381 382 type 383 TPersistentData = record 384 FarTech, ToldAge, ToldModels, ToldAlive, ToldContact, ToldOwnCredibility, 385 ColdWarStart, PeaceEvaHappened: integer; 386 EnhancementJobs: TEnhancementJobs; 387 ImpOrder: array [0 .. nCityType - 1] of TImpOrder; 388 ToldWonders: array [0 .. 27] of TWonderInfo; 389 ToldTech: array [0 .. nAdv - 1] of ShortInt; 390 end; 391 392 var 393 MyData: ^TPersistentData; 394 AdvIcon: array [0 .. nAdv - 1] of integer; 395 { icons displayed with the technologies } 396 xxt, yyt, // half of tile size x/y 397 GameMode, ClientMode, Age, UnFocus, OptionChecked, MapOptionChecked, 398 nLostArmy, ScienceSum, TaxSum, SoundPreloadDone, MarkCityLoc, HGrTerrain, 399 HGrCities, MovieSpeed: integer; 400 CityRepMask: Cardinal; 401 ReceivedOffer: TOffer; 402 Buffer, SmallImp: TBitmap; 403 BlinkON, DestinationMarkON, StartRunning, StayOnTop_Ensured, 404 supervising: boolean; 405 UnusedTribeFiles, TribeNames: tstringlist; 406 TribeOriginal: array [0 .. nPl - 1] of boolean; 407 LostArmy: array [0 .. nPl * nMmax - 1] of integer; 408 DipMem: array [0 .. nPl - 1] of record pContact, SentCommand, 409 FormerTreaty: integer; 410 SentOffer: TOffer; 411 DeliveredPrices, ReceivedPrices: TPriceSet; 393 412 end; 394 413 … … 400 419 procedure InitMyModel(mix: integer; final: boolean); 401 420 402 procedure ImpImage(ca: TCanvas; x, y,iix: integer; Government: integer = -1;421 procedure ImpImage(ca: TCanvas; x, y, iix: integer; Government: integer = -1; 403 422 IsControl: boolean = false); 404 423 procedure HelpOnTerrain(Loc, NewMode: integer); 405 424 406 407 425 implementation 408 426 409 427 uses 410 Directories,IsoEngine,CityScreen,Draft,MessgEx,Select,CityType,Help, 411 UnitStat,Diplomacy,Inp,log,Diagram,NatStat,Wonders,Enhance,Nego,Battle,Rates, 428 Directories, IsoEngine, CityScreen, Draft, MessgEx, Select, CityType, Help, 429 UnitStat, Diplomacy, Inp, log, Diagram, NatStat, Wonders, Enhance, Nego, 430 Battle, Rates, 412 431 TechTree, 413 432 414 Registry,ShellAPI; 415 433 Registry, ShellAPI; 416 434 417 435 {$R *.DFM} … … 419 437 420 438 const 421 lxmax_xxx=130; 422 LeftPanelWidth=70; 423 LeftPanelWidth_Editor=46; 424 overlap=PanelHeight-MidPanelHeight; 425 yTroop=PanelHeight-83; 426 xPalace=66; yPalace=24; //120; 427 xAdvisor=108; yAdvisor=48; 428 xUnitText=80; 429 PaperShade=3; 430 BlinkOnTime=12; BlinkOffTime=6; 431 MoveTime=300; // {time for moving a unit in ms} 432 WaitAfterShowMove=32; 433 FastScrolling=false; // causes problems with overlapping windows 434 435 nBrushTypes=26; 436 BrushTypes: array[0..nBrushTypes-1] of Cardinal= 437 (fPrefStartPos,fStartPos, 438 fShore,fGrass,fTundra,fPrairie,fDesert,fSwamp,fForest,fHills,fMountains,fArctic, 439 fDeadLands,fDeadLands or fCobalt,fDeadLands or fUranium, 440 fDeadLands or fMercury,fRiver, 441 fRoad,fRR,fCanal,tiIrrigation,tiFarm,tiMine,fPoll,tiFort,tiBase); 442 443 // MoveUnit options: 444 muAutoNoWait=$0001; muAutoNext=$0002; muNoSuicideCheck=$0004; 445 446 // ProcessRect options: 447 prPaint=$0001; prAutoBounds=$0002; prInvalidate=$0004; 448 449 // FocusOnLoc options: 450 flRepaintPanel=$0001; flImmUpdate=$0002; 451 452 nSaveOption=22; 439 lxmax_xxx = 130; 440 LeftPanelWidth = 70; 441 LeftPanelWidth_Editor = 46; 442 overlap = PanelHeight - MidPanelHeight; 443 yTroop = PanelHeight - 83; 444 xPalace = 66; 445 yPalace = 24; // 120; 446 xAdvisor = 108; 447 yAdvisor = 48; 448 xUnitText = 80; 449 PaperShade = 3; 450 BlinkOnTime = 12; 451 BlinkOffTime = 6; 452 MoveTime = 300; // {time for moving a unit in ms} 453 WaitAfterShowMove = 32; 454 FastScrolling = false; // causes problems with overlapping windows 455 456 nBrushTypes = 26; 457 BrushTypes: array [0 .. nBrushTypes - 1] of Cardinal = (fPrefStartPos, 458 fStartPos, fShore, fGrass, fTundra, fPrairie, fDesert, fSwamp, fForest, 459 fHills, fMountains, fArctic, fDeadLands, fDeadLands or fCobalt, 460 fDeadLands or fUranium, fDeadLands or fMercury, fRiver, fRoad, fRR, fCanal, 461 tiIrrigation, tiFarm, tiMine, fPoll, tiFort, tiBase); 462 463 // MoveUnit options: 464 muAutoNoWait = $0001; 465 muAutoNext = $0002; 466 muNoSuicideCheck = $0004; 467 468 // ProcessRect options: 469 prPaint = $0001; 470 prAutoBounds = $0002; 471 prInvalidate = $0004; 472 473 // FocusOnLoc options: 474 flRepaintPanel = $0001; 475 flImmUpdate = $0002; 476 477 nSaveOption = 22; 453 478 454 479 var 455 Jump: array[0..nPl-1] of integer; 456 pTurn,pLogo,UnStartLoc,ToldSlavery: integer; 457 PerfFreq: int64; 458 SmallScreen, GameOK, MapValid, skipped, idle: boolean; 459 460 SaveOption: array[0..nSaveOption-1] of integer; 461 MiniColors: array[0..11,0..1] of TColor; 462 MainMap: TIsoMap; 463 CurrentMoveInfo: record 464 AfterMovePaintRadius,AfterAttackExpeller: integer; 465 DoShow,IsAlly: boolean; 466 end; 467 480 Jump: array [0 .. nPl - 1] of integer; 481 pTurn, pLogo, UnStartLoc, ToldSlavery: integer; 482 PerfFreq: int64; 483 SmallScreen, GameOK, MapValid, skipped, idle: boolean; 484 485 SaveOption: array [0 .. nSaveOption - 1] of integer; 486 MiniColors: array [0 .. 11, 0 .. 1] of TColor; 487 MainMap: TIsoMap; 488 CurrentMoveInfo: record AfterMovePaintRadius, AfterAttackExpeller: integer; 489 DoShow, IsAlly: boolean; 490 end; 468 491 469 492 function CityEventName(i: integer): string; 470 493 begin 471 if i=14 then // chAllImpsMade 472 if not Phrases2FallenBackToEnglish then 473 result:=Phrases2.Lookup('CITYEVENT_ALLIMPSMADE') 474 else result:=Phrases.Lookup('CITYEVENTS',1) 475 else result:=Phrases.Lookup('CITYEVENTS',i); 494 if i = 14 then // chAllImpsMade 495 if not Phrases2FallenBackToEnglish then 496 result := Phrases2.Lookup('CITYEVENT_ALLIMPSMADE') 497 else 498 result := Phrases.Lookup('CITYEVENTS', 1) 499 else 500 result := Phrases.Lookup('CITYEVENTS', i); 476 501 end; 477 502 478 503 procedure InitSmallImp; 479 504 const 480 cut=4;481 Sharpen=80;505 cut = 4; 506 Sharpen = 80; 482 507 type 483 TLine=array[0..99999,0..2] of Byte;484 TBuffer=array[0..99999,0..2] of integer;508 TLine = array [0 .. 99999, 0 .. 2] of Byte; 509 TBuffer = array [0 .. 99999, 0 .. 2] of integer; 485 510 var 486 sum,Cnt,dx,dy,nx,ny,ix,iy,ir,x,y,c,ch,xdivider,ydivider: integer; 487 resampled: ^TBuffer; 488 line: ^TLine; 511 sum, Cnt, dx, dy, nx, ny, ix, iy, ir, x, y, c, ch, xdivider, 512 ydivider: integer; 513 resampled: ^TBuffer; 514 line: ^TLine; 489 515 begin 490 nx:=BigImp.Width div xSizeBig *xSizeSmall; 491 ny:=BigImp.Height div ySizeBig *ySizeSmall; 492 493 // resample icons 494 GetMem(resampled,nx*ny*12); 495 FillChar(resampled^,nx*ny*12,0); 496 for ix:=0 to BigImp.Width div xSizeBig-1 do for iy:=0 to BigImp.Height div ySizeBig-1 do 497 for y:=0 to ySizeBig-2*cut-1 do 498 begin 499 ydivider:=(y*ySizeSmall div (ySizeBig-2*cut)+1)*(ySizeBig-2*cut)-y*ySizeSmall; 500 if ydivider>ySizeSmall then ydivider:=ySizeSmall; 501 line:=BigImp.ScanLine[cut+iy*ySizeBig+y]; 502 for x:=0 to xSizeBig-1 do 503 begin 504 ir:=ix*xSizeSmall+iy*nx*ySizeSmall 505 +x*xSizeSmall div xSizeBig + y*ySizeSmall div (ySizeBig-2*cut) *nx; 506 xdivider:=(x*xSizeSmall div xSizeBig+1)*xSizeBig-x*xSizeSmall; 507 if xdivider>xSizeSmall then xdivider:=xSizeSmall; 508 for ch:=0 to 2 do 509 begin 510 c:=line[ix*xSizeBig+x,ch]; 511 inc(resampled[ir,ch],c*xdivider*ydivider); 512 if xdivider<xSizeSmall then 513 inc(resampled[ir+1,ch],c*(xSizeSmall-xdivider)*ydivider); 514 if ydivider<ySizeSmall then 515 inc(resampled[ir+nx,ch],c*xdivider*(ySizeSmall-ydivider)); 516 if (xdivider<xSizeSmall) and (ydivider<ySizeSmall) then 517 inc(resampled[ir+nx+1,ch],c*(xSizeSmall-xdivider)*(ySizeSmall-ydivider)); 516 nx := BigImp.width div xSizeBig * xSizeSmall; 517 ny := BigImp.height div ySizeBig * ySizeSmall; 518 519 // resample icons 520 GetMem(resampled, nx * ny * 12); 521 FillChar(resampled^, nx * ny * 12, 0); 522 for ix := 0 to BigImp.width div xSizeBig - 1 do 523 for iy := 0 to BigImp.height div ySizeBig - 1 do 524 for y := 0 to ySizeBig - 2 * cut - 1 do 525 begin 526 ydivider := (y * ySizeSmall div (ySizeBig - 2 * cut) + 1) * 527 (ySizeBig - 2 * cut) - y * ySizeSmall; 528 if ydivider > ySizeSmall then 529 ydivider := ySizeSmall; 530 line := BigImp.ScanLine[cut + iy * ySizeBig + y]; 531 for x := 0 to xSizeBig - 1 do 532 begin 533 ir := ix * xSizeSmall + iy * nx * ySizeSmall + x * 534 xSizeSmall div xSizeBig + y * 535 ySizeSmall div (ySizeBig - 2 * cut) * nx; 536 xdivider := (x * xSizeSmall div xSizeBig + 1) * xSizeBig - x * 537 xSizeSmall; 538 if xdivider > xSizeSmall then 539 xdivider := xSizeSmall; 540 for ch := 0 to 2 do 541 begin 542 c := line[ix * xSizeBig + x, ch]; 543 inc(resampled[ir, ch], c * xdivider * ydivider); 544 if xdivider < xSizeSmall then 545 inc(resampled[ir + 1, ch], c * (xSizeSmall - xdivider) * 546 ydivider); 547 if ydivider < ySizeSmall then 548 inc(resampled[ir + nx, ch], 549 c * xdivider * (ySizeSmall - ydivider)); 550 if (xdivider < xSizeSmall) and (ydivider < ySizeSmall) then 551 inc(resampled[ir + nx + 1, ch], c * (xSizeSmall - xdivider) * 552 (ySizeSmall - ydivider)); 553 end 518 554 end 519 end 520 end; 521 522 // sharpen resampled icons 523 SmallImp.Width:=nx; SmallImp.Height:=ny;524 for y:=0 to ny-1 do555 end; 556 557 // sharpen resampled icons 558 SmallImp.width := nx; 559 SmallImp.height := ny; 560 for y := 0 to ny - 1 do 525 561 begin 526 line:=SmallImp.ScanLine[y]; 527 for x:=0 to nx-1 do 528 for ch:=0 to 2 do 529 begin 530 sum:=0; 531 Cnt:=0; 532 for dy:=-1 to 1 do 533 if ((dy>=0) or (y mod ySizeSmall>0)) and ((dy<=0) or (y mod ySizeSmall<ySizeSmall-1)) then 534 for dx:=-1 to 1 do 535 if ((dx>=0) or (x mod xSizeSmall>0)) and ((dx<=0) or (x mod xSizeSmall<xSizeSmall-1)) then 562 line := SmallImp.ScanLine[y]; 563 for x := 0 to nx - 1 do 564 for ch := 0 to 2 do 565 begin 566 sum := 0; 567 Cnt := 0; 568 for dy := -1 to 1 do 569 if ((dy >= 0) or (y mod ySizeSmall > 0)) and 570 ((dy <= 0) or (y mod ySizeSmall < ySizeSmall - 1)) then 571 for dx := -1 to 1 do 572 if ((dx >= 0) or (x mod xSizeSmall > 0)) and 573 ((dx <= 0) or (x mod xSizeSmall < xSizeSmall - 1)) then 536 574 begin 537 inc(sum,resampled[x+dx+nx*(y+dy),ch]);538 inc(Cnt);575 inc(sum, resampled[x + dx + nx * (y + dy), ch]); 576 inc(Cnt); 539 577 end; 540 sum:=((Cnt*Sharpen+800)*resampled[x+nx*y,ch]-sum*Sharpen) div (800*xSizeBig*(ySizeBig-2*cut)); 541 if sum<0 then sum:=0; 542 if sum>255 then sum:=255; 543 line[x][ch]:=sum; 578 sum := ((Cnt * Sharpen + 800) * resampled[x + nx * y, ch] - sum * 579 Sharpen) div (800 * xSizeBig * (ySizeBig - 2 * cut)); 580 if sum < 0 then 581 sum := 0; 582 if sum > 255 then 583 sum := 255; 584 line[x][ch] := sum; 544 585 end; 545 586 end; 546 FreeMem(resampled);547 //smallimp.savetofile(homedir+'smallimp.bmp'); //!!!587 FreeMem(resampled); 588 // smallimp.savetofile(homedir+'smallimp.bmp'); //!!! 548 589 end; 549 590 550 procedure ImpImage(ca: TCanvas; x, y,iix: integer; Government: integer;591 procedure ImpImage(ca: TCanvas; x, y, iix: integer; Government: integer; 551 592 IsControl: boolean); 552 593 begin 553 if Government<0 then 554 Government:=MyRO.Government; 555 if (iix=imPalace) and (Government<>gAnarchy) then 556 iix:=Government-8; 557 FrameImage(ca, BigImp, x, y, xSizeBig, ySizeBig, 558 (iix+SystemIconLines*7) mod 7*xSizeBig, 559 (iix+SystemIconLines*7) div 7*ySizeBig, IsControl); 594 if Government < 0 then 595 Government := MyRO.Government; 596 if (iix = imPalace) and (Government <> gAnarchy) then 597 iix := Government - 8; 598 FrameImage(ca, BigImp, x, y, xSizeBig, ySizeBig, (iix + SystemIconLines * 7) 599 mod 7 * xSizeBig, (iix + SystemIconLines * 7) div 7 * ySizeBig, IsControl); 560 600 end; 561 601 562 602 procedure HelpOnTerrain(Loc, NewMode: integer); 563 603 begin 564 if MyMap[Loc] and fDeadLands<>0 then 565 HelpDlg.ShowNewContent(NewMode, hkTer, 3*12) 566 else if (MyMap[Loc] and fTerrain=fForest) and IsJungle(Loc div G.lx) then 567 HelpDlg.ShowNewContent(NewMode, hkTer, fJungle + (MyMap[Loc] shr 5 and 3)*12) 568 else HelpDlg.ShowNewContent(NewMode, hkTer, 569 MyMap[Loc] and fTerrain + (MyMap[Loc] shr 5 and 3)*12); 604 if MyMap[Loc] and fDeadLands <> 0 then 605 HelpDlg.ShowNewContent(NewMode, hkTer, 3 * 12) 606 else if (MyMap[Loc] and fTerrain = fForest) and IsJungle(Loc div G.lx) then 607 HelpDlg.ShowNewContent(NewMode, hkTer, 608 fJungle + (MyMap[Loc] shr 5 and 3) * 12) 609 else 610 HelpDlg.ShowNewContent(NewMode, hkTer, MyMap[Loc] and fTerrain + 611 (MyMap[Loc] shr 5 and 3) * 12); 570 612 end; 571 613 572 573 {*** tribe management procedures ***} 614 { *** tribe management procedures *** } 574 615 575 616 function RoughCredibility(Credibility: integer): integer; 576 617 begin 577 case Credibility of 578 0..69: result:=0; 70..89: result:=1; 90..99: result:=2; 100: result:=3 end; 579 end; 580 581 procedure ChooseModelPicture(p,mix,code,Hash,Turn: integer; 582 ForceNew,final: boolean); 583 var 584 i: integer; 585 Picture: TModelPictureInfo; 586 IsNew: boolean; 587 begin 588 Picture.trix:=p; 589 Picture.mix:=mix; 590 if code=74 then 591 begin // use correct pictures for slaves 592 if Tribe[p].mixSlaves<0 then 593 if not TribeOriginal[p] then Tribe[p].mixSlaves:=mix 594 else begin i:=mix+p shl 16; Server(cSetSlaveIndex,0,0,i); end; 595 if ToldSlavery=1 then Picture.pix:=pixSlaves else Picture.pix:=pixNoSlaves; 596 Picture.Hash:=0; 597 Picture.GrName:='StdUnits'; 598 IsNew:=true; 599 end 600 else 601 begin 602 Picture.Hash:=Hash; 603 IsNew:=Tribe[p].ChooseModelPicture(Picture,code,Turn,ForceNew); 604 end; 605 if final then 606 if not TribeOriginal[p] then 607 Tribe[p].SetModelPicture(Picture, IsNew) 608 else if IsNew then 609 Server(cSetNewModelPicture+(Length(Picture.GrName)+1+16+3) div 4,0, 610 0,Picture) 611 else Server(cSetModelPicture+(Length(Picture.GrName)+1+16+3) div 4,0, 612 0,Picture) 613 else with Tribe[p].ModelPicture[mix] do 614 begin 615 HGr:=LoadGraphicSet(Picture.GrName); 616 pix:=Picture.pix; 618 case Credibility of 619 0 .. 69: 620 result := 0; 621 70 .. 89: 622 result := 1; 623 90 .. 99: 624 result := 2; 625 100: 626 result := 3 617 627 end; 618 628 end; 619 629 630 procedure ChooseModelPicture(p, mix, code, Hash, Turn: integer; 631 ForceNew, final: boolean); 632 var 633 i: integer; 634 Picture: TModelPictureInfo; 635 IsNew: boolean; 636 begin 637 Picture.trix := p; 638 Picture.mix := mix; 639 if code = 74 then 640 begin // use correct pictures for slaves 641 if Tribe[p].mixSlaves < 0 then 642 if not TribeOriginal[p] then 643 Tribe[p].mixSlaves := mix 644 else 645 begin 646 i := mix + p shl 16; 647 Server(cSetSlaveIndex, 0, 0, i); 648 end; 649 if ToldSlavery = 1 then 650 Picture.pix := pixSlaves 651 else 652 Picture.pix := pixNoSlaves; 653 Picture.Hash := 0; 654 Picture.GrName := 'StdUnits'; 655 IsNew := true; 656 end 657 else 658 begin 659 Picture.Hash := Hash; 660 IsNew := Tribe[p].ChooseModelPicture(Picture, code, Turn, ForceNew); 661 end; 662 if final then 663 if not TribeOriginal[p] then 664 Tribe[p].SetModelPicture(Picture, IsNew) 665 else if IsNew then 666 Server(cSetNewModelPicture + (Length(Picture.GrName) + 1 + 16 + 3) div 4, 667 0, 0, Picture) 668 else 669 Server(cSetModelPicture + (Length(Picture.GrName) + 1 + 16 + 3) div 4, 0, 670 0, Picture) 671 else 672 with Tribe[p].ModelPicture[mix] do 673 begin 674 HGr := LoadGraphicSet(Picture.GrName); 675 pix := Picture.pix; 676 end; 677 end; 678 620 679 function InitEnemyModel(emix: integer): boolean; 621 680 begin 622 if GameMode=cMovie then 623 begin result:=false; exit end; 624 with MyRO.EnemyModel[emix] do 625 ChooseModelPicture(Owner, mix, ModelCode(MyRO.EnemyModel[emix]), 626 ModelHash(MyRO.EnemyModel[emix]), MyRO.Turn, false, true); 627 result:=true 681 if GameMode = cMovie then 682 begin 683 result := false; 684 exit 685 end; 686 with MyRO.EnemyModel[emix] do 687 ChooseModelPicture(Owner, mix, ModelCode(MyRO.EnemyModel[emix]), 688 ModelHash(MyRO.EnemyModel[emix]), MyRO.Turn, false, true); 689 result := true 628 690 end; 629 691 630 692 procedure InitAllEnemyModels; 631 693 var 632 emix: integer;694 emix: integer; 633 695 begin 634 for emix:=0 to MyRO.nEnemyModel-1 do635 with MyRO.EnemyModel[emix] do636 if Tribe[Owner].ModelPicture[mix].HGr=0 then637 InitEnemyModel(emix);696 for emix := 0 to MyRO.nEnemyModel - 1 do 697 with MyRO.EnemyModel[emix] do 698 if Tribe[Owner].ModelPicture[mix].HGr = 0 then 699 InitEnemyModel(emix); 638 700 end; 639 701 640 702 procedure InitMyModel(mix: integer; final: boolean); 641 703 var 642 mi: TModelInfo;704 mi: TModelInfo; 643 705 begin 644 if (GameMode=cMovie) and (MyModel[mix].Kind<$08) then exit; 706 if (GameMode = cMovie) and (MyModel[mix].Kind < $08) then 707 exit; 645 708 // don't exit for special units because cSetModelPicture comes after TellNewModels 646 MakeModelInfo(me,mix,MyModel[mix],mi);647 ChooseModelPicture(me, mix, ModelCode(mi), ModelHash(mi), MyRO.Turn, false,648 final);709 MakeModelInfo(me, mix, MyModel[mix], mi); 710 ChooseModelPicture(me, mix, ModelCode(mi), ModelHash(mi), MyRO.Turn, 711 false, final); 649 712 end; 650 713 651 714 function AttackSound(code: integer): string; 652 715 begin 653 result:='ATTACK_'+char(48+code div 100 mod 10)+char(48+code div 10 mod 10) 654 +char(48+code mod 10);716 result := 'ATTACK_' + char(48 + code div 100 mod 10) + 717 char(48 + code div 10 mod 10) + char(48 + code mod 10); 655 718 end; 656 719 … … 658 721 // check whether aircraft survived low-fuel warning 659 722 begin 660 assert(not supervising);661 with MyUn[uix] do662 if (Status and usToldNoReturn<>0)663 and ((MyMap[Loc] and fCity<>0) or (MyMap[Loc] and fTerImp=tiBase)664 or (Master>=0)) then665 Status:=Status and not usToldNoReturn;723 assert(not supervising); 724 with MyUn[uix] do 725 if (Status and usToldNoReturn <> 0) and 726 ((MyMap[Loc] and fCity <> 0) or (MyMap[Loc] and fTerImp = tiBase) or 727 (Master >= 0)) then 728 Status := Status and not usToldNoReturn; 666 729 end; 667 730 668 function CreateTribe(p: integer; FileName:string; Original: boolean): boolean;731 function CreateTribe(p: integer; FileName: string; Original: boolean): boolean; 669 732 begin 670 if not FileExists(LocalizedFilePath('Tribes\'+FileName+'.tribe.txt')) then 671 begin result:=false; exit end; 672 673 TribeOriginal[p]:=Original; 674 Tribe[p]:=TTribe.Create(FileName); 675 with Tribe[p] do 733 if not FileExists(LocalizedFilePath('Tribes\' + FileName + '.tribe.txt')) then 676 734 begin 677 if (GameMode=cNewGame) or not Original then 678 begin 679 Term.ChooseModelPicture(p,0,010,1,0,true,true); 680 Term.ChooseModelPicture(p,1,040,1,0,true,true); 681 Term.ChooseModelPicture(p,2,041,1,0,true,true); 682 Term.ChooseModelPicture(p,-1,017,1,0,true,true); 683 end; 684 DipMem[p].pContact:=-1; 735 result := false; 736 exit 685 737 end; 686 result:=true; 738 739 TribeOriginal[p] := Original; 740 Tribe[p] := TTribe.Create(FileName); 741 with Tribe[p] do 742 begin 743 if (GameMode = cNewGame) or not Original then 744 begin 745 Term.ChooseModelPicture(p, 0, 010, 1, 0, true, true); 746 Term.ChooseModelPicture(p, 1, 040, 1, 0, true, true); 747 Term.ChooseModelPicture(p, 2, 041, 1, 0, true, true); 748 Term.ChooseModelPicture(p, -1, 017, 1, 0, true, true); 749 end; 750 DipMem[p].pContact := -1; 751 end; 752 result := true; 687 753 end; 688 754 689 755 procedure TellNewContacts; 690 756 var 691 p1: integer;757 p1: integer; 692 758 begin 693 if not supervising then694 for p1:=0 to nPl-1 do695 if (p1<>me) and (1 shl p1 and MyData.ToldContact=0)696 and (1 shl p1 and MyRO.Alive<>0) and (MyRO.Treaty[p1]>trNoContact) then697 begin 698 TribeMessage(p1, Tribe[p1].TPhrase('FRNEWNATION'), '');699 MyData.ToldContact:=MyData.ToldContact or (1 shl p1);759 if not supervising then 760 for p1 := 0 to nPl - 1 do 761 if (p1 <> me) and (1 shl p1 and MyData.ToldContact = 0) and 762 (1 shl p1 and MyRO.Alive <> 0) and (MyRO.Treaty[p1] > trNoContact) then 763 begin 764 TribeMessage(p1, Tribe[p1].TPhrase('FRNEWNATION'), ''); 765 MyData.ToldContact := MyData.ToldContact or (1 shl p1); 700 766 end 701 767 end; … … 703 769 procedure TellNewModels; 704 770 var 705 mix: integer;706 ModelNameInfo: TModelNameInfo;771 mix: integer; 772 ModelNameInfo: TModelNameInfo; 707 773 begin 708 if supervising then 709 exit; 710 with Tribe[me] do while MyData.ToldModels<MyRO.nModel do 711 begin {new Unit class available} 712 if (ModelPicture[MyData.ToldModels].HGr>0) 713 and (MyModel[MyData.ToldModels].Kind<>mkSelfDeveloped) then 714 begin // save picture of DevModel 715 ModelPicture[MyData.ToldModels+1]:=ModelPicture[MyData.ToldModels]; 716 ModelName[MyData.ToldModels+1]:=ModelName[MyData.ToldModels]; 717 ModelPicture[MyData.ToldModels].HGr:=0 718 end; 719 if ModelPicture[MyData.ToldModels].HGr=0 then 720 InitMyModel(MyData.ToldModels,true); {only run if no researched model} 721 with MessgExDlg do 722 begin 723 { MakeModelInfo(me,MyData.ToldModels,MyModel[MyData.ToldModels],mi); 724 if mi.Attack=0 then OpenSound:='MSG_DEFAULT' 725 else OpenSound:=AttackSound(ModelCode(mi));} 726 if MyModel[MyData.ToldModels].Kind=mkSelfDeveloped then 727 OpenSound:='NEWMODEL_'+char(48+Age); 728 MessgText:=Phrases.Lookup('MODELAVAILABLE'); 729 if GameMode=cMovie then 730 begin 731 Kind:=mkOkHelp; // doesn't matter 732 MessgText:=MessgText+'\'+ModelName[MyData.ToldModels]; 774 if supervising then 775 exit; 776 with Tribe[me] do 777 while MyData.ToldModels < MyRO.nModel do 778 begin { new Unit class available } 779 if (ModelPicture[MyData.ToldModels].HGr > 0) and 780 (MyModel[MyData.ToldModels].Kind <> mkSelfDeveloped) then 781 begin // save picture of DevModel 782 ModelPicture[MyData.ToldModels + 1] := ModelPicture[MyData.ToldModels]; 783 ModelName[MyData.ToldModels + 1] := ModelName[MyData.ToldModels]; 784 ModelPicture[MyData.ToldModels].HGr := 0 785 end; 786 if ModelPicture[MyData.ToldModels].HGr = 0 then 787 InitMyModel(MyData.ToldModels, true); 788 { only run if no researched model } 789 with MessgExDlg do 790 begin 791 { MakeModelInfo(me,MyData.ToldModels,MyModel[MyData.ToldModels],mi); 792 if mi.Attack=0 then OpenSound:='MSG_DEFAULT' 793 else OpenSound:=AttackSound(ModelCode(mi)); } 794 if MyModel[MyData.ToldModels].Kind = mkSelfDeveloped then 795 OpenSound := 'NEWMODEL_' + char(48 + Age); 796 MessgText := Phrases.Lookup('MODELAVAILABLE'); 797 if GameMode = cMovie then 798 begin 799 Kind := mkOkHelp; // doesn't matter 800 MessgText := MessgText + '\' + ModelName[MyData.ToldModels]; 801 end 802 else 803 begin 804 Kind := mkModel; 805 EInput.Text := ModelName[MyData.ToldModels]; 806 end; 807 IconKind := mikModel; 808 IconIndex := MyData.ToldModels; 809 ShowModal; 810 if (EInput.Text <> '') and (EInput.Text <> ModelName[MyData.ToldModels]) 811 then 812 begin // user renamed model 813 ModelNameInfo.mix := MyData.ToldModels; 814 ModelNameInfo.NewName := EInput.Text; 815 Server(cSetModelName + (Length(ModelNameInfo.NewName) + 1 + 4 + 3) 816 div 4, me, 0, ModelNameInfo); 817 end 818 end; 819 if MyModel[MyData.ToldModels].Kind = mkSettler then 820 begin // engineers make settlers obsolete 821 for mix := 0 to MyData.ToldModels - 1 do 822 if MyModel[mix].Kind = mkSettler then 823 MyModel[mix].Status := MyModel[mix].Status or msObsolete; 824 end; 825 inc(MyData.ToldModels) 826 end; 827 end; 828 829 procedure PaintZoomedTile(dst: TBitmap; x, y, Loc: integer); 830 831 procedure TSprite(xDst, yDst, xSrc, ySrc: integer); 832 begin 833 Sprite(dst, HGrTerrain, x + xDst, y + yDst, xxt * 2, yyt * 3, 834 1 + xSrc * (xxt * 2 + 1), 1 + ySrc * (yyt * 3 + 1)); 835 end; 836 837 procedure TSprite4(xSrc, ySrc: integer); 838 begin 839 Sprite(dst, HGrTerrain, x + xxt, y + yyt + 2, xxt * 2, yyt * 2 - 2, 840 1 + xSrc * (xxt * 2 + 1), 3 + yyt + ySrc * (yyt * 3 + 1)); 841 Sprite(dst, HGrTerrain, x + 4, y + 2 * yyt, xxt * 2 - 4, yyt * 2, 842 5 + xSrc * (xxt * 2 + 1), 1 + yyt + ySrc * (yyt * 3 + 1)); 843 Sprite(dst, HGrTerrain, x + xxt * 2, y + 2 * yyt, xxt * 2 - 4, yyt * 2, 844 1 + xSrc * (xxt * 2 + 1), 1 + yyt + ySrc * (yyt * 3 + 1)); 845 Sprite(dst, HGrTerrain, x + xxt, y + yyt * 3, xxt * 2, yyt * 2 - 2, 846 1 + xSrc * (xxt * 2 + 1), 1 + yyt + ySrc * (yyt * 3 + 1)); 847 end; 848 849 var 850 cix, ySrc, Tile: integer; 851 begin 852 Tile := MyMap[Loc]; 853 if Tile and fCity <> 0 then 854 begin 855 if MyRO.Tech[adRailroad] >= tsApplicable then 856 Tile := Tile or fRR 857 else 858 Tile := Tile or fRoad; 859 if Tile and fOwned <> 0 then 860 begin 861 cix := MyRO.nCity - 1; 862 while (cix >= 0) and (MyCity[cix].Loc <> Loc) do 863 dec(cix); 864 assert(cix >= 0); 865 if MyCity[cix].Built[imSupermarket] > 0 then 866 Tile := Tile or tiFarm 867 else 868 Tile := Tile or tiIrrigation; 869 end 870 else 871 Tile := Tile or tiIrrigation; 872 end; 873 874 if Tile and fTerrain >= fForest then 875 TSprite4(2, 2) 876 else 877 TSprite4(Tile and fTerrain, 0); 878 if Tile and fTerrain >= fForest then 879 begin 880 if (Tile and fTerrain = fForest) and IsJungle(Loc div G.lx) then 881 ySrc := 18 882 else 883 ySrc := 3 + 2 * (Tile and fTerrain - fForest); 884 TSprite(xxt, 0, 6, ySrc); 885 TSprite(0, yyt, 3, ySrc); 886 TSprite((xxt * 2), yyt, 4, ySrc + 1); 887 TSprite(xxt, (yyt * 2), 1, ySrc + 1); 888 end; 889 890 // irrigation 891 case Tile and fTerImp of 892 tiIrrigation: 893 begin 894 TSprite(xxt, 0, 0, 12); 895 TSprite(xxt * 2, yyt, 0, 12); 896 end; 897 tiFarm: 898 begin 899 TSprite(xxt, 0, 1, 12); 900 TSprite(xxt * 2, yyt, 1, 12); 733 901 end 902 end; 903 904 // river/canal/road/railroad 905 if Tile and fRiver <> 0 then 906 begin 907 TSprite(0, yyt, 2, 14); 908 TSprite(xxt, (yyt * 2), 2, 14); 909 end; 910 if Tile and fCanal <> 0 then 911 begin 912 TSprite(xxt, 0, 7, 11); 913 TSprite(xxt, 0, 3, 11); 914 TSprite(xxt * 2, yyt, 7, 11); 915 TSprite(xxt * 2, yyt, 3, 11); 916 end; 917 if Tile and fRR <> 0 then 918 begin 919 TSprite((xxt * 2), yyt, 1, 10); 920 TSprite((xxt * 2), yyt, 5, 10); 921 TSprite(xxt, (yyt * 2), 1, 10); 922 TSprite(xxt, (yyt * 2), 5, 10); 923 end 924 else if Tile and fRoad <> 0 then 925 begin 926 TSprite((xxt * 2), yyt, 8, 9); 927 TSprite((xxt * 2), yyt, 5, 9); 928 TSprite(xxt, (yyt * 2), 1, 9); 929 TSprite(xxt, (yyt * 2), 5, 9); 930 end; 931 932 if Tile and fPoll <> 0 then 933 TSprite(xxt, (yyt * 2), 6, 12); 934 935 // special 936 if Tile and (fTerrain or fSpecial) = fGrass or fSpecial1 then 937 TSprite4(2, 1) 938 else if Tile and fSpecial <> 0 then 939 if Tile and fTerrain < fForest then 940 TSprite(0, yyt, Tile and fTerrain, Tile and fSpecial shr 5) 941 else if (Tile and fTerrain = fForest) and IsJungle(Loc div G.lx) then 942 TSprite(0, yyt, 8, 17 + Tile and fSpecial shr 5) 734 943 else 735 begin 736 Kind:=mkModel; 737 EInput.Text:=ModelName[MyData.ToldModels]; 944 TSprite(0, yyt, 8, 2 + (Tile and fTerrain - fForest) * 2 + Tile and 945 fSpecial shr 5) 946 else if Tile and fDeadLands <> 0 then 947 begin 948 TSprite4(6, 2); 949 TSprite(xxt, yyt, 8, 12 + Tile shr 25 and 3); 950 end; 951 952 // other improvements 953 case Tile and fTerImp of 954 tiMine: 955 TSprite(xxt, 0, 2, 12); 956 tiFort: 957 begin 958 TSprite(xxt, 0, 7, 12); 959 TSprite(xxt, 0, 3, 12); 738 960 end; 739 IconKind:=mikModel; 740 IconIndex:=MyData.ToldModels; 741 ShowModal; 742 if (EInput.Text<>'') and (EInput.Text<>ModelName[MyData.ToldModels]) then 743 begin // user renamed model 744 ModelNameInfo.mix:=MyData.ToldModels; 745 ModelNameInfo.NewName:=EInput.Text; 746 Server(cSetModelName+(Length(ModelNameInfo.NewName)+1+4+3) div 4, 747 me,0,ModelNameInfo); 748 end 749 end; 750 if MyModel[MyData.ToldModels].kind=mkSettler then 751 begin // engineers make settlers obsolete 752 for mix:=0 to MyData.ToldModels-1 do 753 if MyModel[mix].Kind=mkSettler then 754 MyModel[mix].Status:=MyModel[mix].Status or msObsolete; 755 end; 756 inc(MyData.ToldModels) 961 tiBase: 962 TSprite(xxt, 0, 4, 12); 757 963 end; 758 964 end; 759 965 760 procedure PaintZoomedTile(dst: TBitmap; x,y,Loc: integer); 761 762 procedure TSprite(xDst, yDst, xSrc, ySrc: integer); 966 function ChooseResearch: boolean; 967 var 968 ChosenResearch: integer; 969 begin 970 if (MyData.FarTech <> adNone) and (MyRO.Tech[MyData.FarTech] >= tsApplicable) 971 then 972 MyData.FarTech := adNone; 973 repeat 974 { research complete -- select new } 975 repeat 976 ModalSelectDlg.ShowNewContent(wmModal, kAdvance); 977 if ModalSelectDlg.result < 0 then 978 begin 979 result := false; 980 exit 981 end; 982 ChosenResearch := ModalSelectDlg.result; 983 if ChosenResearch = adMilitary then 984 begin 985 DraftDlg.ShowNewContent(wmModal); 986 if DraftDlg.ModalResult <> mrOK then 987 Tribe[me].ModelPicture[MyRO.nModel].HGr := 0 988 end 989 until (ChosenResearch <> adMilitary) or (DraftDlg.ModalResult = mrOK); 990 991 if ChosenResearch = adMilitary then 992 InitMyModel(MyRO.nModel, true) 993 else if ChosenResearch = adFar then 994 begin 995 ModalSelectDlg.ShowNewContent(wmModal, kFarAdvance); 996 if ModalSelectDlg.result >= 0 then 997 if (ModalSelectDlg.result = adNone) or 998 (Server(sSetResearch - sExecute, me, ModalSelectDlg.result, nil^) < 999 rExecuted) then 1000 MyData.FarTech := ModalSelectDlg.result 1001 else 1002 begin 1003 ChosenResearch := ModalSelectDlg.result; 1004 // can be researched immediately 1005 MyData.FarTech := adNone 1006 end 1007 end; 1008 until ChosenResearch <> adFar; 1009 if ChosenResearch = adNexus then 1010 MyData.FarTech := adNexus 1011 else 1012 Server(sSetResearch, me, ChosenResearch, nil^); 1013 ListDlg.TechChange; 1014 result := true; 1015 end; 1016 1017 (* ** client function handling ** *) 1018 1019 function TMainScreen.DipCall(Command: integer): integer; 1020 var 1021 i: integer; 1022 IsTreatyDeal: boolean; 763 1023 begin 764 Sprite(dst, HGrTerrain, x+xDst, y+yDst, xxt*2, yyt*3, 1+xSrc*(xxt*2+1), 765 1+ySrc*(yyt*3+1)); 766 end; 767 768 procedure TSprite4(xSrc, ySrc: integer); 769 begin 770 Sprite(dst, HGrTerrain, x+xxt, y+yyt+2, xxt*2, yyt*2-2, 1+xSrc*(xxt*2+1), 771 3+yyt+ySrc*(yyt*3+1)); 772 Sprite(dst, HGrTerrain, x+4, y+2*yyt, xxt*2-4, yyt*2, 5+xSrc*(xxt*2+1), 773 1+yyt+ySrc*(yyt*3+1)); 774 Sprite(dst, HGrTerrain, x+xxt*2, y+2*yyt, xxt*2-4, yyt*2, 1+xSrc*(xxt*2+1), 775 1+yyt+ySrc*(yyt*3+1)); 776 Sprite(dst, HGrTerrain, x+xxt, y+yyt*3, xxt*2, yyt*2-2, 1+xSrc*(xxt*2+1), 777 1+yyt+ySrc*(yyt*3+1)); 778 end; 779 780 var 781 cix, ySrc, Tile: integer; 782 begin 783 Tile:=MyMap[Loc]; 784 if Tile and fCity<>0 then 785 begin 786 if MyRO.Tech[adRailroad]>=tsApplicable then 787 Tile:=Tile or fRR 788 else Tile:=Tile or fRoad; 789 if Tile and fOwned<>0 then 790 begin 791 cix:=MyRO.nCity-1; 792 while (cix>=0) and (MyCity[cix].Loc<>Loc) do dec(cix); 793 assert(cix>=0); 794 if MyCity[cix].Built[imSupermarket]>0 then 795 Tile:=Tile or tiFarm 796 else Tile:=Tile or tiIrrigation; 797 end 798 else Tile:=Tile or tiIrrigation; 799 end; 800 801 if Tile and fTerrain>=fForest then TSprite4(2,2) 802 else TSprite4(Tile and fTerrain,0); 803 if Tile and fTerrain>=fForest then 804 begin 805 if (Tile and fTerrain=fForest) and IsJungle(Loc div G.lx) then ySrc:=18 806 else ySrc:=3+2*(Tile and fTerrain-fForest); 807 TSprite(xxt, 0, 6, ySrc); 808 TSprite(0, yyt, 3, ySrc); 809 TSprite((xxt*2), yyt, 4, ySrc+1); 810 TSprite(xxt, (yyt*2), 1, ySrc+1); 811 end; 812 813 // irrigation 814 case Tile and fTerImp of 815 tiIrrigation: 816 begin 817 TSprite(xxt,0,0,12); 818 TSprite(xxt*2,yyt,0,12); 819 end; 820 tiFarm: 821 begin 822 TSprite(xxt,0,1,12); 823 TSprite(xxt*2,yyt,1,12); 1024 result := Server(Command, me, 0, nil^); 1025 if result >= rExecuted then 1026 begin 1027 if Command and $FF0F = scContact then 1028 begin 1029 DipMem[me].pContact := Command shr 4 and $F; 1030 NegoDlg.Initiate; 1031 DipMem[me].DeliveredPrices := []; 1032 DipMem[me].ReceivedPrices := []; 1033 end; 1034 1035 DipMem[me].SentCommand := Command; 1036 DipMem[me].FormerTreaty := MyRO.Treaty[DipMem[me].pContact]; 1037 if Command = scDipCancelTreaty then 1038 Play('CANCELTREATY') 1039 else if Command = scDipAccept then 1040 begin // remember delivered and received prices 1041 for i := 0 to ReceivedOffer.nDeliver - 1 do 1042 include(DipMem[me].ReceivedPrices, ReceivedOffer.Price[i] shr 24); 1043 for i := 0 to ReceivedOffer.nCost - 1 do 1044 include(DipMem[me].DeliveredPrices, 1045 ReceivedOffer.Price[ReceivedOffer.nDeliver + i] shr 24); 1046 IsTreatyDeal := false; 1047 for i := 0 to ReceivedOffer.nDeliver + ReceivedOffer.nCost - 1 do 1048 if ReceivedOffer.Price[i] and opMask = opTreaty then 1049 IsTreatyDeal := true; 1050 if IsTreatyDeal then 1051 Play('NEWTREATY') 1052 else 1053 Play('ACCEPTOFFER'); 1054 end; 1055 CityDlg.CloseAction := None; 1056 if G.RO[DipMem[me].pContact] <> nil then 1057 begin // close windows for next player 1058 for i := 0 to Screen.FormCount - 1 do 1059 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) 1060 then 1061 Screen.Forms[i].Close; 1062 end 1063 else 1064 begin 1065 if CityDlg.Visible then 1066 CityDlg.Close; 1067 if UnitStatDlg.Visible then 1068 UnitStatDlg.Close; 1069 end 824 1070 end 825 1071 end; 826 1072 827 // river/canal/road/railroad 828 if Tile and fRiver<>0 then 1073 function TMainScreen.OfferCall(var Offer: TOffer): integer; 1074 var 1075 i: integer; 829 1076 begin 830 TSprite(0, yyt, 2, 14); 831 TSprite(xxt, (yyt*2), 2, 14); 1077 result := Server(scDipOffer, me, 0, Offer); 1078 if result >= rExecuted then 1079 begin 1080 DipMem[me].SentCommand := scDipOffer; 1081 DipMem[me].FormerTreaty := MyRO.Treaty[DipMem[me].pContact]; 1082 DipMem[me].SentOffer := Offer; 1083 CityDlg.CloseAction := None; 1084 if G.RO[DipMem[me].pContact] <> nil then 1085 begin // close windows for next player 1086 for i := 0 to Screen.FormCount - 1 do 1087 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) 1088 then 1089 Screen.Forms[i].Close; 1090 end 1091 else 1092 begin 1093 if CityDlg.Visible then 1094 CityDlg.Close; 1095 if UnitStatDlg.Visible then 1096 UnitStatDlg.Close; 1097 end 1098 end 832 1099 end; 833 if Tile and fCanal<>0 then 1100 1101 procedure TMainScreen.SetUnFocus(uix: integer); 1102 var 1103 Loc0: integer; 834 1104 begin 835 TSprite(xxt, 0, 7, 11); 836 TSprite(xxt, 0, 3, 11); 837 TSprite(xxt*2,yyt,7,11); 838 TSprite(xxt*2,yyt,3,11); 839 end; 840 if Tile and fRR<>0 then 841 begin 842 TSprite((xxt*2), yyt, 1, 10); 843 TSprite((xxt*2), yyt, 5, 10); 844 TSprite(xxt, (yyt*2), 1, 10); 845 TSprite(xxt, (yyt*2), 5, 10); 846 end 847 else if Tile and fRoad<>0 then 848 begin 849 TSprite((xxt*2), yyt, 8, 9); 850 TSprite((xxt*2), yyt, 5, 9); 851 TSprite(xxt, (yyt*2), 1, 9); 852 TSprite(xxt, (yyt*2), 5, 9); 853 end; 854 855 if Tile and fPoll<>0 then 856 TSprite(xxt,(yyt*2),6,12); 857 858 // special 859 if Tile and (fTerrain or fSpecial)=fGrass or fSpecial1 then 860 TSprite4(2,1) 861 else if Tile and fSpecial<>0 then 862 if Tile and fTerrain<fForest then 863 TSprite(0, yyt, Tile and fTerrain, Tile and fSpecial shr 5) 864 else if (Tile and fTerrain=fForest) and IsJungle(Loc div G.lx) then 865 TSprite(0, yyt, 8, 17+Tile and fSpecial shr 5) 866 else TSprite(0, yyt, 8, 2+(Tile and fTerrain-fForest)*2+Tile and fSpecial shr 5) 867 else if Tile and fDeadLands<>0 then 868 begin 869 TSprite4(6,2); 870 TSprite(xxt, yyt, 8, 12+Tile shr 25 and 3); 871 end; 872 873 // other improvements 874 case Tile and fTerImp of 875 tiMine: TSprite(xxt, 0, 2, 12); 876 tiFort: begin TSprite(xxt, 0, 7, 12); TSprite(xxt, 0, 3, 12); end; 877 tiBase: TSprite(xxt, 0, 4, 12); 878 end; 879 end; 880 881 function ChooseResearch: boolean; 882 var 883 ChosenResearch: integer; 884 begin 885 if (MyData.FarTech<>adNone) and (MyRO.Tech[MyData.FarTech]>=tsApplicable) then 886 MyData.FarTech:=adNone; 887 repeat 888 {research complete -- select new} 889 repeat 890 ModalSelectDlg.ShowNewContent(wmModal,kAdvance); 891 if ModalSelectDlg.result<0 then 892 begin result:=false; exit end; 893 ChosenResearch:=ModalSelectDlg.result; 894 if ChosenResearch=adMilitary then 895 begin 896 DraftDlg.ShowNewContent(wmModal); 897 if DraftDlg.ModalResult<>mrOK then 898 Tribe[me].ModelPicture[MyRO.nModel].HGr:=0 899 end 900 until (ChosenResearch<>adMilitary) or (DraftDlg.ModalResult=mrOK); 901 902 if ChosenResearch=adMilitary then InitMyModel(MyRO.nModel,true) 903 else if ChosenResearch=adFar then 904 begin 905 ModalSelectDlg.ShowNewContent(wmModal,kFarAdvance); 906 if ModalSelectDlg.result>=0 then 907 if (ModalSelectDlg.Result=adNone) or 908 (Server(sSetResearch-sExecute,me,ModalSelectDlg.Result,nil^)<rExecuted) then 909 MyData.FarTech:=ModalSelectDlg.result 910 else 911 begin 912 ChosenResearch:=ModalSelectDlg.result; // can be researched immediately 913 MyData.FarTech:=adNone 914 end 915 end; 916 until ChosenResearch<>adFar; 917 if ChosenResearch=adNexus then MyData.FarTech:=adNexus 918 else Server(sSetResearch,me,ChosenResearch,nil^); 919 ListDlg.TechChange; 920 result:=true; 921 end; 922 923 924 (*** client function handling ***) 925 926 function TMainScreen.DipCall(Command: integer): integer; 927 var 928 i: integer; 929 IsTreatyDeal: boolean; 930 begin 931 result:=Server(Command,me,0,nil^); 932 if result>=rExecuted then 933 begin 934 if Command and $FF0F=scContact then 935 begin 936 DipMem[me].pContact:=Command shr 4 and $f; 937 NegoDlg.Initiate; 938 DipMem[me].DeliveredPrices:=[]; 939 DipMem[me].ReceivedPrices:=[]; 940 end; 941 942 DipMem[me].SentCommand:=Command; 943 DipMem[me].FormerTreaty:=MyRO.Treaty[DipMem[me].pContact]; 944 if Command=scDipCancelTreaty then Play('CANCELTREATY') 945 else if Command=scDipAccept then 946 begin // remember delivered and received prices 947 for i:=0 to ReceivedOffer.nDeliver-1 do 948 include(DipMem[me].ReceivedPrices,ReceivedOffer.Price[i] shr 24); 949 for i:=0 to ReceivedOffer.nCost-1 do 950 include(DipMem[me].DeliveredPrices, 951 ReceivedOffer.Price[ReceivedOffer.nDeliver+i] shr 24); 952 IsTreatyDeal:=false; 953 for i:=0 to ReceivedOffer.nDeliver+ReceivedOffer.nCost-1 do 954 if ReceivedOffer.Price[i] and opMask=opTreaty then 955 IsTreatyDeal:=true; 956 if IsTreatyDeal then Play('NEWTREATY') 957 else Play('ACCEPTOFFER'); 958 end; 959 CityDlg.CloseAction:=None; 960 if G.RO[DipMem[me].pContact]<>nil then 961 begin // close windows for next player 962 for i:=0 to Screen.FormCount-1 do 963 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then 964 Screen.Forms[i].Close; 965 end 966 else 967 begin 968 if CityDlg.Visible then CityDlg.Close; 969 if UnitStatDlg.Visible then UnitStatDlg.Close; 970 end 971 end 972 end; 973 974 function TMainScreen.OfferCall(var Offer: TOffer): integer; 975 var 976 i: integer; 977 begin 978 result:=Server(scDipOffer,me,0,Offer); 979 if result>=rExecuted then 980 begin 981 DipMem[me].SentCommand:=scDipOffer; 982 DipMem[me].FormerTreaty:=MyRO.Treaty[DipMem[me].pContact]; 983 DipMem[me].SentOffer:=Offer; 984 CityDlg.CloseAction:=None; 985 if G.RO[DipMem[me].pContact]<>nil then 986 begin // close windows for next player 987 for i:=0 to Screen.FormCount-1 do 988 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then 989 Screen.Forms[i].Close; 990 end 991 else 992 begin 993 if CityDlg.Visible then CityDlg.Close; 994 if UnitStatDlg.Visible then UnitStatDlg.Close; 995 end 996 end 997 end; 998 999 procedure TMainScreen.SetUnFocus(uix:integer); 1000 var 1001 Loc0: integer; 1002 begin 1003 assert(not ((uix>=0) and supervising)); 1004 if uix<>UnFocus then 1005 begin 1006 DestinationMarkON:=false; 1007 PaintDestination; 1008 if uix>=0 then UnStartLoc:=MyUn[uix].Loc; 1009 BlinkON:=false; 1010 BlinkTime:=-1; 1011 if UnFocus>=0 then 1012 begin 1013 Loc0:=MyUn[UnFocus].Loc; 1014 if (uix<0) or (Loc0<>MyUn[uix].Loc) then 1015 begin 1016 UnFocus:=-1; 1017 PaintLoc(Loc0); 1018 end 1019 end; 1020 UnFocus:=uix; 1021 end; 1022 UnitInfoBtn.Visible:= UnFocus>=0; 1023 UnitBtn.Visible:= UnFocus>=0; 1024 CheckTerrainBtnVisible; 1025 end; 1026 1027 procedure TMainScreen.CheckTerrainBtnVisible; 1028 var 1029 Tile: integer; 1030 mox: ^TModel; 1031 begin 1032 if UnFocus>=0 then 1033 begin 1034 mox:=@MyModel[MyUn[UnFocus].mix]; 1035 Tile:=MyMap[MyUn[UnFocus].Loc]; 1036 TerrainBtn.Visible:= (Tile and fCity=0) and (MyUn[UnFocus].Master<0) 1037 and ((mox.Kind=mkSettler) or (mox.Kind=mkSlaves) and (MyRO.Wonder[woPyramids].EffectiveOwner>=0)); 1038 end 1039 else TerrainBtn.Visible:=false; 1040 end; 1041 1042 procedure TMainScreen.CheckMovieSpeedBtnState; 1043 begin 1044 if GameMode=cMovie then 1045 begin 1046 MovieSpeed1Btn.Down:= MovieSpeed=1; 1047 MovieSpeed1Btn.Visible:=true; 1048 MovieSpeed2Btn.Down:= MovieSpeed=2; 1049 MovieSpeed2Btn.Visible:=true; 1050 MovieSpeed3Btn.Down:= MovieSpeed=3; 1051 MovieSpeed3Btn.Visible:=true; 1052 MovieSpeed4Btn.Down:= MovieSpeed=4; 1053 MovieSpeed4Btn.Visible:=true; 1054 end 1055 else 1056 begin 1057 MovieSpeed1Btn.Visible:=false; 1058 MovieSpeed2Btn.Visible:=false; 1059 MovieSpeed3Btn.Visible:=false; 1060 MovieSpeed4Btn.Visible:=false; 1061 end 1062 end; 1063 1064 procedure TMainScreen.SetMapOptions; 1065 begin 1066 IsoEngine.Options:=MapOptionChecked; 1067 if ClientMode=cEditMap then 1068 IsoEngine.Options:=IsoEngine.Options or (1 shl moEditMode); 1069 if mLocCodes.Checked then 1070 IsoEngine.Options:=IsoEngine.Options or (1 shl moLocCodes); 1071 end; 1072 1073 procedure TMainScreen.UpdateViews(UpdateCityScreen: boolean); 1074 begin 1075 SumCities(TaxSum,ScienceSum); 1076 PanelPaint; // TopBar was enough!!! 1077 ListDlg.EcoChange; 1078 NatStatDlg.EcoChange; 1079 if UpdateCityScreen then 1080 CityDlg.SmartUpdateContent; 1081 end; 1082 1083 procedure TMainScreen.SetAIName(p: integer; Name: string); 1084 begin 1085 if Name='' then 1086 begin 1087 if AILogo[p]<>nil then 1088 begin AILogo[p].free; AILogo[p]:=nil end 1089 end 1090 else 1091 begin 1092 if AILogo[p]=nil then 1093 AILogo[p]:=TBitmap.Create; 1094 if not LoadGraphicFile(AILogo[p], HomeDir+Name, gfNoError) then 1095 begin AILogo[p].free; AILogo[p]:=nil end 1096 end 1097 end; 1098 1099 function TMainScreen.ContactRefused(p: integer; Item: String): boolean; 1100 // return whether treaty was cancelled 1101 var 1102 s: string; 1103 begin 1104 assert(MyRO.Treaty[p]>=trPeace); 1105 s:=Tribe[p].TPhrase(Item); 1106 if MyRO.Turn<MyRO.LastCancelTreaty[p]+CancelTreatyTurns then 1107 begin 1108 SimpleMessage(s); 1109 result:=false; 1110 end 1111 else 1112 begin 1113 case MyRO.Treaty[p] of 1114 trPeace: s:=s+' '+Phrases.Lookup('FRCANCELQUERY_PEACE'); 1115 trFriendlyContact: s:=s+' '+Phrases.Lookup('FRCANCELQUERY_FRIENDLY'); 1116 trAlliance: s:=s+' '+Phrases.Lookup('FRCANCELQUERY_ALLIANCE'); 1117 end; 1118 result:= SimpleQuery(mkYesNo,s,'NEGO_REJECTED')=mrOK; 1119 if result then 1120 begin 1121 Play('CANCELTREATY'); 1122 Server(sCancelTreaty,me,0,nil^); 1123 if MyRO.Treaty[p]=trNone then 1124 CityOptimizer_BeginOfTurn; // peace treaty was cancelled -- use formerly forbidden tiles 1125 MapValid:=false; 1126 PaintAllMaps; 1127 end 1128 end 1129 end; 1130 1131 procedure TMainScreen.RememberPeaceViolation; 1132 var 1133 uix,p1: integer; 1134 begin 1135 MyData.PeaceEvaHappened:=0; 1136 for uix:=0 to MyRO.nUn-1 do with MyUn[uix] do if Loc>=0 then 1137 begin 1138 p1:=MyRO.Territory[Loc]; 1139 if (p1<>me) and (p1>=0) and (MyRO.Turn=MyRO.EvaStart[p1]+(PeaceEvaTurns-1)) then 1140 MyData.PeaceEvaHappened:=MyData.PeaceEvaHappened or (1 shl p1); 1141 end; 1142 end; 1143 1144 procedure TMainScreen.Client(Command,NewPlayer:integer;var Data); 1145 1146 procedure GetTribeList; 1147 var 1148 SearchRec: TSearchRec; 1149 Color: TColor; 1150 Name: string; 1151 ok: boolean; 1152 begin 1153 UnusedTribeFiles.Clear; 1154 ok:= FindFirst(DataDir+'Localization\'+'Tribes\*.tribe.txt', 1155 faArchive+faReadOnly,SearchRec)=0; 1156 if not ok then 1157 begin 1158 FindClose(SearchRec); 1159 ok:= FindFirst(HomeDir+'Tribes\*.tribe.txt', 1160 faArchive+faReadOnly,SearchRec)=0; 1161 end; 1162 if ok then 1163 repeat 1164 SearchRec.Name:=Copy(SearchRec.Name,1,Length(SearchRec.Name)-10); 1165 if GetTribeInfo(SearchRec.Name,Name,Color) then 1166 UnusedTribeFiles.AddObject(SearchRec.Name, TObject(Color)); 1167 until FindNext(SearchRec)<>0; 1168 FindClose(SearchRec); 1169 end; 1170 1171 function ChooseUnusedTribe: integer; 1172 var 1173 i,j,ColorDistance, BestColorDistance, TestColorDistance, CountBest: integer; 1174 begin 1175 Assert(UnusedTribeFiles.Count>0); 1176 result:=-1; 1177 BestColorDistance:=-1; 1178 for j:=0 to UnusedTribeFiles.Count-1 do 1179 begin 1180 ColorDistance:=250; // consider differences more than this infinite 1181 for i:=0 to nPl-1 do if Tribe[i]<>nil then 1182 begin 1183 TestColorDistance:=abs(integer(UnusedTribeFiles.Objects[j]) shr 16 and $FF - Tribe[i].Color shr 16 and $FF) 1184 +abs(integer(UnusedTribeFiles.Objects[j]) shr 8 and $FF - Tribe[i].Color shr 8 and $FF)*3 1185 +abs(integer(UnusedTribeFiles.Objects[j]) and $FF - Tribe[i].Color and $FF)*2; 1186 if TestColorDistance<ColorDistance then 1187 ColorDistance:=TestColorDistance 1188 end; 1189 if ColorDistance>BestColorDistance then 1190 begin CountBest:=0; BestColorDistance:=ColorDistance end; 1191 if ColorDistance=BestColorDistance then 1192 begin inc(CountBest); if random(CountBest)=0 then result:=j end 1193 end; 1194 end; 1195 1196 procedure ShowEnemyShipChange(ShowShipChange: TShowShipChange); 1197 var 1198 i,TestCost,MostCost: integer; 1199 Ship1Plus,Ship2Plus: boolean; 1200 begin 1201 with ShowShipChange, MessgExDlg do 1202 begin 1203 case Reason of 1204 scrProduction: 1205 begin 1206 OpenSound:='SHIP_BUILT'; 1207 MessgText:=Tribe[Ship1Owner].TPhrase('SHIPBUILT'); 1208 IconKind:=mikShip; 1209 IconIndex:=Ship1Owner; 1210 end; 1211 1212 scrDestruction: 1213 begin 1214 OpenSound:='SHIP_DESTROYED'; 1215 MessgText:=Tribe[Ship1Owner].TPhrase('SHIPDESTROYED'); 1216 IconKind:=mikImp; 1217 end; 1218 1219 scrTrade: 1220 begin 1221 OpenSound:='SHIP_TRADED'; 1222 Ship1Plus:=false; 1223 Ship2Plus:=false; 1224 for i:=0 to nShipPart-1 do 1225 begin 1226 if Ship1Change[i]>0 then Ship1Plus:=true; 1227 if Ship2Change[i]>0 then Ship2Plus:=true; 1228 end; 1229 if Ship1Plus and Ship2Plus then 1230 MessgText:=Tribe[Ship1Owner].TPhrase('SHIPBITRADE1') 1231 +' '+Tribe[Ship2Owner].TPhrase('SHIPBITRADE2') 1232 else if Ship1Plus then 1233 MessgText:=Tribe[Ship1Owner].TPhrase('SHIPUNITRADE1') 1234 +' '+Tribe[Ship2Owner].TPhrase('SHIPUNITRADE2') 1235 else //if Ship2Plus then 1236 MessgText:=Tribe[Ship2Owner].TPhrase('SHIPUNITRADE1') 1237 +' '+Tribe[Ship1Owner].TPhrase('SHIPUNITRADE2'); 1238 IconKind:=mikImp; 1239 end; 1240 1241 scrCapture: 1242 begin 1243 OpenSound:='SHIP_CAPTURED'; 1244 MessgText:=Tribe[Ship2Owner].TPhrase('SHIPCAPTURE1') 1245 +' '+Tribe[Ship1Owner].TPhrase('SHIPCAPTURE2'); 1246 IconKind:=mikShip; 1247 IconIndex:=Ship2Owner; 1105 assert(not((uix >= 0) and supervising)); 1106 if uix <> UnFocus then 1107 begin 1108 DestinationMarkON := false; 1109 PaintDestination; 1110 if uix >= 0 then 1111 UnStartLoc := MyUn[uix].Loc; 1112 BlinkON := false; 1113 BlinkTime := -1; 1114 if UnFocus >= 0 then 1115 begin 1116 Loc0 := MyUn[UnFocus].Loc; 1117 if (uix < 0) or (Loc0 <> MyUn[uix].Loc) then 1118 begin 1119 UnFocus := -1; 1120 PaintLoc(Loc0); 1248 1121 end 1249 1122 end; 1250 1251 if IconKind=mikImp then 1252 begin 1253 MostCost:=0; 1254 for i:=0 to nShipPart-1 do 1255 begin 1256 TestCost:=abs(Ship1Change[i])*Imp[imShipComp+i].Cost; 1257 if TestCost>MostCost then 1258 begin MostCost:=TestCost; IconIndex:=imShipComp+i end 1259 end; 1123 UnFocus := uix; 1124 end; 1125 UnitInfoBtn.Visible := UnFocus >= 0; 1126 UnitBtn.Visible := UnFocus >= 0; 1127 CheckTerrainBtnVisible; 1128 end; 1129 1130 procedure TMainScreen.CheckTerrainBtnVisible; 1131 var 1132 Tile: integer; 1133 mox: ^TModel; 1134 begin 1135 if UnFocus >= 0 then 1136 begin 1137 mox := @MyModel[MyUn[UnFocus].mix]; 1138 Tile := MyMap[MyUn[UnFocus].Loc]; 1139 TerrainBtn.Visible := (Tile and fCity = 0) and (MyUn[UnFocus].Master < 0) 1140 and ((mox.Kind = mkSettler) or (mox.Kind = mkSlaves) and 1141 (MyRO.Wonder[woPyramids].EffectiveOwner >= 0)); 1142 end 1143 else 1144 TerrainBtn.Visible := false; 1145 end; 1146 1147 procedure TMainScreen.CheckMovieSpeedBtnState; 1148 begin 1149 if GameMode = cMovie then 1150 begin 1151 MovieSpeed1Btn.Down := MovieSpeed = 1; 1152 MovieSpeed1Btn.Visible := true; 1153 MovieSpeed2Btn.Down := MovieSpeed = 2; 1154 MovieSpeed2Btn.Visible := true; 1155 MovieSpeed3Btn.Down := MovieSpeed = 3; 1156 MovieSpeed3Btn.Visible := true; 1157 MovieSpeed4Btn.Down := MovieSpeed = 4; 1158 MovieSpeed4Btn.Visible := true; 1159 end 1160 else 1161 begin 1162 MovieSpeed1Btn.Visible := false; 1163 MovieSpeed2Btn.Visible := false; 1164 MovieSpeed3Btn.Visible := false; 1165 MovieSpeed4Btn.Visible := false; 1166 end 1167 end; 1168 1169 procedure TMainScreen.SetMapOptions; 1170 begin 1171 IsoEngine.Options := MapOptionChecked; 1172 if ClientMode = cEditMap then 1173 IsoEngine.Options := IsoEngine.Options or (1 shl moEditMode); 1174 if mLocCodes.Checked then 1175 IsoEngine.Options := IsoEngine.Options or (1 shl moLocCodes); 1176 end; 1177 1178 procedure TMainScreen.UpdateViews(UpdateCityScreen: boolean); 1179 begin 1180 SumCities(TaxSum, ScienceSum); 1181 PanelPaint; // TopBar was enough!!! 1182 ListDlg.EcoChange; 1183 NatStatDlg.EcoChange; 1184 if UpdateCityScreen then 1185 CityDlg.SmartUpdateContent; 1186 end; 1187 1188 procedure TMainScreen.SetAIName(p: integer; Name: string); 1189 begin 1190 if Name = '' then 1191 begin 1192 if AILogo[p] <> nil then 1193 begin 1194 AILogo[p].free; 1195 AILogo[p] := nil 1196 end 1197 end 1198 else 1199 begin 1200 if AILogo[p] = nil then 1201 AILogo[p] := TBitmap.Create; 1202 if not LoadGraphicFile(AILogo[p], HomeDir + Name, gfNoError) then 1203 begin 1204 AILogo[p].free; 1205 AILogo[p] := nil 1206 end 1207 end 1208 end; 1209 1210 function TMainScreen.ContactRefused(p: integer; Item: String): boolean; 1211 // return whether treaty was cancelled 1212 var 1213 s: string; 1214 begin 1215 assert(MyRO.Treaty[p] >= trPeace); 1216 s := Tribe[p].TPhrase(Item); 1217 if MyRO.Turn < MyRO.LastCancelTreaty[p] + CancelTreatyTurns then 1218 begin 1219 SimpleMessage(s); 1220 result := false; 1221 end 1222 else 1223 begin 1224 case MyRO.Treaty[p] of 1225 trPeace: 1226 s := s + ' ' + Phrases.Lookup('FRCANCELQUERY_PEACE'); 1227 trFriendlyContact: 1228 s := s + ' ' + Phrases.Lookup('FRCANCELQUERY_FRIENDLY'); 1229 trAlliance: 1230 s := s + ' ' + Phrases.Lookup('FRCANCELQUERY_ALLIANCE'); 1260 1231 end; 1261 1262 Kind:=mkOk; 1263 ShowModal; 1264 end; 1232 result := SimpleQuery(mkYesNo, s, 'NEGO_REJECTED') = mrOK; 1233 if result then 1234 begin 1235 Play('CANCELTREATY'); 1236 Server(sCancelTreaty, me, 0, nil^); 1237 if MyRO.Treaty[p] = trNone then 1238 CityOptimizer_BeginOfTurn; 1239 // peace treaty was cancelled -- use formerly forbidden tiles 1240 MapValid := false; 1241 PaintAllMaps; 1242 end 1243 end 1265 1244 end; 1266 1245 1267 procedure InitModule;1246 procedure TMainScreen.RememberPeaceViolation; 1268 1247 var 1269 x,y,i,j,Domain:integer;1248 uix, p1: integer; 1270 1249 begin 1271 {search icons for advances:} 1272 for i:=0 to nAdv-1 do 1273 if i in FutureTech then AdvIcon[i]:=96+i-futResearchTechnology 1274 else 1275 begin 1276 AdvIcon[i]:=-1; 1277 for Domain:=0 to nDomains-1 do 1278 for j:=0 to nUpgrade-1 do if upgrade[Domain,j].Preq=i then 1279 if AdvIcon[i]>=0 then AdvIcon[i]:=85 1280 else AdvIcon[i]:=86+Domain; 1281 for j:=0 to nFeature-1 do if Feature[j].Preq=i then 1282 for Domain:=0 to nDomains-1 do 1283 if 1 shl Domain and Feature[j].Domains<>0 then 1284 if (AdvIcon[i]>=0) and (AdvIcon[i]<>86+Domain) then AdvIcon[i]:=85 1285 else AdvIcon[i]:=86+Domain; 1286 for j:=28 to nImp-1 do if Imp[j].Preq=i then AdvIcon[i]:=j; 1287 for j:=28 to nImp-1 do 1288 if (Imp[j].Preq=i) and (Imp[j].Kind<>ikCommon) then AdvIcon[i]:=j; 1289 for j:=0 to nJob-1 do if i=JobPreq[j] then AdvIcon[i]:=84; 1290 for j:=0 to 27 do if Imp[j].Preq=i then AdvIcon[i]:=j; 1291 if AdvIcon[i]<0 then 1292 if AdvValue[i]<1000 then AdvIcon[i]:=-7 1293 else AdvIcon[i]:=24+AdvValue[i] div 1000; 1294 for j:=2 to nGov-1 do if GovPreq[j]=i then AdvIcon[i]:=j-8; 1250 MyData.PeaceEvaHappened := 0; 1251 for uix := 0 to MyRO.nUn - 1 do 1252 with MyUn[uix] do 1253 if Loc >= 0 then 1254 begin 1255 p1 := MyRO.Territory[Loc]; 1256 if (p1 <> me) and (p1 >= 0) and 1257 (MyRO.Turn = MyRO.EvaStart[p1] + (PeaceEvaTurns - 1)) then 1258 MyData.PeaceEvaHappened := MyData.PeaceEvaHappened or (1 shl p1); 1259 end; 1260 end; 1261 1262 procedure TMainScreen.Client(Command, NewPlayer: integer; var Data); 1263 1264 procedure GetTribeList; 1265 var 1266 SearchRec: TSearchRec; 1267 Color: TColor; 1268 Name: string; 1269 ok: boolean; 1270 begin 1271 UnusedTribeFiles.Clear; 1272 ok := FindFirst(DataDir + 'Localization\' + 'Tribes\*.tribe.txt', 1273 faArchive + faReadOnly, SearchRec) = 0; 1274 if not ok then 1275 begin 1276 FindClose(SearchRec); 1277 ok := FindFirst(HomeDir + 'Tribes\*.tribe.txt', faArchive + faReadOnly, 1278 SearchRec) = 0; 1295 1279 end; 1296 AdvIcon[adConscription]:=86+dGround; 1297 1298 UnusedTribeFiles:=tstringlist.Create; 1299 UnusedTribeFiles.Sorted:=true; 1300 TribeNames:=tstringlist.Create; 1301 1302 for x:=0 to 11 do for y:=0 to 1 do 1303 MiniColors[x,y]:=GrExt[HGrSystem].Data.Canvas.Pixels[66+x,67+y]; 1304 IsoEngine.Init(InitEnemyModel); 1305 if not IsoEngine.ApplyTileSize(xxt,yyt) and ((xxt<>48) or (yyt<>24)) then 1306 ApplyTileSize(48,24); // non-default tile size is missing a file, switch to default 1307 MainMap:=TIsoMap.Create; 1308 MainMap.SetOutput(offscreen); 1309 1310 HGrStdUnits:=LoadGraphicSet('StdUnits'); 1311 SmallImp:=TBitmap.Create; 1312 SmallImp.PixelFormat:=pf24bit; 1313 InitSmallImp; 1314 SoundPreloadDone:=0; 1315 StartRunning:=false; 1316 StayOnTop_Ensured:=false; 1317 1318 CreatePVSB(sb,Handle,100-200,122,100+MidPanelHeight-16-200); 1319 end;{InitModule} 1280 if ok then 1281 repeat 1282 SearchRec.Name := Copy(SearchRec.Name, 1, 1283 Length(SearchRec.Name) - 10); 1284 if GetTribeInfo(SearchRec.Name, Name, Color) then 1285 UnusedTribeFiles.AddObject(SearchRec.Name, TObject(Color)); 1286 until FindNext(SearchRec) <> 0; 1287 FindClose(SearchRec); 1288 end; 1289 1290 function ChooseUnusedTribe: integer; 1291 var 1292 i, j, ColorDistance, BestColorDistance, TestColorDistance, 1293 CountBest: integer; 1294 begin 1295 assert(UnusedTribeFiles.Count > 0); 1296 result := -1; 1297 BestColorDistance := -1; 1298 for j := 0 to UnusedTribeFiles.Count - 1 do 1299 begin 1300 ColorDistance := 250; // consider differences more than this infinite 1301 for i := 0 to nPl - 1 do 1302 if Tribe[i] <> nil then 1303 begin 1304 TestColorDistance := 1305 abs(integer(UnusedTribeFiles.Objects[j]) shr 16 and 1306 $FF - Tribe[i].Color shr 16 and $FF) + 1307 abs(integer(UnusedTribeFiles.Objects[j]) shr 8 and 1308 $FF - Tribe[i].Color shr 8 and $FF) * 3 + 1309 abs(integer(UnusedTribeFiles.Objects[j]) and 1310 $FF - Tribe[i].Color and $FF) * 2; 1311 if TestColorDistance < ColorDistance then 1312 ColorDistance := TestColorDistance 1313 end; 1314 if ColorDistance > BestColorDistance then 1315 begin 1316 CountBest := 0; 1317 BestColorDistance := ColorDistance 1318 end; 1319 if ColorDistance = BestColorDistance then 1320 begin 1321 inc(CountBest); 1322 if random(CountBest) = 0 then 1323 result := j 1324 end 1325 end; 1326 end; 1327 1328 procedure ShowEnemyShipChange(ShowShipChange: TShowShipChange); 1329 var 1330 i, TestCost, MostCost: integer; 1331 Ship1Plus, Ship2Plus: boolean; 1332 begin 1333 with ShowShipChange, MessgExDlg do 1334 begin 1335 case Reason of 1336 scrProduction: 1337 begin 1338 OpenSound := 'SHIP_BUILT'; 1339 MessgText := Tribe[Ship1Owner].TPhrase('SHIPBUILT'); 1340 IconKind := mikShip; 1341 IconIndex := Ship1Owner; 1342 end; 1343 1344 scrDestruction: 1345 begin 1346 OpenSound := 'SHIP_DESTROYED'; 1347 MessgText := Tribe[Ship1Owner].TPhrase('SHIPDESTROYED'); 1348 IconKind := mikImp; 1349 end; 1350 1351 scrTrade: 1352 begin 1353 OpenSound := 'SHIP_TRADED'; 1354 Ship1Plus := false; 1355 Ship2Plus := false; 1356 for i := 0 to nShipPart - 1 do 1357 begin 1358 if Ship1Change[i] > 0 then 1359 Ship1Plus := true; 1360 if Ship2Change[i] > 0 then 1361 Ship2Plus := true; 1362 end; 1363 if Ship1Plus and Ship2Plus then 1364 MessgText := Tribe[Ship1Owner].TPhrase('SHIPBITRADE1') + ' ' + 1365 Tribe[Ship2Owner].TPhrase('SHIPBITRADE2') 1366 else if Ship1Plus then 1367 MessgText := Tribe[Ship1Owner].TPhrase('SHIPUNITRADE1') + ' ' + 1368 Tribe[Ship2Owner].TPhrase('SHIPUNITRADE2') 1369 else // if Ship2Plus then 1370 MessgText := Tribe[Ship2Owner].TPhrase('SHIPUNITRADE1') + ' ' + 1371 Tribe[Ship1Owner].TPhrase('SHIPUNITRADE2'); 1372 IconKind := mikImp; 1373 end; 1374 1375 scrCapture: 1376 begin 1377 OpenSound := 'SHIP_CAPTURED'; 1378 MessgText := Tribe[Ship2Owner].TPhrase('SHIPCAPTURE1') + ' ' + 1379 Tribe[Ship1Owner].TPhrase('SHIPCAPTURE2'); 1380 IconKind := mikShip; 1381 IconIndex := Ship2Owner; 1382 end 1383 end; 1384 1385 if IconKind = mikImp then 1386 begin 1387 MostCost := 0; 1388 for i := 0 to nShipPart - 1 do 1389 begin 1390 TestCost := abs(Ship1Change[i]) * Imp[imShipComp + i].Cost; 1391 if TestCost > MostCost then 1392 begin 1393 MostCost := TestCost; 1394 IconIndex := imShipComp + i 1395 end 1396 end; 1397 end; 1398 1399 Kind := mkOk; 1400 ShowModal; 1401 end; 1402 end; 1403 1404 procedure InitModule; 1405 var 1406 x, y, i, j, Domain: integer; 1407 begin 1408 { search icons for advances: } 1409 for i := 0 to nAdv - 1 do 1410 if i in FutureTech then 1411 AdvIcon[i] := 96 + i - futResearchTechnology 1412 else 1413 begin 1414 AdvIcon[i] := -1; 1415 for Domain := 0 to nDomains - 1 do 1416 for j := 0 to nUpgrade - 1 do 1417 if upgrade[Domain, j].Preq = i then 1418 if AdvIcon[i] >= 0 then 1419 AdvIcon[i] := 85 1420 else 1421 AdvIcon[i] := 86 + Domain; 1422 for j := 0 to nFeature - 1 do 1423 if Feature[j].Preq = i then 1424 for Domain := 0 to nDomains - 1 do 1425 if 1 shl Domain and Feature[j].Domains <> 0 then 1426 if (AdvIcon[i] >= 0) and (AdvIcon[i] <> 86 + Domain) then 1427 AdvIcon[i] := 85 1428 else 1429 AdvIcon[i] := 86 + Domain; 1430 for j := 28 to nImp - 1 do 1431 if Imp[j].Preq = i then 1432 AdvIcon[i] := j; 1433 for j := 28 to nImp - 1 do 1434 if (Imp[j].Preq = i) and (Imp[j].Kind <> ikCommon) then 1435 AdvIcon[i] := j; 1436 for j := 0 to nJob - 1 do 1437 if i = JobPreq[j] then 1438 AdvIcon[i] := 84; 1439 for j := 0 to 27 do 1440 if Imp[j].Preq = i then 1441 AdvIcon[i] := j; 1442 if AdvIcon[i] < 0 then 1443 if AdvValue[i] < 1000 then 1444 AdvIcon[i] := -7 1445 else 1446 AdvIcon[i] := 24 + AdvValue[i] div 1000; 1447 for j := 2 to nGov - 1 do 1448 if GovPreq[j] = i then 1449 AdvIcon[i] := j - 8; 1450 end; 1451 AdvIcon[adConscription] := 86 + dGround; 1452 1453 UnusedTribeFiles := tstringlist.Create; 1454 UnusedTribeFiles.Sorted := true; 1455 TribeNames := tstringlist.Create; 1456 1457 for x := 0 to 11 do 1458 for y := 0 to 1 do 1459 MiniColors[x, y] := GrExt[HGrSystem].Data.Canvas.Pixels 1460 [66 + x, 67 + y]; 1461 IsoEngine.Init(InitEnemyModel); 1462 if not IsoEngine.ApplyTileSize(xxt, yyt) and ((xxt <> 48) or (yyt <> 24)) 1463 then 1464 ApplyTileSize(48, 24); 1465 // non-default tile size is missing a file, switch to default 1466 MainMap := TIsoMap.Create; 1467 MainMap.SetOutput(offscreen); 1468 1469 HGrStdUnits := LoadGraphicSet('StdUnits'); 1470 SmallImp := TBitmap.Create; 1471 SmallImp.PixelFormat := pf24bit; 1472 InitSmallImp; 1473 SoundPreloadDone := 0; 1474 StartRunning := false; 1475 StayOnTop_Ensured := false; 1476 1477 CreatePVSB(sb, Handle, 100 - 200, 122, 100 + MidPanelHeight - 16 - 200); 1478 end; { InitModule } 1320 1479 1321 1480 // sound blocks for preload 1322 1481 const 1323 sbStart=$01; sbWonder=$02; sbScience=$04; sbContact=$08; 1324 sbTurn=$10; sbAll=$FF; 1325 1326 procedure SoundPreload(Check: integer); 1327 const 1328 nStartBlock=27; 1329 StartBlock: array[0..nStartBlock-1] of string= 1330 ('INVALID','TURNEND','DISBAND','CHEAT','MSG_DEFAULT','WARNING_DISORDER', 1331 'WARNING_FAMINE','WARNING_LOWSUPPORT','WARNING_LOWFUNDS','MOVE_MOUNTAIN', 1332 'MOVE_LOAD','MOVE_UNLOAD','MOVE_DIE','NOMOVE_TIME','NOMOVE_DOMAIN', 1333 'NOMOVE_DEFAULT','CITY_SELLIMP','CITY_REBUILDIMP','CITY_BUYPROJECT', 1334 'CITY_UTILIZE','NEWMODEL_0','NEWADVANCE_0','AGE_0','REVOLUTION','NEWGOV', 1335 'CITY_INVALIDTYPE','MSG_GAMEOVER'); 1336 1337 nWonderBlock=6; 1338 WonderBlock: array[0..nWonderBlock-1] of string= 1339 ('WONDER_BUILT','WONDER_CAPTURED','WONDER_EXPIRED','WONDER_DESTROYED', 1340 'MSG_COLDWAR','NEWADVANCE_GRLIB'); 1341 1342 nScienceBlock=17; 1343 ScienceBlock: array[0..nScienceBlock-1] of string= 1344 ('MOVE_PARACHUTE','MOVE_PLANESTART','MOVE_PLANELANDING','MOVE_COVERT', 1345 'NEWMODEL_1','NEWMODEL_2','NEWMODEL_3','NEWADVANCE_1','NEWADVANCE_2', 1346 'NEWADVANCE_3','AGE_1','AGE_2','AGE_3','SHIP_BUILT','SHIP_TRADED', 1347 'SHIP_CAPTURED','SHIP_DESTROYED'); 1348 1349 nContactBlock=20; 1350 ContactBlock: array[0..nContactBlock-1] of string= 1351 ('NEWTREATY','CANCELTREATY','ACCEPTOFFER','MSG_WITHDRAW','MSG_BANKRUPT', 1352 'CONTACT_0','CONTACT_1','CONTACT_2','CONTACT_3','CONTACT_4','CONTACT_5', 1353 'CONTACT_5','CONTACT_6','NEGO_REJECTED','MOVE_CAPTURE','MOVE_EXPEL', 1354 'NOMOVE_TREATY','NOMOVE_ZOC','NOMOVE_SUBMARINE','NOMOVE_STEALTH'); 1355 1356 var 1357 i,cix,mix: integer; 1358 need: boolean; 1359 mi: TModelInfo; 1360 begin 1361 if Check and sbStart and not SoundPreloadDone<>0 then 1362 begin 1363 for i:=0 to nStartBlock-1 do PreparePlay(StartBlock[i]); 1364 SoundPreloadDone:=SoundPreloadDone or sbStart; 1365 end; 1366 if Check and sbWonder and not SoundPreloadDone<>0 then 1367 begin 1368 need:=false; 1369 for i:=0 to 27 do if MyRO.Wonder[i].CityID<>-1 then need:=true; 1370 if need then 1371 begin 1372 for i:=0 to nWonderBlock-1 do PreparePlay(WonderBlock[i]); 1373 SoundPreloadDone:=SoundPreloadDone or sbWonder; 1482 sbStart = $01; 1483 sbWonder = $02; 1484 sbScience = $04; 1485 sbContact = $08; 1486 sbTurn = $10; 1487 sbAll = $FF; 1488 1489 procedure SoundPreload(Check: integer); 1490 const 1491 nStartBlock = 27; 1492 StartBlock: array [0 .. nStartBlock - 1] of string = ('INVALID', 1493 'TURNEND', 'DISBAND', 'CHEAT', 'MSG_DEFAULT', 'WARNING_DISORDER', 1494 'WARNING_FAMINE', 'WARNING_LOWSUPPORT', 'WARNING_LOWFUNDS', 1495 'MOVE_MOUNTAIN', 'MOVE_LOAD', 'MOVE_UNLOAD', 'MOVE_DIE', 'NOMOVE_TIME', 1496 'NOMOVE_DOMAIN', 'NOMOVE_DEFAULT', 'CITY_SELLIMP', 'CITY_REBUILDIMP', 1497 'CITY_BUYPROJECT', 'CITY_UTILIZE', 'NEWMODEL_0', 'NEWADVANCE_0', 1498 'AGE_0', 'REVOLUTION', 'NEWGOV', 'CITY_INVALIDTYPE', 'MSG_GAMEOVER'); 1499 1500 nWonderBlock = 6; 1501 WonderBlock: array [0 .. nWonderBlock - 1] of string = ('WONDER_BUILT', 1502 'WONDER_CAPTURED', 'WONDER_EXPIRED', 'WONDER_DESTROYED', 'MSG_COLDWAR', 1503 'NEWADVANCE_GRLIB'); 1504 1505 nScienceBlock = 17; 1506 ScienceBlock: array [0 .. nScienceBlock - 1] of string = 1507 ('MOVE_PARACHUTE', 'MOVE_PLANESTART', 'MOVE_PLANELANDING', 1508 'MOVE_COVERT', 'NEWMODEL_1', 'NEWMODEL_2', 'NEWMODEL_3', 'NEWADVANCE_1', 1509 'NEWADVANCE_2', 'NEWADVANCE_3', 'AGE_1', 'AGE_2', 'AGE_3', 'SHIP_BUILT', 1510 'SHIP_TRADED', 'SHIP_CAPTURED', 'SHIP_DESTROYED'); 1511 1512 nContactBlock = 20; 1513 ContactBlock: array [0 .. nContactBlock - 1] of string = ('NEWTREATY', 1514 'CANCELTREATY', 'ACCEPTOFFER', 'MSG_WITHDRAW', 'MSG_BANKRUPT', 1515 'CONTACT_0', 'CONTACT_1', 'CONTACT_2', 'CONTACT_3', 'CONTACT_4', 1516 'CONTACT_5', 'CONTACT_5', 'CONTACT_6', 'NEGO_REJECTED', 'MOVE_CAPTURE', 1517 'MOVE_EXPEL', 'NOMOVE_TREATY', 'NOMOVE_ZOC', 'NOMOVE_SUBMARINE', 1518 'NOMOVE_STEALTH'); 1519 1520 var 1521 i, cix, mix: integer; 1522 need: boolean; 1523 mi: TModelInfo; 1524 begin 1525 if Check and sbStart and not SoundPreloadDone <> 0 then 1526 begin 1527 for i := 0 to nStartBlock - 1 do 1528 PreparePlay(StartBlock[i]); 1529 SoundPreloadDone := SoundPreloadDone or sbStart; 1374 1530 end; 1375 end; 1376 if (Check and sbScience and not SoundPreloadDone<>0) 1377 and (MyRO.Tech[adScience]>=tsApplicable) then 1378 begin 1379 for i:=0 to nScienceBlock-1 do PreparePlay(ScienceBlock[i]); 1380 SoundPreloadDone:=SoundPreloadDone or sbScience; 1381 end; 1382 if (Check and sbContact and not SoundPreloadDone<>0) 1383 and (MyRO.nEnemyModel+MyRO.nEnemyCity>0) then 1384 begin 1385 for i:=0 to nContactBlock-1 do PreparePlay(ContactBlock[i]); 1386 SoundPreloadDone:=SoundPreloadDone or sbContact; 1387 end; 1388 if Check and sbTurn<>0 then 1389 begin 1390 if MyRO.Happened and phShipComplete<>0 then 1391 PreparePlay('MSG_YOUWIN'); 1392 if MyData.ToldAlive<>MyRO.Alive then PreparePlay('MSG_EXTINCT'); 1393 for cix:=0 to MyRO.nCity-1 do with MyCity[cix] do 1394 if (Loc>=0) and (Flags and CityRepMask<>0) then 1395 for i:=0 to 12 do if 1 shl i and Flags and CityRepMask<>0 then 1396 PreparePlay(CityEventSoundItem[i]); 1397 for mix:=0 to MyRO.nModel-1 do with MyModel[mix] do if Attack>0 then 1398 begin 1399 MakeModelInfo(me,mix,MyModel[mix],mi); 1400 PreparePlay(AttackSound(ModelCode(mi))); 1401 end 1402 end 1403 end; 1404 1405 procedure InitTurn(p: integer); 1406 const 1407 nAdvBookIcon=16; 1408 AdvBookIcon: array[0..nAdvBookIcon-1] of record Adv,Icon: integer end= 1409 ((Adv:adPolyTheism;Icon:woZeus),(Adv:adBronzeWorking;Icon:woColossus), 1410 (Adv:adMapMaking;Icon:woLighthouse),(Adv:adPoetry;Icon:imTheater), 1411 (Adv:adMonotheism;Icon:woMich),(Adv:adPhilosophy;Icon:woLeo), 1412 (Adv:adTheoryOfGravity;Icon:woNewton),(Adv:adSteel;Icon:woEiffel), 1413 (Adv:adDemocracy;Icon:woLiberty),(Adv:adAutomobile;Icon:imHighways), 1414 (Adv:adSanitation;Icon:imSewer),(Adv:adElectronics;Icon:woHoover), 1415 (Adv:adNuclearFission;Icon:woManhattan),(Adv:adRecycling;Icon:imRecycling), 1416 (Adv:adComputers;Icon:imResLab),(Adv:adSpaceFlight;Icon:woMIR)); 1417 var 1418 Domain,p1,i,ad,uix,cix,MoveOptions,MoveResult,Loc1,Dist,NewAgeCenterTo, 1419 Bankrupt,ShipMore,Winners,NewGovAvailable,dx,dy:integer; 1420 MoveAdviceData: TMoveAdviceData; 1421 Picture: TModelPictureInfo; 1422 s, Item, Item2: string; 1423 UpdatePanel, OwnWonder, ok, Stop, ShowCityList, WondersOnly,AllowCityScreen: boolean; 1424 begin 1425 if IsMultiPlayerGame and (p<>me) then 1426 begin 1427 UnitInfoBtn.Visible:=false; 1428 UnitBtn.Visible:=false; 1429 TerrainBtn.Visible:=false; 1430 EOT.Visible:=false; 1431 end; 1432 if IsMultiPlayerGame and (p<>me) and (G.RO[0].Happened and phShipComplete=0) then 1433 begin //inter player screen 1434 for i:=0 to ControlCount-1 do if Controls[i] is TButtonC then 1435 Controls[i].visible:=false; 1436 me:=-1; 1437 SetMainTextureByAge(-1); 1438 with Panel.Canvas do 1439 begin 1440 Brush.Color:=$000000; 1441 FillRect(Rect(0,0,Panel.Width,Panel.Height)); 1442 Brush.Style:=bsClear; 1531 if Check and sbWonder and not SoundPreloadDone <> 0 then 1532 begin 1533 need := false; 1534 for i := 0 to 27 do 1535 if MyRO.Wonder[i].CityID <> -1 then 1536 need := true; 1537 if need then 1538 begin 1539 for i := 0 to nWonderBlock - 1 do 1540 PreparePlay(WonderBlock[i]); 1541 SoundPreloadDone := SoundPreloadDone or sbWonder; 1542 end; 1443 1543 end; 1444 with TopBar.Canvas do 1445 begin 1446 Brush.Color:=$000000; 1447 FillRect(Rect(0,0,TopBar.Width,TopBar.Height)); 1448 Brush.Style:=bsClear; 1544 if (Check and sbScience and not SoundPreloadDone <> 0) and 1545 (MyRO.Tech[adScience] >= tsApplicable) then 1546 begin 1547 for i := 0 to nScienceBlock - 1 do 1548 PreparePlay(ScienceBlock[i]); 1549 SoundPreloadDone := SoundPreloadDone or sbScience; 1449 1550 end; 1450 Invalidate; 1451 1452 s:=TurnToString(G.RO[0].Turn); 1453 if supervising then 1454 SimpleMessage(Format(Phrases.Lookup('SUPERTURN'),[s])) 1455 else SimpleMessage(Format(Tribe[NewPlayer].TPhrase('TURN'),[s])); 1456 end; 1457 for i:=0 to ControlCount-1 do if Controls[i] is TButtonC then 1458 Controls[i].visible:=true; 1459 1460 ItsMeAgain(p); 1461 MyData:=G.RO[p].Data; 1462 if not supervising then 1463 SoundPreload(sbAll); 1464 if (me=0) and ((MyRO.Turn=0) or (ClientMode=cResume)) then 1465 Invalidate; // colorize empty space 1466 1467 if not supervising then 1468 begin 1469 { if MyRO.Happened and phGameEnd<>0 then 1470 begin 1471 Age:=3; 1472 SetMainTextureByAge(-1); 1551 if (Check and sbContact and not SoundPreloadDone <> 0) and 1552 (MyRO.nEnemyModel + MyRO.nEnemyCity > 0) then 1553 begin 1554 for i := 0 to nContactBlock - 1 do 1555 PreparePlay(ContactBlock[i]); 1556 SoundPreloadDone := SoundPreloadDone or sbContact; 1557 end; 1558 if Check and sbTurn <> 0 then 1559 begin 1560 if MyRO.Happened and phShipComplete <> 0 then 1561 PreparePlay('MSG_YOUWIN'); 1562 if MyData.ToldAlive <> MyRO.Alive then 1563 PreparePlay('MSG_EXTINCT'); 1564 for cix := 0 to MyRO.nCity - 1 do 1565 with MyCity[cix] do 1566 if (Loc >= 0) and (Flags and CityRepMask <> 0) then 1567 for i := 0 to 12 do 1568 if 1 shl i and Flags and CityRepMask <> 0 then 1569 PreparePlay(CityEventSoundItem[i]); 1570 for mix := 0 to MyRO.nModel - 1 do 1571 with MyModel[mix] do 1572 if Attack > 0 then 1573 begin 1574 MakeModelInfo(me, mix, MyModel[mix], mi); 1575 PreparePlay(AttackSound(ModelCode(mi))); 1576 end 1473 1577 end 1474 else} 1475 begin 1476 Age:=GetAge(me); 1477 if SetMainTextureByAge(Age) then 1478 EOT.Invalidate; // has visible background parts in its bounds 1578 end; 1579 1580 procedure InitTurn(p: integer); 1581 const 1582 nAdvBookIcon = 16; 1583 AdvBookIcon: array [0 .. nAdvBookIcon - 1] of record Adv, 1584 Icon: integer end = ((Adv: adPolyTheism; Icon: woZeus), 1585 (Adv: adBronzeWorking; Icon: woColossus), (Adv: adMapMaking; 1586 Icon: woLighthouse), (Adv: adPoetry; Icon: imTheater), 1587 (Adv: adMonotheism; Icon: woMich), (Adv: adPhilosophy; Icon: woLeo), 1588 (Adv: adTheoryOfGravity; Icon: woNewton), (Adv: adSteel; 1589 Icon: woEiffel), (Adv: adDemocracy; Icon: woLiberty), 1590 (Adv: adAutomobile; Icon: imHighways), (Adv: adSanitation; 1591 Icon: imSewer), (Adv: adElectronics; Icon: woHoover), 1592 (Adv: adNuclearFission; Icon: woManhattan), (Adv: adRecycling; 1593 Icon: imRecycling), (Adv: adComputers; Icon: imResLab), 1594 (Adv: adSpaceFlight; Icon: woMIR)); 1595 var 1596 Domain, p1, i, ad, uix, cix, MoveOptions, MoveResult, Loc1, Dist, 1597 NewAgeCenterTo, Bankrupt, ShipMore, Winners, NewGovAvailable, dx, 1598 dy: integer; 1599 MoveAdviceData: TMoveAdviceData; 1600 Picture: TModelPictureInfo; 1601 s, Item, Item2: string; 1602 UpdatePanel, OwnWonder, ok, Stop, ShowCityList, WondersOnly, 1603 AllowCityScreen: boolean; 1604 begin 1605 if IsMultiPlayerGame and (p <> me) then 1606 begin 1607 UnitInfoBtn.Visible := false; 1608 UnitBtn.Visible := false; 1609 TerrainBtn.Visible := false; 1610 EOT.Visible := false; 1479 1611 end; 1480 // age:=MyRO.Turn mod 4; //!!! 1481 if ClientMode=cMovieTurn then 1482 EOT.ButtonIndex:=eotCancel 1483 else if ClientMode<scContact then 1484 EOT.ButtonIndex:=eotGray 1485 else EOT.ButtonIndex:=eotBackToNego; 1486 end 1487 else 1488 begin 1489 Age:=0; 1490 SetMainTextureByAge(-1); 1491 if ClientMode=cMovieTurn then 1492 EOT.ButtonIndex:=eotCancel 1493 else EOT.ButtonIndex:=eotBlinkOn; 1494 end; 1495 InitCityMark(MainTexture); 1496 CityDlg.CheckAge; 1497 NatStatDlg.CheckAge; 1498 UnitStatDlg.CheckAge; 1499 HelpDlg.Difficulty:=G.Difficulty[me]; 1500 1501 UnFocus:=-1; 1502 MarkCityLoc:=-1; 1503 BlinkON:=false; 1504 BlinkTime:=-1; 1505 Tracking:=false; 1506 TurnComplete:=false; 1507 1508 if (ToldSlavery<0) 1509 or ((ToldSlavery=1)<>(MyRO.Wonder[woPyramids].EffectiveOwner>=0)) then 1510 begin 1511 if MyRO.Wonder[woPyramids].EffectiveOwner>=0 then ToldSlavery:=1 1512 else ToldSlavery:=0; 1513 for p1:=0 to nPl-1 do 1514 if (Tribe[p1]<>nil) and (Tribe[p1].mixSlaves>=0) then 1515 with Picture do 1516 begin // replace unit picture 1517 mix:=Tribe[p1].mixSlaves; 1518 if ToldSlavery=1 then pix:=pixSlaves else pix:=pixNoSlaves; 1519 Hash:=0; 1520 GrName:='StdUnits'; 1521 Tribe[p1].SetModelPicture(Picture, true); 1612 if IsMultiPlayerGame and (p <> me) and 1613 (G.RO[0].Happened and phShipComplete = 0) then 1614 begin // inter player screen 1615 for i := 0 to ControlCount - 1 do 1616 if Controls[i] is TButtonC then 1617 Controls[i].Visible := false; 1618 me := -1; 1619 SetMainTextureByAge(-1); 1620 with Panel.Canvas do 1621 begin 1622 Brush.Color := $000000; 1623 FillRect(Rect(0, 0, Panel.width, Panel.height)); 1624 Brush.Style := bsClear; 1625 end; 1626 with TopBar.Canvas do 1627 begin 1628 Brush.Color := $000000; 1629 FillRect(Rect(0, 0, TopBar.width, TopBar.height)); 1630 Brush.Style := bsClear; 1631 end; 1632 Invalidate; 1633 1634 s := TurnToString(G.RO[0].Turn); 1635 if supervising then 1636 SimpleMessage(Format(Phrases.Lookup('SUPERTURN'), [s])) 1637 else 1638 SimpleMessage(Format(Tribe[NewPlayer].TPhrase('TURN'), [s])); 1639 end; 1640 for i := 0 to ControlCount - 1 do 1641 if Controls[i] is TButtonC then 1642 Controls[i].Visible := true; 1643 1644 ItsMeAgain(p); 1645 MyData := G.RO[p].Data; 1646 if not supervising then 1647 SoundPreload(sbAll); 1648 if (me = 0) and ((MyRO.Turn = 0) or (ClientMode = cResume)) then 1649 Invalidate; // colorize empty space 1650 1651 if not supervising then 1652 begin 1653 1654 { if MyRO.Happened and phGameEnd<>0 then 1655 begin 1656 Age:=3; 1657 SetMainTextureByAge(-1); 1522 1658 end 1523 end; 1524 1525 if not supervising and (ClientMode=cTurn) then 1526 begin 1527 for cix:=0 to MyRO.nCity-1 do 1528 if (MyCity[cix].Loc>=0) 1529 and ((MyRO.Turn=0) or (MyCity[cix].Flags and chFounded<>0)) then 1530 MyCity[cix].Status:=MyCity[cix].Status 1531 and not csResourceWeightsMask or (3 shl 4); // new city, set to maximum growth 1532 end; 1533 if (ClientMode=cTurn) or (ClientMode=cContinue) then 1534 CityOptimizer_BeginOfTurn; // maybe peace was made or has ended 1535 SumCities(TaxSum,ScienceSum); 1536 1537 if ClientMode=cMovieTurn then 1538 begin 1539 UnitInfoBtn.Visible:=false; 1540 UnitBtn.Visible:=false; 1541 TerrainBtn.Visible:=false; 1542 EOT.Hint:=Phrases.Lookup('BTN_STOP'); 1543 EOT.Visible:=true; 1544 end 1545 else if ClientMode<scContact then 1546 begin 1547 UnitInfoBtn.Visible:= UnFocus>=0; 1548 UnitBtn.Visible:= UnFocus>=0; 1549 CheckTerrainBtnVisible; 1550 TurnComplete:=supervising; 1551 EOT.Hint:=Phrases.Lookup('BTN_ENDTURN'); 1552 EOT.Visible:= Server(sTurn-sExecute,me,0,nil^)>=rExecuted; 1553 end 1554 else 1555 begin 1556 UnitInfoBtn.Visible:=false; 1557 UnitBtn.Visible:=false; 1558 TerrainBtn.Visible:=false; 1559 EOT.Hint:=Phrases.Lookup('BTN_NEGO'); 1560 EOT.Visible:=true; 1561 end; 1562 SetTroopLoc(-1); 1563 MapValid:=false; 1564 NewAgeCenterTo:=0; 1565 if ((MyRO.Turn=0) and not supervising or IsMultiPlayerGame 1566 or (ClientMode=cResume)) and (MyRO.nCity>0) then 1567 begin 1568 Loc1:=MyCity[0].Loc; 1569 if (ClientMode=cTurn) and (MyRO.Turn=0) then 1570 begin // move city out of center to not be covered by welcome screen 1571 dx:=MapWidth div (xxt*5); 1572 if dx>5 then 1573 dx:=5; 1574 dy:=MapHeight div (yyt*5); 1575 if dy>5 then 1576 dy:=5; 1577 if Loc1>=G.lx*G.ly div 2 then 1578 begin 1579 NewAgeCenterTo:=-1; 1580 Loc1:=dLoc(Loc1,-dx,-dy) 1581 end 1659 else } 1660 begin 1661 Age := GetAge(me); 1662 if SetMainTextureByAge(Age) then 1663 EOT.Invalidate; // has visible background parts in its bounds 1664 end; 1665 // age:=MyRO.Turn mod 4; //!!! 1666 if ClientMode = cMovieTurn then 1667 EOT.ButtonIndex := eotCancel 1668 else if ClientMode < scContact then 1669 EOT.ButtonIndex := eotGray 1670 else 1671 EOT.ButtonIndex := eotBackToNego; 1672 end 1582 1673 else 1583 begin 1584 NewAgeCenterTo:=1; 1585 Loc1:=dLoc(Loc1,-dx,dy); 1586 end 1674 begin 1675 Age := 0; 1676 SetMainTextureByAge(-1); 1677 if ClientMode = cMovieTurn then 1678 EOT.ButtonIndex := eotCancel 1679 else 1680 EOT.ButtonIndex := eotBlinkOn; 1587 1681 end; 1588 Centre(Loc1) 1589 end; 1590 1591 for i:=0 to Screen.FormCount-1 do 1592 if Screen.Forms[i] is TBufferedDrawDlg then 1593 Screen.Forms[i].Enabled:=true; 1594 1595 if ClientMode<>cResume then 1596 begin 1597 PaintAll; 1598 if (MyRO.Happened and phChangeGov<>0) and (MyRO.NatBuilt[imPalace]>0) then 1599 ImpImage(Panel.Canvas, ClientWidth-xPalace, yPalace, imPalace, gAnarchy{, GameMode<>cMovie}); 1600 // first turn after anarchy -- don't show despotism palace! 1601 Update; 1602 for i:=0 to Screen.FormCount-1 do 1603 if (Screen.Forms[i].Visible) and (Screen.Forms[i] is TBufferedDrawDlg) then 1604 begin 1605 if @Screen.Forms[i].OnShow<>nil then 1606 Screen.Forms[i].OnShow(nil); 1607 Screen.Forms[i].Invalidate; 1608 Screen.Forms[i].Update; 1609 end; 1610 1611 if MyRO.Happened and phGameEnd<>0 then 1612 with MessgExDlg do 1613 begin // game ended 1614 if MyRO.Happened and phExtinct<>0 then 1682 InitCityMark(MainTexture); 1683 CityDlg.CheckAge; 1684 NatStatDlg.CheckAge; 1685 UnitStatDlg.CheckAge; 1686 HelpDlg.Difficulty := G.Difficulty[me]; 1687 1688 UnFocus := -1; 1689 MarkCityLoc := -1; 1690 BlinkON := false; 1691 BlinkTime := -1; 1692 Tracking := false; 1693 TurnComplete := false; 1694 1695 if (ToldSlavery < 0) or 1696 ((ToldSlavery = 1) <> (MyRO.Wonder[woPyramids].EffectiveOwner >= 0)) 1697 then 1698 begin 1699 if MyRO.Wonder[woPyramids].EffectiveOwner >= 0 then 1700 ToldSlavery := 1 1701 else 1702 ToldSlavery := 0; 1703 for p1 := 0 to nPl - 1 do 1704 if (Tribe[p1] <> nil) and (Tribe[p1].mixSlaves >= 0) then 1705 with Picture do 1706 begin // replace unit picture 1707 mix := Tribe[p1].mixSlaves; 1708 if ToldSlavery = 1 then 1709 pix := pixSlaves 1710 else 1711 pix := pixNoSlaves; 1712 Hash := 0; 1713 GrName := 'StdUnits'; 1714 Tribe[p1].SetModelPicture(Picture, true); 1715 end 1716 end; 1717 1718 if not supervising and (ClientMode = cTurn) then 1719 begin 1720 for cix := 0 to MyRO.nCity - 1 do 1721 if (MyCity[cix].Loc >= 0) and 1722 ((MyRO.Turn = 0) or (MyCity[cix].Flags and chFounded <> 0)) then 1723 MyCity[cix].Status := MyCity[cix].Status and 1724 not csResourceWeightsMask or (3 shl 4); 1725 // new city, set to maximum growth 1726 end; 1727 if (ClientMode = cTurn) or (ClientMode = cContinue) then 1728 CityOptimizer_BeginOfTurn; // maybe peace was made or has ended 1729 SumCities(TaxSum, ScienceSum); 1730 1731 if ClientMode = cMovieTurn then 1732 begin 1733 UnitInfoBtn.Visible := false; 1734 UnitBtn.Visible := false; 1735 TerrainBtn.Visible := false; 1736 EOT.Hint := Phrases.Lookup('BTN_STOP'); 1737 EOT.Visible := true; 1738 end 1739 else if ClientMode < scContact then 1740 begin 1741 UnitInfoBtn.Visible := UnFocus >= 0; 1742 UnitBtn.Visible := UnFocus >= 0; 1743 CheckTerrainBtnVisible; 1744 TurnComplete := supervising; 1745 EOT.Hint := Phrases.Lookup('BTN_ENDTURN'); 1746 EOT.Visible := Server(sTurn - sExecute, me, 0, nil^) >= rExecuted; 1747 end 1748 else 1749 begin 1750 UnitInfoBtn.Visible := false; 1751 UnitBtn.Visible := false; 1752 TerrainBtn.Visible := false; 1753 EOT.Hint := Phrases.Lookup('BTN_NEGO'); 1754 EOT.Visible := true; 1755 end; 1756 SetTroopLoc(-1); 1757 MapValid := false; 1758 NewAgeCenterTo := 0; 1759 if ((MyRO.Turn = 0) and not supervising or IsMultiPlayerGame or 1760 (ClientMode = cResume)) and (MyRO.nCity > 0) then 1761 begin 1762 Loc1 := MyCity[0].Loc; 1763 if (ClientMode = cTurn) and (MyRO.Turn = 0) then 1764 begin // move city out of center to not be covered by welcome screen 1765 dx := MapWidth div (xxt * 5); 1766 if dx > 5 then 1767 dx := 5; 1768 dy := MapHeight div (yyt * 5); 1769 if dy > 5 then 1770 dy := 5; 1771 if Loc1 >= G.lx * G.ly div 2 then 1615 1772 begin 1616 OpenSound:='MSG_GAMEOVER'; 1617 MessgText:=Tribe[me].TPhrase('GAMEOVER'); 1618 IconKind:=mikBigIcon; 1619 IconIndex:=8; 1773 NewAgeCenterTo := -1; 1774 Loc1 := dLoc(Loc1, -dx, -dy) 1620 1775 end 1621 else if MyRO.Happened and phShipComplete<>0 then1776 else 1622 1777 begin 1623 Winners:=0; 1624 for p1:=0 to nPl-1 do if 1 shl p1 and MyRO.Alive<>0 then 1778 NewAgeCenterTo := 1; 1779 Loc1 := dLoc(Loc1, -dx, dy); 1780 end 1781 end; 1782 Centre(Loc1) 1783 end; 1784 1785 for i := 0 to Screen.FormCount - 1 do 1786 if Screen.Forms[i] is TBufferedDrawDlg then 1787 Screen.Forms[i].Enabled := true; 1788 1789 if ClientMode <> cResume then 1790 begin 1791 PaintAll; 1792 if (MyRO.Happened and phChangeGov <> 0) and (MyRO.NatBuilt[imPalace] > 0) 1793 then 1794 ImpImage(Panel.Canvas, ClientWidth - xPalace, yPalace, imPalace, 1795 gAnarchy { , GameMode<>cMovie } ); 1796 // first turn after anarchy -- don't show despotism palace! 1797 Update; 1798 for i := 0 to Screen.FormCount - 1 do 1799 if (Screen.Forms[i].Visible) and (Screen.Forms[i] is TBufferedDrawDlg) 1800 then 1801 begin 1802 if @Screen.Forms[i].OnShow <> nil then 1803 Screen.Forms[i].OnShow(nil); 1804 Screen.Forms[i].Invalidate; 1805 Screen.Forms[i].Update; 1806 end; 1807 1808 if MyRO.Happened and phGameEnd <> 0 then 1809 with MessgExDlg do 1810 begin // game ended 1811 if MyRO.Happened and phExtinct <> 0 then 1625 1812 begin 1626 Winners:=Winners or 1 shl p1; 1627 for i:=0 to nShipPart-1 do 1628 if MyRO.Ship[p1].Parts[i]<ShipNeed[i] then 1629 Winners:=Winners and not (1 shl p1); 1813 OpenSound := 'MSG_GAMEOVER'; 1814 MessgText := Tribe[me].TPhrase('GAMEOVER'); 1815 IconKind := mikBigIcon; 1816 IconIndex := 8; 1817 end 1818 else if MyRO.Happened and phShipComplete <> 0 then 1819 begin 1820 Winners := 0; 1821 for p1 := 0 to nPl - 1 do 1822 if 1 shl p1 and MyRO.Alive <> 0 then 1823 begin 1824 Winners := Winners or 1 shl p1; 1825 for i := 0 to nShipPart - 1 do 1826 if MyRO.Ship[p1].Parts[i] < ShipNeed[i] then 1827 Winners := Winners and not(1 shl p1); 1828 end; 1829 assert(Winners <> 0); 1830 if Winners and (1 shl me) <> 0 then 1831 begin 1832 s := ''; 1833 for p1 := 0 to nPl - 1 do 1834 if (p1 <> me) and (1 shl p1 and Winners <> 0) then 1835 if s = '' then 1836 s := Tribe[p1].TPhrase('SHORTNAME') 1837 else 1838 s := Format(Phrases.Lookup('SHAREDWIN_CONCAT'), 1839 [s, Tribe[p1].TPhrase('SHORTNAME')]); 1840 1841 OpenSound := 'MSG_YOUWIN'; 1842 MessgText := Tribe[me].TPhrase('MYSPACESHIP'); 1843 if s <> '' then 1844 MessgText := MessgText + '\' + 1845 Format(Phrases.Lookup('SHAREDWIN'), [s]); 1846 IconKind := mikBigIcon; 1847 IconIndex := 9; 1848 end 1849 else 1850 begin 1851 assert(me = 0); 1852 OpenSound := 'MSG_GAMEOVER'; 1853 MessgText := ''; 1854 for p1 := 0 to nPl - 1 do 1855 if Winners and (1 shl p1) <> 0 then 1856 MessgText := MessgText + Tribe[p1].TPhrase('SPACESHIP1'); 1857 MessgText := MessgText + '\' + Phrases.Lookup('SPACESHIP2'); 1858 IconKind := mikEnemyShipComplete; 1859 end 1860 end 1861 else { if MyRO.Happened and fTimeUp<>0 then } 1862 begin 1863 assert(me = 0); 1864 OpenSound := 'MSG_GAMEOVER'; 1865 if not supervising then 1866 MessgText := Tribe[me].TPhrase('TIMEUP') 1867 else 1868 MessgText := Phrases.Lookup('TIMEUPSUPER'); 1869 IconKind := mikImp; 1870 IconIndex := 22; 1630 1871 end; 1631 assert(Winners<>0); 1632 if Winners and (1 shl me)<>0 then 1872 Kind := mkOk; 1873 ShowModal; 1874 if MyRO.Happened and phExtinct = 0 then 1633 1875 begin 1634 s:=''; 1635 for p1:=0 to nPl-1 do 1636 if (p1<>me) and (1 shl p1 and Winners<>0) then 1637 if s='' then s:=Tribe[p1].TPhrase('SHORTNAME') 1638 else s:=Format(Phrases.Lookup('SHAREDWIN_CONCAT'), 1639 [s,Tribe[p1].TPhrase('SHORTNAME')]); 1640 1641 OpenSound:='MSG_YOUWIN'; 1642 MessgText:=Tribe[me].TPhrase('MYSPACESHIP'); 1643 if s<>'' then 1644 MessgText:=MessgText+'\'+Format(Phrases.Lookup('SHAREDWIN'),[s]); 1645 IconKind:=mikBigIcon; 1646 IconIndex:=9; 1876 p1 := 0; 1877 while (p1 < nPl - 1) and (Winners and (1 shl p1) = 0) do 1878 inc(p1); 1879 if MyRO.Happened and phShipComplete = 0 then 1880 DiaDlg.ShowNewContent_Charts(wmModal); 1881 end; 1882 TurnComplete := true; 1883 exit; 1884 end; 1885 if not supervising and (1 shl me and MyRO.Alive = 0) then 1886 begin 1887 TurnComplete := true; 1888 exit; 1889 end; 1890 1891 if (ClientMode = cContinue) and 1892 (DipMem[me].SentCommand and $FF0F = scContact) then 1893 // contact was refused 1894 if MyRO.Treaty[DipMem[me].pContact] >= trPeace then 1895 ContactRefused(DipMem[me].pContact, 'FRREJECTED') 1896 else 1897 SoundMessage(Tribe[DipMem[me].pContact].TPhrase('FRREJECTED'), 1898 'NEGO_REJECTED'); 1899 1900 if not supervising and (Age > MyData.ToldAge) and 1901 ((Age > 0) or (ClientMode <> cMovieTurn)) then 1902 with MessgExDlg do 1903 begin 1904 if Age = 0 then 1905 begin 1906 if Phrases2FallenBackToEnglish then 1907 begin 1908 s := Tribe[me].TPhrase('AGE0'); 1909 MessgText := 1910 Format(s, [TurnToString(MyRO.Turn), CityName(MyCity[0].ID)]) 1911 end 1912 else 1913 begin 1914 s := Tribe[me].TString(Phrases2.Lookup('AGE0')); 1915 MessgText := Format(s, [TurnToString(MyRO.Turn)]); 1916 end 1647 1917 end 1648 else1918 else 1649 1919 begin 1650 assert(me=0); 1651 OpenSound:='MSG_GAMEOVER'; 1652 MessgText:=''; 1653 for p1:=0 to nPl-1 do if Winners and (1 shl p1)<>0 then 1654 MessgText:=MessgText+Tribe[p1].TPhrase('SPACESHIP1'); 1655 MessgText:=MessgText+'\'+Phrases.Lookup('SPACESHIP2'); 1656 IconKind:=mikEnemyShipComplete; 1920 s := Tribe[me].TPhrase('AGE' + char(48 + Age)); 1921 MessgText := Format(s, [TurnToString(MyRO.Turn)]); 1922 end; 1923 IconKind := mikAge; 1924 IconIndex := Age; 1925 { if age=0 then } Kind := mkOk 1926 { else begin Kind:=mkOkHelp; HelpKind:=hkAdv; HelpNo:=AgePreq[age]; end }; 1927 CenterTo := NewAgeCenterTo; 1928 OpenSound := 'AGE_' + char(48 + Age); 1929 ShowModal; 1930 MyData.ToldAge := Age; 1931 if Age > 0 then 1932 MyData.ToldTech[AgePreq[Age]] := MyRO.Tech[AgePreq[Age]]; 1933 end; 1934 1935 if MyData.ToldAlive <> MyRO.Alive then 1936 begin 1937 for p1 := 0 to nPl - 1 do 1938 if (MyData.ToldAlive - MyRO.Alive) and (1 shl p1) <> 0 then 1939 with MessgExDlg do 1940 begin 1941 OpenSound := 'MSG_EXTINCT'; 1942 s := Tribe[p1].TPhrase('EXTINCT'); 1943 MessgText := Format(s, [TurnToString(MyRO.Turn)]); 1944 if MyRO.Alive = 1 shl me then 1945 MessgText := MessgText + Phrases.Lookup('EXTINCTALL'); 1946 Kind := mkOk; 1947 IconKind := mikImp; 1948 IconIndex := 21; 1949 ShowModal; 1950 end; 1951 if (ClientMode <> cMovieTurn) and not supervising then 1952 DiaDlg.ShowNewContent_Charts(wmModal); 1953 end; 1954 1955 // tell changes of own credibility 1956 if not supervising then 1957 begin 1958 if RoughCredibility(MyRO.Credibility) <> 1959 RoughCredibility(MyData.ToldOwnCredibility) then 1960 begin 1961 if RoughCredibility(MyRO.Credibility) > 1962 RoughCredibility(MyData.ToldOwnCredibility) then 1963 s := Phrases.Lookup('CREDUP') 1964 else 1965 s := Phrases.Lookup('CREDDOWN'); 1966 TribeMessage(me, 1967 Format(s, [Phrases.Lookup('CREDIBILITY', 1968 RoughCredibility(MyRO.Credibility))]), ''); 1969 end; 1970 MyData.ToldOwnCredibility := MyRO.Credibility; 1971 end; 1972 1973 for i := 0 to 27 do 1974 begin 1975 OwnWonder := false; 1976 for cix := 0 to MyRO.nCity - 1 do 1977 if (MyCity[cix].Loc >= 0) and 1978 (MyCity[cix].ID = MyRO.Wonder[i].CityID) then 1979 OwnWonder := true; 1980 if MyRO.Wonder[i].CityID <> MyData.ToldWonders[i].CityID then 1981 begin 1982 if MyRO.Wonder[i].CityID = -2 then 1983 with MessgExDlg do 1984 begin { tell about destroyed wonders } 1985 OpenSound := 'WONDER_DESTROYED'; 1986 MessgText := Format(Phrases.Lookup('WONDERDEST'), 1987 [Phrases.Lookup('IMPROVEMENTS', i)]); 1988 Kind := mkOkHelp; 1989 HelpKind := hkImp; 1990 HelpNo := i; 1991 IconKind := mikImp; 1992 IconIndex := i; 1993 ShowModal; 1994 end 1995 else 1996 begin 1997 if i = woManhattan then 1998 if MyRO.Wonder[i].EffectiveOwner > me then 1999 MyData.ColdWarStart := MyRO.Turn - 1 2000 else 2001 MyData.ColdWarStart := MyRO.Turn; 2002 if not OwnWonder then 2003 with MessgExDlg do 2004 begin { tell about newly built wonders } 2005 if i = woManhattan then 2006 begin 2007 OpenSound := 'MSG_COLDWAR'; 2008 s := Tribe[MyRO.Wonder[i].EffectiveOwner].TPhrase('COLDWAR') 2009 end 2010 else if MyRO.Wonder[i].EffectiveOwner >= 0 then 2011 begin 2012 OpenSound := 'WONDER_BUILT'; 2013 s := Tribe[MyRO.Wonder[i].EffectiveOwner] 2014 .TPhrase('WONDERBUILT') 2015 end 2016 else 2017 begin 2018 OpenSound := 'MSG_DEFAULT'; 2019 s := Phrases.Lookup('WONDERBUILTEXP'); 2020 // already expired when built 2021 end; 2022 MessgText := Format(s, [Phrases.Lookup('IMPROVEMENTS', i), 2023 CityName(MyRO.Wonder[i].CityID)]); 2024 Kind := mkOkHelp; 2025 HelpKind := hkImp; 2026 HelpNo := i; 2027 IconKind := mikImp; 2028 IconIndex := i; 2029 ShowModal; 2030 end 1657 2031 end 1658 2032 end 1659 else {if MyRO.Happened and fTimeUp<>0 then} 2033 else if (MyRO.Wonder[i].EffectiveOwner <> MyData.ToldWonders[i] 2034 .EffectiveOwner) and (MyRO.Wonder[i].CityID > -2) then 2035 if MyRO.Wonder[i].EffectiveOwner < 0 then 2036 begin 2037 if i <> woMIR then 2038 with MessgExDlg do 2039 begin { tell about expired wonders } 2040 OpenSound := 'WONDER_EXPIRED'; 2041 MessgText := Format(Phrases.Lookup('WONDEREXP'), 2042 [Phrases.Lookup('IMPROVEMENTS', i), 2043 CityName(MyRO.Wonder[i].CityID)]); 2044 Kind := mkOkHelp; 2045 HelpKind := hkImp; 2046 HelpNo := i; 2047 IconKind := mikImp; 2048 IconIndex := i; 2049 ShowModal; 2050 end 2051 end 2052 else if (MyData.ToldWonders[i].EffectiveOwner >= 0) and not OwnWonder 2053 then 2054 with MessgExDlg do 2055 begin { tell about capture of wonders } 2056 OpenSound := 'WONDER_CAPTURED'; 2057 s := Tribe[MyRO.Wonder[i].EffectiveOwner].TPhrase('WONDERCAPT'); 2058 MessgText := Format(s, [Phrases.Lookup('IMPROVEMENTS', i), 2059 CityName(MyRO.Wonder[i].CityID)]); 2060 Kind := mkOkHelp; 2061 HelpKind := hkImp; 2062 HelpNo := i; 2063 IconKind := mikImp; 2064 IconIndex := i; 2065 ShowModal; 2066 end; 2067 end; 2068 2069 if MyRO.Turn = MyData.ColdWarStart + ColdWarTurns then 2070 begin 2071 SoundMessageEx(Phrases.Lookup('COLDWAREND'), 'MSG_DEFAULT'); 2072 MyData.ColdWarStart := -ColdWarTurns - 1 2073 end; 2074 2075 TellNewModels; 2076 end; // ClientMode<>cResume 2077 MyData.ToldAlive := MyRO.Alive; 2078 move(MyRO.Wonder, MyData.ToldWonders, SizeOf(MyData.ToldWonders)); 2079 2080 NewGovAvailable := -1; 2081 if ClientMode <> cResume then 2082 begin // tell about new techs 2083 for ad := 0 to nAdv - 1 do 2084 if (MyRO.TestFlags and tfAllTechs = 0) and 2085 ((MyRO.Tech[ad] >= tsApplicable) <> 2086 (MyData.ToldTech[ad] >= tsApplicable)) or (ad in FutureTech) and 2087 (MyRO.Tech[ad] <> MyData.ToldTech[ad]) then 2088 with MessgExDlg do 2089 begin 2090 Item := 'RESEARCH_GENERAL'; 2091 if GameMode <> cMovie then 2092 OpenSound := 'NEWADVANCE_' + char(48 + Age); 2093 Item2 := Phrases.Lookup('ADVANCES', ad); 2094 if ad in FutureTech then 2095 Item2 := Item2 + ' ' + IntToStr(MyRO.Tech[ad]); 2096 MessgText := Format(Phrases.Lookup(Item), [Item2]); 2097 Kind := mkOkHelp; 2098 HelpKind := hkAdv; 2099 HelpNo := ad; 2100 IconKind := mikBook; 2101 IconIndex := -1; 2102 for i := 0 to nAdvBookIcon - 1 do 2103 if AdvBookIcon[i].Adv = ad then 2104 IconIndex := AdvBookIcon[i].Icon; 2105 ShowModal; 2106 MyData.ToldTech[ad] := MyRO.Tech[ad]; 2107 for i := gMonarchy to nGov - 1 do 2108 if GovPreq[i] = ad then 2109 NewGovAvailable := i; 2110 end; 2111 end; 2112 2113 ShowCityList := false; 2114 if ClientMode = cTurn then 2115 begin 2116 if (MyRO.Happened and phTech <> 0) and (MyData.FarTech <> adNexus) then 2117 ChooseResearch; 2118 2119 UpdatePanel := false; 2120 if MyRO.Happened and phChangeGov <> 0 then 2121 begin 2122 ModalSelectDlg.ShowNewContent(wmModal, kGov); 2123 Play('NEWGOV'); 2124 Server(sSetGovernment, me, ModalSelectDlg.result, nil^); 2125 CityOptimizer_BeginOfTurn; 2126 UpdatePanel := true; 2127 end; 2128 end; // ClientMode=cTurn 2129 2130 if not supervising and ((ClientMode = cTurn) or (ClientMode = cMovieTurn)) 2131 then 2132 for cix := 0 to MyRO.nCity - 1 do 2133 with MyCity[cix] do 2134 Status := Status and not csToldBombard; 2135 2136 if ((ClientMode = cTurn) or (ClientMode = cMovieTurn)) and 2137 (MyRO.Government <> gAnarchy) then 2138 begin 2139 // tell what happened in cities 2140 for WondersOnly := true downto false do 2141 for cix := 0 to MyRO.nCity - 1 do 2142 with MyCity[cix] do 2143 if (MyRO.Turn > 0) and (Loc >= 0) and (Flags and chCaptured = 0) 2144 and (WondersOnly = (Flags and chProduction <> 0) and 2145 (Project0 and cpImp <> 0) and (Project0 and cpIndex < 28)) then 2146 begin 2147 if WondersOnly then 2148 with MessgExDlg do 2149 begin { tell about newly built wonder } 2150 OpenSound := 'WONDER_BUILT'; 2151 s := Tribe[me].TPhrase('WONDERBUILTOWN'); 2152 MessgText := 2153 Format(s, [Phrases.Lookup('IMPROVEMENTS', 2154 Project0 and cpIndex), CityName(ID)]); 2155 Kind := mkOkHelp; 2156 HelpKind := hkImp; 2157 HelpNo := Project0 and cpIndex; 2158 IconKind := mikImp; 2159 IconIndex := Project0 and cpIndex; 2160 ShowModal; 2161 end; 2162 if not supervising and (ClientMode = cTurn) then 2163 begin 2164 AllowCityScreen := true; 2165 if (Status and 7 <> 0) and 2166 (Project and (cpImp + cpIndex) = cpImp + imTrGoods) then 2167 if (MyData.ImpOrder[Status and 7 - 1, 0] >= 0) then 2168 begin 2169 if AutoBuild(cix, MyData.ImpOrder[Status and 7 - 1]) then 2170 AllowCityScreen := false 2171 else if Flags and chProduction <> 0 then 2172 Flags := (Flags and not chProduction) or chAllImpsMade 2173 end 2174 else 2175 Flags := Flags or chTypeDel; 2176 if (Size >= NeedAqueductSize) and 2177 (MyRO.Tech[Imp[imAqueduct].Preq] < tsApplicable) or 2178 (Size >= NeedSewerSize) and 2179 (MyRO.Tech[Imp[imSewer].Preq] < tsApplicable) then 2180 Flags := Flags and not chNoGrowthWarning; 2181 // don't remind of unknown building 2182 if Flags and chNoSettlerProd = 0 then 2183 Status := Status and not csToldDelay 2184 else if Status and csToldDelay = 0 then 2185 Status := Status or csToldDelay 2186 else 2187 Flags := Flags and not chNoSettlerProd; 2188 if mRepScreens.Checked then 2189 begin 2190 if (Flags and CityRepMask <> 0) and AllowCityScreen then 2191 begin { show what happened in cities } 2192 SetTroopLoc(MyCity[cix].Loc); 2193 MarkCityLoc := MyCity[cix].Loc; 2194 PanelPaint; 2195 CityDlg.CloseAction := None; 2196 CityDlg.ShowNewContent(wmModal, MyCity[cix].Loc, 2197 Flags and CityRepMask); 2198 UpdatePanel := true; 2199 end 2200 end 2201 else { if mRepList.Checked then } 2202 begin 2203 if Flags and CityRepMask <> 0 then 2204 ShowCityList := true 2205 end 2206 end 2207 end; { city loop } 2208 end; // ClientMode=cTurn 2209 2210 if ClientMode = cTurn then 2211 begin 2212 if NewGovAvailable >= 0 then 2213 with MessgExDlg do 1660 2214 begin 1661 assert(me=0); 1662 OpenSound:='MSG_GAMEOVER'; 1663 if not supervising then MessgText:=Tribe[me].TPhrase('TIMEUP') 1664 else MessgText:=Phrases.Lookup('TIMEUPSUPER'); 1665 IconKind:=mikImp; 1666 IconIndex:=22; 2215 MessgText := Format(Phrases.Lookup('AUTOREVOLUTION'), 2216 [Phrases.Lookup('GOVERNMENT', NewGovAvailable)]); 2217 Kind := mkYesNo; 2218 IconKind := mikPureIcon; 2219 IconIndex := 6 + NewGovAvailable; 2220 ShowModal; 2221 if ModalResult = mrOK then 2222 begin 2223 Play('REVOLUTION'); 2224 Server(sRevolution, me, 0, nil^); 2225 end 1667 2226 end; 1668 Kind:=mkOK; 1669 ShowModal; 1670 if MyRO.Happened and phExtinct=0 then 2227 end; // ClientMode=cTurn 2228 2229 if (ClientMode = cTurn) or (ClientMode = cMovieTurn) then 2230 begin 2231 if MyRO.Happened and phGliderLost <> 0 then 2232 ContextMessage(Phrases.Lookup('GLIDERLOST'), 'MSG_DEFAULT', 2233 hkModel, 200); 2234 if MyRO.Happened and phPlaneLost <> 0 then 2235 ContextMessage(Phrases.Lookup('PLANELOST'), 'MSG_DEFAULT', 2236 hkFeature, mcFuel); 2237 if MyRO.Happened and phPeaceEvacuation <> 0 then 2238 for p1 := 0 to nPl - 1 do 2239 if 1 shl p1 and MyData.PeaceEvaHappened <> 0 then 2240 SoundMessageEx(Tribe[p1].TPhrase('WITHDRAW'), 'MSG_DEFAULT'); 2241 if MyRO.Happened and phPeaceViolation <> 0 then 2242 for p1 := 0 to nPl - 1 do 2243 if (1 shl p1 and MyRO.Alive <> 0) and (MyRO.EvaStart[p1] = MyRO.Turn) 2244 then 2245 SoundMessageEx(Format(Tribe[p1].TPhrase('VIOLATION'), 2246 [TurnToString(MyRO.Turn + PeaceEvaTurns - 1)]), 'MSG_WITHDRAW'); 2247 TellNewContacts; 2248 end; 2249 2250 if ClientMode = cMovieTurn then 2251 Update 2252 else if ClientMode = cTurn then 2253 begin 2254 if UpdatePanel then 2255 UpdateViews; 2256 Application.ProcessMessages; 2257 2258 if not supervising then 2259 for uix := 0 to MyRO.nUn - 1 do 2260 with MyUn[uix] do 2261 if Loc >= 0 then 2262 begin 2263 if Flags and unWithdrawn <> 0 then 2264 Status := 0; 2265 if Health = 100 then 2266 Status := Status and not usRecover; 2267 if (Master >= 0) or UnitExhausted(uix) then 2268 Status := Status and not usWaiting 2269 else 2270 Status := Status or usWaiting; 2271 CheckToldNoReturn(uix); 2272 if Status and usGoto <> 0 then 2273 begin { continue multi-turn goto } 2274 SetUnFocus(uix); 2275 SetTroopLoc(Loc); 2276 FocusOnLoc(TroopLoc, flRepaintPanel or flImmUpdate); 2277 if Status shr 16 = $7FFF then 2278 MoveResult := GetMoveAdvice(UnFocus, maNextCity, 2279 MoveAdviceData) 2280 else 2281 MoveResult := GetMoveAdvice(UnFocus, Status shr 16, 2282 MoveAdviceData); 2283 if MoveResult >= rExecuted then 2284 begin // !!! Shinkansen 2285 MoveResult := eOK; 2286 ok := true; 2287 for i := 0 to MoveAdviceData.nStep - 1 do 2288 begin 2289 Loc1 := dLoc(Loc, MoveAdviceData.dx[i], 2290 MoveAdviceData.dy[i]); 2291 if (MyMap[Loc1] and (fCity or fOwned) = fCity) 2292 // don't capture cities during auto move 2293 or (MyMap[Loc1] and (fUnit or fOwned) = fUnit) then 2294 // don't attack during auto move 2295 begin 2296 ok := false; 2297 Break 2298 end 2299 else 2300 begin 2301 if (Loc1 = MoveAdviceData.ToLoc) or 2302 (MoveAdviceData.ToLoc = maNextCity) and 2303 (MyMap[dLoc(Loc, MoveAdviceData.dx[i], 2304 MoveAdviceData.dy[i])] and fCity <> 0) then 2305 MoveOptions := muAutoNoWait 2306 else 2307 MoveOptions := 0; 2308 MoveResult := MoveUnit(MoveAdviceData.dx[i], 2309 MoveAdviceData.dy[i], MoveOptions); 2310 if (MoveResult < rExecuted) or 2311 (MoveResult = eEnemySpotted) then 2312 begin 2313 ok := false; 2314 Break 2315 end; 2316 end 2317 end; 2318 Stop := not ok or (Loc = MoveAdviceData.ToLoc) or 2319 (MoveAdviceData.ToLoc = maNextCity) and 2320 (MyMap[Loc] and fCity <> 0) 2321 end 2322 else 2323 begin 2324 MoveResult := eOK; 2325 Stop := true; 2326 end; 2327 2328 if MoveResult <> eDied then 2329 if Stop then 2330 Status := Status and ($FFFF - usGoto) 2331 else 2332 Status := Status and not usWaiting; 2333 end; 2334 2335 if Status and (usEnhance or usGoto) = usEnhance then 2336 // continue terrain enhancement 2337 begin 2338 MoveResult := ProcessEnhancement(uix, MyData.EnhancementJobs); 2339 if MoveResult <> eDied then 2340 if MoveResult = eJobDone then 2341 Status := Status and not usEnhance 2342 else 2343 Status := Status and not usWaiting; 2344 end 2345 end; 2346 end; // ClientMode=cTurn 2347 2348 HaveStrategyAdvice := false; 2349 // (GameMode<>cMovie) and not supervising 2350 // and AdvisorDlg.HaveStrategyAdvice; 2351 GoOnPhase := true; 2352 if supervising or (GameMode = cMovie) then 2353 begin 2354 SetTroopLoc(-1); 2355 PaintAll 2356 end { supervisor } 2357 { else if (ClientMode=cTurn) and (MyRO.Turn=0) then 2358 begin 2359 SetUnFocus(0); 2360 ZoomToCity(MyCity[0].Loc) 2361 end } 2362 else 2363 begin 2364 if ClientMode >= scContact then 2365 SetUnFocus(-1) 2366 else 2367 NextUnit(-1, false); 2368 if UnFocus < 0 then 2369 begin 2370 UnStartLoc := -1; 2371 if IsMultiPlayerGame or (ClientMode = cResume) then 2372 if MyRO.nCity > 0 then 2373 FocusOnLoc(MyCity[0].Loc) 2374 else 2375 FocusOnLoc(G.lx * G.ly div 2); 2376 SetTroopLoc(-1); 2377 PanelPaint 2378 end; 2379 if ShowCityList then 2380 ListDlg.ShowNewContent(wmPersistent, kCityEvents); 2381 end; 2382 end; { InitTurn } 2383 2384 var 2385 i, j, p1, mix, ToLoc, AnimationSpeed, ShowMoveDomain, cix, ecix: integer; 2386 Color: TColor; 2387 Name, s: string; 2388 TribeInfo: TTribeInfo; 2389 mi: TModelInfo; 2390 SkipTurn, IsAlpine, IsTreatyDeal: boolean; 2391 2392 begin { >>>client } 2393 case Command of 2394 cTurn, cResume, cContinue, cMovieTurn, scContact, 2395 scDipStart .. scDipBreak: 2396 begin 2397 supervising := G.Difficulty[NewPlayer] = 0; 2398 ArrangeMidPanel; 2399 end 2400 end; 2401 case Command of 2402 cDebugMessage: 2403 LogDlg.Add(NewPlayer, G.RO[0].Turn, pchar(@Data)); 2404 2405 cShowNego: 2406 with TShowNegoData(Data) do 2407 begin 2408 s := Format('P%d to P%d: ', [pSender, pTarget]); 2409 if (Action = scDipOffer) and (Offer.nDeliver + Offer.nCost > 0) then 1671 2410 begin 1672 p1:=0; 1673 while (p1<nPl-1) and (Winners and (1 shl p1)=0) do inc(p1); 1674 if MyRO.Happened and phShipComplete=0 then 1675 DiaDlg.ShowNewContent_Charts(wmModal); 2411 s := s + 'Offer '; 2412 for i := 0 to Offer.nDeliver + Offer.nCost - 1 do 2413 begin 2414 if i = Offer.nDeliver then 2415 s := s + ' for ' 2416 else if i > 0 then 2417 s := s + '+'; 2418 case Offer.Price[i] and opMask of 2419 opChoose: 2420 s := s + 'Price of choice'; 2421 opCivilReport: 2422 s := s + 'State report'; 2423 opMilReport: 2424 s := s + 'Military report'; 2425 opMap: 2426 s := s + 'Map'; 2427 opTreaty: 2428 s := s + 'Treaty'; 2429 opShipParts: 2430 s := s + 'Ship part'; 2431 opMoney: 2432 s := s + IntToStr(Offer.Price[i] and $FFFFFF) + 'o'; 2433 opTribute: 2434 s := s + IntToStr(Offer.Price[i] and $FFFFFF) + 'o tribute'; 2435 opTech: 2436 s := s + Phrases.Lookup('ADVANCES', 2437 Offer.Price[i] and $FFFFFF); 2438 opAllTech: 2439 s := s + 'All advances'; 2440 opModel: 2441 s := s + Tribe[pSender].ModelName[Offer.Price[i] and $FFFFFF]; 2442 opAllModel: 2443 s := s + 'All models'; 2444 end 2445 end; 2446 LogDlg.Add(NewPlayer, G.RO[0].Turn, pchar(s)); 2447 end 2448 else if Action = scDipAccept then 2449 begin 2450 s := s + '--- ACCEPTED! ---'; 2451 LogDlg.Add(NewPlayer, G.RO[0].Turn, pchar(s)); 2452 end 2453 end; 2454 2455 cInitModule: 2456 begin 2457 Server := TInitModuleData(Data).Server; 2458 // AdvisorDlg.Init; 2459 InitModule; 2460 TInitModuleData(Data).DataSize := SizeOf(TPersistentData); 2461 TInitModuleData(Data).Flags := aiThreaded; 2462 end; 2463 2464 cReleaseModule: 2465 begin 2466 SmallImp.free; 2467 UnusedTribeFiles.free; 2468 TribeNames.free; 2469 MainMap.free; 2470 IsoEngine.Done; 2471 // AdvisorDlg.DeInit; 2472 end; 2473 2474 cHelpOnly, cStartHelp, cStartCredits: 2475 begin 2476 Age := 0; 2477 if Command = cHelpOnly then 2478 SetMainTextureByAge(-1); 2479 Tribes.Init; 2480 HelpDlg.UserLeft := (Screen.width - HelpDlg.width) div 2; 2481 HelpDlg.UserTop := (Screen.height - HelpDlg.height) div 2; 2482 HelpDlg.Difficulty := 0; 2483 if Command = cStartCredits then 2484 HelpDlg.ShowNewContent(wmModal, hkMisc, miscCredits) 2485 else 2486 HelpDlg.ShowNewContent(wmModal, hkMisc, miscMain); 2487 Tribes.Done; 2488 end; 2489 2490 cNewGame, cLoadGame, cMovie, cNewMap: 2491 begin 2492 { if (Command=cNewGame) or (Command=cLoadGame) then 2493 AdvisorDlg.NewGame(Data); } 2494 GenerateNames := mNames.Checked; 2495 GameOK := true; 2496 G := TNewGameData(Data); 2497 me := -1; 2498 pLogo := -1; 2499 ClientMode := -1; 2500 SetMapOptions; 2501 IsoEngine.pDebugMap := -1; 2502 idle := false; 2503 FillChar(Jump, SizeOf(Jump), 0); 2504 if StartRunning then 2505 Jump[0] := 999999; 2506 GameMode := Command; 2507 for i := 0 to nGrExt - 1 do 2508 FillChar(GrExt[i].pixUsed, GrExt[i].Data.height div 49 * 10, 0); 2509 IsoEngine.Reset; 2510 Tribes.Init; 2511 GetTribeList; 2512 for p1 := 0 to nPl - 1 do 2513 if (G.RO[p1] <> nil) and (G.RO[p1].Data <> nil) then 2514 with TPersistentData(G.RO[p1].Data^) do 2515 begin 2516 FarTech := adNone; 2517 FillChar(EnhancementJobs, SizeOf(EnhancementJobs), jNone); 2518 FillChar(ImpOrder, SizeOf(ImpOrder), -1); 2519 ColdWarStart := -ColdWarTurns - 1; 2520 ToldAge := -1; 2521 ToldModels := 3; 2522 ToldAlive := 0; 2523 ToldContact := 0; 2524 ToldOwnCredibility := InitialCredibility; 2525 for i := 0 to nPl - 1 do 2526 if G.Difficulty[i] > 0 then 2527 inc(ToldAlive, 1 shl i); 2528 PeaceEvaHappened := 0; 2529 for i := 0 to 27 do 2530 with ToldWonders[i] do 2531 begin 2532 CityID := -1; 2533 EffectiveOwner := -1 2534 end; 2535 FillChar(ToldTech, SizeOf(ToldTech), tsNA); 2536 if G.Difficulty[p1] > 0 then 2537 SoundPreload(sbStart); 2538 end; 2539 2540 // arrange dialogs 2541 ListDlg.UserLeft := 8; 2542 ListDlg.UserTop := TopBarHeight + 8; 2543 HelpDlg.UserLeft := Screen.width - HelpDlg.width - 8; 2544 HelpDlg.UserTop := TopBarHeight + 8; 2545 UnitStatDlg.UserLeft := 397; 2546 UnitStatDlg.UserTop := TopBarHeight + 64; 2547 DiaDlg.UserLeft := (Screen.width - DiaDlg.width) div 2; 2548 DiaDlg.UserTop := (Screen.height - DiaDlg.height) div 2; 2549 NatStatDlg.UserLeft := Screen.width - NatStatDlg.width - 8; 2550 NatStatDlg.UserTop := Screen.height - PanelHeight - 2551 NatStatDlg.height - 8; 2552 if NatStatDlg.UserTop < 8 then 2553 NatStatDlg.UserTop := 8; 2554 2555 Age := 0; 2556 MovieSpeed := 1; 2557 LogDlg.mSlot.Visible := true; 2558 LogDlg.Host := self; 2559 HelpDlg.ClearHistory; 2560 CityDlg.Reset; 2561 2562 Mini.width := G.lx * 2; 2563 Mini.height := G.ly; 2564 for i := 0 to nPl - 1 do 2565 begin 2566 Tribe[i] := nil; 2567 TribeOriginal[i] := false; 1676 2568 end; 1677 TurnComplete:=true; 1678 exit; 1679 end; 1680 if not supervising and (1 shl me and MyRO.Alive=0) then 1681 begin TurnComplete:=true; exit; end; 1682 1683 if (ClientMode=cContinue) and (DipMem[me].SentCommand and $FF0F=scContact) then 1684 // contact was refused 1685 if MyRO.Treaty[DipMem[me].pContact]>=trPeace then 1686 ContactRefused(DipMem[me].pContact, 'FRREJECTED') 1687 else SoundMessage(Tribe[DipMem[me].pContact].TPhrase('FRREJECTED'),'NEGO_REJECTED'); 1688 1689 if not supervising and (Age>MyData.ToldAge) 1690 and ((Age>0) or (ClientMode<>cMovieTurn)) then with MessgExDlg do 1691 begin 1692 if Age=0 then 1693 begin 1694 if Phrases2FallenBackToEnglish then 2569 ToldSlavery := -1; 2570 RepaintOnResize := false; 2571 Closable := false; 2572 FirstMovieTurn := true; 2573 2574 MenuArea.Visible := GameMode <> cMovie; 2575 TreasuryArea.Visible := GameMode < cMovie; 2576 ResearchArea.Visible := GameMode < cMovie; 2577 ManagementArea.Visible := GameMode < cMovie; 2578 end; 2579 2580 cGetReady, cReplay: 2581 if NewPlayer = 0 then 2582 begin 2583 i := 0; 2584 for p1 := 0 to nPl - 1 do 2585 if (G.Difficulty[p1] > 0) and (Tribe[p1] = nil) then 2586 inc(i); 2587 if i > UnusedTribeFiles.Count then 1695 2588 begin 1696 s:=Tribe[me].TPhrase('AGE0');1697 MessgText:=Format(s,[TurnToString(MyRO.Turn),CityName(MyCity[0].ID)])2589 GameOK := false; 2590 SimpleMessage(Phrases.Lookup('TOOFEWTRIBES')); 1698 2591 end 2592 else 2593 begin 2594 for p1 := 0 to nPl - 1 do 2595 if (G.Difficulty[p1] > 0) and (Tribe[p1] = nil) and 2596 (G.RO[p1] <> nil) then 2597 begin // let player select own tribes 2598 TribeInfo.trix := p1; 2599 TribeNames.Clear; 2600 for j := 0 to UnusedTribeFiles.Count - 1 do 2601 begin 2602 GetTribeInfo(UnusedTribeFiles[j], Name, Color); 2603 TribeNames.AddObject(Name, TObject(Color)); 2604 end; 2605 assert(TribeNames.Count > 0); 2606 ModalSelectDlg.ShowNewContent(wmModal, kTribe); 2607 Application.ProcessMessages; 2608 TribeInfo.FileName := UnusedTribeFiles[ModalSelectDlg.result]; 2609 UnusedTribeFiles.Delete(ModalSelectDlg.result); 2610 2611 if GameMode = cLoadGame then 2612 CreateTribe(TribeInfo.trix, TribeInfo.FileName, false) 2613 else 2614 Server(cSetTribe + (Length(TribeInfo.FileName) + 1 + 7) div 4, 2615 0, 0, TribeInfo); 2616 end; 2617 2618 for p1 := 0 to nPl - 1 do 2619 if (G.Difficulty[p1] > 0) and (Tribe[p1] = nil) and 2620 (G.RO[p1] = nil) then 2621 begin // autoselect enemy tribes 2622 j := ChooseUnusedTribe; 2623 TribeInfo.FileName := UnusedTribeFiles[j]; 2624 UnusedTribeFiles.Delete(j); 2625 TribeInfo.trix := p1; 2626 if GameMode = cLoadGame then 2627 CreateTribe(TribeInfo.trix, TribeInfo.FileName, false) 2628 else 2629 Server(cSetTribe + (Length(TribeInfo.FileName) + 1 + 7) div 4, 2630 0, 0, TribeInfo); 2631 end; 2632 end; 2633 if not mNames.Checked then 2634 for p1 := 0 to nPl - 1 do 2635 if Tribe[p1] <> nil then 2636 Tribe[p1].NumberName := p1; 2637 end; 2638 2639 cBreakGame: 2640 begin 2641 SaveSettings; 2642 CityDlg.CloseAction := None; 2643 for i := 0 to Screen.FormCount - 1 do 2644 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) 2645 then 2646 Screen.Forms[i].Close; 2647 if LogDlg.Visible then 2648 LogDlg.Close; 2649 LogDlg.List.Clear; 2650 StartRunning := not idle and (Jump[0] > 0); // AI called Reload 2651 me := -1; 2652 idle := false; 2653 ClientMode := -1; 2654 UnitInfoBtn.Visible := false; 2655 UnitBtn.Visible := false; 2656 TerrainBtn.Visible := false; 2657 MovieSpeed1Btn.Visible := false; 2658 MovieSpeed2Btn.Visible := false; 2659 MovieSpeed3Btn.Visible := false; 2660 MovieSpeed4Btn.Visible := false; 2661 EOT.Visible := false; 2662 for i := 0 to ControlCount - 1 do 2663 if Controls[i] is TButtonC then 2664 Controls[i].Visible := false; 2665 InitPVSB(sb, 0, 1); 2666 for p1 := 0 to nPl - 1 do 2667 if Tribe[p1] <> nil then 2668 Tribe[p1].free; 2669 Tribes.Done; 2670 RepaintOnResize := false; 2671 Closable := true; 2672 Close; 2673 { if (GameMode=cNewGame) or (GameMode=cLoadGame) then 2674 AdvisorDlg.BreakGame; } 2675 end; 2676 2677 cShowGame: 2678 begin 2679 with Panel.Canvas do 2680 begin 2681 Brush.Color := $000000; 2682 FillRect(Rect(0, 0, Panel.width, Panel.height)); 2683 Brush.Style := bsClear; 2684 end; 2685 with TopBar.Canvas do 2686 begin 2687 Brush.Color := $000000; 2688 FillRect(Rect(0, 0, TopBar.width, TopBar.height)); 2689 Brush.Style := bsClear; 2690 end; 2691 FormResize(nil); // place mini map correctly according to its size 2692 Show; 2693 Update; 2694 RepaintOnResize := true; 2695 xw := 0; 2696 yw := ywcenter; 2697 if not StayOnTop_Ensured then 2698 begin 2699 StayOnTop_Ensured := true; 2700 CityDlg.StayOnTop_Workaround; 2701 CityTypeDlg.StayOnTop_Workaround; 2702 DiaDlg.StayOnTop_Workaround; 2703 DraftDlg.StayOnTop_Workaround; 2704 EnhanceDlg.StayOnTop_Workaround; 2705 HelpDlg.StayOnTop_Workaround; 2706 NatStatDlg.StayOnTop_Workaround; 2707 NegoDlg.StayOnTop_Workaround; 2708 ModalSelectDlg.StayOnTop_Workaround; 2709 ListDlg.StayOnTop_Workaround; 2710 UnitStatDlg.StayOnTop_Workaround; 2711 WondersDlg.StayOnTop_Workaround; 2712 RatesDlg.StayOnTop_Workaround; 2713 end; 2714 end; 2715 2716 cShowTurnChange: 2717 begin 2718 if integer(Data) >= 0 then 2719 begin 2720 pLogo := integer(Data); 2721 if G.RO[pLogo] = nil then 2722 begin 2723 if AILogo[pLogo] <> nil then 2724 BitBlt(Canvas.Handle, (xRightPanel + 10) - (16 + 64), 2725 ClientHeight - PanelHeight, 64, 64, 2726 AILogo[pLogo].Canvas.Handle, 0, 0, SRCCOPY); 2727 end 2728 end 2729 end; 2730 2731 cTurn, cResume, cContinue: 2732 if not GameOK then 2733 Server(sResign, NewPlayer, 0, nil^) 1699 2734 else 2735 begin 2736 ClientMode := Command; 2737 pTurn := NewPlayer; 2738 pLogo := NewPlayer; 2739 2740 if Command = cResume then 2741 begin // init non-original model pictures (maybe tribes not found) 2742 for p1 := 0 to nPl - 1 do 2743 if G.RO[p1] <> nil then 2744 begin 2745 ItsMeAgain(p1); 2746 for mix := 0 to MyRO.nModel - 1 do 2747 if Tribe[me].ModelPicture[mix].HGr = 0 then 2748 InitMyModel(mix, true); 2749 end; 2750 me := -1; 2751 end; 2752 2753 if Jump[pTurn] > 0 then 2754 Application.ProcessMessages; 2755 if Jump[pTurn] > 0 then 2756 if G.RO[NewPlayer].Happened and phGameEnd <> 0 then 2757 Jump[pTurn] := 0 2758 else 2759 dec(Jump[pTurn]); 2760 SkipTurn := Jump[pTurn] > 0; 2761 if SkipTurn then 1700 2762 begin 1701 s:=Tribe[me].TString(Phrases2.Lookup('AGE0')); 1702 MessgText:=Format(s,[TurnToString(MyRO.Turn)]); 2763 ItsMeAgain(NewPlayer); 2764 MyData := G.RO[NewPlayer].Data; 2765 SetTroopLoc(-1); 2766 MiniPaint; 2767 InitAllEnemyModels; // necessary for correct replay 2768 if not EndTurn(true) then 2769 SkipTurn := false; 2770 end; 2771 if not SkipTurn then 2772 begin 2773 if ((ClientMode < scDipStart) or (ClientMode > scDipBreak)) and 2774 NegoDlg.Visible then 2775 NegoDlg.Close; 2776 skipped := false; // always show my moves during my turn 2777 idle := true; 2778 InitTurn(NewPlayer); 2779 DipMem[me].pContact := -1; 2780 (* if (me=0) and (MyRO.Alive and (1 shl me)=0)} then 2781 begin 2782 if SimpleQuery(Phrases.Lookup('RESIGN'))=mrIgnore then 2783 Server(sResign,me,0,nil^) 2784 else Server(sBreak,me,0,nil^) 2785 end 2786 else Play('TURNSTART'); *) 2787 end; 2788 end; 2789 2790 cMovieTurn: 2791 begin 2792 ClientMode := Command; 2793 pTurn := NewPlayer; 2794 pLogo := -1; 2795 skipped := false; // always show my moves during my turn 2796 idle := true; 2797 if FirstMovieTurn then 2798 begin 2799 CheckMovieSpeedBtnState; 2800 FirstMovieTurn := false; 2801 end; 2802 InitTurn(NewPlayer); 2803 Application.ProcessMessages; 2804 if MovieSpeed = 4 then 2805 begin 2806 Sleep(75); 2807 // this break will ensure speed of fast forward does not depend on cpu speed 2808 Application.ProcessMessages; 2809 end 2810 end; 2811 2812 cMovieEndTurn: 2813 begin 2814 RememberPeaceViolation; 2815 pTurn := -1; 2816 pLogo := -1; 2817 MapValid := false; 2818 ClientMode := -1; 2819 idle := false; 2820 skipped := false; 2821 end; 2822 2823 cEditMap: 2824 begin 2825 ClientMode := cEditMap; 2826 SetMapOptions; 2827 IsoEngine.pDebugMap := -1; 2828 ItsMeAgain(0); 2829 MyData := nil; 2830 UnitInfoBtn.Visible := false; 2831 UnitBtn.Visible := false; 2832 TerrainBtn.Visible := false; 2833 MovieSpeed1Btn.Visible := false; 2834 MovieSpeed2Btn.Visible := false; 2835 MovieSpeed3Btn.Visible := false; 2836 MovieSpeed4Btn.Visible := false; 2837 EOT.Visible := false; 2838 HelpDlg.Difficulty := 0; 2839 BrushType := fGrass; 2840 BrushLoc := -1; 2841 Edited := false; 2842 UnFocus := -1; 2843 MarkCityLoc := -1; 2844 Tracking := false; 2845 TurnComplete := false; 2846 MapValid := false; 2847 FormResize(nil); // calculate geometrics and paint all 2848 SetTroopLoc(-1); 2849 idle := true 2850 end; 2851 2852 (* cNewContact: 2853 begin 2854 end; 2855 *) 2856 2857 scContact: 2858 begin 2859 DipMem[NewPlayer].pContact := integer(Data); 2860 if Jump[NewPlayer] > 0 then 2861 DipCall(scReject) 2862 else 2863 begin 2864 ClientMode := Command; 2865 InitTurn(NewPlayer); 2866 MyData.ToldContact := MyData.ToldContact or (1 shl integer(Data)); 2867 // don't tell about new nation when already contacted by them 2868 with MessgExDlg do 2869 begin 2870 OpenSound := 'CONTACT_' + char(48 + MyRO.EnemyReport[integer(Data) 2871 ].Attitude); 2872 MessgText := Tribe[integer(Data)].TPhrase('FRCONTACT'); 2873 Kind := mkYesNo; 2874 IconKind := mikTribe; 2875 IconIndex := integer(Data); 2876 ShowModal; 2877 if ModalResult = mrOK then 2878 begin 2879 NegoDlg.Respond; 2880 DipMem[me].DeliveredPrices := []; 2881 DipMem[me].ReceivedPrices := []; 2882 DipCall(scDipStart) 2883 end 2884 else 2885 begin 2886 DipCall(scReject); 2887 EndNego 2888 end 2889 end 2890 end; 2891 end; 2892 2893 scDipStart .. scDipBreak: 2894 begin 2895 ClientMode := Command; 2896 InitTurn(NewPlayer); 2897 if Command = scDipStart then 2898 Play('CONTACT_' + char(48 + MyRO.Attitude[DipMem[NewPlayer] 2899 .pContact])) 2900 else if Command = scDipCancelTreaty then 2901 Play('CANCELTREATY') 2902 else if Command = scDipOffer then 2903 begin 2904 ReceivedOffer := TOffer(Data); 2905 InitAllEnemyModels; 2906 end 2907 else if Command = scDipAccept then 2908 begin // remember delivered and received prices 2909 for i := 0 to DipMem[me].SentOffer.nDeliver - 1 do 2910 include(DipMem[me].DeliveredPrices, 2911 DipMem[me].SentOffer.Price[i] shr 24); 2912 for i := 0 to DipMem[me].SentOffer.nCost - 1 do 2913 include(DipMem[me].ReceivedPrices, 2914 DipMem[me].SentOffer.Price[DipMem[me].SentOffer.nDeliver + 2915 i] shr 24); 2916 IsTreatyDeal := false; 2917 for i := 0 to ReceivedOffer.nDeliver + ReceivedOffer.nCost - 1 do 2918 if DipMem[me].SentOffer.Price[i] and opMask = opTreaty then 2919 IsTreatyDeal := true; 2920 if IsTreatyDeal then 2921 Play('NEWTREATY') 2922 else 2923 Play('ACCEPTOFFER'); 2924 end; 2925 NegoDlg.Start; 2926 idle := true 2927 end; 2928 2929 cShowCancelTreaty: 2930 if not IsMultiPlayerGame then 2931 begin 2932 case G.RO[NewPlayer].Treaty[integer(Data)] of 2933 trPeace: 2934 s := Tribe[integer(Data)].TPhrase('FRCANCELBYREJECT_PEACE'); 2935 trFriendlyContact: 2936 s := Tribe[integer(Data)].TPhrase('FRCANCELBYREJECT_FRIENDLY'); 2937 trAlliance: 2938 s := Tribe[integer(Data)].TPhrase('FRCANCELBYREJECT_ALLIANCE'); 2939 end; 2940 TribeMessage(integer(Data), s, 'CANCELTREATY'); 2941 end; 2942 2943 cShowCancelTreatyByAlliance: 2944 if idle and (NewPlayer = me) then 2945 TribeMessage(integer(Data), Tribe[integer(Data) 2946 ].TPhrase('FRENEMYALLIANCE'), 'CANCELTREATY'); 2947 2948 cShowSupportAllianceAgainst: 2949 if not IsMultiPlayerGame and (Jump[0] = 0) then 2950 TribeMessage(integer(Data) and $F, 2951 Tribe[integer(Data) and $F].TPhrase('FRMYALLIANCE1') + ' ' + 2952 Tribe[integer(Data) shr 4].TPhrase('FRMYALLIANCE2'), 2953 'CANCELTREATY'); 2954 2955 cShowPeaceViolation: 2956 if not IsMultiPlayerGame and (Jump[0] = 0) then 2957 TribeMessage(integer(Data), 2958 Format(Tribe[integer(Data)].TPhrase('EVIOLATION'), 2959 [TurnToString(MyRO.Turn + PeaceEvaTurns - 1)]), 'MSG_WITHDRAW'); 2960 2961 cShowEndContact: 2962 EndNego; 2963 2964 cShowUnitChanged, cShowCityChanged, cShowAfterMove, cShowAfterAttack: 2965 if (idle and (NewPlayer = me) or not idle and not skipped) and 2966 not((GameMode = cMovie) and (MovieSpeed = 4)) then 2967 begin 2968 assert(NewPlayer = me); 2969 if not idle or (GameMode = cMovie) then 2970 Application.ProcessMessages; 2971 if Command = cShowCityChanged then 2972 begin 2973 CurrentMoveInfo.DoShow := false; 2974 if idle then 2975 CurrentMoveInfo.DoShow := true 2976 else if CurrentMoveInfo.IsAlly then 2977 CurrentMoveInfo.DoShow := not mAlNoMoves.Checked 2978 else 2979 CurrentMoveInfo.DoShow := not mEnNoMoves.Checked 2980 end 2981 else if Command = cShowUnitChanged then 2982 begin 2983 CurrentMoveInfo.DoShow := false; 2984 if idle then 2985 CurrentMoveInfo.DoShow := not mEffectiveMovesOnly.Checked 2986 else if CurrentMoveInfo.IsAlly then 2987 CurrentMoveInfo.DoShow := 2988 not(mAlNoMoves.Checked or mAlEffectiveMovesOnly.Checked) 2989 else 2990 CurrentMoveInfo.DoShow := 2991 not(mEnNoMoves.Checked or mEnAttacks.Checked) 2992 end; 2993 // else keep DoShow from cShowMove/cShowAttack 2994 2995 if CurrentMoveInfo.DoShow then 2996 begin 2997 if Command = cShowCityChanged then 2998 MapValid := false; 2999 FocusOnLoc(integer(Data), flImmUpdate); 3000 // OldUnFocus:=UnFocus; 3001 // UnFocus:=-1; 3002 if Command = cShowAfterMove then 3003 PaintLoc(integer(Data), CurrentMoveInfo.AfterMovePaintRadius) 3004 // show discovered areas 3005 else 3006 PaintLoc(integer(Data), 1); 3007 // UnFocus:=OldUnFocus; 3008 if (Command = cShowAfterAttack) and 3009 (CurrentMoveInfo.AfterAttackExpeller >= 0) then 3010 begin 3011 SoundMessageEx(Tribe[CurrentMoveInfo.AfterAttackExpeller] 3012 .TPhrase('EXPEL'), ''); 3013 CurrentMoveInfo.AfterAttackExpeller := -1; 3014 Update; // remove message box from screen 3015 end 3016 else if not idle then 3017 if Command = cShowCityChanged then 3018 Sleep(MoveTime * WaitAfterShowMove div 16) 3019 else if (Command = cShowUnitChanged) and 3020 (MyMap[integer(Data)] and fUnit <> 0) then 3021 Sleep(MoveTime * WaitAfterShowMove div 32) 3022 end // if CurrentMoveInfo.DoShow 3023 else 3024 MapValid := false; 3025 end; 3026 3027 cShowMoving, cShowCapturing: 3028 if (idle and (NewPlayer = me) or not idle and not skipped and 3029 (TShowMove(Data).emix <> $FFFF)) and 3030 not((GameMode = cMovie) and (MovieSpeed = 4)) then 3031 begin 3032 assert(NewPlayer = me); 3033 if not idle or (GameMode = cMovie) then 3034 Application.ProcessMessages; 3035 with TShowMove(Data) do 3036 begin 3037 CurrentMoveInfo.DoShow := false; 3038 if not idle and (Tribe[Owner].ModelPicture[mix].HGr = 0) then 3039 InitEnemyModel(emix); 3040 3041 ToLoc := dLoc(FromLoc, dx, dy); 3042 if idle then 3043 begin // own unit -- make discovered land visible 3044 assert(Owner = me); // no foreign moves during my turn! 3045 CurrentMoveInfo.DoShow := not mEffectiveMovesOnly.Checked or 3046 (Command = cShowCapturing); 3047 if CurrentMoveInfo.DoShow then 3048 begin 3049 if GameMode = cMovie then 3050 begin 3051 if MovieSpeed = 3 then 3052 AnimationSpeed := 4 3053 else if MovieSpeed = 2 then 3054 AnimationSpeed := 8 3055 else 3056 AnimationSpeed := 16; 3057 end 3058 else 3059 begin 3060 if mVeryFastMoves.Checked then 3061 AnimationSpeed := 4 3062 else if mFastMoves.Checked then 3063 AnimationSpeed := 8 3064 else 3065 AnimationSpeed := 16; 3066 end; 3067 with MyModel[mix] do 3068 begin 3069 if (Kind = mkDiplomat) or (Domain = dAir) or 3070 (Cap[mcRadar] + Cap[mcCarrier] + Cap[mcAcademy] > 0) or 3071 (MyMap[ToLoc] and fTerrain = fMountains) or 3072 (MyMap[ToLoc] and fTerImp = tiFort) or 3073 (MyMap[ToLoc] and fTerImp = tiBase) then 3074 CurrentMoveInfo.AfterMovePaintRadius := 2 3075 else 3076 CurrentMoveInfo.AfterMovePaintRadius := 1; 3077 if (MyRO.Wonder[woShinkansen].EffectiveOwner = me) and 3078 (Domain = dGround) and 3079 (MyMap[FromLoc] and (fRR or fCity) <> 0) and 3080 (MyMap[ToLoc] and (fRR or fCity) <> 0) and 3081 (Flags and umPlaneUnloading = 0) then 3082 AnimationSpeed := 4; 3083 ShowMoveDomain := Domain; 3084 IsAlpine := Cap[mcAlpine] > 0; 3085 end 3086 end 3087 end 3088 else 3089 begin 3090 CurrentMoveInfo.IsAlly := MyRO.Treaty[Owner] = trAlliance; 3091 if GameMode = cMovie then 3092 CurrentMoveInfo.DoShow := true 3093 else if CurrentMoveInfo.IsAlly then 3094 CurrentMoveInfo.DoShow := not mAlNoMoves.Checked and 3095 not(mAlEffectiveMovesOnly.Checked and 3096 (Command <> cShowCapturing)) 3097 else 3098 CurrentMoveInfo.DoShow := not mEnNoMoves.Checked and 3099 not(mEnAttacks.Checked and (Command <> cShowCapturing)); 3100 if CurrentMoveInfo.DoShow then 3101 begin 3102 if Command = cShowCapturing then 3103 begin // show capture message 3104 if MyMap[ToLoc] and fOwned <> 0 then 3105 begin // own city, search 3106 cix := MyRO.nCity - 1; 3107 while (cix >= 0) and (MyCity[cix].Loc <> ToLoc) do 3108 dec(cix); 3109 s := CityName(MyCity[cix].ID); 3110 end 3111 else 3112 begin // foreign city, search 3113 ecix := MyRO.nEnemyCity - 1; 3114 while (ecix >= 0) and (MyRO.EnemyCity[ecix].Loc <> ToLoc) do 3115 dec(ecix); 3116 s := CityName(MyRO.EnemyCity[ecix].ID); 3117 end; 3118 TribeMessage(Owner, Format(Tribe[Owner].TPhrase('CAPTURE'), 3119 [s]), ''); 3120 Update; // remove message box from screen 3121 end; 3122 3123 if CurrentMoveInfo.IsAlly then 3124 begin // allied unit -- make discovered land visible 3125 if mAlFastMoves.Checked then 3126 AnimationSpeed := 8 3127 else 3128 AnimationSpeed := 16; 3129 with MyRO.EnemyModel[emix] do 3130 if (Kind = mkDiplomat) or (Domain = dAir) or 3131 (ATrans_Fuel > 0) or 3132 (Cap and (1 shl (mcRadar - mcFirstNonCap) or 3133 1 shl (mcAcademy - mcFirstNonCap)) <> 0) or 3134 (MyMap[ToLoc] and fTerrain = fMountains) or 3135 (MyMap[ToLoc] and fTerImp = tiFort) or 3136 (MyMap[ToLoc] and fTerImp = tiBase) then 3137 CurrentMoveInfo.AfterMovePaintRadius := 2 3138 else 3139 CurrentMoveInfo.AfterMovePaintRadius := 1 3140 end 3141 else 3142 begin 3143 if mEnFastMoves.Checked then 3144 AnimationSpeed := 8 3145 else 3146 AnimationSpeed := 16; 3147 CurrentMoveInfo.AfterMovePaintRadius := 0; 3148 // enemy unit, nothing discovered 3149 end; 3150 if GameMode = cMovie then 3151 begin 3152 if MovieSpeed = 3 then 3153 AnimationSpeed := 4 3154 else if MovieSpeed = 2 then 3155 AnimationSpeed := 8 3156 else 3157 AnimationSpeed := 16; 3158 end; 3159 ShowMoveDomain := MyRO.EnemyModel[emix].Domain; 3160 IsAlpine := MyRO.EnemyModel[emix].Cap and 3161 (1 shl (mcAlpine - mcFirstNonCap)) <> 0; 3162 end 3163 end; 3164 3165 if CurrentMoveInfo.DoShow then 3166 begin 3167 if Command = cShowCapturing then 3168 Play('MOVE_CAPTURE') 3169 else if EndHealth <= 0 then 3170 Play('MOVE_DIE') 3171 else if Flags and umSpyMission <> 0 then 3172 Play('MOVE_COVERT') 3173 else if Flags and umShipLoading <> 0 then 3174 if ShowMoveDomain = dAir then 3175 Play('MOVE_PLANELANDING') 3176 else 3177 Play('MOVE_LOAD') 3178 else if Flags and umPlaneLoading <> 0 then 3179 Play('MOVE_LOAD') 3180 else if Flags and umShipUnloading <> 0 then 3181 if ShowMoveDomain = dAir then 3182 Play('MOVE_PLANESTART') 3183 else 3184 Play('MOVE_UNLOAD') 3185 else if Flags and umPlaneUnloading <> 0 then 3186 if (MyMap[FromLoc] and fCity = 0) and 3187 (MyMap[FromLoc] and fTerImp <> tiBase) then 3188 Play('MOVE_PARACHUTE') 3189 else 3190 Play('MOVE_UNLOAD') 3191 else if (ShowMoveDomain = dGround) and not IsAlpine and 3192 (MyMap[ToLoc] and fTerrain = fMountains) and 3193 ((MyMap[FromLoc] and (fRoad or fRR or fCity) = 0) or 3194 (MyMap[ToLoc] and (fRoad or fRR or fCity) = 0)) then 3195 Play('MOVE_MOUNTAIN'); 3196 3197 FocusOnLoc(FromLoc, flImmUpdate); 3198 PaintLoc_BeforeMove(FromLoc); 3199 if Command = cShowCapturing then 3200 MoveOnScreen(TShowMove(Data), 1, 32, 32) 3201 else 3202 MoveOnScreen(TShowMove(Data), 1, AnimationSpeed, AnimationSpeed) 3203 end // if CurrentMoveInfo.DoShow 3204 else 3205 MapValid := false; 3206 end 3207 end; 3208 3209 cShowAttacking: 3210 if (idle and (NewPlayer = me) or not idle and not skipped and 3211 (TShowMove(Data).emix <> $FFFF)) and 3212 not((GameMode = cMovie) and (MovieSpeed = 4)) then 3213 begin 3214 assert(NewPlayer = me); 3215 if not idle or (GameMode = cMovie) then 3216 Application.ProcessMessages; 3217 with TShowMove(Data) do 3218 begin 3219 CurrentMoveInfo.AfterAttackExpeller := -1; 3220 CurrentMoveInfo.DoShow := false; 3221 if idle then 3222 CurrentMoveInfo.DoShow := true // own unit -- always show attacks 3223 else 3224 begin 3225 CurrentMoveInfo.IsAlly := MyRO.Treaty[Owner] = trAlliance; 3226 if CurrentMoveInfo.IsAlly then 3227 CurrentMoveInfo.DoShow := not mAlNoMoves.Checked 3228 else 3229 CurrentMoveInfo.DoShow := not mEnNoMoves.Checked; 3230 end; 3231 if CurrentMoveInfo.DoShow then 3232 begin 3233 ToLoc := dLoc(FromLoc, dx, dy); 3234 if Tribe[Owner].ModelPicture[mix].HGr = 0 then 3235 InitEnemyModel(emix); 3236 3237 if (MyMap[ToLoc] and (fCity or fUnit or fOwned) = fCity or fOwned) 3238 then 3239 begin // tell about bombardment 3240 cix := MyRO.nCity - 1; 3241 while (cix >= 0) and (MyCity[cix].Loc <> ToLoc) do 3242 dec(cix); 3243 if MyCity[cix].Status and csToldBombard = 0 then 3244 begin 3245 if not supervising then 3246 MyCity[cix].Status := MyCity[cix].Status or csToldBombard; 3247 s := CityName(MyCity[cix].ID); 3248 SoundMessageEx(Format(Tribe[Owner].TPhrase('BOMBARD'), 3249 [s]), ''); 3250 Update; // remove message box from screen 3251 end; 3252 end 3253 else if Flags and umExpelling <> 0 then 3254 CurrentMoveInfo.AfterAttackExpeller := Owner; 3255 3256 if Flags and umExpelling <> 0 then 3257 Play('MOVE_EXPEL') 3258 else if Owner = me then 3259 begin 3260 MakeModelInfo(me, mix, MyModel[mix], mi); 3261 Play(AttackSound(ModelCode(mi))); 3262 end 3263 else 3264 Play(AttackSound(ModelCode(MyRO.EnemyModel[emix]))); 3265 3266 FocusOnLoc(FromLoc, flImmUpdate); 3267 3268 // before combat 3269 MainMap.AttackBegin(TShowMove(Data)); 3270 if MyMap[ToLoc] and fCity <> 0 then 3271 PaintLoc(ToLoc); 3272 PaintLoc(FromLoc); 3273 MoveOnScreen(TShowMove(Data), 1, 9, 16); 3274 MoveOnScreen(TShowMove(Data), 17, 12, 32); 3275 MoveOnScreen(TShowMove(Data), 7, 11, 16); 3276 3277 // after combat 3278 MainMap.AttackEffect(TShowMove(Data)); 3279 PaintLoc(ToLoc); 3280 if EndHealth > 0 then 3281 begin 3282 Health := EndHealth; 3283 MoveOnScreen(TShowMove(Data), 10, 0, 16); 3284 end 3285 else if not idle then 3286 Sleep(MoveTime div 2); 3287 MainMap.AttackEnd; 3288 end // if CurrentMoveInfo.DoShow 3289 else 3290 MapValid := false; 3291 end 3292 end; 3293 3294 cShowMissionResult: 3295 if Cardinal(Data) = 0 then 3296 SoundMessageEx(Phrases.Lookup('NOFOREIGNINFO'), '') 3297 else 3298 begin 3299 s := Phrases.Lookup('FOREIGNINFO'); 3300 for p1 := 0 to nPl - 1 do 3301 if 3 shl (p1 * 2) and Cardinal(Data) <> 0 then 3302 s := s + '\' + Tribe[p1].TPhrase('SHORTNAME'); 3303 SoundMessageEx(s, '') 3304 end; 3305 3306 cShowShipChange: 3307 if not IsMultiPlayerGame and (Jump[0] = 0) then 3308 ShowEnemyShipChange(TShowShipChange(Data)); 3309 3310 cShowGreatLibTech: 3311 if not IsMultiPlayerGame and (Jump[0] = 0) then 3312 with MessgExDlg do 3313 begin 3314 MessgText := Format(Phrases.Lookup('GRLIB_GENERAL'), 3315 [Phrases.Lookup('ADVANCES', integer(Data))]); 3316 OpenSound := 'NEWADVANCE_GRLIB'; 3317 Kind := mkOk; 3318 IconKind := mikImp; 3319 IconIndex := woGrLibrary; 3320 ShowModal; 3321 end; 3322 3323 cRefreshDebugMap: 3324 begin 3325 if integer(Data) = IsoEngine.pDebugMap then 3326 begin 3327 MapValid := false; 3328 MainOffscreenPaint; 3329 Update; 3330 end 3331 end; 3332 3333 else 3334 if Command >= cClientEx then 3335 case Command and $FFF0 of 3336 3337 cSetTribe: 3338 with TTribeInfo(Data) do 3339 begin 3340 i := UnusedTribeFiles.Count - 1; 3341 while (i >= 0) and 3342 (AnsiCompareFileName(UnusedTribeFiles[i], FileName) <> 0) do 3343 dec(i); 3344 if i >= 0 then 3345 UnusedTribeFiles.Delete(i); 3346 CreateTribe(trix, FileName, true); 3347 end; 3348 3349 cSetNewModelPicture, cSetModelPicture: 3350 if TribeOriginal[TModelPictureInfo(Data).trix] then 3351 Tribe[TModelPictureInfo(Data).trix].SetModelPicture 3352 (TModelPictureInfo(Data), Command and 3353 $FFF0 = cSetNewModelPicture); 3354 3355 cSetSlaveIndex and $FFF0: 3356 Tribe[integer(Data) shr 16].mixSlaves := integer(Data) and $FFFF; 3357 3358 cSetCityName: 3359 with TCityNameInfo(Data) do 3360 if TribeOriginal[ID shr 12] then 3361 Tribe[ID shr 12].SetCityName(ID and $FFF, NewName); 3362 3363 cSetModelName: 3364 with TModelNameInfo(Data) do 3365 if TribeOriginal[NewPlayer] then 3366 Tribe[NewPlayer].ModelName[mix] := NewName; 3367 end 3368 end 3369 end; { <<<client } 3370 3371 { *** main part *** } 3372 3373 procedure TMainScreen.CreateParams(var p: TCreateParams); 3374 var 3375 DefaultOptionChecked: integer; 3376 Reg: TRegistry; 3377 doinit: boolean; 3378 begin 3379 inherited; 3380 3381 // define which menu settings to save 3382 SaveOption[0] := mAlEffectiveMovesOnly.Tag; 3383 SaveOption[1] := mEnMoves.Tag; 3384 SaveOption[2] := mEnAttacks.Tag; 3385 SaveOption[3] := mEnNoMoves.Tag; 3386 SaveOption[4] := mWaitTurn.Tag; 3387 SaveOption[5] := mEffectiveMovesOnly.Tag; 3388 SaveOption[6] := mEnFastMoves.Tag; 3389 SaveOption[7] := mSlowMoves.Tag; 3390 SaveOption[8] := mFastMoves.Tag; 3391 SaveOption[9] := mVeryFastMoves.Tag; 3392 SaveOption[10] := mNames.Tag; 3393 SaveOption[11] := mRepList.Tag; 3394 SaveOption[12] := mRepScreens.Tag; 3395 SaveOption[13] := mSoundOff.Tag; 3396 SaveOption[14] := mSoundOn.Tag; 3397 SaveOption[15] := mSoundOnAlt.Tag; 3398 SaveOption[16] := mScrollSlow.Tag; 3399 SaveOption[17] := mScrollFast.Tag; 3400 SaveOption[18] := mScrollOff.Tag; 3401 SaveOption[19] := mAlSlowMoves.Tag; 3402 SaveOption[20] := mAlFastMoves.Tag; 3403 SaveOption[21] := mAlNoMoves.Tag; 3404 DefaultOptionChecked := 1 shl 1 + 1 shl 7 + 1 shl 10 + 1 shl 12 + 1 shl 14 + 3405 1 shl 18 + 1 shl 19; 3406 3407 Reg := TRegistry.Create; 3408 doinit := true; 3409 if Reg.KeyExists('SOFTWARE\cevo\RegVer9') then 3410 begin 3411 doinit := false; 3412 Reg.OpenKey('SOFTWARE\cevo\RegVer9', false); 3413 try 3414 xxt := Reg.ReadInteger('TileWidth') div 2; 3415 yyt := Reg.ReadInteger('TileHeight') div 2; 3416 OptionChecked := Reg.ReadInteger('OptionChecked'); 3417 MapOptionChecked := Reg.ReadInteger('MapOptionChecked'); 3418 CityRepMask := Cardinal(Reg.ReadInteger('CityReport')); 3419 except 3420 doinit := true; 3421 end; 3422 Reg.closekey; 3423 if OptionChecked and (7 shl 16) = 0 then 3424 OptionChecked := OptionChecked or (1 shl 16); 3425 // old regver with no scrolling 3426 end; 3427 Reg.free; 3428 if doinit then 3429 begin 3430 xxt := 48; 3431 yyt := 24; 3432 OptionChecked := DefaultOptionChecked; 3433 MapOptionChecked := 1 shl moCityNames; 3434 CityRepMask := Cardinal(not chPopIncrease and not chNoGrowthWarning and 3435 not chCaptured); 3436 end; 3437 3438 if FullScreen then 3439 begin 3440 p.Style := $87000000; 3441 BorderStyle := bsNone; 3442 BorderIcons := []; 3443 end; 3444 3445 if 1 shl 13 and OptionChecked <> 0 then 3446 SoundMode := smOff 3447 else if 1 shl 15 and OptionChecked <> 0 then 3448 SoundMode := smOnAlt 3449 else 3450 SoundMode := smOn 3451 end; 3452 3453 procedure TMainScreen.FormCreate(Sender: TObject); 3454 var 3455 i, j: integer; 3456 begin 3457 Screen.Cursors[crImpDrag] := LoadCursor(HInstance, 'DRAG'); 3458 Screen.Cursors[crFlatHand] := LoadCursor(HInstance, 'FLATHAND'); 3459 3460 // tag-controlled language 3461 for i := 0 to ComponentCount - 1 do 3462 if Components[i].Tag and $FF <> 0 then 3463 if Components[i] is TMenuItem then 3464 begin 3465 TMenuItem(Components[i]).Caption := Phrases.Lookup('CONTROLS', 3466 -1 + Components[i].Tag and $FF); 3467 for j := 0 to nSaveOption - 1 do 3468 if Components[i].Tag and $FF = SaveOption[j] then 3469 TMenuItem(Components[i]).Checked := 1 shl j and 3470 OptionChecked <> 0; 3471 end 3472 else if Components[i] is TButtonBase then 3473 begin 3474 TButtonBase(Components[i]).Hint := Phrases.Lookup('CONTROLS', 3475 -1 + Components[i].Tag and $FF); 3476 if (Components[i] is TButtonC) and 3477 (TButtonC(Components[i]).ButtonIndex <> 1) then 3478 TButtonC(Components[i]).ButtonIndex := 3479 MapOptionChecked shr (Components[i].Tag shr 8) and 1 + 2 3480 end; 3481 3482 // non-tag-controlled language 3483 mTechTree.Caption := Phrases2.Lookup('MENU_ADVTREE'); 3484 mViewpoint.Caption := Phrases2.Lookup('MENU_VIEWPOINT'); 3485 if not Phrases2FallenBackToEnglish then 3486 begin 3487 MenuArea.Hint := Phrases2.Lookup('BTN_MENU'); 3488 TreasuryArea.Hint := Phrases2.Lookup('TIP_TREASURY'); 3489 ResearchArea.Hint := Phrases.Lookup('SCIENCE'); 3490 ManagementArea.Hint := Phrases2.Lookup('BTN_MANAGE'); 3491 end; 3492 for i := 0 to mRep.Count - 1 do 3493 begin 3494 j := mRep[i].Tag shr 8; 3495 mRep[i].Caption := CityEventName(j); 3496 mRep[i].Checked := CityRepMask and (1 shl j) <> 0; 3497 end; 3498 3499 Mini := TBitmap.Create; 3500 Mini.PixelFormat := pf24bit; 3501 Panel := TBitmap.Create; 3502 Panel.PixelFormat := pf24bit; 3503 Panel.Canvas.Font.Assign(UniFont[ftSmall]); 3504 Panel.Canvas.Brush.Style := bsClear; 3505 TopBar := TBitmap.Create; 3506 TopBar.PixelFormat := pf24bit; 3507 TopBar.Canvas.Font.Assign(UniFont[ftNormal]); 3508 TopBar.Canvas.Brush.Style := bsClear; 3509 Buffer := TBitmap.Create; 3510 Buffer.PixelFormat := pf24bit; 3511 if 2 * lxmax > 3 * xSizeBig then 3512 Buffer.width := 2 * lxmax 3513 else 3514 Buffer.width := 3 * xSizeBig; 3515 if lymax > 3 * ySizeBig then 3516 Buffer.height := lymax 3517 else 3518 Buffer.height := 3 * ySizeBig; 3519 Buffer.Canvas.Font.Assign(UniFont[ftSmall]); 3520 for i := 0 to nPl - 1 do 3521 AILogo[i] := nil; 3522 Canvas.Font.Assign(UniFont[ftSmall]); 3523 InitButtons(); 3524 EOT.Template := Templates; 3525 end; 3526 3527 procedure TMainScreen.FormDestroy(Sender: TObject); 3528 var 3529 i: integer; 3530 begin 3531 Mini.free; 3532 Buffer.free; 3533 Panel.free; 3534 for i := 0 to nPl - 1 do 3535 if AILogo[i] <> nil then 3536 AILogo[i].free; 3537 end; 3538 3539 procedure TMainScreen.FormResize(Sender: TObject); 3540 var 3541 MiniFrame, MaxMapWidth: integer; 3542 begin 3543 SmallScreen := ClientWidth < 1024; 3544 MaxMapWidth := (G.lx * 2 - 3) * xxt; 3545 // avoide the same tile being visible left and right 3546 if ClientWidth <= MaxMapWidth then 3547 begin 3548 MapWidth := ClientWidth; 3549 MapOffset := 0; 3550 end 3551 else 3552 begin 3553 MapWidth := MaxMapWidth; 3554 MapOffset := (ClientWidth - MapWidth) div 2; 3555 end; 3556 MapHeight := ClientHeight - TopBarHeight - PanelHeight + overlap; 3557 Panel.width := ClientWidth; 3558 Panel.height := PanelHeight; 3559 TopBar.width := ClientWidth; 3560 TopBar.height := TopBarHeight; 3561 MiniFrame := (lxmax_xxx - G.ly) div 2; 3562 xMidPanel := (G.lx + MiniFrame) * 2 + 1; 3563 xRightPanel := ClientWidth - LeftPanelWidth - 10; 3564 if ClientMode = cEditMap then 3565 TrPitch := 2 * xxt 3566 else 3567 TrPitch := 66; 3568 xMini := MiniFrame - 5; 3569 yMini := (PanelHeight - 26 - lxmax_xxx) div 2 + MiniFrame; 3570 ywmax := (G.ly - MapHeight div yyt + 1) and not 1; 3571 ywcenter := -((MapHeight - yyt * (G.ly - 1)) div (4 * yyt)) * 2; 3572 // only for ywmax<=0 3573 if ywmax <= 0 then 3574 yw := ywcenter 3575 else if yw < 0 then 3576 yw := 0 3577 else if yw > ywmax then 3578 yw := ywmax; 3579 UnitInfoBtn.Top := ClientHeight - 29; 3580 UnitInfoBtn.Left := xMidPanel + 7 + 99; 3581 UnitBtn.Top := ClientHeight - 29; 3582 UnitBtn.Left := xMidPanel + 7 + 99 + 31; 3583 TerrainBtn.Top := ClientHeight - 29; 3584 TerrainBtn.Left := xMidPanel + 7 + 99 + 62; 3585 MovieSpeed1Btn.Top := ClientHeight - 91; 3586 MovieSpeed1Btn.Left := ClientWidth div 2 - 62; 3587 MovieSpeed2Btn.Top := ClientHeight - 91; 3588 MovieSpeed2Btn.Left := ClientWidth div 2 - 62 + 29; 3589 MovieSpeed3Btn.Top := ClientHeight - 91; 3590 MovieSpeed3Btn.Left := ClientWidth div 2 - 62 + 2 * 29; 3591 MovieSpeed4Btn.Top := ClientHeight - 91; 3592 MovieSpeed4Btn.Left := ClientWidth div 2 - 62 + 3 * 29 + 12; 3593 EOT.Top := ClientHeight - 64; 3594 EOT.Left := ClientWidth - 62; 3595 SetWindowPos(sb.h, 0, xRightPanel + 10 - 14 - 3596 GetSystemMetrics(SM_CXVSCROLL), ClientHeight - MidPanelHeight + 8, 0, 0, 3597 SWP_NOSIZE or SWP_NOZORDER); 3598 MapBtn0.Left := xMini + G.lx - 44; 3599 MapBtn0.Top := ClientHeight - 15; 3600 MapBtn1.Left := xMini + G.lx - 28; 3601 MapBtn1.Top := ClientHeight - 15; 3602 { MapBtn2.Left:=xMini+G.lx-20; 3603 MapBtn2.Top:=ClientHeight-15; 3604 MapBtn3.Left:=xMini+G.lx-4; 3605 MapBtn3.Top:=ClientHeight-15; } 3606 MapBtn5.Left := xMini + G.lx - 12; 3607 MapBtn5.Top := ClientHeight - 15; 3608 MapBtn4.Left := xMini + G.lx + 20; 3609 MapBtn4.Top := ClientHeight - 15; 3610 MapBtn6.Left := xMini + G.lx + 36; 3611 MapBtn6.Top := ClientHeight - 15; 3612 TreasuryArea.Left := ClientWidth div 2 - 172; 3613 ResearchArea.Left := ClientWidth div 2; 3614 ManagementArea.Left := ClientWidth - xPalace; 3615 ManagementArea.Top := TopBarHeight + MapHeight - overlap + yPalace; 3616 ArrangeMidPanel; 3617 if RepaintOnResize then 3618 begin 3619 RectInvalidate(0, TopBarHeight, ClientWidth, TopBarHeight + MapHeight); 3620 MapValid := false; 3621 PaintAll 3622 end 3623 end; 3624 3625 procedure TMainScreen.FormCloseQuery(Sender: TObject; var CanClose: boolean); 3626 begin 3627 CanClose := Closable; 3628 if not Closable and idle and (me = 0) and (ClientMode < scContact) then 3629 MenuClick(mResign) 3630 end; 3631 3632 procedure TMainScreen.OnScroll(var m: TMessage); 3633 begin 3634 if ProcessPVSB(sb, m) then 3635 begin 3636 PanelPaint; 3637 Update 3638 end 3639 end; 3640 3641 procedure TMainScreen.OnEOT(var Msg: TMessage); 3642 begin 3643 EndTurn 3644 end; 3645 3646 procedure TMainScreen.EOTClick(Sender: TObject); 3647 begin 3648 if GameMode = cMovie then 3649 begin 3650 MessgExDlg.CancelMovie; 3651 Server(sBreak, me, 0, nil^) 3652 end 3653 else if ClientMode < 0 then 3654 skipped := true 3655 else if ClientMode >= scContact then 3656 NegoDlg.ShowNewContent(wmPersistent) 3657 else if Jump[pTurn] > 0 then 3658 begin 3659 Jump[pTurn] := 0; 3660 StartRunning := false 3661 end 3662 else 3663 EndTurn 3664 end; 3665 3666 // set xTerrain, xTroop, and TrRow 3667 procedure TMainScreen.ArrangeMidPanel; 3668 begin 3669 if ClientMode = cEditMap then 3670 xTroop := xMidPanel + 15 3671 else 3672 begin 3673 if supervising then 3674 xTerrain := xMidPanel + 2 * xxt + 14 3675 else if ClientWidth < 1280 then 3676 xTerrain := ClientWidth div 2 + (1280 - ClientWidth) div 3 3677 else 3678 xTerrain := ClientWidth div 2; 3679 xTroop := xTerrain + 2 * xxt + 12; 3680 if SmallScreen and not supervising then 3681 xTroop := xRightPanel + 10 - 3 * 66 - 3682 GetSystemMetrics(SM_CXVSCROLL) - 19 - 4; 3683 // not perfect but we assume almost no one is still playing on a 800x600 screen 3684 end; 3685 TrRow := (xRightPanel + 10 - xTroop - GetSystemMetrics(SM_CXVSCROLL) - 19) 3686 div TrPitch; 3687 end; 3688 3689 function TMainScreen.EndTurn(WasSkipped: boolean): boolean; 3690 3691 function IsResourceUnused(cix, NeedFood, NeedProd: integer): boolean; 3692 var 3693 dx, dy, fix: integer; 3694 CityAreaInfo: TCityAreaInfo; 3695 TileInfo: TTileInfo; 3696 begin 3697 Server(sGetCityAreaInfo, me, cix, CityAreaInfo); 3698 for dy := -3 to 3 do 3699 for dx := -3 to 3 do 3700 if ((dx + dy) and 1 = 0) and (dx * dx * dy * dy < 81) then 3701 begin 3702 fix := (dy + 3) shl 2 + (dx + 3) shr 1; 3703 if (MyCity[cix].Tiles and (1 shl fix) = 0) // not used yet 3704 and (CityAreaInfo.Available[fix] = faAvailable) then // usable 3705 begin 3706 TileInfo.ExplCity := cix; 3707 Server(sGetHypoCityTileInfo, me, dLoc(MyCity[cix].Loc, dx, dy), 3708 TileInfo); 3709 if (TileInfo.Food >= NeedFood) and (TileInfo.Prod >= NeedProd) 3710 then 3711 begin 3712 result := true; 3713 exit 3714 end; 3715 end 3716 end; 3717 result := false; 3718 end; 3719 3720 var 3721 i, p1, uix, cix, CenterLoc: integer; 3722 MsgItem: string; 3723 CityReport: TCityReport; 3724 PlaneReturnData: TPlaneReturnData; 3725 Zoom: boolean; 3726 begin 3727 result := false; 3728 if ClientMode >= scDipOffer then 3729 exit; 3730 3731 if supervising and (me <> 0) then 3732 begin 3733 for i := 0 to Screen.FormCount - 1 do 3734 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) 3735 then 3736 Screen.Forms[i].Close; // close windows 3737 ItsMeAgain(0); 3738 end; 3739 3740 CityOptimizer_EndOfTurn; 3741 3742 if not WasSkipped then // check warnings 3743 begin 3744 // need to move planes home? 3745 for uix := 0 to MyRO.nUn - 1 do 3746 with MyUn[uix] do 3747 if (Loc >= 0) and (MyModel[mix].Domain = dAir) and 3748 (Status and usToldNoReturn = 0) and (Master < 0) and 3749 (MyMap[Loc] and fCity = 0) and (MyMap[Loc] and fTerImp <> tiBase) 3750 then 3751 begin 3752 PlaneReturnData.Fuel := Fuel; 3753 PlaneReturnData.Loc := Loc; 3754 PlaneReturnData.Movement := 0; // end turn without further movement? 3755 if Server(sGetPlaneReturn, me, uix, PlaneReturnData) = eNoWay then 3756 begin 3757 CenterLoc := Loc + G.lx * 6; 3758 // centering the unit itself would make it covered by the query dialog 3759 while CenterLoc >= G.lx * G.ly do 3760 dec(CenterLoc, G.lx * 2); 3761 Centre(CenterLoc); 3762 SetTroopLoc(-1); 3763 PaintAll; 3764 3765 if MyModel[mix].Kind = mkSpecial_Glider then 3766 MsgItem := 'LOWFUEL_GLIDER' 3767 else 3768 MsgItem := 'LOWFUEL'; 3769 if SimpleQuery(mkYesNo, Phrases.Lookup(MsgItem), 3770 'WARNING_LOWSUPPORT') <> mrOK then 3771 begin 3772 SetUnFocus(uix); 3773 SetTroopLoc(Loc); 3774 PanelPaint; 3775 exit; 3776 end; 3777 MyUn[uix].Status := MyUn[uix].Status or usToldNoReturn; 3778 end 3779 end; 3780 3781 if not supervising and (MyRO.TestFlags and tfImmImprove = 0) and 3782 (MyRO.Government <> gAnarchy) and (MyRO.Money + TaxSum < 0) and 3783 (MyRO.TaxRate < 100) then // low funds! 3784 with MessgExDlg do 3785 begin 3786 OpenSound := 'WARNING_LOWFUNDS'; 3787 MessgText := Phrases.Lookup('LOWFUNDS'); 3788 Kind := mkYesNo; 3789 IconKind := mikImp; 3790 IconIndex := imTrGoods; 3791 ShowModal; 3792 if ModalResult <> mrOK then 3793 exit 3794 end; 3795 3796 if MyRO.Government <> gAnarchy then 3797 for cix := 0 to MyRO.nCity - 1 do 3798 with MyCity[cix] do 3799 if (Loc >= 0) and (Flags and chCaptured = 0) then 3800 begin 3801 Zoom := false; 3802 CityReport.HypoTiles := -1; 3803 CityReport.HypoTax := -1; 3804 CityReport.HypoLux := -1; 3805 Server(sGetCityReport, me, cix, CityReport); 3806 3807 if (CityReport.Working - CityReport.Happy > Size shr 1) and 3808 (Flags and chCaptured <= $10000) then 3809 with MessgExDlg do 3810 begin 3811 OpenSound := 'WARNING_DISORDER'; 3812 if Status and csResourceWeightsMask = 0 then 3813 MsgItem := 'DISORDER' 3814 else 3815 MsgItem := 'DISORDER_UNREST'; 3816 MessgText := Format(Phrases.Lookup(MsgItem), [CityName(ID)]); 3817 Kind := mkYesNo; 3818 // BigIcon:=29; 3819 ShowModal; 3820 Zoom := ModalResult <> mrOK; 3821 end; 3822 if not Zoom and (Food + CityReport.FoodRep - CityReport.Eaten < 0) 3823 then 3824 with MessgExDlg do 3825 begin 3826 OpenSound := 'WARNING_FAMINE'; 3827 if Status and csResourceWeightsMask = 0 then 3828 MsgItem := 'FAMINE' 3829 else if (CityReport.Deployed <> 0) and 3830 IsResourceUnused(cix, 1, 0) then 3831 MsgItem := 'FAMINE_UNREST' 3832 else 3833 MsgItem := 'FAMINE_TILES'; 3834 MessgText := Format(Phrases.Lookup(MsgItem), [CityName(ID)]); 3835 Kind := mkYesNo; 3836 IconKind := mikImp; 3837 IconIndex := 22; 3838 ShowModal; 3839 Zoom := ModalResult <> mrOK; 3840 end; 3841 if not Zoom and (CityReport.ProdRep < CityReport.Support) then 3842 with MessgExDlg do 3843 begin 3844 OpenSound := 'WARNING_LOWSUPPORT'; 3845 if Status and csResourceWeightsMask = 0 then 3846 MsgItem := 'LOWSUPPORT' 3847 else if (CityReport.Deployed <> 0) and 3848 IsResourceUnused(cix, 0, 1) then 3849 MsgItem := 'LOWSUPPORT_UNREST' 3850 else 3851 MsgItem := 'LOWSUPPORT_TILES'; 3852 MessgText := Format(Phrases.Lookup(MsgItem), [CityName(ID)]); 3853 Kind := mkYesNo; 3854 IconKind := mikImp; 3855 IconIndex := 29; 3856 ShowModal; 3857 Zoom := ModalResult <> mrOK; 3858 end; 3859 if Zoom then 3860 begin // zoom to city 3861 ZoomToCity(Loc); 3862 exit 3863 end 3864 end; 3865 3866 if (MyRO.Happened and phTech <> 0) and (MyRO.ResearchTech < 0) and 3867 (MyData.FarTech <> adNexus) then 3868 if not ChooseResearch then 3869 exit; 3870 end; 3871 3872 RememberPeaceViolation; 3873 3874 SetUnFocus(-1); 3875 for uix := 0 to MyRO.nUn - 1 do 3876 MyUn[uix].Status := MyUn[uix].Status and usPersistent; 3877 3878 CityDlg.CloseAction := None; 3879 if IsMultiPlayerGame then 3880 begin // close windows for next player 3881 for i := 0 to Screen.FormCount - 1 do 3882 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) 3883 then 3884 Screen.Forms[i].Close; 3885 end 3886 else 3887 begin 3888 if CityDlg.Visible then 3889 CityDlg.Close; 3890 if UnitStatDlg.Visible then 3891 UnitStatDlg.Close; 3892 end; 3893 for i := 0 to Screen.FormCount - 1 do 3894 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then 3895 Screen.Forms[i].Enabled := false; 3896 3897 if Server(sTurn, pTurn, 0, nil^) >= rExecuted then 3898 begin 3899 if Jump[pTurn] > 0 then 3900 EOT.Hint := Phrases.Lookup('BTN_STOP') 3901 else 3902 EOT.Hint := Phrases.Lookup('BTN_SKIP'); 3903 result := true; 3904 SetTroopLoc(-1); 3905 pTurn := -1; 3906 pLogo := -1; 3907 UnitInfoBtn.Visible := false; 3908 UnitBtn.Visible := false; 3909 TerrainBtn.Visible := false; 3910 EOT.ButtonIndex := eotCancel; 3911 EOT.Visible := true; 3912 MapValid := false; 3913 PanelPaint; 3914 Update; 3915 ClientMode := -1; 3916 idle := false; 3917 skipped := WasSkipped; 3918 for p1 := 1 to nPl - 1 do 3919 if G.RO[p1] <> nil then 3920 skipped := true; // don't show enemy moves in hotseat mode 3921 end 3922 else 3923 PanelPaint 3924 end; // EndTurn 3925 3926 procedure TMainScreen.EndNego; 3927 begin 3928 if NegoDlg.Visible then 3929 NegoDlg.Close; 3930 HaveStrategyAdvice := false; 3931 // AdvisorDlg.HaveStrategyAdvice; 3932 // negotiation might have changed advices 3933 EOT.ButtonIndex := eotCancel; 3934 EOT.Visible := true; 3935 PanelPaint; 3936 Update; 3937 ClientMode := -1; 3938 idle := false; 3939 end; 3940 3941 procedure TMainScreen.ProcessRect(x0, y0, nx, ny, Options: integer); 3942 var 3943 xs, ys, xl, yl: integer; 3944 begin 3945 xl := nx * xxt + xxt; 3946 yl := ny * yyt + yyt * 2; 3947 xs := (x0 - xw) * (xxt * 2) + y0 and 1 * xxt - G.lx * (xxt * 2); 3948 // |xs+xl/2-MapWidth/2| -> min 3949 while abs(2 * (xs + G.lx * (xxt * 2)) + xl - MapWidth) < 3950 abs(2 * xs + xl - MapWidth) do 3951 inc(xs, G.lx * (xxt * 2)); 3952 ys := (y0 - yw) * yyt - yyt; 3953 if xs + xl > MapWidth then 3954 xl := MapWidth - xs; 3955 if ys + yl > MapHeight then 3956 yl := MapHeight - ys; 3957 if (xl <= 0) or (yl <= 0) then 3958 exit; 3959 if Options and prPaint <> 0 then 3960 begin 3961 if Options and prAutoBounds <> 0 then 3962 MainMap.SetPaintBounds(xs, ys, xs + xl, ys + yl); 3963 MainMap.Paint(xs, ys, x0 + G.lx * y0, nx, ny, -1, -1); 3964 end; 3965 if Options and prInvalidate <> 0 then 3966 RectInvalidate(MapOffset + xs, TopBarHeight + ys, MapOffset + xs + xl, 3967 TopBarHeight + ys + yl) 3968 end; 3969 3970 procedure TMainScreen.PaintLoc(Loc: integer; Radius: integer = 0); 3971 var 3972 yLoc, x0: integer; 3973 begin 3974 if MapValid then 3975 begin 3976 yLoc := (Loc + G.lx * 1024) div G.lx - 1024; 3977 x0 := (Loc + (yLoc and 1 - 2 * Radius + G.lx * 1024) div 2) mod G.lx; 3978 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 3979 ProcessRect(x0, yLoc - 2 * Radius, 4 * Radius + 1, 4 * Radius + 1, 3980 prPaint or prAutoBounds or prInvalidate); 3981 Update; 3982 end 3983 end; 3984 3985 procedure TMainScreen.PaintLocTemp(Loc, Style: integer); 3986 var 3987 y0, x0, xMap, yMap: integer; 3988 begin 3989 if not MapValid then 3990 exit; 3991 Buffer.Canvas.Font.Assign(UniFont[ftSmall]); 3992 y0 := Loc div G.lx; 3993 x0 := Loc mod G.lx; 3994 xMap := (x0 - xw) * (xxt * 2) + y0 and 1 * xxt - G.lx * (xxt * 2); 3995 // |xMap+xxt-MapWidth/2| -> min 3996 while abs(2 * (xMap + G.lx * (xxt * 2)) + 2 * xxt - MapWidth) < 3997 abs(2 * xMap + 2 * xxt - MapWidth) do 3998 inc(xMap, G.lx * (xxt * 2)); 3999 yMap := (y0 - yw) * yyt - yyt; 4000 NoMap.SetOutput(Buffer); 4001 NoMap.SetPaintBounds(0, 0, 2 * xxt, 3 * yyt); 4002 NoMap.Paint(0, 0, Loc, 1, 1, -1, -1, Style = pltsBlink); 4003 PaintBufferToScreen(xMap, yMap, 2 * xxt, 3 * yyt); 4004 end; 4005 4006 // paint content of buffer directly to screen instead of offscreen 4007 // panel protusions are added 4008 // NoMap must be set to buffer and bounds before 4009 procedure TMainScreen.PaintBufferToScreen(xMap, yMap, width, height: integer); 4010 begin 4011 if xMap + width > MapWidth then 4012 width := MapWidth - xMap; 4013 if yMap + height > MapHeight then 4014 height := MapHeight - yMap; 4015 if (width <= 0) or (height <= 0) or (width + xMap <= 0) or 4016 (height + yMap <= 0) then 4017 exit; 4018 4019 NoMap.BitBlt(Panel, -xMap - MapOffset, -yMap + MapHeight - overlap, 4020 xMidPanel, overlap, 0, 0, SRCCOPY); 4021 NoMap.BitBlt(Panel, -xMap - MapOffset + xRightPanel, 4022 -yMap + MapHeight - overlap, Panel.width - xRightPanel, overlap, 4023 xRightPanel, 0, SRCCOPY); 4024 if yMap < 0 then 4025 begin 4026 if xMap < 0 then 4027 BitBlt(Canvas.Handle, MapOffset, TopBarHeight, width + xMap, 4028 height + yMap, Buffer.Canvas.Handle, -xMap, -yMap, SRCCOPY) 4029 else 4030 BitBlt(Canvas.Handle, xMap + MapOffset, TopBarHeight, width, 4031 height + yMap, Buffer.Canvas.Handle, 0, -yMap, SRCCOPY) 4032 end 4033 else 4034 begin 4035 if xMap < 0 then 4036 BitBlt(Canvas.Handle, MapOffset, TopBarHeight + yMap, width + xMap, 4037 height, Buffer.Canvas.Handle, -xMap, 0, SRCCOPY) 4038 else 4039 BitBlt(Canvas.Handle, xMap + MapOffset, TopBarHeight + yMap, width, 4040 height, Buffer.Canvas.Handle, 0, 0, SRCCOPY); 4041 end 4042 end; 4043 4044 procedure TMainScreen.PaintLoc_BeforeMove(FromLoc: integer); 4045 var 4046 yLoc, x0: integer; 4047 begin 4048 if MapValid then 4049 begin 4050 yLoc := (FromLoc + G.lx * 1024) div G.lx - 1024; 4051 x0 := (FromLoc + (yLoc and 1 + G.lx * 1024) div 2) mod G.lx; 4052 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 4053 ProcessRect(x0, yLoc, 1, 1, prPaint or prAutoBounds); 4054 end 4055 end; 4056 4057 procedure TMainScreen.PaintDestination; 4058 var 4059 Destination: integer; 4060 begin 4061 if (UnFocus >= 0) and (MyUn[UnFocus].Status and usGoto <> 0) then 4062 begin 4063 Destination := MyUn[UnFocus].Status shr 16; 4064 if (Destination <> $7FFF) and (Destination <> MyUn[UnFocus].Loc) then 4065 PaintLocTemp(Destination, pltsBlink); 4066 end; 4067 end; 4068 4069 procedure TMainScreen.MiniPaint; 4070 type 4071 TLine = array [0 .. 99999999, 0 .. 2] of Byte; 4072 var 4073 uix, cix, x, y, Loc, i, hw, xm, cm, cmPolOcean, cmPolNone: integer; 4074 PrevMiniLine, MiniLine: ^TLine; 4075 begin 4076 cmPolOcean := GrExt[HGrSystem].Data.Canvas.Pixels[101, 67]; 4077 cmPolNone := GrExt[HGrSystem].Data.Canvas.Pixels[102, 67]; 4078 hw := MapWidth div (xxt * 2); 4079 with Mini.Canvas do 4080 begin 4081 Brush.Color := $000000; 4082 FillRect(Rect(0, 0, Mini.width, Mini.height)); 4083 end; 4084 MiniLine := nil; 4085 for y := 0 to G.ly - 1 do 4086 begin 4087 PrevMiniLine := MiniLine; 4088 MiniLine := Mini.ScanLine[y]; 4089 for x := 0 to G.lx - 1 do 4090 if MyMap[x + G.lx * y] and fTerrain <> fUNKNOWN then 4091 begin 4092 Loc := x + G.lx * y; 4093 for i := 0 to 1 do 4094 begin 4095 xm := ((x - xwMini) * 2 + i + y and 1 - hw + G.lx * 5) 4096 mod (G.lx * 2); 4097 cm := MiniColors[MyMap[Loc] and fTerrain, i]; 4098 if ClientMode = cEditMap then 4099 begin 4100 if MyMap[Loc] and (fPrefStartPos or fStartPos) <> 0 then 4101 cm := $FFFFFF; 4102 end 4103 else if MyMap[Loc] and fCity <> 0 then 4104 begin 4105 cix := MyRO.nCity - 1; 4106 while (cix >= 0) and (MyCity[cix].Loc <> Loc) do 4107 dec(cix); 4108 if cix >= 0 then 4109 cm := Tribe[me].Color 4110 else 4111 begin 4112 cix := MyRO.nEnemyCity - 1; 4113 while (cix >= 0) and (MyRO.EnemyCity[cix].Loc <> Loc) do 4114 dec(cix); 4115 if cix >= 0 then 4116 cm := Tribe[MyRO.EnemyCity[cix].Owner].Color 4117 end; 4118 cm := $808080 or cm shr 1; { increase brightness } 4119 if PrevMiniLine <> nil then 4120 begin // 2x2 city dot covers two scanlines 4121 PrevMiniLine[xm, 0] := cm shr 16; 4122 PrevMiniLine[xm, 1] := cm shr 8 and $FF; 4123 PrevMiniLine[xm, 2] := cm and $FF; 4124 end 4125 end 4126 else if (i = 0) and (MyMap[Loc] and fUnit <> 0) then 4127 begin 4128 uix := MyRO.nUn - 1; 4129 while (uix >= 0) and (MyUn[uix].Loc <> Loc) do 4130 dec(uix); 4131 if uix >= 0 then 4132 cm := Tribe[me].Color 4133 else 4134 begin 4135 uix := MyRO.nEnemyUn - 1; 4136 while (uix >= 0) and (MyRO.EnemyUn[uix].Loc <> Loc) do 4137 dec(uix); 4138 if uix >= 0 then 4139 cm := Tribe[MyRO.EnemyUn[uix].Owner].Color 4140 end; 4141 cm := $808080 or cm shr 1; { increase brightness } 4142 end 4143 else if MapOptionChecked and (1 shl moPolitical) <> 0 then 4144 begin 4145 if MyMap[Loc] and fTerrain < fGrass then 4146 cm := cmPolOcean 4147 else if MyRO.Territory[Loc] < 0 then 4148 cm := cmPolNone 4149 else 4150 cm := Tribe[MyRO.Territory[Loc]].Color; 4151 end; 4152 MiniLine[xm, 0] := cm shr 16; 4153 MiniLine[xm, 1] := cm shr 8 and $FF; 4154 MiniLine[xm, 2] := cm and $FF; 4155 end; 4156 end 4157 end; 4158 end; 4159 4160 procedure TMainScreen.MainOffscreenPaint; 4161 var 4162 ProcessOptions: integer; 4163 rec: TRect; 4164 DoInvalidate: boolean; 4165 begin 4166 if me < 0 then 4167 with offscreen.Canvas do 4168 begin 4169 Brush.Color := $000000; 4170 FillRect(Rect(0, 0, MapWidth, MapHeight)); 4171 Brush.Style := bsClear; 4172 OffscreenUser := self; 4173 exit 4174 end; 4175 4176 MainMap.SetPaintBounds(0, 0, MapWidth, MapHeight); 4177 if OffscreenUser <> self then 4178 begin 4179 if OffscreenUser <> nil then 4180 OffscreenUser.Update; 4181 // complete working with old owner to prevent rebound 4182 if MapValid and (xwd = xw) and (ywd = yw) then 4183 MainMap.SetPaintBounds(0, 0, UsedOffscreenWidth, UsedOffscreenHeight); 4184 MapValid := false; 4185 OffscreenUser := self; 4186 end; 4187 4188 if xw - xwd > G.lx div 2 then 4189 xwd := xwd + G.lx 4190 else if xwd - xw > G.lx div 2 then 4191 xwd := xwd - G.lx; 4192 if not MapValid or (xw - xwd > MapWidth div (xxt * 2)) or 4193 (xwd - xw > MapWidth div (xxt * 2)) or (yw - ywd > MapHeight div yyt) or 4194 (ywd - yw > MapHeight div yyt) then 4195 begin 4196 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 4197 ProcessRect(xw, yw, MapWidth div xxt, MapHeight div yyt, 4198 prPaint or prInvalidate) 4199 end 4200 else 4201 begin 4202 if (xwd = xw) and (ywd = yw) then 4203 exit; { map window not moved } 4204 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 4205 rec := Rect(0, 0, MapWidth, MapHeight); 4206 ScrollDC(offscreen.Canvas.Handle, (xwd - xw) * (xxt * 2), 4207 (ywd - yw) * yyt, rec, rec, 0, nil); 4208 for DoInvalidate := false to FastScrolling do 4209 begin 4210 if DoInvalidate then 4211 begin 4212 rec.Bottom := MapHeight - overlap; 4213 ScrollDC(Canvas.Handle, (xwd - xw) * (xxt * 2), (ywd - yw) * yyt, rec, 4214 rec, 0, nil); 4215 ProcessOptions := prInvalidate; 4216 end 4217 else 4218 ProcessOptions := prPaint or prAutoBounds; 4219 if yw < ywd then 4220 begin 4221 ProcessRect(xw, yw, MapWidth div xxt, ywd - yw - 1, ProcessOptions); 4222 if xw < xwd then 4223 ProcessRect(xw, ywd, (xwd - xw) * 2 - 1, MapHeight div yyt - ywd + 4224 yw, ProcessOptions) 4225 else if xw > xwd then 4226 ProcessRect((xwd + MapWidth div (xxt * 2)) mod G.lx, ywd, 4227 (xw - xwd) * 2 + 1, MapHeight div yyt - ywd + yw, ProcessOptions) 4228 end 4229 else if yw > ywd then 4230 begin 4231 if DoInvalidate then 4232 RectInvalidate(MapOffset, TopBarHeight + MapHeight - overlap - 4233 (yw - ywd) * yyt, MapOffset + MapWidth, TopBarHeight + MapHeight 4234 - overlap) 4235 else 4236 ProcessRect(xw, (ywd + MapHeight div (yyt * 2) * 2), 4237 MapWidth div xxt, yw - ywd + 1, ProcessOptions); 4238 if xw < xwd then 4239 ProcessRect(xw, yw, (xwd - xw) * 2 - 1, MapHeight div yyt - yw + ywd 4240 - 2, ProcessOptions) 4241 else if xw > xwd then 4242 ProcessRect((xwd + MapWidth div (xxt * 2)) mod G.lx, yw, 4243 (xw - xwd) * 2 + 1, MapHeight div yyt - yw + ywd - 2, 4244 ProcessOptions) 4245 end 4246 else if xw < xwd then 4247 ProcessRect(xw, yw, (xwd - xw) * 2 - 1, MapHeight div yyt, 4248 ProcessOptions) 4249 else if xw > xwd then 4250 ProcessRect((xwd + MapWidth div (xxt * 2)) mod G.lx, yw, 4251 (xw - xwd) * 2 + 1, MapHeight div yyt, ProcessOptions); 4252 end; 4253 if not FastScrolling then 4254 RectInvalidate(MapOffset, TopBarHeight, MapOffset + MapWidth, 4255 TopBarHeight + MapHeight - overlap); 4256 RectInvalidate(xMidPanel, TopBarHeight + MapHeight - overlap, xRightPanel, 4257 TopBarHeight + MapHeight) 4258 end; 4259 // if (xwd<>xw) or (ywd<>yw) then 4260 // Server(sChangeSuperView,me,yw*G.lx+xw,nil^); // for synchronizing client side viewer, not used currently 4261 xwd := xw; 4262 ywd := yw; 4263 MapValid := true; 4264 end; 4265 4266 procedure TMainScreen.PaintAll; 4267 begin 4268 MainOffscreenPaint; 4269 xwMini := xw; 4270 ywMini := yw; 4271 MiniPaint; 4272 PanelPaint; 4273 end; 4274 4275 procedure TMainScreen.PaintAllMaps; 4276 begin 4277 MainOffscreenPaint; 4278 xwMini := xw; 4279 ywMini := yw; 4280 MiniPaint; 4281 CopyMiniToPanel; 4282 RectInvalidate(xMini + 2, TopBarHeight + MapHeight - overlap + yMini + 2, 4283 xMini + 2 + G.lx * 2, TopBarHeight + MapHeight - overlap + yMini + 4284 2 + G.ly); 4285 end; 4286 4287 procedure TMainScreen.CopyMiniToPanel; 4288 begin 4289 BitBlt(Panel.Canvas.Handle, xMini + 2, yMini + 2, G.lx * 2, G.ly, 4290 Mini.Canvas.Handle, 0, 0, SRCCOPY); 4291 if MarkCityLoc >= 0 then 4292 Sprite(Panel, HGrSystem, 4293 xMini - 2 + (4 * G.lx + 2 * (MarkCityLoc mod G.lx) + 4294 (G.lx - MapWidth div (xxt * 2)) - 2 * xwd) mod (2 * G.lx) + 4295 MarkCityLoc div G.lx and 1, yMini - 3 + MarkCityLoc div G.lx, 10, 4296 10, 77, 47) 4297 else if ywmax <= 0 then 4298 Frame(Panel.Canvas, xMini + 2 + G.lx - MapWidth div (xxt * 2), yMini + 2, 4299 xMini + 1 + G.lx + MapWidth div (xxt * 2), yMini + 2 + G.ly - 1, 4300 MainTexture.clMark, MainTexture.clMark) 4301 else 4302 Frame(Panel.Canvas, xMini + 2 + G.lx - MapWidth div (xxt * 2), 4303 yMini + 2 + yw, xMini + 1 + G.lx + MapWidth div (xxt * 2), 4304 yMini + yw + MapHeight div yyt, MainTexture.clMark, MainTexture.clMark); 4305 end; 4306 4307 procedure TMainScreen.PanelPaint; 4308 4309 function MovementToString(var Un: TUn): string; 4310 begin 4311 result := ScreenTools.MovementToString(Un.Movement); 4312 if Un.Master >= 0 then 4313 result := '(' + result + ')' 4314 else if (MyModel[Un.mix].Domain = dAir) and 4315 (MyModel[Un.mix].Kind <> mkSpecial_Glider) then 4316 result := Format('%s(%d)', [result, Un.Fuel]); 4317 end; 4318 4319 var 4320 i, uix, uixDefender, x, xSrc, ySrc, xSrcBase, ySrcBase, CostFactor, Count, 4321 mixShow, xTreasurySection, xResearchSection, JobFocus, TrueMoney, 4322 TrueResearch: integer; 4323 Tile: Cardinal; 4324 s: string; 4325 unx: TUn; 4326 UnitInfo: TUnitInfo; 4327 JobProgressData: TJobProgressData; 4328 Prio: boolean; 4329 begin 4330 with Panel.Canvas do 4331 begin 4332 Fill(Panel.Canvas, 0, 3, xMidPanel + 7 - 10, PanelHeight - 3, 4333 wMainTexture - (xMidPanel + 7 - 10), hMainTexture - PanelHeight); 4334 Fill(Panel.Canvas, xRightPanel + 10 - 7, 3, Panel.width - xRightPanel - 10 4335 + 7, PanelHeight - 3, -(xRightPanel + 10 - 7), 4336 hMainTexture - PanelHeight); 4337 FillLarge(Panel.Canvas, xMidPanel - 2, PanelHeight - MidPanelHeight, 4338 xRightPanel + 2, PanelHeight, ClientWidth div 2); 4339 4340 Brush.Style := bsClear; 4341 Pen.Color := $000000; 4342 MoveTo(0, 0); 4343 LineTo(xMidPanel + 7 - 8, 0); 4344 LineTo(xMidPanel + 7 - 8, PanelHeight - MidPanelHeight); 4345 LineTo(xRightPanel, PanelHeight - MidPanelHeight); 4346 LineTo(xRightPanel, 0); 4347 LineTo(ClientWidth, 0); 4348 Pen.Color := MainTexture.clBevelLight; 4349 MoveTo(xMidPanel + 7 - 9, PanelHeight - MidPanelHeight + 2); 4350 LineTo(xRightPanel + 10 - 8, PanelHeight - MidPanelHeight + 2); 4351 Pen.Color := MainTexture.clBevelLight; 4352 MoveTo(0, 1); 4353 LineTo(xMidPanel + 7 - 9, 1); 4354 Pen.Color := MainTexture.clBevelShade; 4355 LineTo(xMidPanel + 7 - 9, PanelHeight - MidPanelHeight + 1); 4356 Pen.Color := MainTexture.clBevelLight; 4357 LineTo(xRightPanel + 10 - 9, PanelHeight - MidPanelHeight + 1); 4358 Pen.Color := MainTexture.clBevelLight; 4359 LineTo(xRightPanel + 10 - 9, 1); 4360 LineTo(ClientWidth, 1); 4361 MoveTo(ClientWidth, 2); 4362 LineTo(xRightPanel + 10 - 8, 2); 4363 LineTo(xRightPanel + 10 - 8, PanelHeight); 4364 MoveTo(0, 2); 4365 LineTo(xMidPanel + 7 - 10, 2); 4366 Pen.Color := MainTexture.clBevelShade; 4367 LineTo(xMidPanel + 7 - 10, PanelHeight); 4368 Corner(Panel.Canvas, xMidPanel + 7 - 16, 1, 1, MainTexture); 4369 Corner(Panel.Canvas, xRightPanel + 10 - 9, 1, 0, MainTexture); 4370 if ClientMode <> cEditMap then 4371 begin 4372 if supervising then 4373 begin 4374 Frame(Panel.Canvas, ClientWidth - xPalace - 1, yPalace - 1, 4375 ClientWidth - xPalace + xSizeBig, yPalace + ySizeBig, 4376 $B0B0B0, $FFFFFF); 4377 RFrame(Panel.Canvas, ClientWidth - xPalace - 2, yPalace - 2, 4378 ClientWidth - xPalace + xSizeBig + 1, yPalace + ySizeBig + 1, 4379 $FFFFFF, $B0B0B0); 4380 BitBlt(Panel.Canvas.Handle, ClientWidth - xPalace, yPalace, xSizeBig, 4381 ySizeBig, GrExt[HGrSystem2].Data.Canvas.Handle, 70, 123, SRCCOPY); 4382 end 4383 else if MyRO.NatBuilt[imPalace] > 0 then 4384 ImpImage(Panel.Canvas, ClientWidth - xPalace, yPalace, imPalace, -1, 4385 GameMode <> cMovie 4386 { (GameMode<>cMovie) and (MyRO.Government<>gAnarchy) } ) 4387 else 4388 ImpImage(Panel.Canvas, ClientWidth - xPalace, yPalace, 21, -1, 4389 GameMode <> cMovie 4390 { (GameMode<>cMovie) and (MyRO.Government<>gAnarchy) } ); 4391 end; 4392 4393 if GameMode = cMovie then 4394 Frame(Panel.Canvas, xMini + 1, yMini + 1, xMini + 2 + G.lx * 2, 4395 yMini + 2 + G.ly, $000000, $000000) 4396 else 4397 begin 4398 Frame(Panel.Canvas, xMini + 1, yMini + 1, xMini + 2 + G.lx * 2, 4399 yMini + 2 + G.ly, $B0B0B0, $FFFFFF); 4400 RFrame(Panel.Canvas, xMini, yMini, xMini + 3 + G.lx * 2, 4401 yMini + 3 + G.ly, $FFFFFF, $B0B0B0); 4402 end; 4403 CopyMiniToPanel; 4404 if ClientMode <> cEditMap then // MapBtn icons 4405 for i := 0 to 5 do 4406 if i <> 3 then 4407 Dump(Panel, HGrSystem, xMini + G.lx - 42 + 16 * i, PanelHeight - 26, 4408 8, 8, 121 + i * 9, 61); 4409 4410 if ClientMode = cEditMap then 4411 begin 4412 for i := 0 to TrRow - 1 do 4413 trix[i] := -1; 4414 Count := 0; 4415 for i := 0 to nBrushTypes - 1 do 4416 begin // display terrain types 4417 if (Count >= TrRow * sb.si.npos) and (Count < TrRow * (sb.si.npos + 1)) 4418 then 4419 begin 4420 trix[Count - TrRow * sb.si.npos] := BrushTypes[i]; 4421 x := (Count - TrRow * sb.si.npos) * TrPitch; 4422 xSrcBase := -1; 4423 case BrushTypes[i] of 4424 0 .. 8: 4425 begin 4426 xSrc := BrushTypes[i]; 4427 ySrc := 0 4428 end; 4429 9 .. 30: 4430 begin 4431 xSrcBase := 2; 4432 ySrcBase := 2; 4433 xSrc := 0; 4434 ySrc := 2 * integer(BrushTypes[i]) - 15 4435 end; 4436 fRiver: 4437 begin 4438 xSrc := 7; 4439 ySrc := 14 4440 end; 4441 fRoad: 4442 begin 4443 xSrc := 0; 4444 ySrc := 9 4445 end; 4446 fRR: 4447 begin 4448 xSrc := 0; 4449 ySrc := 10 4450 end; 4451 fCanal: 4452 begin 4453 xSrc := 0; 4454 ySrc := 11 4455 end; 4456 fPoll: 4457 begin 4458 xSrc := 6; 4459 ySrc := 12 4460 end; 4461 fDeadLands, fDeadLands or fCobalt, fDeadLands or fUranium, 4462 fDeadLands or fMercury: 4463 begin 4464 xSrcBase := 6; 4465 ySrcBase := 2; 4466 xSrc := 8; 4467 ySrc := 12 + BrushTypes[i] shr 25; 4468 end; 4469 tiIrrigation, tiFarm, tiMine, tiBase: 4470 begin 4471 xSrc := BrushTypes[i] shr 12 - 1; 4472 ySrc := 12 4473 end; 4474 tiFort: 4475 begin 4476 xSrc := 3; 4477 ySrc := 12; 4478 xSrcBase := 7; 4479 ySrcBase := 12 4480 end; 4481 fPrefStartPos: 4482 begin 4483 xSrc := 0; 4484 ySrc := 1 4485 end; 4486 fStartPos: 4487 begin 4488 xSrc := 0; 4489 ySrc := 2 4490 end; 4491 end; 4492 if xSrcBase >= 0 then 4493 Sprite(Panel, HGrTerrain, xTroop + 2 + x, yTroop + 9 - yyt, 4494 xxt * 2, yyt * 3, 1 + xSrcBase * (xxt * 2 + 1), 4495 1 + ySrcBase * (yyt * 3 + 1)); 4496 Sprite(Panel, HGrTerrain, xTroop + 2 + x, yTroop + 9 - yyt, xxt * 2, 4497 yyt * 3, 1 + xSrc * (xxt * 2 + 1), 1 + ySrc * (yyt * 3 + 1)); 4498 if BrushTypes[i] = BrushType then 4499 begin 4500 Frame(Panel.Canvas, xTroop + 2 + x, yTroop + 7 - yyt div 2, 4501 xTroop + 2 * xxt + x, yTroop + 2 * yyt + 11, $000000, $000000); 4502 Frame(Panel.Canvas, xTroop + 1 + x, yTroop + 6 - yyt div 2, 4503 xTroop + 2 * xxt - 1 + x, yTroop + 2 * yyt + 10, 4504 MainTexture.clMark, MainTexture.clMark); 4505 end 4506 end; 4507 inc(Count) 4508 end; 4509 case BrushType of 4510 fDesert, fPrairie, fTundra, fArctic, fSwamp, fHills, fMountains: 4511 s := Phrases.Lookup('TERRAIN', BrushType); 4512 fShore: 4513 s := Format(Phrases.Lookup('TWOTERRAINS'), 4514 [Phrases.Lookup('TERRAIN', fOcean), Phrases.Lookup('TERRAIN', 4515 fShore)]); 4516 fGrass: 4517 s := Format(Phrases.Lookup('TWOTERRAINS'), 4518 [Phrases.Lookup('TERRAIN', fGrass), Phrases.Lookup('TERRAIN', 4519 fGrass + 12)]); 4520 fForest: 4521 s := Format(Phrases.Lookup('TWOTERRAINS'), 4522 [Phrases.Lookup('TERRAIN', fForest), Phrases.Lookup('TERRAIN', 4523 fJungle)]); 4524 fRiver: 4525 s := Phrases.Lookup('RIVER'); 4526 fDeadLands, fDeadLands or fCobalt, fDeadLands or fUranium, 4527 fDeadLands or fMercury: 4528 s := Phrases.Lookup('TERRAIN', 3 * 12 + BrushType shr 25); 4529 fPrefStartPos: 4530 s := Phrases.Lookup('MAP_PREFSTART'); 4531 fStartPos: 4532 s := Phrases.Lookup('MAP_START'); 4533 fPoll: 4534 s := Phrases.Lookup('POLL'); 4535 else // terrain improvements 4536 begin 4537 case BrushType of 4538 fRoad: 4539 i := 1; 4540 fRR: 4541 i := 2; 4542 tiIrrigation: 4543 i := 4; 4544 tiFarm: 4545 i := 5; 4546 tiMine: 4547 i := 7; 4548 fCanal: 4549 i := 8; 4550 tiFort: 4551 i := 10; 4552 tiBase: 4553 i := 12; 4554 end; 4555 s := Phrases.Lookup('JOBRESULT', i); 4556 end 4557 end; 4558 LoweredTextOut(Panel.Canvas, -1, MainTexture, xTroop + 1, 4559 PanelHeight - 19, s); 4560 end 4561 else if TroopLoc >= 0 then 4562 begin 4563 Brush.Style := bsClear; 4564 if UnFocus >= 0 then 4565 with MyUn[UnFocus], MyModel[mix] do 4566 begin { display info about selected unit } 4567 if Job = jCity then 4568 mixShow := -1 // building site 4569 else 4570 mixShow := mix; 4571 with Tribe[me].ModelPicture[mixShow] do 4572 begin 4573 Sprite(Panel, HGr, xMidPanel + 7 + 12, yTroop + 1, 64, 48, 4574 pix mod 10 * 65 + 1, pix div 10 * 49 + 1); 4575 if MyUn[UnFocus].Flags and unFortified <> 0 then 4576 Sprite(Panel, HGrStdUnits, xMidPanel + 7 + 12, yTroop + 1, 4577 xxu * 2, yyu * 2, 1 + 6 * (xxu * 2 + 1), 1); 4578 end; 4579 4580 MakeBlue(Panel, xMidPanel + 7 + 12 + 10, yTroop - 13, 44, 12); 4581 s := MovementToString(MyUn[UnFocus]); 4582 RisedTextOut(Panel.Canvas, xMidPanel + 7 + 12 + 32 - 4583 BiColorTextWidth(Panel.Canvas, s) div 2, yTroop - 16, s); 4584 4585 s := IntToStr(Health) + '%'; 4586 LightGradient(Panel.Canvas, xMidPanel + 7 + 12 + 7, 4587 PanelHeight - 22, (Health + 1) div 2, 4588 (ColorOfHealth(Health) and $FEFEFE shr 2) * 3); 4589 if Health < 100 then 4590 LightGradient(Panel.Canvas, xMidPanel + 7 + 12 + 7 + (Health + 1) 4591 div 2, PanelHeight - 22, 50 - (Health + 1) div 2, $000000); 4592 RisedTextOut(Panel.Canvas, xMidPanel + 7 + 12 + 32 - 4593 BiColorTextWidth(Panel.Canvas, s) div 2, PanelHeight - 23, s); 4594 4595 FrameImage(Panel.Canvas, GrExt[HGrSystem].Data, 4596 xMidPanel + 7 + xUnitText, yTroop + 15, 12, 14, 4597 121 + Exp div ExpCost * 13, 28); 4598 if Job = jCity then 4599 s := Tribe[me].ModelName[-1] 4600 else 4601 s := Tribe[me].ModelName[mix]; 4602 if Home >= 0 then 4603 begin 4604 LoweredTextOut(Panel.Canvas, -1, MainTexture, 4605 xMidPanel + 7 + xUnitText + 18, yTroop + 5, s); 4606 LoweredTextOut(Panel.Canvas, -1, MainTexture, 4607 xMidPanel + 7 + xUnitText + 18, yTroop + 21, 4608 '(' + CityName(MyCity[Home].ID) + ')'); 4609 end 4610 else 4611 LoweredTextOut(Panel.Canvas, -1, MainTexture, 4612 xMidPanel + 7 + xUnitText + 18, yTroop + 13, s); 4613 end; 4614 4615 if (UnFocus >= 0) and (MyUn[UnFocus].Loc <> TroopLoc) then 4616 begin // divide panel 4617 if SmallScreen and not supervising then 4618 x := xTroop - 8 4619 else 4620 x := xTroop - 152; 4621 Pen.Color := MainTexture.clBevelShade; 4622 MoveTo(x - 1, PanelHeight - MidPanelHeight + 2); 4623 LineTo(x - 1, PanelHeight); 4624 Pen.Color := MainTexture.clBevelLight; 4625 MoveTo(x, PanelHeight - MidPanelHeight + 2); 4626 LineTo(x, PanelHeight); 4627 end; 4628 4629 for i := 0 to 23 do 4630 trix[i] := -1; 4631 if MyMap[TroopLoc] and fUnit <> 0 then 4632 begin 4633 if MyMap[TroopLoc] and fOwned <> 0 then 4634 begin 4635 if (TrCnt > 1) or (UnFocus < 0) or (MyUn[UnFocus].Loc <> TroopLoc) 4636 then 4637 begin 4638 LoweredTextOut(Panel.Canvas, -1, MainTexture, xTroop + 10, 4639 PanelHeight - 24, Phrases.Lookup('PRESENT')); 4640 Server(sGetDefender, me, TroopLoc, uixDefender); 4641 Count := 0; 4642 for Prio := true downto false do 4643 for uix := 0 to MyRO.nUn - 1 do 4644 if (uix = uixDefender) = Prio then 4645 begin // display own units 4646 unx := MyUn[uix]; 4647 if unx.Loc = TroopLoc then 4648 begin 4649 if (Count >= TrRow * sb.si.npos) and 4650 (Count < TrRow * (sb.si.npos + 1)) then 4651 begin 4652 trix[Count - TrRow * sb.si.npos] := uix; 4653 MakeUnitInfo(me, unx, UnitInfo); 4654 x := (Count - TrRow * sb.si.npos) * TrPitch; 4655 if uix = UnFocus then 4656 begin 4657 Frame(Panel.Canvas, xTroop + 4 + x, yTroop + 3, 4658 xTroop + 64 + x, yTroop + 47, $000000, $000000); 4659 Frame(Panel.Canvas, xTroop + 3 + x, yTroop + 2, 4660 xTroop + 63 + x, yTroop + 46, MainTexture.clMark, 4661 MainTexture.clMark); 4662 end 4663 else if (unx.Master >= 0) and (unx.Master = UnFocus) 4664 then 4665 begin 4666 CFrame(Panel.Canvas, xTroop + 4 + x, yTroop + 3, 4667 xTroop + 64 + x, yTroop + 47, 8, $000000); 4668 CFrame(Panel.Canvas, xTroop + 3 + x, yTroop + 2, 4669 xTroop + 63 + x, yTroop + 46, 8, 4670 MainTexture.clMark); 4671 end; 4672 NoMap.SetOutput(Panel); 4673 NoMap.PaintUnit(xTroop + 2 + x, yTroop + 1, UnitInfo, 4674 unx.Status); 4675 if (ClientMode < scContact) and 4676 ((unx.Job > jNone) or 4677 (unx.Status and (usStay or usRecover or usGoto) <> 0)) 4678 then 4679 Sprite(Panel, HGrSystem, xTroop + 2 + 60 - 20 + x, 4680 yTroop + 35, 20, 20, 81, 25); 4681 4682 if not supervising then 4683 begin 4684 MakeBlue(Panel, xTroop + 2 + 10 + x, 4685 yTroop - 13, 44, 12); 4686 s := MovementToString(unx); 4687 RisedTextOut(Panel.Canvas, 4688 xTroop + x + 34 - BiColorTextWidth(Panel.Canvas, s) 4689 div 2, yTroop - 16, s); 4690 end 4691 end; 4692 inc(Count) 4693 end; 4694 end; // for uix:=0 to MyRO.nUn-1 4695 assert(Count = TrCnt); 4696 end 4697 end 4698 else 4699 begin 4700 LoweredTextOut(Panel.Canvas, -1, MainTexture, xTroop + 8, 4701 PanelHeight - 24, Phrases.Lookup('PRESENT')); 4702 Server(sGetUnits, me, TroopLoc, Count); 4703 for i := 0 to Count - 1 do 4704 if (i >= TrRow * sb.si.npos) and (i < TrRow * (sb.si.npos + 1)) 4705 then 4706 begin // display enemy units 4707 trix[i - TrRow * sb.si.npos] := i; 4708 x := (i - TrRow * sb.si.npos) * TrPitch; 4709 NoMap.SetOutput(Panel); 4710 NoMap.PaintUnit(xTroop + 2 + x, yTroop + 1, 4711 MyRO.EnemyUn[MyRO.nEnemyUn + i], 0); 4712 end; 4713 end; 4714 end; 4715 if not SmallScreen or supervising then 4716 begin // show terrain and improvements 4717 PaintZoomedTile(Panel, xTerrain - xxt * 2, 110 - yyt * 3, TroopLoc); 4718 if (UnFocus >= 0) and (MyUn[UnFocus].Job <> jNone) then 4719 begin 4720 JobFocus := MyUn[UnFocus].Job; 4721 Server(sGetJobProgress, me, MyUn[UnFocus].Loc, JobProgressData); 4722 MakeBlue(Panel, xTerrain - 72, 148 - 17, 144, 31); 4723 PaintRelativeProgressBar(Panel.Canvas, 3, xTerrain - 68, 148 + 3, 4724 63, JobProgressData[JobFocus].Done, 4725 JobProgressData[JobFocus].NextTurnPlus, 4726 JobProgressData[JobFocus].Required, true, MainTexture); 4727 s := Format('%s/%s', 4728 [ScreenTools.MovementToString(JobProgressData[JobFocus].Done), 4729 ScreenTools.MovementToString(JobProgressData[JobFocus] 4730 .Required)]); 4731 RisedTextOut(Panel.Canvas, xTerrain + 6, 148 - 3, s); 4732 Tile := MyMap[MyUn[UnFocus].Loc]; 4733 if (JobFocus = jRoad) and (Tile and fRiver <> 0) then 4734 JobFocus := nJob + 0 4735 else if (JobFocus = jRR) and (Tile and fRiver <> 0) then 4736 JobFocus := nJob + 1 4737 else if JobFocus = jClear then 4738 begin 4739 if Tile and fTerrain = fForest then 4740 JobFocus := nJob + 2 4741 else if Tile and fTerrain = fDesert then 4742 JobFocus := nJob + 3 4743 else 4744 JobFocus := nJob + 4 4745 end; 4746 s := Phrases.Lookup('JOBRESULT', JobFocus); 4747 RisedTextOut(Panel.Canvas, xTerrain - BiColorTextWidth(Panel.Canvas, 4748 s) div 2, 148 - 19, s); 4749 end; 4750 if MyMap[TroopLoc] and (fTerrain or fSpecial) = fGrass or fSpecial1 4751 then 4752 s := Phrases.Lookup('TERRAIN', fGrass + 12) 4753 else if MyMap[TroopLoc] and fDeadLands <> 0 then 4754 s := Phrases.Lookup('TERRAIN', 3 * 12) 4755 else if (MyMap[TroopLoc] and fTerrain = fForest) and 4756 IsJungle(TroopLoc div G.lx) then 4757 s := Phrases.Lookup('TERRAIN', fJungle) 4758 else 4759 s := Phrases.Lookup('TERRAIN', MyMap[TroopLoc] and fTerrain); 4760 RisedTextOut(Panel.Canvas, xTerrain - BiColorTextWidth(Panel.Canvas, 4761 s) div 2, 99, s); 4762 end; 4763 4764 if TerrainBtn.Visible then 4765 with TerrainBtn do 4766 RFrame(Panel.Canvas, Left - 1, Top - self.ClientHeight + 4767 (PanelHeight - 1), Left + width, Top + height - self.ClientHeight 4768 + PanelHeight, MainTexture.clBevelShade, MainTexture.clBevelLight) 4769 end { if TroopLoc>=0 } 4770 end; 4771 4772 for i := 0 to ControlCount - 1 do 4773 if Controls[i] is TButtonB then 4774 with TButtonB(Controls[i]) do 4775 begin 4776 if Visible then 4777 begin 4778 Dump(Panel, HGrSystem, Left, Top - self.ClientHeight + PanelHeight, 4779 25, 25, 169, 243); 4780 Sprite(Panel, HGrSystem, Left, Top - self.ClientHeight + 4781 PanelHeight, 25, 25, 1 + 26 * ButtonIndex, 337); 4782 RFrame(Panel.Canvas, Left - 1, Top - self.ClientHeight + 4783 (PanelHeight - 1), Left + width, Top + height - self.ClientHeight 4784 + PanelHeight, MainTexture.clBevelShade, 4785 MainTexture.clBevelLight); 4786 end; 4787 end; 4788 4789 if ClientMode <> cEditMap then 4790 begin 4791 for i := 0 to ControlCount - 1 do 4792 if Controls[i] is TButtonC then 4793 with TButtonC(Controls[i]) do 4794 begin 4795 Dump(Panel, HGrSystem, Left, Top - self.ClientHeight + PanelHeight, 4796 12, 12, 169, 178 + 13 * ButtonIndex); 4797 RFrame(Panel.Canvas, Left - 1, Top - self.ClientHeight + 4798 (PanelHeight - 1), Left + width, Top + height - self.ClientHeight 4799 + PanelHeight, MainTexture.clBevelShade, 4800 MainTexture.clBevelLight); 4801 end 4802 end; 4803 EOT.SetBack(Panel.Canvas, EOT.Left, EOT.Top - (ClientHeight - PanelHeight)); 4804 SmartRectInvalidate(0, ClientHeight - PanelHeight, ClientWidth, 4805 ClientHeight); 4806 4807 // topbar 4808 xTreasurySection := ClientWidth div 2 - 172; 4809 xResearchSection := ClientWidth div 2; 4810 // ClientWidth div 2+68 = maximum to right 4811 FillLarge(TopBar.Canvas, 0, 0, ClientWidth, TopBarHeight - 3, 4812 ClientWidth div 2); 4813 with TopBar.Canvas do 4814 begin 4815 Pen.Color := $000000; 4816 MoveTo(0, TopBarHeight - 1); 4817 LineTo(ClientWidth, TopBarHeight - 1); 4818 Pen.Color := MainTexture.clBevelShade; 4819 MoveTo(0, TopBarHeight - 2); 4820 LineTo(ClientWidth, TopBarHeight - 2); 4821 MoveTo(0, TopBarHeight - 3); 4822 LineTo(ClientWidth, TopBarHeight - 3); 4823 Pen.Color := MainTexture.clBevelLight; 4824 Frame(TopBar.Canvas, 40, -1, xTreasurySection - 1, TopBarHeight - 7, 4825 MainTexture.clBevelShade, MainTexture.clBevelLight); 4826 Frame(TopBar.Canvas, xResearchSection + 332, -1, ClientWidth, 4827 TopBarHeight - 7, MainTexture.clBevelShade, MainTexture.clBevelLight); 4828 end; 4829 if GameMode <> cMovie then 4830 ImageOp_BCC(TopBar, Templates, 2, 1, 145, 38, 36, 36, $BFBF20, $4040DF); 4831 if MyRO.nCity > 0 then 4832 begin 4833 TrueMoney := MyRO.Money; 4834 TrueResearch := MyRO.Research; 4835 if supervising then 4836 begin // normalize values from after-turn state 4837 dec(TrueMoney, TaxSum); 4838 if TrueMoney < 0 then 4839 TrueMoney := 0; // shouldn't happen 4840 dec(TrueResearch, ScienceSum); 4841 if TrueResearch < 0 then 4842 TrueResearch := 0; // shouldn't happen 4843 end; 4844 4845 // treasury section 4846 ImageOp_BCC(TopBar, Templates, xTreasurySection + 8, 1, 145, 1, 36, 36, 4847 $40A040, $4030C0); 4848 s := IntToStr(TrueMoney); 4849 LoweredTextOut(TopBar.Canvas, -1, MainTexture, xTreasurySection + 48, 0, 4850 s + '%c'); 4851 if MyRO.Government <> gAnarchy then 4852 begin 4853 ImageOp_BCC(TopBar, Templates, xTreasurySection + 48, 22, 124, 1, 14, 4854 14, $0000C0, $0080C0); 4855 if TaxSum >= 0 then 4856 s := Format(Phrases.Lookup('MONEYGAINPOS'), [TaxSum]) 4857 else 4858 s := Format(Phrases.Lookup('MONEYGAINNEG'), [TaxSum]); 4859 LoweredTextOut(TopBar.Canvas, -1, MainTexture, 4860 xTreasurySection + 48 + 15, 18, s); 4861 end; 4862 4863 // research section 4864 ImageOp_BCC(TopBar, Templates, xResearchSection + 8, 1, 145, 75, 36, 36, 4865 $FF0000, $00FFE0); 4866 if MyData.FarTech <> adNexus then 4867 begin 4868 if MyRO.ResearchTech < 0 then 4869 CostFactor := 2 4870 else if (MyRO.ResearchTech = adMilitary) or 4871 (MyRO.Tech[MyRO.ResearchTech] = tsSeen) then 4872 CostFactor := 1 4873 else if MyRO.ResearchTech in FutureTech then 4874 if MyRO.Government = gFuture then 4875 CostFactor := 4 4876 else 4877 CostFactor := 8 4878 else 4879 CostFactor := 2; 4880 Server(sGetTechCost, me, 0, i); 4881 CostFactor := CostFactor * 22; // length of progress bar 4882 PaintRelativeProgressBar(TopBar.Canvas, 2, xResearchSection + 48 + 1, 4883 26, CostFactor, TrueResearch, ScienceSum, i, true, MainTexture); 4884 4885 if MyRO.ResearchTech < 0 then 4886 s := Phrases.Lookup('SCIENCE') 4887 else if MyRO.ResearchTech = adMilitary then 4888 s := Phrases.Lookup('INITUNIT') 4889 else 4890 begin 4891 s := Phrases.Lookup('ADVANCES', MyRO.ResearchTech); 4892 if MyRO.ResearchTech in FutureTech then 4893 if MyRO.Tech[MyRO.ResearchTech] >= 1 then 4894 s := s + ' ' + IntToStr(MyRO.Tech[MyRO.ResearchTech] + 1) 4895 else 4896 s := s + ' 1'; 4897 end; 4898 if ScienceSum > 0 then 4899 begin 4900 { j:=(i-MyRO.Research-1) div ScienceSum +1; 4901 if j<1 then j:=1; 4902 if j>1 then 4903 s:=Format(Phrases.Lookup('TECHWAIT'),[s,j]); } 4904 LoweredTextOut(TopBar.Canvas, -1, MainTexture, 4905 xResearchSection + 48, 0, s); 4906 end 4907 else 4908 LoweredTextOut(TopBar.Canvas, -1, MainTexture, 4909 xResearchSection + 48, 0, s); 4910 end 4911 else 4912 CostFactor := 0; 4913 if (MyData.FarTech <> adNexus) and (ScienceSum > 0) then 4914 begin 4915 ImageOp_BCC(TopBar, Templates, xResearchSection + 48 + CostFactor + 11, 4916 22, 124, 1, 14, 14, $0000C0, $0080C0); 4917 s := Format(Phrases.Lookup('TECHGAIN'), [ScienceSum]); 4918 LoweredTextOut(TopBar.Canvas, -1, MainTexture, xResearchSection + 48 + 4919 CostFactor + 26, 18, s); 4920 end 4921 end; 4922 if ClientMode <> cEditMap then 4923 begin 4924 TopBar.Canvas.Font.Assign(UniFont[ftCaption]); 4925 s := TurnToString(MyRO.Turn); 4926 RisedTextOut(TopBar.Canvas, 4927 40 + (xTreasurySection - 40 - BiColorTextWidth(TopBar.Canvas, s)) 4928 div 2, 6, s); 4929 TopBar.Canvas.Font.Assign(UniFont[ftNormal]); 4930 end; 4931 RectInvalidate(0, 0, ClientWidth, TopBarHeight); 4932 end; { PanelPaint } 4933 4934 procedure TMainScreen.FocusOnLoc(Loc: integer; Options: integer = 0); 4935 var 4936 dx: integer; 4937 Outside, Changed: boolean; 4938 begin 4939 dx := G.lx + 1 - (xw - Loc + G.lx * 1024 + 1) mod G.lx; 4940 Outside := (dx >= (MapWidth + 1) div (xxt * 2) - 2) or (ywmax > 0) and 4941 ((yw > 0) and (Loc div G.lx <= yw + 1) or (yw < ywmax) and 4942 (Loc div G.lx >= yw + (MapHeight - 1) div yyt - 2)); 4943 Changed := true; 4944 if Outside then 4945 begin 4946 Centre(Loc); 4947 PaintAllMaps 4948 end 4949 else if not MapValid then 4950 PaintAllMaps 4951 else 4952 Changed := false; 4953 if Options and flRepaintPanel <> 0 then 4954 PanelPaint; 4955 if Changed and (Options and flImmUpdate <> 0) then 4956 Update; 4957 end; 4958 4959 procedure TMainScreen.NextUnit(NearLoc: integer; AutoTurn: boolean); 4960 var 4961 Dist, TestDist: single; 4962 i, uix, NewFocus: integer; 4963 GotoOnly: boolean; 4964 begin 4965 if ClientMode >= scContact then 4966 exit; 4967 DestinationMarkON := false; 4968 PaintDestination; 4969 for GotoOnly := GoOnPhase downto false do 4970 begin 4971 NewFocus := -1; 4972 for i := 1 to MyRO.nUn do 4973 begin 4974 uix := (UnFocus + i) mod MyRO.nUn; 4975 if (MyUn[uix].Loc >= 0) and (MyUn[uix].Job = jNone) and 4976 (MyUn[uix].Status and (usStay or usRecover or usWaiting) = usWaiting) 4977 and (not GotoOnly or (MyUn[uix].Status and usGoto <> 0)) then 4978 if NearLoc < 0 then 4979 begin 4980 NewFocus := uix; 4981 Break 4982 end 4983 else 4984 begin 4985 TestDist := Distance(NearLoc, MyUn[uix].Loc); 4986 if (NewFocus < 0) or (TestDist < Dist) then 4987 begin 4988 NewFocus := uix; 4989 Dist := TestDist 4990 end 4991 end 4992 end; 4993 if GotoOnly then 4994 if NewFocus < 0 then 4995 GoOnPhase := false 4996 else 4997 Break; 4998 end; 4999 if NewFocus >= 0 then 5000 begin 5001 SetUnFocus(NewFocus); 5002 SetTroopLoc(MyUn[NewFocus].Loc); 5003 FocusOnLoc(TroopLoc, flRepaintPanel) 5004 end 5005 else if AutoTurn and not mWaitTurn.Checked then 5006 begin 5007 TurnComplete := true; 5008 SetUnFocus(-1); 5009 SetTroopLoc(-1); 5010 PostMessage(Handle, WM_EOT, 0, 0) 5011 end 5012 else 5013 begin 5014 if { (UnFocus>=0) and } not TurnComplete and EOT.Visible then 5015 Play('TURNEND'); 5016 TurnComplete := true; 5017 SetUnFocus(-1); 5018 SetTroopLoc(-1); 5019 PanelPaint; 5020 end; 5021 end; { NextUnit } 5022 5023 procedure TMainScreen.Scroll(dx, dy: integer); 5024 begin 5025 xw := (xw + G.lx + dx) mod G.lx; 5026 if ywmax > 0 then 5027 begin 5028 yw := yw + 2 * dy; 5029 if yw < 0 then 5030 yw := 0 5031 else if yw > ywmax then 5032 yw := ywmax; 5033 end; 5034 MainOffscreenPaint; 5035 xwMini := xw; 5036 ywMini := yw; 5037 MiniPaint; 5038 CopyMiniToPanel; 5039 RectInvalidate(xMini + 2, TopBarHeight + MapHeight - overlap + yMini + 2, 5040 xMini + 2 + G.lx * 2, TopBarHeight + MapHeight - overlap + yMini + 5041 2 + G.ly); 5042 Update; 5043 end; 5044 5045 procedure TMainScreen.Timer1Timer(Sender: TObject); 5046 var 5047 dx, dy, speed: integer; 5048 begin 5049 if idle and (me >= 0) and (GameMode <> cMovie) then 5050 if (fsModal in Screen.ActiveForm.FormState) or 5051 (Screen.ActiveForm is TBufferedDrawDlg) and 5052 (TBufferedDrawDlg(Screen.ActiveForm).WindowMode <> wmPersistent) then 5053 begin 5054 BlinkTime := BlinkOnTime + BlinkOffTime - 1; 5055 if not BlinkON then 5056 begin 5057 BlinkON := true; 5058 if UnFocus >= 0 then 5059 PaintLocTemp(MyUn[UnFocus].Loc) 5060 else if TurnComplete and not supervising then 5061 EOT.SetButtonIndexFast(eotBlinkOn) 5062 end 5063 end 5064 else 5065 begin 5066 if Application.Active and not mScrollOff.Checked then 5067 begin 5068 if mScrollFast.Checked then 5069 speed := 2 5070 else 5071 speed := 1; 5072 dx := 0; 5073 dy := 0; 5074 if Mouse.CursorPos.y < Screen.height - PanelHeight then 5075 if Mouse.CursorPos.x = 0 then 5076 dx := -speed // scroll left 5077 else if Mouse.CursorPos.x = Screen.width - 1 then 5078 dx := speed; // scroll right 5079 if Mouse.CursorPos.y = 0 then 5080 dy := -speed // scroll up 5081 else if (Mouse.CursorPos.y = Screen.height - 1) and 5082 (Mouse.CursorPos.x >= TerrainBtn.Left + TerrainBtn.width) and 5083 (Mouse.CursorPos.x < xRightPanel + 10 - 8) then 5084 dy := speed; // scroll down 5085 if (dx <> 0) or (dy <> 0) then 5086 begin 5087 if (Screen.ActiveForm <> MainScreen) and 5088 (@Screen.ActiveForm.OnDeactivate <> nil) then 5089 Screen.ActiveForm.OnDeactivate(nil); 5090 Scroll(dx, dy); 5091 end 5092 end; 5093 5094 BlinkTime := (BlinkTime + 1) mod (BlinkOnTime + BlinkOffTime); 5095 BlinkON := BlinkTime >= BlinkOffTime; 5096 DestinationMarkON := true; 5097 if UnFocus >= 0 then 5098 begin 5099 if (BlinkTime = 0) or (BlinkTime = BlinkOffTime) then 5100 begin 5101 PaintLocTemp(MyUn[UnFocus].Loc, pltsBlink); 5102 PaintDestination; 5103 // if MoveHintToLoc>=0 then 5104 // ShowMoveHint(MoveHintToLoc, true); 1703 5105 end 1704 5106 end 1705 else 1706 begin 1707 s:=Tribe[me].TPhrase('AGE'+char(48+Age)); 1708 MessgText:=Format(s,[TurnToString(MyRO.Turn)]); 1709 end; 1710 IconKind:=mikAge; 1711 IconIndex:=Age; 1712 {if age=0 then} Kind:=mkOK 1713 {else begin Kind:=mkOkHelp; HelpKind:=hkAdv; HelpNo:=AgePreq[age]; end}; 1714 CenterTo:=NewAgeCenterTo; 1715 OpenSound:='AGE_'+char(48+Age); 1716 ShowModal; 1717 MyData.ToldAge:=Age; 1718 if Age>0 then 1719 MyData.ToldTech[AgePreq[Age]]:=MyRO.Tech[AgePreq[Age]]; 1720 end; 1721 1722 if MyData.ToldAlive<>MyRO.Alive then 1723 begin 1724 for p1:=0 to nPl-1 do 1725 if (MyData.ToldAlive-MyRO.Alive) and (1 shl p1)<>0 then 1726 with MessgExDlg do 1727 begin 1728 OpenSound:='MSG_EXTINCT'; 1729 s:=Tribe[p1].TPhrase('EXTINCT'); 1730 MessgText:=Format(s,[TurnToString(MyRO.Turn)]); 1731 if MyRO.Alive=1 shl me then 1732 MessgText:=MessgText+Phrases.Lookup('EXTINCTALL'); 1733 Kind:=mkOK; 1734 IconKind:=mikImp; 1735 IconIndex:=21; 1736 ShowModal; 5107 else if TurnComplete and not supervising then 5108 begin 5109 if BlinkTime = 0 then 5110 EOT.SetButtonIndexFast(eotBlinkOff) 5111 else if BlinkTime = BlinkOffTime then 5112 EOT.SetButtonIndexFast(eotBlinkOn) 5113 end 5114 end 5115 end; 5116 5117 procedure TMainScreen.Centre(Loc: integer); 5118 begin 5119 if FastScrolling and MapValid then 5120 Update; 5121 // necessary because ScrollDC for form canvas is called after 5122 xw := (Loc mod G.lx - (MapWidth - xxt * 2 * ((Loc div G.lx) and 1)) 5123 div (xxt * 4) + G.lx) mod G.lx; 5124 if ywmax <= 0 then 5125 yw := ywcenter 5126 else 5127 begin 5128 yw := (Loc div G.lx - MapHeight div (yyt * 2) + 1) and not 1; 5129 if yw < 0 then 5130 yw := 0 5131 else if yw > ywmax then 5132 yw := ywmax; 5133 end 5134 end; 5135 5136 function TMainScreen.ZoomToCity(Loc: integer; 5137 NextUnitOnClose: boolean = false; ShowEvent: integer = 0): boolean; 5138 begin 5139 result := MyMap[Loc] and (fOwned or fSpiedOut) <> 0; 5140 if result then 5141 with CityDlg do 5142 begin 5143 if ClientMode >= scContact then 5144 begin 5145 CloseAction := None; 5146 RestoreUnFocus := -1; 5147 end 5148 else if NextUnitOnClose then 5149 begin 5150 CloseAction := StepFocus; 5151 RestoreUnFocus := -1; 5152 end 5153 else if not Visible then 5154 begin 5155 CloseAction := RestoreFocus; 5156 RestoreUnFocus := UnFocus; 5157 end; 5158 SetUnFocus(-1); 5159 SetTroopLoc(Loc); 5160 MarkCityLoc := Loc; 5161 PanelPaint; 5162 ShowNewContent(wmPersistent, Loc, ShowEvent); 5163 end 5164 end; 5165 5166 function TMainScreen.LocationOfScreenPixel(x, y: integer): integer; 5167 var 5168 qx, qy: integer; 5169 begin 5170 qx := (x * (yyt * 2) + y * (xxt * 2) + xxt * yyt * 2) 5171 div (xxt * yyt * 4) - 1; 5172 qy := (y * (xxt * 2) - x * (yyt * 2) - xxt * yyt * 2 + 4000 * xxt * yyt) 5173 div (xxt * yyt * 4) - 999; 5174 result := (xw + (qx - qy + 2048) div 2 - 1024 + G.lx) mod G.lx + G.lx * 5175 (yw + qx + qy); 5176 end; 5177 5178 procedure TMainScreen.MapBoxMouseDown(Sender: TObject; Button: TMouseButton; 5179 Shift: TShiftState; x, y: integer); 5180 var 5181 i, uix, emix, p1, dx, dy, MouseLoc: integer; 5182 EditTileData: TEditTileData; 5183 m, m2: TMenuItem; 5184 MoveAdviceData: TMoveAdviceData; 5185 DoCenter: boolean; 5186 begin 5187 if GameMode = cMovie then 5188 exit; 5189 5190 if CityDlg.Visible then 5191 CityDlg.Close; 5192 if UnitStatDlg.Visible then 5193 UnitStatDlg.Close; 5194 MouseLoc := LocationOfScreenPixel(x, y); 5195 if (MouseLoc < 0) or (MouseLoc >= G.lx * G.ly) then 5196 exit; 5197 if (Button = mbLeft) and not(ssShift in Shift) then 5198 begin 5199 DoCenter := true; 5200 if ClientMode = cEditMap then 5201 begin 5202 DoCenter := false; 5203 EditTileData.Loc := MouseLoc; 5204 if ssCtrl in Shift then // toggle special resource 5205 case MyMap[MouseLoc] and fTerrain of 5206 fOcean: 5207 EditTileData.NewTile := MyMap[MouseLoc]; 5208 fGrass, fArctic: 5209 EditTileData.NewTile := MyMap[MouseLoc] and not fSpecial or 5210 ((MyMap[MouseLoc] shr 5 and 3 + 1) mod 2 shl 5); 5211 else 5212 EditTileData.NewTile := MyMap[MouseLoc] and not fSpecial or 5213 ((MyMap[MouseLoc] shr 5 and 3 + 1) mod 3 shl 5) 5214 end 5215 else if BrushType <= fTerrain then 5216 EditTileData.NewTile := MyMap[MouseLoc] and not fTerrain or 5217 fSpecial or BrushType 5218 else if BrushType and fDeadLands <> 0 then 5219 if MyMap[MouseLoc] and (fDeadLands or fModern) = BrushType and 5220 (fDeadLands or fModern) then 5221 EditTileData.NewTile := MyMap[MouseLoc] and 5222 not(fDeadLands or fModern) 5223 else 5224 EditTileData.NewTile := MyMap[MouseLoc] and 5225 not(fDeadLands or fModern) or BrushType 5226 else if BrushType and fTerImp <> 0 then 5227 if MyMap[MouseLoc] and fTerImp = BrushType then 5228 EditTileData.NewTile := MyMap[MouseLoc] and not fTerImp 5229 else 5230 EditTileData.NewTile := MyMap[MouseLoc] and not fTerImp or BrushType 5231 else if BrushType and (fPrefStartPos or fStartPos) <> 0 then 5232 if MyMap[MouseLoc] and (fPrefStartPos or fStartPos) = BrushType and 5233 (fPrefStartPos or fStartPos) then 5234 EditTileData.NewTile := MyMap[MouseLoc] and 5235 not(fPrefStartPos or fStartPos) 5236 else 5237 EditTileData.NewTile := MyMap[MouseLoc] and 5238 not(fPrefStartPos or fStartPos) or BrushType 5239 else 5240 EditTileData.NewTile := MyMap[MouseLoc] xor BrushType; 5241 Server(sEditTile, me, 0, EditTileData); 5242 Edited := true; 5243 BrushLoc := MouseLoc; 5244 PaintLoc(MouseLoc, 2); 5245 MiniPaint; 5246 BitBlt(Panel.Canvas.Handle, xMini + 2, yMini + 2, G.lx * 2, G.ly, 5247 Mini.Canvas.Handle, 0, 0, SRCCOPY); 5248 if ywmax <= 0 then 5249 Frame(Panel.Canvas, xMini + 2 + G.lx - MapWidth div (2 * xxt), 5250 yMini + 2, xMini + 1 + G.lx + MapWidth div (2 * xxt), 5251 yMini + 2 + G.ly - 1, MainTexture.clMark, MainTexture.clMark) 5252 else 5253 Frame(Panel.Canvas, xMini + 2 + G.lx - MapWidth div (2 * xxt), 5254 yMini + 2 + yw, xMini + 2 + G.lx + MapWidth div (2 * xxt) - 1, 5255 yMini + 2 + yw + MapHeight div yyt - 2, MainTexture.clMark, 5256 MainTexture.clMark); 5257 RectInvalidate(xMini + 2, TopBarHeight + MapHeight - overlap + yMini + 5258 2, xMini + 2 + G.lx * 2, TopBarHeight + MapHeight - overlap + yMini 5259 + 2 + G.ly) 5260 end 5261 else if MyMap[MouseLoc] and fCity <> 0 then { city clicked } 5262 begin 5263 if MyMap[MouseLoc] and (fOwned or fSpiedOut) <> 0 then 5264 begin 5265 ZoomToCity(MouseLoc); 5266 DoCenter := false; 5267 end 5268 else 5269 begin 5270 UnitStatDlg.ShowNewContent_EnemyCity(wmPersistent, MouseLoc); 5271 DoCenter := false; 5272 end 5273 end 5274 else if MyMap[MouseLoc] and fUnit <> 0 then { unit clicked } 5275 if MyMap[MouseLoc] and fOwned <> 0 then 5276 begin 5277 DoCenter := false; 5278 if not supervising and (ClientMode < scContact) then 5279 begin // not in negotiation mode 5280 if (UnFocus >= 0) and (MyUn[UnFocus].Loc = MouseLoc) then 5281 begin // rotate 5282 uix := (UnFocus + 1) mod MyRO.nUn; 5283 i := MyRO.nUn - 1; 5284 while i > 0 do 5285 begin 5286 if (MyUn[uix].Loc = MouseLoc) and (MyUn[uix].Job = jNone) and 5287 (MyUn[uix].Status and (usStay or usRecover or usEnhance or 5288 usWaiting) = usWaiting) then 5289 Break; 5290 dec(i); 5291 uix := (uix + 1) mod MyRO.nUn; 5292 end; 5293 if i = 0 then 5294 uix := UnFocus 5295 end 5296 else 5297 Server(sGetDefender, me, MouseLoc, uix); 5298 if uix <> UnFocus then 5299 SetUnFocus(uix); 5300 TurnComplete := false; 5301 EOT.ButtonIndex := eotGray; 5302 end; 5303 SetTroopLoc(MouseLoc); 5304 PanelPaint; 5305 end // own unit 5306 else if (MyMap[MouseLoc] and fSpiedOut <> 0) and not(ssCtrl in Shift) 5307 then 5308 begin 5309 DoCenter := false; 5310 SetTroopLoc(MouseLoc); 5311 PanelPaint; 5312 end 5313 else 5314 begin 5315 DoCenter := false; 5316 UnitStatDlg.ShowNewContent_EnemyLoc(wmPersistent, MouseLoc); 5317 end; 5318 if DoCenter then 5319 begin 5320 Centre(MouseLoc); 5321 PaintAllMaps 5322 end 5323 end 5324 else if (ClientMode <> cEditMap) and (Button = mbRight) and 5325 not(ssShift in Shift) then 5326 begin 5327 if supervising then 5328 begin 5329 EditLoc := MouseLoc; 5330 Server(sGetModels, me, 0, nil^); 5331 EmptyMenu(mCreateUnit); 5332 for p1 := 0 to nPl - 1 do 5333 if 1 shl p1 and MyRO.Alive <> 0 then 5334 begin 5335 m := TMenuItem.Create(mCreateUnit); 5336 m.Caption := Tribe[p1].TPhrase('SHORTNAME'); 5337 for emix := MyRO.nEnemyModel - 1 downto 0 do 5338 if (MyRO.EnemyModel[emix].Owner = p1) and 5339 (Server(sCreateUnit - sExecute + p1 shl 4, me, 5340 MyRO.EnemyModel[emix].mix, MouseLoc) >= rExecuted) then 5341 begin 5342 if Tribe[p1].ModelPicture[MyRO.EnemyModel[emix].mix].HGr = 0 5343 then 5344 InitEnemyModel(emix); 5345 m2 := TMenuItem.Create(m); 5346 m2.Caption := Tribe[p1].ModelName[MyRO.EnemyModel[emix].mix]; 5347 m2.Tag := p1 shl 16 + MyRO.EnemyModel[emix].mix; 5348 m2.OnClick := CreateUnitClick; 5349 m.Add(m2); 5350 end; 5351 m.Visible := m.Count > 0; 5352 mCreateUnit.Add(m); 5353 end; 5354 if FullScreen then 5355 EditPopup.Popup(Left + x, Top + y) 5356 else 5357 EditPopup.Popup(Left + x + 4, 5358 Top + y + GetSystemMetrics(SM_CYCAPTION) + 4); 5359 end 5360 else if (UnFocus >= 0) and (MyUn[UnFocus].Loc <> MouseLoc) then 5361 with MyUn[UnFocus] do 5362 begin 5363 dx := ((MouseLoc mod G.lx * 2 + MouseLoc div G.lx and 1) - 5364 (Loc mod G.lx * 2 + Loc div G.lx and 1) + 3 * G.lx) 5365 mod (2 * G.lx) - G.lx; 5366 dy := MouseLoc div G.lx - Loc div G.lx; 5367 if abs(dx) + abs(dy) < 3 then 5368 begin 5369 DestinationMarkON := false; 5370 PaintDestination; 5371 Status := Status and 5372 ($FFFF - usStay - usRecover - usGoto - usEnhance) or usWaiting; 5373 MoveUnit(dx, dy, muAutoNext) { simple move } 5374 end 5375 else if GetMoveAdvice(UnFocus, MouseLoc, MoveAdviceData) >= rExecuted 5376 then 5377 begin 5378 if MyMap[MouseLoc] and (fUnit or fOwned) = fUnit then 5379 begin // check for suicide mission before movement 5380 with MyUn[UnFocus], BattleDlg.Forecast do 5381 begin 5382 pAtt := me; 5383 mixAtt := mix; 5384 HealthAtt := Health; 5385 ExpAtt := Exp; 5386 FlagsAtt := Flags; 5387 end; 5388 BattleDlg.Forecast.Movement := MyUn[UnFocus].Movement; 5389 if (Server(sGetBattleForecastEx, me, MouseLoc, BattleDlg.Forecast) 5390 >= rExecuted) and (BattleDlg.Forecast.EndHealthAtt <= 0) then 5391 begin 5392 BattleDlg.uix := UnFocus; 5393 BattleDlg.ToLoc := MouseLoc; 5394 BattleDlg.IsSuicideQuery := true; 5395 BattleDlg.ShowModal; 5396 if BattleDlg.ModalResult <> mrOK then 5397 exit; 5398 end 1737 5399 end; 1738 if (ClientMode<>cMovieTurn) and not supervising then 1739 DiaDlg.ShowNewContent_Charts(wmModal); 1740 end; 1741 1742 // tell changes of own credibility 1743 if not supervising then 1744 begin 1745 if RoughCredibility(MyRO.Credibility) 1746 <>RoughCredibility(MyData.ToldOwnCredibility) then 1747 begin 1748 if RoughCredibility(MyRO.Credibility) 1749 >RoughCredibility(MyData.ToldOwnCredibility) then 1750 s:=Phrases.Lookup('CREDUP') 1751 else s:=Phrases.Lookup('CREDDOWN'); 1752 TribeMessage(me, Format(s,[Phrases.Lookup('CREDIBILITY', 1753 RoughCredibility(MyRO.Credibility))]), ''); 1754 end; 1755 MyData.ToldOwnCredibility:=MyRO.Credibility; 1756 end; 1757 1758 for i:=0 to 27 do 1759 begin 1760 OwnWonder:=false; 1761 for cix:=0 to MyRO.nCity-1 do 1762 if (MyCity[cix].Loc>=0) and (MyCity[cix].ID=MyRO.Wonder[i].CityID) then 1763 OwnWonder:=true; 1764 if MyRO.Wonder[i].CityID<>MyData.ToldWonders[i].CityID then 1765 begin 1766 if MyRO.Wonder[i].CityID=-2 then with MessgExDlg do 1767 begin {tell about destroyed wonders} 1768 OpenSound:='WONDER_DESTROYED'; 1769 MessgText:=Format(Phrases.Lookup('WONDERDEST'), 1770 [Phrases.Lookup('IMPROVEMENTS',i)]); 1771 Kind:=mkOkHelp; 1772 HelpKind:=hkImp; 1773 HelpNo:=i; 1774 IconKind:=mikImp; 1775 IconIndex:=i; 1776 ShowModal; 1777 end 1778 else 1779 begin 1780 if i=woManhattan then 1781 if MyRO.Wonder[i].EffectiveOwner>me then 1782 MyData.ColdWarStart:=MyRO.Turn-1 1783 else MyData.ColdWarStart:=MyRO.Turn; 1784 if not OwnWonder then with MessgExDlg do 1785 begin {tell about newly built wonders} 1786 if i=woManhattan then 1787 begin 1788 OpenSound:='MSG_COLDWAR'; 1789 s:=Tribe[MyRO.Wonder[i].EffectiveOwner].TPhrase('COLDWAR') 1790 end 1791 else if MyRO.Wonder[i].EffectiveOwner>=0 then 1792 begin 1793 OpenSound:='WONDER_BUILT'; 1794 s:=Tribe[MyRO.Wonder[i].EffectiveOwner].TPhrase('WONDERBUILT') 1795 end 1796 else 1797 begin 1798 OpenSound:='MSG_DEFAULT'; 1799 s:=Phrases.Lookup('WONDERBUILTEXP'); // already expired when built 1800 end; 1801 MessgText:=Format(s, [Phrases.Lookup('IMPROVEMENTS',i), 1802 CityName(MyRO.Wonder[i].CityID)]); 1803 Kind:=mkOkHelp; 1804 HelpKind:=hkImp; 1805 HelpNo:=i; 1806 IconKind:=mikImp; 1807 IconIndex:=i; 1808 ShowModal; 1809 end 5400 DestinationMarkON := false; 5401 PaintDestination; 5402 Status := Status and not(usStay or usRecover or usEnhance) or 5403 usWaiting; 5404 MoveToLoc(MouseLoc, false); { goto } 1810 5405 end 1811 5406 end 1812 else if (MyRO.Wonder[i].EffectiveOwner<>MyData.ToldWonders[i].EffectiveOwner) 1813 and (MyRO.Wonder[i].CityID>-2) then 1814 if MyRO.Wonder[i].EffectiveOwner<0 then 5407 end 5408 else if (Button = mbMiddle) and (UnFocus >= 0) and 5409 (MyModel[MyUn[UnFocus].mix].Kind in [mkSettler, mkSlaves]) then 5410 begin 5411 DestinationMarkON := false; 5412 PaintDestination; 5413 MyUn[UnFocus].Status := MyUn[UnFocus].Status and 5414 ($FFFF - usStay - usRecover - usGoto) or usEnhance; 5415 uix := UnFocus; 5416 if MouseLoc <> MyUn[uix].Loc then 5417 MoveToLoc(MouseLoc, true); { goto } 5418 if (UnFocus = uix) and (MyUn[uix].Loc = MouseLoc) then 5419 MenuClick(mEnhance) 5420 end 5421 else if (Button = mbLeft) and (ssShift in Shift) and 5422 (MyMap[MouseLoc] and fTerrain <> fUNKNOWN) then 5423 HelpOnTerrain(MouseLoc, wmPersistent) 5424 else if (ClientMode <= cContinue) and (Button = mbRight) and 5425 (ssShift in Shift) and (UnFocus >= 0) and 5426 (MyMap[MouseLoc] and (fUnit or fOwned) = fUnit) then 5427 begin // battle forecast 5428 with MyUn[UnFocus], BattleDlg.Forecast do 5429 begin 5430 pAtt := me; 5431 mixAtt := mix; 5432 HealthAtt := Health; 5433 ExpAtt := Exp; 5434 FlagsAtt := Flags; 5435 end; 5436 BattleDlg.Forecast.Movement := MyUn[UnFocus].Movement; 5437 if Server(sGetBattleForecastEx, me, MouseLoc, BattleDlg.Forecast) >= rExecuted 5438 then 5439 begin 5440 BattleDlg.uix := UnFocus; 5441 BattleDlg.ToLoc := MouseLoc; 5442 BattleDlg.Left := x - BattleDlg.width div 2; 5443 if BattleDlg.Left < 0 then 5444 BattleDlg.Left := 0 5445 else if BattleDlg.Left + BattleDlg.width > Screen.width then 5446 BattleDlg.Left := Screen.width - BattleDlg.width; 5447 BattleDlg.Top := y - BattleDlg.height div 2; 5448 if BattleDlg.Top < 0 then 5449 BattleDlg.Top := 0 5450 else if BattleDlg.Top + BattleDlg.height > Screen.height then 5451 BattleDlg.Top := Screen.height - BattleDlg.height; 5452 BattleDlg.IsSuicideQuery := false; 5453 BattleDlg.Show; 5454 end 5455 end 5456 end; 5457 5458 function TMainScreen.MoveUnit(dx, dy: integer; Options: integer): integer; 5459 // move focused unit to adjacent tile 5460 var 5461 i, cix, uix, euix, FromLoc, ToLoc, DirCode, UnFocus0, Defender, Mission, p1, 5462 NewTiles, cixChanged: integer; 5463 OldToTile: Cardinal; 5464 CityCaptured, IsAttack, OldUnrest, NewUnrest, NeedEcoUpdate, 5465 NeedRepaintPanel, ToTransport, ToShip: boolean; 5466 PlaneReturnData: TPlaneReturnData; 5467 QueryItem: string; 5468 begin 5469 result := eInvalid; 5470 UnFocus0 := UnFocus; 5471 FromLoc := MyUn[UnFocus].Loc; 5472 ToLoc := dLoc(FromLoc, dx, dy); 5473 if (ToLoc < 0) or (ToLoc >= G.lx * G.ly) then 5474 begin 5475 result := eInvalid; 5476 exit; 5477 end; 5478 if MyMap[ToLoc] and fStealthUnit <> 0 then 5479 begin 5480 SoundMessage(Phrases.Lookup('ATTACKSTEALTH'), ''); 5481 exit; 5482 end; 5483 if MyMap[ToLoc] and fHiddenUnit <> 0 then 5484 begin 5485 SoundMessage(Phrases.Lookup('ATTACKSUB'), ''); 5486 exit; 5487 end; 5488 5489 if MyMap[ToLoc] and (fUnit or fOwned) = fUnit then 5490 begin // attack -- search enemy unit 5491 if (MyModel[MyUn[UnFocus].mix].Attack = 0) and 5492 not((MyModel[MyUn[UnFocus].mix].Cap[mcBombs] > 0) and 5493 (MyUn[UnFocus].Flags and unBombsLoaded <> 0)) then 5494 begin 5495 SoundMessage(Phrases.Lookup('NOATTACKER'), ''); 5496 exit; 5497 end; 5498 euix := MyRO.nEnemyUn - 1; 5499 while (euix >= 0) and (MyRO.EnemyUn[euix].Loc <> ToLoc) do 5500 dec(euix); 5501 end; 5502 5503 DirCode := dx and 7 shl 4 + dy and 7 shl 7; 5504 result := Server(sMoveUnit - sExecute + DirCode, me, UnFocus, nil^); 5505 if (result < rExecuted) and (MyUn[UnFocus].Job > jNone) then 5506 Server(sStartJob + jNone shl 4, me, UnFocus, nil^); 5507 if (result < rExecuted) and (result <> eNoTime_Move) then 5508 begin 5509 case result of 5510 eNoTime_Load: 5511 if MyModel[MyUn[UnFocus].mix].Domain = dAir then 5512 SoundMessage(Phrases.Lookup('NOTIMELOADAIR'), 'NOMOVE_TIME') 5513 else 5514 SoundMessage(Format(Phrases.Lookup('NOTIMELOADGROUND'), 5515 [MovementToString(MyModel[MyUn[UnFocus].mix].speed)]), 5516 'NOMOVE_TIME'); 5517 eNoTime_Bombard: 5518 SoundMessage(Phrases.Lookup('NOTIMEBOMBARD'), 'NOMOVE_TIME'); 5519 eNoTime_Expel: 5520 SoundMessage(Phrases.Lookup('NOTIMEEXPEL'), 'NOMOVE_TIME'); 5521 eNoRoad: 5522 SoundMessage(Phrases.Lookup('NOROAD'), 'NOMOVE_DEFAULT'); 5523 eNoNav: 5524 SoundMessage(Phrases.Lookup('NONAV'), 'NOMOVE_DEFAULT'); 5525 eNoCapturer: 5526 SoundMessage(Phrases.Lookup('NOCAPTURER'), 'NOMOVE_DEFAULT'); 5527 eNoBombarder: 5528 SoundMessage(Phrases.Lookup('NOBOMBARDER'), 'NOMOVE_DEFAULT'); 5529 eZOC: 5530 ContextMessage(Phrases.Lookup('ZOC'), 'NOMOVE_ZOC', hkText, 5531 HelpDlg.TextIndex('MOVEMENT')); 5532 eTreaty: 5533 if MyMap[ToLoc] and (fUnit or fOwned) <> fUnit 5534 then { no enemy unit -- move } 5535 SoundMessage(Tribe[MyRO.Territory[ToLoc]].TPhrase('PEACE_NOMOVE'), 5536 'NOMOVE_TREATY') 5537 else 5538 SoundMessage(Tribe[MyRO.EnemyUn[euix].Owner] 5539 .TPhrase('PEACE_NOATTACK'), 'NOMOVE_TREATY'); 5540 eDomainMismatch: 1815 5541 begin 1816 if i<>woMir then with MessgExDlg do 1817 begin {tell about expired wonders} 1818 OpenSound:='WONDER_EXPIRED'; 1819 MessgText:=Format(Phrases.Lookup('WONDEREXP'), 1820 [Phrases.Lookup('IMPROVEMENTS',i), 1821 CityName(MyRO.Wonder[i].CityID)]); 1822 Kind:=mkOkHelp; 1823 HelpKind:=hkImp; 1824 HelpNo:=i; 1825 IconKind:=mikImp; 1826 IconIndex:=i; 1827 ShowModal; 5542 if (MyModel[MyUn[UnFocus].mix].Domain < dSea) and 5543 (MyMap[ToLoc] and (fUnit or fOwned) = fUnit or fOwned) then 5544 begin // false load attempt 5545 ToShip := false; 5546 ToTransport := false; 5547 for uix := 0 to MyRO.nUn - 1 do 5548 if (MyUn[uix].Loc = ToLoc) and 5549 (MyModel[MyUn[uix].mix].Domain = dSea) then 5550 begin 5551 ToShip := true; 5552 if MyModel[MyUn[uix].mix].Cap[mcSeaTrans] > 0 then 5553 ToTransport := true; 5554 end; 5555 if ToTransport then 5556 SoundMessage(Phrases.Lookup('FULLTRANSPORT'), 'NOMOVE_DEFAULT') 5557 else if ToShip then 5558 SoundMessage(Phrases.Lookup('NOTRANSPORT'), 'NOMOVE_DEFAULT') 5559 else 5560 Play('NOMOVE_DOMAIN'); 1828 5561 end 5562 else 5563 Play('NOMOVE_DOMAIN'); 1829 5564 end 1830 else if (MyData.ToldWonders[i].EffectiveOwner>=0) and not OwnWonder then 1831 with MessgExDlg do 1832 begin {tell about capture of wonders} 1833 OpenSound:='WONDER_CAPTURED'; 1834 s:=Tribe[MyRO.Wonder[i].EffectiveOwner].TPhrase('WONDERCAPT'); 1835 MessgText:=Format(s, [Phrases.Lookup('IMPROVEMENTS',i), 1836 CityName(MyRO.Wonder[i].CityID)]); 1837 Kind:=mkOkHelp; 1838 HelpKind:=hkImp; 1839 HelpNo:=i; 1840 IconKind:=mikImp; 1841 IconIndex:=i; 1842 ShowModal; 5565 else 5566 Play('NOMOVE_DEFAULT'); 5567 end; 5568 exit; 5569 end; 5570 5571 if ((result = eWon) or (result = eLost) or (result = eBloody)) and 5572 (MyUn[UnFocus].Movement < 100) and 5573 (MyModel[MyUn[UnFocus].mix].Cap[mcWill] = 0) then 5574 begin 5575 if SimpleQuery(mkYesNo, Format(Phrases.Lookup('FASTATTACK'), 5576 [MyUn[UnFocus].Movement]), 'NOMOVE_TIME') <> mrOK then 5577 begin 5578 result := eInvalid; 5579 exit; 5580 end; 5581 Update; // remove message box from screen 5582 end; 5583 5584 OldUnrest := false; 5585 NewUnrest := false; 5586 if (result >= rExecuted) and (result and rUnitRemoved = 0) and 5587 (MyMap[ToLoc] and (fUnit or fOwned) <> fUnit) then 5588 begin 5589 OldUnrest := UnrestAtLoc(UnFocus, FromLoc); 5590 NewUnrest := UnrestAtLoc(UnFocus, ToLoc); 5591 if NewUnrest > OldUnrest then 5592 begin 5593 if MyRO.Government = gDemocracy then 5594 begin 5595 QueryItem := 'UNREST_NOTOWN'; 5596 p1 := me; 5597 end 5598 else 5599 begin 5600 QueryItem := 'UNREST_FOREIGN'; 5601 p1 := MyRO.Territory[ToLoc]; 5602 end; 5603 with MessgExDlg do 5604 begin 5605 MessgText := Format(Tribe[p1].TPhrase(QueryItem), 5606 [Phrases.Lookup('GOVERNMENT', MyRO.Government)]); 5607 Kind := mkYesNo; 5608 IconKind := mikImp; 5609 IconIndex := imPalace; 5610 ShowModal; 5611 if ModalResult <> mrOK then 5612 begin 5613 result := eInvalid; 5614 exit; 5615 end; 5616 end; 5617 Update; // remove message box from screen 5618 end 5619 end; 5620 5621 if (result >= rExecuted) and (MyModel[MyUn[UnFocus].mix].Domain = dAir) and 5622 (MyUn[UnFocus].Status and usToldNoReturn = 0) then 5623 begin // can plane return? 5624 PlaneReturnData.Fuel := MyUn[UnFocus].Fuel; 5625 if (MyMap[ToLoc] and (fUnit or fOwned) = fUnit) or 5626 (MyMap[ToLoc] and (fCity or fOwned) = fCity) then 5627 begin // attack/expel/bombard -> 100MP 5628 PlaneReturnData.Loc := FromLoc; 5629 PlaneReturnData.Movement := MyUn[UnFocus].Movement - 100; 5630 if PlaneReturnData.Movement < 0 then 5631 PlaneReturnData.Movement := 0; 5632 end 5633 else // move 5634 begin 5635 PlaneReturnData.Loc := ToLoc; 5636 if dx and 1 <> 0 then 5637 PlaneReturnData.Movement := MyUn[UnFocus].Movement - 100 5638 else 5639 PlaneReturnData.Movement := MyUn[UnFocus].Movement - 150; 5640 end; 5641 if Server(sGetPlaneReturn, me, UnFocus, PlaneReturnData) = eNoWay then 5642 begin 5643 if MyModel[MyUn[UnFocus].mix].Kind = mkSpecial_Glider then 5644 QueryItem := 'LOWFUEL_GLIDER' 5645 else 5646 QueryItem := 'LOWFUEL'; 5647 if SimpleQuery(mkYesNo, Phrases.Lookup(QueryItem), 'WARNING_LOWSUPPORT') 5648 <> mrOK then 5649 begin 5650 result := eInvalid; 5651 exit; 5652 end; 5653 Update; // remove message box from screen 5654 MyUn[UnFocus].Status := MyUn[UnFocus].Status or usToldNoReturn; 5655 end 5656 end; 5657 5658 if result = eMissionDone then 5659 begin 5660 ModalSelectDlg.ShowNewContent(wmModal, kMission); 5661 Update; // dialog still on screen 5662 Mission := ModalSelectDlg.result; 5663 if Mission < 0 then 5664 exit; 5665 Server(sSetSpyMission + Mission shl 4, me, 0, nil^); 5666 end; 5667 5668 CityCaptured := false; 5669 if result = eNoTime_Move then 5670 Play('NOMOVE_TIME') 5671 else 5672 begin 5673 NeedEcoUpdate := false; 5674 DestinationMarkON := false; 5675 PaintDestination; 5676 if result and rUnitRemoved <> 0 then 5677 CityOptimizer_BeforeRemoveUnit(UnFocus); 5678 IsAttack := (result = eBombarded) or (result <> eMissionDone) and 5679 (MyMap[ToLoc] and (fUnit or fOwned) = fUnit); 5680 if not IsAttack then 5681 begin // move 5682 cix := MyRO.nCity - 1; { look for own city at dest location } 5683 while (cix >= 0) and (MyCity[cix].Loc <> ToLoc) do 5684 dec(cix); 5685 if (result <> eMissionDone) and (MyMap[ToLoc] and fCity <> 0) and 5686 (cix < 0) then 5687 CityCaptured := true; 5688 result := Server(sMoveUnit + DirCode, me, UnFocus, nil^); 5689 case result of 5690 eHiddenUnit: 5691 begin 5692 Play('NOMOVE_SUBMARINE'); 5693 PaintLoc(ToLoc) 1843 5694 end; 1844 end; 1845 1846 if MyRO.Turn=MyData.ColdWarStart+ColdWarTurns then 1847 begin 1848 SoundMessageEx(Phrases.Lookup('COLDWAREND'),'MSG_DEFAULT'); 1849 MyData.ColdWarStart:=-ColdWarTurns-1 1850 end; 1851 1852 TellNewModels; 1853 end; // ClientMode<>cResume 1854 MyData.ToldAlive:=MyRO.Alive; 1855 move(MyRO.Wonder,MyData.ToldWonders,SizeOf(MyData.ToldWonders)); 1856 1857 NewGovAvailable:=-1; 1858 if ClientMode<>cResume then 1859 begin // tell about new techs 1860 for ad:=0 to nAdv-1 do 1861 if (MyRO.TestFlags and tfAllTechs=0) 1862 and ((MyRO.Tech[ad]>=tsApplicable)<>(MyData.ToldTech[ad]>=tsApplicable)) 1863 or (ad in FutureTech ) and (MyRO.Tech[ad]<>MyData.ToldTech[ad]) then 1864 with MessgExDlg do 1865 begin 1866 Item:='RESEARCH_GENERAL'; 1867 if GameMode<>cMovie then 1868 OpenSound:='NEWADVANCE_'+char(48+Age); 1869 Item2:=Phrases.Lookup('ADVANCES',ad); 1870 if ad in FutureTech then Item2:=Item2+' '+IntToStr(MyRO.Tech[ad]); 1871 MessgText:=Format(Phrases.Lookup(Item),[Item2]); 1872 Kind:=mkOkHelp; 1873 HelpKind:=hkAdv; 1874 HelpNo:=ad; 1875 IconKind:=mikBook; 1876 IconIndex:=-1; 1877 for i:=0 to nAdvBookIcon-1 do if AdvBookIcon[i].Adv=ad then 1878 IconIndex:=AdvBookIcon[i].Icon; 1879 ShowModal; 1880 MyData.ToldTech[ad]:=MyRO.Tech[ad]; 1881 for i:=gMonarchy to nGov-1 do if GovPreq[i]=ad then 1882 NewGovAvailable:=i; 1883 end; 1884 end; 1885 1886 ShowCityList:=false; 1887 if ClientMode=cTurn then 1888 begin 1889 if (MyRO.Happened and phTech<>0) and (MyData.FarTech<>adNexus) then 1890 ChooseResearch; 1891 1892 UpdatePanel:=false; 1893 if MyRO.Happened and phChangeGov<>0 then 1894 begin 1895 ModalSelectDlg.ShowNewContent(wmModal,kGov); 1896 Play('NEWGOV'); 1897 Server(sSetGovernment,me,ModalSelectDlg.result,nil^); 1898 CityOptimizer_BeginOfTurn; 1899 UpdatePanel:=true; 1900 end; 1901 end; // ClientMode=cTurn 1902 1903 if not supervising and ((ClientMode=cTurn) or (ClientMode=cMovieTurn)) then 1904 for cix:=0 to MyRO.nCity-1 do with MyCity[cix] do 1905 Status:=Status and not csToldBombard; 1906 1907 if ((ClientMode=cTurn) or (ClientMode=cMovieTurn)) 1908 and (MyRO.Government<>gAnarchy) then 1909 begin 1910 // tell what happened in cities 1911 for WondersOnly:=true downto false do 1912 for cix:=0 to MyRO.nCity-1 do with MyCity[cix] do 1913 if (MyRO.Turn>0) and (Loc>=0) and (Flags and chCaptured=0) 1914 and (WondersOnly=(Flags and chProduction<>0) 1915 and (Project0 and cpImp<>0) and (Project0 and cpIndex<28)) then 1916 begin 1917 if WondersOnly then with MessgExDlg do 1918 begin {tell about newly built wonder} 1919 OpenSound:='WONDER_BUILT'; 1920 s:=Tribe[me].TPhrase('WONDERBUILTOWN'); 1921 MessgText:=Format(s, [Phrases.Lookup('IMPROVEMENTS',Project0 and cpIndex), 1922 CityName(ID)]); 1923 Kind:=mkOkHelp; 1924 HelpKind:=hkImp; 1925 HelpNo:=Project0 and cpIndex; 1926 IconKind:=mikImp; 1927 IconIndex:=Project0 and cpIndex; 1928 ShowModal; 5695 eStealthUnit: 5696 begin 5697 Play('NOMOVE_STEALTH'); 5698 PaintLoc(ToLoc) 1929 5699 end; 1930 if not supervising and (ClientMode=cTurn) then5700 eZOC_EnemySpotted: 1931 5701 begin 1932 AllowCityScreen:=true; 1933 if (Status and 7<>0) and (Project and (cpImp+cpIndex)=cpImp+imTrGoods) then 1934 if (MyData.ImpOrder[Status and 7-1,0]>=0) then 5702 Play('NOMOVE_ZOC'); 5703 PaintLoc(ToLoc, 1) 5704 end; 5705 rExecuted .. maxint: 5706 begin 5707 if result and rUnitRemoved <> 0 then 5708 UnFocus := -1 // unit died 5709 else 5710 begin 5711 assert(UnFocus >= 0); 5712 MyUn[UnFocus].Status := MyUn[UnFocus].Status and 5713 not(usStay or usRecover); 5714 for uix := 0 to MyRO.nUn - 1 do 5715 if MyUn[uix].Master = UnFocus then 5716 MyUn[uix].Status := MyUn[uix].Status and not usWaiting; 5717 if CityCaptured and 5718 (MyRO.Government in [gRepublic, gDemocracy, gFuture]) then 5719 begin // borders have moved, unrest might have changed in any city 5720 CityOptimizer_BeginOfTurn; 5721 NeedEcoUpdate := true; 5722 end 5723 else 1935 5724 begin 1936 if AutoBuild(cix,MyData.ImpOrder[Status and 7-1]) then 1937 AllowCityScreen:=false 1938 else if Flags and chProduction<>0 then 1939 Flags:=(Flags and not chProduction) or chAllImpsMade 1940 end 1941 else Flags:=Flags or chTypeDel; 1942 if (Size>=NeedAqueductSize) and (MyRO.Tech[Imp[imAqueduct].Preq]<tsApplicable) 1943 or (Size>=NeedSewerSize) and (MyRO.Tech[Imp[imSewer].Preq]<tsApplicable) then 1944 Flags:=Flags and not chNoGrowthWarning; // don't remind of unknown building 1945 if Flags and chNoSettlerProd=0 then 1946 Status:=Status and not csToldDelay 1947 else if Status and csToldDelay=0 then 1948 Status:=Status or csToldDelay 1949 else Flags:=Flags and not chNoSettlerProd; 1950 if mRepScreens.Checked then 1951 begin 1952 if (Flags and CityRepMask<>0) and AllowCityScreen then 1953 begin {show what happened in cities} 1954 SetTroopLoc(MyCity[cix].Loc); 1955 MarkCityLoc:=MyCity[cix].Loc; 1956 PanelPaint; 1957 CityDlg.CloseAction:=None; 1958 CityDlg.ShowNewContent(wmModal, MyCity[cix].Loc, Flags and CityRepMask); 1959 UpdatePanel:=true; 1960 end 1961 end 1962 else {if mRepList.Checked then} 1963 begin 1964 if Flags and CityRepMask<>0 then 1965 ShowCityList:=true 1966 end 1967 end 1968 end; {city loop} 1969 end; // ClientMode=cTurn 1970 1971 if ClientMode=cTurn then 1972 begin 1973 if NewGovAvailable>=0 then with MessgExDlg do 1974 begin 1975 MessgText:=Format(Phrases.Lookup('AUTOREVOLUTION'), 1976 [Phrases.Lookup('GOVERNMENT',NewGovAvailable)]); 1977 Kind:=mkYesNo; 1978 IconKind:=mikPureIcon; 1979 IconIndex:=6+NewGovAvailable; 1980 ShowModal; 1981 if ModalResult=mrOK then 1982 begin 1983 Play('REVOLUTION'); 1984 Server(sRevolution,me,0,nil^); 1985 end 1986 end; 1987 end; // ClientMode=cTurn 1988 1989 if (ClientMode=cTurn) or (ClientMode=cMovieTurn) then 1990 begin 1991 if MyRO.Happened and phGliderLost<>0 then 1992 ContextMessage(Phrases.Lookup('GLIDERLOST'), 'MSG_DEFAULT', hkModel, 200); 1993 if MyRO.Happened and phPlaneLost<>0 then 1994 ContextMessage(Phrases.Lookup('PLANELOST'), 'MSG_DEFAULT', hkFeature, 1995 mcFuel); 1996 if MyRO.Happened and phPeaceEvacuation<>0 then 1997 for p1:=0 to nPl-1 do if 1 shl p1 and MyData.PeaceEvaHappened<>0 then 1998 SoundMessageEx(Tribe[p1].TPhrase('WITHDRAW'), 'MSG_DEFAULT'); 1999 if MyRO.Happened and phPeaceViolation<>0 then 2000 for p1:=0 to nPl-1 do 2001 if (1 shl p1 and MyRO.Alive<>0) and (MyRO.EvaStart[p1]=MyRO.Turn) then 2002 SoundMessageEx(Format(Tribe[p1].TPhrase('VIOLATION'), 2003 [TurnToString(MyRO.Turn+PeaceEvaTurns-1)]), 'MSG_WITHDRAW'); 2004 TellNewContacts; 2005 end; 2006 2007 if ClientMode=cMovieTurn then Update 2008 else if ClientMode=cTurn then 2009 begin 2010 if UpdatePanel then UpdateViews; 2011 Application.ProcessMessages; 2012 2013 if not supervising then 2014 for uix:=0 to MyRO.nUn-1 do with MyUn[uix] do if Loc>=0 then 2015 begin 2016 if Flags and unWithdrawn<>0 then Status:=0; 2017 if Health=100 then 2018 Status:=Status and not usRecover; 2019 if (Master>=0) or UnitExhausted(uix) then 2020 Status:=Status and not usWaiting 2021 else Status:=Status or usWaiting; 2022 CheckToldNoReturn(uix); 2023 if Status and usGoto<>0 then 2024 begin {continue multi-turn goto} 2025 SetUnFocus(uix); 2026 SetTroopLoc(Loc); 2027 FocusOnLoc(TroopLoc,flRepaintPanel or flImmUpdate); 2028 if Status shr 16=$7FFF then 2029 MoveResult:=GetMoveAdvice(UnFocus,maNextCity,MoveAdviceData) 2030 else MoveResult:=GetMoveAdvice(UnFocus,Status shr 16,MoveAdviceData); 2031 if MoveResult>=rExecuted then 2032 begin // !!! Shinkansen 2033 MoveResult:=eOK; 2034 ok:=true; 2035 for i:=0 to MoveAdviceData.nStep-1 do 2036 begin 2037 Loc1:=dLoc(Loc,MoveAdviceData.dx[i],MoveAdviceData.dy[i]); 2038 if (MyMap[Loc1] and (fCity or fOwned)=fCity) // don't capture cities during auto move 2039 or (MyMap[Loc1] and (fUnit or fOwned)=fUnit) then // don't attack during auto move 2040 begin ok:=false; Break end 2041 else 2042 begin 2043 if (Loc1=MoveAdviceData.ToLoc) or (MoveAdviceData.ToLoc=maNextCity) 2044 and (MyMap[dLoc(Loc,MoveAdviceData.dx[i],MoveAdviceData.dy[i])] and fCity<>0) then 2045 MoveOptions:=muAutoNoWait 2046 else MoveOptions:=0; 2047 MoveResult:=MoveUnit(MoveAdviceData.dx[i],MoveAdviceData.dy[i],MoveOptions); 2048 if (MoveResult<rExecuted) or (MoveResult=eEnemySpotted) then 2049 begin ok:=false; Break end; 5725 if OldUnrest <> NewUnrest then 5726 begin 5727 CityOptimizer_CityChange(MyUn[UnFocus].Home); 5728 for uix := 0 to MyRO.nUn - 1 do 5729 if MyUn[uix].Master = UnFocus then 5730 CityOptimizer_CityChange(MyUn[uix].Home); 5731 NeedEcoUpdate := true; 5732 end; 5733 if (MyRO.Government = gDespotism) and 5734 (MyModel[MyUn[UnFocus].mix].Kind = mkSpecial_TownGuard) then 5735 begin 5736 if MyMap[FromLoc] and fCity <> 0 then 5737 begin // town guard moved out of city in despotism -- reoptimize! 5738 cixChanged := MyRO.nCity - 1; 5739 while (cixChanged >= 0) and 5740 (MyCity[cixChanged].Loc <> FromLoc) do 5741 dec(cixChanged); 5742 assert(cixChanged >= 0); 5743 if cixChanged >= 0 then 5744 begin 5745 CityOptimizer_CityChange(cixChanged); 5746 NeedEcoUpdate := true; 5747 end; 5748 end; 5749 if (MyMap[ToLoc] and fCity <> 0) and not CityCaptured then 5750 begin // town guard moved into city in despotism -- reoptimize! 5751 cixChanged := MyRO.nCity - 1; 5752 while (cixChanged >= 0) and 5753 (MyCity[cixChanged].Loc <> ToLoc) do 5754 dec(cixChanged); 5755 assert(cixChanged >= 0); 5756 if cixChanged >= 0 then 5757 begin 5758 CityOptimizer_CityChange(cixChanged); 5759 NeedEcoUpdate := true; 5760 end 5761 end 5762 end 2050 5763 end 2051 5764 end; 2052 Stop:=not ok or (Loc=MoveAdviceData.ToLoc)2053 or (MoveAdviceData.ToLoc=maNextCity) and (MyMap[Loc] and fCity<>0)2054 end2055 else2056 begin2057 MoveResult:=eOK;2058 Stop:=true;2059 5765 end; 2060 2061 if MoveResult<>eDied then 2062 if Stop then Status:=Status and ($FFFF-usGoto) 2063 else Status:=Status and not usWaiting; 5766 else 5767 assert(false); 5768 end; 5769 SetTroopLoc(ToLoc); 5770 end 5771 else 5772 begin { enemy unit -- attack } 5773 if result = eBombarded then 5774 Defender := MyRO.Territory[ToLoc] 5775 else 5776 Defender := MyRO.EnemyUn[euix].Owner; 5777 { if MyRO.Treaty[Defender]=trCeaseFire then 5778 if SimpleQuery(mkYesNo,Phrases.Lookup('FRCANCELQUERY_CEASEFIRE'), 5779 'MSG_DEFAULT')<>mrOK then 5780 exit; } 5781 if (Options and muNoSuicideCheck = 0) and (result and rUnitRemoved <> 0) 5782 and (result <> eMissionDone) then 5783 begin // suicide query 5784 with MyUn[UnFocus], BattleDlg.Forecast do 5785 begin 5786 pAtt := me; 5787 mixAtt := mix; 5788 HealthAtt := Health; 5789 ExpAtt := Exp; 5790 FlagsAtt := Flags; 2064 5791 end; 2065 2066 if Status and (usEnhance or usGoto)=usEnhance then 2067 // continue terrain enhancement 5792 BattleDlg.Forecast.Movement := MyUn[UnFocus].Movement; 5793 Server(sGetBattleForecastEx, me, ToLoc, BattleDlg.Forecast); 5794 BattleDlg.uix := UnFocus; 5795 BattleDlg.ToLoc := ToLoc; 5796 BattleDlg.IsSuicideQuery := true; 5797 BattleDlg.ShowModal; 5798 if BattleDlg.ModalResult <> mrOK then 5799 exit; 5800 end; 5801 5802 cixChanged := -1; 5803 if (result and rUnitRemoved <> 0) and (MyRO.Government = gDespotism) and 5804 (MyModel[MyUn[UnFocus].mix].Kind = mkSpecial_TownGuard) and 5805 (MyMap[FromLoc] and fCity <> 0) then 5806 begin // town guard died in city in despotism -- reoptimize! 5807 cixChanged := MyRO.nCity - 1; 5808 while (cixChanged >= 0) and (MyCity[cixChanged].Loc <> FromLoc) do 5809 dec(cixChanged); 5810 assert(cixChanged >= 0); 5811 end; 5812 5813 for i := 0 to MyRO.nEnemyModel - 1 do 5814 LostArmy[i] := MyRO.EnemyModel[i].Lost; 5815 OldToTile := MyMap[ToLoc]; 5816 result := Server(sMoveUnit + DirCode, me, UnFocus, nil^); 5817 nLostArmy := 0; 5818 for i := 0 to MyRO.nEnemyModel - 1 do 5819 begin 5820 LostArmy[i] := MyRO.EnemyModel[i].Lost - LostArmy[i]; 5821 inc(nLostArmy, LostArmy[i]) 5822 end; 5823 if result and rUnitRemoved <> 0 then 5824 begin 5825 UnFocus := -1; 5826 SetTroopLoc(FromLoc); 5827 end; 5828 if (OldToTile and not MyMap[ToLoc] and fCity <> 0) and 5829 (MyRO.Government in [gRepublic, gDemocracy, gFuture]) then 5830 begin // city was destroyed, borders have moved, unrest might have changed in any city 5831 CityOptimizer_BeginOfTurn; 5832 NeedEcoUpdate := true; 5833 end 5834 else 5835 begin 5836 if cixChanged >= 0 then 2068 5837 begin 2069 MoveResult:=ProcessEnhancement(uix,MyData.EnhancementJobs); 2070 if MoveResult<>eDied then 2071 if MoveResult=eJobDone then Status:=Status and not usEnhance 2072 else Status:=Status and not usWaiting; 2073 end 2074 end; 2075 end; // ClientMode=cTurn 2076 2077 HaveStrategyAdvice:= false; 2078 // (GameMode<>cMovie) and not supervising 2079 // and AdvisorDlg.HaveStrategyAdvice; 2080 GoOnPhase:=true; 2081 if supervising or (GameMode=cMovie) then 2082 begin SetTroopLoc(-1); PaintAll end {supervisor} 2083 { else if (ClientMode=cTurn) and (MyRO.Turn=0) then 2084 begin 2085 SetUnFocus(0); 2086 ZoomToCity(MyCity[0].Loc) 2087 end} 2088 else 2089 begin 2090 if ClientMode>=scContact then SetUnFocus(-1) 2091 else NextUnit(-1,false); 2092 if UnFocus<0 then 2093 begin 2094 UnStartLoc:=-1; 2095 if IsMultiPlayerGame or (ClientMode=cResume) then 2096 if MyRO.nCity>0 then FocusOnLoc(MyCity[0].Loc) 2097 else FocusOnLoc(G.lx*G.ly div 2); 2098 SetTroopLoc(-1); 2099 PanelPaint 2100 end; 2101 if ShowCityList then 2102 ListDlg.ShowNewContent(wmPersistent,kCityEvents); 2103 end; 2104 end;{InitTurn} 2105 2106 var 2107 i,j,p1,mix,ToLoc,AnimationSpeed,ShowMoveDomain,cix,ecix: integer; 2108 Color: TColor; 2109 Name,s: string; 2110 TribeInfo: TTribeInfo; 2111 mi: TModelInfo; 2112 SkipTurn,IsAlpine,IsTreatyDeal: boolean; 2113 2114 begin {>>>client} 2115 case command of 2116 cTurn,cResume,cContinue,cMovieTurn,scContact,scDipStart..scDipBreak: 2117 begin 2118 supervising:= G.Difficulty[NewPlayer]=0; 2119 ArrangeMidPanel; 2120 end 2121 end; 2122 case Command of 2123 cDebugMessage: 2124 LogDlg.Add(NewPlayer, G.RO[0].Turn, pchar(@Data)); 2125 2126 cShowNego: with TShowNegoData(Data) do 2127 begin 2128 s:=Format('P%d to P%d: ',[pSender,pTarget]); 2129 if (Action=scDipOffer) and (Offer.nDeliver+Offer.nCost>0) then 2130 begin 2131 s:=s+'Offer '; 2132 for i:=0 to Offer.nDeliver+Offer.nCost-1 do 2133 begin 2134 if i=Offer.nDeliver then s:=s+' for ' 2135 else if i>0 then s:=s+'+'; 2136 case Offer.Price[i] and opMask of 2137 opChoose: s:=s+'Price of choice'; 2138 opCivilReport: s:=s+'State report'; 2139 opMilReport: s:=s+'Military report'; 2140 opMap: s:=s+'Map'; 2141 opTreaty: s:=s+'Treaty'; 2142 opShipParts: s:=s+'Ship part'; 2143 opMoney: s:=s+InttoStr(Offer.Price[i] and $FFFFFF)+'o'; 2144 opTribute: s:=s+InttoStr(Offer.Price[i] and $FFFFFF)+'o tribute'; 2145 opTech: s:=s+Phrases.Lookup('ADVANCES', Offer.Price[i] and $FFFFFF); 2146 opAllTech: s:=s+'All advances'; 2147 opModel: s:=s+Tribe[pSender].ModelName[Offer.Price[i] and $FFFFFF]; 2148 opAllModel: s:=s+'All models'; 2149 end 2150 end; 2151 LogDlg.Add(NewPlayer, G.RO[0].Turn, pchar(s)); 2152 end 2153 else if Action=scDipAccept then 2154 begin 2155 s:=s+'--- ACCEPTED! ---'; 2156 LogDlg.Add(NewPlayer, G.RO[0].Turn, pchar(s)); 2157 end 2158 end; 2159 2160 cInitModule: 2161 begin 2162 Server:=TInitModuleData(Data).Server; 2163 //AdvisorDlg.Init; 2164 InitModule; 2165 TInitModuleData(Data).DataSize:=SizeOf(TPersistentData); 2166 TInitModuleData(Data).Flags:=aiThreaded; 2167 end; 2168 2169 cReleaseModule: 2170 begin 2171 SmallImp.Free; 2172 UnusedTribeFiles.Free; 2173 TribeNames.Free; 2174 MainMap.Free; 2175 IsoEngine.Done; 2176 //AdvisorDlg.DeInit; 2177 end; 2178 2179 cHelpOnly,cStartHelp,cStartCredits: 2180 begin 2181 Age:=0; 2182 if Command=cHelpOnly then 2183 SetMainTextureByAge(-1); 2184 Tribes.Init; 2185 HelpDlg.UserLeft:=(Screen.Width-HelpDlg.Width) div 2; 2186 HelpDlg.UserTop:=(Screen.Height-HelpDlg.Height) div 2; 2187 HelpDlg.Difficulty:=0; 2188 if Command=cStartCredits then 2189 HelpDlg.ShowNewContent(wmModal, hkMisc, miscCredits) 2190 else HelpDlg.ShowNewContent(wmModal, hkMisc, miscMain); 2191 Tribes.Done; 2192 end; 2193 2194 cNewGame,cLoadGame,cMovie,cNewMap: 2195 begin 2196 {if (Command=cNewGame) or (Command=cLoadGame) then 2197 AdvisorDlg.NewGame(Data);} 2198 GenerateNames:=mNames.Checked; 2199 GameOK:=true; 2200 G:=TNewGameData(Data); 2201 me:=-1; 2202 pLogo:=-1; 2203 ClientMode:=-1; 2204 SetMapOptions; 2205 IsoEngine.pDebugMap:=-1; 2206 idle:=false; 2207 FillChar(Jump,SizeOf(Jump),0); 2208 if StartRunning then Jump[0]:=999999; 2209 GameMode:=Command; 2210 for i:=0 to nGrExt-1 do 2211 FillChar(GrExt[i].pixUsed,GrExt[i].Data.Height div 49 *10,0); 2212 IsoEngine.Reset; 2213 Tribes.Init; 2214 GetTribeList; 2215 for p1:=0 to nPl-1 do if (G.RO[p1]<>nil) and (G.RO[p1].Data<>nil) then 2216 with TPersistentData(G.RO[p1].Data^) do 2217 begin 2218 FarTech:=adNone; 2219 FillChar(EnhancementJobs,SizeOf(EnhancementJobs),jNone); 2220 FillChar(ImpOrder,SizeOf(ImpOrder),-1); 2221 ColdWarStart:=-ColdWarTurns-1; 2222 ToldAge:=-1; 2223 ToldModels:=3; 2224 ToldAlive:=0; 2225 ToldContact:=0; 2226 ToldOwnCredibility:=InitialCredibility; 2227 for i:=0 to nPl-1 do if G.Difficulty[i]>0 then inc(ToldAlive,1 shl i); 2228 PeaceEvaHappened:=0; 2229 for i:=0 to 27 do with ToldWonders[i] do 2230 begin CityID:=-1; EffectiveOwner:=-1 end; 2231 FillChar(ToldTech,SizeOf(ToldTech),tsNA); 2232 if G.Difficulty[p1]>0 then 2233 SoundPreload(sbStart); 2234 end; 2235 2236 // arrange dialogs 2237 ListDlg.UserLeft:=8; 2238 ListDlg.UserTop:=TopBarHeight+8; 2239 HelpDlg.UserLeft:=Screen.Width-HelpDlg.Width-8; 2240 HelpDlg.UserTop:=TopBarHeight+8; 2241 UnitStatDlg.UserLeft:=397; 2242 UnitStatDlg.UserTop:=TopBarHeight+64; 2243 DiaDlg.UserLeft:=(Screen.Width-DiaDlg.Width) div 2; 2244 DiaDlg.UserTop:=(Screen.Height-DiaDlg.Height) div 2; 2245 NatStatDlg.UserLeft:=Screen.Width-NatStatDlg.Width-8; 2246 NatStatDlg.UserTop:=Screen.Height-PanelHeight-NatStatDlg.Height-8; 2247 if NatStatDlg.UserTop<8 then 2248 NatStatDlg.UserTop:=8; 2249 2250 Age:=0; 2251 MovieSpeed:=1; 2252 LogDlg.mSlot.Visible:=true; 2253 LogDlg.Host:=self; 2254 HelpDlg.ClearHistory; 2255 CityDlg.Reset; 2256 2257 Mini.Width:=G.lx*2; Mini.Height:=G.ly; 2258 for i:=0 to nPl-1 do 2259 begin Tribe[i]:=nil; TribeOriginal[i]:=false; end; 2260 ToldSlavery:=-1; 2261 RepaintOnResize:=false; 2262 Closable:=false; 2263 FirstMovieTurn:=true; 2264 2265 MenuArea.Visible:= GameMode<>cMovie; 2266 TreasuryArea.Visible:= GameMode<cMovie; 2267 ResearchArea.Visible:= GameMode<cMovie; 2268 ManagementArea.Visible:= GameMode<cMovie; 2269 end; 2270 2271 cGetReady,cReplay: if NewPlayer=0 then 2272 begin 2273 i:=0; 2274 for p1:=0 to nPl-1 do 2275 if (G.Difficulty[p1]>0) and (Tribe[p1]=nil) then inc(i); 2276 if i>UnusedTribeFiles.Count then 2277 begin 2278 GameOK:=false; 2279 SimpleMessage(Phrases.Lookup('TOOFEWTRIBES')); 2280 end 2281 else 2282 begin 2283 for p1:=0 to nPl-1 do 2284 if (G.Difficulty[p1]>0) and (Tribe[p1]=nil) and (G.RO[p1]<>nil) then 2285 begin // let player select own tribes 2286 TribeInfo.trix:=p1; 2287 TribeNames.Clear; 2288 for j:=0 to UnusedTribeFiles.Count-1 do 2289 begin 2290 GetTribeInfo(UnusedTribeFiles[j], Name, Color); 2291 TribeNames.AddObject(Name,TObject(Color)); 2292 end; 2293 assert(TribeNames.Count>0); 2294 ModalSelectDlg.ShowNewContent(wmModal,kTribe); 2295 Application.ProcessMessages; 2296 TribeInfo.FileName:=UnusedTribeFiles[ModalSelectDlg.result]; 2297 UnusedTribeFiles.Delete(ModalSelectDlg.result); 2298 2299 if GameMode=cLoadGame then 2300 CreateTribe(TribeInfo.trix,TribeInfo.FileName,false) 2301 else Server(cSetTribe+(Length(TribeInfo.FileName)+1+7) div 4, 2302 0,0,TribeInfo); 5838 CityOptimizer_CityChange(cixChanged); 5839 NeedEcoUpdate := true; 2303 5840 end; 2304 2305 for p1:=0 to nPl-1 do 2306 if (G.Difficulty[p1]>0) and (Tribe[p1]=nil) and (G.RO[p1]=nil) then 2307 begin // autoselect enemy tribes 2308 j:=ChooseUnusedTribe; 2309 TribeInfo.FileName:=UnusedTribeFiles[j]; 2310 UnusedTribeFiles.Delete(j); 2311 TribeInfo.trix:=p1; 2312 if GameMode=cLoadGame then 2313 CreateTribe(TribeInfo.trix,TribeInfo.FileName,false) 2314 else Server(cSetTribe+(Length(TribeInfo.FileName)+1+7) div 4, 2315 0,0,TribeInfo); 5841 if (result = eWon) or (result = eBloody) or (result = eExpelled) then 5842 begin 5843 CityOptimizer_TileBecomesAvailable(ToLoc); 5844 NeedEcoUpdate := true; 2316 5845 end; 2317 end; 2318 if not mNames.Checked then 2319 for p1:=0 to nPl-1 do if Tribe[p1]<>nil then 2320 Tribe[p1].NumberName:=p1; 2321 end; 2322 2323 cBreakGame: 2324 begin 2325 SaveSettings; 2326 CityDlg.CloseAction:=None; 2327 for i:=0 to Screen.FormCount-1 do 2328 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then 2329 Screen.Forms[i].Close; 2330 if LogDlg.Visible then LogDlg.Close; 2331 LogDlg.List.Clear; 2332 StartRunning:=not idle and (Jump[0]>0); // AI called Reload 2333 me:=-1; 2334 idle:=false; 2335 ClientMode:=-1; 2336 UnitInfoBtn.Visible:=false; 2337 UnitBtn.Visible:=false; 2338 TerrainBtn.Visible:=false; 2339 MovieSpeed1Btn.Visible:=false; 2340 MovieSpeed2Btn.Visible:=false; 2341 MovieSpeed3Btn.Visible:=false; 2342 MovieSpeed4Btn.Visible:=false; 2343 EOT.Visible:=false; 2344 for i:=0 to ControlCount-1 do if Controls[i] is TButtonC then 2345 Controls[i].visible:=false; 2346 InitPVSB(sb,0,1); 2347 for p1:=0 to nPl-1 do if Tribe[p1]<>nil then Tribe[p1].Free; 2348 Tribes.Done; 2349 RepaintOnResize:=false; 2350 Closable:=true; Close; 2351 {if (GameMode=cNewGame) or (GameMode=cLoadGame) then 2352 AdvisorDlg.BreakGame;} 2353 end; 2354 2355 cShowGame: 2356 begin 2357 with Panel.Canvas do 2358 begin 2359 Brush.Color:=$000000; 2360 FillRect(Rect(0,0,Panel.Width,Panel.Height)); 2361 Brush.Style:=bsClear; 2362 end; 2363 with TopBar.Canvas do 2364 begin 2365 Brush.Color:=$000000; 2366 FillRect(Rect(0,0,TopBar.Width,TopBar.Height)); 2367 Brush.Style:=bsClear; 2368 end; 2369 FormResize(nil); // place mini map correctly according to its size 2370 Show; 2371 Update; 2372 RepaintOnResize:=true; 2373 xw:=0; yw:=ywcenter; 2374 if not StayOnTop_Ensured then 2375 begin 2376 StayOnTop_Ensured:=true; 2377 CityDlg.StayOnTop_Workaround; 2378 CityTypeDlg.StayOnTop_Workaround; 2379 DiaDlg.StayOnTop_Workaround; 2380 DraftDlg.StayOnTop_Workaround; 2381 EnhanceDlg.StayOnTop_Workaround; 2382 HelpDlg.StayOnTop_Workaround; 2383 NatStatDlg.StayOnTop_Workaround; 2384 NegoDlg.StayOnTop_Workaround; 2385 ModalSelectDlg.StayOnTop_Workaround; 2386 ListDlg.StayOnTop_Workaround; 2387 UnitStatDlg.StayOnTop_Workaround; 2388 WondersDlg.StayOnTop_Workaround; 2389 RatesDlg.StayOnTop_Workaround; 2390 end; 2391 end; 2392 2393 cShowTurnChange: 2394 begin 2395 if integer(data)>=0 then 2396 begin 2397 pLogo:=integer(data); 2398 if G.RO[pLogo]=nil then 2399 begin 2400 if AILogo[pLogo]<>nil then 2401 BitBlt(Canvas.Handle, (xRightPanel+10)-(16+64), ClientHeight-PanelHeight, 64,64, 2402 AILogo[pLogo].Canvas.Handle,0,0,SRCCOPY); 2403 end 2404 end 2405 end; 2406 2407 cTurn,cResume,cContinue: 2408 if not GameOK then Server(sResign,NewPlayer,0,nil^) 2409 else 2410 begin 2411 ClientMode:=Command; 2412 pTurn:=NewPlayer; 2413 pLogo:=NewPlayer; 2414 2415 if Command=cResume then 2416 begin // init non-original model pictures (maybe tribes not found) 2417 for p1:=0 to nPl-1 do if G.RO[p1]<>nil then 5846 end; 5847 if nLostArmy > 1 then 5848 begin 5849 with MessgExDlg do 2418 5850 begin 2419 ItsMeAgain(p1); 2420 for mix:=0 to MyRO.nModel-1 do 2421 if Tribe[me].ModelPicture[mix].HGr=0 then 2422 InitMyModel(mix, true); 2423 end; 2424 me:=-1; 2425 end; 2426 2427 if Jump[pTurn]>0 then 2428 Application.ProcessMessages; 2429 if Jump[pTurn]>0 then 2430 if G.RO[NewPlayer].Happened and phGameEnd<>0 then Jump[pTurn]:=0 2431 else dec(Jump[pTurn]); 2432 SkipTurn:= Jump[pTurn]>0; 2433 if SkipTurn then 2434 begin 2435 ItsMeAgain(NewPlayer); 2436 MyData:=G.RO[NewPlayer].Data; 2437 SetTroopLoc(-1); 2438 MiniPaint; 2439 InitAllEnemyModels; // necessary for correct replay 2440 if not EndTurn(true) then SkipTurn:=false; 2441 end; 2442 if not SkipTurn then 2443 begin 2444 if ((ClientMode<scDipStart) or (ClientMode>scDipBreak)) 2445 and NegoDlg.Visible then 2446 NegoDlg.Close; 2447 skipped:=false; // always show my moves during my turn 2448 idle:=true; 2449 InitTurn(NewPlayer); 2450 DipMem[me].pContact:=-1; 2451 (* if (me=0) and (MyRO.Alive and (1 shl me)=0)} then 2452 begin 2453 if SimpleQuery(Phrases.Lookup('RESIGN'))=mrIgnore then 2454 Server(sResign,me,0,nil^) 2455 else Server(sBreak,me,0,nil^) 2456 end 2457 else Play('TURNSTART');*) 2458 end; 2459 end; 2460 2461 cMovieTurn: 2462 begin 2463 ClientMode:=Command; 2464 pTurn:=NewPlayer; 2465 pLogo:=-1; 2466 skipped:=false; // always show my moves during my turn 2467 idle:=true; 2468 if FirstMovieTurn then 2469 begin 2470 CheckMovieSpeedBtnState; 2471 FirstMovieTurn:=false; 2472 end; 2473 InitTurn(NewPlayer); 2474 Application.ProcessMessages; 2475 if MovieSpeed=4 then 2476 begin 2477 Sleep(75); // this break will ensure speed of fast forward does not depend on cpu speed 2478 Application.ProcessMessages; 2479 end 2480 end; 2481 2482 cMovieEndTurn: 2483 begin 2484 RememberPeaceViolation; 2485 pTurn:=-1; 2486 pLogo:=-1; 2487 MapValid:=false; 2488 ClientMode:=-1; 2489 idle:=false; 2490 skipped:=false; 2491 end; 2492 2493 cEditMap: 2494 begin 2495 ClientMode:=cEditMap; 2496 SetMapOptions; 2497 IsoEngine.pDebugMap:=-1; 2498 ItsMeAgain(0); 2499 MyData:=nil; 2500 UnitInfoBtn.Visible:=false; 2501 UnitBtn.Visible:=false; 2502 TerrainBtn.Visible:=false; 2503 MovieSpeed1Btn.Visible:=false; 2504 MovieSpeed2Btn.Visible:=false; 2505 MovieSpeed3Btn.Visible:=false; 2506 MovieSpeed4Btn.Visible:=false; 2507 EOT.Visible:=false; 2508 HelpDlg.Difficulty:=0; 2509 BrushType:=fGrass; 2510 BrushLoc:=-1; 2511 Edited:=false; 2512 UnFocus:=-1; 2513 MarkCityLoc:=-1; 2514 Tracking:=false; 2515 TurnComplete:=false; 2516 MapValid:=false; 2517 FormResize(nil); // calculate geometrics and paint all 2518 SetTroopLoc(-1); 2519 idle:=true 2520 end; 2521 2522 (* cNewContact: 2523 begin 2524 end; 2525 *) 2526 2527 scContact: 2528 begin 2529 DipMem[NewPlayer].pContact:=integer(Data); 2530 if Jump[NewPlayer]>0 then DipCall(scReject) 2531 else 2532 begin 2533 ClientMode:=Command; 2534 InitTurn(NewPlayer); 2535 MyData.ToldContact:=MyData.ToldContact or (1 shl integer(Data)); 2536 // don't tell about new nation when already contacted by them 2537 with MessgExDlg do 2538 begin 2539 OpenSound:='CONTACT_'+char(48+MyRO.EnemyReport[integer(Data)].Attitude); 2540 MessgText:=Tribe[integer(Data)].TPhrase('FRCONTACT'); 2541 Kind:=mkYesNo; 2542 IconKind:=mikTribe; 2543 IconIndex:=integer(Data); 2544 ShowModal; 2545 if ModalResult=mrOK then 2546 begin 2547 NegoDlg.Respond; 2548 DipMem[me].DeliveredPrices:=[]; 2549 DipMem[me].ReceivedPrices:=[]; 2550 DipCall(scDipStart) 2551 end 2552 else 2553 begin 2554 DipCall(scReject); 2555 EndNego 5851 Kind := mkOk; 5852 IconKind := mikEnemyArmy; 5853 MessgText := Tribe[Defender].TString(Phrases.Lookup('ARMYLOST', 5854 MyRO.EnemyModel[MyRO.EnemyUn[euix].emix].Domain)); 5855 ShowModal; 2556 5856 end 2557 5857 end 2558 5858 end; 2559 end; 2560 2561 scDipStart..scDipBreak: 2562 begin 2563 ClientMode:=Command; 2564 InitTurn(NewPlayer); 2565 if Command=scDipStart then 2566 Play('CONTACT_'+char(48+MyRO.Attitude[DipMem[NewPlayer].pContact])) 2567 else if Command=scDipCancelTreaty then 2568 Play('CANCELTREATY') 2569 else if Command=scDipOffer then 2570 begin 2571 ReceivedOffer:=TOffer(Data); 2572 InitAllEnemyModels; 5859 if result and rUnitRemoved <> 0 then 5860 begin 5861 CityOptimizer_AfterRemoveUnit; 5862 ListDlg.RemoveUnit; 5863 NeedEcoUpdate := true; 5864 end; 5865 if NeedEcoUpdate then 5866 begin 5867 UpdateViews(true); 5868 Update 2573 5869 end 2574 else if Command=scDipAccept then 2575 begin // remember delivered and received prices 2576 for i:=0 to DipMem[me].SentOffer.nDeliver-1 do 2577 include(DipMem[me].DeliveredPrices,DipMem[me].SentOffer.Price[i] shr 24); 2578 for i:=0 to DipMem[me].SentOffer.nCost-1 do 2579 include(DipMem[me].ReceivedPrices, 2580 DipMem[me].SentOffer.Price[DipMem[me].SentOffer.nDeliver+i] shr 24); 2581 IsTreatyDeal:=false; 2582 for i:=0 to ReceivedOffer.nDeliver+ReceivedOffer.nCost-1 do 2583 if DipMem[me].SentOffer.Price[i] and opMask=opTreaty then 2584 IsTreatyDeal:=true; 2585 if IsTreatyDeal then Play('NEWTREATY') 2586 else Play('ACCEPTOFFER'); 5870 end; 5871 5872 if result = eMissionDone then 5873 begin 5874 p1 := MyRO.Territory[ToLoc]; 5875 case Mission of 5876 smStealMap: 5877 begin 5878 MapValid := false; 5879 PaintAllMaps 5880 end; 5881 smStealCivilReport: 5882 TribeMessage(p1, Tribe[p1].TPhrase('DOSSIER_PREPARED'), ''); 5883 smStealMilReport: 5884 ListDlg.ShowNewContent_MilReport(wmPersistent, p1); 2587 5885 end; 2588 NegoDlg.Start; 2589 idle:=true 2590 end; 2591 2592 cShowCancelTreaty: 2593 if not IsMultiPlayerGame then 2594 begin 2595 case G.RO[NewPlayer].Treaty[integer(data)] of 2596 trPeace: s:=Tribe[integer(data)].TPhrase('FRCANCELBYREJECT_PEACE'); 2597 trFriendlyContact: s:=Tribe[integer(data)].TPhrase('FRCANCELBYREJECT_FRIENDLY'); 2598 trAlliance: s:=Tribe[integer(data)].TPhrase('FRCANCELBYREJECT_ALLIANCE'); 2599 end; 2600 TribeMessage(integer(data), s, 'CANCELTREATY'); 5886 end; 5887 5888 if UnFocus >= 0 then 5889 CheckToldNoReturn(UnFocus); 5890 5891 NeedRepaintPanel := false; 5892 if result >= rExecuted then 5893 begin 5894 if CityCaptured and (MyMap[ToLoc] and fCity = 0) then 5895 begin // city destroyed 5896 for i := 0 to 27 do { tell about destroyed wonders } 5897 if (MyRO.Wonder[i].CityID = -2) and 5898 (MyData.ToldWonders[i].CityID <> -2) then 5899 with MessgExDlg do 5900 begin 5901 if WondersDlg.Visible then 5902 WondersDlg.SmartUpdateContent(false); 5903 OpenSound := 'WONDER_DESTROYED'; 5904 MessgText := Format(Phrases.Lookup('WONDERDEST'), 5905 [Phrases.Lookup('IMPROVEMENTS', i)]); 5906 Kind := mkOkHelp; 5907 HelpKind := hkImp; 5908 HelpNo := i; 5909 IconKind := mikImp; 5910 IconIndex := i; 5911 ShowModal; 5912 MyData.ToldWonders[i] := MyRO.Wonder[i]; 5913 end 2601 5914 end; 2602 2603 cShowCancelTreatyByAlliance: 2604 if idle and (NewPlayer=me) then 2605 TribeMessage(integer(data), Tribe[integer(data)].TPhrase('FRENEMYALLIANCE'), 2606 'CANCELTREATY'); 2607 2608 cShowSupportAllianceAgainst: 2609 if not IsMultiPlayerGame and (Jump[0]=0) then 2610 TribeMessage(integer(data) and $F, 2611 Tribe[integer(data) and $F].TPhrase('FRMYALLIANCE1') 2612 +' '+Tribe[integer(data) shr 4].TPhrase('FRMYALLIANCE2'), 2613 'CANCELTREATY'); 2614 2615 cShowPeaceViolation: 2616 if not IsMultiPlayerGame and (Jump[0]=0) then 2617 TribeMessage(integer(data), Format(Tribe[integer(data)].TPhrase('EVIOLATION'), 2618 [TurnToString(MyRO.Turn+PeaceEvaTurns-1)]), 'MSG_WITHDRAW'); 2619 2620 cShowEndContact: EndNego; 2621 2622 cShowUnitChanged,cShowCityChanged,cShowAfterMove,cShowAfterAttack: 2623 if (idle and (NewPlayer=me) or not idle and not skipped) 2624 and not ((GameMode=cMovie) and (MovieSpeed=4)) then 2625 begin 2626 assert(NewPlayer=me); 2627 if not idle or (GameMode=cMovie) then 2628 Application.ProcessMessages; 2629 if Command=cShowCityChanged then 2630 begin 2631 CurrentMoveInfo.DoShow:=false; 2632 if idle then 2633 CurrentMoveInfo.DoShow:=true 2634 else if CurrentMoveInfo.IsAlly then 2635 CurrentMoveInfo.DoShow:=not mAlNoMoves.Checked 2636 else CurrentMoveInfo.DoShow:=not mEnNoMoves.Checked 5915 if CityCaptured and (MyMap[ToLoc] and fCity <> 0) then 5916 begin // city captured 5917 ListDlg.AddCity; 5918 for i := 0 to 27 do { tell about capture of wonders } 5919 if MyRO.City[MyRO.nCity - 1].Built[i] > 0 then 5920 with MessgExDlg do 5921 begin 5922 if WondersDlg.Visible then 5923 WondersDlg.SmartUpdateContent(false); 5924 OpenSound := 'WONDER_CAPTURED'; 5925 MessgText := Format(Tribe[me].TPhrase('WONDERCAPTOWN'), 5926 [Phrases.Lookup('IMPROVEMENTS', i)]); 5927 Kind := mkOkHelp; 5928 HelpKind := hkImp; 5929 HelpNo := i; 5930 IconKind := mikImp; 5931 IconIndex := i; 5932 ShowModal; 5933 MyData.ToldWonders[i] := MyRO.Wonder[i]; 5934 end; 5935 5936 if MyRO.Happened and phStealTech <> 0 then 5937 begin { Temple of Zeus -- choose advance to steal } 5938 ModalSelectDlg.ShowNewContent(wmModal, kStealTech); 5939 Server(sStealTech, me, ModalSelectDlg.result, nil^); 5940 end; 5941 TellNewModels; 5942 5943 cix := MyRO.nCity - 1; 5944 while (cix >= 0) and (MyCity[cix].Loc <> ToLoc) do 5945 dec(cix); 5946 assert(cix >= 0); 5947 MyCity[cix].Status := MyCity[cix].Status and 5948 not csResourceWeightsMask or (3 shl 4); 5949 // captured city, set to maximum growth 5950 NewTiles := 1 shl 13; { exploit central tile only } 5951 Server(sSetCityTiles, me, cix, NewTiles); 5952 end 5953 else 5954 NeedRepaintPanel := true; 5955 end; 5956 TellNewContacts; 5957 5958 if (UnFocus >= 0) and (MyUn[UnFocus].Master >= 0) then 5959 with MyUn[MyUn[UnFocus].Master] do 5960 if Status and usStay <> 0 then 5961 begin 5962 Status := Status and not usStay; 5963 if (Movement >= 100) and (Status and (usRecover or usGoto) = 0) then 5964 Status := Status or usWaiting; 5965 end; 5966 if Options and (muAutoNoWait or muAutoNext) <> 0 then 5967 begin 5968 if (UnFocus >= 0) and ((result = eNoTime_Move) or UnitExhausted(UnFocus) 5969 or (MyUn[UnFocus].Master >= 0) or 5970 (MyModel[MyUn[UnFocus].mix].Domain = dAir) and 5971 ((MyMap[MyUn[UnFocus].Loc] and fCity <> 0) { aircrafts stop in cities } 5972 or (MyMap[MyUn[UnFocus].Loc] and fTerImp = tiBase))) then 5973 begin 5974 MyUn[UnFocus].Status := MyUn[UnFocus].Status and not usWaiting; 5975 if Options and muAutoNext <> 0 then 5976 if CityCaptured and (MyMap[ToLoc] and fCity <> 0) then 5977 begin 5978 UnFocus := -1; 5979 PaintLoc(ToLoc); // don't show unit in city if not selected 5980 end 5981 else 5982 NextUnit(UnStartLoc, true) 5983 end 5984 else if (UnFocus < 0) and (Options and muAutoNext <> 0) then 5985 NextUnit(UnStartLoc, result <> eMissionDone); 5986 end; 5987 5988 if NeedRepaintPanel and (UnFocus = UnFocus0) then 5989 if IsAttack then 5990 PanelPaint 5991 else 5992 begin 5993 assert(result <> eMissionDone); 5994 CheckTerrainBtnVisible; 5995 FocusOnLoc(ToLoc, flRepaintPanel or flImmUpdate) 5996 end; 5997 5998 if (result >= rExecuted) and CityCaptured and (MyMap[ToLoc] and fCity <> 0) 5999 then 6000 ZoomToCity(ToLoc, UnFocus < 0, chCaptured); // show captured city 6001 end; // moveunit 6002 6003 procedure TMainScreen.MoveOnScreen(ShowMove: TShowMove; 6004 Step0, Step1, nStep: integer; Restore: boolean = true); 6005 var 6006 ToLoc, xFromLoc, yFromLoc, xToLoc, yToLoc, xFrom, yFrom, xTo, yTo, xMin, 6007 yMin, xRange, yRange, xw1, Step, xMoving, yMoving, yl, 6008 SliceCount: integer; 6009 UnitInfo: TUnitInfo; 6010 Ticks0, Ticks: int64; 6011 begin 6012 Timer1.Enabled := false; 6013 QueryPerformanceCounter(Ticks0); 6014 with ShowMove do 6015 begin 6016 UnitInfo.Owner := Owner; 6017 UnitInfo.mix := mix; 6018 UnitInfo.Health := Health; 6019 UnitInfo.Job := jNone; 6020 UnitInfo.Flags := Flags; 6021 if Owner <> me then 6022 UnitInfo.emix := emix; 6023 6024 ToLoc := dLoc(FromLoc, dx, dy); 6025 xToLoc := ToLoc mod G.lx; 6026 yToLoc := ToLoc div G.lx; 6027 xFromLoc := FromLoc mod G.lx; 6028 yFromLoc := FromLoc div G.lx; 6029 if xToLoc > xFromLoc + 2 then 6030 xToLoc := xToLoc - G.lx 6031 else if xToLoc < xFromLoc - 2 then 6032 xToLoc := xToLoc + G.lx; 6033 6034 xw1 := xw + G.lx; 6035 // ((xFromLoc-xw1)*2+yFromLoc and 1+1)*xxt+dx*xxt/2-MapWidth/2 -> min 6036 while abs(((xFromLoc - xw1 + G.lx) * 2 + yFromLoc and 1 + 1) * xxt * 2 + 6037 dx * xxt - MapWidth) < abs(((xFromLoc - xw1) * 2 + yFromLoc and 1 + 1) * 6038 xxt * 2 + dx * xxt - MapWidth) do 6039 dec(xw1, G.lx); 6040 6041 xTo := (xToLoc - xw1) * (xxt * 2) + yToLoc and 1 * xxt + (xxt - xxu); 6042 yTo := (yToLoc - yw) * yyt + (yyt - yyu_anchor); 6043 xFrom := (xFromLoc - xw1) * (xxt * 2) + yFromLoc and 1 * xxt + 6044 (xxt - xxu); 6045 yFrom := (yFromLoc - yw) * yyt + (yyt - yyu_anchor); 6046 if xFrom < xTo then 6047 begin 6048 xMin := xFrom; 6049 xRange := xTo - xFrom 6050 end 6051 else 6052 begin 6053 xMin := xTo; 6054 xRange := xFrom - xTo 6055 end; 6056 if yFrom < yTo then 6057 begin 6058 yMin := yFrom; 6059 yRange := yTo - yFrom 6060 end 6061 else 6062 begin 6063 yMin := yTo; 6064 yRange := yFrom - yTo 6065 end; 6066 inc(xRange, xxt * 2); 6067 inc(yRange, yyt * 3); 6068 6069 MainOffscreenPaint; 6070 NoMap.SetOutput(Buffer); 6071 NoMap.SetPaintBounds(0, 0, xRange, yRange); 6072 for Step := 0 to abs(Step1 - Step0) do 6073 begin 6074 BitBlt(Buffer.Canvas.Handle, 0, 0, xRange, yRange, 6075 offscreen.Canvas.Handle, xMin, yMin, SRCCOPY); 6076 if Step1 <> Step0 then 6077 begin 6078 xMoving := xFrom + 6079 Round((Step0 + Step * (Step1 - Step0) div abs(Step1 - Step0)) * 6080 (xTo - xFrom) / nStep); 6081 yMoving := yFrom + 6082 Round((Step0 + Step * (Step1 - Step0) div abs(Step1 - Step0)) * 6083 (yTo - yFrom) / nStep); 2637 6084 end 2638 else if Command=cShowUnitChanged then 2639 begin 2640 CurrentMoveInfo.DoShow:=false; 2641 if idle then 2642 CurrentMoveInfo.DoShow:=not mEffectiveMovesOnly.Checked 2643 else if CurrentMoveInfo.IsAlly then 2644 CurrentMoveInfo.DoShow:=not (mAlNoMoves.Checked or mAlEffectiveMovesOnly.Checked) 2645 else CurrentMoveInfo.DoShow:=not (mEnNoMoves.Checked or mEnAttacks.Checked) 2646 end; 2647 // else keep DoShow from cShowMove/cShowAttack 2648 2649 if CurrentMoveInfo.DoShow then 2650 begin 2651 if Command=cShowCityChanged then MapValid:=false; 2652 FocusOnLoc(integer(Data),flImmUpdate); 2653 // OldUnFocus:=UnFocus; 2654 // UnFocus:=-1; 2655 if Command=cShowAfterMove then 2656 PaintLoc(integer(Data),CurrentMoveInfo.AfterMovePaintRadius) // show discovered areas 2657 else PaintLoc(integer(Data),1); 2658 // UnFocus:=OldUnFocus; 2659 if (Command=cShowAfterAttack) and (CurrentMoveInfo.AfterAttackExpeller>=0) then 6085 else 6086 begin 6087 xMoving := xFrom; 6088 yMoving := yFrom; 6089 end; 6090 NoMap.PaintUnit(xMoving - xMin, yMoving - yMin, UnitInfo, 0); 6091 PaintBufferToScreen(xMin, yMin, xRange, yRange); 6092 6093 SliceCount := 0; 6094 Ticks := Ticks0; 6095 repeat 6096 if (SliceCount = 0) or ((Ticks - Ticks0) * 12000 * (SliceCount + 1) 6097 div SliceCount < MoveTime * PerfFreq) then 2660 6098 begin 2661 SoundMessageEx(Tribe[CurrentMoveInfo.AfterAttackExpeller].TPhrase('EXPEL'),''); 2662 CurrentMoveInfo.AfterAttackExpeller:=-1; 2663 Update; // remove message box from screen 6099 if not idle or (GameMode = cMovie) then 6100 Application.ProcessMessages; 6101 Sleep(1); 6102 inc(SliceCount) 6103 end; 6104 QueryPerformanceCounter(Ticks); 6105 until (Ticks - Ticks0) * 12000 >= MoveTime * PerfFreq; 6106 Ticks0 := Ticks 6107 end; 6108 end; 6109 if Restore then 6110 begin 6111 BitBlt(Buffer.Canvas.Handle, 0, 0, xRange, yRange, 6112 offscreen.Canvas.Handle, xMin, yMin, SRCCOPY); 6113 PaintBufferToScreen(xMin, yMin, xRange, yRange); 6114 end; 6115 BlinkTime := -1; 6116 Timer1.Enabled := true; 6117 end; 6118 6119 procedure TMainScreen.MoveToLoc(Loc: integer; CheckSuicide: boolean); 6120 // path finder: move focused unit to loc, start multi-turn goto if too far 6121 var 6122 uix, i, MoveOptions, NextLoc, MoveResult: integer; 6123 MoveAdviceData: TMoveAdviceData; 6124 StopReason: (None, Arrived, Dead, NoTime, EnemySpotted, MoveError); 6125 begin 6126 if MyUn[UnFocus].Job > jNone then 6127 Server(sStartJob + jNone shl 4, me, UnFocus, nil^); 6128 if GetMoveAdvice(UnFocus, Loc, MoveAdviceData) >= rExecuted then 6129 begin 6130 uix := UnFocus; 6131 StopReason := None; 6132 repeat 6133 for i := 0 to MoveAdviceData.nStep - 1 do 6134 begin 6135 if i = MoveAdviceData.nStep - 1 then 6136 MoveOptions := muAutoNext 6137 else 6138 MoveOptions := 0; 6139 NextLoc := dLoc(MyUn[uix].Loc, MoveAdviceData.dx[i], 6140 MoveAdviceData.dy[i]); 6141 if (NextLoc = Loc) or (Loc = maNextCity) and 6142 (MyMap[NextLoc] and fCity <> 0) then 6143 StopReason := Arrived; 6144 if not CheckSuicide and (NextLoc = Loc) then 6145 MoveOptions := MoveOptions or muNoSuicideCheck; 6146 MoveResult := MoveUnit(MoveAdviceData.dx[i], MoveAdviceData.dy[i], 6147 MoveOptions); 6148 if MoveResult < rExecuted then 6149 StopReason := MoveError 6150 else if MoveResult and rUnitRemoved <> 0 then 6151 StopReason := Dead 6152 else if (StopReason = None) and (MoveResult and rEnemySpotted <> 0) 6153 then 6154 StopReason := EnemySpotted; 6155 if StopReason <> None then 6156 Break; 6157 end; 6158 if (StopReason = None) and 6159 ((MoveAdviceData.nStep < 25) or 6160 (MyRO.Wonder[woShinkansen].EffectiveOwner <> me)) then 6161 StopReason := NoTime; 6162 if StopReason <> None then 6163 Break; 6164 if GetMoveAdvice(UnFocus, Loc, MoveAdviceData) < rExecuted then 6165 begin 6166 assert(false); 6167 Break 6168 end 6169 until false; 6170 6171 case StopReason of 6172 None: 6173 assert(false); 6174 Arrived: 6175 MyUn[uix].Status := MyUn[uix].Status and ($FFFF - usGoto); 6176 Dead: 6177 if UnFocus < 0 then 6178 NextUnit(UnStartLoc, false); 6179 else 6180 begin // multi-turn goto 6181 if Loc = maNextCity then 6182 MyUn[uix].Status := MyUn[uix].Status and 6183 ($FFFF - usStay - usRecover) or usGoto + $7FFF shl 16 6184 else 6185 MyUn[uix].Status := MyUn[uix].Status and 6186 ($FFFF - usStay - usRecover) or usGoto + Loc shl 16; 6187 PaintLoc(MyUn[uix].Loc); 6188 if (StopReason = NoTime) and (UnFocus = uix) then 6189 begin 6190 MyUn[uix].Status := MyUn[uix].Status and not usWaiting; 6191 NextUnit(UnStartLoc, true) 6192 end; 2664 6193 end 2665 else if not idle then 2666 if Command=cShowCityChanged then 2667 Sleep(MoveTime*WaitAfterShowMove div 16) 2668 else if (Command=cShowUnitChanged) 2669 and (MyMap[integer(Data)] and fUnit<>0) then 2670 Sleep(MoveTime*WaitAfterShowMove div 32) 2671 end // if CurrentMoveInfo.DoShow 2672 else MapValid:=false; 6194 end 6195 end 6196 end; 6197 6198 procedure TMainScreen.PanelBoxMouseDown(Sender: TObject; 6199 Button: TMouseButton; Shift: TShiftState; x, y: integer); 6200 var 6201 i, xMouse, MouseLoc, p1: integer; 6202 begin 6203 if GameMode = cMovie then 6204 exit; 6205 6206 if Button = mbLeft then 6207 begin 6208 if (x >= xMini + 2) and (y >= yMini + 2) and (x < xMini + 2 + 2 * G.lx) 6209 and (y < yMini + 2 + G.ly) then 6210 if ssShift in Shift then 6211 begin 6212 xMouse := (xwMini + (x - (xMini + 2) + MapWidth div (xxt * 2) + 6213 G.lx) div 2) mod G.lx; 6214 MouseLoc := xMouse + G.lx * (y - (yMini + 2)); 6215 if MyMap[MouseLoc] and fTerrain <> fUNKNOWN then 6216 begin 6217 p1 := MyRO.Territory[MouseLoc]; 6218 if (p1 = me) or (p1 >= 0) and (MyRO.Treaty[p1] >= trNone) then 6219 NatStatDlg.ShowNewContent(wmPersistent, p1); 6220 end 6221 end 6222 else 6223 begin 6224 if CityDlg.Visible then 6225 CityDlg.Close; 6226 if UnitStatDlg.Visible then 6227 UnitStatDlg.Close; 6228 Tracking := true; 6229 PanelBoxMouseMove(Sender, Shift + [ssLeft], x, y); 6230 end 6231 else if (ClientMode <> cEditMap) and (x >= ClientWidth - xPalace) and 6232 (y >= yPalace) and (x < ClientWidth - xPalace + xSizeBig) and 6233 (y < yPalace + ySizeBig) then 6234 begin 6235 InitPopup(StatPopup); 6236 if FullScreen then 6237 StatPopup.Popup(Left + ClientWidth - xPalace + xSizeBig + 2, 6238 Top + ClientHeight - PanelHeight + yPalace - 1) 6239 else 6240 StatPopup.Popup(Left + ClientWidth - xPalace + 6, 6241 Top + ClientHeight - PanelHeight + yPalace + ySizeBig + 6242 GetSystemMetrics(SM_CYCAPTION) + 3) 6243 end 6244 (* else if (x>=xAdvisor-3) and (y>=yAdvisor-3) 6245 and (x<xAdvisor+16+3) and (y<yAdvisor+16+3) and HaveStrategyAdvice then 6246 AdviceBtnClick *) 6247 else if (x >= xTroop + 1) and (y >= yTroop + 1) and 6248 (x < xTroop + TrRow * TrPitch) and (y <= yTroop + 55) then 6249 begin 6250 i := (x - xTroop - 1) div TrPitch; 6251 if trix[i] >= 0 then 6252 if ClientMode = cEditMap then 6253 begin 6254 BrushType := trix[i]; 6255 PanelPaint 6256 end 6257 else if (TroopLoc >= 0) then 6258 if MyMap[TroopLoc] and fOwned <> 0 then 6259 begin 6260 if ssShift in Shift then 6261 UnitStatDlg.ShowNewContent_OwnModel(wmPersistent, 6262 MyUn[trix[i]].mix) 6263 else if not supervising and (ClientMode < scContact) and 6264 (x - xTroop - 1 - i * TrPitch >= 60 - 20) and 6265 (y >= yTroop + 35) and 6266 ((MyUn[trix[i]].Job > jNone) or (MyUn[trix[i]].Status and 6267 (usStay or usRecover or usGoto) <> 0)) then 6268 begin // wake up 6269 MyUn[trix[i]].Status := MyUn[trix[i]].Status and 6270 ($FFFF - usStay - usRecover - usGoto - usEnhance) or 6271 usWaiting; 6272 if MyUn[trix[i]].Job > jNone then 6273 Server(sStartJob + jNone shl 4, me, trix[i], nil^); 6274 if (UnFocus < 0) and not CityDlg.Visible then 6275 begin 6276 SetUnFocus(trix[i]); 6277 SetTroopLoc(MyUn[trix[i]].Loc); 6278 FocusOnLoc(TroopLoc, flRepaintPanel) 6279 end 6280 else 6281 begin 6282 if CityDlg.Visible and (CityDlg.RestoreUnFocus < 0) then 6283 CityDlg.RestoreUnFocus := trix[i]; 6284 PanelPaint; 6285 end 6286 end 6287 else if (ClientMode < scContact) then 6288 begin 6289 if supervising then 6290 UnitStatDlg.ShowNewContent_OwnUnit(wmPersistent, trix[i]) 6291 else if CityDlg.Visible then 6292 begin 6293 CityDlg.CloseAction := None; 6294 CityDlg.Close; 6295 SumCities(TaxSum, ScienceSum); 6296 SetUnFocus(trix[i]); 6297 end 6298 else 6299 begin 6300 DestinationMarkON := false; 6301 PaintDestination; 6302 UnFocus := trix[i]; 6303 UnStartLoc := TroopLoc; 6304 BlinkTime := 0; 6305 BlinkON := false; 6306 PaintLoc(TroopLoc); 6307 end; 6308 if UnFocus >= 0 then 6309 begin 6310 UnitInfoBtn.Visible := true; 6311 UnitBtn.Visible := true; 6312 TurnComplete := false; 6313 EOT.ButtonIndex := eotGray; 6314 end; 6315 CheckTerrainBtnVisible; 6316 PanelPaint; 6317 end 6318 end 6319 else if Server(sGetUnits, me, TroopLoc, TrCnt) >= rExecuted then 6320 if ssShift in Shift then 6321 UnitStatDlg.ShowNewContent_EnemyModel(wmPersistent, 6322 MyRO.EnemyUn[MyRO.nEnemyUn + trix[i]].emix) // model info 6323 else 6324 UnitStatDlg.ShowNewContent_EnemyUnit(wmPersistent, 6325 MyRO.nEnemyUn + trix[i]); // unit info 6326 end 6327 end 6328 end; 6329 6330 procedure TMainScreen.SetTroopLoc(Loc: integer); 6331 var 6332 trixFocus, uix, uixDefender: integer; 6333 Prio: boolean; 6334 begin 6335 TroopLoc := Loc; 6336 TrRow := (xRightPanel + 10 - xTroop - GetSystemMetrics(SM_CXVSCROLL) - 19) 6337 div TrPitch; 6338 TrCnt := 0; 6339 trixFocus := -1; 6340 if ClientMode = cEditMap then 6341 TrCnt := nBrushTypes 6342 else if (Loc >= 0) and (MyMap[Loc] and fUnit <> 0) then 6343 if MyMap[Loc] and fOwned <> 0 then 6344 begin // count own units here 6345 Server(sGetDefender, me, TroopLoc, uixDefender); 6346 for Prio := true downto false do 6347 for uix := 0 to MyRO.nUn - 1 do 6348 if ((uix = uixDefender) = Prio) and (MyUn[uix].Loc = Loc) then 6349 begin 6350 if uix = UnFocus then 6351 trixFocus := TrCnt; 6352 inc(TrCnt); 6353 end 6354 end 6355 else // count enemy units here 6356 Server(sGetUnits, me, Loc, TrCnt); 6357 if TrCnt = 0 then 6358 InitPVSB(sb, 0, 1) 6359 else 6360 begin 6361 InitPVSB(sb, (TrCnt + TrRow - 1) div TrRow - 1, 1); 6362 with sb.si do 6363 if (nMax >= integer(nPage)) and (trixFocus >= 0) then 6364 begin 6365 sb.si.npos := trixFocus div TrRow; 6366 sb.si.FMask := SIF_POS; 6367 SetScrollInfo(sb.h, SB_CTL, sb.si, true); 6368 end 6369 end 6370 end; 6371 6372 (* procedure TMainScreen.ShowMoveHint(ToLoc: integer; Force: boolean = false); 6373 var 6374 Step,Loc,x0,y0,xs,ys: integer; 6375 Info: string; 6376 InfoSize: TSize; 6377 MoveAdvice: TMoveAdviceData; 6378 begin 6379 if (ToLoc<0) or (ToLoc>=G.lx*G.ly) 6380 or (UnFocus<0) or (MyUn[UnFocus].Loc=ToLoc) then 6381 ToLoc:=-1 6382 else 6383 begin 6384 MoveAdvice.ToLoc:=ToLoc; 6385 MoveAdvice.MoreTurns:=0; 6386 MoveAdvice.MaxHostile_MovementLeft:=MyUn[UnFocus].Health-50; 6387 if Server(sGetMoveAdvice,me,UnFocus,MoveAdvice)<rExecuted then 6388 ToLoc:=-1 2673 6389 end; 2674 2675 cShowMoving,cShowCapturing: 2676 if (idle and (NewPlayer=me) 2677 or not idle and not skipped and (TShowMove(Data).emix<>$FFFF)) 2678 and not ((GameMode=cMovie) and (MovieSpeed=4)) then 2679 begin 2680 assert(NewPlayer=me); 2681 if not idle or (GameMode=cMovie) then 2682 Application.ProcessMessages; 2683 with TShowMove(Data) do 2684 begin 2685 CurrentMoveInfo.DoShow:=false; 2686 if not idle and (Tribe[Owner].ModelPicture[mix].HGr=0) then 2687 InitEnemyModel(emix); 2688 2689 ToLoc:=dLoc(FromLoc,dx,dy); 2690 if idle then 2691 begin // own unit -- make discovered land visible 2692 assert(Owner=me); // no foreign moves during my turn! 2693 CurrentMoveInfo.DoShow:=not mEffectiveMovesOnly.Checked 2694 or (Command=cShowCapturing); 2695 if CurrentMoveInfo.DoShow then 6390 if (ToLoc=MoveHintToLoc) and not Force then exit; 6391 if (ToLoc<>MoveHintToLoc) and (MoveHintToLoc>=0) then 6392 begin invalidate; update end; // clear old hint from screen 6393 MoveHintToLoc:=ToLoc; 6394 if ToLoc<0 then exit; 6395 6396 with canvas do 6397 begin 6398 Pen.Color:=$80C0FF; 6399 Pen.Width:=3; 6400 Loc:=MyUn[UnFocus].Loc; 6401 for Step:=0 to MoveAdvice.nStep do 6402 begin 6403 y0:=(Loc+G.lx*1024) div G.lx -1024; 6404 x0:=(Loc+(y0 and 1+G.lx*1024) div 2) mod G.lx; 6405 xs:=(x0-xw)*66+y0 and 1*33-G.lx*66; 6406 while abs(2*(xs+G.lx*66)-MapWidth)<abs(2*xs-MapWidth) do 6407 inc(xs,G.lx*66); 6408 ys:=(y0-yw)*16; 6409 if Step=0 then moveto(xs+33,ys+16) 6410 else lineto(xs+33,ys+16); 6411 if Step<MoveAdvice.nStep then 6412 Loc:=dLoc(Loc,MoveAdvice.dx[Step],MoveAdvice.dy[Step]); 6413 end; 6414 Brush.Color:=$80C0FF; 6415 Info:=' '+inttostr(88)+' '; 6416 InfoSize:=TextExtent(Info); 6417 TextOut(xs+33-InfoSize.cx div 2, ys+16-InfoSize.cy div 2, Info); 6418 Brush.Style:=bsClear; 6419 end 6420 end; *) 6421 6422 procedure TMainScreen.SetDebugMap(p: integer); 6423 begin 6424 IsoEngine.pDebugMap := p; 6425 IsoEngine.Options := IsoEngine.Options and not(1 shl moLocCodes); 6426 mLocCodes.Checked := false; 6427 MapValid := false; 6428 MainOffscreenPaint; 6429 end; 6430 6431 procedure TMainScreen.SetViewpoint(p: integer); 6432 var 6433 i: integer; 6434 begin 6435 if supervising and (G.RO[0].Turn > 0) and 6436 ((p = 0) or (1 shl p and G.RO[0].Alive <> 0)) then 6437 begin 6438 for i := 0 to Screen.FormCount - 1 do 6439 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) 6440 then 6441 Screen.Forms[i].Close; // close windows 6442 ItsMeAgain(p); 6443 SumCities(TaxSum, ScienceSum); 6444 for i := 0 to MyRO.nModel - 1 do 6445 if Tribe[me].ModelPicture[i].HGr = 0 then 6446 InitMyModel(i, true); 6447 6448 SetTroopLoc(-1); 6449 PanelPaint; 6450 MapValid := false; 6451 PaintAllMaps; 6452 end 6453 end; 6454 6455 procedure TMainScreen.FormKeyDown(Sender: TObject; var Key: word; 6456 Shift: TShiftState); 6457 6458 procedure MenuClick_Check(Popup: TPopupMenu; Item: TMenuItem); 6459 begin 6460 InitPopup(Popup); 6461 if Item.Visible and Item.Enabled then 6462 MenuClick(Item); 6463 end; 6464 6465 var 6466 dx, dy: integer; 6467 time0, time1: int64; 6468 begin 6469 if GameMode = cMovie then 6470 begin 6471 case Key of 6472 VK_F4: 6473 MenuClick_Check(StatPopup, mScienceStat); 6474 VK_F6: 6475 MenuClick_Check(StatPopup, mDiagram); 6476 VK_F7: 6477 MenuClick_Check(StatPopup, mWonders); 6478 VK_F8: 6479 MenuClick_Check(StatPopup, mShips); 6480 end; 6481 exit; 6482 end; 6483 6484 if not idle then 6485 exit; 6486 6487 if ClientMode = cEditMap then 6488 begin 6489 if Shift = [ssCtrl] then 6490 case char(Key) of 6491 (* 'A': 6492 begin // auto symmetry 6493 Server($7F0,me,0,nil^); 6494 MapValid:=false; 6495 PaintAll; 6496 end; 6497 'B': 6498 begin // land mass 6499 dy:=0; 6500 for dx:=G.lx to G.lx*(G.ly-1)-1 do 6501 if MyMap[dx] and fTerrain>=fGrass then inc(dy); 6502 dy:=dy 6503 end; *) 6504 'Q': 6505 MenuClick(mResign); 6506 'R': 6507 MenuClick(mRandomMap); 6508 end 6509 else if Shift = [] then 6510 case char(Key) of 6511 char(VK_F1): 6512 MenuClick(mHelp); 6513 end; 6514 exit; 6515 end; 6516 6517 if Shift = [ssAlt] then 6518 case char(Key) of 6519 '0': 6520 SetDebugMap(-1); 6521 '1' .. '9': 6522 SetDebugMap(ord(Key) - 48); 6523 end 6524 else if Shift = [ssCtrl] then 6525 case char(Key) of 6526 'J': 6527 MenuClick(mJump); 6528 'K': 6529 mShowClick(mDebugMap); 6530 'L': 6531 mShowClick(mLocCodes); 6532 'M': 6533 if LogDlg.Visible then 6534 LogDlg.Close 6535 else 6536 LogDlg.Show; 6537 'N': 6538 mNamesClick(mNames); 6539 'Q': 6540 MenuClick_Check(GamePopup, mResign); 6541 'R': 6542 MenuClick(mRun); 6543 '0' .. '9': 2696 6544 begin 2697 if GameMode=cMovie then 6545 if ord(Key) - 48 = me then 6546 SetViewpoint(0) 6547 else 6548 SetViewpoint(ord(Key) - 48); 6549 end; 6550 ' ': 6551 begin // test map repaint time 6552 QueryPerformanceCounter(time0); 6553 MapValid := false; 6554 MainOffscreenPaint; 6555 QueryPerformanceCounter(time1); 6556 SimpleMessage(Format('Map repaint time: %.3f ms', 6557 [{$IFDEF VER100}(time1.LowPart - time0.LowPart) 6558 {$ELSE}(time1 - time0){$ENDIF} * 1000.0 / PerfFreq])); 6559 end 6560 end 6561 else if Shift = [] then 6562 case char(Key) of 6563 char(VK_F1): 6564 MenuClick(mHelp); 6565 char(VK_F2): 6566 MenuClick_Check(StatPopup, mUnitStat); 6567 char(VK_F3): 6568 MenuClick_Check(StatPopup, mCityStat); 6569 char(VK_F4): 6570 MenuClick_Check(StatPopup, mScienceStat); 6571 char(VK_F5): 6572 MenuClick_Check(StatPopup, mEUnitStat); 6573 char(VK_F6): 6574 MenuClick_Check(StatPopup, mDiagram); 6575 char(VK_F7): 6576 MenuClick_Check(StatPopup, mWonders); 6577 char(VK_F8): 6578 MenuClick_Check(StatPopup, mShips); 6579 char(VK_F9): 6580 MenuClick_Check(StatPopup, mNations); 6581 char(VK_F10): 6582 MenuClick_Check(StatPopup, mEmpire); 6583 char(VK_ADD): 6584 EndTurn; 6585 '1': 6586 MapBtnClick(MapBtn0); 6587 '2': 6588 MapBtnClick(MapBtn1); 6589 '3': 6590 MapBtnClick(MapBtn4); 6591 '4': 6592 MapBtnClick(MapBtn5); 6593 '5': 6594 MapBtnClick(MapBtn6); 6595 'T': 6596 MenuClick(mTechTree); 6597 'W': 6598 MenuClick(mWait); 6599 end; 6600 6601 if UnFocus >= 0 then 6602 if Shift = [ssCtrl] then 6603 case char(Key) of 6604 'C': 6605 MenuClick_Check(UnitPopup, mCancel); 6606 'D': 6607 MenuClick(mDisband); 6608 'P': 6609 MenuClick_Check(UnitPopup, mPillage); 6610 'T': 6611 MenuClick_Check(UnitPopup, mSelectTransport); 6612 end 6613 else if Shift = [] then 6614 case char(Key) of 6615 ' ': 6616 MenuClick(mNoOrders); 6617 'A': 6618 MenuClick_Check(TerrainPopup, mAirBase); 6619 'B': 6620 MenuClick_Check(UnitPopup, mCity); 6621 'C': 6622 MenuClick(mCentre); 6623 'E': 2698 6624 begin 2699 if MovieSpeed=3 then AnimationSpeed:=4 2700 else if MovieSpeed=2 then AnimationSpeed:=8 2701 else AnimationSpeed:=16; 6625 InitPopup(TerrainPopup); 6626 if mEnhance.Visible and mEnhance.Enabled then 6627 MenuClick(mEnhance) 6628 else 6629 MenuClick(mEnhanceDef) 6630 end; 6631 'F': 6632 MenuClick_Check(TerrainPopup, mFort); 6633 'G': 6634 MenuClick_Check(UnitPopup, mGoOn); 6635 'H': 6636 MenuClick_Check(UnitPopup, mHome); 6637 'I': 6638 if JobTest(UnFocus, jFarm, [eTreaty]) then 6639 MenuClick(mFarm) 6640 else if JobTest(UnFocus, jClear, [eTreaty]) then 6641 MenuClick(mClear) 6642 else 6643 MenuClick_Check(TerrainPopup, mIrrigation); 6644 'L': 6645 MenuClick_Check(UnitPopup, mLoad); 6646 'M': 6647 if JobTest(UnFocus, jAfforest, [eTreaty]) then 6648 MenuClick(mAfforest) 6649 else 6650 MenuClick_Check(TerrainPopup, mMine); 6651 'N': 6652 MenuClick_Check(TerrainPopup, mCanal); 6653 'O': 6654 MenuClick_Check(TerrainPopup, MTrans); 6655 'P': 6656 MenuClick_Check(TerrainPopup, mPollution); 6657 'R': 6658 if JobTest(UnFocus, jRR, [eTreaty]) then 6659 MenuClick(mRR) 6660 else 6661 MenuClick_Check(TerrainPopup, mRoad); 6662 'S': 6663 MenuClick(mStay); 6664 'U': 6665 MenuClick_Check(UnitPopup, mUnload); 6666 'V': 6667 MenuClick_Check(UnitPopup, mRecover); 6668 'Z': 6669 MenuClick_Check(UnitPopup, mUtilize); 6670 #33 .. #40, #97 .. #100, #102 .. #105: 6671 begin { arrow keys } 6672 DestinationMarkON := false; 6673 PaintDestination; 6674 MyUn[UnFocus].Status := MyUn[UnFocus].Status and 6675 ($FFFF - usStay - usRecover - usGoto - usEnhance) or 6676 usWaiting; 6677 case Key of 6678 VK_NUMPAD1, VK_END: 6679 begin 6680 dx := -1; 6681 dy := 1 6682 end; 6683 VK_NUMPAD2, VK_DOWN: 6684 begin 6685 dx := 0; 6686 dy := 2 6687 end; 6688 VK_NUMPAD3, VK_NEXT: 6689 begin 6690 dx := 1; 6691 dy := 1 6692 end; 6693 VK_NUMPAD4, VK_LEFT: 6694 begin 6695 dx := -2; 6696 dy := 0 6697 end; 6698 VK_NUMPAD6, VK_RIGHT: 6699 begin 6700 dx := 2; 6701 dy := 0 6702 end; 6703 VK_NUMPAD7, VK_HOME: 6704 begin 6705 dx := -1; 6706 dy := -1 6707 end; 6708 VK_NUMPAD8, VK_UP: 6709 begin 6710 dx := 0; 6711 dy := -2 6712 end; 6713 VK_NUMPAD9, VK_PRIOR: 6714 begin 6715 dx := 1; 6716 dy := -1 6717 end; 6718 end; 6719 MoveUnit(dx, dy, muAutoNext) 6720 end; 6721 end 6722 end; 6723 6724 procedure TMainScreen.MenuClick(Sender: TObject); 6725 6726 function DoJob(j0: integer): integer; 6727 var 6728 Loc0, Movement0: integer; 6729 begin 6730 with MyUn[UnFocus] do 6731 begin 6732 DestinationMarkON := false; 6733 PaintDestination; 6734 Loc0 := Loc; 6735 Movement0 := Movement; 6736 if j0 < 0 then 6737 result := ProcessEnhancement(UnFocus, MyData.EnhancementJobs) 6738 // terrain enhancement 6739 else 6740 result := Server(sStartJob + j0 shl 4, me, UnFocus, nil^); 6741 if result >= rExecuted then 6742 begin 6743 if result = eDied then 6744 UnFocus := -1; 6745 PaintLoc(Loc0); 6746 if UnFocus >= 0 then 6747 begin 6748 if (j0 < 0) and (result <> eJobDone) then 6749 // multi-turn terrain enhancement 6750 Status := Status and ($FFFF - usStay - usRecover - usGoto) or 6751 usEnhance 6752 else 6753 Status := Status and 6754 ($FFFF - usStay - usRecover - usGoto - usEnhance); 6755 if (Job <> jNone) or (Movement0 < 100) then 6756 begin 6757 Status := Status and not usWaiting; 6758 NextUnit(UnStartLoc, true); 2702 6759 end 6760 else 6761 PanelPaint 6762 end 2703 6763 else 6764 NextUnit(UnStartLoc, true); 6765 end 6766 end; 6767 case result of 6768 eNoBridgeBuilding: 6769 SoundMessage(Phrases.Lookup('NOBB'), 'INVALID'); 6770 eNoCityTerrain: 6771 SoundMessage(Phrases.Lookup('NOCITY'), 'INVALID'); 6772 eTreaty: 6773 SoundMessage(Tribe[MyRO.Territory[Loc0]].TPhrase('PEACE_NOWORK'), 6774 'NOMOVE_TREATY'); 6775 else 6776 if result < rExecuted then 6777 Play('INVALID') 6778 end 6779 end; 6780 6781 var 6782 i, uix, NewFocus, Loc0, OldMaster, Destination, cix, cixOldHome, 6783 ServerResult: integer; 6784 AltGovs, Changed: boolean; 6785 QueryText: string; 6786 6787 begin 6788 if Sender = mResign then 6789 if ClientMode = cEditMap then 6790 begin 6791 if Edited then 6792 begin 6793 QueryText := Phrases.Lookup('MAP_CLOSE'); 6794 case SimpleQuery(mkYesNoCancel, QueryText, '') of 6795 mrIgnore: 6796 Server(sAbandonMap, me, 0, nil^); 6797 mrOK: 6798 Server(sSaveMap, me, 0, nil^); 6799 end 6800 end 6801 else 6802 Server(sAbandonMap, me, 0, nil^) 6803 end 6804 else 6805 begin 6806 if Server(sGetGameChanged, 0, 0, nil^) = eOK then 6807 begin 6808 QueryText := Phrases.Lookup('RESIGN'); 6809 case SimpleQuery(mkYesNoCancel, QueryText, '') of 6810 mrIgnore: 6811 Server(sResign, 0, 0, nil^); 6812 mrOK: 6813 Server(sBreak, 0, 0, nil^) 6814 end 6815 end 6816 else 6817 Server(sResign, 0, 0, nil^) 6818 end 6819 else if Sender = mEmpire then 6820 RatesDlg.ShowNewContent(wmPersistent) 6821 else if Sender = mRevolution then 6822 begin 6823 AltGovs := false; 6824 for i := 2 to nGov - 1 do 6825 if (GovPreq[i] <> preNA) and 6826 ((GovPreq[i] = preNone) or (MyRO.Tech[GovPreq[i]] >= tsApplicable)) 6827 then 6828 AltGovs := true; 6829 6830 if not AltGovs then 6831 SoundMessage(Phrases.Lookup('NOALTGOVS'), 'MSG_DEFAULT') 6832 else 6833 begin 6834 Changed := false; 6835 if MyRO.Happened and phChangeGov <> 0 then 6836 begin 6837 ModalSelectDlg.ShowNewContent(wmModal, kGov); 6838 if ModalSelectDlg.result >= 0 then 6839 begin 6840 Play('NEWGOV'); 6841 Server(sSetGovernment, me, ModalSelectDlg.result, nil^); 6842 CityOptimizer_BeginOfTurn; 6843 Changed := true; 6844 end 6845 end 6846 else 6847 with MessgExDlg do 6848 begin // revolution! 6849 MessgText := Tribe[me].TPhrase('REVOLUTION'); 6850 Kind := mkYesNo; 6851 IconKind := mikPureIcon; 6852 IconIndex := 72; // anarchy palace 6853 ShowModal; 6854 if ModalResult = mrOK then 2704 6855 begin 2705 if mVeryFastMoves.Checked then AnimationSpeed:=4 2706 else if mFastMoves.Checked then AnimationSpeed:=8 2707 else AnimationSpeed:=16; 2708 end; 2709 with MyModel[mix] do 6856 Play('REVOLUTION'); 6857 Server(sRevolution, me, 0, nil^); 6858 Changed := true; 6859 if NatStatDlg.Visible then 6860 NatStatDlg.Close; 6861 if CityDlg.Visible then 6862 CityDlg.Close; 6863 end 6864 end; 6865 if Changed then 6866 UpdateViews(true); 6867 end 6868 end 6869 else if Sender = mWebsite then 6870 ShellExecute(Handle, 'open', 'http://c-evo.org', '', '', SW_SHOWNORMAL) 6871 else if Sender = mRandomMap then 6872 begin 6873 if not Edited or (SimpleQuery(mkYesNo, Phrases.Lookup('MAP_RANDOM'), '') 6874 = mrOK) then 6875 begin 6876 Server(sRandomMap, me, 0, nil^); 6877 Edited := true; 6878 MapValid := false; 6879 PaintAllMaps; 6880 end 6881 end 6882 else if Sender = mJump then 6883 begin 6884 if supervising then 6885 Jump[0] := 20 6886 else 6887 Jump[me] := 20; 6888 EndTurn(true); 6889 end 6890 else if Sender = mRun then 6891 begin 6892 if supervising then 6893 Jump[0] := 999999 6894 else 6895 Jump[me] := 999999; 6896 EndTurn(true); 6897 end 6898 else if Sender = mEnhanceDef then 6899 begin 6900 if UnFocus >= 0 then 6901 EnhanceDlg.ShowNewContent(wmPersistent, 6902 MyMap[MyUn[UnFocus].Loc] and fTerrain) 6903 else 6904 EnhanceDlg.ShowNewContent(wmPersistent) 6905 end 6906 else if Sender = mCityTypes then 6907 CityTypeDlg.ShowNewContent(wmModal) 6908 // must be modal because types are not saved before closing 6909 else if Sender = mUnitStat then 6910 begin 6911 if G.Difficulty[me] > 0 then 6912 ListDlg.ShowNewContent_MilReport(wmPersistent, me) 6913 else 6914 begin 6915 i := 1; 6916 while (i < nPl) and (1 shl i and MyRO.Alive = 0) do 6917 inc(i); 6918 if i < nPl then 6919 ListDlg.ShowNewContent_MilReport(wmPersistent, i); 6920 end; 6921 end 6922 else if Sender = mEUnitStat then 6923 begin 6924 if MyRO.nEnemyModel > 0 then 6925 ListDlg.ShowNewContent(wmPersistent, kAllEModels); 6926 end 6927 else if Sender = mCityStat then 6928 ListDlg.ShowNewContent(wmPersistent, kCities) 6929 else if Sender = mScienceStat then 6930 ListDlg.ShowNewContent(wmPersistent, kScience) 6931 else if Sender = mNations then 6932 NatStatDlg.ShowNewContent(wmPersistent) 6933 else if Sender = mHelp then 6934 if ClientMode = cEditMap then 6935 HelpDlg.ShowNewContent(wmPersistent, hkText, 6936 HelpDlg.TextIndex('MAPEDIT')) 6937 else 6938 HelpDlg.ShowNewContent(wmPersistent, hkMisc, miscMain) 6939 else if Sender = mTechTree then 6940 TechTreeDlg.ShowModal 6941 else if Sender = mWonders then 6942 WondersDlg.ShowNewContent(wmPersistent) 6943 else if Sender = mDiagram then 6944 DiaDlg.ShowNewContent_Charts(wmPersistent) 6945 else if Sender = mShips then 6946 DiaDlg.ShowNewContent_Ship(wmPersistent) 6947 else if Sender = mWait then 6948 begin 6949 if UnFocus >= 0 then 6950 begin 6951 DestinationMarkON := false; 6952 PaintDestination; 6953 MyUn[UnFocus].Status := MyUn[UnFocus].Status and 6954 ($FFFF - usStay - usRecover - usGoto - usEnhance) or usWaiting; 6955 end; 6956 NextUnit(-1, false); 6957 end 6958 else if UnFocus >= 0 then 6959 with MyUn[UnFocus] do 6960 if Sender = mGoOn then 6961 begin 6962 if Status shr 16 = $7FFF then 6963 Destination := maNextCity 6964 else 6965 Destination := Status shr 16; 6966 Status := Status and not(usStay or usRecover) or usWaiting; 6967 MoveToLoc(Destination, true); 6968 end 6969 else if Sender = mHome then 6970 if MyMap[Loc] and fCity <> 0 then 6971 begin 6972 cixOldHome := Home; 6973 if Server(sSetUnitHome, me, UnFocus, nil^) >= rExecuted then 2710 6974 begin 2711 if (Kind=mkDiplomat) or (Domain=dAir) 2712 or (Cap[mcRadar]+Cap[mcCarrier]+Cap[mcAcademy]>0) 2713 or (MyMap[ToLoc] and fTerrain=fMountains) 2714 or (MyMap[ToLoc] and fTerImp=tiFort) 2715 or (MyMap[ToLoc] and fTerImp=tiBase) then 2716 CurrentMoveInfo.AfterMovePaintRadius:=2 2717 else CurrentMoveInfo.AfterMovePaintRadius:=1; 2718 if (MyRO.Wonder[woShinkansen].EffectiveOwner=me) 2719 and (Domain=dGround) 2720 and (MyMap[FromLoc] and (fRR or fCity)<>0) 2721 and (MyMap[ToLoc] and (fRR or fCity)<>0) 2722 and (Flags and umPlaneUnloading=0) then 2723 AnimationSpeed:=4; 2724 ShowMoveDomain:=Domain; 2725 IsAlpine:= Cap[mcAlpine]>0; 6975 CityOptimizer_CityChange(cixOldHome); 6976 CityOptimizer_CityChange(Home); 6977 UpdateViews(true); 6978 end 6979 else 6980 Play('INVALID'); 6981 end 6982 else 6983 begin 6984 Status := Status and not(usStay or usRecover or usEnhance); 6985 MoveToLoc(maNextCity, true) 6986 end 6987 else if Sender = mCentre then 6988 begin 6989 Centre(Loc); 6990 PaintAllMaps 6991 end 6992 else if Sender = mCity then 6993 begin 6994 Loc0 := Loc; 6995 if MyMap[Loc] and fCity = 0 then 6996 begin // build city 6997 if DoJob(jCity) = eCity then 6998 begin 6999 MapValid := false; 7000 PaintAll; 7001 ZoomToCity(Loc0, true, chFounded); 2726 7002 end 2727 7003 end 7004 else 7005 begin 7006 CityOptimizer_BeforeRemoveUnit(UnFocus); 7007 ServerResult := Server(sAddToCity, me, UnFocus, nil^); 7008 if ServerResult >= rExecuted then 7009 begin 7010 cix := MyRO.nCity - 1; 7011 while (cix >= 0) and (MyCity[cix].Loc <> Loc0) do 7012 dec(cix); 7013 assert(cix >= 0); 7014 CityOptimizer_CityChange(cix); 7015 CityOptimizer_AfterRemoveUnit; // does nothing here 7016 SetTroopLoc(Loc0); 7017 UpdateViews(true); 7018 DestinationMarkON := false; 7019 PaintDestination; 7020 UnFocus := -1; 7021 PaintLoc(Loc0); 7022 NextUnit(UnStartLoc, true); 7023 end 7024 else if ServerResult = eMaxSize then 7025 SimpleMessage(Phrases.Lookup('ADDTOMAXSIZE')); 7026 end 2728 7027 end 7028 else if Sender = mRoad then 7029 DoJob(jRoad) 7030 else if Sender = mRR then 7031 DoJob(jRR) 7032 else if Sender = mClear then 7033 DoJob(jClear) 7034 else if Sender = mIrrigation then 7035 DoJob(jIrr) 7036 else if Sender = mFarm then 7037 DoJob(jFarm) 7038 else if Sender = mAfforest then 7039 DoJob(jAfforest) 7040 else if Sender = mMine then 7041 DoJob(jMine) 7042 else if Sender = mCanal then 7043 DoJob(jCanal) 7044 else if Sender = MTrans then 7045 DoJob(jTrans) 7046 else if Sender = mFort then 7047 DoJob(jFort) 7048 else if Sender = mAirBase then 7049 DoJob(jBase) 7050 else if Sender = mPollution then 7051 DoJob(jPoll) 7052 else if Sender = mPillage then 7053 DoJob(jPillage) 7054 else if Sender = mEnhance then 7055 DoJob(-1) 7056 else if Sender = mStay then 7057 begin 7058 DestinationMarkON := false; 7059 PaintDestination; 7060 Status := Status and ($FFFF - usRecover - usGoto - usEnhance) 7061 or usStay; 7062 if Job > jNone then 7063 Server(sStartJob + jNone shl 4, me, UnFocus, nil^); 7064 NextUnit(UnStartLoc, true) 7065 end 7066 else if Sender = mRecover then 7067 begin 7068 DestinationMarkON := false; 7069 PaintDestination; 7070 Status := Status and ($FFFF - usStay - usGoto - usEnhance) or 7071 usRecover; 7072 if Job > jNone then 7073 Server(sStartJob + jNone shl 4, me, UnFocus, nil^); 7074 NextUnit(UnStartLoc, true) 7075 end 7076 else if Sender = mNoOrders then 7077 begin 7078 Status := Status and not usWaiting; 7079 NextUnit(UnStartLoc, true) 7080 end 7081 else if Sender = mCancel then 7082 begin 7083 DestinationMarkON := false; 7084 PaintDestination; 7085 Status := Status and ($FFFF - usRecover - usGoto - usEnhance); 7086 if Job > jNone then 7087 Server(sStartJob + jNone shl 4, me, UnFocus, nil^); 7088 end 7089 else if (Sender = mDisband) or (Sender = mUtilize) then 7090 begin 7091 if (Sender = mUtilize) and 7092 not(Server(sRemoveUnit - sExecute, me, UnFocus, nil^) = eUtilized) 7093 then 7094 begin 7095 SimpleMessage(Phrases2.Lookup('SHIP_UTILIZE')); 7096 // freight for colony ship is the only case in which the command is 7097 // available to player though not valid 7098 exit 7099 end; 7100 if (Sender = mUtilize) and (Health < 100) then 7101 if SimpleQuery(mkYesNo, Phrases.Lookup('DAMAGED_UTILIZE'), '') <> mrOK 7102 then 7103 exit; 7104 Loc0 := Loc; 7105 CityOptimizer_BeforeRemoveUnit(UnFocus); 7106 if Server(sRemoveUnit, me, UnFocus, nil^) = eUtilized then 7107 Play('CITY_UTILIZE') 7108 else 7109 Play('DISBAND'); 7110 CityOptimizer_AfterRemoveUnit; 7111 SetTroopLoc(Loc0); 7112 UpdateViews(true); 7113 DestinationMarkON := false; 7114 PaintDestination; 7115 UnFocus := -1; 7116 PaintLoc(Loc0); 7117 NextUnit(UnStartLoc, true); 7118 end 7119 else if Sender = mLoad then 7120 begin 7121 i := Server(sLoadUnit, me, UnFocus, nil^); 7122 if i >= rExecuted then 7123 begin 7124 if MyModel[mix].Domain = dAir then 7125 Play('MOVE_PLANELANDING') 7126 else 7127 Play('MOVE_LOAD'); 7128 DestinationMarkON := false; 7129 PaintDestination; 7130 Status := Status and 7131 ($FFFF - usWaiting - usStay - usRecover - usGoto - usEnhance); 7132 NextUnit(UnStartLoc, true); 7133 end 7134 else if i = eNoTime_Load then 7135 if MyModel[mix].Domain = dAir then 7136 SoundMessage(Phrases.Lookup('NOTIMELOADAIR'), 'NOMOVE_TIME') 7137 else 7138 SoundMessage(Format(Phrases.Lookup('NOTIMELOADGROUND'), 7139 [MovementToString(MyModel[mix].speed)]), 'NOMOVE_TIME'); 7140 end 7141 else if Sender = mUnload then 7142 if Master >= 0 then 7143 begin 7144 OldMaster := Master; 7145 i := Server(sUnloadUnit, me, UnFocus, nil^); 7146 if i >= rExecuted then 7147 begin 7148 if MyModel[mix].Domain = dAir then 7149 Play('MOVE_PLANESTART') 7150 else if (MyModel[MyUn[OldMaster].mix].Domain = dAir) and 7151 (MyMap[Loc] and fCity = 0) and 7152 (MyMap[Loc] and fTerImp <> tiBase) then 7153 Play('MOVE_PARACHUTE') 7154 else 7155 Play('MOVE_UNLOAD'); 7156 Status := Status and not usWaiting; 7157 if MyModel[mix].Domain <> dAir then 7158 NextUnit(Loc, true) 7159 else 7160 PanelPaint 7161 end 7162 else if i = eNoTime_Load then 7163 if MyModel[mix].Domain = dAir then 7164 SoundMessage(Phrases.Lookup('NOTIMELOADAIR'), 'NOMOVE_TIME') 7165 else 7166 SoundMessage(Format(Phrases.Lookup('NOTIMELOADGROUND'), 7167 [MovementToString(MyModel[mix].speed)]), 'NOMOVE_TIME'); 7168 end 7169 else 7170 begin 7171 NewFocus := -1; 7172 uix := UnFocus; 7173 for i := 1 to MyRO.nUn - 1 do 7174 begin 7175 uix := (uix + MyRO.nUn - 1) mod MyRO.nUn; 7176 if (MyUn[uix].Master = UnFocus) and 7177 (MyUn[uix].Movement = integer(MyModel[MyUn[uix].mix].speed)) 7178 then 7179 begin 7180 MyUn[uix].Status := MyUn[uix].Status or usWaiting; 7181 NewFocus := uix 7182 end; 7183 end; 7184 if NewFocus >= 0 then 7185 begin 7186 SetUnFocus(NewFocus); 7187 SetTroopLoc(Loc); 7188 PanelPaint 7189 end 7190 end 7191 else if Sender = mSelectTransport then 7192 Server(sSelectTransport, me, UnFocus, nil^) 7193 end; 7194 7195 procedure TMainScreen.InitPopup(Popup: TPopupMenu); 7196 var 7197 i, p1, Tile, Test: integer; 7198 NoSuper, extended, Multi, NeedSep, HaveCities: boolean; 7199 LastSep, m: TMenuItem; 7200 mox: ^TModel; 7201 begin 7202 NoSuper := not supervising and (1 shl me and MyRO.Alive <> 0); 7203 HaveCities := false; 7204 for i := 0 to MyRO.nCity - 1 do 7205 if MyCity[i].Loc >= 0 then 7206 begin 7207 HaveCities := true; 7208 Break 7209 end; 7210 if Popup = GamePopup then 7211 begin 7212 mTechTree.Visible := ClientMode <> cEditMap; 7213 mResign.Enabled := supervising or (me = 0) and (ClientMode < scContact); 7214 mRandomMap.Visible := (ClientMode = cEditMap) and 7215 (Server(sMapGeneratorRequest, me, 0, nil^) = eOK); 7216 mOptions.Visible := ClientMode <> cEditMap; 7217 mManip.Visible := ClientMode <> cEditMap; 7218 if ClientMode <> cEditMap then 7219 begin 7220 mWaitTurn.Visible := NoSuper; 7221 mRep.Visible := NoSuper; 7222 mRepList.Visible := NoSuper; 7223 mRepScreens.Visible := NoSuper; 7224 N10.Visible := NoSuper; 7225 mOwnMovement.Visible := NoSuper; 7226 mAllyMovement.Visible := NoSuper; 7227 case SoundMode of 7228 smOff: 7229 mSoundOff.Checked := true; 7230 smOn: 7231 mSoundOn.Checked := true; 7232 smOnAlt: 7233 mSoundOnAlt.Checked := true; 7234 end; 7235 7236 for i := 0 to nTestFlags - 1 do 7237 mManip[i].Checked := MyRO.TestFlags and (1 shl i) <> 0; 7238 mManip.Enabled := supervising or (me = 0); 7239 7240 Multi := false; 7241 for p1 := 1 to nPl - 1 do 7242 if G.RO[p1] <> nil then 7243 Multi := true; 7244 mEnemyMovement.Visible := not Multi; 7245 end; 7246 mMacro.Visible := NoSuper and (ClientMode < scContact); 7247 if NoSuper and (ClientMode < scContact) then 7248 begin 7249 mCityTypes.Enabled := false; 7250 // check if city types already usefull: 7251 if MyRO.nCity > 0 then 7252 for i := 28 to nImp - 1 do 7253 if (i <> imTrGoods) and (Imp[i].Kind = ikCommon) and 7254 (Imp[i].Preq <> preNA) and 7255 ((Imp[i].Preq = preNone) or 7256 (MyRO.Tech[Imp[i].Preq] >= tsApplicable)) then 7257 begin 7258 mCityTypes.Enabled := true; 7259 Break 7260 end; 7261 end; 7262 mViewpoint.Visible := (ClientMode <> cEditMap) and supervising; 7263 mViewpoint.Enabled := G.RO[0].Turn > 0; 7264 if supervising then 7265 begin 7266 EmptyMenu(mViewpoint); 7267 for p1 := 0 to nPl - 1 do 7268 if (p1 = 0) or (1 shl p1 and G.RO[0].Alive <> 0) then 7269 begin 7270 m := TMenuItem.Create(mViewpoint); 7271 if p1 = 0 then 7272 m.Caption := Phrases.Lookup('SUPER') 7273 else 7274 m.Caption := Tribe[p1].TString(Phrases2.Lookup('BELONG')); 7275 m.Tag := p1; 7276 m.OnClick := ViewpointClick; 7277 if p1 < 10 then 7278 m.ShortCut := ShortCut(48 + p1, [ssCtrl]); 7279 m.RadioItem := true; 7280 if p1 = me then 7281 m.Checked := true; 7282 mViewpoint.Add(m); 7283 end 7284 end; 7285 mDebugMap.Visible := (ClientMode <> cEditMap) and supervising; 7286 if supervising then 7287 begin 7288 EmptyMenu(mDebugMap); 7289 for p1 := 0 to nPl - 1 do 7290 if (p1 = 0) or (1 shl p1 and G.RO[0].Alive <> 0) then 7291 begin 7292 m := TMenuItem.Create(mDebugMap); 7293 if p1 = 0 then 7294 m.Caption := Phrases2.Lookup('MENU_DEBUGMAPOFF') 7295 else 7296 m.Caption := Tribe[p1].TString(Phrases2.Lookup('BELONG')); 7297 if p1 = 0 then 7298 m.Tag := -1 7299 else 7300 m.Tag := p1; 7301 m.OnClick := DebugMapClick; 7302 if p1 < 10 then 7303 m.ShortCut := ShortCut(48 + p1, [ssAlt]); 7304 m.RadioItem := true; 7305 if m.Tag = IsoEngine.pDebugMap then 7306 m.Checked := true; 7307 mDebugMap.Add(m); 7308 end 7309 end; 7310 mSmallTiles.Checked := xxt = 33; 7311 mNormalTiles.Checked := xxt = 48; 7312 end 7313 else if Popup = StatPopup then 7314 begin 7315 mEmpire.Visible := NoSuper; 7316 mEmpire.Enabled := MyRO.Government <> gAnarchy; 7317 mRevolution.Visible := NoSuper; 7318 mRevolution.Enabled := (MyRO.Government <> gAnarchy) and 7319 (ClientMode < scContact); 7320 mUnitStat.Enabled := NoSuper or (MyRO.Turn > 0); 7321 mCityStat.Visible := 1 shl me and MyRO.Alive <> 0; 7322 mCityStat.Enabled := HaveCities; 7323 mScienceStat.Visible := true; 7324 mScienceStat.Enabled := not NoSuper or (MyRO.ResearchTech >= 0) or 7325 (MyRO.Happened and phTech <> 0) or (MyRO.Happened and phGameEnd <> 0) 7326 // no researchtech in case just completed 7327 or (MyRO.TestFlags and (tfAllTechs or tfUncover or 7328 tfAllContact) <> 0); 7329 mEUnitStat.Enabled := MyRO.nEnemyModel > 0; 7330 { mWonders.Enabled:= false; 7331 for i:=0 to 27 do if MyRO.Wonder[i].CityID<>-1 then 7332 mWonders.Enabled:=true; } 7333 mDiagram.Enabled := MyRO.Turn >= 2; 7334 mShips.Enabled := false; 7335 for p1 := 0 to nPl - 1 do 7336 if MyRO.Ship[p1].Parts[spComp] + MyRO.Ship[p1].Parts[spPow] + 7337 MyRO.Ship[p1].Parts[spHab] > 0 then 7338 mShips.Enabled := true; 7339 end 7340 else if Popup = UnitPopup then 7341 begin 7342 mox := @MyModel[MyUn[UnFocus].mix]; 7343 Tile := MyMap[MyUn[UnFocus].Loc]; 7344 extended := Tile and fCity = 0; 7345 if extended then 7346 begin 7347 mCity.Caption := Phrases.Lookup('BTN_FOUND'); 7348 mHome.Caption := Phrases.Lookup('BTN_MOVEHOME') 7349 end 2729 7350 else 7351 begin 7352 mCity.Caption := Phrases.Lookup('BTN_ADD'); 7353 mHome.Caption := Phrases.Lookup('BTN_SETHOME') 7354 end; 7355 7356 extended := extended and 7357 ((mox.Kind = mkSettler) or (mox.Kind = mkSlaves) and 7358 (MyRO.Wonder[woPyramids].EffectiveOwner >= 0)) and 7359 (MyUn[UnFocus].Master < 0) and (Tile and fDeadLands = 0); 7360 if (mox.Kind = mkFreight) and (Tile and fCity <> 0) and 7361 not Phrases2FallenBackToEnglish or 7362 (Server(sRemoveUnit - sExecute, me, UnFocus, nil^) = eUtilized) then 7363 begin 7364 mDisband.Visible := false; 7365 mUtilize.Visible := true; 7366 if mox.Kind = mkFreight then 7367 mUtilize.Caption := Phrases.Lookup('UTILIZE') 7368 else 7369 mUtilize.Caption := Phrases.Lookup('INTEGRATE') 7370 end 7371 else 7372 begin 7373 mDisband.Visible := true; 7374 mUtilize.Visible := false 7375 end; 7376 mGoOn.Visible := MyUn[UnFocus].Status and (usGoto or usWaiting) 7377 = usGoto or usWaiting; 7378 mHome.Visible := HaveCities; 7379 mRecover.Visible := (MyUn[UnFocus].Health < 100) and 7380 (Tile and fTerrain >= fGrass) and 7381 ((MyRO.Wonder[woGardens].EffectiveOwner = me) or 7382 (Tile and fTerrain <> fArctic) and (Tile and fTerrain <> fDesert)) and 7383 not((mox.Domain = dAir) and (Tile and fCity = 0) and 7384 (Tile and fTerImp <> tiBase)); 7385 mStay.Visible := not((mox.Domain = dAir) and (Tile and fCity = 0) and 7386 (Tile and fTerImp <> tiBase)); 7387 mCity.Visible := extended and (mox.Kind = mkSettler) or 7388 (Tile and fCity <> 0) and ((mox.Kind in [mkSettler, mkSlaves]) or 7389 (MyUn[UnFocus].Flags and unConscripts <> 0)); 7390 mPillage.Visible := (Tile and (fRoad or fRR or fCanal or fTerImp) <> 0) 7391 and (MyUn[UnFocus].Master < 0) and (mox.Domain = dGround); 7392 mCancel.Visible := (MyUn[UnFocus].Job > jNone) or 7393 (MyUn[UnFocus].Status and (usRecover or usGoto) <> 0); 7394 7395 Test := Server(sLoadUnit - sExecute, me, UnFocus, nil^); 7396 mLoad.Visible := (Test >= rExecuted) or (Test = eNoTime_Load); 7397 mUnload.Visible := (MyUn[UnFocus].Master >= 0) or 7398 (MyUn[UnFocus].TroopLoad + MyUn[UnFocus].AirLoad > 0); 7399 mSelectTransport.Visible := Server(sSelectTransport - sExecute, me, 7400 UnFocus, nil^) >= rExecuted; 7401 end 7402 else { if Popup=TerrainPopup then } 7403 begin 7404 mox := @MyModel[MyUn[UnFocus].mix]; 7405 Tile := MyMap[MyUn[UnFocus].Loc]; 7406 extended := Tile and fCity = 0; 7407 7408 if (Tile and fRiver <> 0) and 7409 (MyRO.Tech[adBridgeBuilding] >= tsApplicable) then 7410 begin 7411 mRoad.Caption := Phrases.Lookup('BTN_BUILDBRIDGE'); 7412 mRR.Caption := Phrases.Lookup('BTN_BUILDRRBRIDGE'); 7413 end 7414 else 7415 begin 7416 mRoad.Caption := Phrases.Lookup('BTN_BUILDROAD'); 7417 mRR.Caption := Phrases.Lookup('BTN_BUILDRR'); 7418 end; 7419 if Tile and fTerrain = fForest then 7420 mClear.Caption := Phrases.Lookup('BTN_CLEAR') 7421 else if Tile and fTerrain = fDesert then 7422 mClear.Caption := Phrases.Lookup('BTN_UNDESERT') 7423 else 7424 mClear.Caption := Phrases.Lookup('BTN_DRAIN'); 7425 7426 extended := extended and 7427 ((mox.Kind = mkSettler) or (mox.Kind = mkSlaves) and 7428 (MyRO.Wonder[woPyramids].EffectiveOwner >= 0)) and 7429 (MyUn[UnFocus].Master < 0); 7430 if extended then 7431 begin 7432 mRoad.Visible := JobTest(UnFocus, jRoad, 7433 [eNoBridgeBuilding, eTreaty]); 7434 mRR.Visible := JobTest(UnFocus, jRR, [eNoBridgeBuilding, eTreaty]); 7435 mClear.Visible := JobTest(UnFocus, jClear, [eTreaty]); 7436 mIrrigation.Visible := JobTest(UnFocus, jIrr, [eTreaty]); 7437 mFarm.Visible := JobTest(UnFocus, jFarm, [eTreaty]); 7438 mAfforest.Visible := JobTest(UnFocus, jAfforest, [eTreaty]); 7439 mMine.Visible := JobTest(UnFocus, jMine, [eTreaty]); 7440 MTrans.Visible := JobTest(UnFocus, jTrans, [eTreaty]); 7441 mCanal.Visible := JobTest(UnFocus, jCanal, [eTreaty]); 7442 mFort.Visible := JobTest(UnFocus, jFort, [eTreaty]); 7443 mAirBase.Visible := JobTest(UnFocus, jBase, [eTreaty]); 7444 mPollution.Visible := JobTest(UnFocus, jPoll, [eTreaty]); 7445 mEnhance.Visible := (Tile and fDeadLands = 0) and 7446 (MyData.EnhancementJobs[MyMap[MyUn[UnFocus].Loc] and fTerrain, 0] 7447 <> jNone); 7448 end 7449 else 7450 begin 7451 for i := 0 to Popup.Items.Count - 1 do 7452 Popup.Items[i].Visible := false; 7453 end; 7454 end; 7455 7456 // set menu seperators 7457 LastSep := nil; 7458 NeedSep := false; 7459 for i := 0 to Popup.Items.Count - 1 do 7460 if Popup.Items[i].Caption = '-' then 7461 begin 7462 Popup.Items[i].Visible := NeedSep; 7463 if NeedSep then 7464 LastSep := Popup.Items[i]; 7465 NeedSep := false 7466 end 7467 else if Popup.Items[i].Visible then 7468 NeedSep := true; 7469 if (LastSep <> nil) and not NeedSep then 7470 LastSep.Visible := false 7471 end; 7472 7473 procedure TMainScreen.PanelBtnClick(Sender: TObject); 7474 var 7475 Popup: TPopupMenu; 7476 begin 7477 if Sender = UnitBtn then 7478 Popup := UnitPopup 7479 else { if Sender=TerrainBtn then } 7480 Popup := TerrainPopup; 7481 InitPopup(Popup); 7482 if FullScreen then 7483 Popup.Popup(Left + TControl(Sender).Left, Top + TControl(Sender).Top) 7484 else 7485 Popup.Popup(Left + TControl(Sender).Left + 4, Top + TControl(Sender).Top 7486 + GetSystemMetrics(SM_CYCAPTION) + 4); 7487 end; 7488 7489 procedure TMainScreen.CityClosed(Activateuix: integer; StepFocus: boolean; 7490 SelectFocus: boolean); 7491 begin 7492 if supervising then 7493 begin 7494 SetTroopLoc(-1); 7495 PanelPaint 7496 end 7497 else 7498 begin 7499 if Activateuix >= 0 then 7500 begin 7501 SetUnFocus(Activateuix); 7502 SetTroopLoc(MyUn[Activateuix].Loc); 7503 if SelectFocus then 7504 FocusOnLoc(TroopLoc, flRepaintPanel) 7505 else 7506 PanelPaint 7507 end 7508 else if StepFocus then 7509 NextUnit(TroopLoc, true) 7510 else 7511 begin 7512 SetTroopLoc(-1); 7513 PanelPaint 7514 end 7515 end 7516 end; 7517 7518 procedure TMainScreen.Toggle(Sender: TObject); 7519 begin 7520 TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked 7521 end; 7522 7523 procedure TMainScreen.PanelBoxMouseMove(Sender: TObject; Shift: TShiftState; 7524 x, y: integer); 7525 var 7526 xCentre, yCentre: integer; 7527 begin 7528 if Tracking and (ssLeft in Shift) then 7529 begin 7530 if (x >= xMini + 2) and (y >= yMini + 2) and (x < xMini + 2 + 2 * G.lx) 7531 and (y < yMini + 2 + G.ly) then 7532 begin 7533 xCentre := (xwMini + (x - xMini - 2) div 2 + G.lx div 2 + 7534 MapWidth div (xxt * 4)) mod G.lx; 7535 yCentre := (y - yMini - 2); 7536 xw := (xCentre - MapWidth div (xxt * 4) + G.lx) mod G.lx; 7537 if ywmax <= 0 then 7538 yw := ywcenter 7539 else 2730 7540 begin 2731 CurrentMoveInfo.IsAlly:= MyRO.Treaty[Owner]=trAlliance; 2732 if GameMode=cMovie then 2733 CurrentMoveInfo.DoShow:=true 2734 else if CurrentMoveInfo.IsAlly then 2735 CurrentMoveInfo.DoShow:=not mAlNoMoves.Checked 2736 and not(mAlEffectiveMovesOnly.Checked and (Command<>cShowCapturing)) 2737 else CurrentMoveInfo.DoShow:=not mEnNoMoves.Checked 2738 and not(mEnAttacks.Checked and (Command<>cShowCapturing)); 2739 if CurrentMoveInfo.DoShow then 2740 begin 2741 if Command=cShowCapturing then 2742 begin // show capture message 2743 if MyMap[ToLoc] and fOwned<>0 then 2744 begin // own city, search 2745 cix:=MyRO.nCity-1; 2746 while (cix>=0) and (MyCity[cix].Loc<>ToLoc) do 2747 dec(cix); 2748 s:=CityName(MyCity[cix].ID); 2749 end 2750 else 2751 begin // foreign city, search 2752 ecix:=MyRO.nEnemyCity-1; 2753 while (ecix>=0) and (MyRO.EnemyCity[ecix].Loc<>ToLoc) do 2754 dec(ecix); 2755 s:=CityName(MyRO.EnemyCity[ecix].ID); 2756 end; 2757 TribeMessage(Owner, Format(Tribe[Owner].TPhrase('CAPTURE'),[s]), ''); 2758 Update; // remove message box from screen 2759 end; 2760 2761 if CurrentMoveInfo.IsAlly then 2762 begin // allied unit -- make discovered land visible 2763 if mAlFastMoves.Checked then AnimationSpeed:=8 2764 else AnimationSpeed:=16; 2765 with MyRO.EnemyModel[emix] do 2766 if (Kind=mkDiplomat) or (Domain=dAir) or (ATrans_Fuel>0) 2767 or (Cap and (1 shl (mcRadar-mcFirstNonCap) or 1 shl (mcAcademy-mcFirstNonCap))<>0) 2768 or (MyMap[ToLoc] and fTerrain=fMountains) 2769 or (MyMap[ToLoc] and fTerImp=tiFort) 2770 or (MyMap[ToLoc] and fTerImp=tiBase) then 2771 CurrentMoveInfo.AfterMovePaintRadius:=2 2772 else CurrentMoveInfo.AfterMovePaintRadius:=1 2773 end 7541 yw := (yCentre - MapHeight div (yyt * 2) + 1) and not 1; 7542 if yw < 0 then 7543 yw := 0 7544 else if yw > ywmax then 7545 yw := ywmax; 7546 end; 7547 BitBlt(Buffer.Canvas.Handle, 0, 0, G.lx * 2, G.ly, Mini.Canvas.Handle, 7548 0, 0, SRCCOPY); 7549 if ywmax <= 0 then 7550 Frame(Buffer.Canvas, x - xMini - 2 - MapWidth div (xxt * 2), 0, 7551 x - xMini - 2 + MapWidth div (xxt * 2) - 1, G.ly - 1, 7552 MainTexture.clMark, MainTexture.clMark) 7553 else 7554 Frame(Buffer.Canvas, x - xMini - 2 - MapWidth div (xxt * 2), yw, 7555 x - xMini - 2 + MapWidth div (xxt * 2) - 1, 7556 yw + MapHeight div yyt - 2, MainTexture.clMark, 7557 MainTexture.clMark); 7558 BitBlt(Panel.Canvas.Handle, xMini + 2, yMini + 2, G.lx * 2, G.ly, 7559 Buffer.Canvas.Handle, 0, 0, SRCCOPY); 7560 MainOffscreenPaint; 7561 RectInvalidate(xMini + 2, TopBarHeight + MapHeight - overlap + yMini + 7562 2, xMini + 2 + G.lx * 2, TopBarHeight + MapHeight - overlap + yMini 7563 + 2 + G.ly); 7564 Update; 7565 end 7566 end 7567 else 7568 Tracking := false 7569 end; 7570 7571 procedure TMainScreen.PanelBoxMouseUp(Sender: TObject; Button: TMouseButton; 7572 Shift: TShiftState; x, y: integer); 7573 begin 7574 if Tracking then 7575 begin 7576 Tracking := false; 7577 xwMini := xw; 7578 ywMini := yw; 7579 MiniPaint; 7580 PanelPaint; 7581 end 7582 end; 7583 7584 procedure TMainScreen.MapBoxMouseMove(Sender: TObject; Shift: TShiftState; 7585 x, y: integer); 7586 var 7587 MouseLoc: integer; 7588 begin 7589 xMouse := x; 7590 yMouse := y; 7591 if (ClientMode = cEditMap) and (ssLeft in Shift) and not Tracking then 7592 begin 7593 MouseLoc := LocationOfScreenPixel(x, y); 7594 if MouseLoc <> BrushLoc then 7595 MapBoxMouseDown(nil, mbLeft, Shift, x, y); 7596 end 7597 (* else if idle and (UnFocus>=0) then 7598 begin 7599 qx:=(xMouse*32+yMouse*66+16*66) div(32*66)-1; 7600 qy:=(yMouse*66-xMouse*32-16*66+2000*33*32) div(32*66)-999; 7601 MouseLoc:=(xw+(qx-qy+2048) div 2-1024+G.lx) mod G.lx+G.lx*(yw+qx+qy); 7602 ShowMoveHint(MouseLoc); 7603 end *) 7604 end; 7605 7606 procedure TMainScreen.mShowClick(Sender: TObject); 7607 begin 7608 TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked; 7609 SetMapOptions; 7610 MapValid := false; 7611 PaintAllMaps; 7612 end; 7613 7614 procedure TMainScreen.mNamesClick(Sender: TObject); 7615 var 7616 p1: integer; 7617 begin 7618 mNames.Checked := not mNames.Checked; 7619 GenerateNames := mNames.Checked; 7620 for p1 := 0 to nPl - 1 do 7621 if Tribe[p1] <> nil then 7622 if GenerateNames then 7623 Tribe[p1].NumberName := -1 7624 else 7625 Tribe[p1].NumberName := p1; 7626 MapValid := false; 7627 PaintAll; 7628 end; 7629 7630 function TMainScreen.IsPanelPixel(x, y: integer): boolean; 7631 begin 7632 result := (y >= TopBarHeight + MapHeight) or 7633 (y >= ClientHeight - PanelHeight) and 7634 ((x < xMidPanel) or (x >= xRightPanel)) 7635 end; 7636 7637 procedure TMainScreen.FormMouseDown(Sender: TObject; Button: TMouseButton; 7638 Shift: TShiftState; x, y: integer); 7639 begin 7640 if idle then 7641 if (x < 40) and (y < 40) then 7642 begin 7643 if GameMode <> cMovie then 7644 begin 7645 InitPopup(GamePopup); 7646 if FullScreen then 7647 GamePopup.Popup(Left, Top + TopBarHeight - 1) 2774 7648 else 2775 begin 2776 if mEnFastMoves.Checked then AnimationSpeed:=8 2777 else AnimationSpeed:=16; 2778 CurrentMoveInfo.AfterMovePaintRadius:=0; // enemy unit, nothing discovered 2779 end; 2780 if GameMode=cMovie then 2781 begin 2782 if MovieSpeed=3 then AnimationSpeed:=4 2783 else if MovieSpeed=2 then AnimationSpeed:=8 2784 else AnimationSpeed:=16; 2785 end; 2786 ShowMoveDomain:=MyRO.EnemyModel[emix].Domain; 2787 IsAlpine:= MyRO.EnemyModel[emix].Cap and (1 shl (mcAlpine-mcFirstNonCap))<>0; 2788 end 2789 end; 2790 2791 if CurrentMoveInfo.DoShow then 2792 begin 2793 if Command=cShowCapturing then Play('MOVE_CAPTURE') 2794 else if EndHealth<=0 then Play('MOVE_DIE') 2795 else if Flags and umSpyMission<>0 then Play('MOVE_COVERT') 2796 else if Flags and umShipLoading<>0 then 2797 if ShowMoveDomain=dAir then Play('MOVE_PLANELANDING') 2798 else Play('MOVE_LOAD') 2799 else if Flags and umPlaneLoading<>0 then Play('MOVE_LOAD') 2800 else if Flags and umShipUnloading<>0 then 2801 if ShowMoveDomain=dAir then Play('MOVE_PLANESTART') 2802 else Play('MOVE_UNLOAD') 2803 else if Flags and umPlaneUnloading<>0 then 2804 if (MyMap[FromLoc] and fCity=0) 2805 and (MyMap[FromLoc] and fTerImp<>tiBase) then 2806 Play('MOVE_PARACHUTE') 2807 else Play('MOVE_UNLOAD') 2808 else if (ShowMoveDomain=dGround) and not IsAlpine 2809 and (MyMap[ToLoc] and fTerrain=fMountains) 2810 and ((MyMap[FromLoc] and (fRoad or fRR or fCity)=0) 2811 or (MyMap[ToLoc] and (fRoad or fRR or fCity)=0)) then 2812 Play('MOVE_MOUNTAIN'); 2813 2814 FocusOnLoc(FromLoc,flImmUpdate); 2815 PaintLoc_BeforeMove(FromLoc); 2816 if Command=cShowCapturing then 2817 MoveOnScreen(TShowMove(Data),1,32,32) 2818 else MoveOnScreen(TShowMove(Data),1,AnimationSpeed,AnimationSpeed) 2819 end // if CurrentMoveInfo.DoShow 2820 else MapValid:=false; 2821 end 2822 end; 2823 2824 cShowAttacking: 2825 if (idle and (NewPlayer=me) 2826 or not idle and not skipped and (TShowMove(Data).emix<>$FFFF)) 2827 and not ((GameMode=cMovie) and (MovieSpeed=4)) then 2828 begin 2829 assert(NewPlayer=me); 2830 if not idle or (GameMode=cMovie) then 2831 Application.ProcessMessages; 2832 with TShowMove(Data) do 2833 begin 2834 CurrentMoveInfo.AfterAttackExpeller:=-1; 2835 CurrentMoveInfo.DoShow:=false; 2836 if idle then 2837 CurrentMoveInfo.DoShow:=true // own unit -- always show attacks 2838 else 2839 begin 2840 CurrentMoveInfo.IsAlly:= MyRO.Treaty[Owner]=trAlliance; 2841 if CurrentMoveInfo.IsAlly then 2842 CurrentMoveInfo.DoShow:=not mAlNoMoves.Checked 2843 else CurrentMoveInfo.DoShow:=not mEnNoMoves.Checked; 2844 end; 2845 if CurrentMoveInfo.DoShow then 2846 begin 2847 ToLoc:=dLoc(FromLoc,dx,dy); 2848 if Tribe[Owner].ModelPicture[mix].HGr=0 then 2849 InitEnemyModel(emix); 2850 2851 if (MyMap[ToLoc] and (fCity or fUnit or fOwned) = fCity or fOwned) then 2852 begin // tell about bombardment 2853 cix:=MyRO.nCity-1; 2854 while (cix>=0) and (MyCity[cix].Loc<>ToLoc) do 2855 dec(cix); 2856 if MyCity[cix].Status and csToldBombard=0 then 2857 begin 2858 if not supervising then 2859 MyCity[cix].Status:=MyCity[cix].Status or csToldBombard; 2860 s:=CityName(MyCity[cix].ID); 2861 SoundMessageEx(Format(Tribe[Owner].TPhrase('BOMBARD'),[s]),''); 2862 Update; // remove message box from screen 2863 end; 2864 end 2865 else if Flags and umExpelling<>0 then 2866 CurrentMoveInfo.AfterAttackExpeller:=Owner; 2867 2868 if Flags and umExpelling<>0 then Play('MOVE_EXPEL') 2869 else if Owner=me then 2870 begin 2871 MakeModelInfo(me,mix,MyModel[mix],mi); 2872 Play(AttackSound(ModelCode(mi))); 2873 end 2874 else Play(AttackSound(ModelCode(MyRO.EnemyModel[emix]))); 2875 2876 FocusOnLoc(FromLoc,flImmUpdate); 2877 2878 // before combat 2879 MainMap.AttackBegin(TShowMove(Data)); 2880 if MyMap[ToLoc] and fCity<>0 then PaintLoc(ToLoc); 2881 PaintLoc(FromLoc); 2882 MoveOnScreen(TShowMove(Data),1,9,16); 2883 MoveOnScreen(TShowMove(Data),17,12,32); 2884 MoveOnScreen(TShowMove(Data),7,11,16); 2885 2886 // after combat 2887 MainMap.AttackEffect(TShowMove(Data)); 2888 PaintLoc(ToLoc); 2889 if EndHealth>0 then 2890 begin 2891 Health:=EndHealth; 2892 MoveOnScreen(TShowMove(Data),10,0,16); 2893 end 2894 else if not idle then 2895 Sleep(MoveTime div 2); 2896 MainMap.AttackEnd; 2897 end // if CurrentMoveInfo.DoShow 2898 else MapValid:=false; 2899 end 2900 end; 2901 2902 cShowMissionResult: 2903 if Cardinal(Data)=0 then 2904 SoundMessageEx(Phrases.Lookup('NOFOREIGNINFO'),'') 2905 else 2906 begin 2907 s:=Phrases.Lookup('FOREIGNINFO'); 2908 for p1:=0 to nPl-1 do if 3 shl (p1*2) and Cardinal(Data)<>0 then 2909 s:=s+'\'+Tribe[p1].TPhrase('SHORTNAME'); 2910 SoundMessageEx(s,'') 2911 end; 2912 2913 cShowShipChange: 2914 if not IsMultiPlayerGame and (Jump[0]=0) then 2915 ShowEnemyShipChange(TShowShipChange(Data)); 2916 2917 cShowGreatLibTech: 2918 if not IsMultiPlayerGame and (Jump[0]=0) then with MessgExDlg do 2919 begin 2920 MessgText:=Format(Phrases.Lookup('GRLIB_GENERAL'), 2921 [Phrases.Lookup('ADVANCES',integer(Data))]); 2922 OpenSound:='NEWADVANCE_GRLIB'; 2923 Kind:=mkOK; 2924 IconKind:=mikImp; 2925 IconIndex:=woGrLibrary; 2926 ShowModal; 2927 end; 2928 2929 cRefreshDebugMap: 2930 begin 2931 if integer(data)=IsoEngine.pDebugMap then 2932 begin 2933 MapValid:=false; 2934 MainOffscreenPaint; 2935 Update; 2936 end 2937 end; 2938 2939 else if Command>=cClientEx then case Command and $FFF0 of 2940 2941 cSetTribe: with TTribeInfo(Data) do 2942 begin 2943 i:=UnusedTribeFiles.Count-1; 2944 while (i>=0) and (AnsiCompareFileName(UnusedTribeFiles[i],FileName)<>0) do 2945 dec(i); 2946 if i>=0 then UnusedTribeFiles.Delete(i); 2947 CreateTribe(trix,FileName,true); 2948 end; 2949 2950 cSetNewModelPicture, cSetModelPicture: 2951 if TribeOriginal[TModelPictureInfo(Data).trix] then 2952 Tribe[TModelPictureInfo(Data).trix].SetModelPicture( 2953 TModelPictureInfo(Data),Command and $FFF0=cSetNewModelPicture); 2954 2955 cSetSlaveIndex and $FFF0: 2956 Tribe[integer(data) shr 16].mixSlaves:=integer(data) and $FFFF; 2957 2958 cSetCityName: with TCityNameInfo(Data) do 2959 if TribeOriginal[ID shr 12] then 2960 Tribe[ID shr 12].SetCityName(ID and $FFF,NewName); 2961 2962 cSetModelName: with TModelNameInfo(Data) do 2963 if TribeOriginal[NewPlayer] then 2964 Tribe[NewPlayer].ModelName[mix]:=NewName; 2965 end 2966 end 2967 end;{<<<client} 2968 2969 {*** main part ***} 2970 2971 procedure TMainScreen.CreateParams (var p: TCreateParams); 2972 var 2973 DefaultOptionChecked: integer; 2974 Reg: TRegistry; 2975 doinit: boolean; 2976 begin 2977 inherited; 2978 2979 // define which menu settings to save 2980 SaveOption[0]:=mAlEffectiveMovesOnly.Tag; 2981 SaveOption[1]:=mEnMoves.Tag; 2982 SaveOption[2]:=mEnAttacks.Tag; 2983 SaveOption[3]:=mEnNoMoves.Tag; 2984 SaveOption[4]:=mWaitTurn.Tag; 2985 SaveOption[5]:=mEffectiveMovesOnly.Tag; 2986 SaveOption[6]:=mEnFastMoves.Tag; 2987 SaveOption[7]:=mSlowMoves.Tag; 2988 SaveOption[8]:=mFastMoves.Tag; 2989 SaveOption[9]:=mVeryFastMoves.Tag; 2990 SaveOption[10]:=mNames.Tag; 2991 SaveOption[11]:=mRepList.Tag; 2992 SaveOption[12]:=mRepScreens.Tag; 2993 SaveOption[13]:=mSoundOff.Tag; 2994 SaveOption[14]:=mSoundOn.Tag; 2995 SaveOption[15]:=mSoundOnAlt.Tag; 2996 SaveOption[16]:=mScrollSlow.Tag; 2997 SaveOption[17]:=mScrollFast.Tag; 2998 SaveOption[18]:=mScrollOff.Tag; 2999 SaveOption[19]:=mAlSlowMoves.Tag; 3000 SaveOption[20]:=mAlFastMoves.Tag; 3001 SaveOption[21]:=mAlNoMoves.Tag; 3002 DefaultOptionChecked:= 1 shl 1 + 1 shl 7 + 1 shl 10 + 1 shl 12 + 1 shl 14 + 1 shl 18 + 1 shl 19; 3003 3004 Reg:=TRegistry.Create; 3005 doinit:=true; 3006 if Reg.KeyExists('SOFTWARE\cevo\RegVer9') then 3007 begin 3008 doinit:=false; 3009 Reg.OpenKey('SOFTWARE\cevo\RegVer9',false); 3010 try 3011 xxt:=Reg.ReadInteger('TileWidth') div 2; 3012 yyt:=Reg.ReadInteger('TileHeight') div 2; 3013 OptionChecked:=Reg.ReadInteger('OptionChecked'); 3014 MapOptionChecked:=Reg.ReadInteger('MapOptionChecked'); 3015 CityRepMask:=cardinal(Reg.ReadInteger('CityReport')); 3016 except 3017 doinit:=true; 3018 end; 3019 Reg.closekey; 3020 if OptionChecked and (7 shl 16)=0 then 3021 OptionChecked:=OptionChecked or (1 shl 16); // old regver with no scrolling 3022 end; 3023 Reg.Free; 3024 if doinit then 3025 begin 3026 xxt:=48; 3027 yyt:=24; 3028 OptionChecked:=DefaultOptionChecked; 3029 MapOptionChecked:=1 shl moCityNames; 3030 CityRepMask:=cardinal(not chPopIncrease and not chNoGrowthWarning and not chCaptured); 3031 end; 3032 3033 if FullScreen then 3034 begin 3035 p.Style:=$87000000; 3036 BorderStyle:=bsNone; 3037 BorderIcons:=[]; 3038 end; 3039 3040 if 1 shl 13 and OptionChecked<>0 then SoundMode:=smOff 3041 else if 1 shl 15 and OptionChecked<>0 then SoundMode:=smOnAlt 3042 else SoundMode:=smOn 3043 end; 3044 3045 procedure TMainScreen.FormCreate(Sender:TObject); 3046 var 3047 i,j: integer; 3048 begin 3049 Screen.Cursors[crImpDrag]:=LoadCursor(HInstance,'DRAG'); 3050 Screen.Cursors[crFlatHand]:=LoadCursor(HInstance,'FLATHAND'); 3051 3052 // tag-controlled language 3053 for i:=0 to ComponentCount-1 do 3054 if Components[i].Tag and $FF<>0 then 3055 if Components[i] is TMenuItem then 3056 begin 3057 TMenuItem(Components[i]).Caption:= 3058 Phrases.Lookup('CONTROLS',-1+Components[i].Tag and $FF); 3059 for j:=0 to nSaveOption-1 do 3060 if Components[i].Tag and $FF=SaveOption[j] then 3061 TMenuItem(Components[i]).Checked:= 1 shl j and OptionChecked<>0; 3062 end 3063 else if Components[i] is TButtonBase then 3064 begin 3065 TButtonBase(Components[i]).Hint:= 3066 Phrases.Lookup('CONTROLS',-1+Components[i].Tag and $FF); 3067 if (Components[i] is TButtonC) and (TButtonC(Components[i]).ButtonIndex<>1) then 3068 TButtonC(Components[i]).ButtonIndex:= 3069 MapOptionChecked shr (Components[i].Tag shr 8) and 1 +2 3070 end; 3071 3072 // non-tag-controlled language 3073 mTechTree.Caption:=Phrases2.Lookup('MENU_ADVTREE'); 3074 mViewpoint.Caption:=Phrases2.Lookup('MENU_VIEWPOINT'); 3075 if not Phrases2FallenBackToEnglish then 3076 begin 3077 MenuArea.Hint:=Phrases2.Lookup('BTN_MENU'); 3078 TreasuryArea.Hint:=Phrases2.Lookup('TIP_TREASURY'); 3079 ResearchArea.Hint:=Phrases.Lookup('SCIENCE'); 3080 ManagementArea.Hint:=Phrases2.Lookup('BTN_MANAGE'); 3081 end; 3082 for i:=0 to mRep.Count-1 do 3083 begin 3084 j:=mRep[i].Tag shr 8; 3085 mRep[i].Caption:=CityEventName(j); 3086 mRep[i].Checked:= CityRepMask and (1 shl j)<>0; 3087 end; 3088 3089 Mini:=TBitmap.Create; 3090 Mini.PixelFormat:=pf24bit; 3091 Panel:=TBitmap.Create; 3092 Panel.PixelFormat:=pf24bit; 3093 Panel.Canvas.Font.Assign(UniFont[ftSmall]); 3094 Panel.Canvas.Brush.Style:=bsClear; 3095 TopBar:=TBitmap.Create; 3096 TopBar.PixelFormat:=pf24bit; 3097 TopBar.Canvas.Font.Assign(UniFont[ftNormal]); 3098 TopBar.Canvas.Brush.Style:=bsClear; 3099 Buffer:=TBitmap.Create; 3100 Buffer.PixelFormat:=pf24bit; 3101 if 2*lxmax>3*xSizeBig then 3102 Buffer.Width:=2*lxmax 3103 else Buffer.Width:=3*xSizeBig; 3104 if lymax>3*ySizeBig then 3105 Buffer.Height:=lymax 3106 else Buffer.Height:=3*ySizeBig; 3107 Buffer.Canvas.Font.Assign(UniFont[ftSmall]); 3108 for i:=0 to nPl-1 do AILogo[i]:=nil; 3109 Canvas.Font.Assign(UniFont[ftSmall]); 3110 InitButtons(); 3111 EOT.Template:=Templates; 3112 end; 3113 3114 procedure TMainScreen.FormDestroy(Sender:TObject); 3115 var 3116 i: integer; 3117 begin 3118 Mini.Free;Buffer.Free;Panel.Free; 3119 for i:=0 to nPl-1 do if AILogo[i]<>nil then 3120 AILogo[i].Free; 3121 end; 3122 3123 procedure TMainScreen.FormResize(Sender:TObject); 3124 var 3125 MiniFrame,MaxMapWidth: integer; 3126 begin 3127 SmallScreen:= ClientWidth<1024; 3128 MaxMapWidth:=(G.lx*2-3)*xxt; // avoide the same tile being visible left and right 3129 if ClientWidth<=MaxMapWidth then 3130 begin 3131 MapWidth:=ClientWidth; 3132 MapOffset:=0; 3133 end 3134 else 3135 begin 3136 MapWidth:=MaxMapWidth; 3137 MapOffset:=(ClientWidth-MapWidth) div 2; 3138 end; 3139 MapHeight:=ClientHeight-TopBarHeight-PanelHeight+overlap; 3140 Panel.Width:=ClientWidth; Panel.Height:=PanelHeight; 3141 TopBar.Width:=ClientWidth; TopBar.Height:=TopBarHeight; 3142 MiniFrame:=(lxmax_xxx-G.ly) div 2; 3143 xMidPanel:=(G.lx+MiniFrame)*2+1; 3144 xRightPanel:=ClientWidth-LeftPanelWidth-10; 3145 if ClientMode=cEditMap then 3146 TrPitch:=2*xxt 3147 else TrPitch:=66; 3148 xMini:=MiniFrame-5; yMini:=(PanelHeight-26-lxmax_xxx) div 2+MiniFrame; 3149 ywmax:=(G.ly-MapHeight div yyt+1) and not 1; 3150 ywcenter:=-((MapHeight-yyt*(G.ly-1)) div (4*yyt))*2; // only for ywmax<=0 3151 if ywmax<=0 then yw:=ywcenter 3152 else if yw<0 then yw:=0 3153 else if yw>ywmax then yw:=ywmax; 3154 UnitInfoBtn.Top:=ClientHeight-29; 3155 UnitInfoBtn.Left:=xMidPanel+7+99; 3156 UnitBtn.Top:=ClientHeight-29; 3157 UnitBtn.Left:=xMidPanel+7+99+31; 3158 TerrainBtn.Top:=ClientHeight-29; 3159 TerrainBtn.Left:=xMidPanel+7+99+62; 3160 MovieSpeed1Btn.Top:=ClientHeight-91; 3161 MovieSpeed1Btn.Left:=ClientWidth div 2-62; 3162 MovieSpeed2Btn.Top:=ClientHeight-91; 3163 MovieSpeed2Btn.Left:=ClientWidth div 2-62+29; 3164 MovieSpeed3Btn.Top:=ClientHeight-91; 3165 MovieSpeed3Btn.Left:=ClientWidth div 2-62+2*29; 3166 MovieSpeed4Btn.Top:=ClientHeight-91; 3167 MovieSpeed4Btn.Left:=ClientWidth div 2-62+3*29+12; 3168 EOT.Top:=ClientHeight-64; 3169 EOT.Left:=ClientWidth-62; 3170 SetWindowPos(sb.h,0,xRightPanel+10-14-GetSystemMetrics(SM_CXVSCROLL), 3171 ClientHeight-MidPanelHeight+8,0,0,SWP_NOSIZE or SWP_NOZORDER); 3172 MapBtn0.Left:=xMini+G.lx-44; 3173 MapBtn0.Top:=ClientHeight-15; 3174 MapBtn1.Left:=xMini+G.lx-28; 3175 MapBtn1.Top:=ClientHeight-15; 3176 {MapBtn2.Left:=xMini+G.lx-20; 3177 MapBtn2.Top:=ClientHeight-15; 3178 MapBtn3.Left:=xMini+G.lx-4; 3179 MapBtn3.Top:=ClientHeight-15;} 3180 MapBtn5.Left:=xMini+G.lx-12; 3181 MapBtn5.Top:=ClientHeight-15; 3182 MapBtn4.Left:=xMini+G.lx+20; 3183 MapBtn4.Top:=ClientHeight-15; 3184 MapBtn6.Left:=xMini+G.lx+36; 3185 MapBtn6.Top:=ClientHeight-15; 3186 TreasuryArea.Left:=ClientWidth div 2-172; 3187 ResearchArea.Left:=ClientWidth div 2; 3188 ManagementArea.Left:=ClientWidth-xPalace; 3189 ManagementArea.Top:=TopBarHeight+MapHeight-overlap+yPalace; 3190 ArrangeMidPanel; 3191 if RepaintOnResize then 3192 begin 3193 RectInvalidate(0,TopBarHeight,ClientWidth,TopBarHeight+MapHeight); 3194 MapValid:=false; 3195 PaintAll 3196 end 3197 end; 3198 3199 procedure TMainScreen.FormCloseQuery(Sender: TObject; var CanClose: boolean); 3200 begin 3201 CanClose:=Closable; 3202 if not Closable and idle and (me=0) and (ClientMode<scContact) then 3203 MenuClick(mResign) 3204 end; 3205 3206 procedure TMainScreen.OnScroll(var m:TMessage); 3207 begin 3208 if ProcessPVSB(sb,m) then begin PanelPaint; Update end 3209 end; 3210 3211 procedure TMainScreen.OnEOT(var Msg:TMessage); 3212 begin 3213 EndTurn 3214 end; 3215 3216 procedure TMainScreen.EOTClick(Sender:TObject); 3217 begin 3218 if GameMode=cMovie then 3219 begin 3220 MessgExDlg.CancelMovie; 3221 Server(sBreak,me,0,nil^) 3222 end 3223 else if ClientMode<0 then 3224 skipped:=true 3225 else if ClientMode>=scContact then 3226 NegoDlg.ShowNewContent(wmPersistent) 3227 else if Jump[pTurn]>0 then 3228 begin Jump[pTurn]:=0; StartRunning:=false end 3229 else EndTurn 3230 end; 3231 3232 // set xTerrain, xTroop, and TrRow 3233 procedure TMainScreen.ArrangeMidPanel; 3234 begin 3235 if ClientMode=cEditMap then 3236 xTroop:=xMidPanel+15 3237 else 3238 begin 3239 if supervising then 3240 xTerrain:=xMidPanel+2*xxt+14 3241 else if ClientWidth<1280 then 3242 xTerrain:=ClientWidth div 2+(1280-ClientWidth) div 3 3243 else xTerrain:=ClientWidth div 2; 3244 xTroop:=xTerrain+2*xxt+12; 3245 if SmallScreen and not supervising then 3246 xTroop:=xRightPanel+10-3*66-GetSystemMetrics(SM_CXVSCROLL)-19-4; 3247 // not perfect but we assume almost no one is still playing on a 800x600 screen 3248 end; 3249 TrRow:=(xRightPanel+10-xTroop-GetSystemMetrics(SM_CXVSCROLL)-19) div TrPitch; 3250 end; 3251 3252 function TMainScreen.EndTurn(WasSkipped: boolean): boolean; 3253 3254 function IsResourceUnused(cix, NeedFood, NeedProd: integer): boolean; 3255 var 3256 dx,dy,fix: integer; 3257 CityAreaInfo: TCityAreaInfo; 3258 TileInfo: TTileInfo; 3259 begin 3260 Server(sGetCityAreaInfo,me,cix,CityAreaInfo); 3261 for dy:=-3 to 3 do for dx:=-3 to 3 do 3262 if ((dx+dy) and 1=0) and (dx*dx*dy*dy<81) then 3263 begin 3264 fix:=(dy+3) shl 2+(dx+3) shr 1; 3265 if (MyCity[cix].Tiles and (1 shl fix)=0) // not used yet 3266 and (CityAreaInfo.Available[fix]=faAvailable) then // usable 3267 begin 3268 TileInfo.ExplCity:=cix; 3269 Server(sGetHypoCityTileInfo, me, dLoc(MyCity[cix].Loc,dx,dy), TileInfo); 3270 if (TileInfo.Food>=NeedFood) and (TileInfo.Prod>=NeedProd) then 3271 begin result:=true; exit end; 3272 end 3273 end; 3274 result:=false; 3275 end; 3276 3277 var 3278 i,p1,uix,cix,CenterLoc: integer; 3279 MsgItem: string; 3280 CityReport: TCityReport; 3281 PlaneReturnData: TPlaneReturnData; 3282 Zoom: boolean; 3283 begin 3284 result:=false; 3285 if ClientMode>=scDipOffer then exit; 3286 3287 if supervising and (me<>0) then 3288 begin 3289 for i:=0 to Screen.FormCount-1 do 3290 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then 3291 Screen.Forms[i].Close; // close windows 3292 ItsMeAgain(0); 3293 end; 3294 3295 CityOptimizer_EndOfTurn; 3296 3297 if not WasSkipped then // check warnings 3298 begin 3299 // need to move planes home? 3300 for uix:=0 to MyRO.nUn-1 do with MyUn[uix] do 3301 if (Loc>=0) and (MyModel[mix].Domain=dAir) 3302 and (Status and usToldNoReturn=0) and (Master<0) 3303 and (MyMap[Loc] and fCity=0) and (MyMap[Loc] and fTerImp<>tiBase) then 3304 begin 3305 PlaneReturnData.Fuel:=Fuel; 3306 PlaneReturnData.Loc:=Loc; 3307 PlaneReturnData.Movement:=0; // end turn without further movement? 3308 if Server(sGetPlaneReturn, me, uix, PlaneReturnData)=eNoWay then 3309 begin 3310 CenterLoc:=Loc+G.lx*6; // centering the unit itself would make it covered by the query dialog 3311 while CenterLoc>=G.lx*G.ly do 3312 dec(CenterLoc, G.lx*2); 3313 Centre(CenterLoc); 3314 SetTroopLoc(-1); 3315 PaintAll; 3316 3317 if MyModel[mix].Kind=mkSpecial_Glider then 3318 MsgItem:='LOWFUEL_GLIDER' 3319 else MsgItem:='LOWFUEL'; 3320 if SimpleQuery(mkYesNo,Phrases.Lookup(MsgItem),'WARNING_LOWSUPPORT')<>mrOk then 3321 begin 3322 SetUnFocus(uix); 3323 SetTroopLoc(Loc); 3324 PanelPaint; 3325 exit; 3326 end; 3327 MyUn[uix].Status:=MyUn[uix].Status or usToldNoReturn; 3328 end 3329 end; 3330 3331 if not supervising and (MyRO.TestFlags and tfImmImprove=0) 3332 and (MyRO.Government<>gAnarchy) 3333 and (MyRO.Money+TaxSum<0) and (MyRO.TaxRate<100) then // low funds! 3334 with MessgExDlg do 3335 begin 3336 OpenSound:='WARNING_LOWFUNDS'; 3337 MessgText:=Phrases.Lookup('LOWFUNDS'); 3338 Kind:=mkYesNo; 3339 IconKind:=mikImp; 3340 IconIndex:=imTrGoods; 3341 ShowModal; 3342 if ModalResult<>mrOK then exit 3343 end; 3344 3345 if MyRO.Government<>gAnarchy then 3346 for cix:=0 to MyRO.nCity-1 do with MyCity[cix] do 3347 if (Loc>=0) and (Flags and chCaptured=0) then 3348 begin 3349 Zoom:=false; 3350 CityReport.HypoTiles:=-1; 3351 CityReport.HypoTax:=-1; 3352 CityReport.HypoLux:=-1; 3353 Server(sGetCityReport,me,cix,CityReport); 3354 3355 if (CityReport.Working-CityReport.Happy>Size shr 1) 3356 and (Flags and chCaptured<=$10000) then 3357 with MessgExDlg do 3358 begin 3359 OpenSound:='WARNING_DISORDER'; 3360 if Status and csResourceWeightsMask=0 then 3361 MsgItem:='DISORDER' 3362 else MsgItem:='DISORDER_UNREST'; 3363 MessgText:=Format(Phrases.Lookup(MsgItem),[CityName(ID)]); 3364 Kind:=mkYesNo; 3365 // BigIcon:=29; 3366 ShowModal; 3367 Zoom:= ModalResult<>mrOK; 3368 end; 3369 if not Zoom and (Food+CityReport.FoodRep-CityReport.Eaten<0) then 3370 with MessgExDlg do 3371 begin 3372 OpenSound:='WARNING_FAMINE'; 3373 if Status and csResourceWeightsMask=0 then 3374 MsgItem:='FAMINE' 3375 else if (CityReport.Deployed<>0) and IsResourceUnused(cix,1,0) then 3376 MsgItem:='FAMINE_UNREST' 3377 else MsgItem:='FAMINE_TILES'; 3378 MessgText:=Format(Phrases.Lookup(MsgItem),[CityName(ID)]); 3379 Kind:=mkYesNo; 3380 IconKind:=mikImp; 3381 IconIndex:=22; 3382 ShowModal; 3383 Zoom:= ModalResult<>mrOK; 3384 end; 3385 if not Zoom and (CityReport.ProdRep<CityReport.Support) then 3386 with MessgExDlg do 3387 begin 3388 OpenSound:='WARNING_LOWSUPPORT'; 3389 if Status and csResourceWeightsMask=0 then 3390 MsgItem:='LOWSUPPORT' 3391 else if (CityReport.Deployed<>0) and IsResourceUnused(cix,0,1) then 3392 MsgItem:='LOWSUPPORT_UNREST' 3393 else MsgItem:='LOWSUPPORT_TILES'; 3394 MessgText:=Format(Phrases.Lookup(MsgItem),[CityName(ID)]); 3395 Kind:=mkYesNo; 3396 IconKind:=mikImp; 3397 IconIndex:=29; 3398 ShowModal; 3399 Zoom:= ModalResult<>mrOK; 3400 end; 3401 if Zoom then 3402 begin // zoom to city 3403 ZoomToCity(Loc); 3404 exit 3405 end 3406 end; 3407 3408 if (MyRO.Happened and phTech<>0) and (MyRO.ResearchTech<0) 3409 and (MyData.FarTech<>adNexus) then 3410 if not ChooseResearch then 3411 exit; 3412 end; 3413 3414 RememberPeaceViolation; 3415 3416 SetUnFocus(-1); 3417 for uix:=0 to MyRO.nUn-1 do 3418 MyUn[uix].Status:=MyUn[uix].Status and usPersistent; 3419 3420 CityDlg.CloseAction:=None; 3421 if IsMultiPlayerGame then 3422 begin // close windows for next player 3423 for i:=0 to Screen.FormCount-1 do 3424 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then 3425 Screen.Forms[i].Close; 3426 end 3427 else 3428 begin 3429 if CityDlg.Visible then CityDlg.Close; 3430 if UnitStatDlg.Visible then UnitStatDlg.Close; 3431 end; 3432 for i:=0 to Screen.FormCount-1 do 3433 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then 3434 Screen.Forms[i].Enabled:=false; 3435 3436 if Server(sTurn,pTurn,0,nil^)>=rExecuted then 3437 begin 3438 if Jump[pTurn]>0 then EOT.Hint:=Phrases.Lookup('BTN_STOP') 3439 else EOT.Hint:=Phrases.Lookup('BTN_SKIP'); 3440 result:=true; 3441 SetTroopLoc(-1); 3442 pTurn:=-1; 3443 pLogo:=-1; 3444 UnitInfoBtn.Visible:=false; 3445 UnitBtn.Visible:=false; 3446 TerrainBtn.Visible:=false; 3447 EOT.ButtonIndex:=eotCancel; 3448 EOT.Visible:=true; 3449 MapValid:=false; 3450 PanelPaint; 3451 Update; 3452 ClientMode:=-1; 3453 idle:=false; 3454 skipped:=WasSkipped; 3455 for p1:=1 to nPl-1 do 3456 if G.RO[p1]<>nil then skipped:=true; // don't show enemy moves in hotseat mode 3457 end 3458 else PanelPaint 3459 end; // EndTurn 3460 3461 procedure TMainScreen.EndNego; 3462 begin 3463 if NegoDlg.Visible then NegoDlg.Close; 3464 HaveStrategyAdvice:=false; 3465 // AdvisorDlg.HaveStrategyAdvice; 3466 // negotiation might have changed advices 3467 EOT.ButtonIndex:=eotCancel; 3468 EOT.Visible:=true; 3469 PanelPaint; 3470 Update; 3471 ClientMode:=-1; 3472 idle:=false; 3473 end; 3474 3475 procedure TMainScreen.ProcessRect(x0,y0,nx,ny,Options: integer); 3476 var 3477 xs,ys,xl,yl: integer; 3478 begin 3479 xl:=nx*xxt+xxt; 3480 yl:=ny*yyt+yyt*2; 3481 xs:=(x0-xw)*(xxt*2)+y0 and 1*xxt-G.lx*(xxt*2); 3482 // |xs+xl/2-MapWidth/2| -> min 3483 while abs(2*(xs+G.lx*(xxt*2))+xl-MapWidth)<abs(2*xs+xl-MapWidth) do 3484 inc(xs,G.lx*(xxt*2)); 3485 ys:=(y0-yw)*yyt-yyt; 3486 if xs+xl>MapWidth then xl:=MapWidth-xs; 3487 if ys+yl>MapHeight then yl:=MapHeight-ys; 3488 if (xl<=0) or (yl<=0) then exit; 3489 if Options and prPaint<>0 then 3490 begin 3491 if Options and prAutoBounds<>0 then 3492 MainMap.SetPaintBounds(xs,ys,xs+xl,ys+yl); 3493 MainMap.Paint(xs,ys,x0+G.lx*y0,nx,ny,-1,-1); 3494 end; 3495 if Options and prInvalidate<>0 then 3496 RectInvalidate(MapOffset+xs,TopBarHeight+ys,MapOffset+xs+xl,TopBarHeight+ys+yl) 3497 end; 3498 3499 procedure TMainScreen.PaintLoc(Loc: integer; Radius: integer = 0); 3500 var 3501 yLoc,x0: integer; 3502 begin 3503 if MapValid then 3504 begin 3505 yLoc:=(Loc+G.lx*1024) div G.lx -1024; 3506 x0:=(Loc+(yLoc and 1-2*Radius+G.lx*1024) div 2) mod G.lx; 3507 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 3508 ProcessRect(x0,yLoc-2*Radius,4*Radius+1,4*Radius+1, 3509 prPaint or prAutoBounds or prInvalidate); 3510 Update; 3511 end 3512 end; 3513 3514 procedure TMainScreen.PaintLocTemp(Loc, Style: integer); 3515 var 3516 y0,x0,xMap,yMap: integer; 3517 begin 3518 if not MapValid then exit; 3519 Buffer.Canvas.Font.Assign(UniFont[ftSmall]); 3520 y0:=Loc div G.lx; 3521 x0:=Loc mod G.lx; 3522 xMap:=(x0-xw)*(xxt*2)+y0 and 1*xxt-G.lx*(xxt*2); 3523 // |xMap+xxt-MapWidth/2| -> min 3524 while abs(2*(xMap+G.lx*(xxt*2))+2*xxt-MapWidth)<abs(2*xMap+2*xxt-MapWidth) do 3525 inc(xMap,G.lx*(xxt*2)); 3526 yMap:=(y0-yw)*yyt-yyt; 3527 NoMap.SetOutput(Buffer); 3528 NoMap.SetPaintBounds(0,0,2*xxt,3*yyt); 3529 NoMap.Paint(0,0,Loc,1,1,-1,-1,Style=pltsBlink); 3530 PaintBufferToScreen(xMap,yMap,2*xxt,3*yyt); 3531 end; 3532 3533 // paint content of buffer directly to screen instead of offscreen 3534 // panel protusions are added 3535 // NoMap must be set to buffer and bounds before 3536 procedure TMainScreen.PaintBufferToScreen(xMap,yMap,width,height: integer); 3537 begin 3538 if xMap+width>MapWidth then 3539 width:=MapWidth-xMap; 3540 if yMap+height>MapHeight then 3541 height:=MapHeight-yMap; 3542 if (width<=0) or (height<=0) or (width+xMap<=0) or (height+yMap<=0) then 3543 exit; 3544 3545 NoMap.BitBlt(Panel,-xMap-MapOffset,-yMap+MapHeight-overlap,xMidPanel,overlap, 3546 0,0,SRCCOPY); 3547 NoMap.BitBlt(Panel,-xMap-MapOffset+xRightPanel,-yMap+MapHeight-overlap, 3548 Panel.Width-xRightPanel,overlap,xRightPanel,0,SRCCOPY); 3549 if yMap<0 then 3550 begin 3551 if xMap<0 then 3552 BitBlt(Canvas.Handle,MapOffset,TopBarHeight,width+xMap,height+yMap, 3553 Buffer.Canvas.Handle,-xMap,-yMap,SRCCOPY) 3554 else BitBlt(Canvas.Handle,xMap+MapOffset,TopBarHeight,width,height+yMap, 3555 Buffer.Canvas.Handle,0,-yMap,SRCCOPY) 3556 end 3557 else 3558 begin 3559 if xMap<0 then 3560 BitBlt(Canvas.Handle,MapOffset,TopBarHeight+yMap,width+xMap,height, 3561 Buffer.Canvas.Handle,-xMap,0,SRCCOPY) 3562 else BitBlt(Canvas.Handle,xMap+MapOffset,TopBarHeight+yMap,width,height, 3563 Buffer.Canvas.Handle,0,0,SRCCOPY); 3564 end 3565 end; 3566 3567 procedure TMainScreen.PaintLoc_BeforeMove(FromLoc: integer); 3568 var 3569 yLoc,x0: integer; 3570 begin 3571 if MapValid then 3572 begin 3573 yLoc:=(FromLoc+G.lx*1024) div G.lx -1024; 3574 x0:=(FromLoc+(yLoc and 1+G.lx*1024) div 2) mod G.lx; 3575 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 3576 ProcessRect(x0,yLoc,1,1,prPaint or prAutoBounds); 3577 end 3578 end; 3579 3580 procedure TMainScreen.PaintDestination; 3581 var 3582 Destination: integer; 3583 begin 3584 if (UnFocus>=0) and (MyUn[UnFocus].Status and usGoto<>0) then 3585 begin 3586 Destination:=MyUn[UnFocus].Status shr 16; 3587 if (Destination<>$7FFF) and (Destination<>MyUn[UnFocus].Loc) then 3588 PaintLocTemp(Destination,pltsBlink); 3589 end; 3590 end; 3591 3592 procedure TMainScreen.MiniPaint; 3593 type 3594 TLine=array[0..99999999,0..2] of Byte; 3595 var 3596 uix,cix,x,y,Loc,i,hw,xm,cm,cmPolOcean,cmPolNone:integer; 3597 PrevMiniLine,MiniLine:^TLine; 3598 begin 3599 cmPolOcean:=GrExt[HGrSystem].Data.Canvas.Pixels[101,67]; 3600 cmPolNone:=GrExt[HGrSystem].Data.Canvas.Pixels[102,67]; 3601 hw:=MapWidth div (xxt*2); 3602 with Mini.Canvas do 3603 begin 3604 Brush.Color:=$000000; 3605 FillRect(Rect(0,0,Mini.Width,Mini.Height)); 3606 end; 3607 MiniLine:=nil; 3608 for y:=0 to G.ly-1 do 3609 begin 3610 PrevMiniLine:=MiniLine; 3611 MiniLine:=Mini.ScanLine[y]; 3612 for x:=0 to G.lx-1 do if MyMap[x+G.lx*y] and fTerrain<>fUNKNOWN then 3613 begin 3614 Loc:=x+G.lx*y; 3615 for i:=0 to 1 do 3616 begin 3617 xm:=((x-xwMini)*2+i+y and 1-hw+G.lx*5) mod (G.lx*2); 3618 cm:=MiniColors[MyMap[Loc] and fTerrain,i]; 3619 if ClientMode=cEditMap then 3620 begin 3621 if MyMap[Loc] and (fPrefStartPos or fStartPos)<>0 then 3622 cm:=$FFFFFF; 3623 end 3624 else if MyMap[Loc] and fCity<>0 then 3625 begin 3626 cix:=MyRO.nCity-1; 3627 while (cix>=0) and (MyCity[cix].Loc<>Loc) do dec(cix); 3628 if cix>=0 then cm:=Tribe[me].Color 3629 else 3630 begin 3631 cix:=MyRO.nEnemyCity-1; 3632 while (cix>=0) and (MyRO.EnemyCity[cix].Loc<>Loc) do dec(cix); 3633 if cix>=0 then cm:=Tribe[MyRO.EnemyCity[cix].Owner].Color 3634 end; 3635 cm:=$808080 or cm shr 1; {increase brightness} 3636 if PrevMiniLine<>nil then 3637 begin // 2x2 city dot covers two scanlines 3638 PrevMiniLine[xm,0]:=cm shr 16; 3639 PrevMiniLine[xm,1]:=cm shr 8 and $FF; 3640 PrevMiniLine[xm,2]:=cm and $FF; 7649 GamePopup.Popup(Left + 4, Top + GetSystemMetrics(SM_CYCAPTION) + 4 7650 + TopBarHeight - 1); 3641 7651 end 3642 7652 end 3643 else if (i=0) and (MyMap[Loc] and fUnit<>0) then 3644 begin 3645 uix:=MyRO.nUn-1; 3646 while (uix>=0) and (MyUn[uix].Loc<>Loc) do dec(uix); 3647 if uix>=0 then cm:=Tribe[me].Color 7653 else if IsPanelPixel(x, y) then 7654 PanelBoxMouseDown(Sender, Button, Shift, x, 7655 y - (ClientHeight - PanelHeight)) 7656 else if (y >= TopBarHeight) and (x >= MapOffset) and 7657 (x < MapOffset + MapWidth) then 7658 MapBoxMouseDown(Sender, Button, Shift, x - MapOffset, 7659 y - TopBarHeight) 7660 end; 7661 7662 procedure TMainScreen.FormMouseMove(Sender: TObject; Shift: TShiftState; 7663 x, y: integer); 7664 begin 7665 if idle then 7666 if IsPanelPixel(x, y) then 7667 PanelBoxMouseMove(Sender, Shift, x, y - (ClientHeight - PanelHeight)) 7668 else if (y >= TopBarHeight) and (x >= MapOffset) and 7669 (x < MapOffset + MapWidth) then 7670 MapBoxMouseMove(Sender, Shift, x - MapOffset, y - TopBarHeight); 7671 end; 7672 7673 procedure TMainScreen.FormMouseUp(Sender: TObject; Button: TMouseButton; 7674 Shift: TShiftState; x, y: integer); 7675 begin 7676 if idle then 7677 PanelBoxMouseUp(Sender, Button, Shift, x, 7678 y - (ClientHeight - PanelHeight)); 7679 end; 7680 7681 procedure TMainScreen.FormPaint(Sender: TObject); 7682 begin 7683 MainOffscreenPaint; 7684 if (MapOffset > 0) or (MapOffset + MapWidth < ClientWidth) then 7685 with Canvas do 7686 begin // pillarbox, make left and right border black 7687 if me < 0 then 7688 Brush.Color := $000000 7689 else 7690 Brush.Color := EmptySpaceColor; 7691 if xMidPanel > MapOffset then 7692 FillRect(Rect(0, TopBarHeight, MapOffset, TopBarHeight + MapHeight 7693 - overlap)) 7694 else 7695 begin 7696 FillRect(Rect(0, TopBarHeight, xMidPanel, TopBarHeight + MapHeight - 7697 overlap)); 7698 FillRect(Rect(xMidPanel, TopBarHeight, MapOffset, 7699 TopBarHeight + MapHeight)); 7700 end; 7701 if xRightPanel < MapOffset + MapWidth then 7702 FillRect(Rect(MapOffset + MapWidth, TopBarHeight, ClientWidth, 7703 TopBarHeight + MapHeight - overlap)) 7704 else 7705 begin 7706 FillRect(Rect(MapOffset + MapWidth, TopBarHeight, xRightPanel, 7707 TopBarHeight + MapHeight)); 7708 FillRect(Rect(xRightPanel, TopBarHeight, ClientWidth, 7709 TopBarHeight + MapHeight - overlap)); 7710 end; 7711 Brush.Style := bsClear; 7712 end; 7713 BitBlt(Canvas.Handle, MapOffset, TopBarHeight, MapWidth, 7714 MapHeight - overlap, offscreen.Canvas.Handle, 0, 0, SRCCOPY); 7715 BitBlt(Canvas.Handle, 0, 0, ClientWidth, TopBarHeight, 7716 TopBar.Canvas.Handle, 0, 0, SRCCOPY); 7717 if xMidPanel > MapOffset then 7718 BitBlt(Canvas.Handle, xMidPanel, TopBarHeight + MapHeight - overlap, 7719 ClientWidth div 2 - xMidPanel, overlap, offscreen.Canvas.Handle, 7720 xMidPanel - MapOffset, MapHeight - overlap, SRCCOPY) 7721 else 7722 BitBlt(Canvas.Handle, MapOffset, TopBarHeight + MapHeight - overlap, 7723 ClientWidth div 2 - MapOffset, overlap, offscreen.Canvas.Handle, 0, 7724 MapHeight - overlap, SRCCOPY); 7725 if xRightPanel < MapOffset + MapWidth then 7726 BitBlt(Canvas.Handle, ClientWidth div 2, TopBarHeight + MapHeight - 7727 overlap, xRightPanel - ClientWidth div 2, overlap, 7728 offscreen.Canvas.Handle, ClientWidth div 2 - MapOffset, 7729 MapHeight - overlap, SRCCOPY) 7730 else 7731 BitBlt(Canvas.Handle, ClientWidth div 2, TopBarHeight + MapHeight - 7732 overlap, MapOffset + MapWidth - ClientWidth div 2, overlap, 7733 offscreen.Canvas.Handle, ClientWidth div 2 - MapOffset, 7734 MapHeight - overlap, SRCCOPY); 7735 BitBlt(Canvas.Handle, 0, TopBarHeight + MapHeight - overlap, xMidPanel, 7736 overlap, Panel.Canvas.Handle, 0, 0, SRCCOPY); 7737 BitBlt(Canvas.Handle, xRightPanel, TopBarHeight + MapHeight - overlap, 7738 Panel.width - xRightPanel, overlap, Panel.Canvas.Handle, xRightPanel, 7739 0, SRCCOPY); 7740 BitBlt(Canvas.Handle, 0, TopBarHeight + MapHeight, Panel.width, 7741 PanelHeight - overlap, Panel.Canvas.Handle, 0, overlap, SRCCOPY); 7742 if (pLogo >= 0) and (G.RO[pLogo] = nil) and (AILogo[pLogo] <> nil) then 7743 BitBlt(Canvas.Handle, xRightPanel + 10 - (16 + 64), 7744 ClientHeight - PanelHeight, 64, 64, AILogo[pLogo].Canvas.Handle, 0, 0, 7745 SRCCOPY); 7746 end; 7747 7748 procedure TMainScreen.RectInvalidate(Left, Top, Rigth, Bottom: integer); 7749 var 7750 r0: HRgn; 7751 begin 7752 r0 := CreateRectRgn(Left, Top, Rigth, Bottom); 7753 InvalidateRgn(Handle, r0, false); 7754 DeleteObject(r0); 7755 end; 7756 7757 procedure TMainScreen.SmartRectInvalidate(Left, Top, Rigth, 7758 Bottom: integer); 7759 var 7760 i: integer; 7761 r0, r1: HRgn; 7762 begin 7763 r0 := CreateRectRgn(Left, Top, Rigth, Bottom); 7764 for i := 0 to ControlCount - 1 do 7765 if not(Controls[i] is TArea) and Controls[i].Visible then 7766 begin 7767 with Controls[i].BoundsRect do 7768 r1 := CreateRectRgn(Left, Top, Right, Bottom); 7769 CombineRgn(r0, r0, r1, RGN_DIFF); 7770 DeleteObject(r1); 7771 end; 7772 InvalidateRgn(Handle, r0, false); 7773 DeleteObject(r0); 7774 end; 7775 7776 procedure TMainScreen.mRepClicked(Sender: TObject); 7777 begin 7778 with TMenuItem(Sender) do 7779 begin 7780 Checked := not Checked; 7781 if Checked then 7782 CityRepMask := CityRepMask or (1 shl (Tag shr 8)) 3648 7783 else 7784 CityRepMask := CityRepMask and not(1 shl (Tag shr 8)) 7785 end 7786 end; 7787 7788 procedure TMainScreen.mLogClick(Sender: TObject); 7789 begin 7790 LogDlg.Show 7791 end; 7792 7793 procedure TMainScreen.FormShow(Sender: TObject); 7794 begin 7795 Timer1.Enabled := true 7796 end; 7797 7798 procedure TMainScreen.FormClose(Sender: TObject; var Action: TCloseAction); 7799 begin 7800 Timer1.Enabled := false 7801 end; 7802 7803 procedure TMainScreen.Radio(Sender: TObject); 7804 begin 7805 TMenuItem(Sender).Checked := true 7806 end; 7807 7808 procedure TMainScreen.mManipClick(Sender: TObject); 7809 var 7810 Flag: integer; 7811 begin 7812 with TMenuItem(Sender) do 7813 begin 7814 Flag := 1 shl (Tag shr 8); 7815 if Checked then 7816 Server(sClearTestFlag, 0, Flag, nil^) 7817 else 7818 begin 7819 Server(sSetTestFlag, 0, Flag, nil^); 7820 Play('CHEAT'); 7821 end; 7822 if not supervising then 7823 begin 7824 if Flag = tfUncover then 3649 7825 begin 3650 uix:=MyRO.nEnemyUn-1; 3651 while (uix>=0) and (MyRO.EnemyUn[uix].Loc<>Loc) do dec(uix); 3652 if uix>=0 then cm:=Tribe[MyRO.EnemyUn[uix].Owner].Color 3653 end; 3654 cm:=$808080 or cm shr 1; {increase brightness} 3655 end 3656 else if MapOptionChecked and (1 shl moPolitical)<>0 then 3657 begin 3658 if MyMap[Loc] and fTerrain<fGrass then cm:=cmPolOcean 3659 else if MyRO.Territory[Loc]<0 then cm:=cmPolNone 3660 else cm:=Tribe[MyRO.Territory[Loc]].Color; 3661 end; 3662 MiniLine[xm,0]:=cm shr 16; 3663 MiniLine[xm,1]:=cm shr 8 and $FF; 3664 MiniLine[xm,2]:=cm and $FF; 3665 end; 3666 end 3667 end; 3668 end; 3669 3670 procedure TMainScreen.MainOffscreenPaint; 3671 var 3672 ProcessOptions: integer; 3673 rec:TRect; 3674 DoInvalidate: boolean; 3675 begin 3676 if me<0 then 3677 with offscreen.Canvas do 3678 begin 3679 Brush.Color:=$000000; 3680 FillRect(Rect(0,0,MapWidth,MapHeight)); 3681 Brush.Style:=bsClear; 3682 OffscreenUser:=self; 3683 exit 3684 end; 3685 3686 MainMap.SetPaintBounds(0,0,MapWidth,MapHeight); 3687 if OffscreenUser<>self then 3688 begin 3689 if OffscreenUser<>nil then OffscreenUser.Update; 3690 // complete working with old owner to prevent rebound 3691 if MapValid and (xwd=xw) and (ywd=yw) then 3692 MainMap.SetPaintBounds(0,0,UsedOffscreenWidth,UsedOffscreenHeight); 3693 MapValid:=false; 3694 OffscreenUser:=self; 3695 end; 3696 3697 if xw-xwd>G.lx div 2 then xwd:=xwd+G.lx 3698 else if xwd-xw>G.lx div 2 then xwd:=xwd-G.lx; 3699 if not MapValid or (xw-xwd>MapWidth div (xxt*2)) or (xwd-xw>MapWidth div (xxt*2)) 3700 or (yw-ywd>MapHeight div yyt) or (ywd-yw>MapHeight div yyt) then 3701 begin 3702 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 3703 ProcessRect(xw,yw,MapWidth div xxt,MapHeight div yyt,prPaint or prInvalidate) 3704 end 3705 else 3706 begin 3707 if (xwd=xw) and (ywd=yw) then exit; {map window not moved} 3708 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 3709 rec:=Rect(0,0,MapWidth,MapHeight); 3710 ScrollDC(offscreen.Canvas.Handle,(xwd-xw)*(xxt*2),(ywd-yw)*yyt,rec,rec,0,nil); 3711 for DoInvalidate:=false to FastScrolling do 3712 begin 3713 if DoInvalidate then 3714 begin 3715 rec.bottom:=MapHeight-overlap; 3716 ScrollDC(Canvas.Handle,(xwd-xw)*(xxt*2),(ywd-yw)*yyt,rec,rec,0,nil); 3717 ProcessOptions:=prInvalidate; 3718 end 3719 else ProcessOptions:=prPaint or prAutoBounds; 3720 if yw<ywd then 3721 begin 3722 ProcessRect(xw,yw,MapWidth div xxt,ywd-yw-1,ProcessOptions); 3723 if xw<xwd then 3724 ProcessRect(xw,ywd,(xwd-xw)*2-1,MapHeight div yyt-ywd+yw,ProcessOptions) 3725 else if xw>xwd then 3726 ProcessRect((xwd+MapWidth div (xxt*2)) mod G.lx,ywd,(xw-xwd)*2+1, 3727 MapHeight div yyt-ywd+yw,ProcessOptions) 3728 end 3729 else if yw>ywd then 3730 begin 3731 if DoInvalidate then 3732 RectInvalidate(MapOffset,TopBarHeight+MapHeight-overlap-(yw-ywd)*yyt,MapOffset+MapWidth, 3733 TopBarHeight+MapHeight-overlap) 3734 else ProcessRect(xw,(ywd+MapHeight div (yyt*2) *2),MapWidth div xxt, 3735 yw-ywd+1,ProcessOptions); 3736 if xw<xwd then 3737 ProcessRect(xw,yw,(xwd-xw)*2-1,MapHeight div yyt-yw+ywd-2, 3738 ProcessOptions) 3739 else if xw>xwd then 3740 ProcessRect((xwd+MapWidth div (xxt*2)) mod G.lx,yw,(xw-xwd)*2+1, 3741 MapHeight div yyt-yw+ywd-2,ProcessOptions) 3742 end 3743 else 3744 if xw<xwd then 3745 ProcessRect(xw,yw,(xwd-xw)*2-1,MapHeight div yyt,ProcessOptions) 3746 else if xw>xwd then 3747 ProcessRect((xwd+MapWidth div (xxt*2)) mod G.lx,yw,(xw-xwd)*2+1, 3748 MapHeight div yyt,ProcessOptions); 3749 end; 3750 if not FastScrolling then 3751 RectInvalidate(MapOffset,TopBarHeight,MapOffset+MapWidth,TopBarHeight+MapHeight-overlap); 3752 RectInvalidate(xMidPanel,TopBarHeight+MapHeight-overlap,xRightPanel,TopBarHeight+MapHeight) 3753 end; 3754 //if (xwd<>xw) or (ywd<>yw) then 3755 // Server(sChangeSuperView,me,yw*G.lx+xw,nil^); // for synchronizing client side viewer, not used currently 3756 xwd:=xw;ywd:=yw; 3757 MapValid:=true; 3758 end; 3759 3760 procedure TMainScreen.PaintAll; 3761 begin 3762 MainOffscreenPaint; 3763 xwMini:=xw; ywMini:=yw; 3764 MiniPaint; 3765 PanelPaint; 3766 end; 3767 3768 procedure TMainScreen.PaintAllMaps; 3769 begin 3770 MainOffscreenPaint; 3771 xwMini:=xw; ywMini:=yw; 3772 MiniPaint; 3773 CopyMiniToPanel; 3774 RectInvalidate(xMini+2,TopBarHeight+MapHeight-overlap+yMini+2,xMini+2+G.lx*2, 3775 TopBarHeight+MapHeight-overlap+yMini+2+G.ly); 3776 end; 3777 3778 procedure TMainScreen.CopyMiniToPanel; 3779 begin 3780 BitBlt(Panel.Canvas.Handle,xMini+2,yMini+2,G.lx*2,G.ly,Mini.Canvas.Handle,0,0,SRCCOPY); 3781 if MarkCityLoc>=0 then 3782 Sprite(Panel, HGrSystem, xMini-2+(4*G.lx+2*(MarkCityLoc mod G.lx) 3783 +(G.lx-MapWidth div (xxt*2))-2*xwd) mod (2*G.lx) +MarkCityLoc div G.lx and 1, 3784 yMini-3+MarkCityLoc div G.lx,10,10,77,47) 3785 else if ywmax<=0 then 3786 Frame(Panel.Canvas,xMini+2+G.lx-MapWidth div (xxt*2),yMini+2, 3787 xMini+1+G.lx+MapWidth div (xxt*2), 3788 yMini+2+G.ly-1,MainTexture.clMark,MainTexture.clMark) 3789 else Frame(Panel.Canvas,xMini+2+G.lx-MapWidth div (xxt*2),yMini+2+yw, 3790 xMini+1+G.lx+MapWidth div (xxt*2), 3791 yMini+yw+MapHeight div yyt,MainTexture.clMark,MainTexture.clMark); 3792 end; 3793 3794 procedure TMainScreen.PanelPaint; 3795 3796 function MovementToString(var Un: TUn): string; 3797 begin 3798 result:=ScreenTools.MovementToString(Un.Movement); 3799 if Un.Master>=0 then 3800 result:='('+result+')' 3801 else if (MyModel[Un.mix].Domain=dAir) 3802 and (MyModel[Un.mix].Kind<>mkSpecial_Glider) then 3803 result:=Format('%s(%d)',[result,Un.Fuel]); 3804 end; 3805 3806 var 3807 i,uix,uixDefender,x,xSrc,ySrc,xSrcBase,ySrcBase,CostFactor,Count,mixShow, 3808 xTreasurySection,xResearchSection,JobFocus,TrueMoney, 3809 TrueResearch: integer; 3810 Tile: cardinal; 3811 s: string; 3812 unx:TUn; 3813 UnitInfo: TUnitInfo; 3814 JobProgressData: TJobProgressData; 3815 Prio: boolean; 3816 begin 3817 with Panel.Canvas do 3818 begin 3819 Fill(Panel.Canvas,0,3,xMidPanel+7-10,PanelHeight-3, 3820 wMainTexture-(xMidPanel+7-10),hMainTexture-PanelHeight); 3821 Fill(Panel.Canvas,xRightPanel+10-7,3,Panel.Width-xRightPanel-10+7,PanelHeight-3, 3822 -(xRightPanel+10-7),hMainTexture-PanelHeight); 3823 FillLarge(Panel.Canvas,xMidPanel-2,PanelHeight-MidPanelHeight,xRightPanel+2,PanelHeight, 3824 ClientWidth div 2); 3825 3826 Brush.Style:=bsClear; 3827 Pen.Color:=$000000; 3828 MoveTo(0,0);LineTo(xMidPanel+7-8,0); LineTo(xMidPanel+7-8,PanelHeight-MidPanelHeight); 3829 LineTo(xRightPanel,PanelHeight-MidPanelHeight); LineTo(xRightPanel,0); 3830 LineTo(ClientWidth,0); 3831 Pen.Color:=MainTexture.clBevelLight; 3832 MoveTo(xMidPanel+7-9,PanelHeight-MidPanelHeight+2); 3833 LineTo(xRightPanel+10-8,PanelHeight-MidPanelHeight+2); 3834 Pen.Color:=MainTexture.clBevelLight; 3835 MoveTo(0,1);LineTo(xMidPanel+7-9,1); Pen.Color:=MainTexture.clBevelShade; 3836 LineTo(xMidPanel+7-9,PanelHeight-MidPanelHeight+1); Pen.Color:=MainTexture.clBevelLight; 3837 LineTo(xRightPanel+10-9,PanelHeight-MidPanelHeight+1); Pen.Color:=MainTexture.clBevelLight; 3838 LineTo(xRightPanel+10-9,1); LineTo(ClientWidth,1); 3839 MoveTo(ClientWidth,2); LineTo(xRightPanel+10-8,2); LineTo(xRightPanel+10-8,PanelHeight); 3840 MoveTo(0,2);LineTo(xMidPanel+7-10,2); Pen.Color:=MainTexture.clBevelShade; 3841 LineTo(xMidPanel+7-10,PanelHeight); 3842 Corner(Panel.Canvas,xMidPanel+7-16,1,1,MainTexture); 3843 Corner(Panel.Canvas,xRightPanel+10-9,1,0,MainTexture); 3844 if ClientMode<>cEditMap then 3845 begin 3846 if supervising then 3847 begin 3848 Frame(Panel.Canvas, ClientWidth-xPalace-1, yPalace-1, 3849 ClientWidth-xPalace+xSizeBig, yPalace+ySizeBig, $B0B0B0, $FFFFFF); 3850 RFrame(Panel.Canvas, ClientWidth-xPalace-2, yPalace-2, 3851 ClientWidth-xPalace+xSizeBig+1, yPalace+ySizeBig+1, $FFFFFF, $B0B0B0); 3852 BitBlt(Panel.Canvas.Handle, ClientWidth-xPalace, yPalace, xSizeBig, 3853 ySizeBig, GrExt[HGrSystem2].Data.Canvas.Handle, 70, 123, SRCCOPY); 3854 end 3855 else if MyRO.NatBuilt[imPalace]>0 then 3856 ImpImage(Panel.Canvas, ClientWidth-xPalace, yPalace, imPalace, -1, GameMode<>cMovie 3857 {(GameMode<>cMovie) and (MyRO.Government<>gAnarchy)}) 3858 else ImpImage(Panel.Canvas, ClientWidth-xPalace, yPalace, 21, -1, GameMode<>cMovie 3859 {(GameMode<>cMovie) and (MyRO.Government<>gAnarchy)}); 3860 end; 3861 3862 if GameMode=cMovie then 3863 Frame(Panel.Canvas,xMini+1,yMini+1,xMini+2+G.lx*2,yMini+2+G.ly,$000000,$000000) 3864 else 3865 begin 3866 Frame(Panel.Canvas,xMini+1,yMini+1,xMini+2+G.lx*2,yMini+2+G.ly,$B0B0B0,$FFFFFF); 3867 RFrame(Panel.Canvas,xMini,yMini,xMini+3+G.lx*2,yMini+3+G.ly,$FFFFFF,$B0B0B0); 3868 end; 3869 CopyMiniToPanel; 3870 if ClientMode<>cEditMap then // MapBtn icons 3871 for i:=0 to 5 do if i<>3 then 3872 Dump(Panel,HGrSystem,xMini+G.lx-42+16*i,PanelHeight-26,8,8,121+i*9,61); 3873 3874 if ClientMode=cEditMap then 3875 begin 3876 for i:=0 to TrRow-1 do trix[i]:=-1; 3877 Count:=0; 3878 for i:=0 to nBrushTypes-1 do 3879 begin // display terrain types 3880 if (Count>=TrRow*sb.si.npos) and (Count<TrRow*(sb.si.npos+1)) then 3881 begin 3882 trix[Count-TrRow*sb.si.npos]:=BrushTypes[i]; 3883 x:=(Count-TrRow*sb.si.npos)*TrPitch; 3884 xSrcBase:=-1; 3885 case BrushTypes[i] of 3886 0..8: begin xSrc:=BrushTypes[i]; ySrc:=0 end; 3887 9..30: 3888 begin 3889 xSrcBase:=2; ySrcBase:=2; 3890 xSrc:=0; ySrc:=2*integer(BrushTypes[i])-15 3891 end; 3892 fRiver: begin xSrc:=7; ySrc:=14 end; 3893 fRoad: begin xSrc:=0; ySrc:=9 end; 3894 fRR: begin xSrc:=0; ySrc:=10 end; 3895 fCanal: begin xSrc:=0; ySrc:=11 end; 3896 fPoll: begin xSrc:=6; ySrc:=12 end; 3897 fDeadLands,fDeadLands or fCobalt,fDeadLands or fUranium, 3898 fDeadLands or fMercury: 3899 begin 3900 xSrcBase:=6; ySrcBase:=2; 3901 xSrc:=8; ySrc:=12+BrushTypes[i] shr 25; 3902 end; 3903 tiIrrigation, tiFarm, tiMine, tiBase: 3904 begin xSrc:=BrushTypes[i] shr 12-1; ySrc:=12 end; 3905 tiFort: 3906 begin xSrc:=3; ySrc:=12; xSrcBase:=7; ySrcBase:=12 end; 3907 fPrefStartPos: begin xSrc:=0; ySrc:=1 end; 3908 fStartPos: begin xSrc:=0; ySrc:=2 end; 3909 end; 3910 if xSrcBase>=0 then 3911 Sprite(Panel,HGrTerrain,xTroop+2+x,yTroop+9-yyt,xxt*2,yyt*3, 3912 1+xSrcBase*(xxt*2+1),1+ySrcBase*(yyt*3+1)); 3913 Sprite(Panel,HGrTerrain,xTroop+2+x,yTroop+9-yyt,xxt*2,yyt*3, 3914 1+xSrc*(xxt*2+1),1+ySrc*(yyt*3+1)); 3915 if BrushTypes[i]=BrushType then 3916 begin 3917 Frame(Panel.Canvas,xTroop+2+x,yTroop+7-yyt div 2,xTroop+2*xxt+x, 3918 yTroop+2*yyt+11,$000000,$000000); 3919 Frame(Panel.Canvas,xTroop+1+x,yTroop+6-yyt div 2,xTroop+2*xxt-1+x, 3920 yTroop+2*yyt+10,MainTexture.clMark,MainTexture.clMark); 7826 MapValid := false; 7827 PaintAllMaps; 3921 7828 end 3922 end; 3923 inc(Count) 3924 end; 3925 case BrushType of 3926 fDesert, fPrairie, fTundra, fArctic, fSwamp, fHills, fMountains: 3927 s:=Phrases.Lookup('TERRAIN',BrushType); 3928 fShore: s:=Format(Phrases.Lookup('TWOTERRAINS'), 3929 [Phrases.Lookup('TERRAIN',fOcean),Phrases.Lookup('TERRAIN',fShore)]); 3930 fGrass: s:=Format(Phrases.Lookup('TWOTERRAINS'), 3931 [Phrases.Lookup('TERRAIN',fGrass),Phrases.Lookup('TERRAIN',fGrass+12)]); 3932 fForest: s:=Format(Phrases.Lookup('TWOTERRAINS'), 3933 [Phrases.Lookup('TERRAIN',fForest),Phrases.Lookup('TERRAIN',fJungle)]); 3934 fRiver: s:=Phrases.Lookup('RIVER'); 3935 fDeadLands,fDeadLands or fCobalt,fDeadLands or fUranium, 3936 fDeadLands or fMercury: 3937 s:=Phrases.Lookup('TERRAIN',3*12+BrushType shr 25); 3938 fPrefStartPos: s:=Phrases.Lookup('MAP_PREFSTART'); 3939 fStartPos: s:=Phrases.Lookup('MAP_START'); 3940 fPoll: s:=Phrases.Lookup('POLL'); 3941 else // terrain improvements 3942 begin 3943 case BrushType of 3944 fRoad: i:=1; 3945 fRR: i:=2; 3946 tiIrrigation: i:=4; 3947 tiFarm: i:=5; 3948 tiMine: i:=7; 3949 fCanal: i:=8; 3950 tiFort: i:=10; 3951 tiBase: i:=12; 3952 end; 3953 s:=Phrases.Lookup('JOBRESULT',i); 3954 end 3955 end; 3956 LoweredTextOut(Panel.Canvas,-1,MainTexture,xTroop+1,PanelHeight-19,s); 3957 end 3958 else if TroopLoc>=0 then 3959 begin 3960 Brush.Style:=bsClear; 3961 if UnFocus>=0 then with MyUn[UnFocus],MyModel[mix] do 3962 begin {display info about selected unit} 3963 if Job=jCity then 3964 mixShow:=-1 // building site 3965 else mixShow:=mix; 3966 with Tribe[me].ModelPicture[mixShow] do 3967 begin 3968 Sprite(Panel,HGr,xMidPanel+7+12,yTroop+1,64,48, 3969 pix mod 10 *65+1,pix div 10 *49+1); 3970 if MyUn[UnFocus].Flags and unFortified<>0 then 3971 Sprite(Panel,HGrStdUnits,xMidPanel+7+12,yTroop+1,xxu*2,yyu*2,1+6*(xxu*2+1),1); 3972 end; 3973 3974 MakeBlue(Panel,xMidPanel+7+12+10,yTroop-13,44,12); 3975 s:=MovementToString(MyUn[UnFocus]); 3976 RisedTextOut(Panel.Canvas,xMidPanel+7+12+32-BiColorTextWidth(Panel.Canvas,s) div 2, 3977 yTroop-16,s); 3978 3979 s:=IntToStr(Health)+'%'; 3980 LightGradient(Panel.Canvas,xMidPanel+7+12+7,PanelHeight-22,(Health+1) div 2, 3981 (ColorOfHealth(Health) and $FEFEFE shr 2)*3); 3982 if Health<100 then 3983 LightGradient(Panel.Canvas,xMidPanel+7+12+7+(Health+1) div 2, 3984 PanelHeight-22,50-(Health+1) div 2,$000000); 3985 RisedTextOut(Panel.Canvas,xMidPanel+7+12+32-BiColorTextWidth(Panel.Canvas,s) div 2, 3986 PanelHeight-23,s); 3987 3988 FrameImage(Panel.Canvas,GrExt[HGrSystem].Data,xMidPanel+7+xUnitText,yTroop+15,12,14, 3989 121+Exp div ExpCost *13,28); 3990 if Job=jCity then s:=Tribe[me].ModelName[-1] 3991 else s:=Tribe[me].ModelName[mix]; 3992 if Home>=0 then 3993 begin 3994 LoweredTextOut(Panel.Canvas,-1,MainTexture,xMidPanel+7+xUnitText+18,yTroop+5,s); 3995 LoweredTextOut(Panel.Canvas,-1,MainTexture,xMidPanel+7+xUnitText+18,yTroop+21, 3996 '('+CityName(MyCity[Home].ID)+')'); 3997 end 3998 else LoweredTextOut(Panel.Canvas,-1,MainTexture,xMidPanel+7+xUnitText+18,yTroop+13,s); 3999 end; 4000 4001 if (UnFocus>=0) and (MyUn[UnFocus].Loc<>TroopLoc) then 4002 begin // divide panel 4003 if SmallScreen and not supervising then 4004 x:=xTroop-8 4005 else x:=xTroop-152; 4006 Pen.Color:=MainTexture.clBevelShade; 4007 MoveTo(x-1,PanelHeight-MidPanelHeight+2); 4008 LineTo(x-1,PanelHeight); 4009 Pen.Color:=MainTexture.clBevelLight; 4010 MoveTo(x,PanelHeight-MidPanelHeight+2); 4011 LineTo(x,PanelHeight); 4012 end; 4013 4014 for i:=0 to 23 do trix[i]:=-1; 4015 if MyMap[TroopLoc] and fUnit<>0 then 4016 begin 4017 if MyMap[TroopLoc] and fOwned<>0 then 4018 begin 4019 if (TrCnt>1) or (UnFocus<0) or (MyUn[UnFocus].Loc<>TroopLoc) then 4020 begin 4021 LoweredTextOut(Panel.Canvas, -1, MainTexture, xTroop+10, PanelHeight-24, 4022 Phrases.Lookup('PRESENT')); 4023 Server(sGetDefender,me,TroopLoc,uixDefender); 4024 Count:=0; 4025 for Prio:=true downto false do 4026 for uix:=0 to MyRO.nUn-1 do if (uix=uixDefender)=Prio then 4027 begin // display own units 4028 unx:=MyUn[uix]; 4029 if unx.Loc=TroopLoc then 4030 begin 4031 if (Count>=TrRow*sb.si.npos) and (Count<TrRow*(sb.si.npos+1)) then 4032 begin 4033 trix[Count-TrRow*sb.si.npos]:=uix; 4034 MakeUnitInfo(me,unx,UnitInfo); 4035 x:=(Count-TrRow*sb.si.npos)*TrPitch; 4036 if uix=UnFocus then 4037 begin 4038 Frame(Panel.Canvas,xTroop+4+x,yTroop+3,xTroop+64+x, 4039 yTroop+47,$000000,$000000); 4040 Frame(Panel.Canvas,xTroop+3+x,yTroop+2,xTroop+63+x, 4041 yTroop+46,MainTexture.clMark,MainTexture.clMark); 4042 end 4043 else if (unx.Master>=0) and (unx.Master=UnFocus) then 4044 begin 4045 CFrame(Panel.Canvas,xTroop+4+x,yTroop+3,xTroop+64+x, 4046 yTroop+47,8,$000000); 4047 CFrame(Panel.Canvas,xTroop+3+x,yTroop+2,xTroop+63+x, 4048 yTroop+46,8,MainTexture.clMark); 4049 end; 4050 NoMap.SetOutput(Panel); 4051 NoMap.PaintUnit(xTroop+2+x,yTroop+1,UnitInfo,unx.Status); 4052 if (ClientMode<scContact) 4053 and ((unx.Job>jNone) 4054 or (unx.Status and (usStay or usRecover or usGoto)<>0)) then 4055 Sprite(Panel, HGrSystem, xTroop+2+60-20+x, yTroop+35, 4056 20, 20, 81, 25); 4057 4058 if not supervising then 4059 begin 4060 MakeBlue(Panel,xTroop+2+10+x,yTroop-13,44,12); 4061 s:=MovementToString(unx); 4062 RisedTextOut(Panel.Canvas,xTroop+x+34-BiColorTextWidth(Panel.Canvas,s) div 2, 4063 yTroop-16,s); 4064 end 4065 end; 4066 inc(Count) 4067 end; 4068 end; // for uix:=0 to MyRO.nUn-1 4069 assert(Count=TrCnt); 4070 end 4071 end 4072 else 4073 begin 4074 LoweredTextOut(Panel.Canvas, -1, MainTexture, xTroop+8, PanelHeight-24, 4075 Phrases.Lookup('PRESENT')); 4076 Server(sGetUnits,me,TroopLoc,Count); 4077 for i:=0 to Count-1 do 4078 if (i>=TrRow*sb.si.npos) and (i<TrRow*(sb.si.npos+1)) then 4079 begin // display enemy units 4080 trix[i-TrRow*sb.si.npos]:=i; 4081 x:=(i-TrRow*sb.si.npos)*TrPitch; 4082 NoMap.SetOutput(Panel); 4083 NoMap.PaintUnit(xTroop+2+x,yTroop+1,MyRO.EnemyUn[MyRO.nEnemyUn+i],0); 4084 end; 4085 end; 4086 end; 4087 if not SmallScreen or supervising then 4088 begin // show terrain and improvements 4089 PaintZoomedTile(Panel, xTerrain-xxt*2, 110-yyt*3, TroopLoc); 4090 if (UnFocus>=0) and (MyUn[UnFocus].Job<>jNone) then 4091 begin 4092 JobFocus:=MyUn[UnFocus].Job; 4093 Server(sGetJobProgress, me, MyUn[UnFocus].Loc, JobProgressData); 4094 MakeBlue(Panel,xTerrain-72,148-17,144,31); 4095 PaintRelativeProgressBar(Panel.Canvas,3,xTerrain-68,148+3,63, 4096 JobProgressData[JobFocus].Done, 4097 JobProgressData[JobFocus].NextTurnPlus, 4098 JobProgressData[JobFocus].Required,true,MainTexture); 4099 s:=Format('%s/%s',[ScreenTools.MovementToString(JobProgressData[JobFocus].Done), 4100 ScreenTools.MovementToString(JobProgressData[JobFocus].Required)]); 4101 RisedTextOut(Panel.Canvas,xTerrain+6,148-3,s); 4102 Tile:=MyMap[MyUn[UnFocus].Loc]; 4103 if (JobFocus=jRoad) and (Tile and fRiver<>0) then 4104 JobFocus:=nJob+0 4105 else if (JobFocus=jRR) and (Tile and fRiver<>0) then 4106 JobFocus:=nJob+1 4107 else if JobFocus=jClear then 4108 begin 4109 if Tile and fTerrain=fForest then 4110 JobFocus:=nJob+2 4111 else if Tile and fTerrain=fDesert then 4112 JobFocus:=nJob+3 4113 else JobFocus:=nJob+4 4114 end; 4115 s:=Phrases.Lookup('JOBRESULT', JobFocus); 4116 RisedTextOut(Panel.Canvas,xTerrain-BiColorTextWidth(Panel.Canvas,s) div 2, 4117 148-19,s); 4118 end; 4119 if MyMap[TroopLoc] and (fTerrain or fSpecial)=fGrass or fSpecial1 then 4120 s:=Phrases.Lookup('TERRAIN',fGrass+12) 4121 else if MyMap[TroopLoc] and fDeadlands<>0 then 4122 s:=Phrases.Lookup('TERRAIN',3*12) 4123 else if (MyMap[TroopLoc] and fTerrain=fForest) 4124 and IsJungle(TroopLoc div G.lx) then 4125 s:=Phrases.Lookup('TERRAIN',fJungle) 4126 else s:=Phrases.Lookup('TERRAIN',MyMap[TroopLoc] and fTerrain); 4127 RisedTextOut(Panel.Canvas,xTerrain-BiColorTextWidth(Panel.Canvas,s) div 2, 4128 99,s); 4129 end; 4130 4131 if TerrainBtn.Visible then with TerrainBtn do 4132 RFrame(Panel.Canvas,Left-1,Top-self.ClientHeight+(PanelHeight-1), 4133 Left+Width,Top+Height-self.ClientHeight+PanelHeight, 4134 MainTexture.clBevelShade,MainTexture.clBevelLight) 4135 end {if TroopLoc>=0} 4136 end; 4137 4138 for i:=0 to ControlCount-1 do 4139 if Controls[i] is TButtonB then with TButtonB(Controls[i]) do 4140 begin 4141 if Visible then 4142 begin 4143 Dump(Panel,HGrSystem,Left,Top-self.ClientHeight+PanelHeight,25,25,169,243); 4144 Sprite(Panel,HGrSystem,Left,Top-self.ClientHeight+PanelHeight,25,25, 4145 1+26*ButtonIndex,337); 4146 RFrame(Panel.Canvas,Left-1,Top-self.ClientHeight+(PanelHeight-1), 4147 Left+Width,Top+Height-self.ClientHeight+PanelHeight, 4148 MainTexture.clBevelShade,MainTexture.clBevelLight); 4149 end; 4150 end; 4151 4152 if ClientMode<>cEditMap then 4153 begin 4154 for i:=0 to ControlCount-1 do 4155 if Controls[i] is TButtonC then with TButtonC(Controls[i]) do 4156 begin 4157 Dump(Panel,HGrSystem,Left,Top-self.ClientHeight+PanelHeight,12,12, 4158 169,178+13*ButtonIndex); 4159 RFrame(Panel.Canvas,Left-1,Top-self.ClientHeight+(PanelHeight-1), 4160 Left+Width,Top+Height-self.ClientHeight+PanelHeight, 4161 MainTexture.clBevelShade,MainTexture.clBevelLight); 4162 end 4163 end; 4164 EOT.SetBack(Panel.Canvas,EOT.Left,EOT.Top-(ClientHeight-PanelHeight)); 4165 SmartRectInvalidate(0,ClientHeight-PanelHeight,ClientWidth,ClientHeight); 4166 4167 // topbar 4168 xTreasurySection:=ClientWidth div 2-172; 4169 xResearchSection:=ClientWidth div 2; //ClientWidth div 2+68 = maximum to right 4170 FillLarge(TopBar.Canvas,0,0,ClientWidth,TopBarHeight-3,ClientWidth div 2); 4171 with TopBar.Canvas do 4172 begin 4173 Pen.Color:=$000000; 4174 MoveTo(0,TopBarHeight-1); LineTo(ClientWidth, TopBarHeight-1); 4175 Pen.Color:=MainTexture.clBevelShade; 4176 MoveTo(0,TopBarHeight-2); LineTo(ClientWidth, TopBarHeight-2); 4177 MoveTo(0,TopBarHeight-3); LineTo(ClientWidth, TopBarHeight-3); 4178 Pen.Color:=MainTexture.clBevelLight; 4179 frame(TopBar.Canvas,40,-1,xTreasurySection-1,TopBarHeight-7, 4180 MainTexture.clBevelShade,MainTexture.clBevelLight); 4181 frame(TopBar.Canvas,xResearchSection+332,-1,ClientWidth,TopBarHeight-7, 4182 MainTexture.clBevelShade,MainTexture.clBevelLight); 4183 end; 4184 if GameMode<>cMovie then 4185 ImageOp_BCC(TopBar,Templates,2,1,145,38,36,36,$BFBF20,$4040DF); 4186 if MyRO.nCity>0 then 4187 begin 4188 TrueMoney:=MyRO.Money; 4189 TrueResearch:=MyRO.Research; 4190 if supervising then 4191 begin // normalize values from after-turn state 4192 dec(TrueMoney,TaxSum); 4193 if TrueMoney<0 then 4194 TrueMoney:=0; // shouldn't happen 4195 dec(TrueResearch,ScienceSum); 4196 if TrueResearch<0 then 4197 TrueResearch:=0; // shouldn't happen 4198 end; 4199 4200 // treasury section 4201 ImageOp_BCC(TopBar,Templates,xTreasurySection+8,1,145,1,36,36,$40A040,$4030C0); 4202 s:=IntToStr(TrueMoney); 4203 LoweredTextOut(TopBar.Canvas,-1,MainTexture,xTreasurySection+48,0,s+'%c'); 4204 if MyRO.Government<>gAnarchy then 4205 begin 4206 ImageOp_BCC(TopBar,Templates,xTreasurySection+48,22,124,1,14,14,$0000C0, $0080C0); 4207 if TaxSum>=0 then 4208 s:=Format(Phrases.Lookup('MONEYGAINPOS'),[TaxSum]) 4209 else s:=Format(Phrases.Lookup('MONEYGAINNEG'),[TaxSum]); 4210 LoweredTextOut(TopBar.Canvas,-1,MainTexture,xTreasurySection+48+15,18,s); 4211 end; 4212 4213 // research section 4214 ImageOp_BCC(TopBar,Templates,xResearchSection+8,1,145,75,36,36,$FF0000,$00FFE0); 4215 if MyData.FarTech<>adNexus then 4216 begin 4217 if MyRO.ResearchTech<0 then 4218 CostFactor:=2 4219 else if (MyRO.ResearchTech=adMilitary) or (MyRO.Tech[MyRO.ResearchTech]=tsSeen) then 4220 CostFactor:=1 4221 else if MyRO.ResearchTech in FutureTech then 4222 if MyRO.Government=gFuture then 4223 CostFactor:=4 4224 else CostFactor:=8 4225 else CostFactor:=2; 4226 Server(sGetTechCost,me,0,i); 4227 CostFactor:=CostFactor*22; // length of progress bar 4228 PaintRelativeProgressBar(TopBar.Canvas,2,xResearchSection+48+1,26, 4229 CostFactor,TrueResearch,ScienceSum,i,true,MainTexture); 4230 4231 if MyRO.ResearchTech<0 then 4232 s:=Phrases.Lookup('SCIENCE') 4233 else if MyRO.ResearchTech=adMilitary then 4234 s:=Phrases.Lookup('INITUNIT') 4235 else 4236 begin 4237 s:=Phrases.Lookup('ADVANCES', MyRO.ResearchTech); 4238 if MyRO.ResearchTech in FutureTech then 4239 if MyRO.Tech[MyRO.ResearchTech]>=1 then 4240 s:=s+' '+IntToStr(MyRO.Tech[MyRO.ResearchTech]+1) 4241 else s:=s+' 1'; 4242 end; 4243 if ScienceSum>0 then 4244 begin 4245 { j:=(i-MyRO.Research-1) div ScienceSum +1; 4246 if j<1 then j:=1; 4247 if j>1 then 4248 s:=Format(Phrases.Lookup('TECHWAIT'),[s,j]);} 4249 LoweredTextOut(TopBar.Canvas,-1,MainTexture,xResearchSection+48,0,s); 4250 end 4251 else LoweredTextOut(TopBar.Canvas,-1,MainTexture,xResearchSection+48,0,s); 4252 end 4253 else CostFactor:=0; 4254 if (MyData.FarTech<>adNexus) and (ScienceSum>0) then 4255 begin 4256 ImageOp_BCC(TopBar,Templates,xResearchSection+48+CostFactor+11,22,124,1,14,14,$0000C0, $0080C0); 4257 s:=Format(Phrases.Lookup('TECHGAIN'),[ScienceSum]); 4258 LoweredTextOut(TopBar.Canvas,-1,MainTexture,xResearchSection+48+CostFactor+26,18,s); 4259 end 4260 end; 4261 if ClientMode<>cEditMap then 4262 begin 4263 TopBar.Canvas.Font.Assign(UniFont[ftCaption]); 4264 s:=TurnToString(MyRO.Turn); 4265 RisedTextOut(TopBar.Canvas,40+(xTreasurySection-40-BiColorTextWidth(TopBar.Canvas,s)) div 2,6,s); 4266 TopBar.Canvas.Font.Assign(UniFont[ftNormal]); 4267 end; 4268 RectInvalidate(0,0,ClientWidth,TopBarHeight); 4269 end;{PanelPaint} 4270 4271 procedure TMainScreen.FocusOnLoc(Loc:integer; Options: integer = 0); 4272 var 4273 dx: integer; 4274 Outside, Changed: boolean; 4275 begin 4276 dx:=G.lx+1-(xw-Loc+G.lx*1024+1) mod G.lx; 4277 Outside:=(dx>=(MapWidth+1) div (xxt*2)-2) 4278 or (ywmax>0) and ((yw>0) and (Loc div G.lx<=yw+1) 4279 or (yw<ywmax) and (Loc div G.lx>=yw+(MapHeight-1) div yyt-2)); 4280 Changed:=true; 4281 if Outside then 4282 begin Centre(Loc); PaintAllMaps end 4283 else if not MapValid then 4284 PaintAllMaps 4285 else Changed:=false; 4286 if Options and flRepaintPanel<>0 then 4287 PanelPaint; 4288 if Changed and (Options and flImmUpdate<>0) then Update; 4289 end; 4290 4291 procedure TMainScreen.NextUnit(NearLoc:integer;AutoTurn:boolean); 4292 var 4293 Dist,TestDist:single; 4294 i,uix,NewFocus:integer; 4295 GotoOnly: boolean; 4296 begin 4297 if ClientMode>=scContact then exit; 4298 DestinationMarkON:=false; 4299 PaintDestination; 4300 for GotoOnly:=GoOnPhase downto false do 4301 begin 4302 NewFocus:=-1; 4303 for i:=1 to MyRO.nUn do 4304 begin 4305 uix:=(UnFocus+i) mod MyRO.nUn; 4306 if (MyUn[uix].Loc>=0) and (MyUn[uix].Job=jNone) 4307 and (MyUn[uix].Status and (usStay or usRecover or usWaiting)=usWaiting) 4308 and (not GotoOnly or (MyUn[uix].Status and usGoto<>0)) then 4309 if NearLoc<0 then begin NewFocus:=uix; Break end 4310 else 4311 begin 4312 TestDist:=Distance(NearLoc,MyUn[uix].Loc); 4313 if (NewFocus<0) or (TestDist<Dist) then 4314 begin NewFocus:=uix; Dist:=TestDist end 4315 end 4316 end; 4317 if GotoOnly then 4318 if NewFocus<0 then GoOnPhase:=false 4319 else break; 4320 end; 4321 if NewFocus>=0 then 4322 begin 4323 SetUnFocus(NewFocus); 4324 SetTroopLoc(MyUn[NewFocus].Loc); 4325 FocusOnLoc(TroopLoc,flRepaintPanel) 4326 end 4327 else if AutoTurn and not mWaitTurn.Checked then 4328 begin 4329 TurnComplete:=true; 4330 SetUnFocus(-1); 4331 SetTroopLoc(-1); 4332 PostMessage(Handle,WM_EOT,0,0) 4333 end 4334 else 4335 begin 4336 if {(UnFocus>=0) and} not TurnComplete and EOT.Visible then Play('TURNEND'); 4337 TurnComplete:=true; 4338 SetUnFocus(-1); 4339 SetTroopLoc(-1); 4340 PanelPaint; 4341 end; 4342 end;{NextUnit} 4343 4344 procedure TMainScreen.Scroll(dx,dy: integer); 4345 begin 4346 xw:=(xw+G.lx+dx) mod G.lx; 4347 if ywmax>0 then 4348 begin 4349 yw:=yw+2*dy; 4350 if yw<0 then yw:=0 4351 else if yw>ywmax then yw:=ywmax; 4352 end; 4353 MainOffscreenPaint; 4354 xwMini:=xw; ywMini:=yw; 4355 MiniPaint; 4356 CopyMiniToPanel; 4357 RectInvalidate(xMini+2,TopBarHeight+MapHeight-overlap+yMini+2,xMini+2+G.lx*2, 4358 TopBarHeight+MapHeight-overlap+yMini+2+G.ly); 4359 Update; 4360 end; 4361 4362 procedure TMainScreen.Timer1Timer(Sender:TObject); 4363 var 4364 dx, dy, speed: integer; 4365 begin 4366 if idle and (me>=0) and (GameMode<>cMovie) then 4367 if (fsModal in Screen.ActiveForm.FormState) 4368 or (Screen.ActiveForm is TBufferedDrawDlg) 4369 and (TBufferedDrawDlg(Screen.ActiveForm).WindowMode<>wmPersistent) then 4370 begin 4371 BlinkTime:=BlinkOnTime+BlinkOffTime-1; 4372 if not BlinkON then 4373 begin 4374 BlinkON:=true; 4375 if UnFocus>=0 then 4376 PaintLocTemp(MyUn[UnFocus].Loc) 4377 else if TurnComplete and not supervising then 4378 EOT.SetButtonIndexFast(eotBlinkOn) 4379 end 4380 end 4381 else 4382 begin 4383 if Application.Active and not mScrollOff.Checked then 4384 begin 4385 if mScrollFast.Checked then Speed:=2 4386 else Speed:=1; 4387 dx:=0; 4388 dy:=0; 4389 if Mouse.CursorPos.y<Screen.Height-PanelHeight then 4390 if Mouse.CursorPos.x=0 then dx:=-Speed // scroll left 4391 else if Mouse.CursorPos.x=Screen.Width-1 then dx:=Speed; // scroll right 4392 if Mouse.CursorPos.y=0 then dy:=-Speed // scroll up 4393 else if (Mouse.CursorPos.y=Screen.Height-1) 4394 and (Mouse.CursorPos.x>=TerrainBtn.Left+TerrainBtn.Width) 4395 and (Mouse.CursorPos.x<xRightPanel+10-8) then dy:=Speed; // scroll down 4396 if (dx<>0) or (dy<>0) then 4397 begin 4398 if (Screen.ActiveForm<>MainScreen) 4399 and (@Screen.ActiveForm.OnDeactivate<>nil) then 4400 Screen.ActiveForm.OnDeactivate(nil); 4401 Scroll(dx,dy); 4402 end 4403 end; 4404 4405 BlinkTime:=(BlinkTime+1) mod (BlinkOnTime+BlinkOffTime); 4406 BlinkON:= BlinkTime>=BlinkOffTime; 4407 DestinationMarkON:=true; 4408 if UnFocus>=0 then 4409 begin 4410 if (BlinkTime=0) or (BlinkTime=BlinkOffTime) then 4411 begin 4412 PaintLocTemp(MyUn[UnFocus].Loc,pltsBlink); 4413 PaintDestination; 4414 // if MoveHintToLoc>=0 then 4415 // ShowMoveHint(MoveHintToLoc, true); 7829 else if Flag = tfAllTechs then 7830 TellNewModels 4416 7831 end 4417 7832 end 4418 else if TurnComplete and not supervising then 4419 begin 4420 if BlinkTime=0 then EOT.SetButtonIndexFast(eotBlinkOff) 4421 else if BlinkTime=BlinkOffTime then EOT.SetButtonIndexFast(eotBlinkOn) 7833 end; 7834 7835 procedure TMainScreen.MapBtnClick(Sender: TObject); 7836 begin 7837 with TButtonC(Sender) do 7838 begin 7839 MapOptionChecked := MapOptionChecked xor (1 shl (Tag shr 8)); 7840 SetMapOptions; 7841 ButtonIndex := MapOptionChecked shr (Tag shr 8) and 1 + 2 7842 end; 7843 if Sender = MapBtn0 then 7844 begin 7845 MiniPaint; 7846 PanelPaint 7847 end // update mini map only 7848 else 7849 begin 7850 MapValid := false; 7851 PaintAllMaps; 7852 end; // update main map 7853 end; 7854 7855 procedure TMainScreen.GrWallBtnDownChanged(Sender: TObject); 7856 begin 7857 if TButtonBase(Sender).Down then 7858 begin 7859 MapOptionChecked := MapOptionChecked or (1 shl moGreatWall); 7860 TButtonBase(Sender).Hint := ''; 4422 7861 end 4423 end 4424 end; 4425 4426 procedure TMainScreen.Centre(Loc:integer); 4427 begin 4428 if FastScrolling and MapValid then update; 4429 // necessary because ScrollDC for form canvas is called after 4430 xw:=(Loc mod G.lx-(MapWidth-xxt*2*((Loc div G.lx) and 1)) div (xxt*4)+G.lx) mod G.lx; 4431 if ywmax<=0 then yw:=ywcenter 4432 else 4433 begin 4434 yw:=(Loc div G.lx-MapHeight div (yyt*2)+1) and not 1; 4435 if yw<0 then yw:=0 4436 else if yw>ywmax then yw:=ywmax; 4437 end 4438 end; 4439 4440 function TMainScreen.ZoomToCity(Loc: integer; NextUnitOnClose: boolean = false; 4441 ShowEvent: integer = 0): boolean; 4442 begin 4443 result:= MyMap[Loc] and (fOwned or fSpiedOut)<>0; 4444 if result then with CityDlg do 4445 begin 4446 if ClientMode>=scContact then 4447 begin 4448 CloseAction:=None; 4449 RestoreUnFocus:=-1; 4450 end 4451 else if NextUnitOnClose then 4452 begin 4453 CloseAction:=StepFocus; 4454 RestoreUnFocus:=-1; 4455 end 4456 else if not Visible then 4457 begin 4458 CloseAction:=RestoreFocus; 4459 RestoreUnFocus:=UnFocus; 4460 end; 4461 SetUnFocus(-1); 4462 SetTroopLoc(Loc); 4463 MarkCityLoc:=Loc; 4464 PanelPaint; 4465 ShowNewContent(wmPersistent, Loc, ShowEvent); 4466 end 4467 end; 4468 4469 function TMainScreen.LocationOfScreenPixel(x,y: integer): integer; 4470 var 4471 qx,qy: integer; 4472 begin 4473 qx:=(x*(yyt*2)+y*(xxt*2)+xxt*yyt*2) div (xxt*yyt*4)-1; 4474 qy:=(y*(xxt*2)-x*(yyt*2)-xxt*yyt*2+4000*xxt*yyt) div (xxt*yyt*4)-999; 4475 result:=(xw+(qx-qy+2048) div 2-1024+G.lx) mod G.lx+G.lx*(yw+qx+qy); 4476 end; 4477 4478 procedure TMainScreen.MapBoxMouseDown(Sender:TObject; 4479 Button:TMouseButton;Shift:TShiftState;x,y:integer); 4480 var 4481 i,uix,emix,p1,dx,dy,MouseLoc:integer; 4482 EditTileData: TEditTileData; 4483 m,m2: TMenuItem; 4484 MoveAdviceData: TMoveAdviceData; 4485 DoCenter: boolean; 4486 begin 4487 if GameMode=cMovie then 4488 exit; 4489 4490 if CityDlg.Visible then CityDlg.Close; 4491 if UnitStatDlg.Visible then UnitStatDlg.Close; 4492 MouseLoc:=LocationOfScreenPixel(x,y); 4493 if (MouseLoc<0) or (MouseLoc>=G.lx*G.ly) then exit; 4494 if (Button=mbLeft) and not(ssShift in Shift) then 4495 begin 4496 DoCenter:=true; 4497 if ClientMode=cEditMap then 4498 begin 4499 DoCenter:=false; 4500 EditTileData.Loc:=MouseLoc; 4501 if ssCtrl in Shift then // toggle special resource 4502 case MyMap[MouseLoc] and fTerrain of 4503 fOcean: EditTileData.NewTile:=MyMap[MouseLoc]; 4504 fGrass, fArctic: EditTileData.NewTile:=MyMap[MouseLoc] and not fSpecial 4505 or ((MyMap[MouseLoc] shr 5 and 3+1) mod 2 shl 5); 4506 else EditTileData.NewTile:=MyMap[MouseLoc] and not fSpecial 4507 or ((MyMap[MouseLoc] shr 5 and 3+1) mod 3 shl 5) 4508 end 4509 else if BrushType<=fTerrain then 4510 EditTileData.NewTile:=MyMap[MouseLoc] and not fTerrain or fSpecial or BrushType 4511 else if BrushType and fDeadLands<>0 then 4512 if MyMap[MouseLoc] and (fDeadLands or fModern) 4513 =BrushType and (fDeadLands or fModern) then 4514 EditTileData.NewTile:=MyMap[MouseLoc] and not (fDeadLands or fModern) 4515 else EditTileData.NewTile:=MyMap[MouseLoc] and not (fDeadLands or fModern) 4516 or BrushType 4517 else if BrushType and fTerImp<>0 then 4518 if MyMap[MouseLoc] and fTerImp=BrushType then 4519 EditTileData.NewTile:=MyMap[MouseLoc] and not fTerImp 4520 else EditTileData.NewTile:=MyMap[MouseLoc] and not fTerImp or BrushType 4521 else if BrushType and (fPrefStartPos or fStartPos)<>0 then 4522 if MyMap[MouseLoc] and (fPrefStartPos or fStartPos) 4523 =BrushType and (fPrefStartPos or fStartPos) then 4524 EditTileData.NewTile:=MyMap[MouseLoc] and not (fPrefStartPos or fStartPos) 4525 else EditTileData.NewTile:=MyMap[MouseLoc] 4526 and not (fPrefStartPos or fStartPos) or BrushType 4527 else EditTileData.NewTile:=MyMap[MouseLoc] xor BrushType; 4528 Server(sEditTile,me,0,EditTileData); 4529 Edited:=true; 4530 BrushLoc:=MouseLoc; 4531 PaintLoc(MouseLoc,2); 4532 MiniPaint; 4533 BitBlt(Panel.Canvas.Handle,xMini+2,yMini+2,G.lx*2,G.ly,Mini.Canvas.Handle, 4534 0,0,SRCCOPY); 4535 if ywmax<=0 then 4536 Frame(Panel.Canvas,xMini+2+G.lx-MapWidth div (2*xxt),yMini+2, 4537 xMini+1+G.lx+MapWidth div (2*xxt), 4538 yMini+2+G.ly-1,MainTexture.clMark,MainTexture.clMark) 4539 else Frame(Panel.Canvas,xMini+2+G.lx-MapWidth div (2*xxt),yMini+2+yw, 4540 xMini+2+G.lx+MapWidth div (2*xxt)-1, 4541 yMini+2+yw+MapHeight div yyt-2,MainTexture.clMark,MainTexture.clMark); 4542 RectInvalidate(xMini+2,TopBarHeight+MapHeight-overlap+yMini+2,xMini+2+G.lx*2, 4543 TopBarHeight+MapHeight-overlap+yMini+2+G.ly) 4544 end 4545 else if MyMap[MouseLoc] and fCity<>0 then {city clicked} 4546 begin 4547 if MyMap[MouseLoc] and (fOwned or fSpiedOut)<>0 then 4548 begin 4549 ZoomToCity(MouseLoc); 4550 DoCenter:=false; 7862 else 7863 begin 7864 MapOptionChecked := MapOptionChecked and not(1 shl moGreatWall); 7865 TButtonBase(Sender).Hint := Phrases.Lookup('CONTROLS', 7866 -1 + TButtonBase(Sender).Tag and $FF); 7867 end; 7868 SetMapOptions; 7869 MapValid := false; 7870 PaintAllMaps; 7871 end; 7872 7873 procedure TMainScreen.BareBtnDownChanged(Sender: TObject); 7874 begin 7875 if TButtonBase(Sender).Down then 7876 begin 7877 MapOptionChecked := MapOptionChecked or (1 shl moBareTerrain); 7878 TButtonBase(Sender).Hint := ''; 4551 7879 end 4552 else 4553 begin 4554 UnitStatDlg.ShowNewContent_EnemyCity(wmPersistent, MouseLoc); 4555 DoCenter:=false; 4556 end 4557 end 4558 else if MyMap[MouseLoc] and fUnit<>0 then {unit clicked} 4559 if MyMap[MouseLoc] and fOwned<>0 then 4560 begin 4561 DoCenter:=false; 4562 if not supervising and (ClientMode<scContact) then 4563 begin // not in negotiation mode 4564 if (UnFocus>=0) and (MyUn[UnFocus].Loc=MouseLoc) then 4565 begin // rotate 4566 uix:=(UnFocus+1) mod MyRO.nUn; 4567 i:=MyRO.nUn-1; 4568 while i>0 do 4569 begin 4570 if (MyUn[uix].Loc=MouseLoc) and (MyUn[uix].Job=jNone) 4571 and (MyUn[uix].Status and (usStay or usRecover or usEnhance or usWaiting)=usWaiting) then 4572 break; 4573 dec(i); 4574 uix:=(uix+1) mod MyRO.nUn; 4575 end; 4576 if i=0 then uix:=UnFocus 4577 end 4578 else Server(sGetDefender,me,MouseLoc,uix); 4579 if uix<>UnFocus then 4580 SetUnFocus(uix); 4581 TurnComplete:=false; 4582 EOT.ButtonIndex:=eotGray; 4583 end; 4584 SetTroopLoc(MouseLoc); 4585 PanelPaint; 4586 end // own unit 4587 else if (MyMap[MouseLoc] and fSpiedOut<>0) and not(ssCtrl in Shift) then 4588 begin 4589 DoCenter:=false; 4590 SetTroopLoc(MouseLoc); 4591 PanelPaint; 4592 end 4593 else 4594 begin 4595 DoCenter:=false; 4596 UnitStatDlg.ShowNewContent_EnemyLoc(wmPersistent, MouseLoc); 7880 else 7881 begin 7882 MapOptionChecked := MapOptionChecked and not(1 shl moBareTerrain); 7883 TButtonBase(Sender).Hint := Phrases.Lookup('CONTROLS', 7884 -1 + TButtonBase(Sender).Tag and $FF); 4597 7885 end; 4598 if DoCenter then begin Centre(MouseLoc); PaintAllMaps end 4599 end 4600 else if (ClientMode<>cEditMap) and (Button=mbRight) and not(ssShift in Shift) then 4601 begin 4602 if supervising then 4603 begin 4604 EditLoc:=MouseLoc; 4605 Server(sGetModels,me,0,nil^); 4606 EmptyMenu(mCreateUnit); 4607 for p1:=0 to nPl-1 do if 1 shl p1 and MyRO.Alive<>0 then 4608 begin 4609 m:=TMenuItem.Create(mCreateUnit); 4610 m.Caption:=Tribe[p1].TPhrase('SHORTNAME'); 4611 for emix:=MyRO.nEnemyModel-1 downto 0 do 4612 if (MyRO.EnemyModel[emix].Owner=p1) and 4613 (Server(sCreateUnit-sExecute+p1 shl 4,me,MyRO.EnemyModel[emix].mix,MouseLoc)>=rExecuted) then 4614 begin 4615 if Tribe[p1].ModelPicture[MyRO.EnemyModel[emix].mix].HGr=0 then 4616 InitEnemyModel(emix); 4617 m2:=TMenuItem.Create(m); 4618 m2.Caption:=Tribe[p1].ModelName[MyRO.EnemyModel[emix].mix]; 4619 m2.Tag:=p1 shl 16 + MyRO.EnemyModel[emix].mix; 4620 m2.OnClick:=CreateUnitClick; 4621 m.Add(m2); 4622 end; 4623 m.Visible:= m.Count>0; 4624 mCreateUnit.Add(m); 4625 end; 4626 if FullScreen then EditPopup.Popup(Left+x, Top+y) 4627 else EditPopup.Popup(Left+x+4, Top+y+GetSystemMetrics(SM_CYCAPTION)+4); 4628 end 4629 else if (UnFocus>=0) and (MyUn[UnFocus].Loc<>MouseLoc) then with MyUn[UnFocus] do 4630 begin 4631 dx:=((MouseLoc mod G.lx *2 +MouseLoc div G.lx and 1) 4632 -(Loc mod G.lx *2 +Loc div G.lx and 1)+3*G.lx) mod (2*G.lx) -G.lx; 4633 dy:=MouseLoc div G.lx-Loc div G.lx; 4634 if abs(dx)+abs(dy)<3 then 7886 SetMapOptions; 7887 MapValid := false; 7888 PaintAllMaps; 7889 end; 7890 7891 procedure TMainScreen.FormKeyUp(Sender: TObject; var Key: word; 7892 Shift: TShiftState); 7893 begin 7894 if idle and (Key = VK_APPS) then 7895 begin 7896 InitPopup(GamePopup); 7897 if FullScreen then 7898 GamePopup.Popup(Left, Top + TopBarHeight - 1) 7899 else 7900 GamePopup.Popup(Left + 4, Top + GetSystemMetrics(SM_CYCAPTION) + 4 + 7901 TopBarHeight - 1); 7902 exit 7903 end // windows menu button calls game menu 7904 end; 7905 7906 procedure TMainScreen.CreateUnitClick(Sender: TObject); 7907 var 7908 p1, mix: integer; 7909 begin 7910 p1 := TComponent(Sender).Tag shr 16; 7911 mix := TComponent(Sender).Tag and $FFFF; 7912 if Server(sCreateUnit + p1 shl 4, me, mix, EditLoc) >= rExecuted then 7913 PaintLoc(EditLoc); 7914 end; 7915 7916 procedure TMainScreen.mSoundOffClick(Sender: TObject); 7917 begin 7918 SoundMode := smOff; 7919 end; 7920 7921 procedure TMainScreen.mSoundOnClick(Sender: TObject); 7922 begin 7923 SoundMode := smOn; 7924 end; 7925 7926 procedure TMainScreen.mSoundOnAltClick(Sender: TObject); 7927 begin 7928 SoundMode := smOnAlt; 7929 end; 7930 7931 { procedure TMainScreen.AdviceBtnClick; 7932 var 7933 OldAdviceLoc: integer; 4635 7934 begin 4636 7935 DestinationMarkON:=false; 4637 7936 PaintDestination; 4638 Status:=Status and ($FFFF-usStay-usRecover-usGoto-usEnhance) or usWaiting; 4639 MoveUnit(dx,dy,muAutoNext) {simple move} 4640 end 4641 else if GetMoveAdvice(UnFocus,MouseLoc,MoveAdviceData)>=rExecuted then 4642 begin 4643 if MyMap[MouseLoc] and (fUnit or fOwned)=fUnit then 4644 begin // check for suicide mission before movement 4645 with MyUn[UnFocus],BattleDlg.Forecast do 4646 begin 4647 pAtt:=me; 4648 mixAtt:=mix; 4649 HealthAtt:=Health; 4650 ExpAtt:=Exp; 4651 FlagsAtt:=Flags; 4652 end; 4653 BattleDlg.Forecast.Movement:=MyUn[UnFocus].Movement; 4654 if (Server(sGetBattleForecastEx,me,MouseLoc,BattleDlg.Forecast)>=rExecuted) 4655 and (BattleDlg.Forecast.EndHealthAtt<=0) then 4656 begin 4657 BattleDlg.uix:=UnFocus; 4658 BattleDlg.ToLoc:=MouseLoc; 4659 BattleDlg.IsSuicideQuery:=true; 4660 BattleDlg.ShowModal; 4661 if BattleDlg.ModalResult<>mrOK then 4662 exit; 4663 end 4664 end; 4665 DestinationMarkON:=false; 4666 PaintDestination; 4667 Status:=Status and not (usStay or usRecover or usEnhance) or usWaiting; 4668 MoveToLoc(MouseLoc,false); {goto} 4669 end 4670 end 4671 end 4672 else if (Button=mbMiddle) and (UnFocus>=0) 4673 and (MyModel[MyUn[UnFocus].mix].Kind in [mkSettler,mkSlaves]) then 4674 begin 4675 DestinationMarkON:=false; 4676 PaintDestination; 4677 MyUn[UnFocus].Status:=MyUn[UnFocus].Status and ($FFFF-usStay-usRecover-usGoto) or usEnhance; 4678 uix:=UnFocus; 4679 if MouseLoc<>MyUn[uix].Loc then MoveToLoc(MouseLoc,true); {goto} 4680 if (UnFocus=uix) and (MyUn[uix].Loc=MouseLoc) then MenuClick(mEnhance) 4681 end 4682 else if (Button=mbLeft) and (ssShift in Shift) 4683 and (MyMap[MouseLoc] and fTerrain<>fUNKNOWN) then 4684 HelpOnTerrain(MouseLoc, wmPersistent) 4685 else if (ClientMode<=cContinue) and (Button=mbRight) and (ssShift in Shift) 4686 and (UnFocus>=0) and (MyMap[MouseLoc] and (fUnit or fOwned)=fUnit) then 4687 begin // battle forecast 4688 with MyUn[UnFocus],BattleDlg.Forecast do 4689 begin 4690 pAtt:=me; 4691 mixAtt:=mix; 4692 HealthAtt:=Health; 4693 ExpAtt:=Exp; 4694 FlagsAtt:=Flags; 4695 end; 4696 BattleDlg.Forecast.Movement:=MyUn[UnFocus].Movement; 4697 if Server(sGetBattleForecastEx,me,MouseLoc,BattleDlg.Forecast)>=rExecuted then 4698 begin 4699 BattleDlg.uix:=UnFocus; 4700 BattleDlg.ToLoc:=MouseLoc; 4701 BattleDlg.Left:=x-BattleDlg.Width div 2; 4702 if BattleDlg.Left<0 then 4703 BattleDlg.Left:=0 4704 else if BattleDlg.Left+BattleDlg.Width>Screen.Width then 4705 BattleDlg.Left:=Screen.Width-BattleDlg.Width; 4706 BattleDlg.Top:=y-BattleDlg.Height div 2; 4707 if BattleDlg.Top<0 then 4708 BattleDlg.Top:=0 4709 else if BattleDlg.Top+BattleDlg.Height>Screen.Height then 4710 BattleDlg.Top:=Screen.Height-BattleDlg.Height; 4711 BattleDlg.IsSuicideQuery:=false; 4712 BattleDlg.Show; 4713 end 4714 end 4715 end; 4716 4717 function TMainScreen.MoveUnit(dx,dy:integer; Options: integer): integer; 4718 // move focused unit to adjacent tile 4719 var 4720 i,cix,uix,euix,FromLoc,ToLoc,DirCode,UnFocus0,Defender,Mission,p1, 4721 NewTiles,cixChanged: integer; 4722 OldToTile: cardinal; 4723 CityCaptured, IsAttack, OldUnrest, NewUnrest, NeedEcoUpdate, NeedRepaintPanel, 4724 ToTransport, ToShip: boolean; 4725 PlaneReturnData: TPlaneReturnData; 4726 QueryItem: string; 4727 begin 4728 result:=eInvalid; 4729 UnFocus0:=UnFocus; 4730 FromLoc:=MyUn[UnFocus].Loc; 4731 ToLoc:=dLoc(FromLoc,dx,dy); 4732 if (ToLoc<0) or (ToLoc>=G.lx*G.ly) then begin result:=eInvalid; exit; end; 4733 if MyMap[ToLoc] and fStealthUnit<>0 then 4734 begin 4735 SoundMessage(Phrases.LookUp('ATTACKSTEALTH'),''); 4736 exit; 4737 end; 4738 if MyMap[ToLoc] and fHiddenUnit<>0 then 4739 begin 4740 SoundMessage(Phrases.LookUp('ATTACKSUB'),''); 4741 exit; 4742 end; 4743 4744 if MyMap[ToLoc] and (fUnit or fOwned)=fUnit then 4745 begin // attack -- search enemy unit 4746 if (MyModel[MyUn[UnFocus].mix].Attack=0) 4747 and not ((MyModel[MyUn[UnFocus].mix].Cap[mcBombs]>0) 4748 and (MyUn[UnFocus].Flags and unBombsLoaded<>0)) then 4749 begin 4750 SoundMessage(Phrases.LookUp('NOATTACKER'),''); 4751 exit; 4752 end; 4753 euix:=MyRO.nEnemyUn-1; 4754 while (euix>=0) and (MyRO.EnemyUn[euix].Loc<>ToLoc) do dec(euix); 4755 end; 4756 4757 DirCode:=dx and 7 shl 4+dy and 7 shl 7; 4758 result:=Server(sMoveUnit-sExecute+DirCode,me,UnFocus,nil^); 4759 if (result<rExecuted) and (MyUn[UnFocus].Job>jNone) then 4760 Server(sStartJob+jNone shl 4,me,UnFocus,nil^); 4761 if (result<rExecuted) and (result<>eNoTime_Move) then 4762 begin 4763 case result of 4764 eNoTime_Load: 4765 if MyModel[MyUn[UnFocus].mix].Domain=dAir then 4766 SoundMessage(Phrases.Lookup('NOTIMELOADAIR'),'NOMOVE_TIME') 4767 else 4768 SoundMessage(Format(Phrases.Lookup('NOTIMELOADGROUND'), 4769 [MovementToString(MyModel[MyUn[UnFocus].mix].Speed)]),'NOMOVE_TIME'); 4770 eNoTime_Bombard: SoundMessage(Phrases.Lookup('NOTIMEBOMBARD'),'NOMOVE_TIME'); 4771 eNoTime_Expel: SoundMessage(Phrases.Lookup('NOTIMEEXPEL'),'NOMOVE_TIME'); 4772 eNoRoad: SoundMessage(Phrases.Lookup('NOROAD'),'NOMOVE_DEFAULT'); 4773 eNoNav: SoundMessage(Phrases.Lookup('NONAV'),'NOMOVE_DEFAULT'); 4774 eNoCapturer: SoundMessage(Phrases.Lookup('NOCAPTURER'),'NOMOVE_DEFAULT'); 4775 eNoBombarder: SoundMessage(Phrases.Lookup('NOBOMBARDER'),'NOMOVE_DEFAULT'); 4776 eZOC: ContextMessage(Phrases.Lookup('ZOC'), 'NOMOVE_ZOC', hkText, HelpDlg.TextIndex('MOVEMENT')); 4777 eTreaty: 4778 if MyMap[ToLoc] and (fUnit or fOwned)<>fUnit then {no enemy unit -- move} 4779 SoundMessage(Tribe[MyRO.Territory[ToLoc]].TPhrase('PEACE_NOMOVE'), 4780 'NOMOVE_TREATY') 4781 else SoundMessage(Tribe[MyRO.EnemyUn[euix].Owner].TPhrase 4782 ('PEACE_NOATTACK'),'NOMOVE_TREATY'); 4783 eDomainMismatch: 4784 begin 4785 if (MyModel[MyUn[UnFocus].mix].Domain<dSea) 4786 and (MyMap[ToLoc] and (fUnit or fOwned)=fUnit or fOwned) then 4787 begin // false load attempt 4788 ToShip:=false; 4789 ToTransport:=false; 4790 for uix:=0 to MyRo.nUn-1 do 4791 if (MyUn[uix].Loc=ToLoc) and (MyModel[MyUn[uix].mix].Domain=dSea) then 4792 begin 4793 ToShip:=true; 4794 if MyModel[MyUn[uix].mix].Cap[mcSeaTrans]>0 then 4795 ToTransport:=true; 4796 end; 4797 if ToTransport then 4798 SoundMessage(Phrases.Lookup('FULLTRANSPORT'),'NOMOVE_DEFAULT') 4799 else if ToShip then 4800 SoundMessage(Phrases.Lookup('NOTRANSPORT'),'NOMOVE_DEFAULT') 4801 else Play('NOMOVE_DOMAIN'); 4802 end 4803 else Play('NOMOVE_DOMAIN'); 4804 end 4805 else Play('NOMOVE_DEFAULT'); 4806 end; 4807 exit; 4808 end; 4809 4810 if ((result=eWon) or (result=eLost) or (result=eBloody)) 4811 and (MyUn[UnFocus].Movement<100) 4812 and (MyModel[MyUn[UnFocus].mix].Cap[mcWill]=0) then 4813 begin 4814 if SimpleQuery(mkYesNo,Format(Phrases.Lookup('FASTATTACK'), 4815 [MyUn[UnFocus].Movement]),'NOMOVE_TIME')<>mrOk then 4816 begin result:=eInvalid; exit; end; 4817 Update; // remove message box from screen 4818 end; 4819 4820 OldUnrest:=false; 4821 NewUnrest:=false; 4822 if (result>=rExecuted) and (result and rUnitRemoved=0) 4823 and (MyMap[ToLoc] and (fUnit or fOwned)<>fUnit) then 4824 begin 4825 OldUnrest:=UnrestAtLoc(UnFocus,FromLoc); 4826 NewUnrest:=UnrestAtLoc(UnFocus,ToLoc); 4827 if NewUnrest>OldUnrest then 4828 begin 4829 if MyRO.Government=gDemocracy then 4830 begin 4831 QueryItem:='UNREST_NOTOWN'; 4832 p1:=me; 4833 end 4834 else 4835 begin 4836 QueryItem:='UNREST_FOREIGN'; 4837 p1:=MyRO.Territory[ToLoc]; 7937 AdvisorDlg.GiveStrategyAdvice; 7938 OldAdviceLoc:=MainMap.AdviceLoc; 7939 MainMap.AdviceLoc:=-1; 7940 PaintLoc(OldAdviceLoc); 7941 end; } 7942 7943 { procedure TMainScreen.SetAdviceLoc(Loc: integer; AvoidRect: TRect); 7944 var 7945 OldAdviceLoc,x,y: integer; 7946 begin 7947 if Loc<>MainMap.AdviceLoc then 7948 begin 7949 if Loc>=0 then 7950 begin // center 7951 y:=Loc div G.lx; 7952 x:=(Loc+G.lx - AvoidRect.Right div (2*66)) mod G.lx; 7953 Centre(y*G.lx+x); 7954 PaintAllMaps; 4838 7955 end; 4839 with MessgExDlg do 4840 begin 4841 MessgText:=Format(Tribe[p1].TPhrase(QueryItem),[Phrases.Lookup('GOVERNMENT',MyRO.Government)]); 4842 Kind:=mkYesNo; 4843 IconKind:=mikImp; 4844 IconIndex:=imPalace; 4845 ShowModal; 4846 if ModalResult<>mrOk then 4847 begin result:=eInvalid; exit; end; 7956 OldAdviceLoc:=MainMap.AdviceLoc; 7957 MainMap.AdviceLoc:=Loc; 7958 PaintLoc(OldAdviceLoc); 7959 PaintLoc(MainMap.AdviceLoc); 4848 7960 end; 4849 Update; // remove message box from screen 4850 end 4851 end; 4852 4853 if (result>=rExecuted) 4854 and (MyModel[MyUn[UnFocus].mix].Domain=dAir) 4855 and (MyUn[UnFocus].Status and usToldNoReturn=0) then 4856 begin // can plane return? 4857 PlaneReturnData.Fuel:=MyUn[UnFocus].Fuel; 4858 if (MyMap[ToLoc] and (fUnit or fOwned)=fUnit) 4859 or (MyMap[ToLoc] and (fCity or fOwned)=fCity) then 4860 begin // attack/expel/bombard -> 100MP 4861 PlaneReturnData.Loc:=FromLoc; 4862 PlaneReturnData.Movement:=MyUn[UnFocus].Movement-100; 4863 if PlaneReturnData.Movement<0 then PlaneReturnData.Movement:=0; 4864 end 4865 else // move 4866 begin 4867 PlaneReturnData.Loc:=ToLoc; 4868 if dx and 1<>0 then PlaneReturnData.Movement:=MyUn[UnFocus].Movement-100 4869 else PlaneReturnData.Movement:=MyUn[UnFocus].Movement-150; 4870 end; 4871 if Server(sGetPlaneReturn, me, UnFocus, PlaneReturnData)=eNoWay then 4872 begin 4873 if MyModel[MyUn[UnFocus].mix].Kind=mkSpecial_Glider then 4874 QueryItem:='LOWFUEL_GLIDER' 4875 else QueryItem:='LOWFUEL'; 4876 if SimpleQuery(mkYesNo,Phrases.Lookup(QueryItem),'WARNING_LOWSUPPORT')<>mrOk then 4877 begin result:=eInvalid; exit; end; 4878 Update; // remove message box from screen 4879 MyUn[UnFocus].Status:=MyUn[UnFocus].Status or usToldNoReturn; 4880 end 4881 end; 4882 4883 if result=eMissionDone then 4884 begin 4885 ModalSelectDlg.ShowNewContent(wmModal,kMission); 4886 Update; // dialog still on screen 4887 Mission:=ModalSelectDlg.result; 4888 if Mission<0 then exit; 4889 Server(sSetSpyMission+Mission shl 4, me, 0, nil^); 4890 end; 4891 4892 CityCaptured:=false; 4893 if result=eNoTime_Move then Play('NOMOVE_TIME') 4894 else 4895 begin 4896 NeedEcoUpdate:=false; 4897 DestinationMarkON:=false; 4898 PaintDestination; 4899 if result and rUnitRemoved<>0 then 4900 CityOptimizer_BeforeRemoveUnit(UnFocus); 4901 IsAttack:= (result=eBombarded) 4902 or (result<>eMissionDone) and (MyMap[ToLoc] and (fUnit or fOwned)=fUnit); 4903 if not IsAttack then 4904 begin // move 4905 cix:=MyRO.nCity-1; {look for own city at dest location} 4906 while (cix>=0) and (MyCity[cix].Loc<>ToLoc) do dec(cix); 4907 if (result<>eMissionDone) and (MyMap[ToLoc] and fCity<>0) and (cix<0) then 4908 CityCaptured:=true; 4909 result:=Server(sMoveUnit+DirCode,me,UnFocus,nil^); 4910 case result of 4911 eHiddenUnit: 4912 begin Play('NOMOVE_SUBMARINE'); PaintLoc(ToLoc) end; 4913 eStealthUnit: 4914 begin Play('NOMOVE_STEALTH'); PaintLoc(ToLoc) end; 4915 eZOC_EnemySpotted: 4916 begin Play('NOMOVE_ZOC'); PaintLoc(ToLoc,1) end; 4917 rExecuted..maxint: 4918 begin 4919 if result and rUnitRemoved<>0 then UnFocus:=-1 // unit died 4920 else 4921 begin 4922 assert(UnFocus>=0); 4923 MyUn[UnFocus].Status:=MyUn[UnFocus].Status and not (usStay or usRecover); 4924 for uix:=0 to MyRO.nUn-1 do if MyUn[uix].Master=UnFocus then 4925 MyUn[uix].Status:=MyUn[uix].Status and not usWaiting; 4926 if CityCaptured 4927 and (MyRO.Government in [gRepublic,gDemocracy,gFuture]) then 4928 begin // borders have moved, unrest might have changed in any city 4929 CityOptimizer_BeginOfTurn; 4930 NeedEcoUpdate:=true; 4931 end 4932 else 4933 begin 4934 if OldUnrest<>NewUnrest then 4935 begin 4936 CityOptimizer_CityChange(MyUn[UnFocus].Home); 4937 for uix:=0 to MyRO.nUn-1 do if MyUn[uix].Master=UnFocus then 4938 CityOptimizer_CityChange(MyUn[uix].Home); 4939 NeedEcoUpdate:=true; 4940 end; 4941 if (MyRO.Government=gDespotism) 4942 and (MyModel[MyUn[UnFocus].mix].Kind=mkSpecial_TownGuard) then 4943 begin 4944 if MyMap[FromLoc] and fCity<>0 then 4945 begin // town guard moved out of city in despotism -- reoptimize! 4946 cixChanged:=MyRO.nCity-1; 4947 while (cixChanged>=0) and (MyCity[cixChanged].Loc<>FromLoc) do 4948 dec(cixChanged); 4949 assert(cixChanged>=0); 4950 if cixChanged>=0 then 4951 begin 4952 CityOptimizer_CityChange(cixChanged); 4953 NeedEcoUpdate:=true; 4954 end; 4955 end; 4956 if (MyMap[ToLoc] and fCity<>0) and not CityCaptured then 4957 begin // town guard moved into city in despotism -- reoptimize! 4958 cixChanged:=MyRO.nCity-1; 4959 while (cixChanged>=0) and (MyCity[cixChanged].Loc<>ToLoc) do 4960 dec(cixChanged); 4961 assert(cixChanged>=0); 4962 if cixChanged>=0 then 4963 begin 4964 CityOptimizer_CityChange(cixChanged); 4965 NeedEcoUpdate:=true; 4966 end 4967 end 4968 end 4969 end 4970 end; 4971 end; 4972 else 4973 assert(false); 4974 end; 4975 SetTroopLoc(ToLoc); 4976 end 4977 else 4978 begin {enemy unit -- attack} 4979 if result=eBombarded then Defender:=MyRO.Territory[ToLoc] 4980 else Defender:=MyRO.EnemyUn[euix].Owner; 4981 {if MyRO.Treaty[Defender]=trCeaseFire then 4982 if SimpleQuery(mkYesNo,Phrases.Lookup('FRCANCELQUERY_CEASEFIRE'), 4983 'MSG_DEFAULT')<>mrOK then 4984 exit;} 4985 if (Options and muNoSuicideCheck=0) 4986 and (result and rUnitRemoved<>0) and (result<>eMissionDone) then 4987 begin // suicide query 4988 with MyUn[UnFocus],BattleDlg.Forecast do 4989 begin 4990 pAtt:=me; 4991 mixAtt:=mix; 4992 HealthAtt:=Health; 4993 ExpAtt:=Exp; 4994 FlagsAtt:=Flags; 4995 end; 4996 BattleDlg.Forecast.Movement:=MyUn[UnFocus].Movement; 4997 Server(sGetBattleForecastEx,me,ToLoc,BattleDlg.Forecast); 4998 BattleDlg.uix:=UnFocus; 4999 BattleDlg.ToLoc:=ToLoc; 5000 BattleDlg.IsSuicideQuery:=true; 5001 BattleDlg.ShowModal; 5002 if BattleDlg.ModalResult<>mrOK then 5003 exit; 5004 end; 5005 5006 cixChanged:=-1; 5007 if (result and rUnitRemoved<>0) and (MyRO.Government=gDespotism) 5008 and (MyModel[MyUn[UnFocus].mix].Kind=mkSpecial_TownGuard) 5009 and (MyMap[FromLoc] and fCity<>0) then 5010 begin // town guard died in city in despotism -- reoptimize! 5011 cixChanged:=MyRO.nCity-1; 5012 while (cixChanged>=0) and (MyCity[cixChanged].Loc<>FromLoc) do 5013 dec(cixChanged); 5014 assert(cixChanged>=0); 5015 end; 5016 5017 for i:=0 to MyRO.nEnemyModel-1 do 5018 LostArmy[i]:=MyRO.EnemyModel[i].Lost; 5019 OldToTile:=MyMap[ToLoc]; 5020 result:=Server(sMoveUnit+DirCode,me,UnFocus,nil^); 5021 nLostArmy:=0; 5022 for i:=0 to MyRO.nEnemyModel-1 do 5023 begin 5024 LostArmy[i]:=MyRO.EnemyModel[i].Lost-LostArmy[i]; 5025 inc(nLostArmy,LostArmy[i]) 5026 end; 5027 if result and rUnitRemoved<>0 then 5028 begin 5029 UnFocus:=-1; 5030 SetTroopLoc(FromLoc); 5031 end; 5032 if (OldToTile and not MyMap[ToLoc] and fCity<>0) 5033 and (MyRO.Government in [gRepublic,gDemocracy,gFuture]) then 5034 begin // city was destroyed, borders have moved, unrest might have changed in any city 5035 CityOptimizer_BeginOfTurn; 5036 NeedEcoUpdate:=true; 5037 end 5038 else 5039 begin 5040 if cixChanged>=0 then 5041 begin 5042 CityOptimizer_CityChange(cixChanged); 5043 NeedEcoUpdate:=true; 5044 end; 5045 if (result=eWon) or (result=eBloody) or (result=eExpelled) then 5046 begin 5047 CityOptimizer_TileBecomesAvailable(ToLoc); 5048 NeedEcoUpdate:=true; 5049 end; 5050 end; 5051 if nLostArmy>1 then 5052 begin 5053 with MessgExDlg do 5054 begin 5055 Kind:=mkOk; 5056 IconKind:=mikEnemyArmy; 5057 MessgText:=Tribe[Defender].TString(Phrases.Lookup('ARMYLOST', 5058 MyRO.EnemyModel[MyRO.EnemyUn[euix].emix].Domain)); 5059 ShowModal; 5060 end 5061 end 5062 end; 5063 if result and rUnitRemoved<>0 then 5064 begin 5065 CityOptimizer_AfterRemoveUnit; 5066 ListDlg.RemoveUnit; 5067 NeedEcoUpdate:=true; 5068 end; 5069 if NeedEcoUpdate then 5070 begin 5071 UpdateViews(true); 5072 Update 5073 end 5074 end; 5075 5076 if result=eMissionDone then 5077 begin 5078 p1:=MyRO.Territory[ToLoc]; 5079 case Mission of 5080 smStealMap: 5081 begin MapValid:=false; PaintAllMaps end; 5082 smStealCivilReport: 5083 TribeMessage(p1,Tribe[p1].TPhrase('DOSSIER_PREPARED'),''); 5084 smStealMilReport: 5085 ListDlg.ShowNewContent_MilReport(wmPersistent,p1); 5086 end; 5087 end; 5088 5089 if UnFocus>=0 then 5090 CheckToldNoReturn(UnFocus); 5091 5092 NeedRepaintPanel:=false; 5093 if result>=rExecuted then 5094 begin 5095 if CityCaptured and (MyMap[ToLoc] and fCity=0) then 5096 begin // city destroyed 5097 for i:=0 to 27 do {tell about destroyed wonders} 5098 if (MyRO.Wonder[i].CityID=-2) and (MyData.ToldWonders[i].CityID<>-2) then 5099 with MessgExDlg do 5100 begin 5101 if WondersDlg.Visible then 5102 WondersDlg.SmartUpdateContent(false); 5103 OpenSound:='WONDER_DESTROYED'; 5104 MessgText:=Format(Phrases.Lookup('WONDERDEST'), 5105 [Phrases.Lookup('IMPROVEMENTS',i)]); 5106 Kind:=mkOkHelp; 5107 HelpKind:=hkImp; 5108 HelpNo:=i; 5109 IconKind:=mikImp; 5110 IconIndex:=i; 5111 ShowModal; 5112 MyData.ToldWonders[i]:=MyRO.Wonder[i]; 5113 end 5114 end; 5115 if CityCaptured and (MyMap[ToLoc] and fCity<>0) then 5116 begin // city captured 5117 ListDlg.AddCity; 5118 for i:=0 to 27 do {tell about capture of wonders} 5119 if MyRO.City[MyRO.nCity-1].Built[i]>0 then with MessgExDlg do 5120 begin 5121 if WondersDlg.Visible then 5122 WondersDlg.SmartUpdateContent(false); 5123 OpenSound:='WONDER_CAPTURED'; 5124 MessgText:=Format(Tribe[me].TPhrase('WONDERCAPTOWN'), 5125 [Phrases.Lookup('IMPROVEMENTS',i)]); 5126 Kind:=mkOkHelp; 5127 HelpKind:=hkImp; 5128 HelpNo:=i; 5129 IconKind:=mikImp; 5130 IconIndex:=i; 5131 ShowModal; 5132 MyData.ToldWonders[i]:=MyRO.Wonder[i]; 5133 end; 5134 5135 if MyRO.Happened and phStealTech<>0 then 5136 begin {Temple of Zeus -- choose advance to steal} 5137 ModalSelectDlg.ShowNewContent(wmModal,kStealTech); 5138 Server(sStealTech,me,ModalSelectDlg.result,nil^); 5139 end; 5140 TellNewModels; 5141 5142 cix:=MyRO.nCity-1; 5143 while (cix>=0) and (MyCity[cix].Loc<>ToLoc) do 5144 dec(cix); 5145 assert(cix>=0); 5146 MyCity[cix].Status:=MyCity[cix].Status 5147 and not csResourceWeightsMask or (3 shl 4); // captured city, set to maximum growth 5148 NewTiles:=1 shl 13; {exploit central tile only} 5149 Server(sSetCityTiles,me,cix,NewTiles); 5150 end 5151 else NeedRepaintPanel:=true; 5152 end; 5153 TellNewContacts; 5154 5155 if (UnFocus>=0) and (MyUn[UnFocus].Master>=0) then 5156 with MyUn[MyUn[UnFocus].Master] do 5157 if Status and usStay<>0 then 5158 begin 5159 Status:=Status and not usStay; 5160 if (Movement>=100) and (Status and (usRecover or usGoto)=0) then 5161 Status:=Status or usWaiting; 5162 end; 5163 if Options and (muAutoNoWait or muAutoNext)<>0 then 5164 begin 5165 if (UnFocus>=0) and ((result=eNoTime_Move) or UnitExhausted(UnFocus) 5166 or (MyUn[UnFocus].Master>=0) 5167 or (MyModel[MyUn[UnFocus].mix].Domain=dAir) 5168 and ((MyMap[MyUn[UnFocus].Loc] and fCity<>0) {aircrafts stop in cities} 5169 or (MyMap[MyUn[UnFocus].Loc] and fTerImp=tiBase))) then 5170 begin 5171 MyUn[UnFocus].Status:=MyUn[UnFocus].Status and not usWaiting; 5172 if Options and muAutoNext<>0 then 5173 if CityCaptured and (MyMap[ToLoc] and fCity<>0) then 5174 begin 5175 UnFocus:=-1; 5176 PaintLoc(ToLoc); // don't show unit in city if not selected 5177 end 5178 else NextUnit(UnStartLoc,true) 5179 end 5180 else if (UnFocus<0) and (Options and muAutoNext<>0) then 5181 NextUnit(UnStartLoc,result<>eMissionDone); 5182 end; 5183 5184 if NeedRepaintPanel and (UnFocus=UnFocus0) then 5185 if IsAttack then PanelPaint 5186 else 5187 begin 5188 assert(result<>eMissionDone); 5189 CheckTerrainBtnVisible; 5190 FocusOnLoc(ToLoc,flRepaintPanel or flImmUpdate) 5191 end; 5192 5193 if (result>=rExecuted) and CityCaptured and (MyMap[ToLoc] and fCity<>0) then 5194 ZoomToCity(ToLoc,UnFocus<0,chCaptured); // show captured city 5195 end; // moveunit 5196 5197 procedure TMainScreen.MoveOnScreen(ShowMove: TShowMove; Step0,Step1,nStep: integer; 5198 Restore: boolean = true); 5199 var 5200 ToLoc,xFromLoc,yFromLoc,xToLoc,yToLoc,xFrom,yFrom,xTo,yTo,xMin,yMin,xRange,yRange, 5201 xw1,Step,xMoving,yMoving,yl,SliceCount:integer; 5202 UnitInfo: TUnitInfo; 5203 Ticks0,Ticks: int64; 5204 begin 5205 Timer1.Enabled:=false; 5206 QueryPerformanceCounter(Ticks0); 5207 with ShowMove do 5208 begin 5209 UnitInfo.Owner:=Owner; 5210 UnitInfo.mix:=mix; 5211 UnitInfo.Health:=Health; 5212 UnitInfo.Job:=jNone; 5213 UnitInfo.Flags:=Flags; 5214 if Owner<>me then 5215 UnitInfo.emix:=emix; 5216 5217 ToLoc:=dLoc(FromLoc,dx,dy); 5218 xToLoc:=ToLoc mod G.lx; yToLoc:=ToLoc div G.lx; 5219 xFromLoc:=FromLoc mod G.lx; yFromLoc:=FromLoc div G.lx; 5220 if xToLoc>xFromLoc+2 then xToLoc:=xToLoc-G.lx 5221 else if xToLoc<xFromLoc-2 then xToLoc:=xToLoc+G.lx; 5222 5223 xw1:=xw+G.lx; 5224 // ((xFromLoc-xw1)*2+yFromLoc and 1+1)*xxt+dx*xxt/2-MapWidth/2 -> min 5225 while abs(((xFromLoc-xw1+G.lx)*2+yFromLoc and 1+1)*xxt*2+dx*xxt-MapWidth) 5226 <abs(((xFromLoc-xw1)*2+yFromLoc and 1+1)*xxt*2+dx*xxt-MapWidth) do 5227 dec(xw1,G.lx); 5228 5229 xTo:=(xToLoc-xw1)*(xxt*2) + yToLoc and 1 *xxt +(xxt-xxu); 5230 yTo:=(yToLoc-yw)*yyt +(yyt-yyu_anchor); 5231 xFrom:=(xFromLoc-xw1)*(xxt*2) + yFromLoc and 1 *xxt +(xxt-xxu); 5232 yFrom:=(yFromLoc-yw)*yyt +(yyt-yyu_anchor); 5233 if xFrom<xTo then begin xMin:=xFrom;xRange:=xTo-xFrom end 5234 else begin xMin:=xTo;xRange:=xFrom-xTo end; 5235 if yFrom<yTo then begin yMin:=yFrom;yRange:=yTo-yFrom end 5236 else begin yMin:=yTo;yRange:=yFrom-yTo end; 5237 inc(xRange,xxt*2); 5238 inc(yRange,yyt*3); 5239 5240 MainOffscreenPaint; 5241 NoMap.SetOutput(Buffer); 5242 NoMap.SetPaintBounds(0,0,xRange,yRange); 5243 for Step:=0 to abs(Step1-Step0) do 5244 begin 5245 BitBlt(Buffer.Canvas.Handle,0,0,xRange,yRange, 5246 offscreen.Canvas.Handle,xMin,yMin,SRCCOPY); 5247 if Step1<>Step0 then 5248 begin 5249 xMoving:=xFrom+Round((Step0+Step*(Step1-Step0) div abs(Step1-Step0)) 5250 *(xTo-xFrom)/nStep); 5251 yMoving:=yFrom+Round((Step0+Step*(Step1-Step0) div abs(Step1-Step0)) 5252 *(yTo-yFrom)/nStep); 5253 end 5254 else begin xMoving:=xFrom; yMoving:=yFrom; end; 5255 NoMap.PaintUnit(xMoving-xMin,yMoving-yMin,UnitInfo,0); 5256 PaintBufferToScreen(xMin,yMin,xRange,yRange); 5257 5258 SliceCount:=0; 5259 Ticks:=Ticks0; 5260 repeat 5261 if (SliceCount=0) or ((Ticks-Ticks0)*12000 *(SliceCount+1) 5262 div SliceCount<MoveTime*PerfFreq) then 5263 begin 5264 if not idle or (GameMode=cMovie) then 5265 Application.ProcessMessages; 5266 Sleep(1); 5267 inc(SliceCount) 5268 end; 5269 QueryPerformanceCounter(Ticks); 5270 until (Ticks-Ticks0)*12000>=MoveTime*PerfFreq; 5271 Ticks0:=Ticks 5272 end; 5273 end; 5274 if Restore then 5275 begin 5276 BitBlt(Buffer.Canvas.Handle,0,0,xRange,yRange,offscreen.Canvas.Handle,xMin, 5277 yMin,SRCCOPY); 5278 PaintBufferToScreen(xMin,yMin,xRange,yRange); 5279 end; 5280 BlinkTime:=-1; 5281 Timer1.Enabled:=true; 5282 end; 5283 5284 procedure TMainScreen.MoveToLoc(Loc: integer; CheckSuicide: boolean); 5285 // path finder: move focused unit to loc, start multi-turn goto if too far 5286 var 5287 uix,i,MoveOptions,NextLoc,MoveResult: integer; 5288 MoveAdviceData: TMoveAdviceData; 5289 StopReason: (None, Arrived, Dead, NoTime, EnemySpotted, MoveError); 5290 begin 5291 if MyUn[UnFocus].Job>jNone then 5292 Server(sStartJob+jNone shl 4,me,UnFocus,nil^); 5293 if GetMoveAdvice(UnFocus,Loc,MoveAdviceData)>=rExecuted then 5294 begin 5295 uix:=UnFocus; 5296 StopReason:=None; 5297 repeat 5298 for i:=0 to MoveAdviceData.nStep-1 do 5299 begin 5300 if i=MoveAdviceData.nStep-1 then MoveOptions:=muAutoNext 5301 else MoveOptions:=0; 5302 NextLoc:=dLoc(MyUn[uix].Loc,MoveAdviceData.dx[i],MoveAdviceData.dy[i]); 5303 if (NextLoc=Loc) 5304 or (Loc=maNextCity) and (MyMap[NextLoc] and fCity<>0) then 5305 StopReason:=Arrived; 5306 if not CheckSuicide and (NextLoc=Loc) then 5307 MoveOptions:=MoveOptions or muNoSuicideCheck; 5308 MoveResult:=MoveUnit(MoveAdviceData.dx[i],MoveAdviceData.dy[i],MoveOptions); 5309 if MoveResult<rExecuted then StopReason:=MoveError 5310 else if MoveResult and rUnitRemoved<>0 then StopReason:=Dead 5311 else if (StopReason=None) and (MoveResult and rEnemySpotted<>0) then 5312 StopReason:=EnemySpotted; 5313 if StopReason<>None then break; 5314 end; 5315 if (StopReason=None) and ((MoveAdviceData.nStep<25) 5316 or (MyRO.Wonder[woShinkansen].EffectiveOwner<>me)) then 5317 StopReason:=NoTime; 5318 if StopReason<>None then break; 5319 if GetMoveAdvice(UnFocus,Loc,MoveAdviceData)<rExecuted then 5320 begin assert(false); break end 5321 until false; 5322 5323 case StopReason of 5324 None: assert(false); 5325 Arrived: MyUn[uix].Status:=MyUn[uix].Status and ($FFFF-usGoto); 5326 Dead: if UnFocus<0 then NextUnit(UnStartLoc,false); 5327 else 5328 begin // multi-turn goto 5329 if Loc=maNextCity then 5330 MyUn[uix].Status:=MyUn[uix].Status and ($FFFF-usStay-usRecover) or usGoto +$7FFF shl 16 5331 else MyUn[uix].Status:=MyUn[uix].Status and ($FFFF-usStay-usRecover) or usGoto +Loc shl 16; 5332 PaintLoc(MyUn[uix].Loc); 5333 if (StopReason=NoTime) and (UnFocus=uix) then 5334 begin 5335 MyUn[uix].Status:=MyUn[uix].Status and not usWaiting; 5336 NextUnit(UnStartLoc,true) 5337 end; 5338 end 5339 end 5340 end 5341 end; 5342 5343 procedure TMainScreen.PanelBoxMouseDown(Sender:TObject; 5344 Button:TMouseButton;Shift:TShiftState;x,y:integer); 5345 var 5346 i,xMouse,MouseLoc,p1: integer; 5347 begin 5348 if GameMode=cMovie then 5349 exit; 5350 5351 if Button=mbLeft then 5352 begin 5353 if (x>=xMini+2) and (y>=yMini+2) and (x<xMini+2+2*G.lx) and (y<yMini+2+G.ly) then 5354 if ssShift in Shift then 5355 begin 5356 xMouse:=(xwMini+(x-(xMini+2)+MapWidth div (xxt*2)+G.lx) div 2) mod G.lx; 5357 MouseLoc:=xMouse+G.lx*(y-(yMini+2)); 5358 if MyMap[MouseLoc] and fTerrain<>fUNKNOWN then 5359 begin 5360 p1:=MyRO.Territory[MouseLoc]; 5361 if (p1=me) or (p1>=0) and (MyRO.Treaty[p1]>=trNone) then 5362 NatStatDlg.ShowNewContent(wmPersistent, p1); 5363 end 5364 end 5365 else 5366 begin 5367 if CityDlg.Visible then CityDlg.Close; 5368 if UnitStatDlg.Visible then UnitStatDlg.Close; 5369 Tracking:=true; 5370 PanelBoxMouseMove(Sender,Shift+[ssLeft],x,y); 5371 end 5372 else if (ClientMode<>cEditMap) and (x>=ClientWidth-xPalace) and (y>=yPalace) 5373 and (x<ClientWidth-xPalace+xSizeBig) and (y<yPalace+ySizeBig) then 5374 begin 5375 InitPopup(StatPopup); 5376 if FullScreen then 5377 StatPopup.Popup(Left+ClientWidth-xPalace+xSizeBig+2, 5378 Top+ClientHeight-PanelHeight+yPalace-1) 5379 else StatPopup.Popup(Left+ClientWidth-xPalace+6, 5380 Top+ClientHeight-PanelHeight+yPalace+ySizeBig+GetSystemMetrics(SM_CYCAPTION)+3) 5381 end 5382 (* else if (x>=xAdvisor-3) and (y>=yAdvisor-3) 5383 and (x<xAdvisor+16+3) and (y<yAdvisor+16+3) and HaveStrategyAdvice then 5384 AdviceBtnClick*) 5385 else if (x>=xTroop+1) and (y>=yTroop+1) 5386 and (x<xTroop+TrRow*TrPitch) and (y<=yTroop+55) then 5387 begin 5388 i:=(x-xTroop-1) div TrPitch; 5389 if trix[i]>=0 then 5390 if ClientMode=cEditMap then begin BrushType:=trix[i]; PanelPaint end 5391 else if (TroopLoc>=0) then 5392 if MyMap[TroopLoc] and fOwned<>0 then 5393 begin 5394 if ssShift in Shift then 5395 UnitStatDlg.ShowNewContent_OwnModel(wmPersistent, MyUn[trix[i]].mix) 5396 else if not supervising and (ClientMode<scContact) 5397 and (x-xTroop-1-i*TrPitch>=60-20) and (y>=yTroop+35) 5398 and ((MyUn[trix[i]].Job>jNone) 5399 or (MyUn[trix[i]].Status and (usStay or usRecover or usGoto)<>0)) then 5400 begin // wake up 5401 MyUn[trix[i]].Status:=MyUn[trix[i]].Status 5402 and ($FFFF-usStay-usRecover-usGoto-usEnhance) or usWaiting; 5403 if MyUn[trix[i]].Job>jNone then 5404 Server(sStartJob+jNone shl 4,me,trix[i],nil^); 5405 if (UnFocus<0) and not CityDlg.Visible then 5406 begin 5407 SetUnFocus(trix[i]); 5408 SetTroopLoc(MyUn[trix[i]].Loc); 5409 FocusOnLoc(TroopLoc,flRepaintPanel) 5410 end 5411 else 5412 begin 5413 if CityDlg.Visible and (CityDlg.RestoreUnFocus<0) then 5414 CityDlg.RestoreUnFocus:=trix[i]; 5415 PanelPaint; 5416 end 5417 end 5418 else if (ClientMode<scContact) then 5419 begin 5420 if supervising then 5421 UnitStatDlg.ShowNewContent_OwnUnit(wmPersistent, trix[i]) 5422 else if CityDlg.Visible then 5423 begin 5424 CityDlg.CloseAction:=None; 5425 CityDlg.Close; 5426 SumCities(TaxSum,ScienceSum); 5427 SetUnFocus(trix[i]); 5428 end 5429 else 5430 begin 5431 DestinationMarkON:=false; 5432 PaintDestination; 5433 UnFocus:=trix[i]; 5434 UnStartLoc:=TroopLoc; 5435 BlinkTime:=0; 5436 BlinkOn:=false; 5437 PaintLoc(TroopLoc); 5438 end; 5439 if UnFocus>=0 then 5440 begin 5441 UnitInfoBtn.Visible:=true; 5442 UnitBtn.Visible:=true; 5443 TurnComplete:=false; 5444 EOT.ButtonIndex:=eotGray; 5445 end; 5446 CheckTerrainBtnVisible; 5447 PanelPaint; 5448 end 5449 end 5450 else if Server(sGetUnits,me,TroopLoc,TrCnt)>=rExecuted then 5451 if ssShift in Shift then 5452 UnitStatDlg.ShowNewContent_EnemyModel(wmPersistent, 5453 MyRO.EnemyUn[MyRO.nEnemyUn+trix[i]].emix) // model info 5454 else UnitStatDlg.ShowNewContent_EnemyUnit(wmPersistent, 5455 MyRO.nEnemyUn+trix[i]); // unit info 5456 end 5457 end 5458 end; 5459 5460 procedure TMainScreen.SetTroopLoc(Loc:integer); 5461 var 5462 trixFocus,uix,uixDefender: integer; 5463 Prio: boolean; 5464 begin 5465 TroopLoc:=Loc; 5466 TrRow:=(xRightPanel+10-xTroop-GetSystemMetrics(SM_CXVSCROLL)-19) div TrPitch; 5467 TrCnt:=0; 5468 trixFocus:=-1; 5469 if ClientMode=cEditMap then TrCnt:=nBrushTypes 5470 else if (Loc>=0) and (MyMap[Loc] and fUnit<>0) then 5471 if MyMap[Loc] and fOwned<>0 then 5472 begin // count own units here 5473 Server(sGetDefender,me,TroopLoc,uixDefender); 5474 for Prio:=true downto false do 5475 for uix:=0 to MyRO.nUn-1 do 5476 if ((uix=uixDefender)=Prio) and (MyUn[uix].Loc=Loc) then 5477 begin 5478 if uix=UnFocus then trixFocus:=TrCnt; 5479 inc(TrCnt); 5480 end 5481 end 5482 else // count enemy units here 5483 Server(sGetUnits,me,Loc,TrCnt); 5484 if TrCnt=0 then InitPVSB(sb,0,1) 5485 else 5486 begin 5487 InitPVSB(sb,(TrCnt+TrRow-1) div TrRow-1,1); 5488 with sb.si do if (nMax>=integer(nPage)) and (trixFocus>=0) then 5489 begin 5490 sb.si.npos:=trixFocus div TrRow; 5491 sb.si.FMask:=SIF_POS; 5492 SetScrollInfo(sb.h,SB_CTL,sb.si,true); 5493 end 5494 end 5495 end; 5496 5497 (*procedure TMainScreen.ShowMoveHint(ToLoc: integer; Force: boolean = false); 5498 var 5499 Step,Loc,x0,y0,xs,ys: integer; 5500 Info: string; 5501 InfoSize: TSize; 5502 MoveAdvice: TMoveAdviceData; 5503 begin 5504 if (ToLoc<0) or (ToLoc>=G.lx*G.ly) 5505 or (UnFocus<0) or (MyUn[UnFocus].Loc=ToLoc) then 5506 ToLoc:=-1 5507 else 5508 begin 5509 MoveAdvice.ToLoc:=ToLoc; 5510 MoveAdvice.MoreTurns:=0; 5511 MoveAdvice.MaxHostile_MovementLeft:=MyUn[UnFocus].Health-50; 5512 if Server(sGetMoveAdvice,me,UnFocus,MoveAdvice)<rExecuted then 5513 ToLoc:=-1 5514 end; 5515 if (ToLoc=MoveHintToLoc) and not Force then exit; 5516 if (ToLoc<>MoveHintToLoc) and (MoveHintToLoc>=0) then 5517 begin invalidate; update end; // clear old hint from screen 5518 MoveHintToLoc:=ToLoc; 5519 if ToLoc<0 then exit; 5520 5521 with canvas do 5522 begin 5523 Pen.Color:=$80C0FF; 5524 Pen.Width:=3; 5525 Loc:=MyUn[UnFocus].Loc; 5526 for Step:=0 to MoveAdvice.nStep do 5527 begin 5528 y0:=(Loc+G.lx*1024) div G.lx -1024; 5529 x0:=(Loc+(y0 and 1+G.lx*1024) div 2) mod G.lx; 5530 xs:=(x0-xw)*66+y0 and 1*33-G.lx*66; 5531 while abs(2*(xs+G.lx*66)-MapWidth)<abs(2*xs-MapWidth) do 5532 inc(xs,G.lx*66); 5533 ys:=(y0-yw)*16; 5534 if Step=0 then moveto(xs+33,ys+16) 5535 else lineto(xs+33,ys+16); 5536 if Step<MoveAdvice.nStep then 5537 Loc:=dLoc(Loc,MoveAdvice.dx[Step],MoveAdvice.dy[Step]); 5538 end; 5539 Brush.Color:=$80C0FF; 5540 Info:=' '+inttostr(88)+' '; 5541 InfoSize:=TextExtent(Info); 5542 TextOut(xs+33-InfoSize.cx div 2, ys+16-InfoSize.cy div 2, Info); 5543 Brush.Style:=bsClear; 5544 end 5545 end;*) 5546 5547 procedure TMainScreen.SetDebugMap(p: integer); 5548 begin 5549 IsoEngine.pDebugMap:=p; 5550 IsoEngine.Options:=IsoEngine.Options and not (1 shl moLocCodes); 5551 mLocCodes.Checked:=false; 5552 MapValid:=false; 5553 MainOffscreenPaint; 5554 end; 5555 5556 procedure TMainScreen.SetViewpoint(p: integer); 5557 var 5558 i: integer; 5559 begin 5560 if supervising and (G.RO[0].Turn>0) 5561 and ((p=0) or (1 shl p and G.RO[0].Alive<>0)) then 5562 begin 5563 for i:=0 to Screen.FormCount-1 do 5564 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then 5565 Screen.Forms[i].Close; // close windows 5566 ItsMeAgain(p); 5567 SumCities(TaxSum,ScienceSum); 5568 for i:=0 to MyRO.nModel-1 do 5569 if Tribe[me].ModelPicture[i].HGr=0 then 5570 InitMyModel(i,true); 5571 5572 SetTroopLoc(-1); 5573 PanelPaint; 5574 MapValid:=false; 5575 PaintAllMaps; 5576 end 5577 end; 5578 5579 procedure TMainScreen.FormKeyDown(Sender:TObject;var Key:word; 5580 Shift:TShiftState); 5581 5582 procedure MenuClick_Check(Popup: TPopupMenu; Item: TMenuItem); 5583 begin 5584 InitPopup(Popup); 5585 if Item.Visible and Item.Enabled then MenuClick(Item); 5586 end; 5587 5588 var 5589 dx,dy: integer; 5590 time0,time1: int64; 5591 begin 5592 if GameMode=cMovie then 5593 begin 5594 case Key of 5595 VK_F4: MenuClick_Check(StatPopup,mScienceStat); 5596 VK_F6: MenuClick_Check(StatPopup,mDiagram); 5597 VK_F7: MenuClick_Check(StatPopup,mWonders); 5598 VK_F8: MenuClick_Check(StatPopup,mShips); 5599 end; 5600 exit; 5601 end; 5602 5603 if not idle then exit; 5604 5605 if ClientMode=cEditMap then 5606 begin 5607 if Shift=[ssCtrl] then 5608 case char(Key) of 5609 (* 'A': 5610 begin // auto symmetry 5611 Server($7F0,me,0,nil^); 5612 MapValid:=false; 5613 PaintAll; 5614 end; 5615 'B': 5616 begin // land mass 5617 dy:=0; 5618 for dx:=G.lx to G.lx*(G.ly-1)-1 do 5619 if MyMap[dx] and fTerrain>=fGrass then inc(dy); 5620 dy:=dy 5621 end;*) 5622 'Q':MenuClick(mResign); 5623 'R':MenuClick(mRandomMap); 5624 end 5625 else if Shift=[] then 5626 case char(Key) of 5627 char(VK_F1): MenuClick(mHelp); 5628 end; 5629 exit; 5630 end; 5631 5632 if Shift=[ssAlt] then 5633 case char(Key) of 5634 '0': SetDebugMap(-1); 5635 '1'..'9': SetDebugMap(ord(Key)-48); 5636 end 5637 else if Shift=[ssCtrl] then 5638 case char(Key) of 5639 'J':MenuClick(mJump); 5640 'K':mShowClick(mDebugMap); 5641 'L':mShowClick(mLocCodes); 5642 'M':if LogDlg.Visible then LogDlg.Close else LogDlg.Show; 5643 'N':mNamesClick(mNames); 5644 'Q':MenuClick_Check(GamePopup,mResign); 5645 'R':MenuClick(mRun); 5646 '0'..'9': 5647 begin 5648 if ord(Key)-48=me then 5649 SetViewpoint(0) 5650 else SetViewpoint(ord(Key)-48); 5651 end; 5652 ' ': 5653 begin // test map repaint time 5654 QueryPerformanceCounter(time0); 5655 MapValid:=false; 5656 MainOffscreenPaint; 5657 QueryPerformanceCounter(time1); 5658 SimpleMessage(Format('Map repaint time: %.3f ms',[{$IFDEF VER100}(time1.LowPart-time0.LowPart) 5659 {$ELSE}(time1-time0){$ENDIF}*1000.0/PerfFreq])); 5660 end 5661 end 5662 else if Shift=[] then 5663 case char(Key) of 5664 char(VK_F1): MenuClick(mHelp); 5665 char(VK_F2):MenuClick_Check(StatPopup,mUnitStat); 5666 char(VK_F3):MenuClick_Check(StatPopup,mCityStat); 5667 char(VK_F4):MenuClick_Check(StatPopup,mScienceStat); 5668 char(VK_F5):MenuClick_Check(StatPopup,mEUnitStat); 5669 char(VK_F6):MenuClick_Check(StatPopup,mDiagram); 5670 char(VK_F7):MenuClick_Check(StatPopup,mWonders); 5671 char(VK_F8):MenuClick_Check(StatPopup,mShips); 5672 char(VK_F9):MenuClick_Check(StatPopup,mNations); 5673 char(VK_F10):MenuClick_Check(StatPopup,mEmpire); 5674 char(VK_ADD): EndTurn; 5675 '1':MapBtnClick(MapBtn0); 5676 '2':MapBtnClick(MapBtn1); 5677 '3':MapBtnClick(MapBtn4); 5678 '4':MapBtnClick(MapBtn5); 5679 '5':MapBtnClick(MapBtn6); 5680 'T':MenuClick(mTechTree); 5681 'W':MenuClick(mWait); 5682 end; 5683 5684 if UnFocus>=0 then 5685 if Shift=[ssCtrl] then 5686 case char(Key) of 5687 'C':MenuClick_Check(UnitPopup,mCancel); 5688 'D':MenuClick(mDisband); 5689 'P':MenuClick_Check(UnitPopup,mPillage); 5690 'T':MenuClick_Check(UnitPopup,mSelectTransport); 5691 end 5692 else if Shift=[] then 5693 case char(Key) of 5694 ' ':MenuClick(mNoOrders); 5695 'A':MenuClick_Check(TerrainPopup,mAirBase); 5696 'B':MenuClick_Check(UnitPopup,mCity); 5697 'C':MenuClick(mCentre); 5698 'E': 5699 begin 5700 InitPopup(TerrainPopup); 5701 if mEnhance.Visible and mEnhance.Enabled then MenuClick(mEnhance) 5702 else MenuClick(mEnhanceDef) 5703 end; 5704 'F':MenuClick_Check(TerrainPopup,mFort); 5705 'G':MenuClick_Check(UnitPopup,mGoOn); 5706 'H':MenuClick_Check(UnitPopup,mHome); 5707 'I': 5708 if JobTest(UnFocus,jFarm,[eTreaty]) then MenuClick(mFarm) 5709 else if JobTest(UnFocus,jClear,[eTreaty]) then MenuClick(mClear) 5710 else MenuClick_Check(TerrainPopup,mIrrigation); 5711 'L':MenuClick_Check(UnitPopup,mLoad); 5712 'M': 5713 if JobTest(UnFocus,jAfforest,[eTreaty]) then MenuClick(mAfforest) 5714 else MenuClick_Check(TerrainPopup,mMine); 5715 'N':MenuClick_Check(TerrainPopup,mCanal); 5716 'O':MenuClick_Check(TerrainPopup,mTrans); 5717 'P':MenuClick_Check(TerrainPopup,mPollution); 5718 'R': 5719 if JobTest(UnFocus,jRR,[eTreaty]) then MenuClick(mRR) 5720 else MenuClick_Check(TerrainPopup,mRoad); 5721 'S':MenuClick(mStay); 5722 'U':MenuClick_Check(UnitPopup,mUnload); 5723 'V':MenuClick_Check(UnitPopup,mRecover); 5724 'Z':MenuClick_Check(UnitPopup,mUtilize); 5725 #33..#40,#97..#100,#102..#105: 5726 begin {arrow keys} 5727 DestinationMarkON:=false; 5728 PaintDestination; 5729 MyUn[UnFocus].Status:=MyUn[UnFocus].Status 5730 and ($FFFF-usStay-usRecover-usGoto-usEnhance) or usWaiting; 5731 case Key of 5732 VK_NUMPAD1,VK_END: begin dx:=-1; dy:=1 end; 5733 VK_NUMPAD2,VK_DOWN: begin dx:=0; dy:=2 end; 5734 VK_NUMPAD3,VK_NEXT: begin dx:=1; dy:=1 end; 5735 VK_NUMPAD4,VK_LEFT: begin dx:=-2; dy:=0 end; 5736 VK_NUMPAD6,VK_RIGHT: begin dx:=2; dy:=0 end; 5737 VK_NUMPAD7,VK_HOME: begin dx:=-1; dy:=-1 end; 5738 VK_NUMPAD8,VK_UP: begin dx:=0; dy:=-2 end; 5739 VK_NUMPAD9,VK_PRIOR: begin dx:=1; dy:=-1 end; 5740 end; 5741 MoveUnit(dx,dy,muAutoNext) 5742 end; 5743 end 5744 end; 5745 5746 procedure TMainScreen.MenuClick(Sender:TObject); 5747 5748 function DoJob(j0:integer): integer; 5749 var 5750 Loc0, Movement0: integer; 5751 begin 5752 with MyUn[UnFocus] do 5753 begin 5754 DestinationMarkON:=false; 5755 PaintDestination; 5756 Loc0:=Loc; 5757 Movement0:=Movement; 5758 if j0<0 then result:=ProcessEnhancement(UnFocus,MyData.EnhancementJobs) // terrain enhancement 5759 else result:=Server(sStartJob+j0 shl 4,me,UnFocus,nil^); 5760 if result>=rExecuted then 5761 begin 5762 if result=eDied then UnFocus:=-1; 5763 PaintLoc(Loc0); 5764 if UnFocus>=0 then 5765 begin 5766 if (j0<0) and (result<>eJobDone) then // multi-turn terrain enhancement 5767 Status:=Status and ($FFFF-usStay-usRecover-usGoto) or usEnhance 5768 else Status:=Status and ($FFFF-usStay-usRecover-usGoto-usEnhance); 5769 if (Job<>jNone) or (Movement0<100) then 5770 begin 5771 Status:=Status and not usWaiting; 5772 NextUnit(UnStartLoc,true); 5773 end 5774 else PanelPaint 5775 end 5776 else NextUnit(UnStartLoc,true); 5777 end 5778 end; 5779 case result of 5780 eNoBridgeBuilding: SoundMessage(Phrases.Lookup('NOBB'),'INVALID'); 5781 eNoCityTerrain: SoundMessage(Phrases.Lookup('NOCITY'),'INVALID'); 5782 eTreaty: SoundMessage(Tribe[MyRO.Territory[Loc0]].TPhrase('PEACE_NOWORK'),'NOMOVE_TREATY'); 5783 else if result<rExecuted then Play('INVALID') 5784 end 5785 end; 5786 5787 var 5788 i,uix,NewFocus,Loc0,OldMaster,Destination,cix,cixOldHome,ServerResult: integer; 5789 AltGovs,changed: boolean; 5790 QueryText: string; 5791 5792 begin 5793 if Sender=mResign then 5794 if ClientMode=cEditMap then 5795 begin 5796 if Edited then 5797 begin 5798 QueryText:=Phrases.Lookup('MAP_CLOSE'); 5799 case SimpleQuery(mkYesNoCancel,QueryText,'') of 5800 mrIgnore: 5801 Server(sAbandonMap,me,0,nil^); 5802 mrOK: 5803 Server(sSaveMap,me,0,nil^); 5804 end 5805 end 5806 else Server(sAbandonMap,me,0,nil^) 5807 end 5808 else 5809 begin 5810 if Server(sGetGameChanged,0,0,nil^)=eOK then 5811 begin 5812 QueryText:=Phrases.Lookup('RESIGN'); 5813 case SimpleQuery(mkYesNoCancel,QueryText,'') of 5814 mrIgnore: 5815 Server(sResign,0,0,nil^); 5816 mrOK: 5817 Server(sBreak,0,0,nil^) 5818 end 5819 end 5820 else Server(sResign,0,0,nil^) 5821 end 5822 else if Sender=mEmpire then 5823 RatesDlg.ShowNewContent(wmPersistent) 5824 else if Sender=mRevolution then 5825 begin 5826 AltGovs:=false; 5827 for i:=2 to nGov-1 do 5828 if (GovPreq[i]<>preNA) and ((GovPreq[i]=preNone) 5829 or (MyRO.Tech[GovPreq[i]]>=tsApplicable)) then 5830 AltGovs:=true; 5831 5832 if not AltGovs then 5833 SoundMessage(Phrases.Lookup('NOALTGOVS'),'MSG_DEFAULT') 5834 else 5835 begin 5836 changed:=false; 5837 if MyRO.Happened and phChangeGov<>0 then 5838 begin 5839 ModalSelectDlg.ShowNewContent(wmModal,kGov); 5840 if ModalSelectDlg.result>=0 then 5841 begin 5842 Play('NEWGOV'); 5843 Server(sSetGovernment,me,ModalSelectDlg.result,nil^); 5844 CityOptimizer_BeginOfTurn; 5845 changed:=true; 5846 end 5847 end 5848 else with MessgExDlg do 5849 begin // revolution! 5850 MessgText:=Tribe[me].TPhrase('REVOLUTION'); 5851 Kind:=mkYesNo; 5852 IconKind:=mikPureIcon; 5853 IconIndex:=72; // anarchy palace 5854 ShowModal; 5855 if ModalResult=mrOK then 5856 begin 5857 Play('REVOLUTION'); 5858 Server(sRevolution,me,0,nil^); 5859 changed:=true; 5860 if NatStatDlg.Visible then NatStatDlg.Close; 5861 if CityDlg.Visible then CityDlg.Close; 5862 end 5863 end; 5864 if changed then 5865 UpdateViews(true); 5866 end 5867 end 5868 else if Sender=mWebsite then 5869 ShellExecute(Handle,'open','http://c-evo.org','','',SW_SHOWNORMAL) 5870 else if Sender=mRandomMap then 5871 begin 5872 if not Edited or (SimpleQuery(mkYesNo,Phrases.Lookup('MAP_RANDOM'),'')=mrOK) then 5873 begin 5874 Server(sRandomMap,me,0,nil^); 5875 Edited:=true; 5876 MapValid:=false; 5877 PaintAllMaps; 5878 end 5879 end 5880 else if Sender=mJump then 5881 begin 5882 if supervising then 5883 Jump[0]:=20 5884 else Jump[me]:=20; 5885 EndTurn(true); 5886 end 5887 else if Sender=mRun then 5888 begin 5889 if supervising then 5890 Jump[0]:=999999 5891 else Jump[me]:=999999; 5892 EndTurn(true); 5893 end 5894 else if Sender=mEnhanceDef then 5895 begin 5896 if UnFocus>=0 then 5897 EnhanceDlg.ShowNewContent(wmPersistent, MyMap[MyUn[UnFocus].Loc] and fTerrain) 5898 else EnhanceDlg.ShowNewContent(wmPersistent) 5899 end 5900 else if Sender=mCityTypes then 5901 CityTypeDlg.ShowNewContent(wmModal) // must be modal because types are not saved before closing 5902 else if Sender=mUnitStat then 5903 begin 5904 if G.Difficulty[me]>0 then 5905 ListDlg.ShowNewContent_MilReport(wmPersistent,me) 5906 else 5907 begin 5908 i:=1; 5909 while (i<nPl) and (1 shl i and MyRO.Alive=0) do inc(i); 5910 if i<nPl then 5911 ListDlg.ShowNewContent_MilReport(wmPersistent,i); 5912 end; 5913 end 5914 else if Sender=mEUnitStat then 5915 begin 5916 if MyRO.nEnemyModel>0 then 5917 ListDlg.ShowNewContent(wmPersistent,kAllEModels); 5918 end 5919 else if Sender=mCityStat then 5920 ListDlg.ShowNewContent(wmPersistent,kCities) 5921 else if Sender=mScienceStat then 5922 ListDlg.ShowNewContent(wmPersistent,kScience) 5923 else if Sender=mNations then 5924 NatStatDlg.ShowNewContent(wmPersistent) 5925 else if Sender=mHelp then 5926 if ClientMode=cEditMap then 5927 HelpDlg.ShowNewContent(wmPersistent, hkText, HelpDlg.TextIndex('MAPEDIT')) 5928 else HelpDlg.ShowNewContent(wmPersistent, hkMisc, miscMain) 5929 else if Sender=mTechTree then 5930 TechTreeDlg.ShowModal 5931 else if Sender=mWonders then 5932 WondersDlg.ShowNewContent(wmPersistent) 5933 else if Sender=mDiagram then 5934 DiaDlg.ShowNewContent_Charts(wmPersistent) 5935 else if Sender=mShips then 5936 DiaDlg.ShowNewContent_Ship(wmPersistent) 5937 else if Sender=mWait then 5938 begin 5939 if UnFocus>=0 then 5940 begin 5941 DestinationMarkON:=false; 5942 PaintDestination; 5943 MyUn[UnFocus].Status:=MyUn[UnFocus].Status and ($FFFF-usStay-usRecover-usGoto-usEnhance) or usWaiting; 5944 end; 5945 NextUnit(-1,false); 5946 end 5947 else if UnFocus>=0 then with MyUn[UnFocus] do 5948 if Sender=mGoOn then 5949 begin 5950 if Status shr 16=$7FFF then Destination:=maNextCity 5951 else Destination:=Status shr 16; 5952 Status:=Status and not (usStay or usRecover) or usWaiting; 5953 MoveToLoc(Destination,true); 5954 end 5955 else if Sender=mHome then 5956 if MyMap[Loc] and fCity<>0 then 5957 begin 5958 cixOldHome:=Home; 5959 if Server(sSetUnitHome,me,UnFocus,nil^)>=rExecuted then 5960 begin 5961 CityOptimizer_CityChange(cixOldHome); 5962 CityOptimizer_CityChange(Home); 5963 UpdateViews(true); 5964 end 5965 else Play('INVALID'); 5966 end 5967 else 5968 begin 5969 Status:=Status and not (usStay or usRecover or usEnhance); 5970 MoveToLoc(maNextCity,true) 5971 end 5972 else if Sender=mCentre then begin Centre(Loc); PaintAllMaps end 5973 else if Sender=mCity then 5974 begin 5975 Loc0:=Loc; 5976 if MyMap[Loc] and fCity=0 then 5977 begin // build city 5978 if DoJob(jCity)=eCity then 5979 begin 5980 MapValid:=false; 5981 PaintAll; 5982 ZoomToCity(Loc0,true,chFounded); 5983 end 5984 end 5985 else 5986 begin 5987 CityOptimizer_BeforeRemoveUnit(UnFocus); 5988 ServerResult:=Server(sAddToCity,me,UnFocus,nil^); 5989 if ServerResult>=rExecuted then 5990 begin 5991 cix:=MyRO.nCity-1; 5992 while (cix>=0) and (MyCity[cix].Loc<>Loc0) do 5993 dec(cix); 5994 assert(cix>=0); 5995 CityOptimizer_CityChange(cix); 5996 CityOptimizer_AfterRemoveUnit; // does nothing here 5997 SetTroopLoc(Loc0); 5998 UpdateViews(true); 5999 DestinationMarkON:=false; 6000 PaintDestination; 6001 UnFocus:=-1; 6002 PaintLoc(Loc0); 6003 NextUnit(UnStartLoc,true); 6004 end 6005 else if ServerResult=eMaxSize then 6006 SimpleMessage(Phrases.Lookup('ADDTOMAXSIZE')); 6007 end 6008 end 6009 else if Sender=mRoad then DoJob(jRoad) 6010 else if Sender=mRR then DoJob(jRR) 6011 else if Sender=mClear then DoJob(jClear) 6012 else if Sender=mIrrigation then DoJob(jIrr) 6013 else if Sender=mFarm then DoJob(jFarm) 6014 else if Sender=mAfforest then DoJob(jAfforest) 6015 else if Sender=mMine then DoJob(jMine) 6016 else if Sender=mCanal then DoJob(jCanal) 6017 else if Sender=MTrans then DoJob(jTrans) 6018 else if Sender=mFort then DoJob(jFort) 6019 else if Sender=mAirBase then DoJob(jBase) 6020 else if Sender=mPollution then DoJob(jPoll) 6021 else if Sender=mPillage then DoJob(jPillage) 6022 else if Sender=mEnhance then DoJob(-1) 6023 else if Sender=mStay then 6024 begin 6025 DestinationMarkON:=false; 6026 PaintDestination; 6027 Status:=Status and ($FFFF-usRecover-usGoto-usEnhance) or usStay; 6028 if Job>jNone then 6029 Server(sStartJob+jNone shl 4,me,UnFocus,nil^); 6030 NextUnit(UnStartLoc,true) 6031 end 6032 else if Sender=mRecover then 6033 begin 6034 DestinationMarkON:=false; 6035 PaintDestination; 6036 Status:=Status and ($FFFF-usStay-usGoto-usEnhance) or usRecover; 6037 if Job>jNone then 6038 Server(sStartJob+jNone shl 4,me,UnFocus,nil^); 6039 NextUnit(UnStartLoc,true) 6040 end 6041 else if Sender=mNoOrders then 6042 begin 6043 Status:=Status and not usWaiting; 6044 NextUnit(UnStartLoc,true) 6045 end 6046 else if Sender=mCancel then 6047 begin 6048 DestinationMarkON:=false; 6049 PaintDestination; 6050 Status:=Status and ($FFFF-usRecover-usGoto-usEnhance); 6051 if Job>jNone then 6052 Server(sStartJob+jNone shl 4,me,UnFocus,nil^); 6053 end 6054 else if (Sender=mDisband) or (Sender=mUtilize) then 6055 begin 6056 if (Sender=mUtilize) 6057 and not (Server(sRemoveUnit-sExecute,me,UnFocus,nil^)=eUtilized) then 6058 begin 6059 SimpleMessage(Phrases2.Lookup('SHIP_UTILIZE')); 6060 // freight for colony ship is the only case in which the command is 6061 // available to player though not valid 6062 exit 6063 end; 6064 if (Sender=mUtilize) and (Health<100) then 6065 if SimpleQuery(mkYesNo,Phrases.Lookup('DAMAGED_UTILIZE'),'')<>mrOK then 6066 exit; 6067 Loc0:=Loc; 6068 CityOptimizer_BeforeRemoveUnit(UnFocus); 6069 if Server(sRemoveUnit,me,UnFocus,nil^)=eUtilized then Play('CITY_UTILIZE') 6070 else Play('DISBAND'); 6071 CityOptimizer_AfterRemoveUnit; 6072 SetTroopLoc(Loc0); 6073 UpdateViews(true); 6074 DestinationMarkON:=false; 6075 PaintDestination; 6076 UnFocus:=-1; 6077 PaintLoc(Loc0); 6078 NextUnit(UnStartLoc,true); 6079 end 6080 else if Sender=mLoad then 6081 begin 6082 i:=Server(sLoadUnit,me,UnFocus,nil^); 6083 if i>=rExecuted then 6084 begin 6085 if MyModel[mix].Domain=dAir then Play('MOVE_PLANELANDING') 6086 else Play('MOVE_LOAD'); 6087 DestinationMarkON:=false; 6088 PaintDestination; 6089 Status:=Status and ($FFFF-usWaiting-usStay-usRecover-usGoto-usEnhance); 6090 NextUnit(UnStartLoc,true); 6091 end 6092 else if i=eNoTime_Load then 6093 if MyModel[mix].Domain=dAir then 6094 SoundMessage(Phrases.Lookup('NOTIMELOADAIR'),'NOMOVE_TIME') 6095 else 6096 SoundMessage(Format(Phrases.Lookup('NOTIMELOADGROUND'), 6097 [MovementToString(MyModel[mix].Speed)]),'NOMOVE_TIME'); 6098 end 6099 else if Sender=mUnload then 6100 if Master>=0 then 6101 begin 6102 OldMaster:=Master; 6103 i:=Server(sUnloadUnit,me,UnFocus,nil^); 6104 if i>=rExecuted then 6105 begin 6106 if MyModel[mix].Domain=dAir then Play('MOVE_PLANESTART') 6107 else if (MyModel[MyUn[OldMaster].mix].Domain=dAir) 6108 and (MyMap[Loc] and fCity=0) and (MyMap[Loc] and fTerImp<>tiBase) then 6109 Play('MOVE_PARACHUTE') 6110 else Play('MOVE_UNLOAD'); 6111 Status:=Status and not usWaiting; 6112 if MyModel[mix].Domain<>dAir then NextUnit(Loc,true) 6113 else PanelPaint 6114 end 6115 else if i=eNoTime_Load then 6116 if MyModel[mix].Domain=dAir then 6117 SoundMessage(Phrases.Lookup('NOTIMELOADAIR'),'NOMOVE_TIME') 6118 else 6119 SoundMessage(Format(Phrases.Lookup('NOTIMELOADGROUND'), 6120 [MovementToString(MyModel[mix].Speed)]),'NOMOVE_TIME'); 6121 end 6122 else 6123 begin 6124 NewFocus:=-1; 6125 uix:=UnFocus; 6126 for i:=1 to MyRo.nUn-1 do 6127 begin 6128 uix:=(uix+MyRO.nUn-1) mod MyRO.nUn; 6129 if (MyUn[uix].Master=UnFocus) 6130 and (MyUn[uix].Movement=integer(MyModel[MyUn[uix].mix].Speed)) then 6131 begin 6132 MyUn[uix].Status:=MyUn[uix].Status or usWaiting; 6133 NewFocus:=uix 6134 end; 6135 end; 6136 if NewFocus>=0 then 6137 begin 6138 SetUnFocus(NewFocus); 6139 SetTroopLoc(Loc); 6140 PanelPaint 6141 end 6142 end 6143 else if Sender=mSelectTransport then 6144 Server(sSelectTransport,me,UnFocus,nil^) 6145 end; 6146 6147 procedure TMainScreen.InitPopup(Popup: TPopupMenu); 6148 var 6149 i,p1,Tile,Test: integer; 6150 NoSuper,extended,Multi,NeedSep,HaveCities: boolean; 6151 LastSep,m: TMenuItem; 6152 mox: ^TModel; 6153 begin 6154 NoSuper:=not supervising and (1 shl me and MyRO.Alive<>0); 6155 HaveCities:=false; 6156 for i:=0 to MyRO.nCity-1 do if MyCity[i].Loc>=0 then 6157 begin HaveCities:=true; Break end; 6158 if Popup=GamePopup then 6159 begin 6160 mTechTree.Visible:= ClientMode<>cEditMap; 6161 mResign.Enabled:= supervising or (me=0) and (ClientMode<scContact); 6162 mRandomMap.Visible:= (ClientMode=cEditMap) 6163 and (Server(sMapGeneratorRequest,me,0,nil^)=eOk); 6164 mOptions.Visible:= ClientMode<>cEditMap; 6165 mManip.Visible:= ClientMode<>cEditMap; 6166 if ClientMode<>cEditMap then 6167 begin 6168 mWaitTurn.Visible:= NoSuper; 6169 mRep.Visible:= NoSuper; 6170 mRepList.Visible:= NoSuper; 6171 mRepScreens.Visible:= NoSuper; 6172 N10.Visible:= NoSuper; 6173 mOwnMovement.Visible:= NoSuper; 6174 mAllyMovement.Visible:= NoSuper; 6175 case SoundMode of 6176 smOff: mSoundOff.Checked:=true; 6177 smOn: mSoundOn.Checked:=true; 6178 smOnAlt: mSoundOnAlt.Checked:=true; 6179 end; 6180 6181 for i:=0 to nTestFlags-1 do 6182 mManip[i].Checked:= MyRO.TestFlags and (1 shl i)<>0; 6183 mManip.Enabled:= supervising or (me=0); 6184 6185 Multi:=false; 6186 for p1:=1 to nPl-1 do 6187 if G.RO[p1]<>nil then Multi:=true; 6188 mEnemyMovement.Visible:=not Multi; 6189 end; 6190 mMacro.Visible:= NoSuper and (ClientMode<scContact); 6191 if NoSuper and (ClientMode<scContact) then 6192 begin 6193 mCityTypes.Enabled:=false; 6194 // check if city types already usefull: 6195 if MyRO.nCity>0 then 6196 for i:=28 to nImp-1 do 6197 if (i<>imTrGoods) and (Imp[i].Kind=ikCommon) and (Imp[i].Preq<>preNA) 6198 and ((Imp[i].Preq=preNone) or (MyRO.Tech[Imp[i].Preq]>=tsApplicable)) then 6199 begin mCityTypes.Enabled:=true; Break end; 6200 end; 6201 mViewpoint.visible:=(ClientMode<>cEditMap) and supervising; 6202 mViewpoint.enabled:= G.RO[0].Turn>0; 6203 if supervising then 6204 begin 6205 EmptyMenu(mViewpoint); 6206 for p1:=0 to nPl-1 do 6207 if (p1=0) or (1 shl p1 and G.RO[0].Alive<>0) then 6208 begin 6209 m:=TMenuItem.Create(mViewpoint); 6210 if p1=0 then 6211 m.Caption:=Phrases.Lookup('SUPER') 6212 else m.Caption:=Tribe[p1].TString(Phrases2.Lookup('BELONG')); 6213 m.Tag:=p1; 6214 m.OnClick:=ViewPointClick; 6215 if p1<10 then 6216 m.ShortCut:=Shortcut(48+p1, [ssCtrl]); 6217 m.RadioItem:=true; 6218 if p1=me then 6219 m.Checked:=true; 6220 mViewPoint.Add(m); 6221 end 6222 end; 6223 mDebugMap.visible:=(ClientMode<>cEditMap) and supervising; 6224 if supervising then 6225 begin 6226 EmptyMenu(mDebugMap); 6227 for p1:=0 to nPl-1 do 6228 if (p1=0) or (1 shl p1 and G.RO[0].Alive<>0) then 6229 begin 6230 m:=TMenuItem.Create(mDebugMap); 6231 if p1=0 then 6232 m.Caption:=Phrases2.Lookup('MENU_DEBUGMAPOFF') 6233 else m.Caption:=Tribe[p1].TString(Phrases2.Lookup('BELONG')); 6234 if p1=0 then 6235 m.Tag:=-1 6236 else m.Tag:=p1; 6237 m.OnClick:=DebugMapClick; 6238 if p1<10 then 6239 m.ShortCut:=Shortcut(48+p1, [ssAlt]); 6240 m.RadioItem:=true; 6241 if m.Tag=IsoEngine.pDebugMap then 6242 m.Checked:=true; 6243 mDebugMap.Add(m); 6244 end 6245 end; 6246 mSmallTiles.Checked:= xxt=33; 6247 mNormalTiles.Checked:= xxt=48; 6248 end 6249 else if Popup=StatPopup then 6250 begin 6251 mEmpire.Visible:= NoSuper; 6252 mEmpire.Enabled:= MyRO.Government<>gAnarchy; 6253 mRevolution.Visible:= NoSuper; 6254 mRevolution.Enabled:= (MyRO.Government<>gAnarchy) and (ClientMode<scContact); 6255 mUnitStat.Enabled:= NoSuper or (MyRO.Turn>0); 6256 mCityStat.Visible:= 1 shl me and MyRO.Alive<>0; 6257 mCityStat.Enabled:= HaveCities; 6258 mScienceStat.Visible:= true; 6259 mScienceStat.Enabled:= not NoSuper or (MyRO.ResearchTech>=0) 6260 or (MyRO.Happened and phTech<>0) 6261 or (MyRO.Happened and phGameEnd<>0) // no researchtech in case just completed 6262 or (MyRO.TestFlags and (tfAllTechs or tfUncover or tfAllContact)<>0); 6263 mEUnitStat.Enabled:= MyRO.nEnemyModel>0; 6264 { mWonders.Enabled:= false; 6265 for i:=0 to 27 do if MyRO.Wonder[i].CityID<>-1 then 6266 mWonders.Enabled:=true;} 6267 mDiagram.Enabled:= MyRO.Turn>=2; 6268 mShips.Enabled:=false; 6269 for p1:=0 to nPl-1 do 6270 if MyRO.Ship[p1].Parts[spComp]+MyRO.Ship[p1].Parts[spPow] 6271 +MyRO.Ship[p1].Parts[spHab]>0 then 6272 mShips.Enabled:=true; 6273 end 6274 else if Popup=UnitPopup then 6275 begin 6276 mox:=@MyModel[MyUn[UnFocus].mix]; 6277 Tile:=MyMap[MyUn[UnFocus].Loc]; 6278 extended:=Tile and fCity=0; 6279 if extended then 6280 begin 6281 mCity.Caption:=Phrases.Lookup('BTN_FOUND'); 6282 mHome.Caption:=Phrases.Lookup('BTN_MOVEHOME') 6283 end 6284 else 6285 begin 6286 mCity.Caption:=Phrases.Lookup('BTN_ADD'); 6287 mHome.Caption:=Phrases.Lookup('BTN_SETHOME') 6288 end; 6289 6290 extended:=extended and ((mox.Kind=mkSettler) or (mox.Kind=mkSlaves) 6291 and (MyRO.Wonder[woPyramids].EffectiveOwner>=0)) 6292 and (MyUn[UnFocus].Master<0) and (Tile and fDeadLands=0); 6293 if (mox.Kind=mkFreight) and (Tile and fCity<>0) and not Phrases2FallenBackToEnglish 6294 or (Server(sRemoveUnit-sExecute,me,UnFocus,nil^)=eUtilized) then 6295 begin 6296 mDisband.Visible:=false; 6297 mUtilize.Visible:=true; 6298 if mox.Kind=mkFreight then 6299 mUtilize.Caption:=Phrases.Lookup('UTILIZE') 6300 else mUtilize.Caption:=Phrases.Lookup('INTEGRATE') 6301 end 6302 else begin mDisband.Visible:=true; mUtilize.Visible:=false end; 6303 mGoOn.Visible:= MyUn[UnFocus].Status and (usGoto or usWaiting)=usGoto or usWaiting; 6304 mHome.Visible:=HaveCities; 6305 mRecover.Visible:= (MyUn[UnFocus].Health<100) and (Tile and fTerrain>=fGrass) 6306 and ((MyRO.Wonder[woGardens].EffectiveOwner=me) 6307 or (Tile and fTerrain<>fArctic) and (Tile and fTerrain<>fDesert)) 6308 and not ((mox.Domain=dAir) and (Tile and fCity=0) and (Tile and fTerImp<>tiBase)); 6309 mStay.Visible:= not ((mox.Domain=dAir) and (Tile and fCity=0) and (Tile and fTerImp<>tiBase)); 6310 mCity.Visible:=extended and (mox.Kind=mkSettler) or (Tile and fCity<>0) 6311 and ((mox.Kind in [mkSettler,mkSlaves]) or (MyUn[UnFocus].Flags and unConscripts<>0)); 6312 mPillage.Visible:=(Tile and (fRoad or fRR or fCanal or fTerImp)<>0) 6313 and (MyUn[UnFocus].Master<0) and (mox.Domain=dGround); 6314 mCancel.Visible:=(MyUn[UnFocus].Job>jNone) or (MyUn[UnFocus].Status and (usRecover or usGoto)<>0); 6315 6316 Test:=Server(sLoadUnit-sExecute,me,UnFocus,nil^); 6317 mLoad.Visible:= (Test>=rExecuted) or (Test=eNoTime_Load); 6318 mUnload.Visible:= (MyUn[UnFocus].Master>=0) 6319 or (MyUn[UnFocus].TroopLoad+MyUn[UnFocus].AirLoad>0); 6320 mSelectTransport.Visible:= 6321 Server(sSelectTransport-sExecute,me,UnFocus,nil^)>=rExecuted; 6322 end 6323 else {if Popup=TerrainPopup then} 6324 begin 6325 mox:=@MyModel[MyUn[UnFocus].mix]; 6326 Tile:=MyMap[MyUn[UnFocus].Loc]; 6327 extended:=Tile and fCity=0; 6328 6329 if (Tile and fRiver<>0) and (MyRO.Tech[adBridgeBuilding]>=tsApplicable) then 6330 begin 6331 mRoad.Caption:=Phrases.Lookup('BTN_BUILDBRIDGE'); 6332 mRR.Caption:=Phrases.Lookup('BTN_BUILDRRBRIDGE'); 6333 end 6334 else 6335 begin 6336 mRoad.Caption:=Phrases.Lookup('BTN_BUILDROAD'); 6337 mRR.Caption:=Phrases.Lookup('BTN_BUILDRR'); 6338 end; 6339 if Tile and fTerrain=fForest then 6340 mClear.Caption:=Phrases.Lookup('BTN_CLEAR') 6341 else if Tile and fTerrain=fDesert then 6342 mClear.Caption:=Phrases.Lookup('BTN_UNDESERT') 6343 else mClear.Caption:=Phrases.Lookup('BTN_DRAIN'); 6344 6345 extended:=extended and ((mox.Kind=mkSettler) or (mox.Kind=mkSlaves) 6346 and (MyRO.Wonder[woPyramids].EffectiveOwner>=0)) 6347 and (MyUn[UnFocus].Master<0); 6348 if extended then 6349 begin 6350 mRoad.Visible:= JobTest(UnFocus,jRoad,[eNoBridgeBuilding,eTreaty]); 6351 mRR.Visible:= JobTest(UnFocus,jRR,[eNoBridgeBuilding,eTreaty]); 6352 mClear.Visible:= JobTest(UnFocus,jClear,[eTreaty]); 6353 mIrrigation.Visible:= JobTest(UnFocus,jIrr,[eTreaty]); 6354 mFarm.Visible:= JobTest(UnFocus,jFarm,[eTreaty]); 6355 mAfforest.Visible:= JobTest(UnFocus,jAfforest,[eTreaty]); 6356 mMine.Visible:= JobTest(UnFocus,jMine,[eTreaty]); 6357 MTrans.Visible:= JobTest(UnFocus,jTrans,[eTreaty]); 6358 mCanal.Visible:= JobTest(UnFocus,jCanal,[eTreaty]); 6359 mFort.Visible:= JobTest(UnFocus,jFort,[eTreaty]); 6360 mAirBase.Visible:= JobTest(UnFocus,jBase,[eTreaty]); 6361 mPollution.Visible:=JobTest(UnFocus,jPoll,[eTreaty]); 6362 mEnhance.Visible:= (Tile and fDeadLands=0) 6363 and (MyData.EnhancementJobs[MyMap[MyUn[UnFocus].Loc] and fTerrain,0]<>jNone); 6364 end 6365 else 6366 begin 6367 for i:=0 to Popup.Items.Count-1 do Popup.Items[i].Visible:=false; 6368 end; 6369 end; 6370 6371 // set menu seperators 6372 LastSep:=nil; 6373 needsep:=false; 6374 for i:=0 to Popup.Items.Count-1 do 6375 if Popup.Items[i].Caption='-' then 6376 begin 6377 Popup.Items[i].Visible:=needsep; 6378 if needsep then LastSep:=Popup.Items[i]; 6379 needsep:=false 6380 end 6381 else if Popup.Items[i].Visible then needsep:=true; 6382 if (LastSep<>nil) and not NeedSep then LastSep.Visible:=false 6383 end; 6384 6385 procedure TMainScreen.PanelBtnClick(Sender: TObject); 6386 var 6387 Popup: TPopupMenu; 6388 begin 6389 if Sender=UnitBtn then Popup:=UnitPopup 6390 else {if Sender=TerrainBtn then} Popup:=TerrainPopup; 6391 InitPopup(Popup); 6392 if FullScreen then 6393 Popup.Popup(Left+TControl(Sender).Left,Top+TControl(Sender).Top) 6394 else Popup.Popup(Left+TControl(Sender).Left+4,Top+TControl(Sender).Top 6395 +GetSystemMetrics(SM_CYCAPTION)+4); 6396 end; 6397 6398 procedure TMainScreen.CityClosed(Activateuix: integer; StepFocus: boolean; 6399 SelectFocus: boolean); 6400 begin 6401 if supervising then 6402 begin 6403 SetTroopLoc(-1); 6404 PanelPaint 6405 end 6406 else 6407 begin 6408 if Activateuix>=0 then 6409 begin 6410 SetUnFocus(Activateuix); 6411 SetTroopLoc(MyUn[Activateuix].Loc); 6412 if SelectFocus then FocusOnLoc(TroopLoc,flRepaintPanel) 6413 else PanelPaint 6414 end 6415 else if StepFocus then NextUnit(TroopLoc,true) 6416 else 6417 begin 6418 SetTroopLoc(-1); 6419 PanelPaint 6420 end 6421 end 6422 end; 6423 6424 procedure TMainScreen.Toggle(Sender: TObject); 6425 begin 6426 TMenuItem(Sender).Checked:=not TMenuItem(Sender).Checked 6427 end; 6428 6429 procedure TMainScreen.PanelBoxMouseMove(Sender: TObject; 6430 Shift: TShiftState; x, y: integer); 6431 var 6432 xCentre,yCentre: integer; 6433 begin 6434 if Tracking and (ssLeft in Shift) then 6435 begin 6436 if (x>=xMini+2) and (y>=yMini+2) and (x<xMini+2+2*G.lx) and (y<yMini+2+G.ly) then 6437 begin 6438 xCentre:=(xwMini+(x-xMini-2) div 2+G.lx div 2+MapWidth div (xxt*4)) mod G.lx; 6439 yCentre:=(y-yMini-2); 6440 xw:=(xCentre-MapWidth div (xxt*4)+G.lx) mod G.lx; 6441 if ywmax<=0 then yw:=ywcenter 6442 else 6443 begin 6444 yw:=(yCentre-MapHeight div (yyt*2)+1) and not 1; 6445 if yw<0 then yw:=0 6446 else if yw>ywmax then yw:=ywmax; 6447 end; 6448 BitBlt(Buffer.Canvas.Handle,0,0,G.lx*2,G.ly,Mini.Canvas.Handle,0,0,SRCCOPY); 6449 if ywmax<=0 then 6450 Frame(Buffer.Canvas,x-xMini-2-MapWidth div (xxt*2),0, 6451 x-xMini-2+MapWidth div (xxt*2)-1, 6452 G.ly-1,MainTexture.clMark,MainTexture.clMark) 6453 else Frame(Buffer.Canvas,x-xMini-2-MapWidth div (xxt*2),yw, 6454 x-xMini-2+MapWidth div (xxt*2)-1, 6455 yw+MapHeight div yyt-2,MainTexture.clMark,MainTexture.clMark); 6456 BitBlt(Panel.Canvas.Handle,xMini+2,yMini+2,G.lx*2,G.ly,Buffer.Canvas.Handle, 6457 0,0,SRCCOPY); 6458 MainOffscreenPaint; 6459 RectInvalidate(xMini+2,TopBarHeight+MapHeight-overlap+yMini+2, 6460 xMini+2+G.lx*2,TopBarHeight+MapHeight-overlap+yMini+2+G.ly); 6461 Update; 6462 end 6463 end 6464 else Tracking:=false 6465 end; 6466 6467 procedure TMainScreen.PanelBoxMouseUp(Sender: TObject; 6468 Button: TMouseButton; Shift: TShiftState; x, y: integer); 6469 begin 6470 if Tracking then 6471 begin 6472 Tracking:=false; 6473 xwMini:=xw; ywMini:=yw; 6474 MiniPaint; 6475 PanelPaint; 6476 end 6477 end; 6478 6479 procedure TMainScreen.MapBoxMouseMove(Sender: TObject; Shift: TShiftState; x, 6480 y: integer); 6481 var 6482 MouseLoc: integer; 6483 begin 6484 xMouse:=x; yMouse:=y; 6485 if (ClientMode=cEditMap) and (ssLeft in Shift) and not tracking then 6486 begin 6487 MouseLoc:=LocationOfScreenPixel(x,y); 6488 if MouseLoc<>BrushLoc then 6489 MapBoxMouseDown(nil, mbLeft, Shift, x, y); 6490 end 6491 (*else if idle and (UnFocus>=0) then 6492 begin 6493 qx:=(xMouse*32+yMouse*66+16*66) div(32*66)-1; 6494 qy:=(yMouse*66-xMouse*32-16*66+2000*33*32) div(32*66)-999; 6495 MouseLoc:=(xw+(qx-qy+2048) div 2-1024+G.lx) mod G.lx+G.lx*(yw+qx+qy); 6496 ShowMoveHint(MouseLoc); 6497 end*) 6498 end; 6499 6500 procedure TMainScreen.mShowClick(Sender: TObject); 6501 begin 6502 TMenuItem(Sender).Checked:=not TMenuItem(Sender).Checked; 6503 SetMapOptions; 6504 MapValid:=false; 6505 PaintAllMaps; 6506 end; 6507 6508 procedure TMainScreen.mNamesClick(Sender: TObject); 6509 var 6510 p1: integer; 6511 begin 6512 mNames.Checked:=not mNames.Checked; 6513 GenerateNames:=mNames.Checked; 6514 for p1:=0 to nPl-1 do if Tribe[p1]<>nil then 6515 if GenerateNames then Tribe[p1].NumberName:=-1 6516 else Tribe[p1].NumberName:=p1; 6517 MapValid:=false; 6518 PaintAll; 6519 end; 6520 6521 function TMainScreen.IsPanelPixel(x,y: integer): boolean; 6522 begin 6523 result:= (y>=TopBarHeight+MapHeight) 6524 or (y>=ClientHeight-PanelHeight) and ((x<xMidPanel) or (x>=xRightPanel)) 6525 end; 6526 6527 procedure TMainScreen.FormMouseDown(Sender: TObject; Button: TMouseButton; 6528 Shift: TShiftState; x, y: integer); 6529 begin 6530 if idle then 6531 if (x<40) and (y<40) then 6532 begin 6533 if GameMode<>cMovie then 6534 begin 6535 InitPopup(GamePopup); 6536 if FullScreen then 6537 GamePopup.Popup(Left,Top+TopBarHeight-1) 6538 else GamePopup.Popup(Left+4,Top+GetSystemMetrics(SM_CYCAPTION)+4+TopBarHeight-1); 6539 end 6540 end 6541 else if IsPanelPixel(x,y) then 6542 PanelBoxMouseDown(Sender,Button,Shift,x,y-(ClientHeight-PanelHeight)) 6543 else if (y>=TopBarHeight) and (x>=MapOffset) and (x<MapOffset+MapWidth) then 6544 MapBoxMouseDown(Sender,Button,Shift,x-MapOffset,y-TopBarHeight) 6545 end; 6546 6547 procedure TMainScreen.FormMouseMove(Sender: TObject; Shift: TShiftState; x, 6548 y: integer); 6549 begin 6550 if idle then 6551 if IsPanelPixel(x,y) then 6552 PanelBoxMouseMove(Sender,Shift,x,y-(ClientHeight-PanelHeight)) 6553 else if (y>=TopBarHeight) and (x>=MapOffset) and (x<MapOffset+MapWidth) then 6554 MapBoxMouseMove(Sender,Shift,x-MapOffset,y-TopBarHeight); 6555 end; 6556 6557 procedure TMainScreen.FormMouseUp(Sender: TObject; Button: TMouseButton; 6558 Shift: TShiftState; x, y: integer); 6559 begin 6560 if idle then 6561 PanelBoxMouseUp(Sender,Button,Shift,x,y-(ClientHeight-PanelHeight)); 6562 end; 6563 6564 procedure TMainScreen.FormPaint(Sender: TObject); 6565 begin 6566 MainOffscreenPaint; 6567 if (MapOffset>0) or (MapOffset+MapWidth<ClientWidth) then with canvas do 6568 begin // pillarbox, make left and right border black 6569 if me<0 then 6570 brush.color:=$000000 6571 else brush.color:=EmptySpaceColor; 6572 if xMidPanel>MapOffset then 6573 FillRect(Rect(0,TopBarHeight,MapOffset,TopBarHeight+MapHeight-overlap)) 6574 else 6575 begin 6576 FillRect(Rect(0,TopBarHeight,xMidPanel,TopBarHeight+MapHeight-overlap)); 6577 FillRect(Rect(xMidPanel,TopBarHeight,MapOffset,TopBarHeight+MapHeight)); 6578 end; 6579 if xRightPanel<MapOffset+MapWidth then 6580 FillRect(Rect(MapOffset+MapWidth,TopBarHeight,ClientWidth,TopBarHeight+MapHeight-overlap)) 6581 else 6582 begin 6583 FillRect(Rect(MapOffset+MapWidth,TopBarHeight,xRightPanel,TopBarHeight+MapHeight)); 6584 FillRect(Rect(xRightPanel,TopBarHeight,ClientWidth,TopBarHeight+MapHeight-overlap)); 6585 end; 6586 Brush.Style:=bsClear; 6587 end; 6588 BitBlt(Canvas.Handle,MapOffset,TopBarHeight,MapWidth,MapHeight-overlap,offscreen.Canvas.Handle, 6589 0,0,SRCCOPY); 6590 BitBlt(Canvas.Handle,0,0,ClientWidth,TopBarHeight,TopBar.Canvas.Handle, 6591 0,0,SRCCOPY); 6592 if xMidPanel>MapOffset then 6593 BitBlt(Canvas.Handle,xMidPanel,TopBarHeight+MapHeight-overlap, 6594 ClientWidth div 2-xMidPanel,overlap, 6595 offscreen.Canvas.Handle,xMidPanel-MapOffset,MapHeight-overlap,SRCCOPY) 6596 else BitBlt(Canvas.Handle,MapOffset,TopBarHeight+MapHeight-overlap, 6597 ClientWidth div 2-MapOffset,overlap, 6598 offscreen.Canvas.Handle,0,MapHeight-overlap,SRCCOPY); 6599 if xRightPanel<MapOffset+MapWidth then 6600 BitBlt(Canvas.Handle,ClientWidth div 2,TopBarHeight+MapHeight-overlap, 6601 xRightPanel-ClientWidth div 2,overlap, 6602 offscreen.Canvas.Handle,ClientWidth div 2-MapOffset,MapHeight-overlap,SRCCOPY) 6603 else BitBlt(Canvas.Handle,ClientWidth div 2,TopBarHeight+MapHeight-overlap, 6604 MapOffset+MapWidth-ClientWidth div 2,overlap, 6605 offscreen.Canvas.Handle,ClientWidth div 2-MapOffset,MapHeight-overlap,SRCCOPY); 6606 BitBlt(Canvas.Handle,0,TopBarHeight+MapHeight-overlap,xMidPanel,overlap, 6607 Panel.Canvas.Handle,0,0,SRCCOPY); 6608 BitBlt(Canvas.Handle,xRightPanel,TopBarHeight+MapHeight-overlap,Panel.Width-xRightPanel, 6609 overlap,Panel.Canvas.Handle,xRightPanel,0,SRCCOPY); 6610 BitBlt(Canvas.Handle,0,TopBarHeight+MapHeight,Panel.Width,PanelHeight-overlap, 6611 Panel.Canvas.Handle,0,overlap,SRCCOPY); 6612 if (pLogo>=0) and (G.RO[pLogo]=nil) and (AILogo[pLogo]<>nil) then 6613 BitBlt(Canvas.Handle, xRightPanel+10-(16+64), ClientHeight-PanelHeight, 64,64, 6614 AILogo[pLogo].Canvas.Handle,0,0,SRCCOPY); 6615 end; 6616 6617 procedure TMainScreen.RectInvalidate(Left,Top,Rigth,Bottom: integer); 6618 var 6619 r0: HRgn; 6620 begin 6621 r0:=CreateRectRgn(Left,Top,Rigth,Bottom); 6622 InvalidateRgn(Handle,r0,false); 6623 DeleteObject(r0); 6624 end; 6625 6626 procedure TMainScreen.SmartRectInvalidate(Left,Top,Rigth,Bottom: integer); 6627 var 6628 i: integer; 6629 r0,r1: HRgn; 6630 begin 6631 r0:=CreateRectRgn(Left,Top,Rigth,Bottom); 6632 for i:=0 to ControlCount-1 do 6633 if not (Controls[i] is TArea) and Controls[i].Visible then 6634 begin 6635 with Controls[i].BoundsRect do 6636 r1:=CreateRectRgn(Left,Top,Right,Bottom); 6637 CombineRgn(r0,r0,r1,RGN_DIFF); 6638 DeleteObject(r1); 6639 end; 6640 InvalidateRgn(Handle,r0,false); 6641 DeleteObject(r0); 6642 end; 6643 6644 procedure TMainScreen.mRepClicked(Sender: TObject); 6645 begin 6646 with TMenuItem(Sender) do 6647 begin 6648 Checked:=not Checked; 6649 if Checked then CityRepMask:=CityRepMask or (1 shl (Tag shr 8)) 6650 else CityRepMask:=CityRepMask and not (1 shl (Tag shr 8)) 6651 end 6652 end; 6653 6654 procedure TMainScreen.mLogClick(Sender: TObject); 6655 begin 6656 LogDlg.Show 6657 end; 6658 6659 procedure TMainScreen.FormShow(Sender: TObject); 6660 begin 6661 Timer1.Enabled:=true 6662 end; 6663 6664 procedure TMainScreen.FormClose(Sender: TObject; var Action: TCloseAction); 6665 begin 6666 Timer1.Enabled:=false 6667 end; 6668 6669 procedure TMainScreen.Radio(Sender: TObject); 6670 begin 6671 TMenuItem(Sender).Checked:=true 6672 end; 6673 6674 procedure TMainScreen.mManipClick(Sender: TObject); 6675 var 6676 Flag: integer; 6677 begin 6678 with TMenuItem(Sender) do 6679 begin 6680 Flag:=1 shl (Tag shr 8); 6681 if Checked then Server(sClearTestFlag,0,Flag,nil^) 6682 else 6683 begin 6684 Server(sSetTestFlag,0,Flag,nil^); 6685 Play('CHEAT'); 6686 end; 6687 if not supervising then 6688 begin 6689 if Flag=tfUncover then 6690 begin MapValid:=false; PaintAllMaps; end 6691 else if Flag=tfAllTechs then 6692 TellNewModels 6693 end 6694 end 6695 end; 6696 6697 procedure TMainScreen.MapBtnClick(Sender: TObject); 6698 begin 6699 with TButtonC(Sender) do 6700 begin 6701 MapOptionChecked:=MapOptionChecked xor (1 shl (Tag shr 8)); 6702 SetMapOptions; 6703 ButtonIndex:=MapOptionChecked shr (Tag shr 8) and 1 +2 6704 end; 6705 if Sender=MapBtn0 then 6706 begin MiniPaint; PanelPaint end // update mini map only 6707 else begin MapValid:=false; PaintAllMaps; end; // update main map 6708 end; 6709 6710 procedure TMainScreen.GrWallBtnDownChanged(Sender: TObject); 6711 begin 6712 if TButtonBase(Sender).Down then 6713 begin 6714 MapOptionChecked:=MapOptionChecked or (1 shl moGreatWall); 6715 TButtonBase(Sender).Hint:=''; 6716 end 6717 else 6718 begin 6719 MapOptionChecked:=MapOptionChecked and not (1 shl moGreatWall); 6720 TButtonBase(Sender).Hint:=Phrases.Lookup('CONTROLS',-1+TButtonBase(Sender).Tag and $FF); 6721 end; 6722 SetMapOptions; 6723 MapValid:=false; 6724 PaintAllMaps; 6725 end; 6726 6727 procedure TMainScreen.BareBtnDownChanged(Sender: TObject); 6728 begin 6729 if TButtonBase(Sender).Down then 6730 begin 6731 MapOptionChecked:=MapOptionChecked or (1 shl moBareTerrain); 6732 TButtonBase(Sender).Hint:=''; 6733 end 6734 else 6735 begin 6736 MapOptionChecked:=MapOptionChecked and not (1 shl moBareTerrain); 6737 TButtonBase(Sender).Hint:=Phrases.Lookup('CONTROLS',-1+TButtonBase(Sender).Tag and $FF); 6738 end; 6739 SetMapOptions; 6740 MapValid:=false; 6741 PaintAllMaps; 6742 end; 6743 6744 procedure TMainScreen.FormKeyUp(Sender: TObject; var Key: Word; 6745 Shift: TShiftState); 6746 begin 6747 if idle and (Key=VK_APPS) then 6748 begin 6749 InitPopup(GamePopup); 6750 if FullScreen then 6751 GamePopup.Popup(Left,Top+TopBarHeight-1) 6752 else GamePopup.Popup(Left+4,Top+GetSystemMetrics(SM_CYCAPTION)+4+TopBarHeight-1); 6753 exit 6754 end // windows menu button calls game menu 6755 end; 6756 6757 procedure TMainScreen.CreateUnitClick(Sender: TObject); 6758 var 6759 p1,mix: integer; 6760 begin 6761 p1:=TComponent(Sender).Tag shr 16; 6762 mix:=TComponent(Sender).Tag and $FFFF; 6763 if Server(sCreateUnit+p1 shl 4,me,mix,EditLoc)>=rExecuted then 6764 PaintLoc(EditLoc); 6765 end; 6766 6767 procedure TMainScreen.mSoundOffClick(Sender: TObject); 6768 begin 6769 SoundMode:=smOff; 6770 end; 6771 6772 procedure TMainScreen.mSoundOnClick(Sender: TObject); 6773 begin 6774 SoundMode:=smOn; 6775 end; 6776 6777 procedure TMainScreen.mSoundOnAltClick(Sender: TObject); 6778 begin 6779 SoundMode:=smOnAlt; 6780 end; 6781 6782 {procedure TMainScreen.AdviceBtnClick; 6783 var 6784 OldAdviceLoc: integer; 6785 begin 6786 DestinationMarkON:=false; 6787 PaintDestination; 6788 AdvisorDlg.GiveStrategyAdvice; 6789 OldAdviceLoc:=MainMap.AdviceLoc; 6790 MainMap.AdviceLoc:=-1; 6791 PaintLoc(OldAdviceLoc); 6792 end;} 6793 6794 {procedure TMainScreen.SetAdviceLoc(Loc: integer; AvoidRect: TRect); 6795 var 6796 OldAdviceLoc,x,y: integer; 6797 begin 6798 if Loc<>MainMap.AdviceLoc then 6799 begin 6800 if Loc>=0 then 6801 begin // center 6802 y:=Loc div G.lx; 6803 x:=(Loc+G.lx - AvoidRect.Right div (2*66)) mod G.lx; 6804 Centre(y*G.lx+x); 6805 PaintAllMaps; 6806 end; 6807 OldAdviceLoc:=MainMap.AdviceLoc; 6808 MainMap.AdviceLoc:=Loc; 6809 PaintLoc(OldAdviceLoc); 6810 PaintLoc(MainMap.AdviceLoc); 6811 end; 6812 end;} 6813 6814 procedure TMainScreen.UnitInfoBtnClick(Sender: TObject); 6815 begin 6816 if UnFocus>=0 then 6817 UnitStatDlg.ShowNewContent_OwnModel(wmPersistent, MyUn[UnFocus].mix) 6818 end; 6819 6820 procedure TMainScreen.ViewpointClick(Sender: TObject); 6821 begin 6822 SetViewpoint(TMenuItem(Sender).Tag); 6823 end; 6824 6825 procedure TMainScreen.DebugMapClick(Sender: TObject); 6826 begin 6827 SetDebugMap(TMenuItem(Sender).Tag); 6828 end; 6829 6830 procedure TMainScreen.mSmallTilesClick(Sender: TObject); 6831 begin 6832 SetTileSize(33,16); 6833 end; 6834 6835 procedure TMainScreen.mNormalTilesClick(Sender: TObject); 6836 begin 6837 SetTileSize(48,24); 6838 end; 6839 6840 procedure TMainScreen.SetTileSize(x,y: integer); 6841 var 6842 i,CenterLoc: integer; 6843 begin 6844 CenterLoc:=(xw+MapWidth div (xxt*4)) mod G.lx+(yw+MapHeight div (yyt*2))*G.lx; 6845 IsoEngine.ApplyTileSize(x,y); 6846 FormResize(nil); 6847 Centre(CenterLoc); 6848 PaintAllMaps; 6849 for i:=0 to Screen.FormCount-1 do 6850 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then 6851 TBufferedDrawDlg(Screen.Forms[i]).SmartUpdateContent(false); 6852 end; 6853 6854 procedure TMainScreen.SaveSettings; 6855 var 6856 i,j: integer; 6857 Reg: TRegistry; 6858 begin 6859 OptionChecked:=OptionChecked and soExtraMask; 6860 for i:=0 to ComponentCount-1 do if Components[i] is TMenuItem then 6861 for j:=0 to nSaveOption-1 do 6862 if TMenuItem(Components[i]).Checked 6863 and (TMenuItem(Components[i]).Tag=SaveOption[j]) then 6864 inc(OptionChecked,1 shl j); 6865 6866 Reg:=TRegistry.Create; 6867 Reg.OpenKey('SOFTWARE\cevo\RegVer9',true); 6868 Reg.WriteInteger('TileWidth',xxt*2); 6869 Reg.WriteInteger('TileHeight',yyt*2); 6870 Reg.WriteInteger('OptionChecked', OptionChecked); 6871 Reg.WriteInteger('MapOptionChecked', MapOptionChecked); 6872 Reg.WriteInteger('CityReport',integer(CityRepMask)); 6873 Reg.closekey; 6874 Reg.Free; 6875 end; 6876 6877 procedure TMainScreen.MovieSpeedBtnClick(Sender: TObject); 6878 begin 6879 MovieSpeed:=TButtonB(Sender).Tag shr 8; 6880 CheckMovieSpeedBtnState; 6881 end; 7961 end; } 7962 7963 procedure TMainScreen.UnitInfoBtnClick(Sender: TObject); 7964 begin 7965 if UnFocus >= 0 then 7966 UnitStatDlg.ShowNewContent_OwnModel(wmPersistent, MyUn[UnFocus].mix) 7967 end; 7968 7969 procedure TMainScreen.ViewpointClick(Sender: TObject); 7970 begin 7971 SetViewpoint(TMenuItem(Sender).Tag); 7972 end; 7973 7974 procedure TMainScreen.DebugMapClick(Sender: TObject); 7975 begin 7976 SetDebugMap(TMenuItem(Sender).Tag); 7977 end; 7978 7979 procedure TMainScreen.mSmallTilesClick(Sender: TObject); 7980 begin 7981 SetTileSize(33, 16); 7982 end; 7983 7984 procedure TMainScreen.mNormalTilesClick(Sender: TObject); 7985 begin 7986 SetTileSize(48, 24); 7987 end; 7988 7989 procedure TMainScreen.SetTileSize(x, y: integer); 7990 var 7991 i, CenterLoc: integer; 7992 begin 7993 CenterLoc := (xw + MapWidth div (xxt * 4)) mod G.lx + 7994 (yw + MapHeight div (yyt * 2)) * G.lx; 7995 IsoEngine.ApplyTileSize(x, y); 7996 FormResize(nil); 7997 Centre(CenterLoc); 7998 PaintAllMaps; 7999 for i := 0 to Screen.FormCount - 1 do 8000 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) 8001 then 8002 TBufferedDrawDlg(Screen.Forms[i]).SmartUpdateContent(false); 8003 end; 8004 8005 procedure TMainScreen.SaveSettings; 8006 var 8007 i, j: integer; 8008 Reg: TRegistry; 8009 begin 8010 OptionChecked := OptionChecked and soExtraMask; 8011 for i := 0 to ComponentCount - 1 do 8012 if Components[i] is TMenuItem then 8013 for j := 0 to nSaveOption - 1 do 8014 if TMenuItem(Components[i]).Checked and 8015 (TMenuItem(Components[i]).Tag = SaveOption[j]) then 8016 inc(OptionChecked, 1 shl j); 8017 8018 Reg := TRegistry.Create; 8019 Reg.OpenKey('SOFTWARE\cevo\RegVer9', true); 8020 Reg.WriteInteger('TileWidth', xxt * 2); 8021 Reg.WriteInteger('TileHeight', yyt * 2); 8022 Reg.WriteInteger('OptionChecked', OptionChecked); 8023 Reg.WriteInteger('MapOptionChecked', MapOptionChecked); 8024 Reg.WriteInteger('CityReport', integer(CityRepMask)); 8025 Reg.closekey; 8026 Reg.free; 8027 end; 8028 8029 procedure TMainScreen.MovieSpeedBtnClick(Sender: TObject); 8030 begin 8031 MovieSpeed := TButtonB(Sender).Tag shr 8; 8032 CheckMovieSpeedBtnState; 8033 end; 6882 8034 6883 8035 initialization 8036 6884 8037 QueryPerformanceFrequency(PerfFreq); 6885 8038 6886 8039 end. 6887 -
trunk/LocalPlayer/Tribes.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit Tribes; 4 3 … … 6 5 7 6 uses 8 Protocol, ScreenTools,9 10 Classes, Graphics,SysUtils;7 Protocol, ScreenTools, 8 9 Classes, Graphics, SysUtils; 11 10 12 11 type 13 TCityPicture=record 14 xShield,yShield:integer; 15 end; 16 TModelPicture=record 17 HGr,pix,xShield,yShield:integer; 18 end; 19 TModelPictureInfo=record 20 trix,mix,pix,Hash: integer; 21 GrName: ShortString 22 end; 23 24 TTribe=class 25 symHGr, sympix, faceHGr, facepix, cHGr, cpix, //symbol and city graphics 26 cAge, mixSlaves: integer; 27 Color: TColor; 28 NumberName: integer; 29 CityPicture: array[0..3] of TCityPicture; 30 ModelPicture: array[-1..256] of TModelPicture; // -1 is building site 31 ModelName: array[-1..256] of string; 32 constructor Create(FileName: string); 33 destructor Destroy; override; 34 function GetCityName(i: integer): string; 35 {$IFNDEF SCR}procedure SetCityName(i: integer; NewName: string);{$ENDIF} 36 {$IFNDEF SCR}function TString(Template: string): string; 37 function TPhrase(Item: string): string;{$ENDIF} 38 procedure SetModelPicture(const Info: TModelPictureInfo; IsNew: boolean); 39 function ChooseModelPicture(var Picture: TModelPictureInfo; 40 code,Turn: integer; ForceNew: boolean): boolean; 41 procedure InitAge(Age: integer); 42 protected 43 CityLine0,nCityLines: integer; 44 Name: array['a'..'z'] of string; 45 Script: tstringlist; 12 TCityPicture = record 13 xShield, yShield: integer; 14 end; 15 16 TModelPicture = record 17 HGr, pix, xShield, yShield: integer; 18 end; 19 20 TModelPictureInfo = record 21 trix, mix, pix, Hash: integer; 22 GrName: ShortString end; 23 24 TTribe = class symHGr, sympix, faceHGr, facepix, cHGr, cpix, 25 // symbol and city graphics 26 cAge, mixSlaves: integer; 27 Color: TColor; 28 NumberName: integer; 29 CityPicture: array [0 .. 3] of TCityPicture; 30 ModelPicture: array [-1 .. 256] of TModelPicture; // -1 is building site 31 ModelName: array [-1 .. 256] of string; 32 constructor Create(FileName: string); 33 destructor Destroy; override; 34 function GetCityName(i: integer): string; 35 {$IFNDEF SCR} procedure SetCityName(i: integer; NewName: string); {$ENDIF} 36 {$IFNDEF SCR} function TString(Template: string): string; 37 function TPhrase(Item: string): string; {$ENDIF} 38 procedure SetModelPicture(const Info: TModelPictureInfo; IsNew: boolean); 39 function ChooseModelPicture(var Picture: TModelPictureInfo; 40 code, Turn: integer; ForceNew: boolean): boolean; 41 procedure InitAge(Age: integer); 42 protected 43 CityLine0, nCityLines: integer; 44 Name: array ['a' .. 'z'] of string; 45 Script: tstringlist; 46 46 end; 47 47 48 48 var 49 Tribe: array[0..nPl-1] of TTribe;50 HGrStdUnits: integer;49 Tribe: array [0 .. nPl - 1] of TTribe; 50 HGrStdUnits: integer; 51 51 52 52 procedure Init; … … 56 56 procedure FindStdModelPicture(code: integer; var pix: integer; 57 57 var Name: string); 58 function GetTribeInfo(FileName: string; var Name: string; var Color: TColor): boolean; 59 procedure FindPosition(HGr,x,y,xmax,ymax: integer; Mark: TColor; var xp,yp: integer); 60 58 function GetTribeInfo(FileName: string; var Name: string; 59 var Color: TColor): boolean; 60 procedure FindPosition(HGr, x, y, xmax, ymax: integer; Mark: TColor; 61 var xp, yp: integer); 61 62 62 63 implementation 63 64 64 65 uses 65 Directories; 66 66 Directories; 67 67 68 68 type 69 TChosenModelPictureInfo=record 70 Hash,HGr,pix: integer; 71 ModelName: ShortString 72 end; 73 74 TPictureList=array[0..99999] of TChosenModelPictureInfo; 75 76 var 77 StdUnitScript: tstringlist; 78 PictureList: ^TPictureList; 79 nPictureList: integer; 80 81 82 procedure Init; 83 begin 84 StdUnitScript:=tstringlist.Create; 85 StdUnitScript.LoadFromFile(LocalizedFilePath('Tribes\StdUnits.txt')); 86 nPictureList:=0; 87 PictureList:=nil; 88 end; 89 90 procedure Done; 91 begin 92 ReallocMem(PictureList,0); 93 StdUnitScript.Free; 94 end; 95 96 function CityName(Founder: integer): string; 97 begin 98 if not GenerateNames then 99 result:=Format('%d.%d',[Founder shr 12, Founder and $FFF]) 100 else result:=Tribe[Founder shr 12].GetCityName(Founder and $FFF); 101 end; 102 103 function ModelCode(const ModelInfo: TModelInfo): integer; 104 begin 105 with ModelInfo do 106 begin 107 case Kind of 108 mkSelfDeveloped, mkEnemyDeveloped: 109 case Domain of {age determination} 110 dGround: 111 if (Attack>=Defense*4) 112 or (Attack>0) and (MaxUpgrade<10) 113 and (Cap and (1 shl (mcArtillery-mcFirstNonCap))<>0) then 114 begin 115 result:=170; 116 if MaxUpgrade>=12 then inc(result,3) 117 else if (MaxUpgrade>=10) or (Weight>7) then inc(result,2) 118 else if MaxUpgrade>=4 then inc(result,1) 69 TChosenModelPictureInfo = record 70 Hash, HGr, pix: integer; 71 ModelName: ShortString end; 72 73 TPictureList = array [0 .. 99999] of TChosenModelPictureInfo; 74 75 var 76 StdUnitScript: tstringlist; 77 PictureList: ^TPictureList; 78 nPictureList: integer; 79 80 procedure Init; 81 begin 82 StdUnitScript := tstringlist.Create; 83 StdUnitScript.LoadFromFile(LocalizedFilePath('Tribes\StdUnits.txt')); 84 nPictureList := 0; 85 PictureList := nil; 86 end; 87 88 procedure Done; 89 begin 90 ReallocMem(PictureList, 0); 91 StdUnitScript.Free; 92 end; 93 94 function CityName(Founder: integer): string; 95 begin 96 if not GenerateNames then 97 result := Format('%d.%d', [Founder shr 12, Founder and $FFF]) 98 else 99 result := Tribe[Founder shr 12].GetCityName(Founder and $FFF); 100 end; 101 102 function ModelCode(const ModelInfo: TModelInfo): integer; 103 begin 104 with ModelInfo do 105 begin 106 case Kind of 107 mkSelfDeveloped, mkEnemyDeveloped: 108 case Domain of { age determination } 109 dGround: 110 if (Attack >= Defense * 4) or (Attack > 0) and (MaxUpgrade < 10) 111 and (Cap and (1 shl (mcArtillery - mcFirstNonCap)) <> 0) then 112 begin 113 result := 170; 114 if MaxUpgrade >= 12 then 115 inc(result, 3) 116 else if (MaxUpgrade >= 10) or (Weight > 7) then 117 inc(result, 2) 118 else if MaxUpgrade >= 4 then 119 inc(result, 1) 120 end 121 else 122 begin 123 result := 100; 124 if MaxUpgrade >= 12 then 125 inc(result, 6) 126 else if (MaxUpgrade >= 10) or (Weight > 7) then 127 inc(result, 5) 128 else if MaxUpgrade >= 6 then 129 inc(result, 4) 130 else if MaxUpgrade >= 4 then 131 inc(result, 3) 132 else if MaxUpgrade >= 2 then 133 inc(result, 2) 134 else if MaxUpgrade >= 1 then 135 inc(result, 1); 136 if Speed >= 250 then 137 if (result >= 105) and (Attack <= Defense) then 138 result := 110 139 else 140 inc(result, 30) 141 end; 142 dSea: 143 begin 144 result := 200; 145 if MaxUpgrade >= 8 then 146 inc(result, 3) 147 else if MaxUpgrade >= 6 then 148 inc(result, 2) 149 else if MaxUpgrade >= 3 then 150 inc(result, 1); 151 if Cap and (1 shl (mcSub - mcFirstNonCap)) <> 0 then 152 result := 240 153 else if ATrans_Fuel > 0 then 154 result := 220 155 else if (result >= 202) and (Attack = 0) and (TTrans > 0) then 156 result := 210; 157 end; 158 dAir: 159 begin 160 result := 300; 161 if (Bombs > 0) or (TTrans > 0) then 162 inc(result, 10); 163 if Speed > 850 then 164 inc(result, 1) 165 end; 166 end; 167 mkSpecial_TownGuard: 168 result := 41; 169 mkSpecial_Boat: 170 result := 64; 171 mkSpecial_SubCabin: 172 result := 71; 173 mkSpecial_Glider: 174 result := 73; 175 mkSlaves: 176 result := 74; 177 mkSettler: 178 if Speed > 150 then 179 result := 11 180 else 181 result := 10; 182 mkDiplomat: 183 result := 21; 184 mkCaravan: 185 result := 30; 186 end; 187 end; 188 end; 189 190 var 191 Input: string; 192 193 function Get: string; 194 195 var 196 p: integer; 197 begin 198 while (Input <> '') and ((Input[1] = ' ') or (Input[1] = #9)) do 199 Delete(Input, 1, 1); 200 p := pos(',', Input); 201 if p = 0 then 202 p := Length(Input) + 1; 203 result := Copy(Input, 1, p - 1); 204 Delete(Input, 1, p) 205 end; 206 207 function GetNum: integer; 208 209 var 210 i: integer; 211 begin 212 val(Get, result, i); 213 if i <> 0 then 214 result := 0 215 end; 216 217 procedure FindStdModelPicture(code: integer; var pix: integer; 218 var Name: string); 219 220 var 221 i: integer; 222 begin 223 for i := 0 to StdUnitScript.Count - 1 do 224 begin // look through StdUnits 225 Input := StdUnitScript[i]; 226 pix := GetNum; 227 if code = GetNum then 228 begin 229 Name := Get; 230 exit; 231 end 232 end; 233 pix := -1 234 end; 235 236 function GetTribeInfo(FileName: string; var Name: string; 237 var Color: TColor): boolean; 238 239 var 240 found: integer; 241 TribeScript: TextFile; 242 begin 243 Name := ''; 244 Color := $FFFFFF; 245 found := 0; 246 AssignFile(TribeScript, LocalizedFilePath('Tribes\' + FileName + 247 '.tribe.txt')); 248 Reset(TribeScript); 249 while not EOF(TribeScript) do 250 begin 251 ReadLn(TribeScript, Input); 252 if Copy(Input, 1, 7) = '#CHOOSE' then 253 begin 254 Name := Copy(Input, 9, 255); 255 found := found or 1; 256 if found = 3 then 257 break 258 end 259 else if Copy(Input, 1, 6) = '#COLOR' then 260 begin 261 Color := HexStringToColor(Copy(Input, 7, 255)); 262 found := found or 2; 263 if found = 3 then 264 break 265 end 266 end; 267 CloseFile(TribeScript); 268 result := found = 3; 269 end; 270 271 constructor TTribe.Create(FileName: string); 272 273 var 274 line: integer; 275 variant: char; 276 Item: string; 277 begin 278 inherited Create; 279 for variant := 'a' to 'z' do 280 Name[variant] := ''; 281 Script := tstringlist.Create; 282 Script.LoadFromFile(LocalizedFilePath('Tribes\' + FileName + '.tribe.txt')); 283 CityLine0 := 0; 284 nCityLines := 0; 285 for line := 0 to Script.Count - 1 do 286 begin 287 Input := Script[line]; 288 if (CityLine0 > 0) and (nCityLines = 0) and 289 ((Input = '') or (Input[1] = '#')) then 290 nCityLines := line - CityLine0; 291 if (Length(Input) >= 3) and (Input[1] = '#') and (Input[2] in ['a' .. 'z'] 292 ) and (Input[3] = ' ') then 293 Name[Input[2]] := Copy(Input, 4, 255) 294 else if Copy(Input, 1, 6) = '#COLOR' then 295 Color := HexStringToColor(Copy(Input, 7, 255)) 296 else if Copy(Input, 1, 7) = '#CITIES' then 297 CityLine0 := line + 1 298 else if Copy(Input, 1, 8) = '#SYMBOLS' then 299 begin 300 Delete(Input, 1, 9); 301 Item := Get; 302 sympix := GetNum; 303 symHGr := LoadGraphicSet(Item); 304 end 305 end; 306 FillChar(ModelPicture, SizeOf(ModelPicture), 0); 307 NumberName := -1; 308 cAge := -1; 309 mixSlaves := -1; 310 end; 311 312 destructor TTribe.Destroy; 313 begin 314 Script.Free; 315 inherited Destroy; 316 end; 317 318 procedure FindPosition(HGr, x, y, xmax, ymax: integer; Mark: TColor; 319 var xp, yp: integer); 320 begin 321 xp := 0; 322 while (xp < xmax) and (GrExt[HGr].Data.Canvas.Pixels[x + 1 + xp, y] 323 <> Mark) do 324 inc(xp); 325 yp := 0; 326 while (yp < ymax) and (GrExt[HGr].Data.Canvas.Pixels[x, y + 1 + yp] 327 <> Mark) do 328 inc(yp); 329 end; 330 331 function TTribe.GetCityName(i: integer): string; 332 begin 333 result := ''; 334 if nCityLines > i then 335 begin 336 result := Script[CityLine0 + i]; 337 while (result <> '') and ((result[1] = ' ') or (result[1] = #9)) do 338 Delete(result, 1, 1); 339 end 340 {$IFNDEF SCR} else 341 result := Format(TPhrase('GENCITY'), [i + 1]){$ENDIF} 342 end; 343 344 {$IFNDEF SCR} 345 procedure TTribe.SetCityName(i: integer; NewName: string); 346 begin 347 while nCityLines <= i do 348 begin 349 Script.Insert(CityLine0 + nCityLines, Format(TPhrase('GENCITY'), 350 [nCityLines + 1])); 351 inc(nCityLines); 352 end; 353 Script[CityLine0 + i] := NewName; 354 end; 355 356 function TTribe.TString(Template: string): string; 357 358 var 359 p: integer; 360 variant: char; 361 CaseUp: boolean; 362 begin 363 repeat 364 p := pos('#', Template); 365 if (p = 0) or (p = Length(Template)) then 366 break; 367 variant := Template[p + 1]; 368 CaseUp := variant in ['A' .. 'Z']; 369 if CaseUp then 370 inc(variant, 32); 371 Delete(Template, p, 2); 372 if variant in ['a' .. 'z'] then 373 begin 374 if NumberName < 0 then 375 Insert(Name[variant], Template, p) 376 else 377 Insert(Format('P%d', [NumberName]), Template, p); 378 if CaseUp and (Length(Template) >= p) and 379 (Template[p] in ['a' .. 'z', #$E0 .. #$FF]) then 380 dec(Template[p], 32); 381 end 382 until false; 383 result := Template; 384 end; 385 386 function TTribe.TPhrase(Item: string): string; 387 begin 388 result := TString(Phrases.Lookup(Item)); 389 end; 390 {$ENDIF} 391 392 procedure TTribe.InitAge(Age: integer); 393 type 394 TLine = array [0 .. 649, 0 .. 2] of Byte; 395 var 396 i, x, gray: integer; 397 Item: string; 398 begin 399 if Age = cAge then 400 exit; 401 cAge := Age; 402 with Script do 403 begin 404 i := 0; 405 while (i < Count) and 406 (Copy(Strings[i], 1, 6) <> '#AGE' + char(48 + Age) + ' ') do 407 inc(i); 408 if i < Count then 409 begin 410 Input := Strings[i]; 411 system.Delete(Input, 1, 6); 412 Item := Get; 413 cpix := GetNum; 414 // init city graphics 415 if Age < 2 then 416 begin 417 if CompareText(Item, 'stdcities') = 0 then 418 case cpix of 419 3: 420 cpix := 0; 421 6: 422 begin 423 cpix := 0; 424 Item := 'Nation2'; 425 end 426 end; 427 cHGr := LoadGraphicSet(Item); 428 for x := 0 to 3 do 429 with CityPicture[x] do 430 begin 431 FindPosition(cHGr, x * 65, cpix * 49, 63, 47, $00FFFF, 432 xShield, yShield); 433 // FindPosition(cHGr,x*65,cpix*49,$FFFFFF,xf,yf); 434 end 435 end 436 else 437 cHGr := -1; 438 439 {$IFNDEF SCR} 440 Get; 441 GetNum; 442 Item := Get; 443 if Item = '' then 444 faceHGr := -1 445 else 446 begin 447 faceHGr := LoadGraphicSet(Item); 448 facepix := GetNum; 449 if GrExt[faceHGr].Data.Canvas.Pixels[facepix mod 10 * 65, 450 facepix div 10 * 49 + 48] = $00FFFF then 451 begin // generate shield picture 452 GrExt[faceHGr].Data.Canvas.Pixels[facepix mod 10 * 65, 453 facepix div 10 * 49 + 48] := $000000; 454 gray := $B8B8B8; 455 ImageOp_BCC(GrExt[faceHGr].Data, Templates, 456 facepix mod 10 * 65 + 1, facepix div 10 * 49 + 1, 1, 25, 64, 48, 457 gray, Color); 119 458 end 120 else121 begin122 result:=100;123 if MaxUpgrade>=12 then inc(result,6)124 else if (MaxUpgrade>=10) or (Weight>7) then inc(result,5)125 else if MaxUpgrade>=6 then inc(result,4)126 else if MaxUpgrade>=4 then inc(result,3)127 else if MaxUpgrade>=2 then inc(result,2)128 else if MaxUpgrade>=1 then inc(result,1);129 if Speed>=250 then130 if (result>=105) and (Attack<=Defense) then result:=110131 else inc(result,30)132 end;133 dSea:134 begin135 result:=200;136 if MaxUpgrade>=8 then inc(result,3)137 else if MaxUpgrade>=6 then inc(result,2)138 else if MaxUpgrade>=3 then inc(result,1);139 if Cap and (1 shl (mcSub-mcFirstNonCap))<>0 then result:=240140 else if ATrans_Fuel>0 then result:=220141 else if (result>=202) and (Attack=0) and (TTrans>0) then result:=210;142 459 end; 143 dAir:144 begin145 result:=300;146 if (Bombs>0) or (TTrans>0) then inc(result,10);147 if Speed>850 then inc(result,1)148 end;149 end;150 mkSpecial_TownGuard: result:=41;151 mkSpecial_Boat: result:=64;152 mkSpecial_SubCabin: result:=71;153 mkSpecial_Glider: result:=73;154 mkSlaves: result:=74;155 mkSettler: if Speed>150 then result:=11 else result:=10;156 mkDiplomat: result:=21;157 mkCaravan: result:=30;158 end;159 end;160 end;161 162 var163 Input: string;164 165 function Get: string;166 var167 p:integer;168 begin169 while (Input<>'') and ((Input[1]=' ') or (Input[1]=#9)) do Delete(Input,1,1);170 p:=pos(',',Input);if p=0 then p:=Length(Input)+1;171 result:=Copy(Input,1,p-1);172 Delete(Input,1,p)173 end;174 175 function GetNum: integer;176 var177 i:integer;178 begin179 val(Get,result,i);180 if i<>0 then result:=0181 end;182 183 procedure FindStdModelPicture(code: integer; var pix: integer;184 var Name: string);185 var186 i: integer;187 begin188 for i:=0 to StdUnitScript.Count-1 do189 begin // look through StdUnits190 Input:=StdUnitScript[i];191 pix:=GetNum;192 if code=GetNum then begin Name:=Get; exit; end193 end;194 pix:=-1195 end;196 197 function GetTribeInfo(FileName: string; var Name: string; var Color: TColor): boolean;198 var199 found: integer;200 TribeScript: TextFile;201 begin202 Name:='';203 Color:=$FFFFFF;204 found:=0;205 AssignFile(TribeScript,LocalizedFilePath('Tribes\'+FileName+'.tribe.txt'));206 Reset(TribeScript);207 while not EOF(TribeScript) do208 begin209 ReadLn(TribeScript,Input);210 if Copy(Input,1,7)='#CHOOSE' then211 begin212 Name:=Copy(Input,9,255);213 found:=found or 1;214 if found=3 then break215 end216 else if Copy(Input,1,6)='#COLOR' then217 begin218 Color:=HexStringToColor(Copy(Input,7,255));219 found:=found or 2;220 if found=3 then break221 end222 end;223 CloseFile(TribeScript);224 result:= found=3;225 end;226 227 constructor TTribe.Create(FileName: string);228 var229 line:integer;230 variant: char;231 Item:string;232 begin233 inherited Create;234 for variant:='a' to 'z' do Name[variant]:='';235 Script:=tstringlist.Create;236 Script.LoadFromFile(LocalizedFilePath('Tribes\'+FileName+'.tribe.txt'));237 CityLine0:=0;238 nCityLines:=0;239 for line:=0 to Script.Count-1 do240 begin241 Input:=Script[line];242 if (CityLine0>0) and (nCityLines=0) and ((Input='') or (Input[1]='#')) then243 nCityLines:=line-CityLine0;244 if (Length(Input)>=3) and (Input[1]='#') and (Input[2] in ['a'..'z'])245 and (Input[3]=' ') then246 Name[Input[2]]:=Copy(Input,4,255)247 else if Copy(Input,1,6)='#COLOR' then248 Color:=HexStringToColor(Copy(Input,7,255))249 else if Copy(Input,1,7)='#CITIES' then CityLine0:=line+1250 else if Copy(Input,1,8)='#SYMBOLS' then251 begin252 Delete(Input,1,9);253 Item:=Get;254 sympix:=GetNum;255 symHGr:=LoadGraphicSet(Item);256 end257 end;258 FillChar(ModelPicture,SizeOf(ModelPicture),0);259 NumberName:=-1;260 cAge:=-1;261 mixSlaves:=-1;262 end;263 264 destructor TTribe.Destroy;265 begin266 Script.Free;267 inherited Destroy;268 end;269 270 procedure FindPosition(HGr,x,y,xmax,ymax: integer; Mark: TColor;271 var xp,yp: integer);272 begin273 xp:=0;274 while (xp<xmax) and (GrExt[HGr].Data.Canvas.Pixels[x+1+xp,y]<>Mark) do275 inc(xp);276 yp:=0;277 while (yp<ymax) and (GrExt[HGr].Data.Canvas.Pixels[x,y+1+yp]<>Mark) do278 inc(yp);279 end;280 281 function TTribe.GetCityName(i: integer): string;282 begin283 result:='';284 if nCityLines>i then285 begin286 result:=Script[CityLine0+i];287 while (result<>'') and ((result[1]=' ') or (result[1]=#9)) do288 Delete(result,1,1);289 end290 {$IFNDEF SCR}else result:=Format(TPhrase('GENCITY'),[i+1]){$ENDIF}291 end;292 293 {$IFNDEF SCR}294 procedure TTribe.SetCityName(i: integer; NewName: string);295 begin296 while nCityLines<=i do297 begin298 Script.Insert(CityLine0+nCityLines, Format(TPhrase('GENCITY'),299 [nCityLines+1]));300 inc(nCityLines);301 end;302 Script[CityLine0+i]:=NewName;303 end;304 305 function TTribe.TString(Template: string): string;306 var307 p: integer;308 variant: char;309 CaseUp: boolean;310 begin311 repeat312 p:=pos('#',Template);313 if (p=0) or (p=Length(Template)) then Break;314 variant:=Template[p+1];315 CaseUp:= variant in ['A'..'Z'];316 if CaseUp then inc(variant,32);317 Delete(Template,p,2);318 if variant in ['a'..'z'] then319 begin320 if NumberName<0 then Insert(Name[variant],Template,p)321 else Insert(Format('P%d',[NumberName]),Template,p);322 if CaseUp and (Length(Template)>=p) and (Template[p] in ['a'..'z',#$E0..#$FF]) then323 dec(Template[p],32);324 end325 until false;326 result:=Template;327 end;328 329 function TTribe.TPhrase(Item: string): string;330 begin331 result:=TString(Phrases.Lookup(Item));332 end;333 460 {$ENDIF} 334 335 procedure TTribe.InitAge(Age: integer);336 type337 TLine=array[0..649,0..2] of Byte;338 var339 i,x,gray: integer;340 Item: string;341 begin342 if Age=cAge then exit;343 cAge:=Age;344 with Script do345 begin346 i:=0;347 while (i<Count) and (Copy(Strings[i],1,6)<>'#AGE'+char(48+Age)+' ') do348 inc(i);349 if i<Count then350 begin351 Input:=Strings[i];352 system.Delete(Input,1,6);353 Item:=Get;354 cpix:=GetNum;355 // init city graphics356 if age<2 then357 begin358 if CompareText(Item,'stdcities')=0 then359 case cpix of360 3: cpix:=0;361 6: begin cpix:=0; Item:='Nation2'; end362 end;363 cHGr:=LoadGraphicSet(Item);364 for x:=0 to 3 do with CityPicture[x] do365 begin366 FindPosition(cHGr,x*65,cpix*49,63,47,$00FFFF,xShield,yShield);367 //FindPosition(cHGr,x*65,cpix*49,$FFFFFF,xf,yf);368 461 end 369 462 end 370 else cHGr:=-1; 371 372 {$IFNDEF SCR} 373 Get; 374 GetNum; 375 Item:=Get; 376 if Item='' then faceHGr:=-1 377 else 378 begin 379 faceHGr:=LoadGraphicSet(Item); 380 facepix:=GetNum; 381 if GrExt[faceHGr].Data.Canvas.Pixels[facepix mod 10*65,facepix div 10*49+48]=$00FFFF then 382 begin // generate shield picture 383 GrExt[faceHGr].Data.Canvas.Pixels[facepix mod 10*65,facepix div 10*49+48]:=$000000; 384 gray:=$B8B8B8; 385 ImageOp_BCC(GrExt[faceHGr].Data,Templates,facepix mod 10*65+1, 386 facepix div 10*49+1,1,25,64,48,gray,Color); 463 end; 464 465 procedure TTribe.SetModelPicture(const Info: TModelPictureInfo; 466 IsNew: boolean); 467 var 468 i: integer; 469 ok: boolean; 470 begin 471 with Info do 472 begin 473 if not IsNew then 474 begin 475 i := nPictureList - 1; 476 while (i >= 0) and (PictureList[i].Hash <> Info.Hash) do 477 dec(i); 478 assert(i >= 0); 479 assert(PictureList[i].HGr = LoadGraphicSet(GrName)); 480 assert(PictureList[i].pix = pix); 481 ModelPicture[mix].HGr := PictureList[i].HGr; 482 ModelPicture[mix].pix := PictureList[i].pix; 483 ModelName[mix] := PictureList[i].ModelName; 484 end 485 else 486 begin 487 with ModelPicture[mix] do 488 begin 489 HGr := LoadGraphicSet(GrName); 490 pix := Info.pix; 491 inc(GrExt[HGr].pixUsed[pix]); 492 end; 493 ModelName[mix] := ''; 494 495 // read model name from tribe script 496 ok := false; 497 for i := 0 to Script.Count - 1 do 498 begin 499 Input := Script[i]; 500 if Input = '#UNITS ' + GrName then 501 ok := true 502 else if (Input <> '') and (Input[1] = '#') then 503 ok := false 504 else if ok and (GetNum = pix) then 505 begin 506 Get; 507 ModelName[mix] := Get 508 end 509 end; 510 511 if ModelName[mix] = '' then 512 begin // read model name from StdUnits.txt 513 for i := 0 to StdUnitScript.Count - 1 do 514 begin 515 Input := StdUnitScript[i]; 516 if GetNum = pix then 517 begin 518 Get; 519 ModelName[mix] := Get 520 end 521 end 522 end; 523 524 if Hash <> 0 then 525 begin 526 if nPictureList = 0 then 527 ReallocMem(PictureList, 64 * SizeOf(TChosenModelPictureInfo)) 528 else if (nPictureList >= 64) and 529 (nPictureList and (nPictureList - 1) = 0) then 530 ReallocMem(PictureList, 531 nPictureList * (2 * SizeOf(TChosenModelPictureInfo))); 532 PictureList[nPictureList].Hash := Info.Hash; 533 PictureList[nPictureList].HGr := ModelPicture[mix].HGr; 534 PictureList[nPictureList].pix := Info.pix; 535 PictureList[nPictureList].ModelName := ModelName[mix]; 536 inc(nPictureList); 537 end 538 end; 539 540 with ModelPicture[mix] do 541 FindPosition(HGr, pix mod 10 * 65, pix div 10 * 49, 63, 47, $FFFFFF, 542 xShield, yShield); 543 end; 544 end; 545 546 function TTribe.ChooseModelPicture(var Picture: TModelPictureInfo; 547 code, Turn: integer; ForceNew: boolean): boolean; 548 var 549 i, Cnt, HGr, used, LeastUsed: integer; 550 TestPic: TModelPictureInfo; 551 ok: boolean; 552 553 procedure check; 554 begin 555 TestPic.pix := GetNum; 556 if code = GetNum then 557 begin 558 if ForceNew or (HGr < 0) then 559 used := 0 560 else 561 begin 562 used := 4 * GrExt[HGr].pixUsed[TestPic.pix]; 563 if HGr = HGrStdUnits then 564 inc(used, 2); // prefer units not from StdUnits 565 end; 566 if used < LeastUsed then 567 begin 568 Cnt := 0; 569 LeastUsed := used 570 end; 571 if used = LeastUsed then 572 begin 573 inc(Cnt); 574 if Turn mod Cnt = 0 then 575 Picture := TestPic 576 end; 387 577 end 388 578 end; 389 {$ENDIF} 390 end 391 end 392 end; 393 394 procedure TTribe.SetModelPicture(const Info: TModelPictureInfo; IsNew: boolean); 395 var 396 i: integer; 397 ok: boolean; 398 begin 399 with Info do 400 begin 401 if not IsNew then 402 begin 403 i:=nPictureList-1; 404 while (i>=0) and (PictureList[i].Hash<>Info.Hash) do dec(i); 405 assert(i>=0); 406 assert(PictureList[i].HGr = LoadGraphicSet(GrName)); 407 assert(PictureList[i].pix = pix); 408 ModelPicture[mix].HGr:=PictureList[i].HGr; 409 ModelPicture[mix].pix:=PictureList[i].pix; 410 ModelName[mix]:=PictureList[i].ModelName; 411 end 412 else 413 begin 414 with ModelPicture[mix] do 415 begin 416 HGr:=LoadGraphicSet(GrName); 417 pix:=Info.pix; 418 inc(GrExt[HGr].pixUsed[pix]); 579 580 begin 581 // look for identical model to assign same picture again 582 if not ForceNew and (Picture.Hash > 0) then 583 begin 584 for i := 0 to nPictureList - 1 do 585 if PictureList[i].Hash = Picture.Hash then 586 begin 587 Picture.GrName := GrExt[PictureList[i].HGr].Name; 588 Picture.pix := PictureList[i].pix; 589 result := false; 590 exit; 591 end 419 592 end; 420 ModelName[mix]:=''; 421 422 // read model name from tribe script423 ok:=false;424 for i:=0 to Script.Count-1 do 425 begin426 Input:=Script[i];427 if Input='#UNITS '+GrName then ok:=true428 else if (Input<>'') and (Input[1]='#') then ok:=false429 else if ok and (GetNum=pix) then430 begin Get; ModelName[mix]:=Get end593 594 Picture.pix := 0; 595 TestPic := Picture; 596 LeastUsed := MaxInt; 597 598 TestPic.GrName := 'StdUnits'; 599 HGr := HGrStdUnits; 600 for i := 0 to StdUnitScript.Count - 1 do 601 begin // look through StdUnits 602 Input := StdUnitScript[i]; 603 check; 431 604 end; 432 605 433 if ModelName[mix]='' then 434 begin // read model name from StdUnits.txt 435 for i:=0 to StdUnitScript.Count-1 do 606 ok := false; 607 for i := 0 to Script.Count - 1 do 608 begin // look through units defined in tribe script 609 Input := Script[i]; 610 if Copy(Input, 1, 6) = '#UNITS' then 436 611 begin 437 Input:=StdUnitScript[i]; 438 if GetNum=pix then 439 begin Get; ModelName[mix]:=Get end 612 ok := true; 613 TestPic.GrName := Copy(Input, 8, 255); 614 HGr := nGrExt - 1; 615 while (HGr >= 0) and (GrExt[HGr].Name <> TestPic.GrName) do 616 dec(HGr); 440 617 end 618 else if (Input <> '') and (Input[1] = '#') then 619 ok := false 620 else if ok then 621 check; 441 622 end; 442 443 if Hash<>0 then 444 begin 445 if nPictureList=0 then 446 ReallocMem(PictureList, 64*sizeof(TChosenModelPictureInfo)) 447 else if (nPictureList>=64) and (nPictureList and (nPictureList-1)=0) then 448 ReallocMem(PictureList, nPictureList*(2*sizeof(TChosenModelPictureInfo))); 449 PictureList[nPictureList].Hash:=Info.Hash; 450 PictureList[nPictureList].HGr:=ModelPicture[mix].HGr; 451 PictureList[nPictureList].pix:=Info.pix; 452 PictureList[nPictureList].ModelName:=ModelName[mix]; 453 inc(nPictureList); 454 end 455 end; 456 457 with ModelPicture[mix] do 458 FindPosition(HGr,pix mod 10 *65,pix div 10 *49,63,47,$FFFFFF,xShield,yShield); 459 end; 460 end; 461 462 function TTribe.ChooseModelPicture(var Picture: TModelPictureInfo; 463 code,Turn: integer; ForceNew: boolean): boolean; 464 var 465 i,Cnt,HGr,used,LeastUsed: integer; 466 TestPic: TModelPictureInfo; 467 ok: boolean; 468 469 procedure check; 470 begin 471 TestPic.pix:=GetNum; 472 if code=GetNum then 473 begin 474 if ForceNew or (HGr<0) then used:=0 475 else 476 begin 477 used:=4*GrExt[HGr].pixUsed[TestPic.pix]; 478 if HGr=HGrStdUnits then inc(used,2); // prefer units not from StdUnits 479 end; 480 if used<LeastUsed then begin Cnt:=0; LeastUsed:=used end; 481 if used=LeastUsed then 482 begin 483 inc(Cnt); 484 if Turn mod Cnt=0 then Picture:=TestPic 485 end; 486 end 487 end; 488 489 begin 490 // look for identical model to assign same picture again 491 if not ForceNew and (Picture.Hash>0) then 492 begin 493 for i:=0 to nPictureList-1 do 494 if PictureList[i].Hash=Picture.Hash then 495 begin 496 Picture.GrName:=GrExt[PictureList[i].HGr].Name; 497 Picture.pix:=PictureList[i].pix; 498 result:=false; 499 exit; 500 end 501 end; 502 503 Picture.pix:=0; 504 TestPic:=Picture; 505 LeastUsed:=MaxInt; 506 507 TestPic.GrName:='StdUnits'; 508 HGr:=HGrStdUnits; 509 for i:=0 to StdUnitScript.Count-1 do 510 begin // look through StdUnits 511 Input:=StdUnitScript[i]; 512 check; 513 end; 514 515 ok:=false; 516 for i:=0 to Script.Count-1 do 517 begin // look through units defined in tribe script 518 Input:=Script[i]; 519 if Copy(Input,1,6)='#UNITS' then 520 begin 521 ok:=true; 522 TestPic.GrName:=Copy(Input,8,255); 523 HGr:=nGrExt-1; 524 while (HGr>=0) and (GrExt[HGr].Name<>TestPic.GrName) do dec(HGr); 525 end 526 else if (Input<>'') and (Input[1]='#') then ok:=false 527 else if ok then check; 528 end; 529 result:=true; 530 end; 623 result := true; 624 end; 531 625 532 626 end. 533 -
trunk/LocalPlayer/UnitStat.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit UnitStat; 4 3 … … 6 5 7 6 uses 8 Protocol,ClientTools,Term,ScreenTools,BaseWin, 9 10 Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,ButtonA,ButtonB, 7 Protocol, ClientTools, Term, ScreenTools, BaseWin, 8 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ButtonA, 10 ButtonB, 11 11 ButtonBase, ButtonC; 12 12 … … 38 38 protected 39 39 mixShow, // for dkOwnModel 40 uixShow, euixShow,ecixShow,41 UnitLoc,AgePrepared: integer;// for dkEnemyUnit, euixShow=-1 ->40 uixShow, euixShow, ecixShow, UnitLoc, AgePrepared: integer; 41 // for dkEnemyUnit, euixShow=-1 -> 42 42 mox: ^TModelInfo; // for dkEnemyModel 43 Kind:(dkOwnModel,dkOwnUnit,dkEnemyModel,dkEnemyUnit,dkEnemyCityDefense,dkEnemyCity); 43 Kind: (dkOwnModel, dkOwnUnit, dkEnemyModel, dkEnemyUnit, dkEnemyCityDefense, 44 dkEnemyCity); 44 45 Back, Template: TBitmap; 45 46 procedure OffscreenPaint; override; … … 56 57 57 58 const 58 xView=71; 59 xTotal=20; StatDown=112; 60 yImp=133; 61 62 // window size 63 wCommon=208; hOwnModel=293; hEnemyModel=236; hEnemyUnit=212; 64 hEnemyCityDefense=320; hEnemyCity=166; hMax=320; 65 59 xView = 71; 60 xTotal = 20; 61 StatDown = 112; 62 yImp = 133; 63 64 // window size 65 wCommon = 208; 66 hOwnModel = 293; 67 hEnemyModel = 236; 68 hEnemyUnit = 212; 69 hEnemyCityDefense = 320; 70 hEnemyCity = 166; 71 hMax = 320; 66 72 67 73 procedure TUnitStatDlg.FormCreate(Sender: TObject); 68 74 begin 69 inherited; 70 AgePrepared:=-2; 71 TitleHeight:=Screen.Height; 72 InitButtons(); 73 74 Back:=TBitmap.Create; 75 Back.PixelFormat:=pf24bit; 76 Back.Width:=5*wCommon; Back.Height:=hMax; 77 Template:=TBitmap.Create; 78 LoadGraphicFile(Template, HomeDir+'Graphics\Unit', gfNoGamma); 79 Template.PixelFormat:=pf8bit; 75 inherited; 76 AgePrepared := -2; 77 TitleHeight := Screen.Height; 78 InitButtons(); 79 80 Back := TBitmap.Create; 81 Back.PixelFormat := pf24bit; 82 Back.Width := 5 * wCommon; 83 Back.Height := hMax; 84 Template := TBitmap.Create; 85 LoadGraphicFile(Template, HomeDir + 'Graphics\Unit', gfNoGamma); 86 Template.PixelFormat := pf8bit; 80 87 end; 81 88 82 89 procedure TUnitStatDlg.FormDestroy(Sender: TObject); 83 90 begin 84 Template.Free;85 Back.Free;91 Template.Free; 92 Back.Free; 86 93 end; 87 94 88 95 procedure TUnitStatDlg.CheckAge; 89 96 begin 90 if MainTextureAge<>AgePrepared then91 begin 92 AgePrepared:=MainTextureAge;93 bitblt(Back.Canvas.Handle,0,0,wCommon,hOwnModel,94 MainTexture.Image.Canvas.Handle,(wMainTexture-wCommon) div 2,95 (hMainTexture-hOwnModel) div 2,SRCCOPY);96 bitblt(Back.Canvas.Handle,wCommon,0,wCommon,hEnemyModel,97 MainTexture.Image.Canvas.Handle,(wMainTexture-wCommon) div 2,98 (hMainTexture-hEnemyModel) div 2,SRCCOPY);99 bitblt(Back.Canvas.Handle,2*wCommon,0,wCommon,hEnemyUnit,100 MainTexture.Image.Canvas.Handle,(wMainTexture-wCommon) div 2,101 (hMainTexture-hEnemyUnit) div 2,SRCCOPY);102 bitblt(Back.Canvas.Handle,3*wCommon,0,wCommon,hEnemyCityDefense,103 MainTexture.Image.Canvas.Handle,(wMainTexture-wCommon) div 2,104 (hMainTexture-hEnemyCityDefense) div 2,SRCCOPY);105 bitblt(Back.Canvas.Handle,4*wCommon,0,wCommon,hEnemyCity,106 MainTexture.Image.Canvas.Handle,(wMainTexture-wCommon) div 2,107 (hMainTexture-hEnemyCity) div 2,SRCCOPY);108 ImageOp_B(Back,Template,0,0,0,0,5*wCommon,hMax);97 if MainTextureAge <> AgePrepared then 98 begin 99 AgePrepared := MainTextureAge; 100 bitblt(Back.Canvas.Handle, 0, 0, wCommon, hOwnModel, 101 MainTexture.Image.Canvas.Handle, (wMainTexture - wCommon) div 2, 102 (hMainTexture - hOwnModel) div 2, SRCCOPY); 103 bitblt(Back.Canvas.Handle, wCommon, 0, wCommon, hEnemyModel, 104 MainTexture.Image.Canvas.Handle, (wMainTexture - wCommon) div 2, 105 (hMainTexture - hEnemyModel) div 2, SRCCOPY); 106 bitblt(Back.Canvas.Handle, 2 * wCommon, 0, wCommon, hEnemyUnit, 107 MainTexture.Image.Canvas.Handle, (wMainTexture - wCommon) div 2, 108 (hMainTexture - hEnemyUnit) div 2, SRCCOPY); 109 bitblt(Back.Canvas.Handle, 3 * wCommon, 0, wCommon, hEnemyCityDefense, 110 MainTexture.Image.Canvas.Handle, (wMainTexture - wCommon) div 2, 111 (hMainTexture - hEnemyCityDefense) div 2, SRCCOPY); 112 bitblt(Back.Canvas.Handle, 4 * wCommon, 0, wCommon, hEnemyCity, 113 MainTexture.Image.Canvas.Handle, (wMainTexture - wCommon) div 2, 114 (hMainTexture - hEnemyCity) div 2, SRCCOPY); 115 ImageOp_B(Back, Template, 0, 0, 0, 0, 5 * wCommon, hMax); 109 116 end 110 117 end; … … 112 119 procedure TUnitStatDlg.FormShow(Sender: TObject); 113 120 var 114 owner, mix: integer;115 IsSpecialUnit: boolean;116 begin 117 if Kind in [dkEnemyUnit,dkEnemyCityDefense,dkEnemyCity] then118 begin 119 if MyMap[UnitLoc] and fUnit<>0 then121 owner, mix: integer; 122 IsSpecialUnit: boolean; 123 begin 124 if Kind in [dkEnemyUnit, dkEnemyCityDefense, dkEnemyCity] then 125 begin 126 if MyMap[UnitLoc] and fUnit <> 0 then 120 127 begin // find model 121 if euixShow<0 then 122 begin 123 euixShow:=MyRO.nEnemyUn-1; 124 while (euixShow>=0) and (MyRO.EnemyUn[euixShow].Loc<>UnitLoc) do dec(euixShow); 125 assert(euixShow>=0); 126 end; 127 with MyRO.EnemyUn[euixShow] do 128 begin 129 mox:=@MyRO.EnemyModel[emix]; 130 if Tribe[Owner].ModelPicture[mix].HGr=0 then 131 InitEnemyModel(emix); 128 if euixShow < 0 then 129 begin 130 euixShow := MyRO.nEnemyUn - 1; 131 while (euixShow >= 0) and (MyRO.EnemyUn[euixShow].Loc <> UnitLoc) do 132 dec(euixShow); 133 assert(euixShow >= 0); 134 end; 135 with MyRO.EnemyUn[euixShow] do 136 begin 137 mox := @MyRO.EnemyModel[emix]; 138 if Tribe[owner].ModelPicture[mix].HGr = 0 then 139 InitEnemyModel(emix); 132 140 end 133 141 end 134 else mox:=nil; 135 if Kind in [dkEnemyCityDefense,dkEnemyCity] then 142 else 143 mox := nil; 144 if Kind in [dkEnemyCityDefense, dkEnemyCity] then 136 145 begin 137 ecixShow:=MyRO.nEnemyCity-1; 138 while (ecixShow>=0) and (MyRO.EnemyCity[ecixShow].Loc<>UnitLoc) do dec(ecixShow); 139 assert(ecixShow>=0); 146 ecixShow := MyRO.nEnemyCity - 1; 147 while (ecixShow >= 0) and (MyRO.EnemyCity[ecixShow].Loc <> UnitLoc) do 148 dec(ecixShow); 149 assert(ecixShow >= 0); 140 150 end 141 151 end; 142 case Kind of143 dkOwnModel: ClientHeight:=hOwnModel;144 dkOwnUnit: ClientHeight:=hEnemyUnit;145 dkEnemyModel: ClientHeight:=hEnemyModel;146 dkEnemyUnit: ClientHeight:=hEnemyUnit;147 dkEnemyCityDefense: ClientHeight:=hEnemyCityDefense;148 dkEnemyCity: ClientHeight:=hEnemyCity;149 end;150 151 if Kind in [dkOwnModel,dkEnemyModel] then152 begin153 Left:=UserLeft;154 Top:=UserTop;155 end156 else157 begin158 Left:=(Screen.Width-Width) div 2;159 Top:=(Screen.Height-Height) div 2;160 end;161 162 SwitchBtn.Visible:= not supervising and (Kind=dkOwnModel);163 ConscriptsBtn.Visible:= not supervising and (Kind=dkOwnModel)164 and (MyRO.Tech[adConscription]>=tsApplicable)165 and (MyModel[mixShow].Domain=dGround) and (MyModel[mixShow].Kind<mkScout);166 IsSpecialUnit:=false;167 if Kind in [dkEnemyCity,dkEnemyCityDefense] then168 Caption:=CityName(MyRO.EnemyCity[ecixShow].ID)169 else170 begin171 152 case Kind of 172 153 dkOwnModel: 173 begin 174 owner:=me; 175 mix:=mixShow; 176 IsSpecialUnit:= MyModel[mix].Kind>=$10; 177 end; 154 ClientHeight := hOwnModel; 178 155 dkOwnUnit: 179 begin 180 owner:=me; 181 mix:=MyUn[uixShow].mix; 182 IsSpecialUnit:= MyModel[mix].Kind>=$10; 183 end 156 ClientHeight := hEnemyUnit; 157 dkEnemyModel: 158 ClientHeight := hEnemyModel; 159 dkEnemyUnit: 160 ClientHeight := hEnemyUnit; 161 dkEnemyCityDefense: 162 ClientHeight := hEnemyCityDefense; 163 dkEnemyCity: 164 ClientHeight := hEnemyCity; 165 end; 166 167 if Kind in [dkOwnModel, dkEnemyModel] then 168 begin 169 Left := UserLeft; 170 Top := UserTop; 171 end 172 else 173 begin 174 Left := (Screen.Width - Width) div 2; 175 Top := (Screen.Height - Height) div 2; 176 end; 177 178 SwitchBtn.Visible := not supervising and (Kind = dkOwnModel); 179 ConscriptsBtn.Visible := not supervising and (Kind = dkOwnModel) and 180 (MyRO.Tech[adConscription] >= tsApplicable) and 181 (MyModel[mixShow].Domain = dGround) and (MyModel[mixShow].Kind < mkScout); 182 IsSpecialUnit := false; 183 if Kind in [dkEnemyCity, dkEnemyCityDefense] then 184 Caption := CityName(MyRO.EnemyCity[ecixShow].ID) 185 else 186 begin 187 case Kind of 188 dkOwnModel: 189 begin 190 owner := me; 191 mix := mixShow; 192 IsSpecialUnit := MyModel[mix].Kind >= $10; 193 end; 194 dkOwnUnit: 195 begin 196 owner := me; 197 mix := MyUn[uixShow].mix; 198 IsSpecialUnit := MyModel[mix].Kind >= $10; 199 end 184 200 else 185 201 begin 186 owner:=mox.owner;187 mix:=mox.mix;188 IsSpecialUnit:= mox.Kind>=$10;202 owner := mox.owner; 203 mix := mox.mix; 204 IsSpecialUnit := mox.Kind >= $10; 189 205 end; 190 206 end; 191 if MainScreen.mNames.Checked then 192 Caption:=Tribe[Owner].ModelName[mix] 193 else Caption:=Format(Tribe[Owner].TPhrase('GENMODEL'),[mix]) 194 end; 195 if IsSpecialUnit then 196 HelpBtn.Hint:=Phrases.Lookup('CONTROLS',6); 197 HelpBtn.Visible:=IsSpecialUnit; 198 OffscreenPaint; 207 if MainScreen.mNames.Checked then 208 Caption := Tribe[owner].ModelName[mix] 209 else 210 Caption := Format(Tribe[owner].TPhrase('GENMODEL'), [mix]) 211 end; 212 if IsSpecialUnit then 213 HelpBtn.Hint := Phrases.Lookup('CONTROLS', 6); 214 HelpBtn.Visible := IsSpecialUnit; 215 OffscreenPaint; 199 216 end; 200 217 201 218 procedure TUnitStatDlg.ShowNewContent_OwnModel(NewMode, mix: integer); 202 219 begin 203 Kind:=dkOwnModel;204 mixShow:=mix;205 inherited ShowNewContent(NewMode);220 Kind := dkOwnModel; 221 mixShow := mix; 222 inherited ShowNewContent(NewMode); 206 223 end; 207 224 208 225 procedure TUnitStatDlg.ShowNewContent_OwnUnit(NewMode, uix: integer); 209 226 begin 210 Kind:=dkOwnUnit;211 uixShow:=uix;212 inherited ShowNewContent(NewMode);227 Kind := dkOwnUnit; 228 uixShow := uix; 229 inherited ShowNewContent(NewMode); 213 230 end; 214 231 215 232 procedure TUnitStatDlg.ShowNewContent_EnemyUnit(NewMode, euix: integer); 216 233 begin 217 Kind:=dkEnemyUnit;218 euixShow:=euix;219 UnitLoc:=MyRO.EnemyUn[euix].Loc;220 inherited ShowNewContent(NewMode);234 Kind := dkEnemyUnit; 235 euixShow := euix; 236 UnitLoc := MyRO.EnemyUn[euix].Loc; 237 inherited ShowNewContent(NewMode); 221 238 end; 222 239 223 240 procedure TUnitStatDlg.ShowNewContent_EnemyLoc(NewMode, Loc: integer); 224 241 begin 225 Kind:=dkEnemyUnit;226 UnitLoc:=Loc;227 euixShow:=-1;228 inherited ShowNewContent(NewMode);242 Kind := dkEnemyUnit; 243 UnitLoc := Loc; 244 euixShow := -1; 245 inherited ShowNewContent(NewMode); 229 246 end; 230 247 231 248 procedure TUnitStatDlg.ShowNewContent_EnemyModel(NewMode, emix: integer); 232 249 begin 233 Kind:=dkEnemyModel;234 mox:=@MyRO.EnemyModel[emix];235 inherited ShowNewContent(NewMode);250 Kind := dkEnemyModel; 251 mox := @MyRO.EnemyModel[emix]; 252 inherited ShowNewContent(NewMode); 236 253 end; 237 254 238 255 procedure TUnitStatDlg.ShowNewContent_EnemyCity(NewMode, Loc: integer); 239 256 begin 240 if MyMap[Loc] and fUnit<>0 then 241 Kind:=dkEnemyCityDefense 242 else Kind:=dkEnemyCity; 243 UnitLoc:=Loc; 244 euixShow:=-1; 245 inherited ShowNewContent(NewMode); 246 end; 247 248 procedure TUnitStatDlg.FormClose(Sender: TObject; 249 var Action: TCloseAction); 250 begin 251 if Kind in [dkOwnModel,dkEnemyModel] then 252 begin UserLeft:=Left; UserTop:=Top end; 253 if OffscreenUser=self then OffscreenUser:=nil; 257 if MyMap[Loc] and fUnit <> 0 then 258 Kind := dkEnemyCityDefense 259 else 260 Kind := dkEnemyCity; 261 UnitLoc := Loc; 262 euixShow := -1; 263 inherited ShowNewContent(NewMode); 264 end; 265 266 procedure TUnitStatDlg.FormClose(Sender: TObject; var Action: TCloseAction); 267 begin 268 if Kind in [dkOwnModel, dkEnemyModel] then 269 begin 270 UserLeft := Left; 271 UserTop := Top 272 end; 273 if OffscreenUser = self then 274 OffscreenUser := nil; 254 275 end; 255 276 256 277 procedure TUnitStatDlg.CloseBtnClick(Sender: TObject); 257 278 begin 258 Close279 Close 259 280 end; 260 281 261 282 procedure TUnitStatDlg.OffscreenPaint; 262 283 var 263 PPicture: ^TModelPicture;284 PPicture: ^TModelPicture; 264 285 265 286 function IsToCount(emix: integer): boolean; 266 287 var 267 PTestPicture: ^TModelPicture;268 begin 269 if MainScreen.mNames.Checked then288 PTestPicture: ^TModelPicture; 289 begin 290 if MainScreen.mNames.Checked then 270 291 begin 271 PTestPicture:=@Tribe[MyRO.EnemyModel[emix].Owner].ModelPicture[MyRO.EnemyModel[emix].mix]; 272 result:= (PPicture.HGr=PTestPicture.HGr) and (PPicture.pix=PTestPicture.pix) 273 and (ModelHash(mox^)=ModelHash(MyRO.EnemyModel[emix])) 292 PTestPicture := @Tribe[MyRO.EnemyModel[emix].owner].ModelPicture 293 [MyRO.EnemyModel[emix].mix]; 294 result := (PPicture.HGr = PTestPicture.HGr) and 295 (PPicture.pix = PTestPicture.pix) and 296 (ModelHash(mox^) = ModelHash(MyRO.EnemyModel[emix])) 274 297 end 275 else result:= (MyRO.EnemyModel[emix].Owner=mox.Owner) 276 and (MyRO.EnemyModel[emix].mix=mox.mix) 277 end; 278 279 procedure FeatureBar(dst: TBitmap; x,y: integer; const mi: TModelInfo; 298 else 299 result := (MyRO.EnemyModel[emix].owner = mox.owner) and 300 (MyRO.EnemyModel[emix].mix = mox.mix) 301 end; 302 303 procedure FeatureBar(dst: TBitmap; x, y: integer; const mi: TModelInfo; 280 304 const T: TTexture); 281 305 var 282 i,w,dx,num: integer;283 s: string;284 begin 285 DarkGradient(dst.Canvas,x-6,y+1,180,1);286 with dst.Canvas do287 if mi.Kind>=$10 then288 begin 289 s:=Phrases.Lookup('UNITSPECIAL');290 Font.Color:=$000000;291 Textout(x-1,y+1,s);292 Font.Color:=$B0B0B0;293 Textout(x-2,y,s);306 i, w, dx, num: integer; 307 s: string; 308 begin 309 DarkGradient(dst.Canvas, x - 6, y + 1, 180, 1); 310 with dst.Canvas do 311 if mi.Kind >= $10 then 312 begin 313 s := Phrases.Lookup('UNITSPECIAL'); 314 Font.Color := $000000; 315 Textout(x - 1, y + 1, s); 316 Font.Color := $B0B0B0; 317 Textout(x - 2, y, s); 294 318 end 295 else 296 begin 297 Font.Color:=$000000; 298 dx:=2; 299 for i:=3 to nFeature-1 do 300 begin 301 num:=0; 302 case i of 303 mcSeaTrans: if mi.Domain=dSea then num:=mi.TTrans; 304 mcCarrier: if mi.Domain=dSea then num:=mi.ATrans_Fuel; 305 mcBombs: num:=mi.Bombs; 306 mcFuel: if mi.Domain=dAir then num:=mi.ATrans_Fuel; 307 mcAirTrans: if mi.Domain=dAir then num:=mi.TTrans; 308 mcFirstNonCap..nFeature-1: 309 if mi.Cap and (1 shl (i-mcFirstNonCap))<>0 then num:=1 319 else 320 begin 321 Font.Color := $000000; 322 dx := 2; 323 for i := 3 to nFeature - 1 do 324 begin 325 num := 0; 326 case i of 327 mcSeaTrans: 328 if mi.Domain = dSea then 329 num := mi.TTrans; 330 mcCarrier: 331 if mi.Domain = dSea then 332 num := mi.ATrans_Fuel; 333 mcBombs: 334 num := mi.Bombs; 335 mcFuel: 336 if mi.Domain = dAir then 337 num := mi.ATrans_Fuel; 338 mcAirTrans: 339 if mi.Domain = dAir then 340 num := mi.TTrans; 341 mcFirstNonCap .. nFeature - 1: 342 if mi.Cap and (1 shl (i - mcFirstNonCap)) <> 0 then 343 num := 1 310 344 end; 311 if (num>0) and ((i<>mcSE) or (mi.Cap and (1 shl (mcNP-mcFirstNonCap))=0)) then 345 if (num > 0) and 346 ((i <> mcSE) or (mi.Cap and (1 shl (mcNP - mcFirstNonCap)) = 0)) 347 then 312 348 begin 313 if num>1 then349 if num > 1 then 314 350 begin 315 s:=IntToStr(num);316 w:=TextWidth(s);317 Brush.Color:=$FFFFFF;318 FillRect(Rect(x-3+dx,y+2,x+w-1+dx,y+16));319 Brush.Style:=bsClear;320 Textout(x-3+dx+1,y,s);321 inc(dx,w+1)351 s := IntToStr(num); 352 w := TextWidth(s); 353 Brush.Color := $FFFFFF; 354 FillRect(Rect(x - 3 + dx, y + 2, x + w - 1 + dx, y + 16)); 355 Brush.Style := bsClear; 356 Textout(x - 3 + dx + 1, y, s); 357 inc(dx, w + 1) 322 358 end; 323 Brush.Color:=$C0C0C0; 324 FrameRect(Rect(x-3+dx,y+2,x+11+dx,y+16)); 325 Brush.Style:=bsClear; 326 Sprite(dst,HGrSystem,x-1+dx,y+4,10,10,66+i mod 11 *11,137+i div 11 *11); 327 inc(dx,15) 359 Brush.Color := $C0C0C0; 360 FrameRect(Rect(x - 3 + dx, y + 2, x + 11 + dx, y + 16)); 361 Brush.Style := bsClear; 362 Sprite(dst, HGrSystem, x - 1 + dx, y + 4, 10, 10, 363 66 + i mod 11 * 11, 137 + i div 11 * 11); 364 inc(dx, 15) 328 365 end; 329 366 end 330 367 end 331 end; {featurebar}332 333 procedure NumberBarS(dst: TBitmap; x,y:integer;334 Cap,s: string;const T: TTexture);335 begin 336 DLine(dst.Canvas,x-2,x+170,y+16,T.clBevelShade,T.clBevelLight);337 LoweredTextOut(dst.Canvas,-1,T,x-2,y,Cap);338 RisedTextout(dst.canvas,x+170-BiColorTextWidth(dst.Canvas,s),y,s);368 end; { featurebar } 369 370 procedure NumberBarS(dst: TBitmap; x, y: integer; Cap, s: string; 371 const T: TTexture); 372 begin 373 DLine(dst.Canvas, x - 2, x + 170, y + 16, T.clBevelShade, T.clBevelLight); 374 LoweredTextOut(dst.Canvas, -1, T, x - 2, y, Cap); 375 RisedTextout(dst.Canvas, x + 170 - BiColorTextWidth(dst.Canvas, s), y, s); 339 376 end; 340 377 341 378 var 342 i,j,x,y,cix,uix,emix,InProd,Available,Destroyed,Loc,Cnt,yView,yTotal, 343 yCaption: integer; 344 s: string; 345 ui: TUnitInfo; 346 mi: TModelInfo; 347 begin 348 inherited; 349 350 case Kind of 351 dkOwnModel: 352 begin 353 bitblt(offscreen.canvas.handle,0,0,wCommon,hOwnModel,Back.Canvas.handle,0,0,SRCCOPY); 354 yView:=13; 355 yTotal:=92; 356 end; 357 dkEnemyModel: 358 begin 359 bitblt(offscreen.canvas.handle,0,0,wCommon,hEnemyModel,Back.Canvas.handle,wCommon,0,SRCCOPY); 360 yView:=13; 361 yTotal:=92; 362 end; 363 dkEnemyUnit,dkOwnUnit: 364 begin 365 bitblt(offscreen.canvas.handle,0,0,wCommon,hEnemyUnit,Back.Canvas.handle,2*wCommon,0,SRCCOPY); 366 yView:=13; 367 yTotal:=123; 368 end; 369 dkEnemyCityDefense: 370 begin 371 bitblt(offscreen.canvas.handle,0,0,wCommon,hEnemyCityDefense,Back.Canvas.handle,3*wCommon,0,SRCCOPY); 372 yView:=171; 373 yTotal:=231; 374 end; 375 dkEnemyCity: 376 begin 377 bitblt(offscreen.canvas.handle,0,0,wCommon,hEnemyCity,Back.Canvas.handle,4*wCommon,0,SRCCOPY); 378 end; 379 end; 380 MarkUsedOffscreen(ClientWidth,ClientHeight); 381 HelpBtn.Top:=yTotal+22; 382 383 if Kind in [dkEnemyCityDefense,dkEnemyCity] then 379 i, j, x, y, cix, uix, emix, InProd, Available, Destroyed, Loc, Cnt, yView, 380 yTotal, yCaption: integer; 381 s: string; 382 ui: TUnitInfo; 383 mi: TModelInfo; 384 begin 385 inherited; 386 387 case Kind of 388 dkOwnModel: 389 begin 390 bitblt(offscreen.Canvas.Handle, 0, 0, wCommon, hOwnModel, 391 Back.Canvas.Handle, 0, 0, SRCCOPY); 392 yView := 13; 393 yTotal := 92; 394 end; 395 dkEnemyModel: 396 begin 397 bitblt(offscreen.Canvas.Handle, 0, 0, wCommon, hEnemyModel, 398 Back.Canvas.Handle, wCommon, 0, SRCCOPY); 399 yView := 13; 400 yTotal := 92; 401 end; 402 dkEnemyUnit, dkOwnUnit: 403 begin 404 bitblt(offscreen.Canvas.Handle, 0, 0, wCommon, hEnemyUnit, 405 Back.Canvas.Handle, 2 * wCommon, 0, SRCCOPY); 406 yView := 13; 407 yTotal := 123; 408 end; 409 dkEnemyCityDefense: 410 begin 411 bitblt(offscreen.Canvas.Handle, 0, 0, wCommon, hEnemyCityDefense, 412 Back.Canvas.Handle, 3 * wCommon, 0, SRCCOPY); 413 yView := 171; 414 yTotal := 231; 415 end; 416 dkEnemyCity: 417 begin 418 bitblt(offscreen.Canvas.Handle, 0, 0, wCommon, hEnemyCity, 419 Back.Canvas.Handle, 4 * wCommon, 0, SRCCOPY); 420 end; 421 end; 422 MarkUsedOffscreen(ClientWidth, ClientHeight); 423 HelpBtn.Top := yTotal + 22; 424 425 if Kind in [dkEnemyCityDefense, dkEnemyCity] then 384 426 begin // show city defense facilities 385 cnt:=0; 386 for i:=0 to 3 do 387 if MyRO.EnemyCity[ecixShow].Flags and (2 shl i)<>0 then 388 inc(cnt); 389 x:=(wCommon-cnt*xSizeSmall) div 2 -(cnt-1)*2; 390 for i:=0 to 3 do 391 if MyRO.EnemyCity[ecixShow].Flags and (2 shl i)<>0 then 392 begin 393 case i of 394 0: j:=imWalls; 395 1: j:=imCoastalFort; 396 2: j:=imMissileBat; 397 3: j:=imBunker 427 Cnt := 0; 428 for i := 0 to 3 do 429 if MyRO.EnemyCity[ecixShow].Flags and (2 shl i) <> 0 then 430 inc(Cnt); 431 x := (wCommon - Cnt * xSizeSmall) div 2 - (Cnt - 1) * 2; 432 for i := 0 to 3 do 433 if MyRO.EnemyCity[ecixShow].Flags and (2 shl i) <> 0 then 434 begin 435 case i of 436 0: 437 j := imWalls; 438 1: 439 j := imCoastalFort; 440 2: 441 j := imMissileBat; 442 3: 443 j := imBunker 398 444 end; 399 Frame(offscreen.Canvas,x-1,yImp-1,x+xSizeSmall,yImp+ySizeSmall, 400 MainTexture.clBevelLight,MainTexture.clBevelShade); 401 BitBlt(offscreen.Canvas.Handle,x,yImp,xSizeSmall,ySizeSmall, 402 SmallImp.Canvas.Handle,j mod 7*xSizeSmall, 403 (j+SystemIconLines*7) div 7*ySizeSmall,SRCCOPY); 404 inc(x,xSizeSmall+4) 405 end; 406 end; 407 408 if Kind=dkEnemyModel then 409 begin 410 PPicture:=@Tribe[mox.Owner].ModelPicture[mox.mix]; 411 Available:=0; 412 if G.Difficulty[me]=0 then // supervisor -- count stacked units too 413 for Loc:=0 to G.lx*G.ly-1 do 414 begin 415 if MyMap[Loc] and fUnit<>0 then 416 begin 417 Server(sGetUnits,me,Loc,Cnt); 418 for uix:=0 to Cnt-1 do 419 if IsToCount(MyRO.EnemyUn[MyRO.nEnemyUn+uix].emix) then 420 inc(Available); 445 Frame(offscreen.Canvas, x - 1, yImp - 1, x + xSizeSmall, 446 yImp + ySizeSmall, MainTexture.clBevelLight, 447 MainTexture.clBevelShade); 448 bitblt(offscreen.Canvas.Handle, x, yImp, xSizeSmall, ySizeSmall, 449 SmallImp.Canvas.Handle, j mod 7 * xSizeSmall, 450 (j + SystemIconLines * 7) div 7 * ySizeSmall, SRCCOPY); 451 inc(x, xSizeSmall + 4) 452 end; 453 end; 454 455 if Kind = dkEnemyModel then 456 begin 457 PPicture := @Tribe[mox.owner].ModelPicture[mox.mix]; 458 Available := 0; 459 if G.Difficulty[me] = 0 then // supervisor -- count stacked units too 460 for Loc := 0 to G.lx * G.ly - 1 do 461 begin 462 if MyMap[Loc] and fUnit <> 0 then 463 begin 464 Server(sGetUnits, me, Loc, Cnt); 465 for uix := 0 to Cnt - 1 do 466 if IsToCount(MyRO.EnemyUn[MyRO.nEnemyUn + uix].emix) then 467 inc(Available); 421 468 end 422 469 end 423 else // no supervisor -- can only count stack top units 424 for uix:=0 to MyRO.nEnemyUn-1 do 425 if (MyRO.EnemyUn[uix].Loc>=0) and IsToCount(MyRO.EnemyUn[uix].emix) then 470 else // no supervisor -- can only count stack top units 471 for uix := 0 to MyRO.nEnemyUn - 1 do 472 if (MyRO.EnemyUn[uix].Loc >= 0) and IsToCount(MyRO.EnemyUn[uix].emix) 473 then 474 inc(Available); 475 Destroyed := 0; 476 for emix := 0 to MyRO.nEnemyModel - 1 do 477 if IsToCount(emix) then 478 inc(Destroyed, MyRO.EnemyModel[emix].Lost); 479 end 480 else 481 begin 482 Available := 0; 483 for uix := 0 to MyRO.nUn - 1 do 484 if (MyUn[uix].Loc >= 0) and (MyUn[uix].mix = mixShow) then 426 485 inc(Available); 427 Destroyed:=0; 428 for emix:=0 to MyRO.nEnemyModel-1 do if IsToCount(emix) then 429 inc(Destroyed,MyRO.EnemyModel[emix].Lost); 430 end 431 else 432 begin 433 Available:=0; 434 for uix:=0 to MyRO.nUn-1 do 435 if (MyUn[uix].Loc>=0) and (MyUn[uix].mix=mixShow) then inc(Available); 436 InProd:=0; 437 for cix:=0 to MyRO.nCity-1 do 438 if (MyCity[cix].Loc>=0) and (MyCity[cix].Project and (cpImp+cpIndex)=mixShow) then 439 inc(InProd); 440 end; 441 442 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 443 if Kind in [dkEnemyCityDefense,dkEnemyCity] then 444 begin 445 NoMap.SetOutput(offscreen); 446 NoMap.PaintCity(ClientWidth div 2,53,MyRO.EnemyCity[ecixShow],false); 447 448 s:=Tribe[MyRO.EnemyCity[ecixShow].Owner].TPhrase('UNITOWNER'); 449 LoweredTextOut(offscreen.Canvas, -1, MainTexture, 450 (ClientWidth-BiColorTextWidth(offscreen.Canvas,s)) div 2, 105, s); 451 end; 452 453 if Kind<>dkEnemyCity then 486 InProd := 0; 487 for cix := 0 to MyRO.nCity - 1 do 488 if (MyCity[cix].Loc >= 0) and 489 (MyCity[cix].Project and (cpImp + cpIndex) = mixShow) then 490 inc(InProd); 491 end; 492 493 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 494 if Kind in [dkEnemyCityDefense, dkEnemyCity] then 495 begin 496 NoMap.SetOutput(offscreen); 497 NoMap.PaintCity(ClientWidth div 2, 53, MyRO.EnemyCity[ecixShow], false); 498 499 s := Tribe[MyRO.EnemyCity[ecixShow].owner].TPhrase('UNITOWNER'); 500 LoweredTextOut(offscreen.Canvas, -1, MainTexture, 501 (ClientWidth - BiColorTextWidth(offscreen.Canvas, s)) div 2, 105, s); 502 end; 503 504 if Kind <> dkEnemyCity then 454 505 begin // show unit stats 455 if Kind=dkOwnModel then456 MakeModelInfo(me,mixShow,MyModel[mixShow],mi)457 else if Kind=dkOwnUnit then506 if Kind = dkOwnModel then 507 MakeModelInfo(me, mixShow, MyModel[mixShow], mi) 508 else if Kind = dkOwnUnit then 458 509 begin 459 MakeUnitInfo(me,MyUn[uixShow],ui);460 MakeModelInfo(me,MyUn[uixShow].mix,MyModel[MyUn[uixShow].mix],mi)510 MakeUnitInfo(me, MyUn[uixShow], ui); 511 MakeModelInfo(me, MyUn[uixShow].mix, MyModel[MyUn[uixShow].mix], mi) 461 512 end 462 else513 else 463 514 begin 464 mi:=mox^;465 if Kind in [dkEnemyUnit,dkEnemyCityDefense] then466 ui:=MyRO.EnemyUn[euixShow]515 mi := mox^; 516 if Kind in [dkEnemyUnit, dkEnemyCityDefense] then 517 ui := MyRO.EnemyUn[euixShow] 467 518 end; 468 519 469 with Tribe[mi.Owner].ModelPicture[mi.mix] do520 with Tribe[mi.owner].ModelPicture[mi.mix] do 470 521 begin 471 if Kind in [dkOwnUnit,dkEnemyUnit,dkEnemyCityDefense] then with ui do 472 begin 473 {Frame(offscreen.canvas,xView-1,yView-1,xView+64,yView+48, 474 MainTexture.clBevelShade,MainTexture.clBevelLight); 475 RFrame(offscreen.canvas,xView-2,yView-2,xView+65,yView+49, 476 MainTexture.clBevelShade,MainTexture.clBevelLight);} 477 with offscreen.canvas do 478 begin 479 Brush.Color:=GrExt[HGrSystem].Data.Canvas.Pixels[98,67]; 480 offscreen.canvas.FillRect(Rect(xView,yView,xView+64,yView+16)); 481 Brush.Style:=bsClear; 522 if Kind in [dkOwnUnit, dkEnemyUnit, dkEnemyCityDefense] then 523 with ui do 524 begin 525 { Frame(offscreen.canvas,xView-1,yView-1,xView+64,yView+48, 526 MainTexture.clBevelShade,MainTexture.clBevelLight); 527 RFrame(offscreen.canvas,xView-2,yView-2,xView+65,yView+49, 528 MainTexture.clBevelShade,MainTexture.clBevelLight); } 529 with offscreen.Canvas do 530 begin 531 Brush.Color := GrExt[HGrSystem].Data.Canvas.Pixels[98, 67]; 532 offscreen.Canvas.FillRect(Rect(xView, yView, xView + 64, 533 yView + 16)); 534 Brush.Style := bsClear; 535 end; 536 537 if MyMap[Loc] and fTerrain >= fForest then 538 begin 539 x := 1 + 2 * (xxt * 2 + 1); 540 y := 1 + yyt + 2 * (yyt * 3 + 1) 541 end 542 else 543 begin 544 x := integer(MyMap[Loc] and fTerrain) * (xxt * 2 + 1) + 1; 545 y := 1 + yyt 546 end; 547 for j := -1 to 1 do 548 for i := -1 to 1 do 549 if (i + j) and 1 = 0 then 550 begin 551 Sprite(Buffer, HGrTerrain, i * xxt, j * yyt, xxt * 2, 552 yyt * 2, x, y); 553 if MyMap[Loc] and (fTerrain or fSpecial) = fGrass or fSpecial1 554 then 555 Sprite(Buffer, HGrTerrain, i * xxt, j * yyt, xxt * 2, yyt * 2, 556 1 + 2 * (xxt * 2 + 1), 1 + yyt + 1 * (yyt * 3 + 1)) 557 else if (MyMap[Loc] and fTerrain = fForest) and 558 IsJungle(Loc div G.lx) then 559 Sprite(Buffer, HGrTerrain, i * xxt, j * yyt, xxt * 2, yyt * 2, 560 1 + 7 * (xxt * 2 + 1), 1 + yyt + 19 * (yyt * 3 + 1)) 561 else if MyMap[Loc] and fTerrain >= fForest then 562 Sprite(Buffer, HGrTerrain, i * xxt, j * yyt, xxt * 2, yyt * 2, 563 1 + 7 * (xxt * 2 + 1), 564 1 + yyt + 2 * integer(2 + MyMap[Loc] and fTerrain - fForest) 565 * (yyt * 3 + 1)); 566 end; 567 bitblt(offscreen.Canvas.Handle, xView, yView + 16, 64, 32, 568 Buffer.Canvas.Handle, 1, 0, SRCCOPY); 569 570 // show unit, experience and health 571 Sprite(offscreen, HGr, xView, yView, 64, 48, pix mod 10 * 65 + 1, 572 pix div 10 * 49 + 1); 573 if Flags and unFortified <> 0 then 574 Sprite(offscreen, HGrStdUnits, xView, yView, xxu * 2, yyu * 2, 575 1 + 6 * (xxu * 2 + 1), 1); 576 FrameImage(offscreen.Canvas, GrExt[HGrSystem].Data, xView - 20, 577 yView + 5, 12, 14, 121 + Exp div ExpCost * 13, 28); 578 if Health < 100 then 579 begin 580 s := IntToStr(Health) + '%'; 581 LightGradient(offscreen.Canvas, xView - 45, yView + 24, 38, 582 (ColorOfHealth(Health) and $FEFEFE shr 2) * 3); 583 RisedTextout(offscreen.Canvas, xView - 45 + 20 - 584 BiColorTextWidth(offscreen.Canvas, s) div 2, yView + 23, s); 585 end; 586 587 if Kind = dkEnemyUnit then 588 begin 589 s := Tribe[mox.owner].TPhrase('UNITOWNER'); 590 LoweredTextOut(offscreen.Canvas, -1, MainTexture, 591 (ClientWidth - BiColorTextWidth(offscreen.Canvas, s)) div 2, 592 yView + 80, s); 593 end 594 end 595 else 596 begin 597 FrameImage(offscreen.Canvas, BigImp, xView + 4, yView, 56, 40, 0, 0); 598 Sprite(offscreen, HGr, xView, yView - 4, 64, 44, pix mod 10 * 65 + 1, 599 pix div 10 * 49 + 1); 600 end; 601 602 DarkGradient(offscreen.Canvas, xTotal - 6, yTotal + 1, 180, 2); 603 RisedTextout(offscreen.Canvas, xTotal - 2, yTotal, 604 Phrases.Lookup('UNITSTRENGTH')); 605 s := IntToStr(mi.Attack) + '/' + IntToStr(mi.Defense); 606 RisedTextout(offscreen.Canvas, 607 xTotal + 170 - BiColorTextWidth(offscreen.Canvas, s), yTotal, s); 608 FeatureBar(offscreen, xTotal, yTotal + 19, mi, MainTexture); 609 NumberBarS(offscreen, xTotal, yTotal + 38, Phrases.Lookup('UNITSPEED'), 610 MovementToString(mi.Speed), MainTexture); 611 LoweredTextOut(offscreen.Canvas, -1, MainTexture, xTotal - 2, yTotal + 57, 612 Phrases.Lookup('UNITCOST')); 613 DLine(offscreen.Canvas, xTotal - 2, xTotal + 170, yTotal + 57 + 16, 614 MainTexture.clBevelShade, MainTexture.clBevelLight); 615 if G.Difficulty[me] = 0 then 616 s := IntToStr(mi.cost) 617 else 618 s := IntToStr(mi.cost * BuildCostMod[G.Difficulty[me]] div 12); 619 RisedTextout(offscreen.Canvas, 620 xTotal + 159 - BiColorTextWidth(offscreen.Canvas, s), yTotal + 57, s); 621 Sprite(offscreen, HGrSystem, xTotal + 160, yTotal + 57 + 5, 10, 622 10, 88, 115); 623 624 if Kind = dkOwnModel then 625 begin 626 if MyModel[mixShow].IntroTurn > 0 then 627 begin 628 if MyModel[mixShow].Kind = mkEnemyDeveloped then 629 LoweredTextOut(offscreen.Canvas, -1, MainTexture, xTotal - 2, 630 (yTotal + StatDown - 19), Phrases.Lookup('UNITADOPT')) 631 else 632 LoweredTextOut(offscreen.Canvas, -1, MainTexture, xTotal - 2, 633 (yTotal + StatDown - 19), Phrases.Lookup('UNITINTRO')); 634 DLine(offscreen.Canvas, xTotal - 2, xTotal + 170, 635 (yTotal + StatDown - 19) + 16, MainTexture.clTextShade, 636 MainTexture.clTextLight); 637 s := TurnToString(MyModel[mixShow].IntroTurn); 638 RisedTextout(offscreen.Canvas, 639 xTotal + 170 - BiColorTextWidth(offscreen.Canvas, s), 640 (yTotal + StatDown - 19), s); 482 641 end; 483 642 484 if MyMap[Loc] and fTerrain>=fForest then 485 begin x:=1+2*(xxt*2+1); y:=1+yyt+2*(yyt*3+1) end 486 else begin x:=integer(MyMap[Loc] and fTerrain) *(xxt*2+1)+1; y:=1+yyt end; 487 for j:=-1 to 1 do for i:=-1 to 1 do if (i+j) and 1=0 then 488 begin 489 Sprite(Buffer,HGrTerrain,i*xxt,j*yyt,xxt*2,yyt*2,x,y); 490 if MyMap[Loc] and (fTerrain or fSpecial)=fGrass or fSpecial1 then 491 Sprite(Buffer,HGrTerrain,i*xxt,j*yyt,xxt*2,yyt*2,1+2*(xxt*2+1), 492 1+yyt+1*(yyt*3+1)) 493 else if (MyMap[Loc] and fTerrain=fForest) 494 and IsJungle(Loc div G.lx) then 495 Sprite(Buffer,HGrTerrain,i*xxt,j*yyt,xxt*2,yyt*2,1+7*(xxt*2+1), 496 1+yyt+19*(yyt*3+1)) 497 else if MyMap[Loc] and fTerrain>=fForest then 498 Sprite(Buffer,HGrTerrain,i*xxt,j*yyt,xxt*2,yyt*2,1+7*(xxt*2+1), 499 1+yyt+2*integer(2+MyMap[Loc] and fTerrain-fForest)*(yyt*3+1)); 643 NumberBar(offscreen, xTotal, yTotal + StatDown, 644 Phrases.Lookup('UNITBUILT'), MyModel[mixShow].Built, MainTexture); 645 if MyModel[mixShow].Lost > 0 then 646 NumberBar(offscreen, xTotal, yTotal + StatDown + 19, 647 Phrases.Lookup('UNITLOST'), MyModel[mixShow].Lost, MainTexture); 648 if InProd > 0 then 649 NumberBar(offscreen, xTotal, yTotal + StatDown + 57, 650 Phrases.Lookup('UNITINPROD'), InProd, MainTexture); 651 if Available > 0 then 652 NumberBar(offscreen, xTotal, yTotal + StatDown + 38, 653 Phrases.Lookup('UNITAVAILABLE'), Available, MainTexture); 654 655 if MyModel[mixShow].Status and msObsolete <> 0 then 656 begin 657 SwitchBtn.ButtonIndex := 12; 658 SwitchBtn.Hint := Phrases.Lookup('BTN_OBSOLETE'); 659 end 660 else 661 begin 662 SwitchBtn.ButtonIndex := 11; 663 SwitchBtn.Hint := Phrases.Lookup('BTN_NONOBSOLETE'); 500 664 end; 501 BitBlt(offscreen.canvas.handle,xView,yView+16,64,32,Buffer.Canvas.Handle,1,0, 502 SRCCOPY); 503 504 // show unit, experience and health 505 Sprite(offscreen,HGr,xView,yView,64,48,pix mod 10 *65+1,pix div 10*49+1); 506 if Flags and unFortified<>0 then 507 Sprite(offscreen,HGrStdUnits,xView,yView,xxu*2,yyu*2,1+6*(xxu*2+1),1); 508 FrameImage(offscreen.canvas,GrExt[HGrSystem].Data,xView-20,yView+5,12,14, 509 121+Exp div ExpCost *13,28); 510 if Health<100 then 511 begin 512 s:=IntToStr(Health)+'%'; 513 LightGradient(offscreen.canvas,xView-45,yView+24,38, 514 (ColorOfHealth(Health) and $FEFEFE shr 2)*3); 515 RisedTextOut(offscreen.canvas,xView-45+20-BiColorTextWidth(offscreen.Canvas,s) div 2, 516 yView+23,s); 517 end; 518 519 if Kind=dkEnemyUnit then 520 begin 521 s:=Tribe[mox.Owner].TPhrase('UNITOWNER'); 522 LoweredTextOut(offscreen.Canvas, -1, MainTexture, 523 (ClientWidth-BiColorTextWidth(offscreen.Canvas,s)) div 2, yView+80, s); 665 if MyModel[mixShow].Status and msAllowConscripts = 0 then 666 begin 667 ConscriptsBtn.ButtonIndex := 30; 668 ConscriptsBtn.Hint := Phrases.Lookup('BTN_NOCONSCRIPTS'); 669 end 670 else 671 begin 672 ConscriptsBtn.ButtonIndex := 29; 673 ConscriptsBtn.Hint := Phrases.Lookup('BTN_ALLOWCONSCRIPTS'); 524 674 end 525 675 end 526 else 527 begin 528 FrameImage(offscreen.canvas,BigImp,xView+4,yView,56,40,0,0); 529 Sprite(offscreen,HGr,xView,yView-4,64,44,pix mod 10 *65+1,pix div 10*49+1); 530 end; 531 532 DarkGradient(offscreen.Canvas,xTotal-6,yTotal+1,180,2); 533 RisedTextOut(offscreen.Canvas,xTotal-2,yTotal,Phrases.Lookup('UNITSTRENGTH')); 534 s:=IntToStr(mi.Attack)+'/'+IntToStr(mi.Defense); 535 RisedTextOut(offscreen.Canvas,xTotal+170-BiColorTextWidth(Offscreen.Canvas,s),yTotal,s); 536 FeatureBar(offscreen,xTotal,yTotal+19,mi,MainTexture); 537 NumberBarS(offscreen,xTotal,yTotal+38,Phrases.Lookup('UNITSPEED'),MovementToString(mi.Speed),MainTexture); 538 LoweredTextOut(offscreen.Canvas,-1,MainTexture,xTotal-2,yTotal+57,Phrases.Lookup('UNITCOST')); 539 DLine(offscreen.Canvas,xTotal-2,xTotal+170,yTotal+57+16, 540 MainTexture.clBevelShade,MainTexture.clBevelLight); 541 if G.Difficulty[me]=0 then s:=IntToStr(mi.cost) 542 else s:=IntToStr(mi.cost*BuildCostMod[G.Difficulty[me]] div 12); 543 RisedTextout(offscreen.Canvas,xTotal+159-BiColorTextWidth(Offscreen.Canvas,s),yTotal+57,s); 544 Sprite(offscreen,HGrSystem,xTotal+160,yTotal+57+5,10,10,88,115); 545 546 if Kind=dkOwnModel then 547 begin 548 if MyModel[mixShow].IntroTurn>0 then 549 begin 550 if MyModel[mixShow].Kind=mkEnemyDeveloped then 551 LoweredTextOut(offscreen.Canvas,-1,MainTexture,xTotal-2,(yTotal+StatDown-19),Phrases.Lookup('UNITADOPT')) 552 else LoweredTextOut(offscreen.Canvas,-1,MainTexture,xTotal-2,(yTotal+StatDown-19),Phrases.Lookup('UNITINTRO')); 553 DLine(offscreen.Canvas,xTotal-2,xTotal+170,(yTotal+StatDown-19)+16, 554 MainTexture.clTextShade,MainTexture.clTextLight); 555 s:=TurnToString(MyModel[mixShow].IntroTurn); 556 RisedTextOut(offscreen.Canvas,xTotal+170-BiColorTextWidth(Offscreen.Canvas,s),(yTotal+StatDown-19),s); 557 end; 558 559 NumberBar(offscreen,xTotal,yTotal+StatDown,Phrases.Lookup('UNITBUILT'),MyModel[mixShow].Built,MainTexture); 560 if MyModel[mixShow].Lost>0 then 561 NumberBar(offscreen,xTotal,yTotal+StatDown+19,Phrases.Lookup('UNITLOST'),MyModel[mixShow].Lost,MainTexture); 562 if InProd>0 then 563 NumberBar(offscreen,xTotal,yTotal+StatDown+57,Phrases.Lookup('UNITINPROD'),InProd,MainTexture); 564 if Available>0 then 565 NumberBar(offscreen,xTotal,yTotal+StatDown+38,Phrases.Lookup('UNITAVAILABLE'),Available,MainTexture); 566 567 if MyModel[mixShow].Status and msObsolete<>0 then 568 begin 569 SwitchBtn.ButtonIndex:=12; 570 SwitchBtn.Hint:=Phrases.Lookup('BTN_OBSOLETE'); 571 end 572 else 573 begin 574 SwitchBtn.ButtonIndex:=11; 575 SwitchBtn.Hint:=Phrases.Lookup('BTN_NONOBSOLETE'); 576 end; 577 if MyModel[mixShow].Status and msAllowConscripts=0 then 578 begin 579 ConscriptsBtn.ButtonIndex:=30; 580 ConscriptsBtn.Hint:=Phrases.Lookup('BTN_NOCONSCRIPTS'); 581 end 582 else 583 begin 584 ConscriptsBtn.ButtonIndex:=29; 585 ConscriptsBtn.Hint:=Phrases.Lookup('BTN_ALLOWCONSCRIPTS'); 586 end 587 end 588 else if Kind=dkEnemyModel then 589 begin 590 if Destroyed>0 then 591 NumberBar(offscreen,xTotal,yTotal+StatDown-19,Phrases.Lookup('UNITDESTROYED'),Destroyed,MainTexture); 592 if Available>0 then 593 NumberBar(offscreen,xTotal,yTotal+StatDown,Phrases.Lookup('UNITKNOWN'),Available,MainTexture); 676 else if Kind = dkEnemyModel then 677 begin 678 if Destroyed > 0 then 679 NumberBar(offscreen, xTotal, yTotal + StatDown - 19, 680 Phrases.Lookup('UNITDESTROYED'), Destroyed, MainTexture); 681 if Available > 0 then 682 NumberBar(offscreen, xTotal, yTotal + StatDown, 683 Phrases.Lookup('UNITKNOWN'), Available, MainTexture); 594 684 end 595 685 end; 596 686 end; 597 687 598 offscreen.Canvas.Font.Assign(UniFont[ftNormal]); 599 case Kind of 600 dkOwnModel,dkEnemyModel: yCaption:=yView+46; 601 dkEnemyUnit,dkOwnUnit: yCaption:=yView+54; 602 dkEnemyCityDefense,dkEnemyCity: yCaption:=79; 603 end; 604 RisedTextOut(offscreen.Canvas, (ClientWidth-BiColorTextWidth(offscreen.Canvas,caption)) div 2, yCaption, caption); 605 end; {OffscreenPaint} 688 offscreen.Canvas.Font.Assign(UniFont[ftNormal]); 689 case Kind of 690 dkOwnModel, dkEnemyModel: 691 yCaption := yView + 46; 692 dkEnemyUnit, dkOwnUnit: 693 yCaption := yView + 54; 694 dkEnemyCityDefense, dkEnemyCity: 695 yCaption := 79; 696 end; 697 RisedTextout(offscreen.Canvas, 698 (ClientWidth - BiColorTextWidth(offscreen.Canvas, Caption)) div 2, 699 yCaption, Caption); 700 end; { OffscreenPaint } 606 701 607 702 procedure TUnitStatDlg.ModelBoxChange(Sender: TObject); 608 703 begin 609 SmartUpdateContent704 SmartUpdateContent 610 705 end; 611 706 612 707 procedure TUnitStatDlg.SwitchBtnClick(Sender: TObject); 613 708 begin 614 MyModel[mixShow].Status:=MyModel[mixShow].Status xor msObsolete;615 if MyModel[mixShow].Status and msObsolete<>0 then616 begin 617 SwitchBtn.ButtonIndex:=12;618 SwitchBtn.Hint:=Phrases.Lookup('BTN_OBSOLETE');709 MyModel[mixShow].Status := MyModel[mixShow].Status xor msObsolete; 710 if MyModel[mixShow].Status and msObsolete <> 0 then 711 begin 712 SwitchBtn.ButtonIndex := 12; 713 SwitchBtn.Hint := Phrases.Lookup('BTN_OBSOLETE'); 619 714 end 620 else621 begin 622 SwitchBtn.ButtonIndex:=11;623 SwitchBtn.Hint:=Phrases.Lookup('BTN_NONOBSOLETE');715 else 716 begin 717 SwitchBtn.ButtonIndex := 11; 718 SwitchBtn.Hint := Phrases.Lookup('BTN_NONOBSOLETE'); 624 719 end 625 720 end; … … 627 722 procedure TUnitStatDlg.ConscriptsBtnClick(Sender: TObject); 628 723 begin 629 MyModel[mixShow].Status:=MyModel[mixShow].Status xor msAllowConscripts;630 if MyModel[mixShow].Status and msAllowConscripts=0 then631 begin 632 ConscriptsBtn.ButtonIndex:=30;633 ConscriptsBtn.Hint:=Phrases.Lookup('BTN_NOCONSCRIPTS');724 MyModel[mixShow].Status := MyModel[mixShow].Status xor msAllowConscripts; 725 if MyModel[mixShow].Status and msAllowConscripts = 0 then 726 begin 727 ConscriptsBtn.ButtonIndex := 30; 728 ConscriptsBtn.Hint := Phrases.Lookup('BTN_NOCONSCRIPTS'); 634 729 end 635 else636 begin 637 ConscriptsBtn.ButtonIndex:=29;638 ConscriptsBtn.Hint:=Phrases.Lookup('BTN_ALLOWCONSCRIPTS');730 else 731 begin 732 ConscriptsBtn.ButtonIndex := 29; 733 ConscriptsBtn.Hint := Phrases.Lookup('BTN_ALLOWCONSCRIPTS'); 639 734 end 640 735 end; … … 642 737 procedure TUnitStatDlg.HelpBtnClick(Sender: TObject); 643 738 begin 644 HelpDlg.ShowNewContent(wmPersistent, hkModel, 0)739 HelpDlg.ShowNewContent(wmPersistent, hkModel, 0) 645 740 end; 646 741 647 742 end. 648 -
trunk/LocalPlayer/Wonders.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit Wonders; 4 3 … … 6 5 7 6 uses 8 ScreenTools, BaseWin,Protocol,7 ScreenTools, BaseWin, Protocol, 9 8 10 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, … … 16 15 procedure FormCreate(Sender: TObject); 17 16 procedure CloseBtnClick(Sender: TObject); 18 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, 19 Y: Integer); 17 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); 20 18 procedure FormShow(Sender: TObject); 21 19 procedure FormMouseDown(Sender: TObject; Button: TMouseButton; … … 24 22 public 25 23 procedure OffscreenPaint; override; 26 procedure ShowNewContent(NewMode: integer);24 procedure ShowNewContent(NewMode: Integer); 27 25 28 26 private 29 xm, ym,Selection: integer;27 xm, ym, Selection: Integer; 30 28 end; 31 29 … … 36 34 37 35 uses 38 Term, ClientTools, Help,Tribes;36 Term, ClientTools, Help, Tribes; 39 37 40 38 {$R *.DFM} 41 39 42 40 const 43 RingPosition: array[0..20,0..1] of integer= 44 ((-80,-32), // Pyramids 45 (80,-32), // Zeus 46 (0,-64), // Gardens 47 (0,0), // Colossus 48 (0,64), // Lighthouse 49 (-80,32), // GrLibrary 50 (-90,114), // Oracle 51 (80,32), // Sun 52 (90,-114), // Leo 53 (-180,0), // Magellan 54 (90,114), // Mich 55 (0,0), //{11;} 56 (180,0), // Newton 57 (-90,-114), // Bach 58 (0,0), //{14;} 59 (-160,-64), // Liberty 60 (0,128), // Eiffel 61 (160,-64), // Hoover 62 (-160,64), // Shinkansen 63 (0,-128), // Manhattan 64 (160,64)); // Mir 65 41 RingPosition: array [0 .. 20, 0 .. 1] of Integer = ((-80, -32), // Pyramids 42 (80, -32), // Zeus 43 (0, -64), // Gardens 44 (0, 0), // Colossus 45 (0, 64), // Lighthouse 46 (-80, 32), // GrLibrary 47 (-90, 114), // Oracle 48 (80, 32), // Sun 49 (90, -114), // Leo 50 (-180, 0), // Magellan 51 (90, 114), // Mich 52 (0, 0), // {11;} 53 (180, 0), // Newton 54 (-90, -114), // Bach 55 (0, 0), // {14;} 56 (-160, -64), // Liberty 57 (0, 128), // Eiffel 58 (160, -64), // Hoover 59 (-160, 64), // Shinkansen 60 (0, -128), // Manhattan 61 (160, 64)); // Mir 66 62 67 63 procedure TWondersDlg.FormCreate(Sender: TObject); 68 64 begin 69 Canvas.Font.Assign(UniFont[ftNormal]);70 Canvas.Brush.Style:=bsClear;71 InitButtons();65 Canvas.Font.Assign(UniFont[ftNormal]); 66 Canvas.Brush.Style := bsClear; 67 InitButtons(); 72 68 end; 73 69 74 70 procedure TWondersDlg.FormShow(Sender: TObject); 75 71 begin 76 Selection:=-1;77 OffscreenPaint;78 end; 79 80 procedure TWondersDlg.ShowNewContent(NewMode: integer);81 begin 82 inherited ShowNewContent(NewMode);72 Selection := -1; 73 OffscreenPaint; 74 end; 75 76 procedure TWondersDlg.ShowNewContent(NewMode: Integer); 77 begin 78 inherited ShowNewContent(NewMode); 83 79 end; 84 80 85 81 procedure TWondersDlg.OffscreenPaint; 86 82 type 87 TLine=array[0..649,0..2] of Byte;88 89 procedure DarkIcon(i: integer);83 TLine = array [0 .. 649, 0 .. 2] of Byte; 84 85 procedure DarkIcon(i: Integer); 90 86 var 91 x,y,ch,x0Dst,y0Dst,x0Src,y0Src,darken,c: integer;92 Src,Dst: ^TLine;93 begin 94 x0Dst:=ClientWidth div 2-xSizeBig div 2+RingPosition[i,0];95 y0Dst:=ClientHeight div 2-ySizeBig div 2+RingPosition[i,1];96 x0Src:=(i mod 7)*xSizeBig;97 y0Src:=(i div 7+SystemIconLines)*ySizeBig;98 for y:=0 to ySizeBig-1 do99 begin 100 Src:=BigImp.ScanLine[y0Src+y];101 Dst:=Offscreen.ScanLine[y0Dst+y];102 for x:=0 to xSizeBig-1 do87 X, Y, ch, x0Dst, y0Dst, x0Src, y0Src, darken, c: Integer; 88 Src, Dst: ^TLine; 89 begin 90 x0Dst := ClientWidth div 2 - xSizeBig div 2 + RingPosition[i, 0]; 91 y0Dst := ClientHeight div 2 - ySizeBig div 2 + RingPosition[i, 1]; 92 x0Src := (i mod 7) * xSizeBig; 93 y0Src := (i div 7 + SystemIconLines) * ySizeBig; 94 for Y := 0 to ySizeBig - 1 do 95 begin 96 Src := BigImp.ScanLine[y0Src + Y]; 97 Dst := Offscreen.ScanLine[y0Dst + Y]; 98 for X := 0 to xSizeBig - 1 do 103 99 begin 104 darken:=((255-Src[x0Src+x][0])*3 105 +(255-Src[x0Src+x][1])*15 106 +(255-Src[x0Src+x][2])*9) div 128; 107 for ch:=0 to 2 do 100 darken := ((255 - Src[x0Src + X][0]) * 3 + (255 - Src[x0Src + X][1]) * 101 15 + (255 - Src[x0Src + X][2]) * 9) div 128; 102 for ch := 0 to 2 do 108 103 begin 109 c:=Dst[x0Dst+x][ch]-darken; 110 if c<0 then Dst[x0Dst+x][ch]:=0 111 else Dst[x0Dst+x][ch]:=c; 104 c := Dst[x0Dst + X][ch] - darken; 105 if c < 0 then 106 Dst[x0Dst + X][ch] := 0 107 else 108 Dst[x0Dst + X][ch] := c; 112 109 end 113 110 end … … 115 112 end; 116 113 117 procedure Glow(i, GlowColor: integer);118 begin 119 GlowFrame(Offscreen, ClientWidth div 2-xSizeBig div 2+RingPosition[i,0],120 ClientHeight div 2-ySizeBig div 2+RingPosition[i,1],121 xSizeBig,ySizeBig, GlowColor);114 procedure Glow(i, GlowColor: Integer); 115 begin 116 GlowFrame(Offscreen, ClientWidth div 2 - xSizeBig div 2 + RingPosition[i, 117 0], ClientHeight div 2 - ySizeBig div 2 + RingPosition[i, 1], xSizeBig, 118 ySizeBig, GlowColor); 122 119 end; 123 120 124 121 const 125 darken=24;126 // space=pi/120;127 amax0=15734; // 1 shl 16*tan(pi/12-space);128 amin1=19413; // 1 shl 16*tan(pi/12+space);129 amax1=62191; // 1 shl 16*tan(pi/4-space);130 amin2=69061; // 1 shl 16*tan(pi/4+space);131 amax2=221246; // 1 shl 16*tan(5*pi/12-space);132 amin3=272977; // 1 shl 16*tan(5*pi/12+space);122 darken = 24; 123 // space=pi/120; 124 amax0 = 15734; // 1 shl 16*tan(pi/12-space); 125 amin1 = 19413; // 1 shl 16*tan(pi/12+space); 126 amax1 = 62191; // 1 shl 16*tan(pi/4-space); 127 amin2 = 69061; // 1 shl 16*tan(pi/4+space); 128 amax2 = 221246; // 1 shl 16*tan(5*pi/12-space); 129 amin3 = 272977; // 1 shl 16*tan(5*pi/12+space); 133 130 var 134 i,x,y,r,ax,ch,c: integer; 135 HaveWonder: boolean; 136 Line: array[0..1] of ^TLine; 137 s: string; 138 begin 139 if (OffscreenUser<>nil) and (OffscreenUser<>self) then OffscreenUser.Update; 131 i, X, Y, r, ax, ch, c: Integer; 132 HaveWonder: boolean; 133 Line: array [0 .. 1] of ^TLine; 134 s: string; 135 begin 136 if (OffscreenUser <> nil) and (OffscreenUser <> self) then 137 OffscreenUser.Update; 140 138 // complete working with old owner to prevent rebound 141 OffscreenUser:=self; 142 143 Fill(Offscreen.Canvas,3,3,ClientWidth-6,ClientHeight-6, 144 (wMaintexture-ClientWidth) div 2,(hMaintexture-ClientHeight) div 2); 145 Frame(Offscreen.Canvas,0,0,ClientWidth-1,ClientHeight-1,0,0); 146 Frame(Offscreen.Canvas,1,1,ClientWidth-2,ClientHeight-2,MainTexture.clBevelLight,MainTexture.clBevelShade); 147 Frame(Offscreen.Canvas,2,2,ClientWidth-3,ClientHeight-3,MainTexture.clBevelLight,MainTexture.clBevelShade); 148 Corner(Offscreen.Canvas,1,1,0,MainTexture); 149 Corner(Offscreen.Canvas,ClientWidth-9,1,1,MainTexture); 150 Corner(Offscreen.Canvas,1,ClientHeight-9,2,MainTexture); 151 Corner(Offscreen.Canvas,ClientWidth-9,ClientHeight-9,3,MainTexture); 152 153 BtnFrame(Offscreen.Canvas,CloseBtn.BoundsRect,MainTexture); 154 155 Offscreen.Canvas.Font.Assign(UniFont[ftCaption]); 156 s:=Phrases.Lookup('TITLE_WONDERS'); 157 RisedTextOut(Offscreen.Canvas,(ClientWidth-BiColorTextWidth(Offscreen.Canvas,s)) div 2-1,7,s); 158 Offscreen.Canvas.Font.Assign(UniFont[ftNormal]); 159 160 xm:=ClientWidth div 2; 161 ym:=ClientHeight div 2; 162 for y:=0 to 127 do 163 begin 164 Line[0]:=Offscreen.Scanline[ym+y]; 165 Line[1]:=Offscreen.Scanline[ym-1-y]; 166 for x:=0 to 179 do 167 begin 168 r:=x*x*(32*32)+y*y*(45*45); 169 ax:=((1 shl 16 div 32)*45)*y; 170 if (r<8*128*180*180) 171 and ((r>=32*64*90*90) and (ax<amax2*x) and ((ax<amax0*x) or (ax>amin2*x)) 172 or (ax>amin1*x) and ((ax<amax1*x) or (ax>amin3*x))) then 173 for i:=0 to 1 do for ch:=0 to 2 do 139 OffscreenUser := self; 140 141 Fill(Offscreen.Canvas, 3, 3, ClientWidth - 6, ClientHeight - 6, 142 (wMaintexture - ClientWidth) div 2, (hMaintexture - ClientHeight) div 2); 143 Frame(Offscreen.Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0); 144 Frame(Offscreen.Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2, 145 MainTexture.clBevelLight, MainTexture.clBevelShade); 146 Frame(Offscreen.Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3, 147 MainTexture.clBevelLight, MainTexture.clBevelShade); 148 Corner(Offscreen.Canvas, 1, 1, 0, MainTexture); 149 Corner(Offscreen.Canvas, ClientWidth - 9, 1, 1, MainTexture); 150 Corner(Offscreen.Canvas, 1, ClientHeight - 9, 2, MainTexture); 151 Corner(Offscreen.Canvas, ClientWidth - 9, ClientHeight - 9, 3, MainTexture); 152 153 BtnFrame(Offscreen.Canvas, CloseBtn.BoundsRect, MainTexture); 154 155 Offscreen.Canvas.Font.Assign(UniFont[ftCaption]); 156 s := Phrases.Lookup('TITLE_WONDERS'); 157 RisedTextOut(Offscreen.Canvas, 158 (ClientWidth - BiColorTextWidth(Offscreen.Canvas, s)) div 2 - 1, 7, s); 159 Offscreen.Canvas.Font.Assign(UniFont[ftNormal]); 160 161 xm := ClientWidth div 2; 162 ym := ClientHeight div 2; 163 for Y := 0 to 127 do 164 begin 165 Line[0] := Offscreen.ScanLine[ym + Y]; 166 Line[1] := Offscreen.ScanLine[ym - 1 - Y]; 167 for X := 0 to 179 do 168 begin 169 r := X * X * (32 * 32) + Y * Y * (45 * 45); 170 ax := ((1 shl 16 div 32) * 45) * Y; 171 if (r < 8 * 128 * 180 * 180) and 172 ((r >= 32 * 64 * 90 * 90) and (ax < amax2 * X) and 173 ((ax < amax0 * X) or (ax > amin2 * X)) or (ax > amin1 * X) and 174 ((ax < amax1 * X) or (ax > amin3 * X))) then 175 for i := 0 to 1 do 176 for ch := 0 to 2 do 174 177 begin 175 c:=Line[i][xm+x][ch]-darken; 176 if c<0 then Line[i][xm+x][ch]:=0 177 else Line[i][xm+x][ch]:=c; 178 c:=Line[i][xm-1-x][ch]-darken; 179 if c<0 then Line[i][xm-1-x][ch]:=0 180 else Line[i][xm-1-x][ch]:=c; 178 c := Line[i][xm + X][ch] - darken; 179 if c < 0 then 180 Line[i][xm + X][ch] := 0 181 else 182 Line[i][xm + X][ch] := c; 183 c := Line[i][xm - 1 - X][ch] - darken; 184 if c < 0 then 185 Line[i][xm - 1 - X][ch] := 0 186 else 187 Line[i][xm - 1 - X][ch] := c; 181 188 end 182 189 end; 183 190 end; 184 191 185 HaveWonder:=false; 186 for i:=0 to 20 do if Imp[i].Preq<>preNA then 187 begin 188 case MyRO.Wonder[i].CityID of 189 -1: // not built yet 192 HaveWonder := false; 193 for i := 0 to 20 do 194 if Imp[i].Preq <> preNA then 195 begin 196 case MyRO.Wonder[i].CityID of 197 - 1: // not built yet 198 begin 199 Fill(Offscreen.Canvas, xm - xSizeBig div 2 + RingPosition[i, 0] - 3, 200 ym - ySizeBig div 2 + RingPosition[i, 1] - 3, xSizeBig + 6, 201 ySizeBig + 6, (wMaintexture - ClientWidth) div 2, 202 (hMaintexture - ClientHeight) div 2); 203 DarkIcon(i); 204 end; 205 -2: // destroyed 206 begin 207 HaveWonder := true; 208 Glow(i, $000000); 209 BitBlt(Offscreen.Canvas.Handle, xm - xSizeBig div 2 + RingPosition 210 [i, 0], ym - ySizeBig div 2 + RingPosition[i, 1], xSizeBig, 211 ySizeBig, BigImp.Canvas.Handle, 0, (SystemIconLines + 3) * 212 ySizeBig, SRCCOPY); 213 end; 214 else 215 begin 216 HaveWonder := true; 217 if MyRO.Wonder[i].EffectiveOwner >= 0 then 218 Glow(i, Tribe[MyRO.Wonder[i].EffectiveOwner].Color) 219 else 220 Glow(i, $000000); 221 BitBlt(Offscreen.Canvas.Handle, xm - xSizeBig div 2 + RingPosition[i, 222 0], ym - ySizeBig div 2 + RingPosition[i, 1], xSizeBig, ySizeBig, 223 BigImp.Canvas.Handle, (i mod 7) * xSizeBig, 224 (i div 7 + SystemIconLines) * ySizeBig, SRCCOPY); 225 end 226 end 227 end; 228 229 if not HaveWonder then 230 begin 231 s := Phrases.Lookup('NOWONDER'); 232 RisedTextOut(Offscreen.Canvas, xm - BiColorTextWidth(Offscreen.Canvas, s) 233 div 2, ym - Offscreen.Canvas.TextHeight(s) div 2, s); 234 end; 235 236 MarkUsedOffscreen(ClientWidth, ClientHeight); 237 end; { OffscreenPaint } 238 239 procedure TWondersDlg.CloseBtnClick(Sender: TObject); 240 begin 241 Close 242 end; 243 244 procedure TWondersDlg.FormMouseMove(Sender: TObject; Shift: TShiftState; 245 X, Y: Integer); 246 var 247 i, OldSelection: Integer; 248 s: string; 249 begin 250 OldSelection := Selection; 251 Selection := -1; 252 for i := 0 to 20 do 253 if (Imp[i].Preq <> preNA) and (X >= xm - xSizeBig div 2 + RingPosition[i, 0] 254 ) and (X < xm + xSizeBig div 2 + RingPosition[i, 0]) and 255 (Y >= ym - ySizeBig div 2 + RingPosition[i, 1]) and 256 (Y < ym + ySizeBig div 2 + RingPosition[i, 1]) then 257 begin 258 Selection := i; 259 break 260 end; 261 if Selection <> OldSelection then 262 begin 263 Fill(Canvas, 9, ClientHeight - 3 - 46, ClientWidth - 18, 44, 264 (wMaintexture - ClientWidth) div 2, (hMaintexture - ClientHeight) div 2); 265 if Selection >= 0 then 266 begin 267 if MyRO.Wonder[Selection].CityID = -1 then 268 begin // not built yet 269 { s:=Phrases.Lookup('IMPROVEMENTS',Selection); 270 Canvas.Font.Color:=$000000; 271 Canvas.TextOut( 272 (ClientWidth-BiColorTextWidth(Canvas,s)) div 2+1, 273 ClientHeight-3-36+1, s); 274 Canvas.Font.Color:=MainTexture.clBevelLight; 275 Canvas.TextOut( 276 (ClientWidth-BiColorTextWidth(Canvas,s)) div 2, 277 ClientHeight-3-36, s); } 278 end 279 else 190 280 begin 191 Fill(Offscreen.Canvas, 192 xm-xSizeBig div 2+RingPosition[i,0]-3, 193 ym-ySizeBig div 2+RingPosition[i,1]-3, 194 xSizeBig+6, ySizeBig+6, 195 (wMaintexture-ClientWidth) div 2,(hMaintexture-ClientHeight) div 2); 196 DarkIcon(i); 197 end; 198 -2: // destroyed 199 begin 200 HaveWonder:=true; 201 Glow(i,$000000); 202 BitBlt(Offscreen.Canvas.Handle, xm-xSizeBig div 2+RingPosition[i,0], 203 ym-ySizeBig div 2+RingPosition[i,1], xSizeBig, ySizeBig, 204 BigImp.Canvas.Handle, 0, (SystemIconLines+3)*ySizeBig, SRCCOPY); 205 end; 206 else 207 begin 208 HaveWonder:=true; 209 if MyRO.Wonder[i].EffectiveOwner>=0 then 210 Glow(i,Tribe[MyRO.Wonder[i].EffectiveOwner].Color) 211 else Glow(i,$000000); 212 BitBlt(Offscreen.Canvas.Handle, xm-xSizeBig div 2+RingPosition[i,0], 213 ym-ySizeBig div 2+RingPosition[i,1], xSizeBig, ySizeBig, 214 BigImp.Canvas.Handle, (i mod 7)*xSizeBig, 215 (i div 7+SystemIconLines)*ySizeBig, SRCCOPY); 216 end 217 end 218 end; 219 220 if not HaveWonder then 221 begin 222 s:=Phrases.Lookup('NOWONDER'); 223 RisedTextout(Offscreen.Canvas,xm-BiColorTextWidth(Offscreen.Canvas,s) div 2, 224 ym-Offscreen.Canvas.TextHeight(s) div 2, s); 225 end; 226 227 MarkUsedOffscreen(ClientWidth,ClientHeight); 228 end; {OffscreenPaint} 229 230 procedure TWondersDlg.CloseBtnClick(Sender: TObject); 231 begin 232 Close 233 end; 234 235 procedure TWondersDlg.FormMouseMove(Sender: TObject; Shift: TShiftState; X, 236 Y: Integer); 237 var 238 i,OldSelection: integer; 239 s: string; 240 begin 241 OldSelection:=Selection; 242 Selection:=-1; 243 for i:=0 to 20 do 244 if (Imp[i].Preq<>preNA) and (x>=xm-xSizeBig div 2+RingPosition[i,0]) 245 and (x<xm+xSizeBig div 2+RingPosition[i,0]) 246 and (y>=ym-ySizeBig div 2+RingPosition[i,1]) 247 and (y<ym+ySizeBig div 2+RingPosition[i,1]) then 248 begin Selection:=i; break end; 249 if Selection<>OldSelection then 250 begin 251 Fill(Canvas,9,ClientHeight-3-46,ClientWidth-18,44, 252 (wMaintexture-ClientWidth) div 2,(hMaintexture-ClientHeight) div 2); 253 if Selection>=0 then 254 begin 255 if MyRO.Wonder[Selection].CityID=-1 then 256 begin // not built yet 257 { s:=Phrases.Lookup('IMPROVEMENTS',Selection); 258 Canvas.Font.Color:=$000000; 259 Canvas.TextOut( 260 (ClientWidth-BiColorTextWidth(Canvas,s)) div 2+1, 261 ClientHeight-3-36+1, s); 262 Canvas.Font.Color:=MainTexture.clBevelLight; 263 Canvas.TextOut( 264 (ClientWidth-BiColorTextWidth(Canvas,s)) div 2, 265 ClientHeight-3-36, s);} 266 end 267 else 268 begin 269 s:=Phrases.Lookup('IMPROVEMENTS',Selection); 270 if MyRO.Wonder[Selection].CityID<>-2 then 271 s:=Format(Phrases.Lookup('WONDEROF'), 272 [s,CityName(MyRO.Wonder[Selection].CityID)]); 273 LoweredTextOut(Canvas, -1, MainTexture, (ClientWidth-BiColorTextWidth(Canvas,s)) div 2, 274 ClientHeight-3-36-10, s); 275 if MyRO.Wonder[Selection].CityID=-2 then 276 s:=Phrases.Lookup('DESTROYED') 277 else if MyRO.Wonder[Selection].EffectiveOwner<0 then 278 s:=Phrases.Lookup('EXPIRED') 279 else s:=Tribe[MyRO.Wonder[Selection].EffectiveOwner].TPhrase('WONDEROWNER'); 280 LoweredTextOut(Canvas, -1, MainTexture, (ClientWidth-BiColorTextWidth(Canvas,s)) div 2, 281 ClientHeight-3-36+10, s); 281 s := Phrases.Lookup('IMPROVEMENTS', Selection); 282 if MyRO.Wonder[Selection].CityID <> -2 then 283 s := Format(Phrases.Lookup('WONDEROF'), 284 [s, CityName(MyRO.Wonder[Selection].CityID)]); 285 LoweredTextOut(Canvas, -1, MainTexture, 286 (ClientWidth - BiColorTextWidth(Canvas, s)) div 2, 287 ClientHeight - 3 - 36 - 10, s); 288 if MyRO.Wonder[Selection].CityID = -2 then 289 s := Phrases.Lookup('DESTROYED') 290 else if MyRO.Wonder[Selection].EffectiveOwner < 0 then 291 s := Phrases.Lookup('EXPIRED') 292 else 293 s := Tribe[MyRO.Wonder[Selection].EffectiveOwner] 294 .TPhrase('WONDEROWNER'); 295 LoweredTextOut(Canvas, -1, MainTexture, 296 (ClientWidth - BiColorTextWidth(Canvas, s)) div 2, 297 ClientHeight - 3 - 36 + 10, s); 282 298 end 283 299 end; … … 288 304 Shift: TShiftState; X, Y: Integer); 289 305 begin 290 if Selection>=0 then291 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkImp, Selection);306 if Selection >= 0 then 307 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkImp, Selection); 292 308 end; 293 309 294 310 end. 295
Note:
See TracChangeset
for help on using the changeset viewer.