Changeset 210 for branches/highdpi/Start.pas
- Timestamp:
- May 9, 2020, 4:02:07 PM (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/highdpi/Start.pas
r193 r210 5 5 6 6 uses 7 GameServer, Messg, ButtonBase, ButtonA, ButtonC, ButtonB, Area, Math,7 UDpiControls, GameServer, Messg, ButtonBase, ButtonA, ButtonC, ButtonB, Area, 8 8 LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, 9 Menus, Registry, DrawDlg, fgl, Protocol, UDpiControls; 10 11 const 12 // main actions 13 nMainActions = 5; 14 maConfig = 0; 15 maManual = 1; 16 maCredits = 2; 17 maAIDev = 3; 18 maWeb = 4; 9 Menus, Registry, DrawDlg, fgl, Protocol; 19 10 20 11 type … … 40 31 ); 41 32 42 TStartTab = ( 43 tbMain, 44 tbMap, 45 tbNew, 46 tbPrevious 47 ); 33 TStartTab = (tbMain, tbMap, tbNew, tbPrevious); 34 TMainAction = (maConfig, maManual, maCredits, maAIDev, maWeb, maNone); 35 TMainActionSet = set of TMainAction; 48 36 49 37 TMapArray = array[0 .. lxmax * lymax - 1] of Byte; 38 39 TMiniMode = (mmNone, mmPicture, mmMultiPlayer); 40 41 { TMiniMap } 42 43 TMiniMap = class 44 const 45 MaxWidthMapLogo = 96; 46 MaxHeightMapLogo = 96; 47 var 48 Bitmap: TDpiBitmap; { game world sample preview } 49 Size: TPoint; 50 Colors: array [0 .. 11, 0 .. 1] of TColor; 51 Mode: TMiniMode; 52 procedure LoadFromLogFile(FileName: string; var LastTurn: Integer); 53 procedure LoadFromMapFile(FileName: string; var nMapLandTiles, nMapStartPositions: Integer); 54 procedure PaintRandom(Brightness, StartLandMass, WorldSize: Integer); 55 procedure PaintFile(SaveMap: TMapArray); 56 constructor Create; 57 destructor Destroy; override; 58 end; 50 59 51 60 { TStartDlg } … … 72 81 procedure FormShow(Sender: TObject); 73 82 procedure FormHide(Sender: TObject); 83 procedure FormClose(Sender: TObject; var Action: TCloseAction); 74 84 procedure FormCreate(Sender: TObject); 75 85 procedure FormDestroy(Sender: TObject); 76 86 procedure BrainClick(Sender: TObject); 87 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 77 88 procedure FormMouseDown(Sender: TObject; Button: TMouseButton; 78 89 Shift: TShiftState; x, y: integer); 90 procedure FormMouseUp(Sender: TObject; Button: TMouseButton; 91 Shift: TShiftState; x, y: integer); 92 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; x, y: integer); 79 93 procedure Up1BtnClick(Sender: TObject); 80 94 procedure Down1BtnClick(Sender: TObject); 81 procedure FormClose(Sender: TObject; var Action: TCloseAction);82 95 procedure ListClick(Sender: TObject); 83 96 procedure RenameBtnClick(Sender: TObject); … … 88 101 procedure Down2BtnClick(Sender: TObject); 89 102 procedure QuitBtnClick(Sender: TObject); 90 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);91 103 procedure CustomizeBtnClick(Sender: TObject); 92 104 procedure AutoDiffUpBtnClick(Sender: TObject); 93 105 procedure AutoDiffDownBtnClick(Sender: TObject); 94 procedure FormMouseUp(Sender: TObject; Button: TMouseButton;95 Shift: TShiftState; x, y: integer);96 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; x, y: integer);97 106 procedure AutoEnemyUpBtnClick(Sender: TObject); 98 107 procedure AutoEnemyDownBtnClick(Sender: TObject); … … 109 118 AutoDiff: Integer; 110 119 MultiControl: Integer; 111 MiniWidth: Integer;112 MiniHeight: Integer;113 SelectedAction: Integer;114 120 Page: TStartPage; 115 121 ShowTab: TStartTab; … … 126 132 ListIndex: array [TStartTab] of Integer; 127 133 MapFileName: string; 128 FormerGames , Maps: TStringList;129 LogoBuffer, Mini: TDpiBitmap; { game world sample preview }130 MiniColors: array [0 .. 11, 0 .. 1] of TColor;134 FormerGames: TStringList; 135 Maps: TStringList; 136 LogoBuffer: TDpiBitmap; 131 137 // BookDate: string; 132 138 PlayerSlots: TPlayerSlots; 133 MiniMode: (mmNone, mmPicture, mmMultiPlayer); 134 ActionsOffered: set of 0 .. nMainActions - 1; 135 TurnValid, Tracking: boolean; 139 ActionsOffered: TMainActionSet; 140 SelectedAction: TMainAction; 141 TurnValid: Boolean; 142 Tracking: Boolean; 136 143 DefaultAI: string; 144 MiniMap: TMiniMap; 137 145 procedure DrawAction(y, IconIndex: integer; HeaderItem, TextItem: string); 138 146 procedure InitPopup(PlayerIndex: Integer); 139 147 procedure OfferBrain(Brain: TBrain; FixedLines: Integer); 140 procedure PaintFileMini(SaveMap: TMapArray);141 148 procedure PaintInfo; 142 149 procedure ChangePage(NewPage: TStartPage); 143 150 procedure ChangeTab(NewTab: TStartTab); 144 procedure PaintRandomMini(Brightness: integer);145 151 procedure UnlistBackupFile(FileName: string); 146 152 procedure SmartInvalidate(x0, y0, x1, y1: integer; 147 153 invalidateTab0: boolean = false); overload; 148 154 procedure LoadConfig; 155 procedure SaveConfig; 156 procedure LoadAiBrainsPictures; 157 procedure UpdateInterface; 149 158 end; 150 159 … … 152 161 StartDlg: TStartDlg; 153 162 163 154 164 implementation 155 165 156 166 uses 157 Directories, Direct, ScreenTools, Inp, Back, Locale;167 Global, Directories, Direct, ScreenTools, Inp, Back, Locale, UPixelPointer; 158 168 159 169 {$R *.lfm} 160 170 161 171 const 162 CevoExt = '.cevo';163 CevoMapExt = '.cevo map';164 172 // predefined world size 165 173 // attention: lx*ly+1 must be prime! 166 { nWorldSize=8;174 { MaxWorldSize=8; 167 175 lxpre: array[0..nWorldSize-1] of integer =(30,40,50,60,70,90,110,130); 168 176 lypre: array[0..nWorldSize-1] of integer =(46,52,60,70,84,94,110,130); 169 177 DefaultWorldTiles=4200; } 170 nWorldSize = 6; 171 lxpre: array [0 .. nWorldSize - 1] of integer = (30, 40, 50, 60, 75, 100); 172 lypre: array [0 .. nWorldSize - 1] of integer = (46, 52, 60, 70, 82, 96); 178 MaxWorldSize = 6; 179 WorldSizes: array [0 .. MaxWorldSize - 1] of TPoint = ((X: 30; Y: 46), 180 (X: 40; Y: 52), (X: 50; Y: 60), (X: 60; Y: 70), (X: 75; Y: 82), 181 (X: 100; Y: 96)); 173 182 DefaultWorldTiles = 4150; 174 183 DefaultWorldSize = 3; … … 206 215 TabHeight = 40; 207 216 208 MaxWidthMapLogo = 96;209 MaxHeightMapLogo = 96;210 211 217 InitAlive: array [1 .. nPl] of integer = (1, 1 + 2, 1 + 2 + 32, 212 218 1 + 2 + 8 + 128, 1 + 2 + 8 + 32 + 128, 1 + 2 + 8 + 16 + 64 + 128, … … 219 225 EnemyAutoDiff: array [1 .. 5] of integer = (4, 3, 2, 1, 1); 220 226 227 { TMiniMap } 228 229 constructor TMiniMap.Create; 230 var 231 X, Y: Integer; 232 begin 233 Bitmap := TDpiBitmap.Create; 234 235 for X := 0 to 11 do 236 for Y := 0 to 1 do 237 Colors[x, y] := GrExt[HGrSystem].Data.Canvas.Pixels[66 + x, 67 + y]; 238 end; 239 240 destructor TMiniMap.Destroy; 241 begin 242 FreeAndNil(Bitmap); 243 inherited Destroy; 244 end; 245 246 procedure TMiniMap.LoadFromLogFile(FileName: string; var LastTurn: Integer); 247 var 248 SaveMap: TMapArray; 249 y: Integer; 250 Dummy: Integer; 251 FileLandMass: integer; 252 LogFile: file; 253 s: string[255]; 254 MapRow: array [0 .. lxmax - 1] of Cardinal; 255 begin 256 AssignFile(LogFile, FileName); 257 try 258 Reset(LogFile, 4); 259 BlockRead(LogFile, s[1], 2); { file id } 260 BlockRead(LogFile, Dummy, 1); { format id } 261 if Dummy >= $000E01 then 262 BlockRead(LogFile, Dummy, 1); { item stored since 0.14.1 } 263 BlockRead(LogFile, Size.X, 1); 264 BlockRead(LogFile, Size.Y, 1); 265 BlockRead(LogFile, FileLandMass, 1); 266 if FileLandMass = 0 then 267 for y := 0 to Size.Y - 1 do 268 BlockRead(LogFile, MapRow, Size.X); 269 BlockRead(LogFile, Dummy, 1); 270 BlockRead(LogFile, Dummy, 1); 271 BlockRead(LogFile, LastTurn, 1); 272 BlockRead(LogFile, SaveMap, 1); 273 if SaveMap[0] = $80 then 274 Mode := mmMultiPlayer 275 else 276 Mode := mmPicture; 277 if Mode = mmPicture then 278 BlockRead(LogFile, SaveMap[4], (Size.X * Size.Y - 1) div 4); 279 CloseFile(LogFile); 280 except 281 CloseFile(LogFile); 282 LastTurn := 0; 283 Size := WorldSizes[DefaultWorldSize]; 284 Mode := mmNone; 285 end; 286 PaintFile(SaveMap); 287 end; 288 289 procedure TMiniMap.LoadFromMapFile(FileName: string; var nMapLandTiles, nMapStartPositions: Integer); 290 var 291 x, y, lxFile, lyFile: integer; 292 MapFile: file; 293 s: string[255]; 294 MapRow: array [0 .. lxmax - 1] of Cardinal; 295 ImageFileName: string; 296 begin 297 ImageFileName := Copy(FileName, 1, Length(FileName) - Length(CevoMapExt)) + '.png'; 298 Mode := mmPicture; 299 if LoadGraphicFile(Bitmap, ImageFileName, gfNoError) then 300 begin 301 if Bitmap.width div 2 > MaxWidthMapLogo then 302 Bitmap.width := MaxWidthMapLogo * 2; 303 if Bitmap.height > MaxHeightMapLogo then 304 Bitmap.height := MaxHeightMapLogo; 305 Size.X := Bitmap.width div 2; 306 Size.Y := Bitmap.height; 307 end 308 else 309 begin 310 Mode := mmNone; 311 Size.X := MaxWidthMapLogo; 312 Size.Y := MaxHeightMapLogo; 313 end; 314 315 AssignFile(MapFile, FileName); 316 try 317 Reset(MapFile, 4); 318 BlockRead(MapFile, s[1], 2); { file id } 319 BlockRead(MapFile, x, 1); { format id } 320 BlockRead(MapFile, x, 1); // MaxTurn 321 BlockRead(MapFile, lxFile, 1); 322 BlockRead(MapFile, lyFile, 1); 323 nMapLandTiles := 0; 324 nMapStartPositions := 0; 325 for y := 0 to lyFile - 1 do begin 326 BlockRead(MapFile, MapRow, lxFile); 327 for x := 0 to lxFile - 1 do 328 begin 329 if (MapRow[x] and fTerrain) in [fGrass, fPrairie, fTundra, fSwamp, 330 fForest, fHills] then 331 inc(nMapLandTiles); 332 if MapRow[x] and (fPrefStartPos or fStartPos) <> 0 then 333 inc(nMapStartPositions); 334 end 335 end; 336 if nMapStartPositions > nPl then 337 nMapStartPositions := nPl; 338 CloseFile(MapFile); 339 except 340 CloseFile(MapFile); 341 end; 342 end; 343 344 procedure TMiniMap.PaintRandom(Brightness, StartLandMass, WorldSize: Integer); 345 var 346 i, x, y, xm, cm: Integer; 347 MiniPixel: TPixelPointer; 348 Map: ^TTileList; 349 begin 350 Map := PreviewMap(StartLandMass); 351 Size := WorldSizes[WorldSize]; 352 353 Bitmap.PixelFormat := pf24bit; 354 Bitmap.SetSize(Size.X * 2, Size.Y); 355 Bitmap.BeginUpdate; 356 MiniPixel := PixelPointer(Bitmap); 357 for y := 0 to ScaleToVcl(Size.Y) - 1 do begin 358 for x := 0 to ScaleToVcl(Size.X) - 1 do begin 359 for i := 0 to 1 do begin 360 xm := (x * 2 + i + y and 1) mod (ScaleToVcl(Size.X) * 2); 361 MiniPixel.SetX(xm); 362 cm := Colors 363 [Map[ScaleFromVcl(x) * lxmax div Size.X + lxmax * 364 ((ScaleFromVcl(y) * (lymax - 1) + Size.Y div 2) div (Size.Y - 1))] and 365 fTerrain, i]; 366 MiniPixel.Pixel^.B := ((cm shr 16) and $FF) * Brightness div 3; 367 MiniPixel.Pixel^.G := ((cm shr 8) and $FF) * Brightness div 3; 368 MiniPixel.Pixel^.R := ((cm shr 0) and $FF) * Brightness div 3; 369 end; 370 end; 371 MiniPixel.NextLine; 372 end; 373 Bitmap.EndUpdate; 374 end; 375 376 procedure TMiniMap.PaintFile(SaveMap: TMapArray); 377 var 378 i, x, y, xm, cm, Tile, OwnColor, EnemyColor: integer; 379 MiniPixel: TPixelPointer; 380 PrevMiniPixel: TPixelPointer; 381 begin 382 OwnColor := GrExt[HGrSystem].Data.Canvas.Pixels[95, 67]; 383 EnemyColor := GrExt[HGrSystem].Data.Canvas.Pixels[96, 67]; 384 Bitmap.PixelFormat := pf24bit; 385 Bitmap.SetSize(Size.X * 2, Size.Y); 386 if Mode = mmPicture then begin 387 Bitmap.BeginUpdate; 388 MiniPixel := PixelPointer(Bitmap); 389 PrevMiniPixel := PixelPointer(Bitmap, 0, -1); 390 for y := 0 to ScaleToVcl(Size.Y) - 1 do begin 391 for x := 0 to ScaleToVcl(Size.X) - 1 do begin 392 for i := 0 to 1 do begin 393 xm := (x * 2 + i + y and 1) mod (ScaleToVcl(Size.X) * 2); 394 MiniPixel.SetX(xm); 395 Tile := SaveMap[ScaleFromVcl(x) + Size.X * ScaleFromVcl(y)]; 396 if Tile and fTerrain = fUNKNOWN then 397 cm := $000000 398 else if Tile and smCity <> 0 then 399 begin 400 if Tile and smOwned <> 0 then 401 cm := OwnColor 402 else 403 cm := EnemyColor; 404 if y > 0 then begin 405 // 2x2 city dot covers two lines 406 PrevMiniPixel.SetX(xm); 407 PrevMiniPixel.Pixel^.B := cm shr 16; 408 PrevMiniPixel.Pixel^.G:= cm shr 8 and $FF; 409 PrevMiniPixel.Pixel^.R := cm and $FF; 410 end; 411 end 412 else if (i = 0) and (Tile and smUnit <> 0) then 413 if Tile and smOwned <> 0 then 414 cm := OwnColor 415 else cm := EnemyColor 416 else 417 cm := Colors[Tile and fTerrain, i]; 418 MiniPixel.Pixel^.B := (cm shr 16) and $ff; 419 MiniPixel.Pixel^.G := (cm shr 8) and $ff; 420 MiniPixel.Pixel^.R := (cm shr 0) and $ff; 421 end; 422 end; 423 MiniPixel.NextLine; 424 PrevMiniPixel.NextLine; 425 end; 426 Bitmap.EndUpdate; 427 end; 428 end; 429 430 { TStartDlg } 221 431 222 432 procedure TStartDlg.FormCreate(Sender: TObject); 223 433 var 224 x, y, i: Integer; 225 r0, r1: HRgn; 226 Location: TPoint; 434 x, i: Integer; 435 PlayerSlot: TPlayerSlot; 227 436 AIBrains: TBrains; 228 PlayerSlot: TPlayerSlot;229 437 begin 230 438 PlayerSlots := TPlayerSlots.Create; … … 236 444 end; 237 445 LoadConfig; 238 239 ActionsOffered := [maManual, maCredits, maWeb]; 240 Include(ActionsOffered, maConfig);241 if FileExists(HomeDir + 'AI Template' + DirectorySeparator + 'AI development manual.html') then446 LoadAssets; 447 448 ActionsOffered := [maConfig, maManual, maCredits, maWeb]; 449 if FileExists(HomeDir + AITemplateFileName) then 242 450 Include(ActionsOffered, maAIDev); 243 451 … … 259 467 DirectDlg.Top := (DpiScreen.Height - DirectDlg.Height) div 2; 260 468 261 if FullScreen then 262 begin 263 Location := Point((DpiScreen.Width - 800) * 3 div 8, 264 DpiScreen.Height - Height - (DpiScreen.Height - 600) div 3); 265 Left := Location.X; 266 Top := Location.Y; 267 268 r0 := DpiCreateRectRgn(0, 0, Width, Height); 269 r1 := DpiCreateRectRgn(TabOffset + 4 * TabSize + 2, 0, Width, TabHeight); 270 CombineRgn(r0, r0, r1, RGN_DIFF); 271 DeleteObject(r1); 272 r1 := DpiCreateRectRgn(QuitBtn.Left, QuitBtn.Top, QuitBtn.Left + QuitBtn.Width, 273 QuitBtn.top + QuitBtn.Height); 274 CombineRgn(r0, r0, r1, RGN_OR); 275 DeleteObject(r1); 276 SetWindowRgn(Handle, r0, False); 277 DeleteObject(r0); // causes crash with Windows 95 278 end 279 else 280 begin 281 Left := (DpiScreen.Width - Width) div 2; 282 Top := (DpiScreen.Height - Height) div 2; 283 end; 469 UpdateInterface; 284 470 285 471 Canvas.Font.Assign(UniFont[ftNormal]); … … 290 476 PlayerSlots.Count := nPlOffered; 291 477 for i := 0 to PlayerSlots.Count - 1 do 292 with TPlayerSlot(PlayerSlots[i])do begin478 with PlayerSlots[i] do begin 293 479 DiffUpBtn := TButtonC.Create(self); 294 480 DiffUpBtn.Graphic := GrExt[HGrSystem].Data; … … 324 510 CustomizeBtn.ButtonIndex := 2; 325 511 326 Brains[0].Picture := TDpiBitmap.Create; 327 Brains[0].Picture.SetSize(64, 64); 328 DpiBitBlt(Brains[0].Picture.Canvas.Handle, 0, 0, 64, 64, 329 GrExt[HGrSystem2].Data.Canvas.Handle, 1, 111, SRCCOPY); 330 Brains[1].Picture := TDpiBitmap.Create; 331 Brains[1].Picture.SetSize(64, 64); 332 DpiBitBlt(Brains[1].Picture.Canvas.Handle, 0, 0, 64, 64, 333 GrExt[HGrSystem2].Data.Canvas.Handle, 66, 111, SRCCOPY); 334 Brains[2].Picture := TDpiBitmap.Create; 335 Brains[2].Picture.SetSize(64, 64); 336 DpiBitBlt(Brains[2].Picture.Canvas.Handle, 0, 0, 64, 64, 337 GrExt[HGrSystem2].Data.Canvas.Handle, 131, 111, SRCCOPY); 338 Brains[3].Picture := TDpiBitmap.Create; 339 Brains[3].Picture.SetSize(64, 64); 340 DpiBitBlt(Brains[3].Picture.Canvas.Handle, 0, 0, 64, 64, 341 GrExt[HGrSystem2].Data.Canvas.Handle, 131, 46, SRCCOPY); 342 343 AIBrains := TBrains.Create(False); 344 Brains.GetByKind(btAI, AIBrains); 345 for i := 0 to AIBrains.Count - 1 do 346 with AIBrains[I] do 347 begin 348 AIBrains[i].Picture := TDpiBitmap.Create; 349 if not LoadGraphicFile(AIBrains[i].Picture, HomeDir + 'AI' + DirectorySeparator + 350 FileName + DirectorySeparator + FileName + '.png', gfNoError) then begin 351 AIBrains[i].Picture.SetSize(64, 64); 352 with AIBrains[i].Picture.Canvas do begin 353 Brush.Color := $904830; 354 FillRect(Rect(0, 0, 64, 64)); 355 Font.Assign(UniFont[ftTiny]); 356 Font.Style := []; 357 Font.Color := $5FDBFF; 358 Textout(32 - TextWidth(FileName) div 2, 359 32 - TextHeight(FileName) div 2, FileName); 360 end; 361 end; 362 end; 363 AIBrains.Free; 512 BitBltBitmap(BrainNoTerm.Picture, 0, 0, 64, 64, GrExt[HGrSystem2].Data, 1, 111); 513 BitBltBitmap(BrainSuperVirtual.Picture, 0, 0, 64, 64, GrExt[HGrSystem2].Data, 66, 111); 514 BitBltBitmap(BrainTerm.Picture, 0, 0, 64, 64, GrExt[HGrSystem2].Data, 131, 111); 515 BitBltBitmap(BrainRandom.Picture, 0, 0, 64, 64, GrExt[HGrSystem2].Data, 131, 46); 516 LoadAiBrainsPictures; 364 517 365 518 EmptyPicture := TDpiBitmap.Create; … … 372 525 LogoBuffer.Canvas.FillRect(0, 0, LogoBuffer.Width, LogoBuffer.Height); 373 526 374 Mini := TDpiBitmap.Create; 375 for x := 0 to 11 do 376 for y := 0 to 1 do 377 MiniColors[x, y] := GrExt[HGrSystem].Data.Canvas.Pixels[66 + x, 67 + y]; 527 MiniMap := TMiniMap.Create; 378 528 InitButtons; 379 529 … … 394 544 procedure TStartDlg.FormDestroy(Sender: TObject); 395 545 begin 546 SaveConfig; 396 547 FreeAndNil(FormerGames); 397 548 FreeAndNil(Maps); 398 FreeAndNil(Mini);399 549 FreeAndNil(EmptyPicture); 400 550 FreeAndNil(LogoBuffer); 401 551 FreeAndNil(PlayerSlots); 552 FreeAndNil(MiniMap); 402 553 end; 403 554 … … 417 568 DeleteObject(r1); 418 569 end; 419 if not invalidateTab0 then 420 begin 570 if not invalidateTab0 then begin 421 571 r1 := DpiCreateRectRgn(0, 0, 6 + 36, 3 + 38); // tab 0 icon 422 572 CombineRgn(r0, r0, r1, RGN_DIFF); … … 447 597 WriteInteger('Diff' + IntToStr(I), 2); 448 598 end; 449 WriteInteger('MultiControl', 0);450 599 451 600 OpenKey(AppRegistryKey, True); 601 if ValueExists('Gamma') then Gamma := ReadInteger('Gamma') 602 else Gamma := 100; 603 if Gamma <> 100 then InitGammaLookupTable; 604 if ValueExists('Locale') then LocaleCode := ReadString('Locale') 605 else LocaleCode := ''; 452 606 if ValueExists('WorldSize') then WorldSize := Reg.ReadInteger('WorldSize') 453 607 else WorldSize := DefaultWorldSize; … … 475 629 if ValueExists('ResolutionFreq') then 476 630 ResolutionFreq := ReadInteger('ResolutionFreq'); 631 if ValueExists('MultiControl') then 632 MultiControl := ReadInteger('MultiControl') 633 else MultiControl := 0; 477 634 {$IFDEF WINDOWS} 478 635 if ScreenMode = 2 then … … 485 642 end; 486 643 644 procedure TStartDlg.SaveConfig; 645 var 646 Reg: TRegistry; 647 begin 648 Reg := TRegistry.Create; 649 with Reg do try 650 OpenKey(AppRegistryKey, True); 651 WriteInteger('WorldSize', WorldSize); 652 WriteInteger('LandMass', StartLandMass); 653 WriteString('Locale', LocaleCode); 654 WriteInteger('Gamma', Gamma); 655 if FullScreen then WriteInteger('ScreenMode', 1) 656 else WriteInteger('ScreenMode', 0); 657 WriteInteger('MultiControl', MultiControl); 658 finally 659 Free; 660 end; 661 end; 662 663 procedure TStartDlg.LoadAiBrainsPictures; 664 var 665 AIBrains: TBrains; 666 I: Integer; 667 begin 668 AIBrains := TBrains.Create(False); 669 Brains.GetByKind(btAI, AIBrains); 670 for i := 0 to AIBrains.Count - 1 do 671 with AIBrains[I] do begin 672 if not LoadGraphicFile(AIBrains[i].Picture, GetAiDir + DirectorySeparator + 673 FileName + DirectorySeparator + FileName + '.png', gfNoError) then begin 674 with AIBrains[i].Picture.Canvas do begin 675 Brush.Color := $904830; 676 FillRect(Rect(0, 0, 64, 64)); 677 Font.Assign(UniFont[ftTiny]); 678 Font.Style := []; 679 Font.Color := $5FDBFF; 680 Textout(32 - TextWidth(FileName) div 2, 681 32 - TextHeight(FileName) div 2, FileName); 682 end; 683 end; 684 end; 685 AIBrains.Free; 686 end; 687 688 procedure TStartDlg.UpdateInterface; 689 var 690 r0, r1: HRgn; 691 Location: TPoint; 692 begin 693 if FullScreen then begin 694 Location := Point((DpiScreen.Width - 800) * 3 div 8, 695 DpiScreen.Height - Height - (DpiScreen.Height - 600) div 3); 696 Left := Location.X; 697 Top := Location.Y; 698 699 r0 := DpiCreateRectRgn(0, 0, Width, Height); 700 r1 := DpiCreateRectRgn(TabOffset + 4 * TabSize + 2, 0, Width, TabHeight); 701 CombineRgn(r0, r0, r1, RGN_DIFF); 702 DeleteObject(r1); 703 r1 := DpiCreateRectRgn(QuitBtn.Left, QuitBtn.Top, QuitBtn.Left + QuitBtn.Width, 704 QuitBtn.top + QuitBtn.Height); 705 CombineRgn(r0, r0, r1, RGN_OR); 706 DeleteObject(r1); 707 SetWindowRgn(Handle, r0, False); 708 DeleteObject(r0); // causes crash with Windows 95 709 end else begin 710 Left := (DpiScreen.Width - Width) div 2; 711 Top := (DpiScreen.Height - Height) div 2; 712 end; 713 end; 714 487 715 procedure TStartDlg.DrawAction(y, IconIndex: integer; HeaderItem, TextItem: string); 488 716 begin … … 493 721 BiColorTextOut(Canvas, Colors.Canvas.Pixels[clkAge0 - 1, cliDimmedText], 494 722 $000000, xAction, y + 21, Phrases2.Lookup(TextItem)); 495 BitBltCanvas(LogoBuffer.Canvas, 0, 0, 50, 50, Canvas, 496 xActionIcon - 2, y - 2, SRCCOPY); 723 724 // TODO: Explicitly clear background to black but in fact BitBlt SRCCOPY should do it 725 LogoBuffer.Canvas.FillRect(0, 0, LogoBuffer.Width, LogoBuffer.Height); 726 DpiBitCanvas(LogoBuffer.Canvas, 0, 0, 50, 50, Canvas, 727 xActionIcon - 2, y - 2); 497 728 GlowFrame(LogoBuffer, 8, 8, 34, 34, $202020); 498 DpiBit Blt(Canvas.Handle, xActionIcon - 2, y - 2, 50, 50,499 LogoBuffer.Canvas .Handle, 0, 0, SRCCOPY);500 DpiBit Blt(Canvas.Handle, xActionIcon, y, 40, 40, BigImp.Canvas.Handle,501 (IconIndex mod 7) * xSizeBig + 8, (IconIndex div 7) * ySizeBig , SRCCOPY);729 DpiBitCanvas(Canvas, xActionIcon - 2, y - 2, 50, 50, 730 LogoBuffer.Canvas, 0, 0); 731 DpiBitCanvas(Canvas, xActionIcon, y, 40, 40, BigImp.Canvas, 732 (IconIndex mod 7) * xSizeBig + 8, (IconIndex div 7) * ySizeBig); 502 733 RFrame(Canvas, xActionIcon - 1, y - 1, xActionIcon + 40, y + 40, 503 734 $000000, $000000); … … 511 742 s: string; 512 743 Tab2: TStartTab; 744 MainAction: TMainAction; 513 745 begin 514 746 PaintBackground(self, 3, 3, TabOffset + 4 * TabSize - 4, TabHeight - 3); … … 588 820 TabOffset + (Integer(Tab) + 1) * TabSize + 2, TabHeight, MainTexture.clBevelShade, 589 821 MainTexture.clBevelShade); // Tab shadow 590 BitBltCanvas(LogoBuffer.Canvas, 0, 0, 36, 36, Canvas, 6, 591 3 + 2 * integer(Tab <> tbMain), SRCCOPY); 822 // TODO: Explicitly clear background to black but in fact BitBlt SRCCOPY should do it 823 LogoBuffer.Canvas.FillRect(0, 0, LogoBuffer.Width, LogoBuffer.Height); 824 DpiBitCanvas(LogoBuffer.Canvas, 0, 0, 36, 36, Canvas, 6, 825 3 + 2 * integer(Tab <> tbMain)); 592 826 593 827 ImageOp_BCC(LogoBuffer, Templates, 0, 0, 145, 38, 36, 27, $BFBF20, $4040DF); … … 595 829 ImageOp_BCC(LogoBuffer, Templates, 10, 27, 155, 38 + 27, 26, 9, $BFBF20, 596 830 $4040DF); // logo part 2 597 DpiBitBlt(Canvas.Handle, 6, 3 + 2 * integer(Tab <> tbMain), 36, 36, 598 LogoBuffer.Canvas.Handle, 0, 0, SRCCOPY); 599 600 if Page = pgMain then 601 begin 602 if SelectedAction >= 0 then // mark selected action 831 DpiBitCanvas(Canvas, 6, 3 + 2 * integer(Tab <> tbMain), 36, 36, 832 LogoBuffer.Canvas, 0, 0); 833 834 if Page = pgMain then begin 835 if SelectedAction <> maNone then // mark selected action 603 836 for i := 0 to (ClientWidth - 2 * ActionSideBorder) div wBuffer + 1 do 604 837 begin … … 607 840 w := wBuffer; 608 841 h := ActionPitch; 609 if yAction + SelectedAction* ActionPitch - 8 + h > ClientHeight - ActionBottomBorder842 if yAction + Integer(SelectedAction) * ActionPitch - 8 + h > ClientHeight - ActionBottomBorder 610 843 then 611 844 h := ClientHeight - ActionBottomBorder - 612 (yAction + SelectedAction * ActionPitch - 8); 613 //BitBltCanvas(LogoBuffer.Canvas, 0, 0, w, h, Canvas, 614 // ActionSideBorder + i * wBuffer, yAction + SelectedAction * ActionPitch 615 // - 8, SRCCOPY); 616 BitBlt(LogoBuffer.Canvas.Handle, 0, 0, w, h, Canvas.Handle, 617 ActionSideBorder + i * wBuffer, yAction + SelectedAction * ActionPitch 618 - 8, SRCCOPY); 845 (yAction + Integer(SelectedAction) * ActionPitch - 8); 846 // TODO: Explicitly clear background to black but in fact BitBlt SRCCOPY should do it 847 LogoBuffer.Canvas.FillRect(0, 0, LogoBuffer.Width, LogoBuffer.Height); 848 DpiBitCanvas(LogoBuffer.Canvas, 0, 0, w, h, Canvas, 849 ActionSideBorder + i * wBuffer, yAction + Integer(SelectedAction) * ActionPitch 850 - 8); 619 851 MakeBlue(LogoBuffer, 0, 0, w, h); 620 DpiBit Blt(Canvas.Handle, ActionSideBorder + i * wBuffer,621 yAction + SelectedAction* ActionPitch - 8, w, h,622 LogoBuffer.Canvas .Handle, 0, 0, SRCCOPY);852 DpiBitCanvas(Canvas, ActionSideBorder + i * wBuffer, 853 yAction + Integer(SelectedAction) * ActionPitch - 8, w, h, 854 LogoBuffer.Canvas, 0, 0); 623 855 end; 624 856 y := yAction; 625 for i := 0 to nMainActions - 1do857 for MainAction := Low(TMainActionSet) to High(TMainActionSet) do 626 858 begin 627 if i in ActionsOffered then 628 case i of 629 maConfig: 630 DrawAction(y, 25, 'ACTIONHEADER_CONFIG', 'ACTION_CONFIG'); 631 maManual: 632 DrawAction(y, 19, 'ACTIONHEADER_MANUAL', 'ACTION_MANUAL'); 633 maCredits: 634 DrawAction(y, 22, 'ACTIONHEADER_CREDITS', 'ACTION_CREDITS'); 635 maAIDev: 636 DrawAction(y, 24, 'ACTIONHEADER_AIDEV', 'ACTION_AIDEV'); 859 if MainAction in ActionsOffered then 860 case MainAction of 861 maConfig: DrawAction(y, 25, 'ACTIONHEADER_CONFIG', 'ACTION_CONFIG'); 862 maManual: DrawAction(y, 19, 'ACTIONHEADER_MANUAL', 'ACTION_MANUAL'); 863 maCredits: DrawAction(y, 22, 'ACTIONHEADER_CREDITS', 'ACTION_CREDITS'); 864 maAIDev: DrawAction(y, 24, 'ACTIONHEADER_AIDEV', 'ACTION_AIDEV'); 637 865 maWeb: 638 866 begin … … 642 870 Phrases2.Lookup('ACTIONHEADER_WEB')); 643 871 Canvas.Font.Assign(UniFont[ftNormal]); 644 BitBltCanvas(LogoBuffer.Canvas, 0, 0, 91, 25, Canvas, 645 xActionIcon, y + 2, SRCCOPY); 872 // TODO: Explicitly clear background to black but in fact BitBlt SRCCOPY should do it 873 LogoBuffer.Canvas.FillRect(0, 0, LogoBuffer.Width, LogoBuffer.Height); 874 DpiBitCanvas(LogoBuffer.Canvas, 0, 0, 91, 25, Canvas, 875 xActionIcon, y + 2); 646 876 ImageOp_BCC(LogoBuffer, Templates, 0, 0, 1, 400, 91, 25, 0, 647 877 Colors.Canvas.Pixels[clkAge0 - 1, cliDimmedText]); 648 DpiBit Blt(Canvas.Handle, xActionIcon, y + 2, 91, 25,649 LogoBuffer.Canvas .Handle, 0, 0, SRCCOPY);878 DpiBitCanvas(Canvas, xActionIcon, y + 2, 91, 25, 879 LogoBuffer.Canvas, 0, 0); 650 880 end; 651 881 end; 652 inc(y, ActionPitch);882 Inc(y, ActionPitch); 653 883 end; 654 884 end … … 671 901 if (i < 13) or (i > 17) then 672 902 begin 673 DpiBit Blt(Canvas.Handle, 9 + i * 27, yLogo - 2, wOrna, hOrna,674 GrExt[HGrSystem2].Mask.Canvas .Handle, xOrna, yOrna, SRCAND);675 DpiBit Blt(Canvas.Handle, 9 + i * 27, yLogo - 2, wOrna, hOrna,676 GrExt[HGrSystem2].Data.Canvas .Handle, xOrna, yOrna, SRCPAINT);903 DpiBitCanvas(Canvas, 9 + i * 27, yLogo - 2, wOrna, hOrna, 904 GrExt[HGrSystem2].Mask.Canvas, xOrna, yOrna, SRCAND); 905 DpiBitCanvas(Canvas, 9 + i * 27, yLogo - 2, wOrna, hOrna, 906 GrExt[HGrSystem2].Data.Canvas, xOrna, yOrna, SRCPAINT); 677 907 end; 678 908 PaintLogo(Canvas, 69 + 11 * 27, yLogo, MainTexture.clBevelLight, … … 690 920 if Assigned(PlayersBrain[I]) and (PlayersBrain[i].Kind in [btTerm, btRandom, btAI]) then 691 921 begin 692 DpiBit Blt(Canvas.Handle, xBrain[i] - 18, yBrain[i] + 19, 12, 14,693 GrExt[HGrSystem].Data.Canvas .Handle, 134 + (Difficulty[i] - 1) *694 13, 28 , SRCCOPY);922 DpiBitCanvas(Canvas, xBrain[i] - 18, yBrain[i] + 19, 12, 14, 923 GrExt[HGrSystem].Data.Canvas, 134 + (Difficulty[i] - 1) * 924 13, 28); 695 925 Frame(Canvas, xBrain[i] - 19, yBrain[i] + 18, xBrain[i] - 18 + 12, 696 926 yBrain[i] + (19 + 14), $000000, $000000); … … 710 940 PlayerSlots[I].MultiBtn.left + 12, PlayerSlots[I].MultiBtn.top + 12, 711 941 MainTexture.clBevelShade, MainTexture.clBevelLight); 712 DpiBit Blt(Canvas.Handle, xBrain[i] - 31, yBrain[i], 13, 12,713 GrExt[HGrSystem].Data.Canvas .Handle, 88, 47, SRCCOPY);942 DpiBitCanvas(Canvas, xBrain[i] - 31, yBrain[i], 13, 12, 943 GrExt[HGrSystem].Data.Canvas, 88, 47); 714 944 end; 715 945 end; … … 755 985 if (i < 2) or (i > 6) then 756 986 begin 757 DpiBit Blt(Canvas.Handle, 9 + i * 27, yLogo - 2, wOrna, hOrna,758 GrExt[HGrSystem2].Mask.Canvas .Handle, xOrna, yOrna, SRCAND);759 DpiBit Blt(Canvas.Handle, 9 + i * 27, yLogo - 2, wOrna, hOrna,760 GrExt[HGrSystem2].Data.Canvas .Handle, xOrna, yOrna, SRCPAINT);987 DpiBitCanvas(Canvas, 9 + i * 27, yLogo - 2, wOrna, hOrna, 988 GrExt[HGrSystem2].Mask.Canvas, xOrna, yOrna, SRCAND); 989 DpiBitCanvas(Canvas, 9 + i * 27, yLogo - 2, wOrna, hOrna, 990 GrExt[HGrSystem2].Data.Canvas, xOrna, yOrna, SRCPAINT); 761 991 end; 762 992 PaintLogo(Canvas, 69, yLogo, MainTexture.clBevelLight, … … 788 1018 MainTexture.clBevelShade); 789 1019 RisedTextOut(Canvas, 344, y0Mini - 77, Phrases.Lookup('STARTCONTROLS', 5)); 790 s := IntToStr(( lxpre[WorldSize] * lypre[WorldSize]* 20 +1020 s := IntToStr((WorldSizes[WorldSize].X * WorldSizes[WorldSize].Y * 20 + 791 1021 DefaultWorldTiles div 2) div DefaultWorldTiles * 5) + '%'; 792 1022 RisedTextOut(Canvas, 514 - BiColorTextWidth(Canvas, s), y0Mini - 77, s); … … 837 1067 BtnFrame(Canvas, ReplayBtn.BoundsRect, MainTexture); 838 1068 839 if not (Page in [pgMain, pgNoLoad]) then840 begin 841 xMini := x0Mini - Mini Width;842 yMini := y0Mini - Mini Heightdiv 2;843 Frame(Canvas, xMini, yMini, xMini + 3 + Mini Width* 2,844 yMini + 3 + Mini Height, MainTexture.clBevelLight,1069 if not (Page in [pgMain, pgNoLoad]) then 1070 begin 1071 xMini := x0Mini - MiniMap.Size.X; 1072 yMini := y0Mini - MiniMap.Size.Y div 2; 1073 Frame(Canvas, xMini, yMini, xMini + 3 + MiniMap.Size.X * 2, 1074 yMini + 3 + MiniMap.Size.Y, MainTexture.clBevelLight, 845 1075 MainTexture.clBevelShade); 846 Frame(Canvas, xMini + 1, yMini + 1, xMini + 2 + Mini Width* 2,847 yMini + 2 + Mini Height, MainTexture.clBevelShade,1076 Frame(Canvas, xMini + 1, yMini + 1, xMini + 2 + MiniMap.Size.X * 2, 1077 yMini + 2 + MiniMap.Size.Y, MainTexture.clBevelShade, 848 1078 MainTexture.clBevelLight); 849 end; 850 s := ''; 851 if MiniMode = mmPicture then 852 begin 853 DpiBitBlt(Canvas.Handle, xMini + 2, yMini + 2, MiniWidth * 2, MiniHeight, 854 Mini.Canvas.Handle, 0, 0, SRCCOPY); 855 if Page = pgStartRandom then 856 s := Phrases.Lookup('RANMAP') 857 end 858 else if MiniMode = mmMultiPlayer then 859 s := Phrases.Lookup('MPMAP') 860 else if Page = pgStartMap then 861 s := Copy(MapFileName, 1, Length(MapFileName) - 9) 862 else if Page = pgEditMap then 863 s := List.Items[List.ItemIndex] 864 else if Page = pgNoLoad then 865 s := Phrases.Lookup('NOGAMES'); 866 if s <> '' then 867 RisedTextOut(Canvas, x0Mini + 2 - BiColorTextWidth(Canvas, s) div 2, 868 y0Mini - 8, s); 1079 1080 s := ''; 1081 if MiniMap.Mode = mmPicture then 1082 begin 1083 DpiBitCanvas(Canvas, xMini + 2, yMini + 2, MiniMap.Size.X * 2, MiniMap.Size.Y, 1084 MiniMap.Bitmap.Canvas, 0, 0); 1085 if Page = pgStartRandom then 1086 s := Phrases.Lookup('RANMAP') 1087 end 1088 else if MiniMap.Mode = mmMultiPlayer then 1089 s := Phrases.Lookup('MPMAP') 1090 else if Page = pgStartMap then 1091 s := Copy(MapFileName, 1, Length(MapFileName) - 9) 1092 else if Page = pgEditMap then 1093 s := List.Items[List.ItemIndex] 1094 else if Page = pgNoLoad then 1095 s := Phrases.Lookup('NOGAMES'); 1096 if s <> '' then 1097 RisedTextOut(Canvas, x0Mini + 2 - BiColorTextWidth(Canvas, s) div 2, 1098 y0Mini - 8, s); 1099 end; 869 1100 end; 870 1101 871 1102 procedure TStartDlg.FormShow(Sender: TObject); 872 var873 x, y: integer;874 PicturePixel: TPixelPointer;875 1103 begin 876 1104 SetMainTextureByAge(-1); 877 1105 List.Font.Color := MainTexture.clMark; 878 1106 879 Fill(EmptyPicture.Canvas, 0, 0, 64, 64, (wMaintexture - 64) div 2, 880 (hMaintexture - 64) div 2); 881 // darken texture for empty slot 882 EmptyPicture.BeginUpdate; 883 PicturePixel.Init(EmptyPicture); 884 for y := 0 to ScaleToVcl(64) - 1 do begin 885 for x := 0 to ScaleToVcl(64) - 1 do begin 886 PicturePixel.Pixel^.B := Max(PicturePixel.Pixel^.B - 28, 0); 887 PicturePixel.Pixel^.G := Max(PicturePixel.Pixel^.G - 28, 0); 888 PicturePixel.Pixel^.R := Max(PicturePixel.Pixel^.R - 28, 0); 889 PicturePixel.NextPixel; 890 end; 891 PicturePixel.NextLine; 892 end; 893 EmptyPicture.EndUpdate; 1107 Fill(EmptyPicture.Canvas, Bounds(0, 0, 64, 64), 1108 Point((wMaintexture - 64) div 2, (hMaintexture - 64) div 2)); 1109 1110 DarkenImage(EmptyPicture, 28); 894 1111 895 1112 Difficulty[0] := Diff0; 896 1113 897 SelectedAction := -1;1114 SelectedAction := maNone; 898 1115 if ShowTab = tbPrevious then 899 1116 PreviewMap(StartLandMass); // avoid delay on first TabX change … … 921 1138 procedure TStartDlg.StartBtnClick(Sender: TObject); 922 1139 var 923 I, GameCount, MapCount: integer;1140 I, GameCount, MapCount: Integer; 924 1141 FileName: string; 925 1142 Reg: TRegistry; … … 929 1146 begin // load 930 1147 FileName := List.Items[List.ItemIndex]; 931 if LoadGame( DataDir + 'Saved'+ DirectorySeparator, FileName + CevoExt, LoadTurn, false)1148 if LoadGame(GetSavedDir + DirectorySeparator, FileName + CevoExt, LoadTurn, false) 932 1149 then 933 1150 UnlistBackupFile(FileName) … … 960 1177 end; 961 1178 962 // save settings and AI assignment1179 // Save settings and AI assignment 963 1180 if Page = pgStartRandom then begin 964 WriteInteger('WorldSize', WorldSize); 965 WriteInteger('LandMass', StartLandMass); 966 1181 SaveConfig; 967 1182 OpenKey(AppRegistryKey + '\AI', True); 968 1183 if AutoDiff < 0 then … … 974 1189 WriteInteger('Diff' + IntToStr(I), Difficulty[I]); 975 1190 end; 976 WriteInteger('MultiControl', MultiControl);977 1191 end; 978 1192 … … 1013 1227 end; 1014 1228 1015 StartNewGame( DataDir + 'Saved'+ DirectorySeparator, FileName + CevoExt, MapFileName,1016 lxpre[WorldSize], lypre[WorldSize], StartLandMass, MaxTurn);1229 StartNewGame(GetSavedDir + DirectorySeparator, FileName + CevoExt, MapFileName, 1230 WorldSizes[WorldSize].X, WorldSizes[WorldSize].Y, StartLandMass, MaxTurn); 1017 1231 UnlistBackupFile(FileName); 1018 1232 end; … … 1033 1247 end; 1034 1248 MapFileName := Format(Phrases.Lookup('MAP'), [MapCount]) + CevoMapExt; 1035 EditMap(MapFileName, lxpre[WorldSize], lypre[WorldSize], StartLandMass); 1036 end 1037 end 1038 end; 1039 1040 procedure TStartDlg.PaintRandomMini(Brightness: integer); 1041 var 1042 i, x, y, xm, cm: integer; 1043 MiniPixel: TPixelPointer; 1044 Map: ^TTileList; 1045 begin 1046 Map := PreviewMap(StartLandMass); 1047 MiniWidth := lxpre[WorldSize]; 1048 MiniHeight := lypre[WorldSize]; 1049 1050 Mini.PixelFormat := pf24bit; 1051 Mini.SetSize(MiniWidth * 2, MiniHeight); 1052 Mini.BeginUpdate; 1053 MiniPixel.Init(Mini); 1054 for y := 0 to ScaleToVcl(MiniHeight) - 1 do begin 1055 for x := 0 to ScaleToVcl(MiniWidth) - 1 do begin 1056 for i := 0 to 1 do begin 1057 xm := (x * 2 + i + y and 1) mod (ScaleToVcl(MiniWidth) * 2); 1058 MiniPixel.SetX(xm); 1059 cm := MiniColors 1060 [Map[x * lxmax div MiniWidth + lxmax * 1061 ((y * (lymax - 1) + MiniHeight div 2) div (MiniHeight - 1))] and 1062 fTerrain, i]; 1063 MiniPixel.Pixel^.B := ((cm shr 16) and $FF) * Brightness div 3; 1064 MiniPixel.Pixel^.G := ((cm shr 8) and $FF) * Brightness div 3; 1065 MiniPixel.Pixel^.R := ((cm shr 0) and $FF) * Brightness div 3; 1066 end; 1067 end; 1068 MiniPixel.NextLine; 1069 end; 1070 Mini.EndUpdate; 1071 end; 1072 1073 procedure TStartDlg.PaintFileMini(SaveMap: TMapArray); 1074 var 1075 i, x, y, xm, cm, Tile, OwnColor, EnemyColor: integer; 1076 MiniPixel, PrevMiniPixel: TPixelPointer; 1077 begin 1078 OwnColor := GrExt[HGrSystem].Data.Canvas.Pixels[95, 67]; 1079 EnemyColor := GrExt[HGrSystem].Data.Canvas.Pixels[96, 67]; 1080 Mini.PixelFormat := pf24bit; 1081 Mini.SetSize(MiniWidth * 2, MiniHeight); 1082 if MiniMode = mmPicture then 1083 begin 1084 Mini.BeginUpdate; 1085 MiniPixel.Init(Mini); 1086 PrevMiniPixel.Init(Mini, 0, -1); 1087 for y := 0 to MiniHeight - 1 do begin 1088 for x := 0 to MiniWidth - 1 do begin 1089 for i := 0 to 1 do begin 1090 xm := (x * 2 + i + y and 1) mod (MiniWidth * 2); 1091 MiniPixel.SetX(xm); 1092 Tile := SaveMap[x + MiniWidth * y]; 1093 if Tile and fTerrain = fUNKNOWN then 1094 cm := $000000 1095 else if Tile and smCity <> 0 then 1096 begin 1097 if Tile and smOwned <> 0 then 1098 cm := OwnColor 1099 else 1100 cm := EnemyColor; 1101 if y > 0 then begin 1102 // 2x2 city dot covers two lines 1103 PrevMiniPixel.SetX(xm); 1104 PrevMiniPixel.Pixel^.B := cm shr 16; 1105 PrevMiniPixel.Pixel^.G:= cm shr 8 and $FF; 1106 PrevMiniPixel.Pixel^.R := cm and $FF; 1107 end; 1108 end 1109 else if (i = 0) and (Tile and smUnit <> 0) then 1110 if Tile and smOwned <> 0 then 1111 cm := OwnColor 1112 else 1113 cm := EnemyColor 1114 else 1115 cm := MiniColors[Tile and fTerrain, i]; 1116 MiniPixel.Pixel^.B := cm shr 16; 1117 MiniPixel.Pixel^.G:= cm shr 8 and $FF; 1118 MiniPixel.Pixel^.R := cm and $FF; 1119 end; 1120 end; 1121 MiniPixel.NextLine; 1122 PrevMiniPixel.NextLine; 1123 end; 1124 Mini.EndUpdate; 1249 EditMap(MapFileName, WorldSizes[WorldSize].X, WorldSizes[WorldSize].Y, StartLandMass); 1250 end; 1125 1251 end; 1126 1252 end; 1127 1253 1128 1254 procedure TStartDlg.PaintInfo; 1129 var1130 SaveMap: TMapArray;1131 x, y, Dummy, FileLandMass, lxFile, lyFile: integer;1132 LogFile, MapFile: file;1133 s: string[255];1134 MapRow: array [0 .. lxmax - 1] of Cardinal;1135 1255 begin 1136 1256 case Page of 1137 pgStartRandom: 1138 begin 1139 MiniMode := mmPicture; 1140 PaintRandomMini(3); 1141 end; 1142 pgNoLoad: 1143 begin 1144 MiniWidth := lxpre[DefaultWorldSize]; 1145 MiniHeight := lypre[DefaultWorldSize]; 1146 MiniMode := mmNone; 1147 end; 1148 pgLoad: 1149 begin 1150 AssignFile(LogFile, DataDir + 'Saved' + DirectorySeparator + List.Items[List.ItemIndex] 1151 + CevoExt); 1152 try 1153 Reset(LogFile, 4); 1154 BlockRead(LogFile, s[1], 2); { file id } 1155 BlockRead(LogFile, Dummy, 1); { format id } 1156 if Dummy >= $000E01 then 1157 BlockRead(LogFile, Dummy, 1); { item stored since 0.14.1 } 1158 BlockRead(LogFile, MiniWidth, 1); 1159 BlockRead(LogFile, MiniHeight, 1); 1160 BlockRead(LogFile, FileLandMass, 1); 1161 if FileLandMass = 0 then 1162 for y := 0 to MiniHeight - 1 do 1163 BlockRead(LogFile, MapRow, MiniWidth); 1164 BlockRead(LogFile, Dummy, 1); 1165 BlockRead(LogFile, Dummy, 1); 1166 BlockRead(LogFile, LastTurn, 1); 1167 BlockRead(LogFile, SaveMap, 1); 1168 if SaveMap[0] = $80 then 1169 MiniMode := mmMultiPlayer 1170 else 1171 MiniMode := mmPicture; 1172 if MiniMode = mmPicture then 1173 BlockRead(LogFile, SaveMap[4], (MiniWidth * MiniHeight - 1) div 4); 1174 CloseFile(LogFile); 1175 except 1176 CloseFile(LogFile); 1177 LastTurn := 0; 1178 MiniWidth := lxpre[DefaultWorldSize]; 1179 MiniHeight := lypre[DefaultWorldSize]; 1180 MiniMode := mmNone; 1181 end; 1257 pgStartRandom: begin 1258 MiniMap.Mode := mmPicture; 1259 MiniMap.PaintRandom(3, StartLandMass, WorldSize); 1260 end; 1261 pgNoLoad: begin 1262 MiniMap.Mode := mmNone; 1263 MiniMap.Size := WorldSizes[DefaultWorldSize]; 1264 end; 1265 pgLoad: begin 1266 MiniMap.LoadFromLogFile(GetSavedDir + DirectorySeparator + 1267 List.Items[List.ItemIndex] + CevoExt, LastTurn); 1182 1268 // BookDate:=DateToStr(FileDateToDateTime(FileAge(FileName))); 1183 PaintFileMini(SaveMap); 1184 if not TurnValid then 1185 begin 1269 if not TurnValid then begin 1186 1270 LoadTurn := LastTurn; 1187 1271 SmartInvalidate(xTurnSlider - 2, y0Mini + 61, … … 1190 1274 TurnValid := True; 1191 1275 end; 1192 pgEditRandom: 1193 begin 1194 MapFileName := ''; 1195 MiniMode := mmPicture; 1196 PaintRandomMini(4); 1197 end; 1276 pgEditRandom: begin 1277 MapFileName := ''; 1278 MiniMap.Mode := mmPicture; 1279 MiniMap.PaintRandom(4, StartLandMass, WorldSize); 1280 end; 1198 1281 pgStartMap, pgEditMap: 1199 1282 begin 1200 MiniMode := mmPicture;1201 1283 if Page = pgEditMap then 1202 1284 MapFileName := List.Items[List.ItemIndex] + CevoMapExt; 1203 if LoadGraphicFile(Mini, DataDir + 'Maps' + DirectorySeparator + Copy(MapFileName, 1, 1204 Length(MapFileName) - 9) + '.png', gfNoError) then 1205 begin 1206 if Mini.width div 2 > MaxWidthMapLogo then 1207 Mini.width := MaxWidthMapLogo * 2; 1208 if Mini.height > MaxHeightMapLogo then 1209 Mini.height := MaxHeightMapLogo; 1210 MiniWidth := Mini.width div 2; 1211 MiniHeight := Mini.height; 1212 end 1213 else 1214 begin 1215 MiniMode := mmNone; 1216 MiniWidth := MaxWidthMapLogo; 1217 MiniHeight := MaxHeightMapLogo; 1218 end; 1219 1220 AssignFile(MapFile, DataDir + 'Maps' + DirectorySeparator + MapFileName); 1221 try 1222 Reset(MapFile, 4); 1223 BlockRead(MapFile, s[1], 2); { file id } 1224 BlockRead(MapFile, x, 1); { format id } 1225 BlockRead(MapFile, x, 1); // MaxTurn 1226 BlockRead(MapFile, lxFile, 1); 1227 BlockRead(MapFile, lyFile, 1); 1228 nMapLandTiles := 0; 1229 nMapStartPositions := 0; 1230 for y := 0 to lyFile - 1 do 1231 begin 1232 BlockRead(MapFile, MapRow, lxFile); 1233 for x := 0 to lxFile - 1 do 1234 begin 1235 if (MapRow[x] and fTerrain) in [fGrass, fPrairie, fTundra, fSwamp, 1236 fForest, fHills] then 1237 inc(nMapLandTiles); 1238 if MapRow[x] and (fPrefStartPos or fStartPos) <> 0 then 1239 inc(nMapStartPositions); 1240 end 1241 end; 1242 if nMapStartPositions > nPl then 1243 nMapStartPositions := nPl; 1244 CloseFile(MapFile); 1245 except 1246 CloseFile(MapFile); 1247 end; 1285 MiniMap.LoadFromMapFile(GetMapsDir + DirectorySeparator + MapFileName, nMapLandTiles, nMapStartPositions); 1248 1286 if Page = pgEditMap then 1249 1287 SmartInvalidate(x0Mini - 112, y0Mini + 61, x0Mini + 112, y0Mini + 91); … … 1398 1436 begin 1399 1437 FormerGames.Clear; 1400 if FindFirst( DataDir + 'Saved'+ DirectorySeparator + '*' + CevoExt, $21, F) = 0 then1438 if FindFirst(GetSavedDir + DirectorySeparator + '*' + CevoExt, $21, F) = 0 then 1401 1439 repeat 1402 1440 I := FormerGames.Count; … … 1418 1456 begin 1419 1457 Maps.Clear; 1420 if FindFirst( DataDir + 'Maps'+ DirectorySeparator + '*' + CevoMapExt, $21, f) = 0 then1458 if FindFirst(GetMapsDir + DirectorySeparator + '*' + CevoMapExt, $21, f) = 0 then 1421 1459 repeat 1422 1460 Maps.Add(Copy(f.Name, 1, Length(f.Name) - 9)); … … 1435 1473 s: string; 1436 1474 Reg: TRegistry; 1437 invalidateTab0: boolean;1438 begin 1439 invalidateTab0 := (Page = pgMain) or (NewPage = pgMain);1475 InvalidateTab0: boolean; 1476 begin 1477 InvalidateTab0 := (Page = pgMain) or (NewPage = pgMain); 1440 1478 Page := NewPage; 1441 1479 case Page of … … 1478 1516 PlayersBrain[p1] := Brains[j]; 1479 1517 end; 1480 MultiControl := Reg.ReadInteger('MultiControl');1481 1518 finally 1482 1519 Free; … … 1556 1593 Controls[i].Visible := Controls[i].Tag and (256 shl Integer(Page)) <> 0; 1557 1594 if Page = pgLoad then 1558 ReplayBtn.Visible := MiniM ode <> mmMultiPlayer;1595 ReplayBtn.Visible := MiniMap.Mode <> mmMultiPlayer; 1559 1596 List.Invalidate; 1560 1597 SmartInvalidate(0, 0, ClientWidth, ClientHeight, invalidateTab0); … … 1616 1653 LocaleDlg := TLocaleDlg.Create(nil); 1617 1654 if LocaleDlg.ShowModal = mrOk then begin 1618 Load Phrases;1655 LoadAssets; 1619 1656 Invalidate; 1657 UpdateInterface; 1658 Background.UpdateInterface; 1620 1659 end; 1621 1660 FreeAndNil(LocaleDlg); … … 1626 1665 DirectHelp(cStartCredits); 1627 1666 maAIDev: 1628 OpenDocument( pchar(HomeDir + 'AI Template' + DirectorySeparator + 'AI development manual.html'));1667 OpenDocument(HomeDir + AITemplateFileName); 1629 1668 maWeb: 1630 OpenURL( 'http://c-evo.org')1669 OpenURL(CevoHomepage); 1631 1670 end; 1632 1671 end … … 1720 1759 procedure TStartDlg.Up1BtnClick(Sender: TObject); 1721 1760 begin 1722 if WorldSize < nWorldSize - 1 then1761 if WorldSize < MaxWorldSize - 1 then 1723 1762 begin 1724 1763 Inc(WorldSize); … … 1761 1800 PaintInfo; 1762 1801 if Page = pgLoad then 1763 ReplayBtn.Visible := MiniM ode <> mmMultiPlayer;1802 ReplayBtn.Visible := MiniMap.Mode <> mmMultiPlayer; 1764 1803 end; 1765 1804 … … 1793 1832 end; 1794 1833 if Page = pgLoad then 1795 AssignFile(f, DataDir + 'Saved'+ DirectorySeparator + List.Items[List.ItemIndex] + CevoExt)1834 AssignFile(f, GetSavedDir + DirectorySeparator + List.Items[List.ItemIndex] + CevoExt) 1796 1835 else 1797 AssignFile(f, DataDir + 'Maps'+ DirectorySeparator + List.Items[List.ItemIndex] +1836 AssignFile(f, GetMapsDir + DirectorySeparator + List.Items[List.ItemIndex] + 1798 1837 CevoMapExt); 1799 1838 ok := true; 1800 1839 try 1801 1840 if Page = pgLoad then 1802 Rename(f, DataDir + 'Saved'+ DirectorySeparator + NewName + CevoExt)1841 Rename(f, GetSavedDir + DirectorySeparator + NewName + CevoExt) 1803 1842 else 1804 Rename(f, DataDir + 'Maps'+ DirectorySeparator + NewName + CevoMapExt);1843 Rename(f, GetMapsDir + DirectorySeparator + NewName + CevoMapExt); 1805 1844 except 1806 1845 // Play('INVALID'); … … 1809 1848 if Page <> pgLoad then 1810 1849 try // rename map picture 1811 AssignFile(f, DataDir + 'Maps'+ DirectorySeparator + List.Items[List.ItemIndex]1850 AssignFile(f, GetMapsDir + DirectorySeparator + List.Items[List.ItemIndex] 1812 1851 + '.png'); 1813 Rename(f, DataDir + 'Maps'+ DirectorySeparator + NewName + '.png');1852 Rename(f, GetMapsDir + DirectorySeparator + NewName + '.png'); 1814 1853 except 1815 1854 end; … … 1845 1884 begin 1846 1885 if Page = pgLoad then 1847 AssignFile(f, DataDir + 'Saved'+ DirectorySeparator + List.Items[List.ItemIndex] + CevoExt)1886 AssignFile(f, GetSavedDir + DirectorySeparator + List.Items[List.ItemIndex] + CevoExt) 1848 1887 else 1849 AssignFile(f, DataDir + 'Maps'+ DirectorySeparator + List.Items[List.ItemIndex] +1888 AssignFile(f, GetMapsDir + DirectorySeparator + List.Items[List.ItemIndex] + 1850 1889 CevoMapExt); 1851 1890 Erase(f); … … 1873 1912 PaintInfo; 1874 1913 if Page = pgLoad then 1875 ReplayBtn.Visible := MiniM ode <> mmMultiPlayer;1914 ReplayBtn.Visible := MiniMap.Mode <> mmMultiPlayer; 1876 1915 end; 1877 1916 end; … … 1967 2006 x, y: integer); 1968 2007 var 1969 OldLoadTurn, NewSelectedAction: Integer; 2008 OldLoadTurn: Integer; 2009 NewSelectedAction: TMainAction; 1970 2010 begin 1971 2011 if Tracking then … … 1998 2038 (y >= yAction - 8) and (y < ClientHeight - ActionBottomBorder) then 1999 2039 begin 2000 NewSelectedAction := (y - (yAction - 8)) div ActionPitch;2001 if not (NewSelectedAction in ActionsOffered) then2002 NewSelectedAction := -1;2040 NewSelectedAction := TMainAction((y - (yAction - 8)) div ActionPitch); 2041 if not (NewSelectedAction in ActionsOffered) then 2042 NewSelectedAction := maNone; 2003 2043 end 2004 2044 else 2005 NewSelectedAction := -1;2045 NewSelectedAction := maNone; 2006 2046 if NewSelectedAction <> SelectedAction then 2007 2047 begin 2008 if SelectedAction >= 0then2009 SmartInvalidate(ActionSideBorder, yAction + SelectedAction* ActionPitch2010 - 8, ClientWidth - ActionSideBorder, yAction + ( SelectedAction+ 1) *2048 if SelectedAction <> maNone then 2049 SmartInvalidate(ActionSideBorder, yAction + Integer(SelectedAction) * ActionPitch 2050 - 8, ClientWidth - ActionSideBorder, yAction + (Integer(SelectedAction) + 1) * 2011 2051 ActionPitch - 8); 2012 2052 SelectedAction := NewSelectedAction; 2013 if SelectedAction >= 0then2014 SmartInvalidate(ActionSideBorder, yAction + SelectedAction* ActionPitch2015 - 8, ClientWidth - ActionSideBorder, yAction + ( SelectedAction+ 1) *2053 if SelectedAction <> maNone then 2054 SmartInvalidate(ActionSideBorder, yAction + Integer(SelectedAction) * ActionPitch 2055 - 8, ClientWidth - ActionSideBorder, yAction + (Integer(SelectedAction) + 1) * 2016 2056 ActionPitch - 8); 2017 2057 end; … … 2039 2079 procedure TStartDlg.ReplayBtnClick(Sender: TObject); 2040 2080 begin 2041 LoadGame( DataDir + 'Saved'+ DirectorySeparator, List.Items[List.ItemIndex] + CevoExt,2081 LoadGame(GetSavedDir + DirectorySeparator, List.Items[List.ItemIndex] + CevoExt, 2042 2082 LastTurn, True); 2043 2083 SlotAvailable := -1; 2044 2084 end; 2045 2085 2086 2046 2087 end.
Note:
See TracChangeset
for help on using the changeset viewer.