- Timestamp:
- May 9, 2020, 4:02:07 PM (5 years ago)
- Location:
- branches/highdpi
- Files:
-
- 47 added
- 73 edited
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
branches/highdpi/Back.lfm
r178 r210 1 1 object Background: TBackground 2 2 Left = 581 3 Height = 2583 Height = 172 4 4 Top = 638 5 Width = 3035 Width = 202 6 6 BorderIcons = [] 7 7 BorderStyle = bsNone 8 8 Caption = 'C-evo' 9 9 Color = clBlack 10 DesignTimePPI = 14411 10 Font.Color = clWindowText 12 Font.Height = - 2011 Font.Height = -13 13 12 Font.Name = 'MS Sans Serif' 14 13 OnClose = FormClose … … 17 16 OnPaint = FormPaint 18 17 OnShow = FormShow 19 LCLVersion = ' 2.0.2.0'18 LCLVersion = '1.6.2.0' 20 19 WindowState = wsMaximized 21 20 end -
branches/highdpi/Back.pas
r193 r210 5 5 6 6 uses 7 LCLIntf, LCLType, SysUtils, Classes, Graphics, Forms, Controls, UDpiControls;7 UDpiControls, LCLIntf, LCLType, SysUtils, Classes, Graphics, Forms, Controls; 8 8 9 9 type … … 11 11 { TBackground } 12 12 13 TBackground = class(T Form)13 TBackground = class(TDpiForm) 14 14 procedure FormDestroy(Sender: TObject); 15 15 procedure FormPaint(Sender: TObject); … … 19 19 private 20 20 Img: TDpiBitmap; 21 public 22 procedure UpdateInterface; 21 23 end; 22 24 … … 37 39 38 40 procedure TBackground.FormShow(Sender: TObject); 41 begin 42 UpdateInterface; 43 end; 44 45 procedure TBackground.FormDestroy(Sender: TObject); 46 begin 47 if Assigned(Img) then FreeAndNil(Img); 48 end; 49 50 procedure TBackground.FormPaint(Sender: TObject); 51 begin 52 if Assigned(Img) then 53 DpiBitCanvas(Canvas, DpiScreen.Width - Img.Width - (DpiScreen.Width - 800) * 54 3 div 8, (DpiScreen.Height - 600) div 3, Img.Width, Img.Height, 55 Img.Canvas, 0, 0); 56 end; 57 58 procedure TBackground.FormClose(Sender: TObject; var Action: TCloseAction); 59 begin 60 end; 61 62 procedure TBackground.UpdateInterface; 39 63 var 40 64 FileName: string; 41 65 begin 42 66 if FullScreen then begin 67 WindowState := wsMaximized; 43 68 if not Assigned(Img) then begin 44 FileName := HomeDir + 'Graphics'+ DirectorySeparator + 'Background.png';69 FileName := GetGraphicsDir + DirectorySeparator + 'Background.png'; 45 70 if FileExists(FileName) then begin 46 71 Img := TDpiBitmap.Create; … … 57 82 end; 58 83 59 procedure TBackground.FormDestroy(Sender: TObject);60 begin61 if Assigned(Img) then FreeAndNil(Img);62 end;63 64 procedure TBackground.FormPaint(Sender: TObject);65 begin66 if Assigned(Img) then67 DpiBitBlt(Canvas.Handle, DpiScreen.Width - Img.Width - (DpiScreen.Width - 800) *68 3 div 8, (DpiScreen.Height - 600) div 3, Img.Width, Img.Height,69 Img.Canvas.Handle, 0, 0, SRCCOPY);70 end;71 72 procedure TBackground.FormClose(Sender: TObject; var Action: TCloseAction);73 begin74 end;75 76 84 end. -
branches/highdpi/CityProcessing.pas
r38 r210 630 630 TileInfo: TTileInfo; 631 631 begin 632 BestDist := MaxInt; 632 633 {$IFOPT O-}assert(1 shl p and InvalidTreatyMap = 0); {$ENDIF} 633 634 Best := 0; … … 660 661 result := Loc1; 661 662 Best := Resources; 662 BestDist := Dist 663 end 664 end 665 end 666 end; 667 end 663 BestDist := Dist; 664 end; 665 end; 666 end; 667 end; 668 end; 668 669 end; 669 670 -
branches/highdpi/Database.pas
r144 r210 11 11 const 12 12 // additional test flags 13 FastContact = false;{ extra small world with railroad everywhere }13 //{$DEFINE FastContact} { extra small world with railroad everywhere } 14 14 15 15 neumax = 4096; … … 957 957 end; 958 958 if (RealMap[Loc] xor Cardinal(OldTile)) and fTerrain <> 0 then 959 result := true 959 result := true; 960 960 end; 961 961 end; … … 991 991 begin 992 992 z0 := 6 * y div ly; 993 ZPlus := 6 * y / ly - z0 993 ZPlus := 6 * y / ly - z0; 994 994 end 995 995 else 996 996 begin 997 997 z0 := 6 * (ly - 1 - y) div ly; 998 ZPlus := 6 * (ly - 1 - y) / ly - z0 998 ZPlus := 6 * (ly - 1 - y) / ly - z0; 999 999 end; 1000 1000 p0 := 1; … … 1006 1006 begin 1007 1007 RndLow := i; 1008 Break 1009 end; 1010 p0 := p0 - p 1008 Break; 1009 end; 1010 p0 := p0 - p; 1011 1011 end; 1012 1012 end; … … 1053 1053 Cost := 0; 1054 1054 if Q.Put(Loc1, T + Cost shl 8 + 1) then 1055 From[Loc1] := Loc 1056 end 1057 end 1055 From[Loc1] := Loc; 1056 end; 1057 end; 1058 1058 end; 1059 1059 Loc1 := Loc; … … 1075 1075 else if RealMap[Loc] and fTerrain >= fGrass then 1076 1076 RealMap[Loc] := RealMap[Loc] or fRiver; 1077 end 1077 end; 1078 1078 end 1079 1079 else 1080 1080 result := 0; 1081 Q.Free 1081 Q.Free; 1082 1082 end; 1083 1083 … … 1404 1404 CityLoc[c, nCityLoc[c]] := Loc; 1405 1405 inc(nCityLoc[c]) 1406 end 1407 end 1406 end; 1407 end; 1408 1408 end; 1409 1409 Loc := (Loc + 1) * primitive mod (MapSize + 1) - 1; … … 1537 1537 IrrLoc[j] := IrrLoc[nIrrLoc - 1]; 1538 1538 dec(nIrrLoc); 1539 dec(i) 1539 dec(i); 1540 1540 end; 1541 1541 end; … … 1590 1590 StartLoc2[p1] := Loc1; 1591 1591 end; 1592 end 1592 end; 1593 1593 end; 1594 1594 end; { StartPositions } … … 1657 1657 i, p, p1, uix, Loc1: integer; 1658 1658 begin 1659 if FastContact then { Railroad everywhere } 1659 {$IFDEF FastContact} 1660 { Railroad everywhere } 1660 1661 for Loc1 := 0 to MapSize - 1 do 1661 1662 if RealMap[Loc1] and fTerrain >= fGrass then 1662 1663 RealMap[Loc1] := RealMap[Loc1] or fRR; 1664 {$ENDIF} 1663 1665 1664 1666 { !!!for Loc1:=0 to MapSize-1 do … … 1795 1797 StartPositions; 1796 1798 InitGame; 1797 end; { InitRandomGame }1799 end; 1798 1800 1799 1801 procedure InitMapGame(Human: integer); … … 1803 1805 PredefinedStartPositions(Human); 1804 1806 InitGame; 1805 end; { InitMapGame }1807 end; 1806 1808 1807 1809 procedure ReleaseGame; … … 1824 1826 FreeMem(RW[p1].MapObservedLast); 1825 1827 FreeMem(RW[p1].Map); 1826 end 1828 end; 1827 1829 end; 1828 1830 … … 1944 1946 begin 1945 1947 result := eNoPreq; 1946 exit 1948 exit; 1947 1949 end; 1948 1950 end; … … 1958 1960 begin 1959 1961 result := eInvalid; 1960 exit 1962 exit; 1961 1963 end; // no city found here 1962 1964 … … 2114 2116 Det := TestDet; 2115 2117 Cost := TestCost; 2116 end 2117 end 2118 end 2118 end; 2119 end; 2120 end; 2119 2121 end; 2120 2122 end; … … 2178 2180 UnitReport.ReportFlags := UnitReport.ReportFlags or urfDeployed; 2179 2181 end; 2180 end 2182 end; 2181 2183 end; 2182 2184 end; … … 2373 2375 end 2374 2376 else 2375 AddFlags := AddFlags or Map[Loc] and (fStealthUnit or fHiddenUnit) 2376 end 2377 AddFlags := AddFlags or Map[Loc] and (fStealthUnit or fHiddenUnit); 2378 end; 2377 2379 end; // if Mode>moLoading_Fast 2378 2380 … … 2431 2433 ObserveLevel[Loc] := ObserveLevel[Loc] and not(3 shl (2 * pTell)) or 2432 2434 Cardinal(Level) shl (2 * pTell); 2433 end 2435 end; 2434 2436 end; // DiscoverTile 2435 2437 … … 2460 2462 result := DiscoverTile(Loc1, p, pTell, Level, EnableContact) 2461 2463 or result; 2462 end 2464 end; 2463 2465 end 2464 2466 else … … 2467 2469 if Level > OldLevel then 2468 2470 result := DiscoverTile(Loc1, p, p, Level, EnableContact) or result; 2469 end 2471 end; 2470 2472 end; 2471 2473 end; … … 2500 2502 result := DiscoverTile(Loc1, p, pTell, Level, EnableContact) 2501 2503 or result; 2502 end 2504 end; 2503 2505 end 2504 2506 else … … 2507 2509 if Level > OldLevel then 2508 2510 result := DiscoverTile(Loc1, p, p, Level, EnableContact) or result; 2509 end 2511 end; 2510 2512 end; 2511 2513 AdjacentFlags := AdjacentFlags shr 1; … … 2570 2572 RW[pTell].EnemyCity[ecix].Loc := -1; 2571 2573 RW[pTell].Map[Loc] := RW[pTell].Map[Loc] and not fCity 2572 end 2573 end 2574 end 2574 end; 2575 end; 2576 end; 2575 2577 end; 2576 2578 end; … … 2594 2596 RWemix[p, Occupant[Loc], unx.mix]; 2595 2597 inc(result); 2596 end 2597 end 2598 end; 2599 end; 2598 2600 end; 2599 2601 … … 2655 2657 ClearFlags := ClearFlags or fOwnZoCUnit; 2656 2658 RW[p].Map[Loc] := RW[p].Map[Loc] and not ClearFlags or AddFlags; 2657 end 2658 end 2659 end 2659 end; 2660 end; 2661 end; 2660 2662 end; 2661 2663 … … 2691 2693 Tile1^ := Tile1^ or fInEnemyZoC; 2692 2694 Break 2693 end 2694 end 2695 end; 2696 end 2697 end 2695 end; 2696 end; 2697 end; 2698 end; 2699 end; 2698 2700 end; 2699 2701 … … 2721 2723 if (Loc1 >= 0) and (Loc1 < MapSize) then 2722 2724 RW[p].Map[Loc1] := RW[p].Map[Loc1] or fInEnemyZoC 2723 end 2724 end 2725 end 2725 end; 2726 end; 2727 end; 2726 2728 end; 2727 2729 … … 2740 2742 for Loc := 0 to MapSize - 1 do 2741 2743 if PeacePlayer[RW[p].Territory[Loc]] then 2742 RW[p].Map[Loc] := RW[p].Map[Loc] or fPeace 2744 RW[p].Map[Loc] := RW[p].Map[Loc] or fPeace; 2743 2745 end; 2744 2746 … … 2754 2756 p1: integer; 2755 2757 begin 2756 assert(p >= 0); // no player's territory indicated by p=nPl2757 dec(TerritoryCount[RealMap[Loc] shr 27]);2758 inc(TerritoryCount[p]);2758 Assert(p >= 0); // no player's territory indicated by p=nPl 2759 Dec(TerritoryCount[RealMap[Loc] shr 27]); 2760 Inc(TerritoryCount[p]); 2759 2761 RealMap[Loc] := RealMap[Loc] and not($F shl 27) or Cardinal(p) shl 27; 2760 2762 if p = $F then … … 2770 2772 else 2771 2773 RW[p1].Map[Loc] := RW[p1].Map[Loc] and not fPeace; 2772 end 2774 end; 2773 2775 end; 2774 2776 … … 2797 2799 ChangeTerritory(Loc, NewOwner); 2798 2800 inc(i); 2799 end 2800 end 2801 end; 2802 end; 2801 2803 end; 2802 2804 … … 2839 2841 then 2840 2842 StolenDist[Loc1] := NewDist; 2841 end 2842 end 2843 end; 2844 end; 2843 2845 end; 2844 2846 end; … … 2875 2877 Country[Loc1] := FormerCountry[Loc]; 2876 2878 Dist[Loc1] := NewDist; 2877 end 2878 end 2879 end 2879 end; 2880 end; 2881 end; 2880 2882 end; 2881 2883 … … 3026 3028 if RW[p].Model[mix].Flags and mdZOC <> 0 then 3027 3029 ZoCMap[Loc] := 1; 3028 end 3030 end; 3029 3031 end; 3030 3032 3031 3033 procedure CountLost(p, mix, Enemy: integer); 3032 3034 begin 3033 inc(RW[p].Model[mix].Lost);3035 Inc(RW[p].Model[mix].Lost); 3034 3036 TellAboutModel(Enemy, p, mix); 3035 inc(Destroyed[Enemy, p, mix]);3037 Inc(Destroyed[Enemy, p, mix]); 3036 3038 end; 3037 3039 … … 3064 3066 if Enemy >= 0 then 3065 3067 CountLost(p, mix, Enemy); 3066 end 3067 end; { RemoveUnit }3068 end; 3069 end; 3068 3070 3069 3071 procedure RemoveUnit_UpdateMap(p, uix: integer); 3070 3072 var 3071 Loc0: integer;3073 Loc0: Integer; 3072 3074 begin 3073 3075 Loc0 := RW[p].Un[uix].Loc; … … 3138 3140 ChangeTerritory(Loc, p) 3139 3141 end; 3140 end; { FoundCity }3142 end; 3141 3143 3142 3144 procedure StealCity(p, cix: integer; SaveUnits: boolean); … … 3178 3180 else 3179 3181 RemoveUnit(p, uix1); // destroy supported units 3180 end; // StealCity3182 end; 3181 3183 3182 3184 procedure DestroyCity(p, cix: integer; SaveUnits: boolean); … … 3197 3199 RealMap[Loc] := RealMap[Loc] and not fCity; 3198 3200 Loc := -1 3199 end 3200 end; // DestroyCity3201 end; 3202 end; 3201 3203 3202 3204 procedure ChangeCityOwner(pOld, cixOld, pNew: integer); … … 3275 3277 ChangeTerritory(Loc, pNew); 3276 3278 end; 3277 end; // ChangeCityOwner3279 end; 3278 3280 3279 3281 procedure CompleteJob(p, Loc, Job: integer); … … 3411 3413 if RW[pAbout].Un[uix].Loc >= 0 then 3412 3414 inc(UnCount[RW[pAbout].Un[uix].mix]); 3413 end 3415 end; 3414 3416 end; 3415 3417 … … 3426 3428 begin 3427 3429 end; } 3428 end 3430 end; 3429 3431 end; 3430 3432 … … 3447 3449 rTarget.ResearchTech := rSender.ResearchTech; 3448 3450 rTarget.ResearchDone := rSender.ResearchDone; 3449 result := true 3451 result := true; 3450 3452 end; 3451 3453 for i := 0 to nAdv - 1 do … … 3453 3455 begin 3454 3456 rTarget.Tech[i] := rSender.Tech[i]; 3455 result := true 3456 end 3457 result := true; 3458 end; 3457 3459 end; 3458 3460 … … 3474 3476 for mix := 0 to rTarget.nModelCounted - 1 do 3475 3477 TellAboutModel(pTarget, pAbout, mix); 3476 result := true 3477 end 3478 result := true; 3479 end; 3478 3480 end; 3479 3481 … … 3491 3493 MakeModelInfo(pTarget, i, RW[pTarget].Model[i], miTarget); 3492 3494 if IsSameModel(miSender, miTarget) then 3493 ok := false 3495 ok := false; 3494 3496 end; 3495 3497 if ok then … … 3509 3511 inc(Researched[pTarget]); 3510 3512 TellAboutModel(pSender, pTarget, RW[pTarget].nModel - 1); 3511 end 3513 end; 3512 3514 end; 3513 3515 … … 3662 3664 RecalcPeaceMap(pSender); 3663 3665 RecalcPeaceMap(pTarget); 3664 end 3665 end 3666 end; 3667 end; 3666 3668 end; 3667 3669 opShipParts: // + number + part type shl 16 … … 3681 3683 RW[pSender].Ship[pTarget].Parts[i] := GShip[pTarget].Parts[i]; 3682 3684 RW[pTarget].Ship[pTarget].Parts[i] := GShip[pTarget].Parts[i]; 3683 end 3684 end 3685 end; 3686 end; 3685 3687 end 3686 3688 else … … 3695 3697 dec(RW[pSender].Money, Price - opMoney); 3696 3698 inc(RW[pTarget].Money, Price - opMoney); 3697 end 3699 end; 3698 3700 end 3699 3701 else … … 3710 3712 SeeTech(pTarget, Price - opTech); 3711 3713 RW[pSender].EnemyReport[pTarget].Tech[Price - opTech] := tsSeen; 3712 end 3714 end; 3713 3715 end 3714 3716 else … … 3807 3809 RecalcMapZoC(p); 3808 3810 RecalcMapZoC(pWith); 3809 end 3811 end; 3810 3812 end; 3811 3813 if OldTreaty in [trPeace, trAlliance] then … … 3813 3815 RecalcPeaceMap(p); 3814 3816 RecalcPeaceMap(pWith); 3815 end 3817 end; 3816 3818 end; 3817 3819 … … 3854 3856 if CopyMilReport(pCity, p, p1) then 3855 3857 result := result or (2 shl (2 * p1)); 3856 end 3858 end; 3857 3859 end; 3858 3860 end; … … 3911 3913 if RW[p2].EnemyReport[p1].Tech[AgePreq[i]] < tsApplicable then 3912 3914 RW[p2].EnemyReport[p1].Tech[AgePreq[i]] := tsCheat; 3913 end 3915 end; 3914 3916 end; 3915 3917 … … 3925 3927 GiveCivilReport(p, p1); 3926 3928 GiveMilReport(p, p1); 3927 end 3928 end 3929 end; 3930 end; 3929 3931 end; 3930 3932 end; -
branches/highdpi/Direct.pas
r143 r210 5 5 6 6 uses 7 Messg,7 UDpiControls, Messg, 8 8 9 9 LCLIntf, LCLType, {$IFDEF Linux}LMessages, {$ENDIF}Messages, SysUtils, Classes, … … 129 129 ShowModal; 130 130 if ModalResult = mrOK then 131 OpenURL( 'http://c-evo.org/_sg/contact/cevobug.html');131 OpenURL(CevoContactBug); 132 132 end 133 133 *) … … 216 216 if Brains.Count = 3 then 217 217 begin 218 Application.MessageBox(PChar(Phrases.Lookup('NOAI')), 'C-evo', 0);218 DpiApplication.MessageBox(PChar(Phrases.Lookup('NOAI')), 'C-evo', 0); 219 219 Close; 220 exit 220 exit; 221 221 end; 222 222 Quick := false; … … 244 244 begin 245 245 SimpleMessage(Phrases.Lookup('LOADERR')); 246 Close 247 end 248 end 249 end; 250 if not Quick then 251 begin 246 Close; 247 end; 248 end; 249 end; 250 if not Quick then begin 252 251 background.Show; 253 StartDlg.Show 254 end 252 StartDlg.Show; 253 end; 255 254 end; 256 255 … … 267 266 procedure TDirectDlg.OnAIException(var Msg: TMessage); 268 267 begin 269 Application.MessageBox(PChar(Format(Phrases.Lookup('AIEXCEPTION'),268 DpiApplication.MessageBox(PChar(Format(Phrases.Lookup('AIEXCEPTION'), 270 269 [Brains[Msg.WParam].Name])), 'C-evo', 0); 271 270 end; … … 310 309 PaintProgressBar(Canvas, 6, ClientWidth div 2 - 64, 40, State, 128 - State, 311 310 128, MainTexture); 312 end 311 end; 313 312 end; 314 313 -
branches/highdpi/GameServer.pas
r178 r210 7 7 8 8 uses 9 Protocol, Database, dynlibs, Platform, dateutils, fgl, FileUtil, Graphics, 10 UDpiControls; 9 UDpiControls, Protocol, Database, dynlibs, Platform, dateutils, fgl, LazFileUtils, Graphics; 11 10 12 11 const … … 117 116 function PreviewMap(lm: integer): pointer; 118 117 118 119 119 implementation 120 120 121 121 uses 122 Directories, CityProcessing, UnitProcessing, CmdList, 123 124 LCLIntf, LCLType, LMessages, Classes, SysUtils; 122 Directories, CityProcessing, UnitProcessing, CmdList, LCLIntf, LCLType, 123 LMessages, Classes, SysUtils; 124 125 resourcestring 126 SNoAiFound = 'No AI libraries found in directory %s'; 125 127 126 128 var … … 257 259 BrainBeginner := nil; 258 260 259 if FindFirst( HomeDir + 'AI'+ DirectorySeparator + '*', faDirectory or faArchive or faReadOnly, f) = 0 then261 if FindFirst(GetAiDir + DirectorySeparator + '*', faDirectory or faArchive or faReadOnly, f) = 0 then 260 262 repeat 261 BasePath := HomeDir + 'AI'+ DirectorySeparator + f.Name;263 BasePath := GetAiDir + DirectorySeparator + f.Name; 262 264 if (f.Name <> '.') and (f.Name <> '..') and DirectoryExists(BasePath) then begin 263 265 NewBrain := Brains.AddNew; … … 273 275 274 276 if Brains.GetKindCount(btAI) = 0 then 275 raise Exception.Create(Format( 'No AI libraries found in directory %s', [HomeDir + 'AI']));277 raise Exception.Create(Format(SNoAiFound, [GetAiDir])); 276 278 end; 277 279 … … 305 307 end; 306 308 CreateMap(true); 307 result := @RealMap;309 Result := @RealMap; 308 310 end; 309 311 … … 557 559 s: string[255]; 558 560 begin 559 MapFile := TFileStream.Create( DataDir + 'Maps'+ DirectorySeparator + FileName,561 MapFile := TFileStream.Create(GetMapsDir + DirectorySeparator + FileName, 560 562 fmCreate or fmShareExclusive); 561 563 MapFile.Position := 0; … … 580 582 MapFile := nil; 581 583 try 582 MapFile := TFileStream.Create( DataDir + 'Maps'+ DirectorySeparator + FileName,584 MapFile := TFileStream.Create(GetMapsDir + DirectorySeparator + FileName, 583 585 fmOpenRead or fmShareExclusive); 584 586 MapFile.Position := 0; … … 1367 1369 LogFileName := FileName; 1368 1370 MapFileName := Map; 1369 if FastContact then 1370 begin 1371 {$IFDEF FastContact} 1371 1372 lx := 24; 1372 1373 ly := 42; 1373 end 1374 else 1375 begin 1374 {$ELSE} 1376 1375 lx := Newlx; 1377 ly := Newly 1378 end;1376 ly := Newly; 1377 {$ENDIF} 1379 1378 MapSize := lx * ly; 1380 1379 if MapFileName <> '' then … … 2698 2697 end; 2699 2698 2700 const2701 Dirx: array [0 .. 7] of integer = (1, 2, 1, 0, -1, -2, -1, 0);2702 Diry: array [0 .. 7] of integer = (-1, 0, 1, 2, 1, 0, -1, -2);2703 2704 2699 var 2705 2700 d, i, j, p1, p2, pt0, pt1, uix1, cix1, Loc0, Loc1, dx, dy, NewCap, MinCap, … … 2707 2702 StopTurn, FutureMCost, NewProject, OldImp, mix, V8, V21, AStr, DStr, 2708 2703 ABaseDamage, DBaseDamage: integer; 2709 CityReport , AltCityReport: TCityReport;2704 CityReport: TCityReport; 2710 2705 FormerCLState: TCmdListState; 2711 EndTime: int64;2712 2706 Adjacent: TVicinity8Loc; 2713 2707 Radius: TVicinity21Loc; … … 4585 4579 constructor TBrain.Create; 4586 4580 begin 4587 Picture := nil; 4581 Picture := TDpiBitmap.Create; 4582 Picture.SetSize(64, 64); 4588 4583 end; 4589 4584 4590 4585 destructor TBrain.Destroy; 4591 4586 begin 4592 if Assigned(Picture) then Picture.Free;4587 FreeAndNil(Picture); 4593 4588 inherited Destroy; 4594 4589 end; -
branches/highdpi/Inp.pas
r193 r210 5 5 6 6 uses 7 ScreenTools, Messg,7 UDpiControls, ScreenTools, Messg, 8 8 LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, DrawDlg, 9 ButtonA, StdCtrls , UDpiControls;9 ButtonA, StdCtrls; 10 10 11 11 type -
branches/highdpi/Install/deb/debian/control
r178 r210 8 8 Package: c-evo 9 9 Architecture: any 10 Depends: ${shlibs:Depends}, ${misc:Depends}, 10 Depends: ${shlibs:Depends}, ${misc:Depends}, sox, libsox-fmt-mp3 11 11 Description: Empire building game 12 12 HomePage: https://app.zdechov.net/c-evo -
branches/highdpi/Install/win/C-evo.iss
r160 r210 19 19 AppVersion={#MyAppVersion} 20 20 AppVerName={#MyAppName} {#MyAppVersion} 21 UninstallDisplayName={#MyAppName} 22 UninstallDisplayIcon="{app}\{#MyAppExeName}" 23 VersionInfoVersion={#MyAppVersion} 24 VersionInfoCompany={#MyAppPublisher} 21 25 AppPublisher={#MyAppPublisher} 22 26 AppPublisherURL={#MyAppURL} … … 80 84 Name: "ai\seti"; Description: "SETI"; Types: full; Check: not Is64BitInstallMode; 81 85 Name: "ai\shah"; Description: "Shah"; Types: full; Check: not Is64BitInstallMode; 86 Name: "ai_template"; Description: "AI template"; Types: full 82 87 83 88 [Files] … … 97 102 Source: "{#MyAppSubDir}\Language.txt"; DestDir: "{app}"; Flags: ignoreversion; Components: main 98 103 Source: "{#MyAppSubDir}\Language2.txt"; DestDir: "{app}"; Flags: ignoreversion; Components: main 104 Source: "{#MyAppSubDir}\AI Template\*.*"; DestDir: "{app}\AI Template"; Flags: ignoreversion recursesubdirs; Components: ai_template 99 105 Source: "{#MyAppSubDir}\AI\StdAI\lib\x86_64-win64-Release\StdAI.dll"; DestDir: "{app}\AI\StdAI"; DestName: "StdAI-win64.dll"; Flags: ignoreversion; Components: ai\stdai 100 106 Source: "{#MyAppSubDir}\AI\StdAI\lib\i386-win32-Release\StdAI.dll"; DestDir: "{app}\AI\StdAI"; DestName: "StdAI-win32.dll"; Flags: ignoreversion; Components: ai\stdai -
branches/highdpi/Integrated.lpi
r193 r210 16 16 <ResourceType Value="res"/> 17 17 <UseXPManifest Value="True"/> 18 <XPManifest>19 <DpiAware Value="True"/>20 </XPManifest>21 18 <Icon Value="0"/> 22 19 <Resources Count="2"> … … 102 99 </Item3> 103 100 </RequiredPackages> 104 <Units Count="4 0">101 <Units Count="41"> 105 102 <Unit0> 106 103 <Filename Value="Integrated.lpr"/> … … 163 160 <ComponentName Value="Background"/> 164 161 <HasResources Value="True"/> 165 <ResourceBaseClass Value="Form"/>166 162 </Unit11> 167 163 <Unit12> … … 328 324 <ComponentName Value="LocaleDlg"/> 329 325 <HasResources Value="True"/> 326 <ResourceBaseClass Value="Form"/> 330 327 </Unit38> 331 328 <Unit39> … … 333 330 <IsPartOfProject Value="True"/> 334 331 </Unit39> 332 <Unit40> 333 <Filename Value="Global.pas"/> 334 <IsPartOfProject Value="True"/> 335 </Unit40> 335 336 </Units> 336 337 </ProjectOptions> … … 366 367 <Linking> 367 368 <Debugging> 369 <UseHeaptrc Value="True"/> 368 370 <UseExternalDbgSyms Value="True"/> 369 371 </Debugging> … … 382 384 </CompilerOptions> 383 385 <Debugging> 384 <Exceptions Count=" 4">386 <Exceptions Count="3"> 385 387 <Item1> 386 388 <Name Value="EAbort"/> … … 392 394 <Name Value="EFOpenError"/> 393 395 </Item3> 394 <Item4>395 <Name Value="EReadError"/>396 </Item4>397 396 </Exceptions> 398 397 </Debugging> -
branches/highdpi/Integrated.lpr
r180 r210 3 3 4 4 uses 5 Forms, Interfaces, SysUtils, 6 Protocol in 'Protocol.pas', 7 CmdList in 'CmdList.pas', 8 Database in 'Database.pas', 9 GameServer in 'GameServer.pas', 10 CityProcessing in 'CityProcessing.pas', 11 UnitProcessing in 'UnitProcessing.pas', 12 Direct in 'Direct.pas' {DirectDlg} , 13 Start in 'Start.pas' {StartDlg} , 14 Messg in 'Messg.pas' {MessgDlg} , 15 Inp in 'Inp.pas' {InputDlg} , 16 Back in 'Back.pas' {Background} , 17 Log in 'Log.pas' {LogDlg} , 18 PVSB in 'LocalPlayer\PVSB.pas', 19 LocalPlayer in 'LocalPlayer\LocalPlayer.pas', 20 ClientTools in 'LocalPlayer\ClientTools.pas', 21 Diplomacy in 'LocalPlayer\Diplomacy.pas', 22 Tribes in 'LocalPlayer\Tribes.pas', 23 IsoEngine in 'LocalPlayer\IsoEngine.pas', 24 Term in 'LocalPlayer\Term.pas' {MainScreen} , 25 MessgEx in 'LocalPlayer\MessgEx.pas' {MessgExDlg} , 26 Help in 'LocalPlayer\Help.pas' {HelpDlg} , 27 Select in 'LocalPlayer\Select.pas' {ListDlg} , 28 CityScreen in 'LocalPlayer\CityScreen.pas' {CityDlg} , 29 UnitStat in 'LocalPlayer\UnitStat.pas' {UnitStatDlg} , 30 Draft in 'LocalPlayer\Draft.pas' {DraftDlg} , 31 NatStat in 'LocalPlayer\NatStat.pas' {NatStatDlg} , 32 Diagram in 'LocalPlayer\Diagram.pas' {DiaDlg} , 33 Wonders in 'LocalPlayer\Wonders.pas' {WonderDlg} , 34 Nego in 'LocalPlayer\Nego.pas' {NegoDlg} , 35 CityType in 'LocalPlayer\CityType.pas' {CityTypeDlg} , 36 Enhance in 'LocalPlayer\Enhance.pas' {EnhanceDlg} , 37 NoTerm in 'NoTerm.pas' {NoTermDlg} , 38 Battle in 'LocalPlayer\Battle.pas' {BattleDlg} , 39 Rates in 'LocalPlayer\Rates.pas' {RatesDlg} , 40 TechTree in 'LocalPlayer\TechTree.pas' {TechTreeDlg}, 41 ScreenTools, Directories, UDpiControls; 5 UDpiControls, Forms, Interfaces, SysUtils, Protocol, GameServer, Direct, Start, Messg, Inp, 6 Back, Log, LocalPlayer, ClientTools, Tribes, IsoEngine, Term, CityScreen, Nego, 7 NoTerm, ScreenTools, Directories; 42 8 43 9 {$if declared(UseHeapTrace)} … … 58 24 DpiApplication.Initialize; 59 25 DpiApplication.Title := 'c-evo'; 60 Directories. InitUnit;26 Directories.UnitInit; 61 27 ScreenTools.UnitInit; 62 28 DpiApplication.CreateForm(TDirectDlg, DirectDlg); -
branches/highdpi/Language.txt
r178 r210 942 942 Hurry\Production 943 943 Maximize\Production 944 945 #SETTINGS 946 Full screen -
branches/highdpi/LocalPlayer/Battle.pas
r193 r210 5 5 6 6 uses 7 ScreenTools, Protocol, Messg, ButtonBase, ButtonA, Types, LCLIntf, LCLType,8 SysUtils, Classes, Graphics, Controls, Forms, DrawDlg , UDpiControls;7 UDpiControls, ScreenTools, Protocol, ButtonBase, ButtonA, Types, LCLIntf, LCLType, 8 SysUtils, Classes, Graphics, Controls, Forms, DrawDlg; 9 9 10 10 type … … 107 107 VLightGradient(ca, xm - 8, ym + 8 + LABaseDamage, LADamage - LABaseDamage, 108 108 FanaticColor); 109 DpiBit Blt(ca.Handle, xm - 12, ym - 12, 24, 24,110 GrExt[HGrSystem].Mask.Canvas .Handle, 26, 146, SRCAND);111 DpiBit Blt(ca.Handle, xm - 12, ym - 12, 24, 24,112 GrExt[HGrSystem].Data.Canvas .Handle, 26, 146, SRCPAINT);109 DpiBitCanvas(ca, xm - 12, ym - 12, 24, 24, 110 GrExt[HGrSystem].Mask.Canvas, 26, 146, SRCAND); 111 DpiBitCanvas(ca, xm - 12, ym - 12, 24, 24, 112 GrExt[HGrSystem].Data.Canvas, 26, 146, SRCPAINT); 113 113 114 114 LabelText := Format('%d', [Forecast.AStr]); … … 132 132 if Forecast.EndHealthDef <= 0 then 133 133 begin 134 DpiBit Blt(ca.Handle, xm + 9 + LDDamage - 7, ym - 6, 14, 17,135 GrExt[HGrSystem].Mask.Canvas .Handle, 51, 153, SRCAND);136 DpiBit Blt(ca.Handle, xm + 8 + LDDamage - 7, ym - 7, 14, 17,137 GrExt[HGrSystem].Mask.Canvas .Handle, 51, 153, SRCAND);138 DpiBit Blt(ca.Handle, xm + 8 + LDDamage - 7, ym - 7, 14, 17,139 GrExt[HGrSystem].Data.Canvas .Handle, 51, 153, SRCPAINT);134 DpiBitCanvas(ca, xm + 9 + LDDamage - 7, ym - 6, 14, 17, 135 GrExt[HGrSystem].Mask.Canvas, 51, 153, SRCAND); 136 DpiBitCanvas(ca, xm + 8 + LDDamage - 7, ym - 7, 14, 17, 137 GrExt[HGrSystem].Mask.Canvas, 51, 153, SRCAND); 138 DpiBitCanvas(ca, xm + 8 + LDDamage - 7, ym - 7, 14, 17, 139 GrExt[HGrSystem].Data.Canvas, 51, 153, SRCPAINT); 140 140 end; 141 141 LabelText := Format('%d', [DDamage]); … … 152 152 if Forecast.EndHealthAtt <= 0 then 153 153 begin 154 DpiBit Blt(ca.Handle, xm - 6, ym + 9 + LADamage - 7, 14, 17,155 GrExt[HGrSystem].Mask.Canvas .Handle, 51, 153, SRCAND);156 DpiBit Blt(ca.Handle, xm - 7, ym + 8 + LADamage - 7, 14, 17,157 GrExt[HGrSystem].Mask.Canvas .Handle, 51, 153, SRCAND);158 DpiBit Blt(ca.Handle, xm - 7, ym + 8 + LADamage - 7, 14, 17,159 GrExt[HGrSystem].Data.Canvas .Handle, 51, 153, SRCPAINT);154 DpiBitCanvas(ca, xm - 6, ym + 9 + LADamage - 7, 14, 17, 155 GrExt[HGrSystem].Mask.Canvas, 51, 153, SRCAND); 156 DpiBitCanvas(ca, xm - 7, ym + 8 + LADamage - 7, 14, 17, 157 GrExt[HGrSystem].Mask.Canvas, 51, 153, SRCAND); 158 DpiBitCanvas(ca, xm - 7, ym + 8 + LADamage - 7, 14, 17, 159 GrExt[HGrSystem].Data.Canvas, 51, 153, SRCPAINT); 160 160 end; 161 161 LabelText := Format('%d', [MyUn[uix].Health - Forecast.EndHealthAtt]); … … 173 173 174 174 NoMap.SetOutput(Buffer); 175 DpiBit Blt(Buffer.Canvas.Handle, 0, 0, 66, 48, ca.Handle, xm + 8 + 4,176 ym - 8 - 12 - 48 , SRCCOPY);175 DpiBitCanvas(Buffer.Canvas, 0, 0, 66, 48, ca, xm + 8 + 4, 176 ym - 8 - 12 - 48); 177 177 { if TerrType<fForest then 178 178 Sprite(Buffer,HGrTerrain,0,16,66,32,1+TerrType*(xxt*2+1),1+yyt) … … 185 185 end; } 186 186 NoMap.PaintUnit(1, 0, UnitInfo, 0); 187 DpiBit Blt(ca.Handle, xm + 8 + 4, ym - 8 - 12 - 48, 66, 48, Buffer.Canvas.Handle,188 0, 0 , SRCCOPY);189 190 DpiBit Blt(Buffer.Canvas.Handle, 0, 0, 66, 48, ca.Handle, xm - 8 - 4 - 66,191 ym + 8 + 12 , SRCCOPY);187 DpiBitCanvas(ca, xm + 8 + 4, ym - 8 - 12 - 48, 66, 48, Buffer.Canvas, 188 0, 0); 189 190 DpiBitCanvas(Buffer.Canvas, 0, 0, 66, 48, ca, xm - 8 - 4 - 66, 191 ym + 8 + 12); 192 192 MakeUnitInfo(me, MyUn[uix], UnitInfo); 193 193 UnitInfo.Flags := UnitInfo.Flags and not unFortified; 194 194 NoMap.PaintUnit(1, 0, UnitInfo, 0); 195 DpiBitBlt(ca.Handle, xm - 8 - 4 - 66, ym + 8 + 12, 66, 48, Buffer.Canvas.Handle, 196 0, 0, SRCCOPY); 195 DpiBitCanvas(ca, xm - 8 - 4 - 66, ym + 8 + 12, 66, 48, Buffer.Canvas, 0, 0); 197 196 end; { PaintBattleOutcome } 198 197 -
branches/highdpi/LocalPlayer/CityScreen.pas
r193 r210 5 5 6 6 uses 7 {$IFDEF LINUX}7 UDpiControls, {$IFDEF LINUX} 8 8 LMessages, 9 9 {$ENDIF} 10 Protocol, ClientTools, Term, ScreenTools, IsoEngine, BaseWin, UDpiControls,10 Protocol, ClientTools, Term, ScreenTools, IsoEngine, BaseWin, 11 11 LCLIntf, LCLType, Messages, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, 12 12 ButtonA, ButtonC, Area, GraphType; … … 90 90 91 91 uses 92 Select, Messg, MessgEx, Help, Tribes, Directories, Math ;92 Select, Messg, MessgEx, Help, Tribes, Directories, Math, UPixelPointer, Sound; 93 93 94 94 {$R *.lfm} … … 216 216 Template := TDpiBitmap.Create; 217 217 Template.PixelFormat := pf24bit; 218 LoadGraphicFile(Template, HomeDir + 'Graphics'+ DirectorySeparator + 'City.png', gfNoGamma);218 LoadGraphicFile(Template, GetGraphicsDir + DirectorySeparator + 'City.png', gfNoGamma); 219 219 CityMapTemplate := TDpiBitmap.Create; 220 220 CityMapTemplate.PixelFormat := pf24bit; 221 LoadGraphicFile(CityMapTemplate, HomeDir + 'Graphics'+ DirectorySeparator + 'BigCityMap.png', gfNoGamma);221 LoadGraphicFile(CityMapTemplate, GetGraphicsDir + DirectorySeparator + 'BigCityMap.png', gfNoGamma); 222 222 SmallCityMapTemplate := TDpiBitmap.Create; 223 223 SmallCityMapTemplate.PixelFormat := pf24bit; 224 LoadGraphicFile(SmallCityMapTemplate, HomeDir + 'Graphics'+ DirectorySeparator + 'SmallCityMap.png',224 LoadGraphicFile(SmallCityMapTemplate, GetGraphicsDir + DirectorySeparator + 'SmallCityMap.png', 225 225 gfNoGamma); 226 226 SmallCityMap := TDpiBitmap.Create; … … 260 260 Back.Canvas.FillRect(0, 0, ClientWidth, ClientHeight); 261 261 262 Dpi bitblt(Back.Canvas.Handle, 0, 0, ClientWidth, ClientHeight,263 MainTexture.Image.Canvas .Handle, 0, 0, SRCCOPY);262 DpiBitCanvas(Back.Canvas, 0, 0, ClientWidth, ClientHeight, 263 MainTexture.Image.Canvas, 0, 0); 264 264 ImageOp_B(Back, Template, 0, 0, 0, 0, ClientWidth, ClientHeight); 265 265 end; … … 291 291 Color2 := Colors.Canvas.Pixels[clkAge0 + Age, cliHouse]; 292 292 SmallCityMap.Canvas.FillRect(0, 0, SmallCityMap.Width, SmallCityMap.Height); 293 Dpi bitblt(SmallCityMap.Canvas.Handle, 0, 0, 83, hSmallMap,294 SmallCityMapTemplate.Canvas .Handle, 83 * SizeClass, 0, SRCCOPY);293 DpiBitCanvas(SmallCityMap.Canvas, 0, 0, 83, hSmallMap, 294 SmallCityMapTemplate.Canvas, 83 * SizeClass, 0); 295 295 if IsPort then 296 296 begin 297 Dpi bitblt(SmallCityMap.Canvas.Handle, 83, 0, 15, hSmallMap,298 SmallCityMapTemplate.Canvas .Handle, 332 + 15, 0, SRCCOPY);297 DpiBitCanvas(SmallCityMap.Canvas, 83, 0, 15, hSmallMap, 298 SmallCityMapTemplate.Canvas, 332 + 15, 0); 299 299 ImageOp_CCC(SmallCityMap, 0, 0, 83, hSmallMap, Color0, Color1, Color2); 300 300 Color2 := Colors.Canvas.Pixels[clkCity, cliWater]; … … 303 303 else 304 304 begin 305 Dpi bitblt(SmallCityMap.Canvas.Handle, 83, 0, 15, hSmallMap,306 SmallCityMapTemplate.Canvas .Handle, 332, 0, SRCCOPY);305 DpiBitCanvas(SmallCityMap.Canvas, 83, 0, 15, hSmallMap, 306 SmallCityMapTemplate.Canvas, 332, 0); 307 307 ImageOp_CCC(SmallCityMap, 0, 0, wSmallMap, hSmallMap, Color0, 308 308 Color1, Color2); … … 311 311 with SmallCityMap.Canvas do 312 312 begin 313 brush.Color := ScreenTools.Colors.Canvas.Pixels[clkAge0 + Age, cliImp];313 Brush.Color := ScreenTools.Colors.Canvas.Pixels[clkAge0 + Age, cliImp]; 314 314 for i := 0 to 29 do 315 315 begin … … 359 359 ZoomCityMap.Canvas.FillRect(0, 0, ZoomCityMap.Width, ZoomCityMap.Height); 360 360 361 Dpi bitblt(ZoomCityMap.Canvas.Handle, 0, 0, wZoomMap, hZoomMap,362 Back.Canvas .Handle, xZoomMap, yZoomMap, SRCCOPY);361 DpiBitCanvas(ZoomCityMap.Canvas, 0, 0, wZoomMap, hZoomMap, 362 Back.Canvas, xZoomMap, yZoomMap); 363 363 if Mode = mImp then begin 364 364 if ZoomArea < 3 then begin … … 442 442 PixelPtr: TPixelPointer; 443 443 begin 444 X := ScaleToVcl(X); 445 Y := ScaleToVcl(Y); 446 W := ScaleToVcl(W); 447 H := ScaleToVcl(H); 444 448 Offscreen.BeginUpdate; 445 PixelPtr .Init(Offscreen, X, Y);449 PixelPtr := PixelPointer(Offscreen, X, Y); 446 450 for YY := 0 to H - 1 do begin 447 451 for XX := 0 to W - 1 do begin … … 498 502 499 503 var 500 x, y, xGr, i, i1,j, iix, d, dx, dy, PrCost, Cnt, Loc1, FreeSupp, Paintiix,504 x, y, xGr, i, j, iix, d, dx, dy, PrCost, Cnt, Loc1, FreeSupp, Paintiix, 501 505 HappyGain, OptiType, rx, ry, TrueFood, TrueProd, TruePoll: integer; 502 506 av: integer; … … 542 546 RedTex.clTextShade := $0000FF; 543 547 544 Dpibitblt(offscreen.Canvas.Handle, 0, 0, 640, 480, Back.Canvas.Handle, 0, 545 0, SRCCOPY); 546 547 offscreen.Canvas.Font.Assign(UniFont[ftCaption]); 548 DpiBitCanvas(offscreen.Canvas, 0, 0, 640, 480, Back.Canvas, 0, 0); 549 550 Offscreen.Canvas.Font.Assign(UniFont[ftCaption]); 548 551 RisedTextOut(offscreen.Canvas, 42, 7, Caption); 549 552 with offscreen.Canvas do … … 558 561 TextOut(8 + 14 - textwidth(s) div 2, 7, s); 559 562 end; 560 offscreen.Canvas.Font.Assign(UniFont[ftSmall]);563 Offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 561 564 562 565 if not IsCityAlive then … … 614 617 false, AllowChange and IsCityAlive and 615 618 (c.Status and csResourceWeightsMask = 0)); 616 Dpi bitblt(offscreen.Canvas.Handle, xmArea + 102, 42, 90, 33, Back.Canvas.Handle,617 xmArea + 102, 42 , SRCCOPY);619 DpiBitCanvas(offscreen.Canvas, xmArea + 102, 42, 90, 33, Back.Canvas, 620 xmArea + 102, 42); 618 621 619 622 if IsCityAlive then … … 645 648 else 646 649 xGr := 141; 647 Dpi bitblt(offscreen.Canvas.Handle, xmArea - 192 + 5 + i * d, ymArea - 96 - 29,648 27, 30, GrExt[HGrSystem].Mask.Canvas .Handle, xGr, 171, SRCAND); { shadow }650 DpiBitCanvas(offscreen.Canvas, xmArea - 192 + 5 + i * d, ymArea - 96 - 29, 651 27, 30, GrExt[HGrSystem].Mask.Canvas, xGr, 171, SRCAND); { shadow } 649 652 Sprite(offscreen, HGrSystem, xmArea - 192 + 4 + i * d, ymArea - 96 - 30, 27, 650 653 30, xGr, 171); … … 657 660 begin 658 661 xGr := 1 + 112; 659 Dpi bitblt(offscreen.Canvas.Handle, xmArea + 192 - 27 + 1 - i * d, 29 + 1, 27,660 30, GrExt[HGrSystem].Mask.Canvas .Handle, xGr, 171, SRCAND); { shadow }662 DpiBitCanvas(offscreen.Canvas, xmArea + 192 - 27 + 1 - i * d, 29 + 1, 27, 663 30, GrExt[HGrSystem].Mask.Canvas, xGr, 171, SRCAND); { shadow } 661 664 Sprite(offscreen, HGrSystem, xmArea + 192 - 27 - i * d, 29, 27, 30, 662 665 xGr, 171); … … 803 806 804 807 // small map 805 Dpi bitblt(offscreen.Canvas.Handle, xSmallMap, ySmallMap, wSmallMap, hSmallMap,806 SmallCityMap.Canvas .Handle, 0, 0, SRCCOPY);808 DpiBitCanvas(offscreen.Canvas, xSmallMap, ySmallMap, wSmallMap, hSmallMap, 809 SmallCityMap.Canvas, 0, 0); 807 810 if Mode = mImp then 808 811 Frame(offscreen.Canvas, xSmallMap + 48 * (ZoomArea div 3), … … 831 834 Sprite(offscreen, HGrSystem, x + 6, y - 5, 10, 10, 154, 126); 832 835 833 Dpi bitblt(offscreen.Canvas.Handle, xZoomMap, yZoomMap, wZoomMap, hZoomMap,834 ZoomCityMap.Canvas .Handle, 0, 0, SRCCOPY);836 DpiBitCanvas(offscreen.Canvas, xZoomMap, yZoomMap, wZoomMap, hZoomMap, 837 ZoomCityMap.Canvas, 0, 0); 835 838 836 839 for i := 0 to 5 do … … 1620 1623 with Canvas do 1621 1624 begin 1622 Dpi bitblt(Canvas.Handle, xView + 5, yView + 1, 64, 2, Back.Canvas.Handle,1623 xView + 5, yView + 1 , SRCCOPY);1624 Dpi bitblt(Canvas.Handle, xView + 5, yView + 3, 2, 42, Back.Canvas.Handle,1625 xView + 5, yView + 3 , SRCCOPY);1626 Dpi bitblt(Canvas.Handle, xView + 5 + 62, yView + 3, 2, 42,1627 Back.Canvas .Handle, xView + 5 + 62, yView + 3, SRCCOPY);1625 DpiBitCanvas(Canvas, xView + 5, yView + 1, 64, 2, Back.Canvas, 1626 xView + 5, yView + 1); 1627 DpiBitCanvas(Canvas, xView + 5, yView + 3, 2, 42, Back.Canvas, 1628 xView + 5, yView + 3); 1629 DpiBitCanvas(Canvas, xView + 5 + 62, yView + 3, 2, 42, 1630 Back.Canvas, xView + 5 + 62, yView + 3); 1628 1631 ScreenTools.Frame(Canvas, xView + 9 - 1, yView + 5 - 1, xView + 9 + xSizeBig, 1629 1632 yView + 5 + ySizeBig, $B0B0B0, $FFFFFF); 1630 1633 RFrame(Canvas, xView + 9 - 2, yView + 5 - 2, xView + 9 + xSizeBig + 1, 1631 1634 yView + 5 + ySizeBig + 1, $FFFFFF, $B0B0B0); 1632 brush.Color := $000000;1635 Brush.Color := $000000; 1633 1636 FillRect(Rect(xView + 9, yView + 5, xView + 1 + 72 - 8, 1634 1637 yView + 5 + 40)); 1635 brush.style := bsClear;1638 Brush.style := bsClear; 1636 1639 end 1637 1640 else if BlinkTime = 6 then … … 1644 1647 else if c.Project and cpImp = 0 then 1645 1648 begin // project is unit 1646 Dpi bitblt(Canvas.Handle, xView + 9, yView + 5, xSizeBig, ySizeBig,1647 bigimp.Canvas.Handle, 0, 0, SRCCOPY);1649 DpiBitCanvas(Canvas, xView + 9, yView + 5, xSizeBig, ySizeBig, 1650 Bigimp.Canvas, 0, 0); 1648 1651 with Tribe[cOwner].ModelPicture[c.Project and cpIndex] do 1649 1652 Sprite(Canvas, HGr, xView + 5, yView + 1, 64, 44, pix mod 10 * 65 + 1, -
branches/highdpi/LocalPlayer/CityType.pas
r179 r210 5 5 6 6 uses 7 Protocol, ClientTools, Term, ScreenTools, BaseWin, LCLIntf, LCLType,7 UDpiControls, Protocol, ClientTools, Term, ScreenTools, BaseWin, LCLIntf, LCLType, 8 8 SysUtils, Classes, Graphics, Controls, Forms, 9 9 ButtonB, ExtCtrls; … … 39 39 CityTypeDlg: TCityTypeDlg; 40 40 41 42 41 implementation 43 42 44 uses 45 Help, UDpiControls; 43 uses Help; 46 44 47 45 {$R *.lfm} … … 116 114 xSwitch + 38 + i * 42, ySwitch + 22, MainTexture.clBevelLight, 117 115 MainTexture.clBevelShade); 118 DpiBitBlt(offscreen.Canvas.Handle, xSwitch + 2 + i * 42, ySwitch + 2, 119 xSizeSmall, ySizeSmall, SmallImp.Canvas.Handle, (i + 3) * xSizeSmall, 120 0, SRCCOPY) 116 DpiBitCanvas(offscreen.Canvas, xSwitch + 2 + i * 42, ySwitch + 2, 117 xSizeSmall, ySizeSmall, SmallImp.Canvas, (i + 3) * xSizeSmall, 0); 121 118 end; 122 119 RisedTextOut(offscreen.Canvas, 8, yList + 32 * nListRow + 2, … … 151 148 yList + 16 + ySizeSmall div 2 + i div nListCol * 32, 152 149 MainTexture.clBevelLight, MainTexture.clBevelShade); 153 DpiBit Blt(offscreen.Canvas.Handle, xList + 21 - xSizeSmall div 2 +150 DpiBitCanvas(offscreen.Canvas, xList + 21 - xSizeSmall div 2 + 154 151 i mod nListCol * 42, yList + 16 - ySizeSmall div 2 + i div nListCol * 32, 155 xSizeSmall, ySizeSmall, SmallImp.Canvas .Handle,152 xSizeSmall, ySizeSmall, SmallImp.Canvas, 156 153 MyData.ImpOrder[ctype, i] mod 7 * xSizeSmall, 157 154 (MyData.ImpOrder[ctype, i] + SystemIconLines * 7) div 7 * 158 ySizeSmall , SRCCOPY);155 ySizeSmall); 159 156 inc(i); 160 157 end; … … 174 171 nPool div nPoolCol * 32, MainTexture.clBevelLight, 175 172 MainTexture.clBevelShade); 176 DpiBit Blt(offscreen.Canvas.Handle, xPool + 21 - xSizeSmall div 2 +173 DpiBitCanvas(offscreen.Canvas, xPool + 21 - xSizeSmall div 2 + 177 174 nPool mod nPoolCol * 42, yPool + 16 - ySizeSmall div 2 + 178 nPool div nPoolCol * 32, xSizeSmall, ySizeSmall, SmallImp.Canvas .Handle,175 nPool div nPoolCol * 32, xSizeSmall, ySizeSmall, SmallImp.Canvas, 179 176 iix mod 7 * xSizeSmall, (iix + SystemIconLines * 7) div 7 * 180 ySizeSmall , SRCCOPY);181 inc(nPool) 177 ySizeSmall); 178 inc(nPool); 182 179 end; 183 180 DeleteBtn.Visible := MyData.ImpOrder[ctype, 0] >= 0; … … 254 251 begin 255 252 dragiix := MyData.ImpOrder[ctype, i]; 256 Screen.Cursor := crImpDrag;253 DpiScreen.Cursor := crImpDrag; 257 254 SmartUpdateContent 258 255 end; … … 270 267 begin 271 268 dragiix := Pooliix[i]; 272 Screen.Cursor := crImpDrag;269 DpiScreen.Cursor := crImpDrag; 273 270 SmartUpdateContent 274 271 end; … … 332 329 SmartUpdateContent 333 330 end; 334 Screen.Cursor := crDefault331 DpiScreen.Cursor := crDefault 335 332 end; 336 333 -
branches/highdpi/LocalPlayer/ClientTools.pas
r70 r210 695 695 initialization 696 696 697 assert(nImp < 128);697 Assert(nImp < 128); 698 698 CalculateAdvValues; 699 699 -
branches/highdpi/LocalPlayer/Diagram.pas
r193 r210 5 5 6 6 uses 7 BaseWin, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms,8 ButtonB, Menus , UDpiControls;7 UDpiControls, BaseWin, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, 8 ButtonB, Menus; 9 9 10 10 type -
branches/highdpi/LocalPlayer/Draft.pas
r193 r210 5 5 6 6 uses 7 Protocol, ClientTools, Term, ScreenTools, BaseWin, UDpiControls, 7 UDpiControls, Protocol, ClientTools, Term, ScreenTools, BaseWin, 8 8 9 LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, 9 10 ButtonA, … … 91 92 Template := TDpiBitmap.Create; 92 93 Template.PixelFormat := pf24bit; 93 LoadGraphicFile(Template, HomeDir + 'Graphics'+ DirectorySeparator + 'MiliRes.png', gfNoGamma);94 LoadGraphicFile(Template, GetGraphicsDir + DirectorySeparator + 'MiliRes.png', gfNoGamma); 94 95 end; 95 96 … … 238 239 // assemble background from 2 texture tiles 239 240 begin 240 Dpi bitblt(Back.Canvas.Handle, 0, 0, ClientWidth, 64,241 MainTexture.Image.Canvas .Handle, (wMainTexture - ClientWidth) div 2,242 hMainTexture - 64 , SRCCOPY);243 Dpi bitblt(Back.Canvas.Handle, 0, 64, ClientWidth, ClientHeight - 64,244 MainTexture.Image.Canvas .Handle, (wMainTexture - ClientWidth) div 2,245 0 , SRCCOPY);241 DpiBitCanvas(Back.Canvas, 0, 0, ClientWidth, 64, 242 MainTexture.Image.Canvas, (wMainTexture - ClientWidth) div 2, 243 hMainTexture - 64); 244 DpiBitCanvas(Back.Canvas, 0, 64, ClientWidth, ClientHeight - 64, 245 MainTexture.Image.Canvas, (wMainTexture - ClientWidth) div 2, 246 0); 246 247 end 247 248 else 248 Dpi bitblt(Back.Canvas.Handle, 0, 0, ClientWidth, ClientHeight,249 MainTexture.Image.Canvas .Handle, (wMainTexture - ClientWidth) div 2,250 (hMainTexture - ClientHeight) div 2 , SRCCOPY);249 DpiBitCanvas(Back.Canvas, 0, 0, ClientWidth, ClientHeight, 250 MainTexture.Image.Canvas, (wMainTexture - ClientWidth) div 2, 251 (hMainTexture - ClientHeight) div 2); 251 252 ImageOp_B(Back, Template, 0, 0, 0, 0, Template.Width, 64); 252 253 ImageOp_B(Back, Template, 0, 64, 0, 64 + Cut, Template.Width, 253 254 Template.Height - 64 - Cut); 254 255 255 Dpi bitblt(offscreen.Canvas.Handle, 0, 0, ClientWidth, ClientHeight,256 Back.Canvas .Handle, 0, 0, SRCCOPY);256 DpiBitCanvas(offscreen.Canvas, 0, 0, ClientWidth, ClientHeight, 257 Back.Canvas, 0, 0); 257 258 258 259 offscreen.Canvas.Font.Assign(UniFont[ftCaption]); -
branches/highdpi/LocalPlayer/Enhance.pas
r179 r210 5 5 6 6 uses 7 ScreenTools, BaseWin, Protocol, ClientTools, Term, LCLIntf, LCLType,7 UDpiControls, ScreenTools, BaseWin, Protocol, ClientTools, Term, LCLIntf, LCLType, 8 8 9 9 SysUtils, Classes, Graphics, Controls, Forms, … … 45 45 EnhanceDlg: TEnhanceDlg; 46 46 47 48 47 implementation 49 48 50 uses 51 Help, UDpiControls; 49 uses Help; 52 50 53 51 {$R *.lfm} … … 98 96 for i := 0 to ControlCount - 1 do 99 97 if Controls[i] is TButtonC then 100 DpiBit Blt(Canvas.Handle, Controls[i].Left + 2, Controls[i].Top - 11, 8, 8,101 GrExt[HGrSystem].Data.Canvas .Handle, 121 + Controls[i].Tag mod 7 * 9,102 1 + Controls[i].Tag div 7 * 9 , SRCCOPY);98 DpiBitCanvas(Canvas, Controls[i].Left + 2, Controls[i].Top - 11, 8, 8, 99 GrExt[HGrSystem].Data.Canvas, 121 + Controls[i].Tag mod 7 * 9, 100 1 + Controls[i].Tag div 7 * 9); 103 101 end; 104 102 -
branches/highdpi/LocalPlayer/Help.lfm
r193 r210 1 1 object HelpDlg: THelpDlg 2 2 Left = 394 3 Height = 7184 3 Top = 180 5 Width = 8406 4 BorderIcons = [] 7 5 BorderStyle = bsNone 8 ClientHeight = 7189 ClientWidth = 8406 ClientHeight = 479 7 ClientWidth = 560 10 8 Color = clBtnFace 11 DesignTimePPI = 1449 Font.Charset = DEFAULT_CHARSET 12 10 Font.Color = clWindowText 13 Font.Height = - 2011 Font.Height = -13 14 12 Font.Name = 'MS Sans Serif' 13 Font.Style = [] 15 14 FormStyle = fsStayOnTop 16 15 OnClose = FormClose … … 18 17 OnDestroy = FormDestroy 19 18 OnKeyDown = FormKeyDown 19 OnMouseWheel = FormMouseWheel 20 20 OnMouseDown = PaintBox1MouseDown 21 21 OnMouseMove = PaintBox1MouseMove 22 OnMouseWheel = FormMouseWheel23 22 OnPaint = FormPaint 24 LCLVersion = '2.0.8.0'23 PixelsPerInch = 96 25 24 object CloseBtn: TButtonB 26 Left = 78327 Height = 3828 Top = 929 Width = 3825 Left = 522 26 Top = 6 27 Width = 25 28 Height = 25 30 29 Down = False 31 30 Permanent = False … … 34 33 end 35 34 object BackBtn: TButtonB 36 Left = 6337 Height = 3838 Top = 939 Width = 3835 Left = 42 36 Top = 6 37 Width = 25 38 Height = 25 40 39 Down = False 41 40 Permanent = False … … 44 43 end 45 44 object TopBtn: TButtonB 46 Left = 2047 Height = 3848 Top = 949 Width = 3845 Left = 13 46 Top = 6 47 Width = 25 48 Height = 25 50 49 Down = False 51 50 Permanent = False … … 54 53 end 55 54 object SearchBtn: TButtonB 56 Left = 74057 Height = 3858 Top = 959 Width = 3855 Left = 493 56 Top = 6 57 Width = 25 58 Height = 25 60 59 Down = False 61 60 Permanent = False -
branches/highdpi/LocalPlayer/Help.pas
r193 r210 5 5 6 6 uses 7 Protocol, ScreenTools, BaseWin, StringTables, Math, UDpiControls,8 LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls, Forms,9 ExtCtrls, ButtonB, PVSB, Types;7 UDpiControls, Protocol, ScreenTools, BaseWin, StringTables, Math, LCLIntf, LCLType, 8 Messages, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, 9 ButtonB, PVSB, Types, fgl; 10 10 11 11 const … … 41 41 THyperText = class(TStringList) 42 42 public 43 procedure AddLine(s: String = ''; Format: integer = 0; Picpix: integer = 0;43 procedure AddLine(s: String = ''; Format: integer = 0; Picpix: Integer = 0; 44 44 LinkCategory: integer = 0; LinkIndex: integer = 0); 45 procedure LF; 45 procedure LineFeed; 46 procedure AppendList(Source: THyperText); 46 47 destructor Destroy; override; 48 end; 49 50 { THistItem } 51 52 THistItem = class 53 Kind: Integer; 54 No: Integer; 55 Pos: Integer; 56 SearchContent: string; 57 procedure Assign(Source: THistItem); 58 end; 59 60 { THistItems } 61 62 THistItems = class(TFPGObjectList<THistItem>) 63 function AddNew(Kind, No, Pos: Integer; SearchContent: string): THistItem; 47 64 end; 48 65 … … 72 89 procedure OffscreenPaint; override; 73 90 private 74 Kind, no, Sel, nHist, CaptionColor: integer; 75 hADVHELP, hIMPHELP, hFEATUREHELP, hGOVHELP, hSPECIALMODEL, 76 hJOBHELP: integer; 77 SearchContent, NewSearchContent: string; 91 Kind: Integer; 92 no: Integer; 93 Sel: Integer; 94 CaptionColor: Integer; 95 hADVHELP, hIMPHELP, hFEATUREHELP, hGOVHELP, hSPECIALMODEL, hJOBHELP: Integer; 96 SearchContent: string; 97 NewSearchContent: string; 78 98 CaptionFont: TDpiFont; 79 MainText, SearchResult: THyperText; 99 MainText: THyperText; 100 SearchResult: THyperText; 80 101 HelpText: TStringTable; 81 102 ExtPic, TerrIcon: TDpiBitmap; 82 sb: TPVScrollbar; 83 x0: array [-2 .. 180] of integer; 84 HistKind: array [0 .. MaxHist - 1] of integer; 85 HistNo: array [0 .. MaxHist - 1] of integer; 86 HistPos: array [0 .. MaxHist - 1] of integer; 87 HistSearchContent: array [0 .. MaxHist - 1] of shortstring; 103 ScrollBar: TPVScrollbar; 104 x0: array [-2..180] of Integer; 105 procedure PaintTerrIcon(x, y, xSrc, ySrc: Integer); 88 106 procedure ScrollBarUpdate(Sender: TObject); 89 procedure line(ca: TDpiCanvas; i: integer; lit: boolean); 90 procedure Prepare(sbPos: integer = 0); 91 procedure WaterSign(x0, y0, iix: integer); 107 procedure Line(ca: TDpiCanvas; i: Integer; lit: Boolean); 108 procedure Prepare(sbPos: Integer = 0); 109 procedure ShowNewContentProcExecute(NewMode: Integer; HelpContext: string); 110 procedure WaterSign(x0, y0, iix: Integer); 92 111 procedure Search(SearchString: string); 93 112 procedure OnScroll(var m: TMessage); message WM_VSCROLL; 94 113 procedure OnMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE; 95 114 public 96 Difficulty: integer;97 procedure ShowNewContent(NewMode, Category, Index: integer);115 HistItems: THistItems; 116 Difficulty: Integer; 98 117 procedure ClearHistory; 99 function TextIndex(Item: string): integer; 118 procedure ShowNewContent(NewMode, Category, Index: Integer); 119 function TextIndex(Item: string): Integer; 100 120 end; 101 121 … … 103 123 HelpDlg: THelpDlg; 104 124 125 105 126 implementation 106 127 107 128 uses 108 Directories, ClientTools, Term, Tribes, Inp, Messg ;129 Directories, ClientTools, Term, Tribes, Inp, Messg, UPixelPointer, Global; 109 130 110 131 {$R *.lfm} 111 132 112 133 type 134 135 { THelpLineInfo } 136 113 137 THelpLineInfo = class 114 Format, Picpix: Byte; 138 Format: Byte; 139 Picpix: Byte; 115 140 Link: Word; 116 end; 141 procedure Assign(Source: THelpLineInfo); 142 end; 143 144 { THelpLineInfo } 145 146 procedure THelpLineInfo.Assign(Source: THelpLineInfo); 147 begin 148 Format := Source.Format; 149 PicPix := Source.PicPix; 150 Link := Source.Link; 151 end; 152 153 { THistItem } 154 155 procedure THistItem.Assign(Source: THistItem); 156 begin 157 Kind := Source.Kind; 158 No := Source.No; 159 Pos := Source.Pos; 160 SearchContent := Source.SearchContent; 161 end; 162 163 { THistItems } 164 165 function THistItems.AddNew(Kind, No, Pos: Integer; SearchContent: string 166 ): THistItem; 167 begin 168 Result := THistItem.Create; 169 Result.Kind := Kind; 170 Result.No := No; 171 Result.Pos := Pos; 172 Result.SearchContent := SearchContent; 173 Add(Result); 174 end; 117 175 118 176 procedure THyperText.AddLine(s: String; Format: integer; Picpix: integer; … … 130 188 end; 131 189 132 procedure THyperText.L F;190 procedure THyperText.LineFeed; 133 191 begin 134 192 AddLine; 193 end; 194 195 procedure THyperText.AppendList(Source: THyperText); 196 var 197 I: Integer; 198 HelpLineInfo: THelpLineInfo; 199 begin 200 for I := 0 to Source.Count - 1 do begin 201 HelpLineInfo := THelpLineInfo.Create; 202 HelpLineInfo.Assign(THelpLineInfo(Source.Objects[I])); 203 AddObject(Source.Strings[I], HelpLineInfo); 204 end; 135 205 end; 136 206 … … 198 268 begin 199 269 inherited; 270 HistItems := THistItems.Create; 271 200 272 CaptionLeft := BackBtn.Left + BackBtn.Width; 201 273 CaptionRight := SearchBtn.Left; … … 205 277 SearchResult := THyperText.Create; 206 278 SearchResult.OwnsObjects := True; 207 sb:= TPVScrollbar.Create(Self);208 sb.SetBorderSpacing(36, 9, 11);209 sb.OnUpdate := ScrollBarUpdate;279 ScrollBar := TPVScrollbar.Create(Self); 280 ScrollBar.SetBorderSpacing(36, 9, 11); 281 ScrollBar.OnUpdate := ScrollBarUpdate; 210 282 211 283 HelpText := TStringTable.Create; … … 218 290 hJOBHELP := HelpText.Gethandle('JOBHELP'); 219 291 220 CaptionFont := TDpiFont.Create;292 CaptionFont := Font.Create; 221 293 CaptionFont.Assign(UniFont[ftNormal]); 222 294 CaptionFont.Style := CaptionFont.Style + [fsItalic, fsBold]; … … 233 305 TerrIcon.Canvas.FillRect(0, 0, TerrIcon.Width, TerrIcon.Height); 234 306 SearchContent := ''; 235 nHist := -1; 236 end; 237 238 procedure THelpDlg.ClearHistory; 239 begin 240 nHist := -1; 307 ShowNewContentProc := ShowNewContentProcExecute; 308 end; 309 310 procedure THelpDlg.ShowNewContentProcExecute(NewMode: Integer; 311 HelpContext: string); 312 begin 313 HelpDlg.ShowNewContent(NewMode, hkText, 314 HelpDlg.TextIndex(HelpContext)) 241 315 end; 242 316 243 317 procedure THelpDlg.FormDestroy(Sender: TObject); 244 318 begin 245 FreeAndNil(sb); 319 ShowNewContentProc := nil; 320 FreeAndNil(ScrollBar); 246 321 FreeAndNil(MainText); 247 322 FreeAndNil(SearchResult); … … 250 325 FreeAndNil(HelpText); 251 326 // FreeAndNil(CaptionFont); 327 FreeAndNil(HistItems); 252 328 end; 253 329 … … 255 331 WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); 256 332 begin 257 if sb.ProcessMouseWheel(WheelDelta) then begin333 if ScrollBar.ProcessMouseWheel(WheelDelta) then begin 258 334 PaintBox1MouseMove(nil, [], MousePos.X - Left, 259 335 MousePos.Y - Top); … … 269 345 begin 270 346 { TODO: Handled by MouseWheel event 271 if sb.Process(m) then begin347 if ScrollBar.Process(m) then begin 272 348 Sel := -1; 273 349 SmartUpdateContent(true) … … 279 355 begin 280 356 if Sel <> -1 then begin 281 line(Canvas, Sel, false);357 Line(Canvas, Sel, false); 282 358 Sel := -1 283 359 end 284 360 end; 285 361 362 procedure THelpDlg.ClearHistory; 363 begin 364 HistItems.Clear; 365 end; 366 286 367 procedure THelpDlg.FormPaint(Sender: TObject); 287 368 begin … … 290 371 end; 291 372 292 procedure THelpDlg. line(ca: TDpiCanvas; i: integer; lit: boolean);373 procedure THelpDlg.Line(ca: TDpiCanvas; i: Integer; lit: Boolean); 293 374 var 294 TextColor, x, y: integer;375 TextColor, x, y: Integer; 295 376 TextSize: TSize; 296 377 s: string; 297 378 begin 298 s := MainText[ sb.Position + i];379 s := MainText[ScrollBar.Position + i]; 299 380 if s = '' then 300 exit;381 Exit; 301 382 x := x0[i]; 302 383 y := 2 + i * 24; … … 306 387 y := y + WideFrame 307 388 end; 308 if THelpLineInfo(MainText.Objects[ sb.Position + i]).Format389 if THelpLineInfo(MainText.Objects[ScrollBar.Position + i]).Format 309 390 in [pkCaption, pkBigTer, pkRightIcon, pkBigFeature] then 310 391 begin … … 315 396 ca.FrameRect(rect(x+1,i*24+1,x+24-1,i*24+24-1)); 316 397 ca.Brush.Style:=bsClear; } 317 DpiBit Blt(ca.Handle, x, y - 4, 24, 24, GrExt[HGrSystem].Data.Canvas.Handle, 1,318 146 , SRCCOPY);398 DpiBitCanvas(ca, x, y - 4, 24, 24, GrExt[HGrSystem].Data.Canvas, 1, 399 146); 319 400 BiColorTextOut(ca, $FFFFFF, $7F007F, x + 10 - ca.Textwidth(s[1]) div 2, 320 401 y - 3, s[1]); … … 322 403 ca.Font.Assign(UniFont[ftNormal]); 323 404 end 324 else if THelpLineInfo(MainText.Objects[ sb.Position + i]).Format = pkSection405 else if THelpLineInfo(MainText.Objects[ScrollBar.Position + i]).Format = pkSection 325 406 then 326 407 begin … … 341 422 TextSize.cy := WideFrame + InnerHeight - y; 342 423 FillSeamless(ca, x, y, TextSize.cx, TextSize.cy, -SideFrame, 343 sb.Position * 24 - WideFrame, Paper);424 ScrollBar.Position * 24 - WideFrame, Paper); 344 425 end; 345 426 BiColorTextOut(ca, TextColor, $7F007F, x, y, s); … … 347 428 with ca do 348 429 begin 349 assert(ca = Canvas);350 pen.color := TextColor;351 moveto(x + 1, y + TextSize.cy - 2);352 lineto(x + TextSize.cx, y + TextSize.cy - 2);430 Assert(ca = Canvas); 431 Pen.Color := TextColor; 432 MoveTo(x + 1, y + TextSize.cy - 2); 433 LineTo(x + TextSize.cx, y + TextSize.cy - 2); 353 434 end; 354 435 if (Kind = hkMisc) and (no = miscMain) then … … 363 444 var 364 445 x, y, dx, dy, xSrc, ySrc, sum, xx: integer; 365 Heaven: array [0 ..nHeaven] of integer;446 Heaven: array [0..nHeaven] of integer; 366 447 PaintPtr, CoalPtr: TPixelPointer; 367 ImpPtr: array [-1 .. 1] of TPixelPointer; 368 begin 369 { TODO 448 ImpPtr: array [-1..1] of TPixelPointer; 449 begin 370 450 // assume eiffel tower has free common heaven 371 451 for dy := 0 to nHeaven - 1 do … … 377 457 xSrc := iix mod 7 * xSizeBig; 378 458 ySrc := (iix div 7 + 1) * ySizeBig; 379 for y := 0 to ScaleToVcl(ySizeBig * 2)- 1 do459 for y := 0 to ySizeBig * 2 - 1 do 380 460 if ((y0 + y) >= 0) and ((y0 + y) < InnerHeight) then begin 381 PaintPtr .Init(OffScreen, 0, ScaleToVcl(y0 + y));382 CoalPtr .Init(Templates, 0, ScaleToVcl(yCoal + y));461 PaintPtr := PixelPointer(OffScreen, 0, y0 + y); 462 CoalPtr := PixelPointer(Templates, 0, yCoal + y); 383 463 for dy := -1 to 1 do 384 464 if ((Max(y + dy, 0) shr 1) >= 0) and ((Max(y + dy, 0) shr 1) < ySizeBig) then 385 ImpPtr[dy] .Init(BigImp, 0, ScaleToVcl(ySrc + (Max(y + dy, 0) shr 1)));386 for x := 0 to ScaleToVcl(xSizeBig * 2)- 1 do begin465 ImpPtr[dy] := PixelPointer(BigImp, 0, ySrc + (Max(y + dy, 0) shr 1)); 466 for x := 0 to xSizeBig * 2 - 1 do begin 387 467 sum := 0; 388 468 for dx := -1 to 1 do begin … … 413 493 Offscreen.EndUpdate; 414 494 BigImp.EndUpdate; 415 } 495 end; 496 497 procedure THelpDlg.PaintTerrIcon(x, y, xSrc, ySrc: integer); 498 begin 499 Frame(OffScreen.Canvas, x - 1, y - 1, x + xSizeBig, y + ySizeBig, 500 $000000, $000000); 501 if 2 * yyt < 40 then begin 502 Sprite(OffScreen, HGrTerrain, x, y, 56, 2 * yyt, xSrc, ySrc); 503 Sprite(OffScreen, HGrTerrain, x, y + 2 * yyt, 56, 40 - 2 * yyt, 504 xSrc, ySrc); 505 end else 506 Sprite(OffScreen, HGrTerrain, x, y, 56, 40, xSrc, ySrc); 507 Sprite(OffScreen, HGrTerrain, x, y, xxt, yyt, xSrc + xxt, ySrc + yyt); 508 Sprite(OffScreen, HGrTerrain, x, y + yyt, xxt, 40 - yyt, xSrc + xxt, ySrc); 509 Sprite(OffScreen, HGrTerrain, x + xxt, y, 56 - xxt, yyt, xSrc, ySrc + yyt); 510 Sprite(OffScreen, HGrTerrain, x + xxt, y + yyt, 56 - xxt, 40 - yyt, 511 xSrc, ySrc); 416 512 end; 417 513 418 514 procedure THelpDlg.OffscreenPaint; 419 420 procedure PaintTerrIcon(x, y, xSrc, ySrc: integer);421 begin422 Frame(OffScreen.Canvas, x - 1, y - 1, x + xSizeBig, y + ySizeBig,423 $000000, $000000);424 if 2 * yyt < 40 then425 begin426 Sprite(OffScreen, HGrTerrain, x, y, 56, 2 * yyt, xSrc, ySrc);427 Sprite(OffScreen, HGrTerrain, x, y + 2 * yyt, 56, 40 - 2 * yyt,428 xSrc, ySrc);429 end430 else431 Sprite(OffScreen, HGrTerrain, x, y, 56, 40, xSrc, ySrc);432 Sprite(OffScreen, HGrTerrain, x, y, xxt, yyt, xSrc + xxt, ySrc + yyt);433 Sprite(OffScreen, HGrTerrain, x, y + yyt, xxt, 40 - yyt, xSrc + xxt, ySrc);434 Sprite(OffScreen, HGrTerrain, x + xxt, y, 56 - xxt, yyt, xSrc, ySrc + yyt);435 Sprite(OffScreen, HGrTerrain, x + xxt, y + yyt, 56 - xxt, 40 - yyt,436 xSrc, ySrc);437 end;438 439 515 var 440 i, j, yl, srcno, ofs, cnt, y: integer;516 i, j, yl, srcno, ofs, cnt, y: Integer; 441 517 s: string; 442 518 HelpLineInfo: THelpLineInfo; … … 445 521 CaptionColor := Colors.Canvas.Pixels[clkMisc, cliPaperCaption]; 446 522 FillSeamless(OffScreen.Canvas, 0, 0, InnerWidth, InnerHeight, 0, 447 sb.Position * 24, Paper);523 ScrollBar.Position * 24, Paper); 448 524 with OffScreen.Canvas do 449 525 begin 450 526 Font.Assign(UniFont[ftNormal]); 451 for i := - sb.Position to InnerHeight div 24 do452 if sb.Position + i < MainText.Count then527 for i := -ScrollBar.Position to InnerHeight div 24 do 528 if ScrollBar.Position + i < MainText.Count then 453 529 begin 454 HelpLineInfo := THelpLineInfo(MainText.Objects[ sb.Position + i]);530 HelpLineInfo := THelpLineInfo(MainText.Objects[ScrollBar.Position + i]); 455 531 if HelpLineInfo.Format = pkExternal then 456 532 begin … … 458 534 if 4 + i * 24 + yl > InnerHeight then 459 535 yl := InnerHeight - (4 + i * 24); 460 DpiBit Blt(Handle, 8, 4 + i * 24, ExtPic.Width, yl, ExtPic.Canvas.Handle,461 0, 0 , SRCCOPY);536 DpiBitCanvas(OffScreen.Canvas, 8, 4 + i * 24, ExtPic.Width, yl, ExtPic.Canvas, 537 0, 0); 462 538 end; 463 539 end; 464 540 for i := -2 to InnerHeight div 24 do 465 if ( sb.Position + i >= 0) and (sb.Position + i < MainText.Count) then541 if (ScrollBar.Position + i >= 0) and (ScrollBar.Position + i < MainText.Count) then 466 542 begin 467 HelpLineInfo := THelpLineInfo(MainText.Objects[ sb.Position + i]);543 HelpLineInfo := THelpLineInfo(MainText.Objects[ScrollBar.Position + i]); 468 544 if HelpLineInfo.Link <> 0 then 469 545 begin … … 499 575 8 + xSizeSmall + x0[i], 2 + 20 + i * 24, $000000, $000000); 500 576 if HelpLineInfo.Picpix = imPalace then 501 DpiBit Blt(OffScreen.Canvas.Handle, 8 + x0[i], 2 + i * 24,502 xSizeSmall, ySizeSmall, SmallImp.Canvas .Handle,503 0 * xSizeSmall, 1 * ySizeSmall , SRCCOPY)577 DpiBitCanvas(OffScreen.Canvas, 8 + x0[i], 2 + i * 24, 578 xSizeSmall, ySizeSmall, SmallImp.Canvas, 579 0 * xSizeSmall, 1 * ySizeSmall) 504 580 else 505 DpiBit Blt(OffScreen.Canvas.Handle, 8 + x0[i], 2 + i * 24,506 xSizeSmall, ySizeSmall, SmallImp.Canvas .Handle,581 DpiBitCanvas(OffScreen.Canvas, 8 + x0[i], 2 + i * 24, 582 xSizeSmall, ySizeSmall, SmallImp.Canvas, 507 583 HelpLineInfo.Picpix mod 7 * xSizeSmall, 508 584 (HelpLineInfo.Picpix + SystemIconLines * 7) div 7 * 509 ySizeSmall , SRCCOPY);585 ySizeSmall); 510 586 x0[i] := x0[i] + (8 + 8 + 36); 511 587 end; … … 566 642 $000000, $000000); 567 643 if AdvIcon[HelpLineInfo.Picpix] < 84 then 568 DpiBit Blt(OffScreen.Canvas.Handle, 8 + x0[i], 2 + i * 24,569 xSizeSmall, ySizeSmall, SmallImp.Canvas .Handle,644 DpiBitCanvas(OffScreen.Canvas, 8 + x0[i], 2 + i * 24, 645 xSizeSmall, ySizeSmall, SmallImp.Canvas, 570 646 (AdvIcon[HelpLineInfo.Picpix] + SystemIconLines * 7) mod 7 * 571 647 xSizeSmall, (AdvIcon[HelpLineInfo.Picpix] + SystemIconLines * 572 7) div 7 * ySizeSmall , SRCCOPY)648 7) div 7 * ySizeSmall) 573 649 else 574 650 Dump(OffScreen, HGrSystem, 8 + x0[i], 2 + i * 24, 36, 20, … … 576 652 295 + (AdvIcon[HelpLineInfo.Picpix] - 84) div 8 * 21); 577 653 j := AdvValue[HelpLineInfo.Picpix] div 1000; 578 DpiBit Blt(Handle, x0[i] + 4, 4 + i * 24, 14, 14,579 GrExt[HGrSystem].Mask.Canvas .Handle, 127 + j * 15, 85, SRCAND);654 DpiBitCanvas(OffScreen.Canvas, x0[i] + 4, 4 + i * 24, 14, 14, 655 GrExt[HGrSystem].Mask.Canvas, 127 + j * 15, 85, SRCAND); 580 656 Sprite(OffScreen, HGrSystem, x0[i] + 3, 3 + i * 24, 14, 14, 581 657 127 + j * 15, 85); … … 753 829 ScreenTools.Frame(OffScreen.Canvas, 8 - 1 + x0[i], 2 - 1 + i * 24, 754 830 8 + xSizeSmall + x0[i], 2 + 20 + i * 24, $000000, $000000); 755 DpiBit Blt(OffScreen.Canvas.Handle, 8 + x0[i], 2 + i * 24, xSizeSmall,756 ySizeSmall, SmallImp.Canvas .Handle, (HelpLineInfo.Picpix - 1) *757 xSizeSmall, ySizeSmall , SRCCOPY);831 DpiBitCanvas(OffScreen.Canvas, 8 + x0[i], 2 + i * 24, xSizeSmall, 832 ySizeSmall, SmallImp.Canvas, (HelpLineInfo.Picpix - 1) * 833 xSizeSmall, ySizeSmall); 758 834 x0[i] := x0[i] + (8 + 8 + 36); 759 835 end; … … 769 845 x0[i] := 64 + 8 + 8; 770 846 else 771 x0[i] := x0[i] + 8 847 x0[i] := x0[i] + 8; 772 848 end; 773 Self. line(OffScreen.Canvas, i, false)849 Self.Line(OffScreen.Canvas, i, False) 774 850 end; 775 851 end; 776 852 MarkUsedOffscreen(InnerWidth, InnerHeight + 13 + 48); 777 end; { OffscreenPaint }853 end; 778 854 779 855 procedure THelpDlg.ScrollBarUpdate(Sender: TObject); … … 785 861 procedure THelpDlg.Prepare(sbPos: integer = 0); 786 862 var 787 i, j, special, Domain, Headline, TerrType, TerrSubType: integer;863 i, j, Special, Domain, Headline, TerrType, TerrSubType: integer; 788 864 s: string; 789 865 ps: pchar; 790 866 List: THyperText; 791 CheckSeeAlso: boolean;792 793 procedure AddAdv (i: integer);867 CheckSeeAlso: Boolean; 868 869 procedure AddAdvance(i: integer); 794 870 begin 795 871 MainText.AddLine(Phrases.Lookup('ADVANCES', i), pkAdvIcon, i, … … 803 879 end; 804 880 805 procedure AddImp (i: integer);881 procedure AddImprovement(i: integer); 806 882 begin 807 883 MainText.AddLine(Phrases.Lookup('IMPROVEMENTS', i), pkSmallIcon, i, … … 815 891 end; 816 892 817 procedure AddTer (i: integer);893 procedure AddTerrain(i: integer); 818 894 begin 819 895 if MainText.Count > 1 then 820 896 begin 821 MainText.L F;897 MainText.LineFeed; 822 898 end; 823 899 MainText.AddLine(Phrases.Lookup('TERRAIN', i), pkTer, i, hkTer, i); … … 836 912 begin 837 913 if MainText.Count > 1 then 838 MainText.L F;914 MainText.LineFeed; 839 915 FindStdModelPicture(SpecialModelPictureCode[i], pix, Name); 840 916 MainText.AddLine(Name, pkModel, pix, hkModel + hkCrossLink, i) … … 850 926 begin 851 927 AddLine('', pkLogo); 852 L F;928 LineFeed; 853 929 end 854 930 else if Item = 'TECHFORMULA' then … … 866 942 for i := 1 to 3 do 867 943 begin 868 L F;944 LineFeed; 869 945 AddLine(Phrases.Lookup('TERRAIN', 3 * 12 + i), pkTer, 3 * 12 + i); 870 946 end … … 877 953 end; 878 954 879 procedure DecodeItem(s: string; var Category, Index: integer);955 procedure DecodeItem(s: string; var Category, Index: Integer); 880 956 var 881 i: integer; 882 begin 883 if (length(s) > 0) and (s[1] = ':') then 884 begin 957 i: Integer; 958 begin 959 if (Length(s) > 0) and (s[1] = ':') then begin 885 960 Category := hkMisc; 886 961 Index := 0; 887 962 for i := 3 to length(s) do 888 Index := Index * 10 + ord(s[i]) - 48;963 Index := Index * 10 + Ord(s[i]) - 48; 889 964 case s[2] of 890 'A': 891 Category := hkAdv; 892 'B': 893 Category := hkImp; 894 'T': 895 Category := hkTer; 896 'F': 897 Category := hkFeature; 898 'E': 899 Category := hkInternet; 900 'S': 901 Category := hkModel; 902 'C': 903 Index := miscCredits; 904 'J': 905 Index := miscJobList; 906 'G': 907 Index := miscGovList; 965 'A': Category := hkAdv; 966 'B': Category := hkImp; 967 'T': Category := hkTer; 968 'F': Category := hkFeature; 969 'E': Category := hkInternet; 970 'S': Category := hkModel; 971 'C': Index := miscCredits; 972 'J': Index := miscJobList; 973 'G': Index := miscGovList; 908 974 end; 909 975 if (Category <> hkMisc) and (Index = 0) then 910 976 Index := 200; 911 end 912 else 913 begin 977 end else begin 914 978 Category := hkText; 915 Index := HelpText.Gethandle( copy(s, 1, 255));979 Index := HelpText.Gethandle(Copy(s, 1, 255)); 916 980 end; 917 981 end; … … 935 999 repeat 936 1000 inc(p) 937 until (p > length(s)) or (s[p] = '\');938 Caption := copy(s, 2, p - 2);1001 until (p > Length(s)) or (s[p] = '\'); 1002 Caption := Copy(s, 2, p - 2); 939 1003 Delete(s, 1, p); 940 1004 end … … 944 1008 repeat 945 1009 inc(p) 946 until (p > length(s)) or (s[p] = '\');947 AddStandardBlock( copy(s, 2, p - 2));1010 until (p > Length(s)) or (s[p] = '\'); 1011 AddStandardBlock(Copy(s, 2, p - 2)); 948 1012 Delete(s, 1, p); 949 1013 end 950 1014 else if s[1] = '@' then 951 1015 begin // image 952 if ( length(s) >= 2) and (s[2] = '@') then1016 if (Length(s) >= 2) and (s[2] = '@') then 953 1017 begin // generate from icon 954 1018 Picpix := 0; 955 1019 p := 3; 956 while (p <= length(s)) and (s[p] <> '\') do1020 while (p <= Length(s)) and (s[p] <> '\') do 957 1021 begin 958 Picpix := Picpix * 10 + ord(s[p]) - 48;1022 Picpix := Picpix * 10 + Ord(s[p]) - 48; 959 1023 inc(p) 960 1024 end; … … 962 1026 Picpix := 0; 963 1027 MainText.AddLine('', pkIllu, Picpix); 964 MainText.L F;965 MainText.L F;1028 MainText.LineFeed; 1029 MainText.LineFeed; 966 1030 end 967 1031 else … … 969 1033 p := 1; 970 1034 repeat 971 inc(p)972 until (p > length(s)) or (s[p] = '\');1035 Inc(p) 1036 until (p > Length(s)) or (s[p] = '\'); 973 1037 if LoadGraphicFile(ExtPic, LocalizedFilePath('Help' + 974 DirectorySeparator + copy(s, 2, p - 2)) + '.png') then1038 DirectorySeparator + Copy(s, 2, p - 2)) + '.png') then 975 1039 begin 976 1040 MainText.AddLine('', pkExternal); 977 1041 for i := 0 to (ExtPic.Height - 12) div 24 do 978 MainText.L F;1042 MainText.LineFeed; 979 1043 end; 980 1044 end; … … 989 1053 repeat 990 1054 inc(p) 991 until (p > length(s)) or (s[p] = '\') or (s[p] = ' ');992 DecodeItem( copy(s, 2, p - 2), LinkCategory, LinkIndex);1055 until (p > Length(s)) or (s[p] = '\') or (s[p] = ' '); 1056 DecodeItem(Copy(s, 2, p - 2), LinkCategory, LinkIndex); 993 1057 CurrentFormat := 0; 994 1058 if (LinkCategory <> hkText) and (LinkIndex < 200) then … … 1008 1072 begin 1009 1073 CurrentFormat := pkTer; 1010 Picpix := LinkIndex 1074 Picpix := LinkIndex; 1011 1075 end; 1012 1076 hkFeature: … … 1024 1088 if s[1] = ':' then 1025 1089 LinkCategory := LinkCategory + hkCrossLink; 1026 if (p > length(s)) or (s[p] = ' ') then1090 if (p > Length(s)) or (s[p] = ' ') then 1027 1091 Delete(s, 1, p) 1028 1092 else … … 1030 1094 end; 1031 1095 '!': // highlited 1032 if ( length(s) >= 2) and (s[2] = '!') then1096 if (Length(s) >= 2) and (s[2] = '!') then 1033 1097 begin 1034 1098 if MainText.Count > 1 then 1035 MainText.L F;1099 MainText.LineFeed; 1036 1100 FollowFormat := pkCaption; 1037 1101 CurrentFormat := pkCaption; … … 1060 1124 repeat 1061 1125 repeat 1062 inc(p)1063 until (p > length(s)) or (s[p] = ' ') or (s[p] = '\');1064 if (BiColorTextWidth(OffScreen.Canvas, copy(s, 1, p - 1)) <=1126 Inc(p) 1127 until (p > Length(s)) or (s[p] = ' ') or (s[p] = '\'); 1128 if (BiColorTextWidth(OffScreen.Canvas, Copy(s, 1, p - 1)) <= 1065 1129 RightMargin - ofs) then 1066 1130 l := p - 1 1067 1131 else 1068 1132 Break; 1069 until (p >= length(s)) or (s[l + 1] = '\');1070 MainText.AddLine( copy(s, 1, l), CurrentFormat, Picpix, LinkCategory,1133 until (p >= Length(s)) or (s[l + 1] = '\'); 1134 MainText.AddLine(Copy(s, 1, l), CurrentFormat, Picpix, LinkCategory, 1071 1135 LinkIndex); 1072 if (l < length(s)) and (s[l + 1] = '\') then1136 if (l < Length(s)) and (s[l + 1] = '\') then 1073 1137 FollowFormat := pkNormal; 1074 1138 Delete(s, 1, l + 1); … … 1082 1146 end; 1083 1147 1084 procedure AddModelText(i: integer);1148 procedure AddModelText(i: Integer); 1085 1149 var 1086 pix: integer;1150 pix: Integer; 1087 1151 s: string; 1088 1152 begin 1089 with MainText do 1090 begin 1091 if Count > 1 then 1092 begin 1093 LF; 1094 LF; 1153 with MainText do begin 1154 if Count > 1 then begin 1155 LineFeed; 1156 LineFeed; 1095 1157 end; 1096 1158 FindStdModelPicture(SpecialModelPictureCode[i], pix, s); … … 1126 1188 procedure AddJobList; 1127 1189 var 1128 i, JobCost: integer; 1129 begin 1130 with MainText do 1131 begin 1132 for i := 0 to nJobHelp - 1 do 1133 begin 1134 if i > 0 then 1135 begin 1136 LF; 1137 LF 1190 i, JobCost: Integer; 1191 begin 1192 with MainText do begin 1193 for i := 0 to nJobHelp - 1 do begin 1194 if i > 0 then begin 1195 LineFeed; 1196 LineFeed; 1138 1197 end; 1139 1198 AddLine(Phrases.Lookup('JOBRESULT', JobHelp[i]), pkSection); … … 1144 1203 JobCost := -1; 1145 1204 case JobHelp[i] of 1146 jCanal: 1147 JobCost := CanalWork; 1148 jFort: 1149 JobCost := FortWork; 1150 jBase: 1151 JobCost := BaseWork; 1205 jCanal: JobCost := CanalWork; 1206 jFort: JobCost := FortWork; 1207 jBase: JobCost := BaseWork; 1152 1208 end; 1153 1209 if JobCost >= 0 then … … 1156 1212 else 1157 1213 AddTextual(HelpText.Lookup('JOBCOSTVAR')); 1158 if JobPreq[JobHelp[i]] <> preNone then 1159 begin 1214 if JobPreq[JobHelp[i]] <> preNone then begin 1160 1215 AddPreqAdv(JobPreq[JobHelp[i]]); 1161 1216 MainText[Count - 1] := Format(HelpText.Lookup('REQUIRED'), … … 1168 1223 procedure AddGraphicCredits; 1169 1224 var 1170 i: integer;1225 i: Integer; 1171 1226 s: string; 1172 1227 sr: TSearchRec; 1173 List, plus: TStringList;1228 List, Plus: TStringList; 1174 1229 begin 1175 1230 List := TStringList.Create; 1176 plus := TStringList.Create;1177 if FindFirst( HomeDir + 'Graphics'+ DirectorySeparator + '*.credits.txt', $27, sr) = 0 then1231 Plus := TStringList.Create; 1232 if FindFirst(GetGraphicsDir + DirectorySeparator + '*.credits.txt', $27, sr) = 0 then 1178 1233 repeat 1179 plus.LoadFromFile(HomeDir + 'Graphics'+ DirectorySeparator + sr.Name);1180 List.AddStrings( plus);1234 Plus.LoadFromFile(GetGraphicsDir + DirectorySeparator + sr.Name); 1235 List.AddStrings(Plus); 1181 1236 until FindNext(sr) <> 0; 1182 1237 FindClose(sr); 1183 plus.Free;1238 Plus.Free; 1184 1239 1185 1240 List.Sort; … … 1189 1244 List.Delete(i) 1190 1245 else 1191 inc(i); 1192 1193 for i := 0 to List.Count - 1 do 1194 begin 1246 Inc(i); 1247 1248 for i := 0 to List.Count - 1 do begin 1195 1249 s := List[i]; 1196 1250 while BiColorTextWidth(OffScreen.Canvas, s) > InnerWidth - 16 - … … 1204 1258 procedure AddSoundCredits; 1205 1259 var 1206 i: integer;1260 i: Integer; 1207 1261 s: string; 1208 1262 List: TStringList; 1209 1263 begin 1210 1264 List := TStringList.Create; 1211 List.LoadFromFile(HomeDir + 'Sounds' + DirectorySeparator + 'sound.credits.txt'); 1212 for i := 0 to List.Count - 1 do 1213 begin 1265 List.LoadFromFile(GetSoundsDir + DirectorySeparator + 'sound.credits.txt'); 1266 for i := 0 to List.Count - 1 do begin 1214 1267 s := List[i]; 1215 1268 while BiColorTextWidth(OffScreen.Canvas, s) > InnerWidth - 16 - … … 1227 1280 MainText.Delete(Headline) 1228 1281 else 1229 MainText.L F;1282 MainText.LineFeed; 1230 1283 MainText.AddLine(HelpText.Lookup(Item), pkSection); 1231 1284 Headline := MainText.Count - 1; … … 1233 1286 1234 1287 begin { Prepare } 1235 with MainText do 1236 begin 1288 with MainText do begin 1237 1289 OffScreen.Canvas.Font.Assign(UniFont[ftNormal]); 1238 CheckSeeAlso := false;1290 CheckSeeAlso := False; 1239 1291 Clear; 1240 1292 Headline := -1; 1241 1293 if (no >= 200) or not(Kind in [hkAdv, hkImp, hkTer, hkFeature]) then 1242 L F;1294 LineFeed; 1243 1295 case Kind of 1244 1296 hkText: … … 1252 1304 AddLine(HelpText.Lookup('HELPTITLE_QUICKSTART'), pkSpecialIcon, 1253 1305 0, { pkBigIcon,22, } hkText, HelpText.Gethandle('QUICK')); 1254 L F;1306 LineFeed; 1255 1307 AddLine(HelpText.Lookup('HELPTITLE_CONCEPTS'), pkBigIcon, 6, 1256 1308 hkText, HelpText.Gethandle('CONCEPTS')); 1257 L F;1309 LineFeed; 1258 1310 AddLine(HelpText.Lookup('HELPTITLE_TERLIST'), pkSpecialIcon, 1, 1259 1311 hkTer, 200); 1260 L F;1312 LineFeed; 1261 1313 AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'), pkSpecialIcon, 2, 1262 1314 hkMisc, miscJobList); 1263 L F;1315 LineFeed; 1264 1316 AddLine(HelpText.Lookup('HELPTITLE_TECHLIST'), pkBigIcon, 39, 1265 1317 hkAdv, 200); 1266 L F;1318 LineFeed; 1267 1319 FindStdModelPicture(SpecialModelPictureCode[6], i, s); 1268 1320 AddLine(HelpText.Lookup('HELPTITLE_MODELLIST'), pkModel, i, 1269 1321 hkModel, 0); 1270 L F;1322 LineFeed; 1271 1323 AddLine(HelpText.Lookup('HELPTITLE_FEATURELIST'), pkBigIcon, 28, 1272 1324 hkFeature, 200); 1273 L F;1325 LineFeed; 1274 1326 AddLine(HelpText.Lookup('HELPTITLE_IMPLIST'), pkBigIcon, 1275 1327 7 * SystemIconLines + imCourt, hkImp, 200); 1276 L F;1328 LineFeed; 1277 1329 AddLine(HelpText.Lookup('HELPTITLE_UNIQUELIST'), pkBigIcon, 1278 1330 7 * SystemIconLines + imStockEx, hkImp, 201); 1279 L F;1331 LineFeed; 1280 1332 AddLine(HelpText.Lookup('HELPTITLE_WONDERLIST'), pkBigIcon, 1281 1333 7 * SystemIconLines, hkImp, 202); 1282 L F;1334 LineFeed; 1283 1335 AddLine(HelpText.Lookup('HELPTITLE_GOVLIST'), pkBigIcon, 1284 1336 gDemocracy + 6, hkMisc, miscGovList); 1285 L F;1337 LineFeed; 1286 1338 AddLine(HelpText.Lookup('HELPTITLE_KEYS'), pkBigIcon, 2, hkText, 1287 1339 HelpText.Gethandle('HOTKEYS')); 1288 L F;1340 LineFeed; 1289 1341 AddLine(HelpText.Lookup('HELPTITLE_ABOUT'), pkBigIcon, 1, 1290 1342 hkText, HelpText.Gethandle('ABOUT')); 1291 L F;1343 LineFeed; 1292 1344 AddLine(HelpText.Lookup('HELPTITLE_CREDITS'), pkBigIcon, 22, 1293 1345 hkMisc, miscCredits); … … 1296 1348 begin 1297 1349 AddItem('CREDITS'); 1298 L F;1350 LineFeed; 1299 1351 AddGraphicCredits; 1300 1352 NextSection('CRED_CAPSOUND'); … … 1310 1362 Caption := HelpText.Lookup('HELPTITLE_JOBLIST'); 1311 1363 AddJobList; 1312 L F;1364 LineFeed; 1313 1365 AddItem('TERIMPEXCLUDE'); 1314 L F;1366 LineFeed; 1315 1367 AddItem('TERIMPCITY'); 1316 1368 end; … … 1321 1373 begin 1322 1374 AddLine(Phrases.Lookup('GOVERNMENT', i mod nGov), pkSection); 1323 L F;1375 LineFeed; 1324 1376 if i = nGov then 1325 1377 AddLine('', pkBigIcon, 7 * SystemIconLines + imPalace) 1326 1378 else 1327 1379 AddLine('', pkBigIcon, i + 6); 1328 L F;1380 LineFeed; 1329 1381 AddTextual(HelpText.LookupByHandle(hGOVHELP, i mod nGov)); 1330 1382 if i mod nGov >= 2 then … … 1336 1388 if i < nGov then 1337 1389 begin 1338 L F;1339 L F;1390 LineFeed; 1391 LineFeed; 1340 1392 end 1341 1393 end … … 1345 1397 Caption := HelpText.Lookup('HELPTITLE_SEARCHRESULTS'); 1346 1398 AddTextual(Format(HelpText.Lookup('MATCHES'), [SearchContent])); 1347 MainText.A ddStrings(SearchResult);1348 end 1399 MainText.AppendList(SearchResult); 1400 end; 1349 1401 end; // case no 1350 1402 end; … … 1355 1407 Caption := HelpText.Lookup('HELPTITLE_TECHLIST'); 1356 1408 List := THyperText.Create; 1409 List.OwnsObjects := True; 1357 1410 for j := 0 to 3 do 1358 1411 begin 1359 1412 if j > 0 then 1360 1413 begin 1361 L F;1362 L F;1414 LineFeed; 1415 LineFeed; 1363 1416 end; 1364 1417 AddLine(HelpText.Lookup('TECHAGE', j), pkSection); … … 1378 1431 hkAdv, i); 1379 1432 List.Sort; 1380 A ddStrings(List);1433 AppendList(List); 1381 1434 end; 1382 List.Free 1435 List.Free; 1383 1436 end 1384 1437 else // single advance 1385 1438 begin 1386 1439 Caption := Phrases.Lookup('ADVANCES', no); 1387 L F;1440 LineFeed; 1388 1441 AddLine(Phrases.Lookup('ADVANCES', no), pkCaption); 1389 1442 if no in FutureTech then 1390 1443 begin 1391 1444 AddLine(HelpText.Lookup('HELPSPEC_FUTURE')); 1392 L F;1445 LineFeed; 1393 1446 if no = futResearchTechnology then 1394 1447 AddItem('FUTURETECHHELP100') … … 1413 1466 for i := 0 to 27 do 1414 1467 if Imp[i].Preq = no then 1415 AddImp (i);1468 AddImprovement(i); 1416 1469 for i := 28 to nImp - 1 do 1417 1470 if (Imp[i].Preq = no) and (Imp[i].Kind <> ikCommon) then 1418 AddImp (i);1471 AddImprovement(i); 1419 1472 for i := 28 to nImp - 1 do 1420 1473 if (Imp[i].Preq = no) and (Imp[i].Kind = ikCommon) then 1421 AddImp (i);1474 AddImprovement(i); 1422 1475 NextSection('MODELALLOW'); 1423 1476 for i := 0 to nSpecialModel - 1 do … … 1432 1485 if (AdvPreq[i, 0] = no) or (AdvPreq[i, 1] = no) or 1433 1486 (AdvPreq[i, 2] = no) then 1434 AddAdv (i);1487 AddAdvance(i); 1435 1488 NextSection('UPGRADEALLOW'); 1436 1489 for Domain := 0 to nDomains - 1 do … … 1456 1509 for i := 0 to 27 do 1457 1510 if (Imp[i].Preq <> preNA) and (Imp[i].Expiration = no) then 1458 AddImp (i);1511 AddImprovement(i); 1459 1512 NextSection('ADVEFFECT'); 1460 1513 s := HelpText.LookupByHandle(hADVHELP, no); … … 1471 1524 // AddLine(HelpText.Lookup('HELPTITLE_IMPLIST'),pkSection); 1472 1525 List := THyperText.Create; 1526 List.OwnsObjects := True; 1473 1527 for i := 28 to nImp - 1 do 1474 1528 if (i <> imTrGoods) and (Imp[i].Preq <> preNA) and … … 1477 1531 i, hkImp, i); 1478 1532 List.Sort; 1479 A ddStrings(List);1480 List.Free 1533 AppendList(List); 1534 List.Free; 1481 1535 end 1482 1536 else if no = 201 then … … 1489 1543 AddLine(Phrases.Lookup('IMPROVEMENTS', i), pkSmallIcon, i, 1490 1544 hkImp, i); 1491 { L F;1492 L F;1545 { LineFeed; 1546 LineFeed; 1493 1547 AddLine(HelpText.Lookup('HELPTITLE_SHIPPARTLIST'),pkSection); 1494 1548 for i:=28 to nImp-1 do … … 1508 1562 begin // single building 1509 1563 Caption := Phrases.Lookup('IMPROVEMENTS', no); 1510 L F;1564 LineFeed; 1511 1565 AddLine(Phrases.Lookup('IMPROVEMENTS', no), pkRightIcon, no); 1512 1566 case Imp[no].Kind of 1513 ikWonder: 1514 AddLine(HelpText.Lookup('HELPSPEC_WONDER')); 1515 ikCommon: 1516 AddLine(HelpText.Lookup('HELPSPEC_IMP')); 1517 ikShipPart: 1518 AddLine(HelpText.Lookup('HELPSPEC_SHIPPART')); 1567 ikWonder: AddLine(HelpText.Lookup('HELPSPEC_WONDER')); 1568 ikCommon: AddLine(HelpText.Lookup('HELPSPEC_IMP')); 1569 ikShipPart: AddLine(HelpText.Lookup('HELPSPEC_SHIPPART')); 1519 1570 else 1520 1571 AddLine(HelpText.Lookup('HELPSPEC_NAT')) 1521 1572 end; 1522 if Imp[no].Kind <> ikShipPart then 1523 begin 1573 if Imp[no].Kind <> ikShipPart then begin 1524 1574 NextSection('EFFECT'); 1525 1575 AddTextual(HelpText.LookupByHandle(hIMPHELP, no)); 1526 1576 end; 1527 if no = woSun then 1528 begin 1577 if no = woSun then begin 1529 1578 AddFeature(mcFirst); 1530 1579 AddFeature(mcWill); … … 1533 1582 if (no < 28) and not Phrases2FallenBackToEnglish then 1534 1583 begin 1535 L F;1584 LineFeed; 1536 1585 if Imp[no].Expiration >= 0 then 1537 1586 AddTextual(Phrases2.Lookup('HELP_WONDERMORALE1')) … … 1563 1612 j := 1 1564 1613 end; 1565 AddImp (ImpReplacement[i].OldImp);1614 AddImprovement(ImpReplacement[i].OldImp); 1566 1615 end; 1567 1616 if Imp[no].Kind = ikShipPart then 1568 1617 begin 1569 L F;1618 LineFeed; 1570 1619 if no = imShipComp then 1571 1620 i := 1 … … 1588 1637 NextSection('SEEALSO'); 1589 1638 if (no < 28) and (Imp[no].Expiration >= 0) then 1590 AddImp (woEiffel);1639 AddImprovement(woEiffel); 1591 1640 for i := 0 to nImpReplacement - 1 do 1592 1641 if ImpReplacement[i].OldImp = no then 1593 AddImp (ImpReplacement[i].NewImp);1642 AddImprovement(ImpReplacement[i].NewImp); 1594 1643 if no = imSupermarket then 1595 1644 AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'), pkNormal, 0, … … 1604 1653 // AddLine(HelpText.Lookup('HELPTITLE_TERLIST'),pkSection); 1605 1654 for i := 0 to nTerrainHelp - 1 do 1606 AddTer (TerrainHelp[i]);1655 AddTerrain(TerrainHelp[i]); 1607 1656 end 1608 1657 else … … 1620 1669 begin 1621 1670 Caption := Phrases.Lookup('TERRAIN', no); 1622 L F;1671 LineFeed; 1623 1672 AddLine(Phrases.Lookup('TERRAIN', no), pkBigTer, no); 1624 1673 AddLine(HelpText.Lookup('HELPSPEC_TER')); 1625 L F;1674 LineFeed; 1626 1675 if (ProdRes[TerrSubType] > 0) or (MineEff > 0) then 1627 1676 AddLine(Format(HelpText.Lookup('RESPROD'), … … 1649 1698 if no = 3 * 12 then 1650 1699 begin 1651 L F;1700 LineFeed; 1652 1701 AddTextual(HelpText.Lookup('DEADLANDS')); 1653 1702 end; 1654 1703 if (TerrType = fDesert) and (no <> fDesert + 12) then 1655 1704 begin 1656 L F;1705 LineFeed; 1657 1706 AddTextual(Format(HelpText.Lookup('HOSTILE'), [DesertThurst])); 1658 1707 end; 1659 1708 if TerrType = fArctic then 1660 1709 begin 1661 L F;1710 LineFeed; 1662 1711 AddTextual(Format(HelpText.Lookup('HOSTILE'), [ArcticThurst])); 1663 1712 end; 1664 1713 if (no < 3 * 12) and (TransTerrain >= 0) then 1665 1714 begin 1666 L F;1715 LineFeed; 1667 1716 i := TransTerrain; 1668 1717 if (TerrType <> fGrass) and (i <> fGrass) then 1669 1718 i := i + TerrSubType * 12; 1670 // trafo to same special resource group1719 // trafo to same Special resource group 1671 1720 AddLine(Format(HelpText.Lookup('TRAFO'), 1672 1721 [Phrases.Lookup('TERRAIN', i)]), pkTer, i, … … 1674 1723 if no = fSwamp + 12 then 1675 1724 begin 1676 L F;1725 LineFeed; 1677 1726 AddLine(Format(HelpText.Lookup('TRAFO'), 1678 1727 [Phrases.Lookup('TERRAIN', TransTerrain + 24)]), pkTer, … … 1681 1730 else if i = fGrass then 1682 1731 begin 1683 L F;1732 LineFeed; 1684 1733 AddLine(Format(HelpText.Lookup('TRAFO'), 1685 1734 [Phrases.Lookup('TERRAIN', fGrass + 12)]), pkTer, fGrass + 12, … … 1690 1739 if no = 3 * 12 then 1691 1740 begin 1692 L F;1693 for special := 1 to 3 do1741 LineFeed; 1742 for Special := 1 to 3 do 1694 1743 begin 1695 if special > 1 then1696 L F;1697 AddLine(Phrases.Lookup('TERRAIN', 3 * 12 + special), pkTer,1698 3 * 12 + special);1744 if Special > 1 then 1745 LineFeed; 1746 AddLine(Phrases.Lookup('TERRAIN', 3 * 12 + Special), pkTer, 1747 3 * 12 + Special); 1699 1748 end 1700 1749 end 1701 1750 else if (no < 12) and (no <> fGrass) and (no <> fOcean) then 1702 1751 begin 1703 L F;1704 for special := 1 to 2 do1705 if (no <> fArctic) and (no <> fSwamp) or ( special < 2) then1752 LineFeed; 1753 for Special := 1 to 2 do 1754 if (no <> fArctic) and (no <> fSwamp) or (Special < 2) then 1706 1755 begin 1707 if special > 1 then1708 L F;1709 AddLine(Phrases.Lookup('TERRAIN', no + special * 12), pkTer,1710 no + special * 12);1711 i := FoodRes[ special] - FoodRes[0];1756 if Special > 1 then 1757 LineFeed; 1758 AddLine(Phrases.Lookup('TERRAIN', no + Special * 12), pkTer, 1759 no + Special * 12); 1760 i := FoodRes[Special] - FoodRes[0]; 1712 1761 if i <> 0 then 1713 1762 MainText[Count - 1] := MainText[Count - 1] + 1714 1763 Format(HelpText.Lookup('SPECIALFOOD'), [i]); 1715 i := ProdRes[ special] - ProdRes[0];1764 i := ProdRes[Special] - ProdRes[0]; 1716 1765 if i <> 0 then 1717 1766 MainText[Count - 1] := MainText[Count - 1] + 1718 1767 Format(HelpText.Lookup('SPECIALPROD'), [i]); 1719 i := TradeRes[ special] - TradeRes[0];1768 i := TradeRes[Special] - TradeRes[0]; 1720 1769 if i <> 0 then 1721 1770 MainText[Count - 1] := MainText[Count - 1] + … … 1725 1774 if no = 3 * 12 then 1726 1775 begin 1727 L F;1776 LineFeed; 1728 1777 AddTextual(HelpText.Lookup('RARE')); 1729 1778 end; … … 1731 1780 begin 1732 1781 NextSection('SEEALSO'); 1733 AddImp (woGardens);1782 AddImprovement(woGardens); 1734 1783 CheckSeeAlso := true 1735 1784 end … … 1742 1791 Caption := HelpText.Lookup('HELPTITLE_FEATURELIST'); 1743 1792 List := THyperText.Create; 1744 for special := 0 to 2 do 1793 List.OwnsObjects := True; 1794 for Special := 0 to 2 do 1745 1795 begin 1746 if special > 0 then 1747 begin 1748 LF; 1749 LF 1750 end; 1751 case special of 1752 0: 1753 AddLine(HelpText.Lookup('HELPTITLE_FEATURE1LIST'), pkSection); 1754 1: 1755 AddLine(HelpText.Lookup('HELPTITLE_FEATURE2LIST'), pkSection); 1756 2: 1757 AddLine(HelpText.Lookup('HELPTITLE_FEATURE3LIST'), pkSection); 1796 if Special > 0 then 1797 begin 1798 LineFeed; 1799 LineFeed; 1800 end; 1801 case Special of 1802 0: AddLine(HelpText.Lookup('HELPTITLE_FEATURE1LIST'), pkSection); 1803 1: AddLine(HelpText.Lookup('HELPTITLE_FEATURE2LIST'), pkSection); 1804 2: AddLine(HelpText.Lookup('HELPTITLE_FEATURE3LIST'), pkSection); 1758 1805 end; 1759 1806 List.Clear; … … 1767 1814 else 1768 1815 j := 1; 1769 if j = special then1816 if j = Special then 1770 1817 List.AddLine(Phrases.Lookup('FEATURES', i), pkFeature, i, 1771 1818 hkFeature, i); 1772 1819 end; 1773 1820 List.Sort; 1774 A ddStrings(List);1821 AppendList(List); 1775 1822 end; 1776 List.Free 1823 List.Free; 1777 1824 end 1778 1825 else 1779 1826 begin // single feature 1780 1827 Caption := Phrases.Lookup('FEATURES', no); 1781 L F;1828 LineFeed; 1782 1829 AddLine(Phrases.Lookup('FEATURES', no), pkBigFeature, no); 1783 1830 if no < mcFirstNonCap then … … 1807 1854 if Feature[no].Preq <> preNone then 1808 1855 begin 1809 L F;1856 LineFeed; 1810 1857 if Feature[no].Preq = preSun then 1811 1858 AddPreqImp(woSun) // sun tsu feature … … 1816 1863 end; 1817 1864 NextSection('SEEALSO'); 1818 CheckSeeAlso := true1865 CheckSeeAlso := True; 1819 1866 end; 1820 1867 … … 1825 1872 if i <> 2 then 1826 1873 AddModelText(i); 1827 L F;1874 LineFeed; 1828 1875 AddItem('MODELNOTE'); 1829 1876 end; … … 1834 1881 if (SeeAlso[i].Kind = Kind) and (SeeAlso[i].no = no) then 1835 1882 case SeeAlso[i].SeeKind of 1836 hkImp: 1837 AddImp(SeeAlso[i].SeeNo); 1838 hkAdv: 1839 AddAdv(SeeAlso[i].SeeNo); 1840 hkFeature: 1841 AddFeature(SeeAlso[i].SeeNo); 1883 hkImp: AddImprovement(SeeAlso[i].SeeNo); 1884 hkAdv: AddAdvance(SeeAlso[i].SeeNo); 1885 hkFeature: AddFeature(SeeAlso[i].SeeNo); 1842 1886 end; 1843 1887 if (Headline >= 0) and (Count = Headline + 1) then 1844 1888 Delete(Headline) 1845 1889 else 1846 L F;1890 LineFeed; 1847 1891 1848 1892 //Self.Show; 1849 sb.Init(Count - 1, InnerHeight div 24);1850 sb.SetPos(sbPos);1851 BackBtn.Visible := nHist > 0;1852 TopBtn.Visible := ( nHist > 0) or (Kind <> hkMisc) or (no <> miscMain);1893 ScrollBar.Init(Count - 1, InnerHeight div 24); 1894 ScrollBar.SetPos(sbPos); 1895 BackBtn.Visible := HistItems.Count > 1; 1896 TopBtn.Visible := (HistItems.Count > 1) or (Kind <> hkMisc) or (no <> miscMain); 1853 1897 Sel := -1; 1854 1898 end; // with MainText 1855 end; { Prepare }1856 1857 procedure THelpDlg.ShowNewContent(NewMode, Category, Index: integer);1899 end; 1900 1901 procedure THelpDlg.ShowNewContent(NewMode, Category, Index: Integer); 1858 1902 begin 1859 1903 if (Category <> Kind) or (Index <> no) or (Category = hkMisc) and 1860 (Index = miscSearchResult) then 1861 begin 1862 if nHist = MaxHist then 1863 begin 1864 move(HistKind[2], HistKind[1], 4 * (nHist - 2)); 1865 move(HistNo[2], HistNo[1], 4 * (nHist - 2)); 1866 move(HistPos[2], HistPos[1], 4 * (nHist - 2)); 1867 move(HistSearchContent[2], HistSearchContent[1], 1868 sizeof(shortstring) * (nHist - 2)); 1869 end 1870 else 1871 inc(nHist); 1872 if nHist > 0 then 1873 begin 1874 HistKind[nHist - 1] := Kind; 1875 HistNo[nHist - 1] := no; 1876 HistPos[nHist - 1] := sb.Position; 1877 HistSearchContent[nHist - 1] := SearchContent 1878 end 1904 (Index = miscSearchResult) then begin 1905 if HistItems.Count = MaxHist then HistItems.Delete(0); 1906 if HistItems.Count = 0 then 1907 HistItems.AddNew(Category, Index, ScrollBar.Position, NewSearchContent) 1908 else HistItems.AddNew(Kind, No, ScrollBar.Position, SearchContent); 1879 1909 end; 1880 1910 Kind := Category; … … 1889 1919 x, y: integer); 1890 1920 var 1891 i0, Sel0: integer;1921 i0, Sel0: Integer; 1892 1922 begin 1893 1923 y := y - WideFrame; 1894 i0 := sb.Position;1924 i0 := ScrollBar.Position; 1895 1925 Sel0 := Sel; 1896 1926 if (x >= SideFrame) and (x < SideFrame + InnerWidth) and (y >= 0) and … … 1905 1935 begin 1906 1936 if Sel0 <> -1 then 1907 line(Canvas, Sel0, false);1937 Line(Canvas, Sel0, False); 1908 1938 if Sel <> -1 then 1909 line(Canvas, Sel, true)1939 Line(Canvas, Sel, True) 1910 1940 end 1911 1941 end; … … 1915 1945 begin 1916 1946 if Sel >= 0 then 1917 with THelpLineInfo(MainText.Objects[Sel + sb.Position]) do1947 with THelpLineInfo(MainText.Objects[Sel + ScrollBar.Position]) do 1918 1948 if Link shr 8 and $3F = hkInternet then 1919 1949 case Link and $FF of 1920 1: OpenDocument( pchar(HomeDir + 'AI Template' + DirectorySeparator + 'AI development manual.html'));1921 2: OpenURL( 'http://c-evo.org');1922 3: OpenURL( 'http://c-evo.org/_sg/contact');1950 1: OpenDocument(HomeDir + AITemplateFileName); 1951 2: OpenURL(CevoHomepage); 1952 3: OpenURL(CevoContact); 1923 1953 end 1924 1954 else … … 1934 1964 1935 1965 procedure THelpDlg.BackBtnClick(Sender: TObject); 1936 begin 1937 if nHist > 0 then 1938 begin 1939 dec(nHist); 1940 if (HistKind[nHist] = hkMisc) and (HistNo[nHist] = miscSearchResult) and 1941 (HistSearchContent[nHist] <> SearchContent) then 1966 var 1967 HistItem: THistItem; 1968 begin 1969 if HistItems.Count > 1 then begin 1970 HistItem := THistItem.Create; 1971 HistItem.Assign(HistItems.Last); 1972 HistItems.Delete(HistItems.Count - 1); 1973 if (HistItem.Kind = hkMisc) and (HistItem.No = miscSearchResult) and 1974 (HistItem.SearchContent <> SearchContent) then 1942 1975 begin 1943 SearchContent := Hist SearchContent[nHist];1976 SearchContent := HistItem.SearchContent; 1944 1977 Search(SearchContent); 1945 1978 end; 1946 Kind := Hist Kind[nHist];1947 no := Hist No[nHist];1948 Prepare(Hist Pos[nHist]);1979 Kind := HistItem.Kind; 1980 no := HistItem.No; 1981 Prepare(HistItem.Pos); 1949 1982 OffscreenPaint; 1950 1983 Invalidate; 1951 end 1984 HistItem.Free; 1985 end; 1952 1986 end; 1953 1987 1954 1988 procedure THelpDlg.TopBtnClick(Sender: TObject); 1955 1989 begin 1956 nHist := 0;1990 while HistItems.Count > 1 do HistItems.Delete(HistItems.Count - 1); 1957 1991 Kind := hkMisc; 1958 1992 no := miscMain; … … 1968 2002 end; 1969 2003 1970 function THelpDlg.TextIndex(Item: string): integer;1971 begin 1972 result := HelpText.Gethandle(Item)2004 function THelpDlg.TextIndex(Item: string): Integer; 2005 begin 2006 Result := HelpText.Gethandle(Item) 1973 2007 end; 1974 2008 … … 1987 2021 InputDlg.CenterToRect(BoundsRect); 1988 2022 InputDlg.ShowModal; 1989 if (InputDlg.ModalResult = mrOK) and ( length(InputDlg.EInput.Text) >= 2) then2023 if (InputDlg.ModalResult = mrOK) and (Length(InputDlg.EInput.Text) >= 2) then 1990 2024 begin 1991 2025 Search(InputDlg.EInput.Text); … … 2004 2038 NewSearchContent := InputDlg.EInput.Text; 2005 2039 ShowNewContent(FWindowMode, hkMisc, miscSearchResult); 2006 end 2007 end 2008 end 2040 end; 2041 end; 2042 end; 2009 2043 end; 2010 2044 2011 2045 procedure THelpDlg.Search(SearchString: string); 2012 2046 var 2013 h, i, PrevHandle, PrevIndex, p, RightMargin: integer;2047 h, i, PrevHandle, PrevIndex, p, RightMargin: Integer; 2014 2048 s: string; 2015 2049 mADVHELP, mIMPHELP, mFEATUREHELP: set of 0 .. 255; 2016 bGOVHELP, bSPECIALMODEL, bJOBHELP: boolean;2050 bGOVHELP, bSPECIALMODEL, bJOBHELP: Boolean; 2017 2051 begin 2018 2052 SearchResult.Clear; … … 2020 2054 mIMPHELP := []; 2021 2055 mFEATUREHELP := []; 2022 bGOVHELP := false;2023 bSPECIALMODEL := false;2024 bJOBHELP := false;2056 bGOVHELP := False; 2057 bSPECIALMODEL := False; 2058 bJOBHELP := False; 2025 2059 2026 2060 // search in generic reference 2027 2061 SearchString := UpperCase(SearchString); 2028 for i := 0 to 35 + 4 do 2029 begin 2062 for i := 0 to 35 + 4 do begin 2030 2063 s := Phrases.Lookup('TERRAIN', i); 2031 2064 if pos(SearchString, UpperCase(s)) > 0 then … … 2042 2075 imShipComp + i - 37) + ' ' + HelpText.Lookup('HELPSPEC_SHIPPART'), 2043 2076 pkNormal, 0, hkImp + hkCrossLink, imShipComp + i - 37); 2044 Break 2045 end 2077 Break; 2078 end; 2046 2079 end; 2047 2080 for i := 0 to nJobHelp - 1 do … … 2051 2084 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'), pkNormal, 0, 2052 2085 hkMisc + hkCrossLink, miscJobList); 2053 bJOBHELP := true;2054 Break 2086 bJOBHELP := True; 2087 Break; 2055 2088 end; 2056 2089 for i := 0 to nAdv - 1 do … … 2065 2098 SearchResult.AddLine(s, pkNormal, 0, hkAdv + hkCrossLink, i); 2066 2099 include(mADVHELP, i); 2067 end 2100 end; 2068 2101 end; 2069 2102 for i := 0 to nSpecialModel - 1 do … … 2074 2107 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_MODELLIST'), pkNormal, 0, 2075 2108 hkModel + hkCrossLink, 0); 2076 bSPECIALMODEL := true;2077 Break 2109 bSPECIALMODEL := True; 2110 Break; 2078 2111 end; 2079 2112 end; … … 2081 2114 begin 2082 2115 s := Phrases.Lookup('FEATURES', i); 2083 if pos(SearchString, UpperCase(s)) > 0 then2116 if Pos(SearchString, UpperCase(s)) > 0 then 2084 2117 begin 2085 2118 if i < mcFirstNonCap then … … 2090 2123 s := s + ' ' + HelpText.Lookup('HELPSPEC_FEATURE'); 2091 2124 SearchResult.AddLine(s, pkNormal, 0, hkFeature + hkCrossLink, i); 2092 include(mFEATUREHELP, i);2093 end 2125 Include(mFEATUREHELP, i); 2126 end; 2094 2127 end; 2095 2128 for i := 0 to nImp - 1 do 2096 2129 begin 2097 2130 s := Phrases.Lookup('IMPROVEMENTS', i); 2098 if pos(SearchString, UpperCase(s)) > 0 then2131 if Pos(SearchString, UpperCase(s)) > 0 then 2099 2132 begin 2100 2133 case Imp[i].Kind of … … 2109 2142 end; 2110 2143 SearchResult.AddLine(s, pkNormal, 0, hkImp + hkCrossLink, i); 2111 include(mIMPHELP, i);2144 Include(mIMPHELP, i); 2112 2145 end 2113 2146 end; 2114 2147 for i := 0 to nGov - 1 do 2115 if pos(SearchString, UpperCase(Phrases.Lookup('GOVERNMENT', i))) > 0 then2148 if Pos(SearchString, UpperCase(Phrases.Lookup('GOVERNMENT', i))) > 0 then 2116 2149 begin 2117 2150 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_GOVLIST'), pkNormal, 0, 2118 2151 hkMisc + hkCrossLink, miscGovList); 2119 bGOVHELP := true;2120 Break 2152 bGOVHELP := True; 2153 Break; 2121 2154 end; 2122 2155 … … 2139 2172 s := s + ' ' + HelpText.Lookup('HELPSPEC_ADV'); 2140 2173 SearchResult.AddLine(s, pkNormal, 0, hkAdv + hkCrossLink, i) 2141 end 2174 end; 2142 2175 end 2143 2176 else if h = hIMPHELP then … … 2158 2191 end; 2159 2192 SearchResult.AddLine(s, pkNormal, 0, hkImp + hkCrossLink, i) 2160 end 2193 end; 2161 2194 end 2162 2195 else if h = hFEATUREHELP then … … 2173 2206 s := s + ' ' + HelpText.Lookup('HELPSPEC_FEATURE'); 2174 2207 SearchResult.AddLine(s, pkNormal, 0, hkFeature + hkCrossLink, i); 2175 end 2208 end; 2176 2209 end 2177 2210 else if h = hGOVHELP then … … 2196 2229 begin 2197 2230 s := HelpText.LookupByHandle(h); 2198 p := pos('$', s);2231 p := Pos('$', s); 2199 2232 if p > 0 then 2200 2233 begin 2201 s := copy(s, p + 1, maxint);2202 p := pos('\', s);2234 s := Copy(s, p + 1, maxint); 2235 p := Pos('\', s); 2203 2236 if p > 0 then 2204 s := copy(s, 1, p - 1);2237 s := Copy(s, 1, p - 1); 2205 2238 SearchResult.AddLine(s, pkNormal, 0, hkText + hkCrossLink, h); 2206 end 2207 end 2208 until false;2239 end; 2240 end; 2241 until False; 2209 2242 2210 2243 // cut lines to fit to window -
branches/highdpi/LocalPlayer/IsoEngine.pas
r179 r210 5 5 6 6 uses 7 Protocol, ClientTools, ScreenTools, Tribes, UDpiControls, 8 {$IFNDEF SCR}Term, {$ENDIF} 9 LCLIntf, LCLType, SysUtils, Classes, Graphics; 7 UDpiControls, Protocol, ClientTools, ScreenTools, Tribes, {$IFNDEF SCR}Term, {$ENDIF} 8 LCLIntf, LCLType, SysUtils, Classes, Graphics, UPixelPointer; 10 9 11 10 type … … 24 23 procedure PaintCity(x, y: integer; const CityInfo: TCityInfo; 25 24 accessory: boolean = true); 26 procedure BitBlt (Src: TDpiBitmap; x, y, Width, Height, xSrc, ySrc,25 procedure BitBltBitmap(Src: TDpiBitmap; x, y, Width, Height, xSrc, ySrc, 27 26 Rop: integer); 28 27 … … 40 39 FLeft, FTop, FRight, FBottom, RealTop, RealBottom, AttLoc, DefLoc, 41 40 DefHealth, FAdviceLoc: integer; 42 DataDC, MaskDC: HDC; 41 DataCanvas: TDpiCanvas; 42 MaskCanvas: TDpiCanvas; 43 43 function Connection4(Loc, Mask, Value: integer): integer; 44 44 function Connection8(Loc, Mask: integer): integer; … … 89 89 90 90 // sprites indexes 91 sp DeadLands= 2 * TerrainIconCols + 6;91 spRow2 = 2 * TerrainIconCols + 6; 92 92 spBlink1 = 1 * TerrainIconCols + 8; 93 93 spBlink2 = 2 * TerrainIconCols + 8; … … 107 107 spPollution = 12 * TerrainIconCols + 6; 108 108 spFortBack = 12 * TerrainIconCols + 7; 109 spMinerals = 12 * TerrainIconCols + 8; 109 110 spRiver = 13 * TerrainIconCols; 111 spRiverMouths = 15 * TerrainIconCols; 112 spGrid = 15 * TerrainIconCols + 6; 110 113 spJungle = 18 * TerrainIconCols; 114 spCanalMouths = 20 * TerrainIconCols; 111 115 112 116 var … … 137 141 i, x, y, xSrc, ySrc, HGrTerrainNew, HGrCitiesNew, age, size: integer; 138 142 LandMore, OceanMore, DitherMask, Mask24: TDpiBitmap; 139 MaskLine: array [0 .. 32* 3 - 1] of TPixelPointer; // 32 = assumed maximum for yyt143 MaskLine: array [0 .. 50 * 3 - 1] of TPixelPointer; // 32 = assumed maximum for yyt 140 144 Border: boolean; 141 145 begin … … 191 195 DitherMask.SetSize(xxt * 2, yyt * 2); 192 196 DitherMask.Canvas.FillRect(0, 0, DitherMask.Width, DitherMask.Height); 193 BitBlt(DitherMask.Canvas.Handle, 0, 0, xxt * 2, yyt * 2,194 GrExt[HGrTerrain].Mask.Canvas .Handle, 1 + 7 * (xxt * 2 + 1),197 DpiBitCanvas(DitherMask.Canvas, 0, 0, xxt * 2, yyt * 2, 198 GrExt[HGrTerrain].Mask.Canvas, 1 + 7 * (xxt * 2 + 1), 195 199 1 + yyt + 15 * (yyt * 3 + 1), SRCAND); 196 200 … … 213 217 end; 214 218 for y := -1 to 6 do 215 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2), (y + 2) * yyt, 216 xxt * 2, yyt, GrExt[HGrTerrain].Data.Canvas.Handle, xSrc, ySrc, 217 SRCCOPY); 219 DpiBitCanvas(LandPatch.Canvas, (x + 2) * (xxt * 2), (y + 2) * yyt, 220 xxt * 2, yyt, GrExt[HGrTerrain].Data.Canvas, xSrc, ySrc); 218 221 for y := -2 to 6 do 219 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2), (y + 2) * yyt, xxt,220 yyt, GrExt[HGrTerrain].Data.Canvas .Handle, xSrc + xxt, ySrc + yyt,222 DpiBitCanvas(LandPatch.Canvas, (x + 2) * (xxt * 2), (y + 2) * yyt, xxt, 223 yyt, GrExt[HGrTerrain].Data.Canvas, xSrc + xxt, ySrc + yyt, 221 224 SRCPAINT); 222 225 for y := -2 to 6 do 223 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2) + xxt, (y + 2) * yyt,224 xxt, yyt, GrExt[HGrTerrain].Data.Canvas .Handle, xSrc, ySrc + yyt,226 DpiBitCanvas(LandPatch.Canvas, (x + 2) * (xxt * 2) + xxt, (y + 2) * yyt, 227 xxt, yyt, GrExt[HGrTerrain].Data.Canvas, xSrc, ySrc + yyt, 225 228 SRCPAINT); 226 229 for y := -2 to 6 do 227 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2), (y + 2) * yyt, xxt,228 yyt, DitherMask.Canvas .Handle, xxt, yyt, SRCAND);230 DpiBitCanvas(LandPatch.Canvas, (x + 2) * (xxt * 2), (y + 2) * yyt, xxt, 231 yyt, DitherMask.Canvas, xxt, yyt, SRCAND); 229 232 for y := -2 to 6 do 230 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2) + xxt, (y + 2) * yyt,231 xxt, yyt, DitherMask.Canvas .Handle, 0, yyt, SRCAND);233 DpiBitCanvas(LandPatch.Canvas, (x + 2) * (xxt * 2) + xxt, (y + 2) * yyt, 234 xxt, yyt, DitherMask.Canvas, 0, yyt, SRCAND); 232 235 end; 233 236 … … 250 253 end; 251 254 for x := -2 to 6 do 252 BitBlt(LandMore.Canvas.Handle, (x + 2) * (xxt * 2), (y + 2) * yyt, 253 xxt * 2, yyt, GrExt[HGrTerrain].Data.Canvas.Handle, xSrc, ySrc, 254 SRCCOPY); 255 BitBlt(LandMore.Canvas.Handle, xxt * 2, (y + 2) * yyt, xxt, yyt, 256 GrExt[HGrTerrain].Data.Canvas.Handle, xSrc + xxt, ySrc + yyt, SRCPAINT); 255 DpiBitCanvas(LandMore.Canvas, (x + 2) * (xxt * 2), (y + 2) * yyt, 256 xxt * 2, yyt, GrExt[HGrTerrain].Data.Canvas, xSrc, ySrc); 257 DpiBitCanvas(LandMore.Canvas, xxt * 2, (y + 2) * yyt, xxt, yyt, 258 GrExt[HGrTerrain].Data.Canvas, xSrc + xxt, ySrc + yyt, SRCPAINT); 257 259 for x := 0 to 7 do 258 BitBlt(LandMore.Canvas.Handle, (x + 2) * (xxt * 2) - xxt, (y + 2) * yyt,259 xxt * 2, yyt, GrExt[HGrTerrain].Data.Canvas .Handle, xSrc, ySrc + yyt,260 DpiBitCanvas(LandMore.Canvas, (x + 2) * (xxt * 2) - xxt, (y + 2) * yyt, 261 xxt * 2, yyt, GrExt[HGrTerrain].Data.Canvas, xSrc, ySrc + yyt, 260 262 SRCPAINT); 261 263 for x := -2 to 6 do 262 BitBlt(LandMore.Canvas.Handle, (x + 2) * (xxt * 2), (y + 2) * yyt,263 xxt * 2, yyt, DitherMask.Canvas .Handle, 0, 0, SRCAND);264 DpiBitCanvas(LandMore.Canvas, (x + 2) * (xxt * 2), (y + 2) * yyt, 265 xxt * 2, yyt, DitherMask.Canvas, 0, 0, SRCAND); 264 266 end; 265 267 … … 273 275 ySrc := 1 + yyt; 274 276 if (x >= 1) = (y >= 2) then 275 BitBlt(OceanPatch.Canvas.Handle, x * (xxt * 2), y * yyt, xxt * 2, yyt,276 GrExt[HGrTerrain].Data.Canvas .Handle, xSrc, ySrc, SRCCOPY);277 DpiBitCanvas(OceanPatch.Canvas, x * (xxt * 2), y * yyt, xxt * 2, yyt, 278 GrExt[HGrTerrain].Data.Canvas, xSrc, ySrc); 277 279 if (x >= 1) and ((y < 2) or (x >= 2)) then 278 280 begin 279 BitBlt(OceanPatch.Canvas.Handle, x * (xxt * 2), y * yyt, xxt, yyt,280 GrExt[HGrTerrain].Data.Canvas .Handle, xSrc + xxt, ySrc + yyt,281 DpiBitCanvas(OceanPatch.Canvas, x * (xxt * 2), y * yyt, xxt, yyt, 282 GrExt[HGrTerrain].Data.Canvas, xSrc + xxt, ySrc + yyt, 281 283 SRCPAINT); 282 BitBlt(OceanPatch.Canvas.Handle, x * (xxt * 2) + xxt, y * yyt, xxt, yyt,283 GrExt[HGrTerrain].Data.Canvas .Handle, xSrc, ySrc + yyt, SRCPAINT);284 DpiBitCanvas(OceanPatch.Canvas, x * (xxt * 2) + xxt, y * yyt, xxt, yyt, 285 GrExt[HGrTerrain].Data.Canvas, xSrc, ySrc + yyt, SRCPAINT); 284 286 end; 285 BitBlt(OceanPatch.Canvas.Handle, x * (xxt * 2), y * yyt, xxt, yyt,286 DitherMask.Canvas .Handle, xxt, yyt, SRCAND);287 BitBlt(OceanPatch.Canvas.Handle, x * (xxt * 2) + xxt, y * yyt, xxt, yyt,288 DitherMask.Canvas .Handle, 0, yyt, SRCAND);287 DpiBitCanvas(OceanPatch.Canvas, x * (xxt * 2), y * yyt, xxt, yyt, 288 DitherMask.Canvas, xxt, yyt, SRCAND); 289 DpiBitCanvas(OceanPatch.Canvas, x * (xxt * 2) + xxt, y * yyt, xxt, yyt, 290 DitherMask.Canvas, 0, yyt, SRCAND); 289 291 end; 290 292 … … 298 300 ySrc := 1 + yyt; 299 301 if (x < 1) or (y >= 2) then 300 BitBlt(OceanMore.Canvas.Handle, x * (xxt * 2), y * yyt, xxt * 2, yyt,301 GrExt[HGrTerrain].Data.Canvas .Handle, xSrc, ySrc, SRCCOPY);302 DpiBitCanvas(OceanMore.Canvas, x * (xxt * 2), y * yyt, xxt * 2, yyt, 303 GrExt[HGrTerrain].Data.Canvas, xSrc, ySrc); 302 304 if (x = 1) and (y < 2) or (x >= 2) and (y >= 1) then 303 305 begin 304 BitBlt(OceanMore.Canvas.Handle, x * (xxt * 2), y * yyt, xxt, yyt,305 GrExt[HGrTerrain].Data.Canvas .Handle, xSrc + xxt, ySrc + yyt,306 DpiBitCanvas(OceanMore.Canvas, x * (xxt * 2), y * yyt, xxt, yyt, 307 GrExt[HGrTerrain].Data.Canvas, xSrc + xxt, ySrc + yyt, 306 308 SRCPAINT); 307 BitBlt(OceanMore.Canvas.Handle, x * (xxt * 2) + xxt, y * yyt, xxt, yyt,308 GrExt[HGrTerrain].Data.Canvas .Handle, xSrc, ySrc + yyt, SRCPAINT);309 DpiBitCanvas(OceanMore.Canvas, x * (xxt * 2) + xxt, y * yyt, xxt, yyt, 310 GrExt[HGrTerrain].Data.Canvas, xSrc, ySrc + yyt, SRCPAINT); 309 311 end; 310 BitBlt(OceanMore.Canvas.Handle, x * (xxt * 2), y * yyt, xxt * 2, yyt,311 DitherMask.Canvas .Handle, 0, 0, SRCAND);312 DpiBitCanvas(OceanMore.Canvas, x * (xxt * 2), y * yyt, xxt * 2, yyt, 313 DitherMask.Canvas, 0, 0, SRCAND); 312 314 end; 313 315 314 BitBlt(DitherMask.Canvas.Handle, 0, 0, xxt * 2, yyt * 2,315 DitherMask.Canvas .Handle, 0, 0, DSTINVERT); { invert dither mask }316 BitBlt(DitherMask.Canvas.Handle, 0, 0, xxt * 2, yyt * 2,317 GrExt[HGrTerrain].Mask.Canvas .Handle, 1, 1 + yyt, SRCPAINT);316 DpiBitCanvas(DitherMask.Canvas, 0, 0, xxt * 2, yyt * 2, 317 DitherMask.Canvas, 0, 0, DSTINVERT); { invert dither mask } 318 DpiBitCanvas(DitherMask.Canvas, 0, 0, xxt * 2, yyt * 2, 319 GrExt[HGrTerrain].Mask.Canvas, 1, 1 + yyt, SRCPAINT); 318 320 319 321 for x := -1 to 6 do 320 322 for y := -2 to 6 do 321 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2), (y + 2) * yyt,322 xxt * 2, yyt, DitherMask.Canvas .Handle, 0, 0, SRCAND);323 DpiBitCanvas(LandPatch.Canvas, (x + 2) * (xxt * 2), (y + 2) * yyt, 324 xxt * 2, yyt, DitherMask.Canvas, 0, 0, SRCAND); 323 325 324 326 for y := -1 to 6 do 325 327 for x := -2 to 7 do 326 BitBlt(LandMore.Canvas.Handle, (x + 2) * (xxt * 2) - xxt, (y + 2) * yyt,327 xxt * 2, yyt, DitherMask.Canvas .Handle, 0, yyt, SRCAND);328 329 BitBlt(LandPatch.Canvas.Handle, 0, 0, (xxt * 2) * 9, yyt * 9,330 LandMore.Canvas .Handle, 0, 0, SRCPAINT);328 DpiBitCanvas(LandMore.Canvas, (x + 2) * (xxt * 2) - xxt, (y + 2) * yyt, 329 xxt * 2, yyt, DitherMask.Canvas, 0, yyt, SRCAND); 330 331 DpiBitCanvas(LandPatch.Canvas, 0, 0, (xxt * 2) * 9, yyt * 9, 332 LandMore.Canvas, 0, 0, SRCPAINT); 331 333 332 334 for x := 0 to 3 do 333 335 for y := 0 to 3 do 334 BitBlt(OceanPatch.Canvas.Handle, x * (xxt * 2), y * yyt, xxt * 2, yyt,335 DitherMask.Canvas .Handle, 0, 0, SRCAND);336 DpiBitCanvas(OceanPatch.Canvas, x * (xxt * 2), y * yyt, xxt * 2, yyt, 337 DitherMask.Canvas, 0, 0, SRCAND); 336 338 337 339 for y := 0 to 3 do 338 340 for x := 0 to 4 do 339 BitBlt(OceanMore.Canvas.Handle, x * (xxt * 2) - xxt, y * yyt, xxt * 2,340 yyt, DitherMask.Canvas .Handle, 0, yyt, SRCAND);341 342 BitBlt(OceanPatch.Canvas.Handle, 0, 0, (xxt * 2) * 4, yyt * 4,343 OceanMore.Canvas .Handle, 0, 0, SRCPAINT);341 DpiBitCanvas(OceanMore.Canvas, x * (xxt * 2) - xxt, y * yyt, xxt * 2, 342 yyt, DitherMask.Canvas, 0, yyt, SRCAND); 343 344 DpiBitCanvas(OceanPatch.Canvas, 0, 0, (xxt * 2) * 4, yyt * 4, 345 OceanMore.Canvas, 0, 0, SRCPAINT); 344 346 345 347 with DitherMask.Canvas do … … 348 350 FillRect(Rect(0, 0, xxt * 2, yyt)); 349 351 end; 350 BitBlt(DitherMask.Canvas.Handle, 0, 0, xxt * 2, yyt,351 GrExt[HGrTerrain].Mask.Canvas .Handle, 1, 1 + yyt, SRCCOPY);352 DpiBitCanvas(DitherMask.Canvas, 0, 0, xxt * 2, yyt, 353 GrExt[HGrTerrain].Mask.Canvas, 1, 1 + yyt); 352 354 353 355 for x := 0 to 6 do 354 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2), yyt, xxt * 2, yyt,355 DitherMask.Canvas .Handle, 0, 0, SRCAND);356 BitBlt(DitherMask.Canvas.Handle, 0, 0, xxt * 2, yyt, DitherMask.Canvas.Handle,356 DpiBitCanvas(LandPatch.Canvas, (x + 2) * (xxt * 2), yyt, xxt * 2, yyt, 357 DitherMask.Canvas, 0, 0, SRCAND); 358 DpiBitCanvas(DitherMask.Canvas, 0, 0, xxt * 2, yyt, DitherMask.Canvas, 357 359 0, 0, DSTINVERT); 358 360 359 361 for y := 0 to 6 do 360 BitBlt(LandPatch.Canvas.Handle, xxt * 2, (y + 2) * yyt, xxt * 2, yyt,361 DitherMask.Canvas .Handle, 0, 0, SRCAND);362 DpiBitCanvas(LandPatch.Canvas, xxt * 2, (y + 2) * yyt, xxt * 2, yyt, 363 DitherMask.Canvas, 0, 0, SRCAND); 362 364 363 365 LandMore.Free; … … 373 375 begin 374 376 for i := 0 to yyt * 3 - 1 do 375 MaskLine[i] .Init(Mask24, 0, 1 + ySrc * (yyt * 3 + 1) + i);377 MaskLine[i] := PixelPointer(Mask24, 0, 1 + ySrc * (yyt * 3 + 1) + i); 376 378 for xSrc := 0 to 9 - 1 do 377 379 begin … … 422 424 Borders := TDpiBitmap.Create; 423 425 Borders.PixelFormat := pf24bit; 424 Borders.SetSize(xxt * 2, (yyt * 2) * nPl);426 Borders.SetSize(xxt * 2, (yyt * 2) * nPl); 425 427 Borders.Canvas.FillRect(0, 0, Borders.Width, Borders.Height); 426 428 BordersOK := 0; … … 474 476 begin 475 477 Width := Width - (FLeft - x); 476 x := FLeft 478 x := FLeft; 477 479 end; 478 480 if y < FTop then 479 481 begin 480 482 Height := Height - (FTop - y); 481 y := FTop 483 y := FTop; 482 484 end; 483 485 if x + Width >= FRight then … … 499 501 end; 500 502 501 procedure TIsoMap.BitBlt (Src: TDpiBitmap; x, y, Width, Height, xSrc, ySrc,503 procedure TIsoMap.BitBltBitmap(Src: TDpiBitmap; x, y, Width, Height, xSrc, ySrc, 502 504 Rop: integer); 503 505 begin … … 506 508 Width := Width - (FLeft - x); 507 509 xSrc := xSrc + (FLeft - x); 508 x := FLeft 510 x := FLeft; 509 511 end; 510 512 if y < FTop then … … 512 514 Height := Height - (FTop - y); 513 515 ySrc := ySrc + (FTop - y); 514 y := FTop 516 y := FTop; 515 517 end; 516 518 if x + Width >= FRight then … … 521 523 exit; 522 524 523 DpiBitBlt(FOutput.Canvas.Handle, x, y, Width, Height, Src.Canvas.Handle, 524 xSrc, ySrc, Rop); 525 DpiBitCanvas(FOutput.Canvas, x, y, Width, Height, Src.Canvas, xSrc, ySrc, Rop); 525 526 end; 526 527 527 528 procedure TIsoMap.Sprite(HGr, xDst, yDst, Width, Height, xGr, yGr: integer); 528 529 begin 529 BitBlt (GrExt[HGr].Mask, xDst, yDst, Width, Height, xGr, yGr, SRCAND);530 BitBlt (GrExt[HGr].Data, xDst, yDst, Width, Height, xGr, yGr, SRCPAINT);530 BitBltBitmap(GrExt[HGr].Mask, xDst, yDst, Width, Height, xGr, yGr, SRCAND); 531 BitBltBitmap(GrExt[HGr].Data, xDst, yDst, Width, Height, xGr, yGr, SRCPAINT); 531 532 end; 532 533 … … 561 562 exit; 562 563 563 DpiBit Blt(FOutput.Canvas.Handle, xDst, yDst, Width, Height, MaskDC, xSrc, ySrc, SRCAND);564 DpiBitCanvas(FOutput.Canvas, xDst, yDst, Width, Height, MaskCanvas, xSrc, ySrc, SRCAND); 564 565 if not PureBlack then 565 DpiBitBlt(FOutput.Canvas.Handle, xDst, yDst, Width, Height, DataDC, xSrc, ySrc, 566 SRCPAINT); 566 DpiBitCanvas(FOutput.Canvas, xDst, yDst, Width, Height, DataCanvas, xSrc, ySrc, SRCPAINT); 567 567 end; 568 568 … … 612 612 xGr := 121 + j mod 7 * 9; 613 613 yGr := 1 + j div 7 * 9; 614 BitBlt (GrExt[HGrSystem].Mask, x + xsh + 3, y + ysh + 9, 8, 8, xGr,614 BitBltBitmap(GrExt[HGrSystem].Mask, x + xsh + 3, y + ysh + 9, 8, 8, xGr, 615 615 yGr, SRCAND); 616 616 Sprite(HGrSystem, x + xsh + 2, y + ysh + 8, 8, 8, xGr, yGr); … … 620 620 if Flags and unFortified <> 0 then 621 621 begin 622 { Data DC:=GrExt[HGrTerrain].Data.Canvas.Handle;623 Mask DC:=GrExt[HGrTerrain].Mask.Canvas.Handle;622 { DataCanvas:=GrExt[HGrTerrain].Data.Canvas; 623 MaskCanvas:=GrExt[HGrTerrain].Mask.Canvas; 624 624 TSprite(x,y+16,12*9+7); } 625 625 Sprite(HGrStdUnits, x, y, xxu * 2, yyu * 2, 1 + 6 * (xxu * 2 + 1), 1); 626 end 627 end 626 end; 627 end; 628 628 end; { PaintUnit } 629 629 … … 819 819 exit; 820 820 821 BitBlt (GrExt[HGrTerrain].Data, x + xxt div 2, y, xxt, yyt,821 BitBltBitmap(GrExt[HGrTerrain].Data, x + xxt div 2, y, xxt, yyt, 822 822 1 + (Conn shr 6 + Conn and 1 shl 2) * (xxt * 2 + 1), 823 823 1 + yyt + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT); 824 BitBlt (GrExt[HGrTerrain].Data, x + xxt, y + yyt div 2, xxt, yyt,824 BitBltBitmap(GrExt[HGrTerrain].Data, x + xxt, y + yyt div 2, xxt, yyt, 825 825 1 + (Conn and 7) * (xxt * 2 + 1) + xxt, 826 826 1 + yyt * 2 + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT); 827 BitBlt (GrExt[HGrTerrain].Data, x + xxt div 2, y + yyt, xxt, yyt,827 BitBltBitmap(GrExt[HGrTerrain].Data, x + xxt div 2, y + yyt, xxt, yyt, 828 828 1 + (Conn shr 2 and 7) * (xxt * 2 + 1) + xxt, 829 829 1 + yyt + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT); 830 BitBlt (GrExt[HGrTerrain].Data, x, y + yyt div 2, xxt, yyt,830 BitBltBitmap(GrExt[HGrTerrain].Data, x, y + yyt div 2, xxt, yyt, 831 831 1 + (Conn shr 4 and 7) * (xxt * 2 + 1), 832 832 1 + yyt * 2 + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT); 833 833 Conn := Connection4(Loc, fTerrain, fUNKNOWN); { dither to black } 834 834 if Conn and 1 <> 0 then 835 BitBlt (GrExt[HGrTerrain].Mask, x + xxt, y, xxt, yyt, 1 + 7 * (xxt * 2 + 1) +835 BitBltBitmap(GrExt[HGrTerrain].Mask, x + xxt, y, xxt, yyt, 1 + 7 * (xxt * 2 + 1) + 836 836 xxt, 1 + yyt + 15 * (yyt * 3 + 1), SRCAND); 837 837 if Conn and 2 <> 0 then 838 BitBlt (GrExt[HGrTerrain].Mask, x + xxt, y + yyt, xxt, yyt,838 BitBltBitmap(GrExt[HGrTerrain].Mask, x + xxt, y + yyt, xxt, yyt, 839 839 1 + 7 * (xxt * 2 + 1) + xxt, 1 + yyt * 2 + 15 * (yyt * 3 + 1), SRCAND); 840 840 if Conn and 4 <> 0 then 841 BitBlt (GrExt[HGrTerrain].Mask, x, y + yyt, xxt, yyt, 1 + 7 * (xxt * 2 + 1),841 BitBltBitmap(GrExt[HGrTerrain].Mask, x, y + yyt, xxt, yyt, 1 + 7 * (xxt * 2 + 1), 842 842 1 + yyt * 2 + 15 * (yyt * 3 + 1), SRCAND); 843 843 if Conn and 8 <> 0 then 844 BitBlt (GrExt[HGrTerrain].Mask, x, y, xxt, yyt, 1 + 7 * (xxt * 2 + 1),844 BitBltBitmap(GrExt[HGrTerrain].Mask, x, y, xxt, yyt, 1 + 7 * (xxt * 2 + 1), 845 845 1 + yyt + 15 * (yyt * 3 + 1), SRCAND); 846 846 end; … … 876 876 end 877 877 else if Tile and fDeadLands <> 0 then 878 TSprite(x, y, sp DeadLands);878 TSprite(x, y, spRow2); 879 879 880 880 if ShowObjects then … … 898 898 for Dir := 0 to 3 do 899 899 if Conn and (1 shl Dir) <> 0 then { river mouths } 900 TSprite(x, y, 15 * TerrainIconCols + Dir);900 TSprite(x, y, spRiverMouths + Dir); 901 901 if ShowObjects then 902 902 begin … … 904 904 for Dir := 0 to 7 do 905 905 if Conn and (1 shl Dir) <> 0 then { canal mouths } 906 TSprite(x, y, 20 * TerrainIconCols + 1 + Dir);906 TSprite(x, y, spCanalMouths + 1 + Dir); 907 907 end 908 908 end; … … 1007 1007 if BordersOK and (1 shl p1) = 0 then 1008 1008 begin 1009 // Clearing before bitbltSRCCOPY shouldn't be neccesary but for some1009 // Clearing before BitBltBitmap SRCCOPY shouldn't be neccesary but for some 1010 1010 // reason without it code works different then under Delphi 1011 1011 Borders.Canvas.FillRect(Bounds(0, p1 * (yyt * 2), xxt * 2, yyt * 2)); 1012 1012 1013 DpiBit Blt(Borders.Canvas.Handle, 0, p1 * (yyt * 2), xxt * 2,1014 yyt * 2, GrExt[HGrTerrain].Data.Canvas .Handle,1015 1 + 8 * (xxt * 2 + 1), 1 + yyt + 16 * (yyt * 3 + 1) , SRCCOPY);1013 DpiBitCanvas(Borders.Canvas, 0, p1 * (yyt * 2), xxt * 2, 1014 yyt * 2, GrExt[HGrTerrain].Data.Canvas, 1015 1 + 8 * (xxt * 2 + 1), 1 + yyt + 16 * (yyt * 3 + 1)); 1016 1016 Borders.BeginUpdate; 1017 1017 for dy := 0 to yyt * 2 - 1 do 1018 1018 begin 1019 PixelPtr .Init(Borders, 0, p1 * (yyt * 2) + dy);1019 PixelPtr := PixelPointer(Borders, 0, p1 * (yyt * 2) + dy); 1020 1020 for dx := 0 to xxt * 2 - 1 do begin 1021 1021 if PixelPtr.Pixel^.B = 99 then begin … … 1043 1043 if p2 <> p1 then 1044 1044 begin 1045 BitBlt (GrExt[HGrTerrain].Mask, x + dx * xxt, y + dy * yyt, xxt,1045 BitBltBitmap(GrExt[HGrTerrain].Mask, x + dx * xxt, y + dy * yyt, xxt, 1046 1046 yyt, 1 + 8 * (xxt * 2 + 1) + dx * xxt, 1047 1047 1 + yyt + 16 * (yyt * 3 + 1) + dy * yyt, SRCAND); 1048 BitBlt (Borders, x + dx * xxt, y + dy * yyt, xxt, yyt, dx * xxt,1048 BitBltBitmap(Borders, x + dx * xxt, y + dy * yyt, xxt, yyt, dx * xxt, 1049 1049 p1 * (yyt * 2) + dy * yyt, SRCPAINT); 1050 1050 end … … 1112 1112 end; 1113 1113 end; 1114 if Tile and fDeadLands<> 0 then1115 TSprite(x, y, (12 + Tile shr 25 and 3) * TerrainIconCols + 8);1114 if (Tile and fDeadLands) <> 0 then 1115 TSprite(x, y, spMinerals + (Tile shr 25 and 3) * TerrainIconCols); 1116 1116 1117 1117 if Options and (1 shl moEditMode) <> 0 then … … 1131 1131 1 + yyt + 15 * (yyt * 3 + 1)) 1132 1132 else 1133 TSprite(x, y, 6 + TerrainIconCols * 15, xxt <> 33);1133 TSprite(x, y, spGrid, xxt <> 33); 1134 1134 1135 1135 if FoW and (Tile and fObserved = 0) then … … 1340 1340 FOutput.BeginUpdate; 1341 1341 for y := y0 to y1 - 1 do begin 1342 Line .Init(FOutput, 0, y);1342 Line := PixelPointer(FOutput, 0, y); 1343 1343 y_n := (y - ym) / yyt; 1344 1344 if abs(y_n) < rShade then begin … … 1487 1487 bix := 0 1488 1488 end; 1489 BitBlt (OceanPatch, x + dx * xxt, y + dy * yyt, xxt, yyt,1489 BitBltBitmap(OceanPatch, x + dx * xxt, y + dy * yyt, xxt, yyt, 1490 1490 Aix * (xxt * 2) + (dx + dy + 1) and 1 * xxt, bix * yyt, SRCCOPY) 1491 1491 end … … 1535 1535 bix := Aix; 1536 1536 if Aix = -1 then 1537 BitBlt (GrExt[HGrTerrain].Data, x + dx * xxt, y + dy * yyt, xxt,1537 BitBltBitmap(GrExt[HGrTerrain].Data, x + dx * xxt, y + dy * yyt, xxt, 1538 1538 yyt, 1 + 6 * (xxt * 2 + 1) + (dx + dy + 1) and 1 * xxt, 1 + yyt, 1539 1539 SRCCOPY) // arctic <-> ocean 1540 1540 else if bix = -1 then 1541 BitBlt (GrExt[HGrTerrain].Data, x + dx * xxt, y + dy * yyt, xxt,1541 BitBltBitmap(GrExt[HGrTerrain].Data, x + dx * xxt, y + dy * yyt, xxt, 1542 1542 yyt, 1 + 6 * (xxt * 2 + 1) + xxt - (dx + dy + 1) and 1 * xxt, 1543 1543 1 + yyt * 2, SRCCOPY) // arctic <-> ocean 1544 1544 else 1545 BitBlt (LandPatch, x + dx * xxt, y + dy * yyt, xxt, yyt,1545 BitBltBitmap(LandPatch, x + dx * xxt, y + dy * yyt, xxt, yyt, 1546 1546 Aix * (xxt * 2) + (dx + dy + 1) and 1 * xxt, bix * yyt, SRCCOPY) 1547 1547 end 1548 1548 end; 1549 1549 1550 Data DC := GrExt[HGrTerrain].Data.Canvas.Handle;1551 Mask DC := GrExt[HGrTerrain].Mask.Canvas.Handle;1550 DataCanvas := GrExt[HGrTerrain].Data.Canvas; 1551 MaskCanvas := GrExt[HGrTerrain].Mask.Canvas; 1552 1552 for dy := -2 to ny + 1 do 1553 1553 for dx := -1 to nx do -
branches/highdpi/LocalPlayer/LocalPlayer.pas
r155 r210 11 11 12 12 uses 13 Term, CityScreen, Draft, MessgEx, Select, CityType, Help, UnitStat, Diagram,13 UDpiControls, Term, CityScreen, Draft, MessgEx, Select, CityType, Help, UnitStat, Diagram, 14 14 NatStat, Wonders, Nego, Enhance, BaseWin, Battle, Rates, TechTree, 15 15 … … 25 25 FormsCreated := true; 26 26 // TODO: Changing application name in runtime will cause change of Linux XML registry file path 27 // Application.MainForm := MainScreen;28 Application.CreateForm(TMainScreen, MainScreen);29 Application.CreateForm(TCityDlg, CityDlg);30 Application.CreateForm(TModalSelectDlg, ModalSelectDlg);31 Application.CreateForm(TListDlg, ListDlg);32 Application.CreateForm(TMessgExDlg, MessgExDlg);33 Application.CreateForm(TDraftDlg, DraftDlg);34 Application.CreateForm(TCityTypeDlg, CityTypeDlg);35 Application.CreateForm(THelpDlg, HelpDlg);36 Application.CreateForm(TUnitStatDlg, UnitStatDlg);37 Application.CreateForm(TDiaDlg, DiaDlg);38 Application.CreateForm(TNatStatDlg, NatStatDlg);39 Application.CreateForm(TWondersDlg, WondersDlg);40 Application.CreateForm(TNegoDlg, NegoDlg);41 Application.CreateForm(TEnhanceDlg, EnhanceDlg);42 Application.CreateForm(TBattleDlg, BattleDlg);43 // Application.CreateForm(TAdvisorDlg, AdvisorDlg);44 Application.CreateForm(TRatesDlg, RatesDlg);45 Application.CreateForm(TTechTreeDlg, TechTreeDlg);27 // DpiApplication.MainForm := MainScreen; 28 DpiApplication.CreateForm(TMainScreen, MainScreen); 29 DpiApplication.CreateForm(TCityDlg, CityDlg); 30 DpiApplication.CreateForm(TModalSelectDlg, ModalSelectDlg); 31 DpiApplication.CreateForm(TListDlg, ListDlg); 32 DpiApplication.CreateForm(TMessgExDlg, MessgExDlg); 33 DpiApplication.CreateForm(TDraftDlg, DraftDlg); 34 DpiApplication.CreateForm(TCityTypeDlg, CityTypeDlg); 35 DpiApplication.CreateForm(THelpDlg, HelpDlg); 36 DpiApplication.CreateForm(TUnitStatDlg, UnitStatDlg); 37 DpiApplication.CreateForm(TDiaDlg, DiaDlg); 38 DpiApplication.CreateForm(TNatStatDlg, NatStatDlg); 39 DpiApplication.CreateForm(TWondersDlg, WondersDlg); 40 DpiApplication.CreateForm(TNegoDlg, NegoDlg); 41 DpiApplication.CreateForm(TEnhanceDlg, EnhanceDlg); 42 DpiApplication.CreateForm(TBattleDlg, BattleDlg); 43 // DpiApplication.CreateForm(TAdvisorDlg, AdvisorDlg); 44 DpiApplication.CreateForm(TRatesDlg, RatesDlg); 45 DpiApplication.CreateForm(TTechTreeDlg, TechTreeDlg); 46 46 end; 47 47 MainScreen.Client(Command, Player, Data); -
branches/highdpi/LocalPlayer/MessgEx.pas
r193 r210 5 5 6 6 uses 7 Messg, Protocol, ScreenTools, Platform, DateUtils, UDpiControls,7 UDpiControls, Messg, Protocol, ScreenTools, Platform, DateUtils, 8 8 LCLIntf, LCLType, Messages, SysUtils, Classes, Graphics, Controls, Forms, ButtonA, 9 9 ButtonB, StdCtrls, DrawDlg; … … 73 73 74 74 uses 75 ClientTools, BaseWin, Term, Help, UnitStat, Tribes, 76 IsoEngine, Diagram ;75 ClientTools, BaseWin, Term, Help, UnitStat, Tribes, UPixelPointer, 76 IsoEngine, Diagram, Sound; 77 77 78 78 {$R *.lfm} … … 209 209 Ticks0 := NowPrecise; 210 210 repeat 211 Application.ProcessMessages;211 DpiApplication.ProcessMessages; 212 212 Sleep(1); 213 213 Ticks := NowPrecise; … … 246 246 for iy := 0 to 39 do begin 247 247 for ix := 0 to 55 do begin 248 SrcPtr .Init(BigImp, ix + xIcon, iy + yIcon);248 SrcPtr := PixelPointer(BigImp, ix + xIcon, iy + yIcon); 249 249 xR := ix * (37 + iy * 5 / 40) / 56; 250 250 xDst := Trunc(xR); … … 291 291 292 292 // paint 293 BitBltCanvas(LogoBuffer.Canvas, 0, 0, wb, hb, ca, x, y, SRCCOPY);293 DpiBitCanvas(LogoBuffer.Canvas, 0, 0, wb, hb, ca, x, y); 294 294 295 295 if IconIndex >= 0 then … … 304 304 ImageOp_BCC(LogoBuffer, Templates, 0, 0, xb, yb, wb, hb, clCover, clPage); 305 305 306 DpiBit Blt(ca.Handle, x, y, wb, hb, LogoBuffer.Canvas.Handle, 0, 0, SRCCOPY);306 DpiBitCanvas(ca, x, y, wb, hb, LogoBuffer.Canvas, 0, 0); 307 307 end; 308 308 … … 328 328 with MyRO.EnemyModel[emix], Tribe[Owner].ModelPicture[mix] do 329 329 begin 330 DpiBit Blt(Canvas.Handle, x, y, 64, 48, GrExt[HGr].Mask.Canvas.Handle,330 DpiBitCanvas(Canvas, x, y, 64, 48, GrExt[HGr].Mask.Canvas, 331 331 pix mod 10 * 65 + 1, pix div 10 * 49 + 1, SRCAND); 332 DpiBit Blt(Canvas.Handle, x, y, 64, 48, GrExt[HGr].Data.Canvas.Handle,332 DpiBitCanvas(Canvas, x, y, 64, 48, GrExt[HGr].Data.Canvas, 333 333 pix mod 10 * 65 + 1, pix div 10 * 49 + 1, SRCPAINT); 334 334 end; … … 345 345 if UnitsInLine > LostUnitsPerLine then 346 346 UnitsInLine := LostUnitsPerLine; 347 end 347 end; 348 348 end; 349 349 end; … … 371 371 begin 372 372 p1 := MyRO.Wonder[IconIndex].EffectiveOwner; 373 DpiBit Blt(Buffer.Canvas.Handle, 0, 0, xSizeBig + 2 * GlowRange,374 ySizeBig + 2 * GlowRange, Canvas .Handle,375 ClientWidth div 2 - (28 + GlowRange), 24 - GlowRange , SRCCOPY);376 DpiBit Blt(Buffer.Canvas.Handle, GlowRange, GlowRange, xSizeBig, ySizeBig,377 BigImp.Canvas .Handle, IconIndex mod 7 * xSizeBig,378 (IconIndex + SystemIconLines * 7) div 7 * ySizeBig , SRCCOPY);373 DpiBitCanvas(Buffer.Canvas, 0, 0, xSizeBig + 2 * GlowRange, 374 ySizeBig + 2 * GlowRange, Canvas, 375 ClientWidth div 2 - (28 + GlowRange), 24 - GlowRange); 376 DpiBitCanvas(Buffer.Canvas, GlowRange, GlowRange, xSizeBig, ySizeBig, 377 BigImp.Canvas, IconIndex mod 7 * xSizeBig, 378 (IconIndex + SystemIconLines * 7) div 7 * ySizeBig); 379 379 if p1 < 0 then 380 380 GlowFrame(Buffer, GlowRange, GlowRange, xSizeBig, ySizeBig, $000000) … … 382 382 GlowFrame(Buffer, GlowRange, GlowRange, xSizeBig, ySizeBig, 383 383 Tribe[p1].Color); 384 DpiBit Blt(Canvas.Handle, ClientWidth div 2 - (28 + GlowRange),384 DpiBitCanvas(Canvas, ClientWidth div 2 - (28 + GlowRange), 385 385 24 - GlowRange, xSizeBig + 2 * GlowRange, ySizeBig + 2 * GlowRange, 386 Buffer.Canvas .Handle, 0, 0, SRCCOPY);386 Buffer.Canvas, 0, 0); 387 387 end 388 388 else … … 400 400 FrameImage(Canvas, BigImp, ClientWidth div 2 - 28, 24, xSizeBig, 401 401 ySizeBig, 0, 0); 402 DpiBit Blt(Canvas.Handle, ClientWidth div 2 - 32, 20, 64, 44,403 GrExt[HGr].Mask.Canvas .Handle, pix mod 10 * 65 + 1,402 DpiBitCanvas(Canvas, ClientWidth div 2 - 32, 20, 64, 44, 403 GrExt[HGr].Mask.Canvas, pix mod 10 * 65 + 1, 404 404 pix div 10 * 49 + 1, SRCAND); 405 DpiBit Blt(Canvas.Handle, ClientWidth div 2 - 32, 20, 64, 44,406 GrExt[HGr].Data.Canvas .Handle, pix mod 10 * 65 + 1,405 DpiBitCanvas(Canvas, ClientWidth div 2 - 32, 20, 64, 44, 406 GrExt[HGr].Data.Canvas, pix mod 10 * 65 + 1, 407 407 pix div 10 * 49 + 1, SRCPAINT); 408 408 end; … … 415 415 Frame(Canvas, ClientWidth div 2 - 32 - 1, 24 - 1, 416 416 ClientWidth div 2 + 32, 24 + 48, $000000, $000000); 417 DpiBit Blt(Canvas.Handle, ClientWidth div 2 - 32, 24, 64, 48,418 GrExt[Tribe[IconIndex].faceHGr].Data.Canvas .Handle,417 DpiBitCanvas(Canvas, ClientWidth div 2 - 32, 24, 64, 48, 418 GrExt[Tribe[IconIndex].faceHGr].Data.Canvas, 419 419 1 + Tribe[IconIndex].facepix mod 10 * 65, 420 1 + Tribe[IconIndex].facepix div 10 * 49 , SRCCOPY)420 1 + Tribe[IconIndex].facepix div 10 * 49) 421 421 end; 422 422 mikPureIcon: … … 429 429 mikEnemyShipComplete: 430 430 begin 431 BitBltCanvas(Buffer.Canvas, 0, 0, 140, 120, Canvas,432 (ClientWidth - 140) div 2, 24 , SRCCOPY);431 DpiBitCanvas(Buffer.Canvas, 0, 0, 140, 120, Canvas, 432 (ClientWidth - 140) div 2, 24); 433 433 ImageOp_BCC(Buffer, Templates, 0, 0, 1, 279, 140, 120, 0, $FFFFFF); 434 DpiBit Blt(Canvas.Handle, (ClientWidth - 140) div 2, 24, 140, 120,435 Buffer.Canvas .Handle, 0, 0, SRCCOPY);434 DpiBitCanvas(Canvas, (ClientWidth - 140) div 2, 24, 140, 120, 435 Buffer.Canvas, 0, 0); 436 436 end; 437 437 mikMyArmy: … … 450 450 if OpenSound <> '' then 451 451 PostMessage(Handle, WM_PLAYSOUND, 0, 0); 452 end; { FormPaint }452 end; 453 453 454 454 procedure TMessgExDlg.Button1Click(Sender: TObject); … … 469 469 procedure TMessgExDlg.Button3Click(Sender: TObject); 470 470 begin 471 ModalResult := mrCancel 471 ModalResult := mrCancel; 472 472 end; 473 473 474 474 procedure TMessgExDlg.RemoveBtnClick(Sender: TObject); 475 475 begin 476 ModalResult := mrNo 476 ModalResult := mrNo; 477 477 end; 478 478 … … 485 485 ModalResult := mrCancel 486 486 else if Button2.Visible then 487 ModalResult := mrIgnore 487 ModalResult := mrIgnore; 488 488 end; 489 489 … … 497 497 Kind := mkOk; 498 498 ShowModal; 499 end 499 end; 500 500 end; 501 501 … … 522 522 Kind := QueryKind; 523 523 ShowModal; 524 result := ModalResult 525 end 524 result := ModalResult; 525 end; 526 526 end; 527 527 … … 537 537 HelpNo := ContextNo; 538 538 ShowModal; 539 end 539 end; 540 540 end; 541 541 … … 552 552 end; 553 553 554 554 555 initialization 555 556 -
branches/highdpi/LocalPlayer/NatStat.pas
r179 r210 5 5 6 6 uses 7 Protocol, ClientTools, Term, ScreenTools, BaseWin, UDpiControls, 7 UDpiControls, Protocol, ClientTools, Term, ScreenTools, BaseWin, 8 8 9 LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, 9 10 ButtonB, ButtonC, Menus, EOTButton; … … 92 93 Template := TDpiBitmap.Create; 93 94 Template.PixelFormat := pf24bit; 94 LoadGraphicFile(Template, HomeDir + 'Graphics'+ DirectorySeparator + 'Nation.png', gfNoGamma);95 LoadGraphicFile(Template, GetGraphicsDir + DirectorySeparator + 'Nation.png', gfNoGamma); 95 96 end; 96 97 … … 108 109 begin 109 110 AgePrepared := MainTextureAge; 110 Dpi bitblt(Back.Canvas.Handle, 0, 0, ClientWidth, ClientHeight,111 MainTexture.Image.Canvas .Handle, (wMainTexture - ClientWidth) div 2,112 (hMainTexture - ClientHeight) div 2 , SRCCOPY);111 DpiBitCanvas(Back.Canvas, 0, 0, ClientWidth, ClientHeight, 112 MainTexture.Image.Canvas, (wMainTexture - ClientWidth) div 2, 113 (hMainTexture - ClientHeight) div 2); 113 114 ImageOp_B(Back, Template, 0, 0, 0, 0, ClientWidth, ClientHeight); 114 115 end … … 263 264 Extinct := 1 shl pView and MyRO.Alive = 0; 264 265 265 Dpi bitblt(offscreen.Canvas.Handle, 0, 0, ClientWidth, ClientHeight,266 Back.Canvas .Handle, 0, 0, SRCCOPY);266 DpiBitCanvas(offscreen.Canvas, 0, 0, ClientWidth, ClientHeight, 267 Back.Canvas, 0, 0); 267 268 268 269 offscreen.Canvas.Font.Assign(UniFont[ftCaption]); -
branches/highdpi/LocalPlayer/Nego.pas
r178 r210 5 5 6 6 uses 7 ScreenTools, BaseWin, Protocol, Term, LCLType, SysUtils, Classes, Graphics,8 Controls, Forms, ButtonA, ButtonB, ButtonN , UDpiControls;7 UDpiControls, ScreenTools, BaseWin, Protocol, Term, LCLType, SysUtils, Classes, Graphics, 8 Controls, Forms, ButtonA, ButtonB, ButtonN; 9 9 10 10 const … … 15 15 type 16 16 THistory = record 17 n: integer;18 Text: array 19 end; 20 21 TCommandAllowedEnum = scDipNoticeStart ..scDipBreakStart;17 n: Integer; 18 Text: array[0 .. MaxHistory - 1] of ansistring; 19 end; 20 21 TCommandAllowedEnum = scDipNoticeStart..scDipBreakStart; 22 22 23 23 { TNegoDlg } -
branches/highdpi/LocalPlayer/PVSB.pas
r178 r210 5 5 6 6 uses 7 {$IFDEF WINDOWS}7 UDpiControls, {$IFDEF WINDOWS} 8 8 Windows, 9 9 {$ENDIF} 10 10 Classes, Controls, Forms, LCLIntf, LCLType, LMessages, Messages, SysUtils, 11 StdCtrls, Math , UDpiControls;11 StdCtrls, Math; 12 12 13 13 type … … 109 109 if Max < ScrollBar.PageSize then Result := False 110 110 else begin 111 NewPos := ScrollBar.Position - Delta div 30 0;111 NewPos := ScrollBar.Position - Delta div 30; 112 112 if NewPos < 0 then NewPos := 0; 113 113 if NewPos > Max - ScrollBar.PageSize + 1 then … … 153 153 begin 154 154 FMax := AValue; 155 ScrollBar.Max := Math.Max(0, Max{$IFDEF LINUX} - PageSize + 1{$ENDIF});155 ScrollBar.Max := Math.Max(0, FMax); 156 156 end; 157 157 -
branches/highdpi/LocalPlayer/Rates.pas
r193 r210 5 5 6 6 uses 7 Protocol, ScreenTools, BaseWin, LCLIntf, LCLType,7 UDpiControls, Protocol, ScreenTools, BaseWin, LCLIntf, LCLType, 8 8 9 9 SysUtils, Classes, Graphics, Controls, Forms, … … 29 29 RatesDlg: TRatesDlg; 30 30 31 32 31 implementation 33 32 34 33 uses 35 ClientTools, Term, Tribes , UDpiControls;34 ClientTools, Term, Tribes; 36 35 37 36 {$R *.lfm} … … 96 95 GlowFrame(Offscreen, ClientWidth div 2 - xSizeBig div 2, 52, xSizeBig, 97 96 ySizeBig, Tribe[me].Color); 98 DpiBit Blt(Offscreen.Canvas.Handle, ClientWidth div 2 - xSizeBig div 2, 52,99 xSizeBig, ySizeBig, BigImp.Canvas .Handle, (woLiberty mod 7) * xSizeBig,100 (woLiberty div 7 + SystemIconLines) * ySizeBig , SRCCOPY);97 DpiBitCanvas(Offscreen.Canvas, ClientWidth div 2 - xSizeBig div 2, 52, 98 xSizeBig, ySizeBig, BigImp.Canvas, (woLiberty mod 7) * xSizeBig, 99 (woLiberty div 7 + SystemIconLines) * ySizeBig); 101 100 end 102 101 else … … 123 122 begin 124 123 for i := 0 to current div 8 - 1 do 125 DpiBit Blt(Handle, x + max - 8 - i * 8, y, 8, 7,126 GrExt[HGrSystem].Data.Canvas .Handle, 104, 9 + 8 * 2, SRCCOPY);127 DpiBit Blt(Handle, x + max - current, y, current - 8 * (current div 8), 7,128 GrExt[HGrSystem].Data.Canvas .Handle, 104, 9 + 8 * 2, SRCCOPY);124 DpiBitCanvas(Offscreen.Canvas, x + max - 8 - i * 8, y, 8, 7, 125 GrExt[HGrSystem].Data.Canvas, 104, 9 + 8 * 2); 126 DpiBitCanvas(Offscreen.Canvas, x + max - current, y, current - 8 * (current div 8), 7, 127 GrExt[HGrSystem].Data.Canvas, 104, 9 + 8 * 2); 129 128 Brush.Color := $000000; 130 129 FillRect(Rect(x, y, x + max - current, y + 7)); -
branches/highdpi/LocalPlayer/Select.pas
r193 r210 5 5 6 6 uses 7 Protocol, ClientTools, Term, ScreenTools, IsoEngine, PVSB, BaseWin, UDpiControls, 8 LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls, Forms, 7 UDpiControls, Protocol, ClientTools, Term, ScreenTools, IsoEngine, PVSB, BaseWin, 8 9 LCLIntf, LCLType, Messages, SysUtils, Classes, Graphics, Controls, Forms, 9 10 ExtCtrls, ButtonB, ButtonBase, Menus, Types; 10 11 … … 196 197 if pix and cpType = 0 then 197 198 if (pix and cpIndex = imPalace) and (MyRO.Government <> gAnarchy) then 198 DpiBit Blt(offscreen.Canvas.Handle, x + 16, y + (16 - 1), xSizeSmall,199 ySizeSmall, SmallImp.Canvas .Handle, (MyRO.Government - 1) *200 xSizeSmall, ySizeSmall , SRCCOPY)199 DpiBitCanvas(offscreen.Canvas, x + 16, y + (16 - 1), xSizeSmall, 200 ySizeSmall, SmallImp.Canvas, (MyRO.Government - 1) * 201 xSizeSmall, ySizeSmall) 201 202 else 202 DpiBit Blt(offscreen.Canvas.Handle, x + 16, y + (16 - 1), xSizeSmall,203 ySizeSmall, SmallImp.Canvas .Handle, pix and cpIndex mod 7 *203 DpiBitCanvas(offscreen.Canvas, x + 16, y + (16 - 1), xSizeSmall, 204 ySizeSmall, SmallImp.Canvas, pix and cpIndex mod 7 * 204 205 xSizeSmall, (pix and cpIndex + SystemIconLines * 7) div 7 * 205 ySizeSmall , SRCCOPY)206 ySizeSmall) 206 207 else 207 DpiBit Blt(offscreen.Canvas.Handle, x + 16, y + (16 - 1), xSizeSmall,208 ySizeSmall, SmallImp.Canvas .Handle, (3 + pix and cpIndex) *209 xSizeSmall, 0 , SRCCOPY)208 DpiBitCanvas(offscreen.Canvas, x + 16, y + (16 - 1), xSizeSmall, 209 ySizeSmall, SmallImp.Canvas, (3 + pix and cpIndex) * 210 xSizeSmall, 0); 210 211 end; 211 212 end; … … 567 568 MainTexture.clBevelLight, MainTexture.clBevelShade); 568 569 if AdvIcon[lix] < 84 then 569 DpiBit Blt(offscreen.Canvas.Handle, (8 + 16), y0, xSizeSmall,570 ySizeSmall, SmallImp.Canvas .Handle,570 DpiBitCanvas(offscreen.Canvas, (8 + 16), y0, xSizeSmall, 571 ySizeSmall, SmallImp.Canvas, 571 572 (AdvIcon[lix] + SystemIconLines * 7) mod 7 * xSizeSmall, 572 573 (AdvIcon[lix] + SystemIconLines * 7) div 7 * 573 ySizeSmall , SRCCOPY)574 ySizeSmall) 574 575 else 575 576 Dump(offscreen, HGrSystem, (8 + 16), y0, 36, 20, … … 577 578 295 + (AdvIcon[lix] - 84) div 8 * 21); 578 579 j := AdvValue[lix] div 1000; 579 DpiBit Blt(Handle, (8 + 16 - 4), y0 + 2, 14, 14,580 GrExt[HGrSystem].Mask.Canvas .Handle, 127 + j * 15,580 DpiBitCanvas(Canvas, (8 + 16 - 4), y0 + 2, 14, 14, 581 GrExt[HGrSystem].Mask.Canvas, 127 + j * 15, 581 582 85, SRCAND); 582 583 Sprite(offscreen, HGrSystem, (8 + 16 - 5), y0 + 1, 14, 14, … … 672 673 8 + 16 + xSizeSmall, y0 - 15 + (16 - 1 + ySizeSmall), 673 674 MainTexture.clBevelLight, MainTexture.clBevelShade); 674 DpiBit Blt(offscreen.Canvas.Handle, 8 + 16, y0 - 15 + (16 - 1),675 xSizeSmall, ySizeSmall, SmallImp.Canvas .Handle,676 (lix - 1) * xSizeSmall, ySizeSmall , SRCCOPY);675 DpiBitCanvas(offscreen.Canvas, 8 + 16, y0 - 15 + (16 - 1), 676 xSizeSmall, ySizeSmall, SmallImp.Canvas, 677 (lix - 1) * xSizeSmall, ySizeSmall); 677 678 end 678 679 end; … … 815 816 LoweredTextOut(Canvas, -1, MainTexture, xScreen + 10, 816 817 ClientHeight - 29, s); 817 BitBltCanvas(ScienceNationDot.Canvas, 0, 0, 17, 17, Canvas,818 xScreen - 10, ClientHeight - 27 , SRCCOPY);818 DpiBitCanvas(ScienceNationDot.Canvas, 0, 0, 17, 17, Canvas, 819 xScreen - 10, ClientHeight - 27); 819 820 ImageOp_BCC(ScienceNationDot, Templates, 0, 0, 114, 211, 17, 17, 820 821 MainTexture.clBevelShade, Tribe[ScienceNation].Color); 821 DpiBit Blt(Canvas.Handle, xScreen - 10, ClientHeight - 27, 17, 17,822 ScienceNationDot.Canvas .Handle, 0, 0, SRCCOPY);822 DpiBitCanvas(Canvas, xScreen - 10, ClientHeight - 27, 17, 17, 823 ScienceNationDot.Canvas, 0, 0); 823 824 end; 824 825 end -
branches/highdpi/LocalPlayer/TechTree.pas
r193 r210 5 5 6 6 uses 7 ScreenTools, Messg, LCLIntf, LCLType, Messages, SysUtils, Classes, Graphics,8 Controls, Forms, ButtonB ase, ButtonB, DrawDlg, UDpiControls;7 UDpiControls, ScreenTools, LCLIntf, LCLType, SysUtils, Classes, Graphics, 8 Controls, Forms, ButtonB, DrawDlg; 9 9 10 10 type … … 30 30 TechTreeDlg: TTechTreeDlg; 31 31 32 32 33 implementation 33 34 … … 77 78 X, w: Integer; 78 79 begin 79 with Canvas do 80 begin 80 with Canvas do begin 81 81 // black border 82 82 brush.color := $000000; … … 107 107 -BlackBorder - yOffset, Paper); 108 108 end; 109 DpiBit Blt(Canvas.Handle, max(BlackBorder, BlackBorder + xOffset),109 DpiBitCanvas(Canvas, max(BlackBorder, BlackBorder + xOffset), 110 110 max(BlackBorder, BlackBorder + yOffset), 111 111 min(Image.width, min(Image.width + xOffset, … … 113 113 ), min(Image.height, min(Image.height + yOffset, 114 114 min(ClientHeight - 2 * BlackBorder, ClientHeight - 2 * BlackBorder - 115 yOffset))), Image.Canvas .Handle, max(0, -xOffset),116 max(0, -yOffset) , SRCCOPY);115 yOffset))), Image.Canvas, max(0, -xOffset), 116 max(0, -yOffset)); 117 117 end; 118 118 119 119 procedure TTechTreeDlg.FormShow(Sender: TObject); 120 120 var 121 X, Y, ad , TexWidth, TexHeight: Integer;121 X, Y, ad: Integer; 122 122 s: string; 123 SrcPixel, DstPixel: TPixelPointer; 124 begin 125 if Image = nil then126 begin123 const 124 TransparentColor = $7F007F; 125 begin 126 if Image = nil then begin 127 127 Image := TDpiBitmap.Create; 128 128 Image.PixelFormat := pf24bit; 129 129 LoadGraphicFile(Image, HomeDir + 'Help' + DirectorySeparator + 'AdvTree.png', gfNoGamma); 130 130 131 with Image.Canvas do 132 begin 131 with Image.Canvas do begin 133 132 // write advance names 134 133 Font.Assign(UniFont[ftSmall]); … … 146 145 TextOut(xStart + X * xPitch + 2, yStart + Y * yPitch, s); 147 146 Pixels[xStart + X * xPitch + 10, yStart + Y * yPitch - 1] 148 := $7F007F;147 := TransparentColor; 149 148 end 150 149 end; … … 161 160 end; 162 161 163 // texturize background 164 Image.BeginUpdate; 165 TexWidth := Paper.Width; 166 TexHeight := Paper.Height; 167 DstPixel.Init(Image); 168 SrcPixel.Init(Paper); 169 for Y := 0 to Image.Height - 1 do begin 170 for X := 0 to Image.Width - 1 do begin 171 if (DstPixel.Pixel^.ARGB and $FFFFFF) = $7F007F then begin // transparent 172 SrcPixel.SetXY(X mod TexWidth, Y mod TexHeight); 173 DstPixel.Pixel^.B := SrcPixel.Pixel^.B; 174 DstPixel.Pixel^.G := SrcPixel.Pixel^.G; 175 DstPixel.Pixel^.R := SrcPixel.Pixel^.R; 176 end; 177 DstPixel.NextPixel; 178 end; 179 DstPixel.NextLine; 180 end; 181 Image.EndUpdate; 162 Texturize(Image, Paper, TransparentColor); 182 163 end; 183 164 … … 204 185 xDown := X; 205 186 yDown := Y; 206 end 187 end; 207 188 end; 208 189 … … 234 215 235 216 SmartInvalidate; 236 end 217 end; 237 218 end; 238 219 … … 246 227 procedure TTechTreeDlg.CloseBtnClick(Sender: TObject); 247 228 begin 248 Close ();229 Close; 249 230 end; 250 231 -
branches/highdpi/LocalPlayer/Term.lfm
r90 r210 1 1 object MainScreen: TMainScreen 2 2 Left = 231 3 Height = 4803 Height = 600 4 4 Top = 190 5 Width = 8005 Width = 1000 6 6 HorzScrollBar.Visible = False 7 7 VertScrollBar.Visible = False 8 8 Caption = 'C-evo' 9 ClientHeight = 48010 ClientWidth = 8009 ClientHeight = 600 10 ClientWidth = 1000 11 11 Color = clBtnFace 12 Constraints.MinHeight = 480 13 Constraints.MinWidth = 800 12 Constraints.MinHeight = 600 13 Constraints.MinWidth = 1000 14 DesignTimePPI = 120 14 15 Font.Color = clWindowText 15 Font.Height = -1 316 Font.Height = -16 16 17 Font.Name = 'MS Sans Serif' 17 18 KeyPreview = True … … 30 31 OnShow = FormShow 31 32 Position = poDefault 32 LCLVersion = ' 1.6.0.4'33 LCLVersion = '2.0.6.0' 33 34 WindowState = wsMaximized 34 35 object UnitBtn: TButtonB 35 36 Tag = 14 36 Left = 2 0837 Height = 2538 Top = 38439 Width = 2537 Left = 260 38 Height = 31 39 Top = 480 40 Width = 31 40 41 Visible = False 41 42 Down = False … … 46 47 object MapBtn0: TButtonC 47 48 Tag = 51 48 Left = 1649 Height = 1 250 Top = 3 0451 Width = 1 249 Left = 20 50 Height = 15 51 Top = 380 52 Width = 15 52 53 Visible = False 53 54 Down = False … … 58 59 object MapBtn1: TButtonC 59 60 Tag = 291 60 Left = 1661 Height = 1 262 Top = 32063 Width = 1 261 Left = 20 62 Height = 15 63 Top = 400 64 Width = 15 64 65 Visible = False 65 66 Down = False … … 70 71 object MapBtn4: TButtonC 71 72 Tag = 1028 72 Left = 1673 Height = 1 274 Top = 36875 Width = 1 273 Left = 20 74 Height = 15 75 Top = 460 76 Width = 15 76 77 Visible = False 77 78 Down = False … … 82 83 object MapBtn5: TButtonC 83 84 Tag = 1328 84 Left = 1685 Height = 1 286 Top = 38487 Width = 1 285 Left = 20 86 Height = 15 87 Top = 480 88 Width = 15 88 89 Visible = False 89 90 Down = False … … 94 95 object MapBtn6: TButtonC 95 96 Tag = 1541 96 Left = 1697 Height = 1 298 Top = 40099 Width = 1 297 Left = 20 98 Height = 15 99 Top = 500 100 Width = 15 100 101 Visible = False 101 102 Down = False … … 106 107 object TerrainBtn: TButtonB 107 108 Tag = 28 108 Left = 240109 Height = 25110 Top = 384111 Width = 25109 Left = 300 110 Height = 31 111 Top = 480 112 Width = 31 112 113 Visible = False 113 114 Down = False … … 118 119 object UnitInfoBtn: TButtonB 119 120 Tag = 15 120 Left = 176121 Height = 25122 Top = 384123 Width = 25121 Left = 220 122 Height = 31 123 Top = 480 124 Width = 31 124 125 Visible = False 125 126 Down = False … … 129 130 end 130 131 object EOT: TEOTButton 131 Left = 712132 Height = 48133 Top = 368134 Width = 48132 Left = 890 133 Height = 60 134 Top = 460 135 Width = 60 135 136 Visible = False 136 137 Down = False … … 141 142 object MenuArea: TArea 142 143 Left = 2 143 Height = 36144 Height = 45 144 145 Top = 1 145 Width = 36146 Width = 45 146 147 end 147 148 object TreasuryArea: TArea 148 Left = 2 08149 Height = 36149 Left = 260 150 Height = 45 150 151 Top = 1 151 Width = 164152 Width = 205 152 153 end 153 154 object ResearchArea: TArea 154 Left = 384155 Height = 36155 Left = 480 156 Height = 45 156 157 Top = 1 157 Width = 240158 Width = 300 158 159 end 159 160 object ManagementArea: TArea 160 Left = 704161 Height = 40162 Top = 3 12163 Width = 56161 Left = 880 162 Height = 50 163 Top = 390 164 Width = 70 164 165 end 165 166 object MovieSpeed1Btn: TButtonB 166 167 Tag = 256 167 Left = 384168 Height = 25169 Top = 384170 Width = 25168 Left = 480 169 Height = 31 170 Top = 480 171 Width = 31 171 172 Visible = False 172 173 Down = False … … 177 178 object MovieSpeed2Btn: TButtonB 178 179 Tag = 512 179 Left = 416180 Height = 25181 Top = 384182 Width = 25180 Left = 520 181 Height = 31 182 Top = 480 183 Width = 31 183 184 Visible = False 184 185 Down = False … … 189 190 object MovieSpeed3Btn: TButtonB 190 191 Tag = 768 191 Left = 448192 Height = 25193 Top = 384194 Width = 25192 Left = 560 193 Height = 31 194 Top = 480 195 Width = 31 195 196 Visible = False 196 197 Down = False … … 201 202 object MovieSpeed4Btn: TButtonB 202 203 Tag = 1024 203 Left = 480204 Height = 25205 Top = 384206 Width = 25204 Left = 600 205 Height = 31 206 Top = 480 207 Width = 31 207 208 Visible = False 208 209 Down = False … … 215 216 Interval = 50 216 217 OnTimer = Timer1Timer 217 left = 8218 top = 48218 left = 10 219 top = 60 219 220 end 220 221 object GamePopup: TPopupMenu 221 222 AutoPopup = False 222 left = 40223 top = 48223 left = 50 224 top = 60 224 225 object mHelp: TMenuItem 225 226 Tag = 7 … … 452 453 RadioItem = True 453 454 OnClick = mNormalTilesClick 455 end 456 object mBigTiles: TMenuItem 457 Caption = '90px' 458 RadioItem = True 459 OnClick = mBigTilesClick 454 460 end 455 461 end … … 580 586 object UnitPopup: TPopupMenu 581 587 AutoPopup = False 582 left = 1 04583 top = 48588 left = 130 589 top = 60 584 590 object mdisband: TMenuItem 585 591 Tag = 72 … … 663 669 object StatPopup: TPopupMenu 664 670 AutoPopup = False 665 left = 72666 top = 48671 left = 90 672 top = 60 667 673 object mUnitStat: TMenuItem 668 674 Tag = 9 … … 719 725 end 720 726 object EditPopup: TPopupMenu 721 left = 168722 top = 48727 left = 210 728 top = 60 723 729 object mCreateUnit: TMenuItem 724 730 Tag = 47 … … 726 732 end 727 733 object TerrainPopup: TPopupMenu 728 left = 1 36729 top = 48734 left = 170 735 top = 60 730 736 object mtrans: TMenuItem 731 737 Tag = 273 -
branches/highdpi/LocalPlayer/Term.pas
r193 r210 5 5 6 6 uses 7 {$IFDEF Windows}7 UDpiControls, {$IFDEF Windows} 8 8 Windows, 9 9 {$ENDIF} … … 13 13 Protocol, Tribes, PVSB, ClientTools, ScreenTools, BaseWin, Messg, ButtonBase, 14 14 LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, DrawDlg, Types, 15 Forms, Menus, ExtCtrls, dateutils, Platform, ButtonB, ButtonC, EOTButton, Area, 16 UDpiControls; 15 Forms, Menus, ExtCtrls, dateutils, Platform, ButtonB, ButtonC, EOTButton, Area; 17 16 18 17 const … … 27 26 28 27 TMainScreen = class(TDrawDlg) 28 mBigTiles: TMenuItem; 29 29 Timer1: TTimer; 30 30 GamePopup: TPopupMenu; … … 219 219 procedure mSmallTilesClick(Sender: TObject); 220 220 procedure mNormalTilesClick(Sender: TObject); 221 procedure mBigTilesClick(Sender: TObject); 221 222 procedure GrWallBtnDownChanged(Sender: TObject); 222 223 procedure BareBtnDownChanged(Sender: TObject); … … 234 235 Closable, RepaintOnResize, Tracking, TurnComplete, Edited, GoOnPhase, 235 236 HaveStrategyAdvice, FirstMovieTurn: boolean; 237 function ChooseUnusedTribe: integer; 238 procedure GetTribeList; 239 procedure InitModule; 240 procedure InitTurn(NewPlayer: integer); 236 241 procedure ScrollBarUpdate(Sender: TObject); 237 242 procedure ArrangeMidPanel; … … 271 276 procedure SetTileSize(x, y: integer); 272 277 procedure RectInvalidate(Left, Top, Rigth, Bottom: integer); 278 procedure ShowEnemyShipChange(ShowShipChange: TShowShipChange); 273 279 procedure SmartRectInvalidate(Left, Top, Rigth, Bottom: integer); 280 procedure LoadSettings; 274 281 procedure SaveSettings; 275 282 procedure OnScroll(var m: TMessage); message WM_VSCROLL; 276 283 procedure OnEOT(var Msg: TMessage); message WM_EOT; 284 procedure SoundPreload(Check: integer); 277 285 public 278 286 UsedOffscreenWidth, UsedOffscreenHeight: integer; … … 391 399 'CITY_WONDEREX', 'CITY_EMDELAY', 'CITY_FOUNDED', 'CITY_FOUNDED', '', 392 400 'CITY_INVALIDTYPE'); 401 402 // sound blocks for preload 403 sbStart = $01; 404 sbWonder = $02; 405 sbScience = $04; 406 sbContact = $08; 407 sbTurn = $10; 408 sbAll = $FF; 393 409 394 410 type … … 460 476 procedure HelpOnTerrain(Loc, NewMode: integer); 461 477 478 462 479 implementation 463 480 464 481 uses 465 482 Directories, IsoEngine, CityScreen, Draft, MessgEx, Select, CityType, Help, 466 UnitStat, Log, Diagram, NatStat, Wonders, Enhance, Nego, 467 Battle, Rates, TechTree, Registry ;483 UnitStat, Log, Diagram, NatStat, Wonders, Enhance, Nego, UPixelPointer, Sound, 484 Battle, Rates, TechTree, Registry, Global; 468 485 469 486 {$R *.lfm} … … 560 577 if ydivider > ySizeSmall then 561 578 ydivider := ySizeSmall; 562 PixelPtr .Init(BigImp, 0, cut + iy * ySizeBig + y);579 PixelPtr := PixelPointer(BigImp, 0, cut + iy * ySizeBig + y); 563 580 for x := 0 to xSizeBig - 1 do 564 581 begin … … 593 610 SmallImp.BeginUpdate; 594 611 for y := 0 to ny - 1 do begin 595 PixelPtr .Init(SmallImp, 0, y);612 PixelPtr := PixelPointer(SmallImp, 0, y); 596 613 for x := 0 to nx - 1 do 597 614 for ch := 0 to 2 do begin … … 1292 1309 end; 1293 1310 1294 procedure TMainScreen.Client(Command, NewPlayer: integer; var Data); 1295 1296 procedure GetTribeList; 1297 var 1298 SearchRec: TSearchRec; 1299 Color: TColor; 1300 Name: string; 1301 ok: boolean; 1302 begin 1303 UnusedTribeFiles.Clear; 1304 ok := FindFirst(LocalizedFilePath('Tribes') + DirectorySeparator + '*.tribe.txt', 1311 procedure TMainScreen.SoundPreload(Check: integer); 1312 const 1313 nStartBlock = 27; 1314 StartBlock: array [0 .. nStartBlock - 1] of string = ('INVALID', 'TURNEND', 1315 'DISBAND', 'CHEAT', 'MSG_DEFAULT', 'WARNING_DISORDER', 'WARNING_FAMINE', 1316 'WARNING_LOWSUPPORT', 'WARNING_LOWFUNDS', 'MOVE_MOUNTAIN', 'MOVE_LOAD', 1317 'MOVE_UNLOAD', 'MOVE_DIE', 'NOMOVE_TIME', 'NOMOVE_DOMAIN', 1318 'NOMOVE_DEFAULT', 'CITY_SELLIMP', 'CITY_REBUILDIMP', 'CITY_BUYPROJECT', 1319 'CITY_UTILIZE', 'NEWMODEL_0', 'NEWADVANCE_0', 'AGE_0', 'REVOLUTION', 1320 'NEWGOV', 'CITY_INVALIDTYPE', 'MSG_GAMEOVER'); 1321 1322 nWonderBlock = 6; 1323 WonderBlock: array [0 .. nWonderBlock - 1] of string = ('WONDER_BUILT', 1324 'WONDER_CAPTURED', 'WONDER_EXPIRED', 'WONDER_DESTROYED', 'MSG_COLDWAR', 1325 'NEWADVANCE_GRLIB'); 1326 1327 nScienceBlock = 17; 1328 ScienceBlock: array [0 .. nScienceBlock - 1] of string = ('MOVE_PARACHUTE', 1329 'MOVE_PLANESTART', 'MOVE_PLANELANDING', 'MOVE_COVERT', 'NEWMODEL_1', 1330 'NEWMODEL_2', 'NEWMODEL_3', 'NEWADVANCE_1', 'NEWADVANCE_2', 1331 'NEWADVANCE_3', 'AGE_1', 'AGE_2', 'AGE_3', 'SHIP_BUILT', 'SHIP_TRADED', 1332 'SHIP_CAPTURED', 'SHIP_DESTROYED'); 1333 1334 nContactBlock = 20; 1335 ContactBlock: array [0 .. nContactBlock - 1] of string = ('NEWTREATY', 1336 'CANCELTREATY', 'ACCEPTOFFER', 'MSG_WITHDRAW', 'MSG_BANKRUPT', 1337 'CONTACT_0', 'CONTACT_1', 'CONTACT_2', 'CONTACT_3', 'CONTACT_4', 1338 'CONTACT_5', 'CONTACT_5', 'CONTACT_6', 'NEGO_REJECTED', 'MOVE_CAPTURE', 1339 'MOVE_EXPEL', 'NOMOVE_TREATY', 'NOMOVE_ZOC', 'NOMOVE_SUBMARINE', 1340 'NOMOVE_STEALTH'); 1341 1342 var 1343 i, cix, mix: integer; 1344 need: boolean; 1345 mi: TModelInfo; 1346 begin 1347 if Check and sbStart and not SoundPreloadDone <> 0 then 1348 begin 1349 for i := 0 to nStartBlock - 1 do 1350 PreparePlay(StartBlock[i]); 1351 SoundPreloadDone := SoundPreloadDone or sbStart; 1352 end; 1353 if Check and sbWonder and not SoundPreloadDone <> 0 then 1354 begin 1355 need := false; 1356 for i := 0 to 27 do 1357 if MyRO.Wonder[i].CityID <> -1 then 1358 need := true; 1359 if need then 1360 begin 1361 for i := 0 to nWonderBlock - 1 do 1362 PreparePlay(WonderBlock[i]); 1363 SoundPreloadDone := SoundPreloadDone or sbWonder; 1364 end; 1365 end; 1366 if (Check and sbScience and not SoundPreloadDone <> 0) and 1367 (MyRO.Tech[adScience] >= tsApplicable) then 1368 begin 1369 for i := 0 to nScienceBlock - 1 do 1370 PreparePlay(ScienceBlock[i]); 1371 SoundPreloadDone := SoundPreloadDone or sbScience; 1372 end; 1373 if (Check and sbContact and not SoundPreloadDone <> 0) and 1374 (MyRO.nEnemyModel + MyRO.nEnemyCity > 0) then 1375 begin 1376 for i := 0 to nContactBlock - 1 do 1377 PreparePlay(ContactBlock[i]); 1378 SoundPreloadDone := SoundPreloadDone or sbContact; 1379 end; 1380 if Check and sbTurn <> 0 then 1381 begin 1382 if MyRO.Happened and phShipComplete <> 0 then 1383 PreparePlay('MSG_YOUWIN'); 1384 if MyData.ToldAlive <> MyRO.Alive then 1385 PreparePlay('MSG_EXTINCT'); 1386 for cix := 0 to MyRO.nCity - 1 do 1387 with MyCity[cix] do 1388 if (Loc >= 0) and (Flags and CityRepMask <> 0) then 1389 for i := 0 to 12 do 1390 if 1 shl i and Flags and CityRepMask <> 0 then 1391 PreparePlay(CityEventSoundItem[i]); 1392 for mix := 0 to MyRO.nModel - 1 do 1393 with MyModel[mix] do 1394 if Attack > 0 then 1395 begin 1396 MakeModelInfo(me, mix, MyModel[mix], mi); 1397 PreparePlay(AttackSound(ModelCode(mi))); 1398 end; 1399 end; 1400 end; 1401 1402 procedure TMainScreen.GetTribeList; 1403 var 1404 SearchRec: TSearchRec; 1405 Color: TColor; 1406 Name: string; 1407 ok: boolean; 1408 begin 1409 UnusedTribeFiles.Clear; 1410 ok := FindFirst(LocalizedFilePath('Tribes') + DirectorySeparator + '*.tribe.txt', 1411 faArchive + faReadOnly, SearchRec) = 0; 1412 if not ok then 1413 begin 1414 FindClose(SearchRec); 1415 ok := FindFirst(LocalizedFilePath('Tribes' + DirectorySeparator + '*.tribe.txt'), 1305 1416 faArchive + faReadOnly, SearchRec) = 0; 1306 if not ok then 1307 begin 1308 FindClose(SearchRec); 1309 ok := FindFirst(LocalizedFilePath('Tribes' + DirectorySeparator + '*.tribe.txt'), 1310 faArchive + faReadOnly, SearchRec) = 0; 1417 end; 1418 if ok then 1419 repeat 1420 SearchRec.Name := Copy(SearchRec.Name, 1, Length(SearchRec.Name) - 10); 1421 if GetTribeInfo(SearchRec.Name, Name, Color) then 1422 UnusedTribeFiles.AddObject(SearchRec.Name, TObject(Color)); 1423 until FindNext(SearchRec) <> 0; 1424 FindClose(SearchRec); 1425 end; 1426 1427 function TMainScreen.ChooseUnusedTribe: integer; 1428 var 1429 i, j, ColorDistance, BestColorDistance, TestColorDistance, 1430 CountBest: integer; 1431 begin 1432 assert(UnusedTribeFiles.Count > 0); 1433 result := -1; 1434 BestColorDistance := -1; 1435 for j := 0 to UnusedTribeFiles.Count - 1 do 1436 begin 1437 ColorDistance := 250; // consider differences more than this infinite 1438 for i := 0 to nPl - 1 do 1439 if Tribe[i] <> nil then 1440 begin 1441 TestColorDistance := abs(integer(UnusedTribeFiles.Objects[j]) 1442 shr 16 and $FF - Tribe[i].Color shr 16 and $FF) + 1443 abs(integer(UnusedTribeFiles.Objects[j]) shr 8 and 1444 $FF - Tribe[i].Color shr 8 and $FF) * 3 + 1445 abs(integer(UnusedTribeFiles.Objects[j]) and 1446 $FF - Tribe[i].Color and $FF) * 2; 1447 if TestColorDistance < ColorDistance then 1448 ColorDistance := TestColorDistance 1449 end; 1450 if ColorDistance > BestColorDistance then 1451 begin 1452 CountBest := 0; 1453 BestColorDistance := ColorDistance 1311 1454 end; 1312 if ok then 1313 repeat 1314 SearchRec.Name := Copy(SearchRec.Name, 1, Length(SearchRec.Name) - 10); 1315 if GetTribeInfo(SearchRec.Name, Name, Color) then 1316 UnusedTribeFiles.AddObject(SearchRec.Name, TObject(Color)); 1317 until FindNext(SearchRec) <> 0; 1318 FindClose(SearchRec); 1319 end; 1320 1321 function ChooseUnusedTribe: integer; 1322 var 1323 i, j, ColorDistance, BestColorDistance, TestColorDistance, 1324 CountBest: integer; 1325 begin 1326 assert(UnusedTribeFiles.Count > 0); 1327 result := -1; 1328 BestColorDistance := -1; 1329 for j := 0 to UnusedTribeFiles.Count - 1 do 1330 begin 1331 ColorDistance := 250; // consider differences more than this infinite 1332 for i := 0 to nPl - 1 do 1333 if Tribe[i] <> nil then 1334 begin 1335 TestColorDistance := abs(integer(UnusedTribeFiles.Objects[j]) 1336 shr 16 and $FF - Tribe[i].Color shr 16 and $FF) + 1337 abs(integer(UnusedTribeFiles.Objects[j]) shr 8 and 1338 $FF - Tribe[i].Color shr 8 and $FF) * 3 + 1339 abs(integer(UnusedTribeFiles.Objects[j]) and 1340 $FF - Tribe[i].Color and $FF) * 2; 1341 if TestColorDistance < ColorDistance then 1342 ColorDistance := TestColorDistance 1455 if ColorDistance = BestColorDistance then 1456 begin 1457 inc(CountBest); 1458 if DelphiRandom(CountBest) = 0 then 1459 result := j 1460 end 1461 end; 1462 end; 1463 1464 procedure TMainScreen.ShowEnemyShipChange(ShowShipChange: TShowShipChange); 1465 var 1466 i, TestCost, MostCost: integer; 1467 Ship1Plus, Ship2Plus: boolean; 1468 begin 1469 with ShowShipChange, MessgExDlg do 1470 begin 1471 case Reason of 1472 scrProduction: 1473 begin 1474 OpenSound := 'SHIP_BUILT'; 1475 MessgText := Tribe[Ship1Owner].TPhrase('SHIPBUILT'); 1476 IconKind := mikShip; 1477 IconIndex := Ship1Owner; 1343 1478 end; 1344 if ColorDistance > BestColorDistance then 1345 begin 1346 CountBest := 0; 1347 BestColorDistance := ColorDistance 1479 1480 scrDestruction: 1481 begin 1482 OpenSound := 'SHIP_DESTROYED'; 1483 MessgText := Tribe[Ship1Owner].TPhrase('SHIPDESTROYED'); 1484 IconKind := mikImp; 1485 end; 1486 1487 scrTrade: 1488 begin 1489 OpenSound := 'SHIP_TRADED'; 1490 Ship1Plus := false; 1491 Ship2Plus := false; 1492 for i := 0 to nShipPart - 1 do 1493 begin 1494 if Ship1Change[i] > 0 then 1495 Ship1Plus := true; 1496 if Ship2Change[i] > 0 then 1497 Ship2Plus := true; 1498 end; 1499 if Ship1Plus and Ship2Plus then 1500 MessgText := Tribe[Ship1Owner].TPhrase('SHIPBITRADE1') + ' ' + 1501 Tribe[Ship2Owner].TPhrase('SHIPBITRADE2') 1502 else if Ship1Plus then 1503 MessgText := Tribe[Ship1Owner].TPhrase('SHIPUNITRADE1') + ' ' + 1504 Tribe[Ship2Owner].TPhrase('SHIPUNITRADE2') 1505 else // if Ship2Plus then 1506 MessgText := Tribe[Ship2Owner].TPhrase('SHIPUNITRADE1') + ' ' + 1507 Tribe[Ship1Owner].TPhrase('SHIPUNITRADE2'); 1508 IconKind := mikImp; 1509 end; 1510 1511 scrCapture: 1512 begin 1513 OpenSound := 'SHIP_CAPTURED'; 1514 MessgText := Tribe[Ship2Owner].TPhrase('SHIPCAPTURE1') + ' ' + 1515 Tribe[Ship1Owner].TPhrase('SHIPCAPTURE2'); 1516 IconKind := mikShip; 1517 IconIndex := Ship2Owner; 1518 end 1519 end; 1520 1521 if IconKind = mikImp then 1522 begin 1523 MostCost := 0; 1524 for i := 0 to nShipPart - 1 do 1525 begin 1526 TestCost := abs(Ship1Change[i]) * Imp[imShipComp + i].Cost; 1527 if TestCost > MostCost then 1528 begin 1529 MostCost := TestCost; 1530 IconIndex := imShipComp + i 1531 end 1348 1532 end; 1349 if ColorDistance = BestColorDistance then1350 begin1351 inc(CountBest);1352 if DelphiRandom(CountBest) = 0 then1353 result := j1354 end1355 1533 end; 1356 end; 1357 1358 procedure ShowEnemyShipChange(ShowShipChange: TShowShipChange); 1359 var 1360 i, TestCost, MostCost: integer; 1361 Ship1Plus, Ship2Plus: boolean; 1362 begin 1363 with ShowShipChange, MessgExDlg do 1364 begin 1365 case Reason of 1366 scrProduction: 1367 begin 1368 OpenSound := 'SHIP_BUILT'; 1369 MessgText := Tribe[Ship1Owner].TPhrase('SHIPBUILT'); 1370 IconKind := mikShip; 1371 IconIndex := Ship1Owner; 1372 end; 1373 1374 scrDestruction: 1375 begin 1376 OpenSound := 'SHIP_DESTROYED'; 1377 MessgText := Tribe[Ship1Owner].TPhrase('SHIPDESTROYED'); 1378 IconKind := mikImp; 1379 end; 1380 1381 scrTrade: 1382 begin 1383 OpenSound := 'SHIP_TRADED'; 1384 Ship1Plus := false; 1385 Ship2Plus := false; 1386 for i := 0 to nShipPart - 1 do 1387 begin 1388 if Ship1Change[i] > 0 then 1389 Ship1Plus := true; 1390 if Ship2Change[i] > 0 then 1391 Ship2Plus := true; 1392 end; 1393 if Ship1Plus and Ship2Plus then 1394 MessgText := Tribe[Ship1Owner].TPhrase('SHIPBITRADE1') + ' ' + 1395 Tribe[Ship2Owner].TPhrase('SHIPBITRADE2') 1396 else if Ship1Plus then 1397 MessgText := Tribe[Ship1Owner].TPhrase('SHIPUNITRADE1') + ' ' + 1398 Tribe[Ship2Owner].TPhrase('SHIPUNITRADE2') 1399 else // if Ship2Plus then 1400 MessgText := Tribe[Ship2Owner].TPhrase('SHIPUNITRADE1') + ' ' + 1401 Tribe[Ship1Owner].TPhrase('SHIPUNITRADE2'); 1402 IconKind := mikImp; 1403 end; 1404 1405 scrCapture: 1406 begin 1407 OpenSound := 'SHIP_CAPTURED'; 1408 MessgText := Tribe[Ship2Owner].TPhrase('SHIPCAPTURE1') + ' ' + 1409 Tribe[Ship1Owner].TPhrase('SHIPCAPTURE2'); 1410 IconKind := mikShip; 1411 IconIndex := Ship2Owner; 1412 end 1413 end; 1414 1415 if IconKind = mikImp then 1416 begin 1417 MostCost := 0; 1418 for i := 0 to nShipPart - 1 do 1419 begin 1420 TestCost := abs(Ship1Change[i]) * Imp[imShipComp + i].Cost; 1421 if TestCost > MostCost then 1422 begin 1423 MostCost := TestCost; 1424 IconIndex := imShipComp + i 1425 end 1426 end; 1427 end; 1428 1429 Kind := mkOk; 1430 ShowModal; 1431 end; 1432 end; 1433 1434 procedure InitModule; 1435 var 1436 x, y, i, j, Domain: integer; 1437 begin 1438 { search icons for advances: } 1439 for i := 0 to nAdv - 1 do 1440 if i in FutureTech then 1441 AdvIcon[i] := 96 + i - futResearchTechnology 1442 else 1443 begin 1444 AdvIcon[i] := -1; 1445 for Domain := 0 to nDomains - 1 do 1446 for j := 0 to nUpgrade - 1 do 1447 if upgrade[Domain, j].Preq = i then 1448 if AdvIcon[i] >= 0 then 1534 1535 Kind := mkOk; 1536 ShowModal; 1537 end; 1538 end; 1539 1540 procedure TMainScreen.InitModule; 1541 var 1542 x, y, i, j, Domain: integer; 1543 begin 1544 { search icons for advances: } 1545 for i := 0 to nAdv - 1 do 1546 if i in FutureTech then 1547 AdvIcon[i] := 96 + i - futResearchTechnology 1548 else 1549 begin 1550 AdvIcon[i] := -1; 1551 for Domain := 0 to nDomains - 1 do 1552 for j := 0 to nUpgrade - 1 do 1553 if upgrade[Domain, j].Preq = i then 1554 if AdvIcon[i] >= 0 then 1555 AdvIcon[i] := 85 1556 else 1557 AdvIcon[i] := 86 + Domain; 1558 for j := 0 to nFeature - 1 do 1559 if Feature[j].Preq = i then 1560 for Domain := 0 to nDomains - 1 do 1561 if 1 shl Domain and Feature[j].Domains <> 0 then 1562 if (AdvIcon[i] >= 0) and (AdvIcon[i] <> 86 + Domain) then 1449 1563 AdvIcon[i] := 85 1450 1564 else 1451 1565 AdvIcon[i] := 86 + Domain; 1452 for j := 0 to nFeature - 1 do 1453 if Feature[j].Preq = i then 1454 for Domain := 0 to nDomains - 1 do 1455 if 1 shl Domain and Feature[j].Domains <> 0 then 1456 if (AdvIcon[i] >= 0) and (AdvIcon[i] <> 86 + Domain) then 1457 AdvIcon[i] := 85 1458 else 1459 AdvIcon[i] := 86 + Domain; 1460 for j := 28 to nImp - 1 do 1461 if Imp[j].Preq = i then 1462 AdvIcon[i] := j; 1463 for j := 28 to nImp - 1 do 1464 if (Imp[j].Preq = i) and (Imp[j].Kind <> ikCommon) then 1465 AdvIcon[i] := j; 1466 for j := 0 to nJob - 1 do 1467 if i = JobPreq[j] then 1468 AdvIcon[i] := 84; 1469 for j := 0 to 27 do 1470 if Imp[j].Preq = i then 1471 AdvIcon[i] := j; 1472 if AdvIcon[i] < 0 then 1473 if AdvValue[i] < 1000 then 1474 AdvIcon[i] := -7 1475 else 1476 AdvIcon[i] := 24 + AdvValue[i] div 1000; 1477 for j := 2 to nGov - 1 do 1478 if GovPreq[j] = i then 1479 AdvIcon[i] := j - 8; 1480 end; 1481 AdvIcon[adConscription] := 86 + dGround; 1482 1483 UnusedTribeFiles := tstringlist.Create; 1484 UnusedTribeFiles.Sorted := true; 1485 TribeNames := tstringlist.Create; 1486 1487 for x := 0 to 11 do 1488 for y := 0 to 1 do 1489 MiniColors[x, y] := GrExt[HGrSystem].Data.Canvas.Pixels[66 + x, 67 + y]; 1490 IsoEngine.Init(InitEnemyModel); 1491 if not IsoEngine.ApplyTileSize(xxt, yyt) and ((xxt <> 48) or (yyt <> 24)) 1492 then 1493 ApplyTileSize(48, 24); 1494 // non-default tile size is missing a file, switch to default 1495 MainMap := TIsoMap.Create; 1496 MainMap.SetOutput(offscreen); 1497 1498 HGrStdUnits := LoadGraphicSet('StdUnits.png'); 1499 SmallImp := TDpiBitmap.Create; 1500 SmallImp.PixelFormat := pf24bit; 1501 InitSmallImp; 1502 SoundPreloadDone := 0; 1503 StartRunning := false; 1504 StayOnTop_Ensured := false; 1505 1506 sb := TPVScrollbar.Create(Self); 1507 sb.OnUpdate := ScrollBarUpdate; 1508 end; { InitModule } 1509 1510 // sound blocks for preload 1566 for j := 28 to nImp - 1 do 1567 if Imp[j].Preq = i then 1568 AdvIcon[i] := j; 1569 for j := 28 to nImp - 1 do 1570 if (Imp[j].Preq = i) and (Imp[j].Kind <> ikCommon) then 1571 AdvIcon[i] := j; 1572 for j := 0 to nJob - 1 do 1573 if i = JobPreq[j] then 1574 AdvIcon[i] := 84; 1575 for j := 0 to 27 do 1576 if Imp[j].Preq = i then 1577 AdvIcon[i] := j; 1578 if AdvIcon[i] < 0 then 1579 if AdvValue[i] < 1000 then 1580 AdvIcon[i] := -7 1581 else 1582 AdvIcon[i] := 24 + AdvValue[i] div 1000; 1583 for j := 2 to nGov - 1 do 1584 if GovPreq[j] = i then 1585 AdvIcon[i] := j - 8; 1586 end; 1587 AdvIcon[adConscription] := 86 + dGround; 1588 1589 UnusedTribeFiles := tstringlist.Create; 1590 UnusedTribeFiles.Sorted := true; 1591 TribeNames := tstringlist.Create; 1592 1593 for x := 0 to 11 do 1594 for y := 0 to 1 do 1595 MiniColors[x, y] := GrExt[HGrSystem].Data.Canvas.Pixels[66 + x, 67 + y]; 1596 IsoEngine.Init(InitEnemyModel); 1597 if not IsoEngine.ApplyTileSize(xxt, yyt) and ((xxt <> 48) or (yyt <> 24) or (xxt <> 72)) 1598 then 1599 ApplyTileSize(48, 24); 1600 // non-default tile size is missing a file, switch to default 1601 MainMap := TIsoMap.Create; 1602 MainMap.SetOutput(offscreen); 1603 1604 HGrStdUnits := LoadGraphicSet('StdUnits.png'); 1605 SmallImp := TDpiBitmap.Create; 1606 SmallImp.PixelFormat := pf24bit; 1607 InitSmallImp; 1608 SoundPreloadDone := 0; 1609 StartRunning := false; 1610 StayOnTop_Ensured := false; 1611 1612 sb := TPVScrollbar.Create(Self); 1613 sb.OnUpdate := ScrollBarUpdate; 1614 end; { InitModule } 1615 1616 procedure TMainScreen.InitTurn(NewPlayer: integer); 1511 1617 const 1512 sbStart = $01; 1513 sbWonder = $02; 1514 sbScience = $04; 1515 sbContact = $08; 1516 sbTurn = $10; 1517 sbAll = $FF; 1518 1519 procedure SoundPreload(Check: integer); 1520 const 1521 nStartBlock = 27; 1522 StartBlock: array [0 .. nStartBlock - 1] of string = ('INVALID', 'TURNEND', 1523 'DISBAND', 'CHEAT', 'MSG_DEFAULT', 'WARNING_DISORDER', 'WARNING_FAMINE', 1524 'WARNING_LOWSUPPORT', 'WARNING_LOWFUNDS', 'MOVE_MOUNTAIN', 'MOVE_LOAD', 1525 'MOVE_UNLOAD', 'MOVE_DIE', 'NOMOVE_TIME', 'NOMOVE_DOMAIN', 1526 'NOMOVE_DEFAULT', 'CITY_SELLIMP', 'CITY_REBUILDIMP', 'CITY_BUYPROJECT', 1527 'CITY_UTILIZE', 'NEWMODEL_0', 'NEWADVANCE_0', 'AGE_0', 'REVOLUTION', 1528 'NEWGOV', 'CITY_INVALIDTYPE', 'MSG_GAMEOVER'); 1529 1530 nWonderBlock = 6; 1531 WonderBlock: array [0 .. nWonderBlock - 1] of string = ('WONDER_BUILT', 1532 'WONDER_CAPTURED', 'WONDER_EXPIRED', 'WONDER_DESTROYED', 'MSG_COLDWAR', 1533 'NEWADVANCE_GRLIB'); 1534 1535 nScienceBlock = 17; 1536 ScienceBlock: array [0 .. nScienceBlock - 1] of string = ('MOVE_PARACHUTE', 1537 'MOVE_PLANESTART', 'MOVE_PLANELANDING', 'MOVE_COVERT', 'NEWMODEL_1', 1538 'NEWMODEL_2', 'NEWMODEL_3', 'NEWADVANCE_1', 'NEWADVANCE_2', 1539 'NEWADVANCE_3', 'AGE_1', 'AGE_2', 'AGE_3', 'SHIP_BUILT', 'SHIP_TRADED', 1540 'SHIP_CAPTURED', 'SHIP_DESTROYED'); 1541 1542 nContactBlock = 20; 1543 ContactBlock: array [0 .. nContactBlock - 1] of string = ('NEWTREATY', 1544 'CANCELTREATY', 'ACCEPTOFFER', 'MSG_WITHDRAW', 'MSG_BANKRUPT', 1545 'CONTACT_0', 'CONTACT_1', 'CONTACT_2', 'CONTACT_3', 'CONTACT_4', 1546 'CONTACT_5', 'CONTACT_5', 'CONTACT_6', 'NEGO_REJECTED', 'MOVE_CAPTURE', 1547 'MOVE_EXPEL', 'NOMOVE_TREATY', 'NOMOVE_ZOC', 'NOMOVE_SUBMARINE', 1548 'NOMOVE_STEALTH'); 1549 1550 var 1551 i, cix, mix: integer; 1552 need: boolean; 1553 mi: TModelInfo; 1554 begin 1555 if Check and sbStart and not SoundPreloadDone <> 0 then 1556 begin 1557 for i := 0 to nStartBlock - 1 do 1558 PreparePlay(StartBlock[i]); 1559 SoundPreloadDone := SoundPreloadDone or sbStart; 1560 end; 1561 if Check and sbWonder and not SoundPreloadDone <> 0 then 1562 begin 1563 need := false; 1564 for i := 0 to 27 do 1565 if MyRO.Wonder[i].CityID <> -1 then 1566 need := true; 1567 if need then 1568 begin 1569 for i := 0 to nWonderBlock - 1 do 1570 PreparePlay(WonderBlock[i]); 1571 SoundPreloadDone := SoundPreloadDone or sbWonder; 1572 end; 1573 end; 1574 if (Check and sbScience and not SoundPreloadDone <> 0) and 1575 (MyRO.Tech[adScience] >= tsApplicable) then 1576 begin 1577 for i := 0 to nScienceBlock - 1 do 1578 PreparePlay(ScienceBlock[i]); 1579 SoundPreloadDone := SoundPreloadDone or sbScience; 1580 end; 1581 if (Check and sbContact and not SoundPreloadDone <> 0) and 1582 (MyRO.nEnemyModel + MyRO.nEnemyCity > 0) then 1583 begin 1584 for i := 0 to nContactBlock - 1 do 1585 PreparePlay(ContactBlock[i]); 1586 SoundPreloadDone := SoundPreloadDone or sbContact; 1587 end; 1588 if Check and sbTurn <> 0 then 1589 begin 1590 if MyRO.Happened and phShipComplete <> 0 then 1591 PreparePlay('MSG_YOUWIN'); 1592 if MyData.ToldAlive <> MyRO.Alive then 1593 PreparePlay('MSG_EXTINCT'); 1594 for cix := 0 to MyRO.nCity - 1 do 1595 with MyCity[cix] do 1596 if (Loc >= 0) and (Flags and CityRepMask <> 0) then 1597 for i := 0 to 12 do 1598 if 1 shl i and Flags and CityRepMask <> 0 then 1599 PreparePlay(CityEventSoundItem[i]); 1600 for mix := 0 to MyRO.nModel - 1 do 1601 with MyModel[mix] do 1602 if Attack > 0 then 1603 begin 1604 MakeModelInfo(me, mix, MyModel[mix], mi); 1605 PreparePlay(AttackSound(ModelCode(mi))); 1606 end 1607 end 1608 end; 1609 1610 procedure InitTurn(p: integer); 1611 const 1612 nAdvBookIcon = 16; 1613 AdvBookIcon: array [0 .. nAdvBookIcon - 1] of record Adv, 1614 Icon: integer end = ((Adv: adPolyTheism; Icon: woZeus), 1615 (Adv: adBronzeWorking; Icon: woColossus), (Adv: adMapMaking; 1616 Icon: woLighthouse), (Adv: adPoetry; Icon: imTheater), (Adv: adMonotheism; 1617 Icon: woMich), (Adv: adPhilosophy; Icon: woLeo), (Adv: adTheoryOfGravity; 1618 Icon: woNewton), (Adv: adSteel; Icon: woEiffel), (Adv: adDemocracy; 1619 Icon: woLiberty), (Adv: adAutomobile; Icon: imHighways), 1620 (Adv: adSanitation; Icon: imSewer), (Adv: adElectronics; Icon: woHoover), 1621 (Adv: adNuclearFission; Icon: woManhattan), (Adv: adRecycling; 1622 Icon: imRecycling), (Adv: adComputers; Icon: imResLab), 1623 (Adv: adSpaceFlight; Icon: woMIR)); 1624 var 1625 Domain, p1, i, ad, uix, cix, MoveOptions, MoveResult, Loc1, Dist, 1626 NewAgeCenterTo, Bankrupt, ShipMore, Winners, NewGovAvailable, dx, 1627 dy: integer; 1628 MoveAdviceData: TMoveAdviceData; 1629 Picture: TModelPictureInfo; 1630 s, Item, Item2: string; 1631 UpdatePanel, OwnWonder, ok, Stop, ShowCityList, WondersOnly, 1632 AllowCityScreen: boolean; 1633 begin 1634 if IsMultiPlayerGame and (p <> me) then 1635 begin 1636 UnitInfoBtn.Visible := false; 1637 UnitBtn.Visible := false; 1638 TerrainBtn.Visible := false; 1639 EOT.Visible := false; 1640 end; 1641 if IsMultiPlayerGame and (p <> me) and 1642 (G.RO[0].Happened and phShipComplete = 0) then 1643 begin // inter player screen 1644 for i := 0 to ControlCount - 1 do 1645 if Controls[i] is TButtonC then 1646 Controls[i].Visible := false; 1647 me := -1; 1648 SetMainTextureByAge(-1); 1649 with Panel.Canvas do 1650 begin 1651 Brush.Color := $000000; 1652 FillRect(Rect(0, 0, Panel.width, Panel.height)); 1653 Brush.Style := bsClear; 1654 end; 1655 with TopBar.Canvas do 1656 begin 1657 Brush.Color := $000000; 1658 FillRect(Rect(0, 0, TopBar.width, TopBar.height)); 1659 Brush.Style := bsClear; 1660 end; 1661 Invalidate; 1662 1663 s := TurnToString(G.RO[0].Turn); 1664 if supervising then 1665 SimpleMessage(Format(Phrases.Lookup('SUPERTURN'), [s])) 1666 else 1667 SimpleMessage(Format(Tribe[NewPlayer].TPhrase('TURN'), [s])); 1668 end; 1618 nAdvBookIcon = 16; 1619 AdvBookIcon: array [0 .. nAdvBookIcon - 1] of record Adv, 1620 Icon: integer end = ((Adv: adPolyTheism; Icon: woZeus), 1621 (Adv: adBronzeWorking; Icon: woColossus), (Adv: adMapMaking; 1622 Icon: woLighthouse), (Adv: adPoetry; Icon: imTheater), (Adv: adMonotheism; 1623 Icon: woMich), (Adv: adPhilosophy; Icon: woLeo), (Adv: adTheoryOfGravity; 1624 Icon: woNewton), (Adv: adSteel; Icon: woEiffel), (Adv: adDemocracy; 1625 Icon: woLiberty), (Adv: adAutomobile; Icon: imHighways), 1626 (Adv: adSanitation; Icon: imSewer), (Adv: adElectronics; Icon: woHoover), 1627 (Adv: adNuclearFission; Icon: woManhattan), (Adv: adRecycling; 1628 Icon: imRecycling), (Adv: adComputers; Icon: imResLab), 1629 (Adv: adSpaceFlight; Icon: woMIR)); 1630 var 1631 p1, i, ad, uix, cix, MoveOptions, MoveResult, Loc1, 1632 NewAgeCenterTo, Winners, NewGovAvailable, dx, 1633 dy: integer; 1634 MoveAdviceData: TMoveAdviceData; 1635 Picture: TModelPictureInfo; 1636 s, Item, Item2: string; 1637 UpdatePanel, OwnWonder, ok, Stop, ShowCityList, WondersOnly, 1638 AllowCityScreen: boolean; 1639 begin 1640 if IsMultiPlayerGame and (NewPlayer <> me) then 1641 begin 1642 UnitInfoBtn.Visible := false; 1643 UnitBtn.Visible := false; 1644 TerrainBtn.Visible := false; 1645 EOT.Visible := false; 1646 end; 1647 if IsMultiPlayerGame and (NewPlayer <> me) and 1648 (G.RO[0].Happened and phShipComplete = 0) then 1649 begin // inter player screen 1669 1650 for i := 0 to ControlCount - 1 do 1670 1651 if Controls[i] is TButtonC then 1671 Controls[i].Visible := true; 1672 1673 ItsMeAgain(p); 1674 MyData := G.RO[p].Data; 1675 if not supervising then 1676 SoundPreload(sbAll); 1677 if (me = 0) and ((MyRO.Turn = 0) or (ClientMode = cResume)) then 1678 Invalidate; // colorize empty space 1679 1680 if not supervising then 1681 begin 1682 1683 { if MyRO.Happened and phGameEnd<>0 then 1684 begin 1685 Age:=3; 1686 SetMainTextureByAge(-1); 1652 Controls[i].Visible := false; 1653 me := -1; 1654 SetMainTextureByAge(-1); 1655 with Panel.Canvas do 1656 begin 1657 Brush.Color := $000000; 1658 FillRect(Rect(0, 0, Panel.width, Panel.height)); 1659 Brush.Style := bsClear; 1660 end; 1661 with TopBar.Canvas do 1662 begin 1663 Brush.Color := $000000; 1664 FillRect(Rect(0, 0, TopBar.width, TopBar.height)); 1665 Brush.Style := bsClear; 1666 end; 1667 Invalidate; 1668 1669 s := TurnToString(G.RO[0].Turn); 1670 if supervising then 1671 SimpleMessage(Format(Phrases.Lookup('SUPERTURN'), [s])) 1672 else 1673 SimpleMessage(Format(Tribe[NewPlayer].TPhrase('TURN'), [s])); 1674 end; 1675 for i := 0 to ControlCount - 1 do 1676 if Controls[i] is TButtonC then 1677 Controls[i].Visible := true; 1678 1679 ItsMeAgain(NewPlayer); 1680 MyData := G.RO[NewPlayer].Data; 1681 if not supervising then 1682 SoundPreload(sbAll); 1683 if (me = 0) and ((MyRO.Turn = 0) or (ClientMode = cResume)) then 1684 Invalidate; // colorize empty space 1685 1686 if not supervising then 1687 begin 1688 1689 { if MyRO.Happened and phGameEnd<>0 then 1690 begin 1691 Age:=3; 1692 SetMainTextureByAge(-1); 1693 end 1694 else } 1695 begin 1696 Age := GetAge(me); 1697 if SetMainTextureByAge(Age) then 1698 EOT.Invalidate; // has visible background parts in its bounds 1699 end; 1700 // age:=MyRO.Turn mod 4; //!!! 1701 if ClientMode = cMovieTurn then 1702 EOT.ButtonIndex := eotCancel 1703 else if ClientMode < scContact then 1704 EOT.ButtonIndex := eotGray 1705 else 1706 EOT.ButtonIndex := eotBackToNego; 1707 end 1708 else 1709 begin 1710 Age := 0; 1711 SetMainTextureByAge(-1); 1712 if ClientMode = cMovieTurn then 1713 EOT.ButtonIndex := eotCancel 1714 else 1715 EOT.ButtonIndex := eotBlinkOn; 1716 end; 1717 InitCityMark(MainTexture); 1718 CityDlg.CheckAge; 1719 NatStatDlg.CheckAge; 1720 UnitStatDlg.CheckAge; 1721 HelpDlg.Difficulty := G.Difficulty[me]; 1722 1723 UnFocus := -1; 1724 MarkCityLoc := -1; 1725 BlinkON := false; 1726 BlinkTime := -1; 1727 Tracking := false; 1728 TurnComplete := false; 1729 1730 if (ToldSlavery < 0) or 1731 ((ToldSlavery = 1) <> (MyRO.Wonder[woPyramids].EffectiveOwner >= 0)) then 1732 begin 1733 if MyRO.Wonder[woPyramids].EffectiveOwner >= 0 then 1734 ToldSlavery := 1 1735 else 1736 ToldSlavery := 0; 1737 for p1 := 0 to nPl - 1 do 1738 if (Tribe[p1] <> nil) and (Tribe[p1].mixSlaves >= 0) then 1739 with Picture do 1740 begin // replace unit picture 1741 mix := Tribe[p1].mixSlaves; 1742 if ToldSlavery = 1 then 1743 pix := pixSlaves 1744 else 1745 pix := pixNoSlaves; 1746 Hash := 0; 1747 GrName := 'StdUnits.png'; 1748 Tribe[p1].SetModelPicture(Picture, true); 1687 1749 end 1688 else } 1689 begin 1690 Age := GetAge(me); 1691 if SetMainTextureByAge(Age) then 1692 EOT.Invalidate; // has visible background parts in its bounds 1750 end; 1751 1752 if not supervising and (ClientMode = cTurn) then 1753 begin 1754 for cix := 0 to MyRO.nCity - 1 do 1755 if (MyCity[cix].Loc >= 0) and 1756 ((MyRO.Turn = 0) or (MyCity[cix].Flags and chFounded <> 0)) then 1757 MyCity[cix].Status := MyCity[cix].Status and 1758 not csResourceWeightsMask or (3 shl 4); 1759 // new city, set to maximum growth 1760 end; 1761 if (ClientMode = cTurn) or (ClientMode = cContinue) then 1762 CityOptimizer_BeginOfTurn; // maybe peace was made or has ended 1763 SumCities(TaxSum, ScienceSum); 1764 1765 if ClientMode = cMovieTurn then 1766 begin 1767 UnitInfoBtn.Visible := false; 1768 UnitBtn.Visible := false; 1769 TerrainBtn.Visible := false; 1770 EOT.Hint := Phrases.Lookup('BTN_STOP'); 1771 EOT.Visible := true; 1772 end 1773 else if ClientMode < scContact then 1774 begin 1775 UnitInfoBtn.Visible := UnFocus >= 0; 1776 UnitBtn.Visible := UnFocus >= 0; 1777 CheckTerrainBtnVisible; 1778 TurnComplete := supervising; 1779 EOT.Hint := Phrases.Lookup('BTN_ENDTURN'); 1780 EOT.Visible := Server(sTurn - sExecute, me, 0, nil^) >= rExecuted; 1781 end 1782 else 1783 begin 1784 UnitInfoBtn.Visible := false; 1785 UnitBtn.Visible := false; 1786 TerrainBtn.Visible := false; 1787 EOT.Hint := Phrases.Lookup('BTN_NEGO'); 1788 EOT.Visible := true; 1789 end; 1790 SetTroopLoc(-1); 1791 MapValid := false; 1792 NewAgeCenterTo := 0; 1793 if ((MyRO.Turn = 0) and not supervising or IsMultiPlayerGame or 1794 (ClientMode = cResume)) and (MyRO.nCity > 0) then 1795 begin 1796 Loc1 := MyCity[0].Loc; 1797 if (ClientMode = cTurn) and (MyRO.Turn = 0) then 1798 begin // move city out of center to not be covered by welcome screen 1799 dx := MapWidth div (xxt * 5); 1800 if dx > 5 then 1801 dx := 5; 1802 dy := MapHeight div (yyt * 5); 1803 if dy > 5 then 1804 dy := 5; 1805 if Loc1 >= G.lx * G.ly div 2 then 1806 begin 1807 NewAgeCenterTo := -1; 1808 Loc1 := dLoc(Loc1, -dx, -dy) 1809 end 1810 else 1811 begin 1812 NewAgeCenterTo := 1; 1813 Loc1 := dLoc(Loc1, -dx, dy); 1814 end 1815 end; 1816 Centre(Loc1) 1817 end; 1818 1819 for i := 0 to DpiScreen.FormCount - 1 do 1820 if DpiScreen.Forms[i] is TBufferedDrawDlg then 1821 DpiScreen.Forms[i].Enabled := true; 1822 1823 if ClientMode <> cResume then 1824 begin 1825 PaintAll; 1826 if (MyRO.Happened and phChangeGov <> 0) and (MyRO.NatBuilt[imPalace] > 0) 1827 then 1828 ImpImage(Panel.Canvas, ClientWidth - xPalace, yPalace, imPalace, 1829 gAnarchy { , GameMode<>cMovie } ); 1830 // first turn after anarchy -- don't show despotism palace! 1831 Update; 1832 for i := 0 to DpiScreen.FormCount - 1 do 1833 if (DpiScreen.Forms[i].Visible) and (DpiScreen.Forms[i] is TBufferedDrawDlg) 1834 then 1835 begin 1836 if @DpiScreen.Forms[i].OnShow <> nil then 1837 DpiScreen.Forms[i].OnShow(nil); 1838 DpiScreen.Forms[i].Invalidate; 1839 DpiScreen.Forms[i].Update; 1693 1840 end; 1694 // age:=MyRO.Turn mod 4; //!!! 1695 if ClientMode = cMovieTurn then 1696 EOT.ButtonIndex := eotCancel 1697 else if ClientMode < scContact then 1698 EOT.ButtonIndex := eotGray 1699 else 1700 EOT.ButtonIndex := eotBackToNego; 1701 end 1702 else 1703 begin 1704 Age := 0; 1705 SetMainTextureByAge(-1); 1706 if ClientMode = cMovieTurn then 1707 EOT.ButtonIndex := eotCancel 1708 else 1709 EOT.ButtonIndex := eotBlinkOn; 1710 end; 1711 InitCityMark(MainTexture); 1712 CityDlg.CheckAge; 1713 NatStatDlg.CheckAge; 1714 UnitStatDlg.CheckAge; 1715 HelpDlg.Difficulty := G.Difficulty[me]; 1716 1717 UnFocus := -1; 1718 MarkCityLoc := -1; 1719 BlinkON := false; 1720 BlinkTime := -1; 1721 Tracking := false; 1722 TurnComplete := false; 1723 1724 if (ToldSlavery < 0) or 1725 ((ToldSlavery = 1) <> (MyRO.Wonder[woPyramids].EffectiveOwner >= 0)) then 1726 begin 1727 if MyRO.Wonder[woPyramids].EffectiveOwner >= 0 then 1728 ToldSlavery := 1 1729 else 1730 ToldSlavery := 0; 1731 for p1 := 0 to nPl - 1 do 1732 if (Tribe[p1] <> nil) and (Tribe[p1].mixSlaves >= 0) then 1733 with Picture do 1734 begin // replace unit picture 1735 mix := Tribe[p1].mixSlaves; 1736 if ToldSlavery = 1 then 1737 pix := pixSlaves 1738 else 1739 pix := pixNoSlaves; 1740 Hash := 0; 1741 GrName := 'StdUnits.png'; 1742 Tribe[p1].SetModelPicture(Picture, true); 1841 1842 if MyRO.Happened and phGameEnd <> 0 then 1843 with MessgExDlg do 1844 begin // game ended 1845 if MyRO.Happened and phExtinct <> 0 then 1846 begin 1847 OpenSound := 'MSG_GAMEOVER'; 1848 MessgText := Tribe[me].TPhrase('GAMEOVER'); 1849 IconKind := mikBigIcon; 1850 IconIndex := 8; 1851 end 1852 else if MyRO.Happened and phShipComplete <> 0 then 1853 begin 1854 Winners := 0; 1855 for p1 := 0 to nPl - 1 do 1856 if 1 shl p1 and MyRO.Alive <> 0 then 1857 begin 1858 Winners := Winners or 1 shl p1; 1859 for i := 0 to nShipPart - 1 do 1860 if MyRO.Ship[p1].Parts[i] < ShipNeed[i] then 1861 Winners := Winners and not(1 shl p1); 1862 end; 1863 assert(Winners <> 0); 1864 if Winners and (1 shl me) <> 0 then 1865 begin 1866 s := ''; 1867 for p1 := 0 to nPl - 1 do 1868 if (p1 <> me) and (1 shl p1 and Winners <> 0) then 1869 if s = '' then 1870 s := Tribe[p1].TPhrase('SHORTNAME') 1871 else 1872 s := Format(Phrases.Lookup('SHAREDWIN_CONCAT'), 1873 [s, Tribe[p1].TPhrase('SHORTNAME')]); 1874 1875 OpenSound := 'MSG_YOUWIN'; 1876 MessgText := Tribe[me].TPhrase('MYSPACESHIP'); 1877 if s <> '' then 1878 MessgText := MessgText + '\' + 1879 Format(Phrases.Lookup('SHAREDWIN'), [s]); 1880 IconKind := mikBigIcon; 1881 IconIndex := 9; 1743 1882 end 1744 end; 1745 1746 if not supervising and (ClientMode = cTurn) then 1747 begin 1748 for cix := 0 to MyRO.nCity - 1 do 1749 if (MyCity[cix].Loc >= 0) and 1750 ((MyRO.Turn = 0) or (MyCity[cix].Flags and chFounded <> 0)) then 1751 MyCity[cix].Status := MyCity[cix].Status and 1752 not csResourceWeightsMask or (3 shl 4); 1753 // new city, set to maximum growth 1754 end; 1755 if (ClientMode = cTurn) or (ClientMode = cContinue) then 1756 CityOptimizer_BeginOfTurn; // maybe peace was made or has ended 1757 SumCities(TaxSum, ScienceSum); 1758 1759 if ClientMode = cMovieTurn then 1760 begin 1761 UnitInfoBtn.Visible := false; 1762 UnitBtn.Visible := false; 1763 TerrainBtn.Visible := false; 1764 EOT.Hint := Phrases.Lookup('BTN_STOP'); 1765 EOT.Visible := true; 1766 end 1767 else if ClientMode < scContact then 1768 begin 1769 UnitInfoBtn.Visible := UnFocus >= 0; 1770 UnitBtn.Visible := UnFocus >= 0; 1771 CheckTerrainBtnVisible; 1772 TurnComplete := supervising; 1773 EOT.Hint := Phrases.Lookup('BTN_ENDTURN'); 1774 EOT.Visible := Server(sTurn - sExecute, me, 0, nil^) >= rExecuted; 1775 end 1776 else 1777 begin 1778 UnitInfoBtn.Visible := false; 1779 UnitBtn.Visible := false; 1780 TerrainBtn.Visible := false; 1781 EOT.Hint := Phrases.Lookup('BTN_NEGO'); 1782 EOT.Visible := true; 1783 end; 1784 SetTroopLoc(-1); 1785 MapValid := false; 1786 NewAgeCenterTo := 0; 1787 if ((MyRO.Turn = 0) and not supervising or IsMultiPlayerGame or 1788 (ClientMode = cResume)) and (MyRO.nCity > 0) then 1789 begin 1790 Loc1 := MyCity[0].Loc; 1791 if (ClientMode = cTurn) and (MyRO.Turn = 0) then 1792 begin // move city out of center to not be covered by welcome screen 1793 dx := MapWidth div (xxt * 5); 1794 if dx > 5 then 1795 dx := 5; 1796 dy := MapHeight div (yyt * 5); 1797 if dy > 5 then 1798 dy := 5; 1799 if Loc1 >= G.lx * G.ly div 2 then 1800 begin 1801 NewAgeCenterTo := -1; 1802 Loc1 := dLoc(Loc1, -dx, -dy) 1803 end 1804 else 1805 begin 1806 NewAgeCenterTo := 1; 1807 Loc1 := dLoc(Loc1, -dx, dy); 1808 end 1809 end; 1810 Centre(Loc1) 1811 end; 1812 1813 for i := 0 to DpiScreen.FormCount - 1 do 1814 if DpiScreen.Forms[i] is TBufferedDrawDlg then 1815 DpiScreen.Forms[i].Enabled := true; 1816 1817 if ClientMode <> cResume then 1818 begin 1819 PaintAll; 1820 if (MyRO.Happened and phChangeGov <> 0) and (MyRO.NatBuilt[imPalace] > 0) 1821 then 1822 ImpImage(Panel.Canvas, ClientWidth - xPalace, yPalace, imPalace, 1823 gAnarchy { , GameMode<>cMovie } ); 1824 // first turn after anarchy -- don't show despotism palace! 1825 Update; 1826 for i := 0 to DpiScreen.FormCount - 1 do 1827 if (DpiScreen.Forms[i].Visible) and (DpiScreen.Forms[i] is TBufferedDrawDlg) 1828 then 1829 begin 1830 if @DpiScreen.Forms[i].OnShow <> nil then 1831 DpiScreen.Forms[i].OnShow(nil); 1832 DpiScreen.Forms[i].Invalidate; 1833 DpiScreen.Forms[i].Update; 1834 end; 1835 1836 if MyRO.Happened and phGameEnd <> 0 then 1837 with MessgExDlg do 1838 begin // game ended 1839 if MyRO.Happened and phExtinct <> 0 then 1840 begin 1841 OpenSound := 'MSG_GAMEOVER'; 1842 MessgText := Tribe[me].TPhrase('GAMEOVER'); 1843 IconKind := mikBigIcon; 1844 IconIndex := 8; 1845 end 1846 else if MyRO.Happened and phShipComplete <> 0 then 1847 begin 1848 Winners := 0; 1849 for p1 := 0 to nPl - 1 do 1850 if 1 shl p1 and MyRO.Alive <> 0 then 1851 begin 1852 Winners := Winners or 1 shl p1; 1853 for i := 0 to nShipPart - 1 do 1854 if MyRO.Ship[p1].Parts[i] < ShipNeed[i] then 1855 Winners := Winners and not(1 shl p1); 1856 end; 1857 assert(Winners <> 0); 1858 if Winners and (1 shl me) <> 0 then 1859 begin 1860 s := ''; 1861 for p1 := 0 to nPl - 1 do 1862 if (p1 <> me) and (1 shl p1 and Winners <> 0) then 1863 if s = '' then 1864 s := Tribe[p1].TPhrase('SHORTNAME') 1865 else 1866 s := Format(Phrases.Lookup('SHAREDWIN_CONCAT'), 1867 [s, Tribe[p1].TPhrase('SHORTNAME')]); 1868 1869 OpenSound := 'MSG_YOUWIN'; 1870 MessgText := Tribe[me].TPhrase('MYSPACESHIP'); 1871 if s <> '' then 1872 MessgText := MessgText + '\' + 1873 Format(Phrases.Lookup('SHAREDWIN'), [s]); 1874 IconKind := mikBigIcon; 1875 IconIndex := 9; 1876 end 1877 else 1878 begin 1879 assert(me = 0); 1880 OpenSound := 'MSG_GAMEOVER'; 1881 MessgText := ''; 1882 for p1 := 0 to nPl - 1 do 1883 if Winners and (1 shl p1) <> 0 then 1884 MessgText := MessgText + Tribe[p1].TPhrase('SPACESHIP1'); 1885 MessgText := MessgText + '\' + Phrases.Lookup('SPACESHIP2'); 1886 IconKind := mikEnemyShipComplete; 1887 end 1888 end 1889 else { if MyRO.Happened and fTimeUp<>0 then } 1883 else 1890 1884 begin 1891 1885 assert(me = 0); 1892 1886 OpenSound := 'MSG_GAMEOVER'; 1893 if not supervising then 1894 MessgText := Tribe[me].TPhrase('TIMEUP') 1895 else 1896 MessgText := Phrases.Lookup('TIMEUPSUPER'); 1897 IconKind := mikImp; 1898 IconIndex := 22; 1899 end; 1900 Kind := mkOk; 1901 ShowModal; 1902 if MyRO.Happened and phExtinct = 0 then 1903 begin 1904 p1 := 0; 1905 while (p1 < nPl - 1) and (Winners and (1 shl p1) = 0) do 1906 inc(p1); 1907 if MyRO.Happened and phShipComplete = 0 then 1908 DiaDlg.ShowNewContent_Charts(wmModal); 1909 end; 1910 TurnComplete := true; 1911 exit; 1887 MessgText := ''; 1888 for p1 := 0 to nPl - 1 do 1889 if Winners and (1 shl p1) <> 0 then 1890 MessgText := MessgText + Tribe[p1].TPhrase('SPACESHIP1'); 1891 MessgText := MessgText + '\' + Phrases.Lookup('SPACESHIP2'); 1892 IconKind := mikEnemyShipComplete; 1893 end 1894 end 1895 else { if MyRO.Happened and fTimeUp<>0 then } 1896 begin 1897 assert(me = 0); 1898 OpenSound := 'MSG_GAMEOVER'; 1899 if not supervising then 1900 MessgText := Tribe[me].TPhrase('TIMEUP') 1901 else 1902 MessgText := Phrases.Lookup('TIMEUPSUPER'); 1903 IconKind := mikImp; 1904 IconIndex := 22; 1912 1905 end; 1913 if not supervising and (1 shl me and MyRO.Alive = 0) then 1914 begin 1906 Kind := mkOk; 1907 ShowModal; 1908 if MyRO.Happened and phExtinct = 0 then 1909 begin 1910 p1 := 0; 1911 while (p1 < nPl - 1) and (Winners and (1 shl p1) = 0) do 1912 inc(p1); 1913 if MyRO.Happened and phShipComplete = 0 then 1914 DiaDlg.ShowNewContent_Charts(wmModal); 1915 end; 1915 1916 TurnComplete := true; 1916 1917 exit; 1917 1918 end; 1918 1919 if (ClientMode = cContinue) and 1920 (DipMem[me].SentCommand and $FF0F = scContact) then 1921 // contact was refused 1922 if MyRO.Treaty[DipMem[me].pContact] >= trPeace then 1923 ContactRefused(DipMem[me].pContact, 'FRREJECTED') 1924 else 1925 SoundMessage(Tribe[DipMem[me].pContact].TPhrase('FRREJECTED'), 1926 'NEGO_REJECTED'); 1927 1928 if not supervising and (Age > MyData.ToldAge) and 1929 ((Age > 0) or (ClientMode <> cMovieTurn)) then 1930 with MessgExDlg do 1931 begin 1932 if Age = 0 then 1919 if not supervising and (1 shl me and MyRO.Alive = 0) then 1920 begin 1921 TurnComplete := true; 1922 exit; 1923 end; 1924 1925 if (ClientMode = cContinue) and 1926 (DipMem[me].SentCommand and $FF0F = scContact) then 1927 // contact was refused 1928 if MyRO.Treaty[DipMem[me].pContact] >= trPeace then 1929 ContactRefused(DipMem[me].pContact, 'FRREJECTED') 1930 else 1931 SoundMessage(Tribe[DipMem[me].pContact].TPhrase('FRREJECTED'), 1932 'NEGO_REJECTED'); 1933 1934 if not supervising and (Age > MyData.ToldAge) and 1935 ((Age > 0) or (ClientMode <> cMovieTurn)) then 1936 with MessgExDlg do 1937 begin 1938 if Age = 0 then 1939 begin 1940 if Phrases2FallenBackToEnglish then 1933 1941 begin 1934 if Phrases2FallenBackToEnglish then 1935 begin 1936 s := Tribe[me].TPhrase('AGE0'); 1937 MessgText := 1938 Format(s, [TurnToString(MyRO.Turn), CityName(MyCity[0].ID)]) 1939 end 1940 else 1941 begin 1942 s := Tribe[me].TString(Phrases2.Lookup('AGE0')); 1943 MessgText := Format(s, [TurnToString(MyRO.Turn)]); 1944 end 1942 s := Tribe[me].TPhrase('AGE0'); 1943 MessgText := 1944 Format(s, [TurnToString(MyRO.Turn), CityName(MyCity[0].ID)]) 1945 1945 end 1946 1946 else 1947 1947 begin 1948 s := Tribe[me].T Phrase('AGE' + char(48 + Age));1948 s := Tribe[me].TString(Phrases2.Lookup('AGE0')); 1949 1949 MessgText := Format(s, [TurnToString(MyRO.Turn)]); 1950 end;1951 IconKind := mikAge;1952 IconIndex := Age;1953 { if age=0 then } Kind := mkOk1954 { else begin Kind:=mkOkHelp; HelpKind:=hkAdv; HelpNo:=AgePreq[age]; end };1955 CenterTo := NewAgeCenterTo;1956 OpenSound := 'AGE_' + char(48 + Age);1957 ShowModal;1958 MyData.ToldAge := Age;1959 if Age > 0 then1960 MyData.ToldTech[AgePreq[Age]] := MyRO.Tech[AgePreq[Age]];1961 end;1962 1963 if MyData.ToldAlive <> MyRO.Alive then1964 begin1965 for p1 := 0 to nPl - 1 do1966 if (MyData.ToldAlive - MyRO.Alive) and (1 shl p1) <> 0 then1967 with MessgExDlg do1968 begin1969 OpenSound := 'MSG_EXTINCT';1970 s := Tribe[p1].TPhrase('EXTINCT');1971 MessgText := Format(s, [TurnToString(MyRO.Turn)]);1972 if MyRO.Alive = 1 shl me then1973 MessgText := MessgText + Phrases.Lookup('EXTINCTALL');1974 Kind := mkOk;1975 IconKind := mikImp;1976 IconIndex := 21;1977 ShowModal;1978 end;1979 if (ClientMode <> cMovieTurn) and not supervising then1980 DiaDlg.ShowNewContent_Charts(wmModal);1981 end;1982 1983 // tell changes of own credibility1984 if not supervising then1985 begin1986 if RoughCredibility(MyRO.Credibility) <>1987 RoughCredibility(MyData.ToldOwnCredibility) then1988 begin1989 if RoughCredibility(MyRO.Credibility) >1990 RoughCredibility(MyData.ToldOwnCredibility) then1991 s := Phrases.Lookup('CREDUP')1992 else1993 s := Phrases.Lookup('CREDDOWN');1994 TribeMessage(me, Format(s, [Phrases.Lookup('CREDIBILITY',1995 RoughCredibility(MyRO.Credibility))]), '');1996 end;1997 MyData.ToldOwnCredibility := MyRO.Credibility;1998 end;1999 2000 for i := 0 to 27 do2001 begin2002 OwnWonder := false;2003 for cix := 0 to MyRO.nCity - 1 do2004 if (MyCity[cix].Loc >= 0) and (MyCity[cix].ID = MyRO.Wonder[i].CityID)2005 then2006 OwnWonder := true;2007 if MyRO.Wonder[i].CityID <> MyData.ToldWonders[i].CityID then2008 begin2009 if MyRO.Wonder[i].CityID = -2 then2010 with MessgExDlg do2011 begin { tell about destroyed wonders }2012 OpenSound := 'WONDER_DESTROYED';2013 MessgText := Format(Phrases.Lookup('WONDERDEST'),2014 [Phrases.Lookup('IMPROVEMENTS', i)]);2015 Kind := mkOkHelp;2016 HelpKind := hkImp;2017 HelpNo := i;2018 IconKind := mikImp;2019 IconIndex := i;2020 ShowModal;2021 end2022 else2023 begin2024 if i = woManhattan then2025 if MyRO.Wonder[i].EffectiveOwner > me then2026 MyData.ColdWarStart := MyRO.Turn - 12027 else2028 MyData.ColdWarStart := MyRO.Turn;2029 if not OwnWonder then2030 with MessgExDlg do2031 begin { tell about newly built wonders }2032 if i = woManhattan then2033 begin2034 OpenSound := 'MSG_COLDWAR';2035 s := Tribe[MyRO.Wonder[i].EffectiveOwner].TPhrase('COLDWAR')2036 end2037 else if MyRO.Wonder[i].EffectiveOwner >= 0 then2038 begin2039 OpenSound := 'WONDER_BUILT';2040 s := Tribe[MyRO.Wonder[i].EffectiveOwner]2041 .TPhrase('WONDERBUILT')2042 end2043 else2044 begin2045 OpenSound := 'MSG_DEFAULT';2046 s := Phrases.Lookup('WONDERBUILTEXP');2047 // already expired when built2048 end;2049 MessgText := Format(s, [Phrases.Lookup('IMPROVEMENTS', i),2050 CityName(MyRO.Wonder[i].CityID)]);2051 Kind := mkOkHelp;2052 HelpKind := hkImp;2053 HelpNo := i;2054 IconKind := mikImp;2055 IconIndex := i;2056 ShowModal;2057 end2058 1950 end 2059 1951 end 2060 else if (MyRO.Wonder[i].EffectiveOwner <> MyData.ToldWonders[i] 2061 .EffectiveOwner) and (MyRO.Wonder[i].CityID > -2) then 2062 if MyRO.Wonder[i].EffectiveOwner < 0 then 1952 else 1953 begin 1954 s := Tribe[me].TPhrase('AGE' + char(48 + Age)); 1955 MessgText := Format(s, [TurnToString(MyRO.Turn)]); 1956 end; 1957 IconKind := mikAge; 1958 IconIndex := Age; 1959 { if age=0 then } Kind := mkOk 1960 { else begin Kind:=mkOkHelp; HelpKind:=hkAdv; HelpNo:=AgePreq[age]; end }; 1961 CenterTo := NewAgeCenterTo; 1962 OpenSound := 'AGE_' + char(48 + Age); 1963 ShowModal; 1964 MyData.ToldAge := Age; 1965 if Age > 0 then 1966 MyData.ToldTech[AgePreq[Age]] := MyRO.Tech[AgePreq[Age]]; 1967 end; 1968 1969 if MyData.ToldAlive <> MyRO.Alive then 1970 begin 1971 for p1 := 0 to nPl - 1 do 1972 if (MyData.ToldAlive - MyRO.Alive) and (1 shl p1) <> 0 then 1973 with MessgExDlg do 2063 1974 begin 2064 if i <> woMIR then 2065 with MessgExDlg do 2066 begin { tell about expired wonders } 2067 OpenSound := 'WONDER_EXPIRED'; 2068 MessgText := Format(Phrases.Lookup('WONDEREXP'), 2069 [Phrases.Lookup('IMPROVEMENTS', i), 2070 CityName(MyRO.Wonder[i].CityID)]); 2071 Kind := mkOkHelp; 2072 HelpKind := hkImp; 2073 HelpNo := i; 2074 IconKind := mikImp; 2075 IconIndex := i; 2076 ShowModal; 1975 OpenSound := 'MSG_EXTINCT'; 1976 s := Tribe[p1].TPhrase('EXTINCT'); 1977 MessgText := Format(s, [TurnToString(MyRO.Turn)]); 1978 if MyRO.Alive = 1 shl me then 1979 MessgText := MessgText + Phrases.Lookup('EXTINCTALL'); 1980 Kind := mkOk; 1981 IconKind := mikImp; 1982 IconIndex := 21; 1983 ShowModal; 1984 end; 1985 if (ClientMode <> cMovieTurn) and not supervising then 1986 DiaDlg.ShowNewContent_Charts(wmModal); 1987 end; 1988 1989 // tell changes of own credibility 1990 if not supervising then 1991 begin 1992 if RoughCredibility(MyRO.Credibility) <> 1993 RoughCredibility(MyData.ToldOwnCredibility) then 1994 begin 1995 if RoughCredibility(MyRO.Credibility) > 1996 RoughCredibility(MyData.ToldOwnCredibility) then 1997 s := Phrases.Lookup('CREDUP') 1998 else 1999 s := Phrases.Lookup('CREDDOWN'); 2000 TribeMessage(me, Format(s, [Phrases.Lookup('CREDIBILITY', 2001 RoughCredibility(MyRO.Credibility))]), ''); 2002 end; 2003 MyData.ToldOwnCredibility := MyRO.Credibility; 2004 end; 2005 2006 for i := 0 to 27 do 2007 begin 2008 OwnWonder := false; 2009 for cix := 0 to MyRO.nCity - 1 do 2010 if (MyCity[cix].Loc >= 0) and (MyCity[cix].ID = MyRO.Wonder[i].CityID) 2011 then 2012 OwnWonder := true; 2013 if MyRO.Wonder[i].CityID <> MyData.ToldWonders[i].CityID then 2014 begin 2015 if MyRO.Wonder[i].CityID = -2 then 2016 with MessgExDlg do 2017 begin { tell about destroyed wonders } 2018 OpenSound := 'WONDER_DESTROYED'; 2019 MessgText := Format(Phrases.Lookup('WONDERDEST'), 2020 [Phrases.Lookup('IMPROVEMENTS', i)]); 2021 Kind := mkOkHelp; 2022 HelpKind := hkImp; 2023 HelpNo := i; 2024 IconKind := mikImp; 2025 IconIndex := i; 2026 ShowModal; 2027 end 2028 else 2029 begin 2030 if i = woManhattan then 2031 if MyRO.Wonder[i].EffectiveOwner > me then 2032 MyData.ColdWarStart := MyRO.Turn - 1 2033 else 2034 MyData.ColdWarStart := MyRO.Turn; 2035 if not OwnWonder then 2036 with MessgExDlg do 2037 begin { tell about newly built wonders } 2038 if i = woManhattan then 2039 begin 2040 OpenSound := 'MSG_COLDWAR'; 2041 s := Tribe[MyRO.Wonder[i].EffectiveOwner].TPhrase('COLDWAR') 2077 2042 end 2078 end 2079 else if (MyData.ToldWonders[i].EffectiveOwner >= 0) and not OwnWonder 2080 then 2081 with MessgExDlg do 2082 begin { tell about capture of wonders } 2083 OpenSound := 'WONDER_CAPTURED'; 2084 s := Tribe[MyRO.Wonder[i].EffectiveOwner].TPhrase('WONDERCAPT'); 2043 else if MyRO.Wonder[i].EffectiveOwner >= 0 then 2044 begin 2045 OpenSound := 'WONDER_BUILT'; 2046 s := Tribe[MyRO.Wonder[i].EffectiveOwner] 2047 .TPhrase('WONDERBUILT') 2048 end 2049 else 2050 begin 2051 OpenSound := 'MSG_DEFAULT'; 2052 s := Phrases.Lookup('WONDERBUILTEXP'); 2053 // already expired when built 2054 end; 2085 2055 MessgText := Format(s, [Phrases.Lookup('IMPROVEMENTS', i), 2086 2056 CityName(MyRO.Wonder[i].CityID)]); … … 2091 2061 IconIndex := i; 2092 2062 ShowModal; 2093 end; 2094 end; 2095 2096 if MyRO.Turn = MyData.ColdWarStart + ColdWarTurns then 2097 begin 2098 SoundMessageEx(Phrases.Lookup('COLDWAREND'), 'MSG_DEFAULT'); 2099 MyData.ColdWarStart := -ColdWarTurns - 1 2100 end; 2101 2102 TellNewModels; 2103 end; // ClientMode<>cResume 2104 MyData.ToldAlive := MyRO.Alive; 2105 move(MyRO.Wonder, MyData.ToldWonders, SizeOf(MyData.ToldWonders)); 2106 2107 NewGovAvailable := -1; 2108 if ClientMode <> cResume then 2109 begin // tell about new techs 2110 for ad := 0 to nAdv - 1 do 2111 if (MyRO.TestFlags and tfAllTechs = 0) and 2112 ((MyRO.Tech[ad] >= tsApplicable) <> (MyData.ToldTech[ad] >= 2113 tsApplicable)) or (ad in FutureTech) and 2114 (MyRO.Tech[ad] <> MyData.ToldTech[ad]) then 2063 end 2064 end 2065 end 2066 else if (MyRO.Wonder[i].EffectiveOwner <> MyData.ToldWonders[i] 2067 .EffectiveOwner) and (MyRO.Wonder[i].CityID > -2) then 2068 if MyRO.Wonder[i].EffectiveOwner < 0 then 2069 begin 2070 if i <> woMIR then 2071 with MessgExDlg do 2072 begin { tell about expired wonders } 2073 OpenSound := 'WONDER_EXPIRED'; 2074 MessgText := Format(Phrases.Lookup('WONDEREXP'), 2075 [Phrases.Lookup('IMPROVEMENTS', i), 2076 CityName(MyRO.Wonder[i].CityID)]); 2077 Kind := mkOkHelp; 2078 HelpKind := hkImp; 2079 HelpNo := i; 2080 IconKind := mikImp; 2081 IconIndex := i; 2082 ShowModal; 2083 end 2084 end 2085 else if (MyData.ToldWonders[i].EffectiveOwner >= 0) and not OwnWonder 2086 then 2115 2087 with MessgExDlg do 2116 begin 2117 Item := 'RESEARCH_GENERAL'; 2118 if GameMode <> cMovie then 2119 OpenSound := 'NEWADVANCE_' + char(48 + Age); 2120 Item2 := Phrases.Lookup('ADVANCES', ad); 2121 if ad in FutureTech then 2122 Item2 := Item2 + ' ' + IntToStr(MyRO.Tech[ad]); 2123 MessgText := Format(Phrases.Lookup(Item), [Item2]); 2088 begin { tell about capture of wonders } 2089 OpenSound := 'WONDER_CAPTURED'; 2090 s := Tribe[MyRO.Wonder[i].EffectiveOwner].TPhrase('WONDERCAPT'); 2091 MessgText := Format(s, [Phrases.Lookup('IMPROVEMENTS', i), 2092 CityName(MyRO.Wonder[i].CityID)]); 2124 2093 Kind := mkOkHelp; 2125 HelpKind := hkAdv; 2126 HelpNo := ad; 2127 IconKind := mikBook; 2128 IconIndex := -1; 2129 for i := 0 to nAdvBookIcon - 1 do 2130 if AdvBookIcon[i].Adv = ad then 2131 IconIndex := AdvBookIcon[i].Icon; 2094 HelpKind := hkImp; 2095 HelpNo := i; 2096 IconKind := mikImp; 2097 IconIndex := i; 2132 2098 ShowModal; 2133 MyData.ToldTech[ad] := MyRO.Tech[ad];2134 for i := gMonarchy to nGov - 1 do2135 if GovPreq[i] = ad then2136 NewGovAvailable := i;2137 2099 end; 2138 2100 end; 2139 2101 2140 ShowCityList := false; 2141 if ClientMode = cTurn then 2142 begin 2143 if (MyRO.Happened and phTech <> 0) and (MyData.FarTech <> adNexus) then 2144 ChooseResearch; 2145 2146 UpdatePanel := false; 2147 if MyRO.Happened and phChangeGov <> 0 then 2148 begin 2149 ModalSelectDlg.ShowNewContent(wmModal, kGov); 2150 Play('NEWGOV'); 2151 Server(sSetGovernment, me, ModalSelectDlg.result, nil^); 2152 CityOptimizer_BeginOfTurn; 2153 UpdatePanel := true; 2154 end; 2155 end; // ClientMode=cTurn 2156 2157 if not supervising and ((ClientMode = cTurn) or (ClientMode = cMovieTurn)) 2158 then 2102 if MyRO.Turn = MyData.ColdWarStart + ColdWarTurns then 2103 begin 2104 SoundMessageEx(Phrases.Lookup('COLDWAREND'), 'MSG_DEFAULT'); 2105 MyData.ColdWarStart := -ColdWarTurns - 1 2106 end; 2107 2108 TellNewModels; 2109 end; // ClientMode<>cResume 2110 MyData.ToldAlive := MyRO.Alive; 2111 move(MyRO.Wonder, MyData.ToldWonders, SizeOf(MyData.ToldWonders)); 2112 2113 NewGovAvailable := -1; 2114 if ClientMode <> cResume then 2115 begin // tell about new techs 2116 for ad := 0 to nAdv - 1 do 2117 if (MyRO.TestFlags and tfAllTechs = 0) and 2118 ((MyRO.Tech[ad] >= tsApplicable) <> (MyData.ToldTech[ad] >= 2119 tsApplicable)) or (ad in FutureTech) and 2120 (MyRO.Tech[ad] <> MyData.ToldTech[ad]) then 2121 with MessgExDlg do 2122 begin 2123 Item := 'RESEARCH_GENERAL'; 2124 if GameMode <> cMovie then 2125 OpenSound := 'NEWADVANCE_' + char(48 + Age); 2126 Item2 := Phrases.Lookup('ADVANCES', ad); 2127 if ad in FutureTech then 2128 Item2 := Item2 + ' ' + IntToStr(MyRO.Tech[ad]); 2129 MessgText := Format(Phrases.Lookup(Item), [Item2]); 2130 Kind := mkOkHelp; 2131 HelpKind := hkAdv; 2132 HelpNo := ad; 2133 IconKind := mikBook; 2134 IconIndex := -1; 2135 for i := 0 to nAdvBookIcon - 1 do 2136 if AdvBookIcon[i].Adv = ad then 2137 IconIndex := AdvBookIcon[i].Icon; 2138 ShowModal; 2139 MyData.ToldTech[ad] := MyRO.Tech[ad]; 2140 for i := gMonarchy to nGov - 1 do 2141 if GovPreq[i] = ad then 2142 NewGovAvailable := i; 2143 end; 2144 end; 2145 2146 ShowCityList := false; 2147 if ClientMode = cTurn then 2148 begin 2149 if (MyRO.Happened and phTech <> 0) and (MyData.FarTech <> adNexus) then 2150 ChooseResearch; 2151 2152 UpdatePanel := false; 2153 if MyRO.Happened and phChangeGov <> 0 then 2154 begin 2155 ModalSelectDlg.ShowNewContent(wmModal, kGov); 2156 Play('NEWGOV'); 2157 Server(sSetGovernment, me, ModalSelectDlg.result, nil^); 2158 CityOptimizer_BeginOfTurn; 2159 UpdatePanel := true; 2160 end; 2161 end; // ClientMode=cTurn 2162 2163 if not supervising and ((ClientMode = cTurn) or (ClientMode = cMovieTurn)) 2164 then 2165 for cix := 0 to MyRO.nCity - 1 do 2166 with MyCity[cix] do 2167 Status := Status and not csToldBombard; 2168 2169 if ((ClientMode = cTurn) or (ClientMode = cMovieTurn)) and 2170 (MyRO.Government <> gAnarchy) then 2171 begin 2172 // tell what happened in cities 2173 for WondersOnly := true downto false do 2159 2174 for cix := 0 to MyRO.nCity - 1 do 2160 2175 with MyCity[cix] do 2161 Status := Status and not csToldBombard; 2162 2163 if ((ClientMode = cTurn) or (ClientMode = cMovieTurn)) and 2164 (MyRO.Government <> gAnarchy) then 2165 begin 2166 // tell what happened in cities 2167 for WondersOnly := true downto false do 2168 for cix := 0 to MyRO.nCity - 1 do 2169 with MyCity[cix] do 2170 if (MyRO.Turn > 0) and (Loc >= 0) and (Flags and chCaptured = 0) and 2171 (WondersOnly = (Flags and chProduction <> 0) and 2172 (Project0 and cpImp <> 0) and (Project0 and cpIndex < 28)) then 2176 if (MyRO.Turn > 0) and (Loc >= 0) and (Flags and chCaptured = 0) and 2177 (WondersOnly = (Flags and chProduction <> 0) and 2178 (Project0 and cpImp <> 0) and (Project0 and cpIndex < 28)) then 2179 begin 2180 if WondersOnly then 2181 with MessgExDlg do 2182 begin { tell about newly built wonder } 2183 OpenSound := 'WONDER_BUILT'; 2184 s := Tribe[me].TPhrase('WONDERBUILTOWN'); 2185 MessgText := 2186 Format(s, [Phrases.Lookup('IMPROVEMENTS', 2187 Project0 and cpIndex), CityName(ID)]); 2188 Kind := mkOkHelp; 2189 HelpKind := hkImp; 2190 HelpNo := Project0 and cpIndex; 2191 IconKind := mikImp; 2192 IconIndex := Project0 and cpIndex; 2193 ShowModal; 2194 end; 2195 if not supervising and (ClientMode = cTurn) then 2173 2196 begin 2174 if WondersOnly then 2175 with MessgExDlg do 2176 begin { tell about newly built wonder } 2177 OpenSound := 'WONDER_BUILT'; 2178 s := Tribe[me].TPhrase('WONDERBUILTOWN'); 2179 MessgText := 2180 Format(s, [Phrases.Lookup('IMPROVEMENTS', 2181 Project0 and cpIndex), CityName(ID)]); 2182 Kind := mkOkHelp; 2183 HelpKind := hkImp; 2184 HelpNo := Project0 and cpIndex; 2185 IconKind := mikImp; 2186 IconIndex := Project0 and cpIndex; 2187 ShowModal; 2188 end; 2189 if not supervising and (ClientMode = cTurn) then 2197 AllowCityScreen := true; 2198 if (Status and 7 <> 0) and 2199 (Project and (cpImp + cpIndex) = cpImp + imTrGoods) then 2200 if (MyData.ImpOrder[Status and 7 - 1, 0] >= 0) then 2201 begin 2202 if AutoBuild(cix, MyData.ImpOrder[Status and 7 - 1]) then 2203 AllowCityScreen := false 2204 else if Flags and chProduction <> 0 then 2205 Flags := (Flags and not chProduction) or chAllImpsMade 2206 end 2207 else 2208 Flags := Flags or chTypeDel; 2209 if (Size >= NeedAqueductSize) and 2210 (MyRO.Tech[Imp[imAqueduct].Preq] < tsApplicable) or 2211 (Size >= NeedSewerSize) and 2212 (MyRO.Tech[Imp[imSewer].Preq] < tsApplicable) then 2213 Flags := Flags and not chNoGrowthWarning; 2214 // don't remind of unknown building 2215 if Flags and chNoSettlerProd = 0 then 2216 Status := Status and not csToldDelay 2217 else if Status and csToldDelay = 0 then 2218 Status := Status or csToldDelay 2219 else 2220 Flags := Flags and not chNoSettlerProd; 2221 if mRepScreens.Checked then 2190 2222 begin 2191 AllowCityScreen := true; 2192 if (Status and 7 <> 0) and 2193 (Project and (cpImp + cpIndex) = cpImp + imTrGoods) then 2194 if (MyData.ImpOrder[Status and 7 - 1, 0] >= 0) then 2223 if (Flags and CityRepMask <> 0) and AllowCityScreen then 2224 begin { show what happened in cities } 2225 SetTroopLoc(MyCity[cix].Loc); 2226 MarkCityLoc := MyCity[cix].Loc; 2227 PanelPaint; 2228 CityDlg.CloseAction := None; 2229 CityDlg.ShowNewContent(wmModal, MyCity[cix].Loc, 2230 Flags and CityRepMask); 2231 UpdatePanel := true; 2232 end 2233 end 2234 else { if mRepList.Checked then } 2235 begin 2236 if Flags and CityRepMask <> 0 then 2237 ShowCityList := true 2238 end 2239 end 2240 end; { city loop } 2241 end; // ClientMode=cTurn 2242 2243 if ClientMode = cTurn then 2244 begin 2245 if NewGovAvailable >= 0 then 2246 with MessgExDlg do 2247 begin 2248 MessgText := Format(Phrases.Lookup('AUTOREVOLUTION'), 2249 [Phrases.Lookup('GOVERNMENT', NewGovAvailable)]); 2250 Kind := mkYesNo; 2251 IconKind := mikPureIcon; 2252 IconIndex := 6 + NewGovAvailable; 2253 ShowModal; 2254 if ModalResult = mrOK then 2255 begin 2256 Play('REVOLUTION'); 2257 Server(sRevolution, me, 0, nil^); 2258 end 2259 end; 2260 end; // ClientMode=cTurn 2261 2262 if (ClientMode = cTurn) or (ClientMode = cMovieTurn) then 2263 begin 2264 if MyRO.Happened and phGliderLost <> 0 then 2265 ContextMessage(Phrases.Lookup('GLIDERLOST'), 'MSG_DEFAULT', 2266 hkModel, 200); 2267 if MyRO.Happened and phPlaneLost <> 0 then 2268 ContextMessage(Phrases.Lookup('PLANELOST'), 'MSG_DEFAULT', 2269 hkFeature, mcFuel); 2270 if MyRO.Happened and phPeaceEvacuation <> 0 then 2271 for p1 := 0 to nPl - 1 do 2272 if 1 shl p1 and MyData.PeaceEvaHappened <> 0 then 2273 SoundMessageEx(Tribe[p1].TPhrase('WITHDRAW'), 'MSG_DEFAULT'); 2274 if MyRO.Happened and phPeaceViolation <> 0 then 2275 for p1 := 0 to nPl - 1 do 2276 if (1 shl p1 and MyRO.Alive <> 0) and (MyRO.EvaStart[p1] = MyRO.Turn) 2277 then 2278 SoundMessageEx(Format(Tribe[p1].TPhrase('VIOLATION'), 2279 [TurnToString(MyRO.Turn + PeaceEvaTurns - 1)]), 'MSG_WITHDRAW'); 2280 TellNewContacts; 2281 end; 2282 2283 if ClientMode = cMovieTurn then 2284 Update 2285 else if ClientMode = cTurn then 2286 begin 2287 if UpdatePanel then 2288 UpdateViews; 2289 DpiApplication.ProcessMessages; 2290 2291 if not supervising then 2292 for uix := 0 to MyRO.nUn - 1 do 2293 with MyUn[uix] do 2294 if Loc >= 0 then 2295 begin 2296 if Flags and unWithdrawn <> 0 then 2297 Status := 0; 2298 if Health = 100 then 2299 Status := Status and not usRecover; 2300 if (Master >= 0) or UnitExhausted(uix) then 2301 Status := Status and not usWaiting 2302 else 2303 Status := Status or usWaiting; 2304 CheckToldNoReturn(uix); 2305 if Status and usGoto <> 0 then 2306 begin { continue multi-turn goto } 2307 SetUnFocus(uix); 2308 SetTroopLoc(Loc); 2309 FocusOnLoc(TroopLoc, flRepaintPanel or flImmUpdate); 2310 if Status shr 16 = $7FFF then 2311 MoveResult := GetMoveAdvice(UnFocus, maNextCity, 2312 MoveAdviceData) 2313 else 2314 MoveResult := GetMoveAdvice(UnFocus, Status shr 16, 2315 MoveAdviceData); 2316 if MoveResult >= rExecuted then 2317 begin // !!! Shinkansen 2318 MoveResult := eOK; 2319 ok := true; 2320 for i := 0 to MoveAdviceData.nStep - 1 do 2321 begin 2322 Loc1 := dLoc(Loc, MoveAdviceData.dx[i], 2323 MoveAdviceData.dy[i]); 2324 if (MyMap[Loc1] and (fCity or fOwned) = fCity) 2325 // don't capture cities during auto move 2326 or (MyMap[Loc1] and (fUnit or fOwned) = fUnit) then 2327 // don't attack during auto move 2195 2328 begin 2196 if AutoBuild(cix, MyData.ImpOrder[Status and 7 - 1]) then 2197 AllowCityScreen := false 2198 else if Flags and chProduction <> 0 then 2199 Flags := (Flags and not chProduction) or chAllImpsMade 2329 ok := false; 2330 Break 2200 2331 end 2201 2332 else 2202 Flags := Flags or chTypeDel;2203 if (Size >= NeedAqueductSize) and2204 (MyRO.Tech[Imp[imAqueduct].Preq] < tsApplicable) or2205 (Size >= NeedSewerSize) and2206 (MyRO.Tech[Imp[imSewer].Preq] < tsApplicable) then2207 Flags := Flags and not chNoGrowthWarning;2208 // don't remind of unknown building2209 if Flags and chNoSettlerProd = 0 then2210 Status := Status and not csToldDelay2211 else if Status and csToldDelay = 0 then2212 Status := Status or csToldDelay2213 else2214 Flags := Flags and not chNoSettlerProd;2215 if mRepScreens.Checked then2216 begin2217 if (Flags and CityRepMask <> 0) and AllowCityScreen then2218 begin { show what happened in cities }2219 SetTroopLoc(MyCity[cix].Loc);2220 MarkCityLoc := MyCity[cix].Loc;2221 PanelPaint;2222 CityDlg.CloseAction := None;2223 CityDlg.ShowNewContent(wmModal, MyCity[cix].Loc,2224 Flags and CityRepMask);2225 UpdatePanel := true;2226 end2227 end2228 else { if mRepList.Checked then }2229 begin2230 if Flags and CityRepMask <> 0 then2231 ShowCityList := true2232 end2233 end2234 end; { city loop }2235 end; // ClientMode=cTurn2236 2237 if ClientMode = cTurn then2238 begin2239 if NewGovAvailable >= 0 then2240 with MessgExDlg do2241 begin2242 MessgText := Format(Phrases.Lookup('AUTOREVOLUTION'),2243 [Phrases.Lookup('GOVERNMENT', NewGovAvailable)]);2244 Kind := mkYesNo;2245 IconKind := mikPureIcon;2246 IconIndex := 6 + NewGovAvailable;2247 ShowModal;2248 if ModalResult = mrOK then2249 begin2250 Play('REVOLUTION');2251 Server(sRevolution, me, 0, nil^);2252 end2253 end;2254 end; // ClientMode=cTurn2255 2256 if (ClientMode = cTurn) or (ClientMode = cMovieTurn) then2257 begin2258 if MyRO.Happened and phGliderLost <> 0 then2259 ContextMessage(Phrases.Lookup('GLIDERLOST'), 'MSG_DEFAULT',2260 hkModel, 200);2261 if MyRO.Happened and phPlaneLost <> 0 then2262 ContextMessage(Phrases.Lookup('PLANELOST'), 'MSG_DEFAULT',2263 hkFeature, mcFuel);2264 if MyRO.Happened and phPeaceEvacuation <> 0 then2265 for p1 := 0 to nPl - 1 do2266 if 1 shl p1 and MyData.PeaceEvaHappened <> 0 then2267 SoundMessageEx(Tribe[p1].TPhrase('WITHDRAW'), 'MSG_DEFAULT');2268 if MyRO.Happened and phPeaceViolation <> 0 then2269 for p1 := 0 to nPl - 1 do2270 if (1 shl p1 and MyRO.Alive <> 0) and (MyRO.EvaStart[p1] = MyRO.Turn)2271 then2272 SoundMessageEx(Format(Tribe[p1].TPhrase('VIOLATION'),2273 [TurnToString(MyRO.Turn + PeaceEvaTurns - 1)]), 'MSG_WITHDRAW');2274 TellNewContacts;2275 end;2276 2277 if ClientMode = cMovieTurn then2278 Update2279 else if ClientMode = cTurn then2280 begin2281 if UpdatePanel then2282 UpdateViews;2283 Application.ProcessMessages;2284 2285 if not supervising then2286 for uix := 0 to MyRO.nUn - 1 do2287 with MyUn[uix] do2288 if Loc >= 0 then2289 begin2290 if Flags and unWithdrawn <> 0 then2291 Status := 0;2292 if Health = 100 then2293 Status := Status and not usRecover;2294 if (Master >= 0) or UnitExhausted(uix) then2295 Status := Status and not usWaiting2296 else2297 Status := Status or usWaiting;2298 CheckToldNoReturn(uix);2299 if Status and usGoto <> 0 then2300 begin { continue multi-turn goto }2301 SetUnFocus(uix);2302 SetTroopLoc(Loc);2303 FocusOnLoc(TroopLoc, flRepaintPanel or flImmUpdate);2304 if Status shr 16 = $7FFF then2305 MoveResult := GetMoveAdvice(UnFocus, maNextCity,2306 MoveAdviceData)2307 else2308 MoveResult := GetMoveAdvice(UnFocus, Status shr 16,2309 MoveAdviceData);2310 if MoveResult >= rExecuted then2311 begin // !!! Shinkansen2312 MoveResult := eOK;2313 ok := true;2314 for i := 0 to MoveAdviceData.nStep - 1 do2315 2333 begin 2316 Loc1 := dLoc(Loc, MoveAdviceData.dx[i], 2317 MoveAdviceData.dy[i]); 2318 if (MyMap[Loc1] and (fCity or fOwned) = fCity) 2319 // don't capture cities during auto move 2320 or (MyMap[Loc1] and (fUnit or fOwned) = fUnit) then 2321 // don't attack during auto move 2334 if (Loc1 = MoveAdviceData.ToLoc) or 2335 (MoveAdviceData.ToLoc = maNextCity) and 2336 (MyMap[dLoc(Loc, MoveAdviceData.dx[i], 2337 MoveAdviceData.dy[i])] and fCity <> 0) then 2338 MoveOptions := muAutoNoWait 2339 else 2340 MoveOptions := 0; 2341 MoveResult := MoveUnit(MoveAdviceData.dx[i], 2342 MoveAdviceData.dy[i], MoveOptions); 2343 if (MoveResult < rExecuted) or (MoveResult = eEnemySpotted) 2344 then 2322 2345 begin 2323 2346 ok := false; 2324 2347 Break 2325 end 2326 else 2327 begin 2328 if (Loc1 = MoveAdviceData.ToLoc) or 2329 (MoveAdviceData.ToLoc = maNextCity) and 2330 (MyMap[dLoc(Loc, MoveAdviceData.dx[i], 2331 MoveAdviceData.dy[i])] and fCity <> 0) then 2332 MoveOptions := muAutoNoWait 2333 else 2334 MoveOptions := 0; 2335 MoveResult := MoveUnit(MoveAdviceData.dx[i], 2336 MoveAdviceData.dy[i], MoveOptions); 2337 if (MoveResult < rExecuted) or (MoveResult = eEnemySpotted) 2338 then 2339 begin 2340 ok := false; 2341 Break 2342 end; 2343 end 2344 end; 2345 Stop := not ok or (Loc = MoveAdviceData.ToLoc) or 2346 (MoveAdviceData.ToLoc = maNextCity) and 2347 (MyMap[Loc] and fCity <> 0) 2348 end 2348 end; 2349 end 2350 end; 2351 Stop := not ok or (Loc = MoveAdviceData.ToLoc) or 2352 (MoveAdviceData.ToLoc = maNextCity) and 2353 (MyMap[Loc] and fCity <> 0) 2354 end 2355 else 2356 begin 2357 MoveResult := eOK; 2358 Stop := true; 2359 end; 2360 2361 if MoveResult <> eDied then 2362 if Stop then 2363 Status := Status and ($FFFF - usGoto) 2349 2364 else 2350 begin 2351 MoveResult := eOK; 2352 Stop := true; 2353 end; 2354 2355 if MoveResult <> eDied then 2356 if Stop then 2357 Status := Status and ($FFFF - usGoto) 2358 else 2359 Status := Status and not usWaiting; 2360 end; 2361 2362 if Status and (usEnhance or usGoto) = usEnhance then 2363 // continue terrain enhancement 2364 begin 2365 MoveResult := ProcessEnhancement(uix, MyData.EnhancementJobs); 2366 if MoveResult <> eDied then 2367 if MoveResult = eJobDone then 2368 Status := Status and not usEnhance 2369 else 2370 Status := Status and not usWaiting; 2371 end 2365 Status := Status and not usWaiting; 2372 2366 end; 2373 end; // ClientMode=cTurn 2374 2375 HaveStrategyAdvice := false; 2376 // (GameMode<>cMovie) and not supervising 2377 // and AdvisorDlg.HaveStrategyAdvice; 2378 GoOnPhase := true; 2379 if supervising or (GameMode = cMovie) then 2380 begin 2367 2368 if Status and (usEnhance or usGoto) = usEnhance then 2369 // continue terrain enhancement 2370 begin 2371 MoveResult := ProcessEnhancement(uix, MyData.EnhancementJobs); 2372 if MoveResult <> eDied then 2373 if MoveResult = eJobDone then 2374 Status := Status and not usEnhance 2375 else 2376 Status := Status and not usWaiting; 2377 end 2378 end; 2379 end; // ClientMode=cTurn 2380 2381 HaveStrategyAdvice := false; 2382 // (GameMode<>cMovie) and not supervising 2383 // and AdvisorDlg.HaveStrategyAdvice; 2384 GoOnPhase := true; 2385 if supervising or (GameMode = cMovie) then 2386 begin 2387 SetTroopLoc(-1); 2388 PaintAll 2389 end { supervisor } 2390 { else if (ClientMode=cTurn) and (MyRO.Turn=0) then 2391 begin 2392 SetUnFocus(0); 2393 ZoomToCity(MyCity[0].Loc) 2394 end } 2395 else 2396 begin 2397 if ClientMode >= scContact then 2398 SetUnFocus(-1) 2399 else 2400 NextUnit(-1, false); 2401 if UnFocus < 0 then 2402 begin 2403 UnStartLoc := -1; 2404 if IsMultiPlayerGame or (ClientMode = cResume) then 2405 if MyRO.nCity > 0 then 2406 FocusOnLoc(MyCity[0].Loc) 2407 else 2408 FocusOnLoc(G.lx * G.ly div 2); 2381 2409 SetTroopLoc(-1); 2382 PaintAll 2383 end { supervisor } 2384 { else if (ClientMode=cTurn) and (MyRO.Turn=0) then 2385 begin 2386 SetUnFocus(0); 2387 ZoomToCity(MyCity[0].Loc) 2388 end } 2389 else 2390 begin 2391 if ClientMode >= scContact then 2392 SetUnFocus(-1) 2393 else 2394 NextUnit(-1, false); 2395 if UnFocus < 0 then 2396 begin 2397 UnStartLoc := -1; 2398 if IsMultiPlayerGame or (ClientMode = cResume) then 2399 if MyRO.nCity > 0 then 2400 FocusOnLoc(MyCity[0].Loc) 2401 else 2402 FocusOnLoc(G.lx * G.ly div 2); 2403 SetTroopLoc(-1); 2404 PanelPaint 2405 end; 2406 if ShowCityList then 2407 ListDlg.ShowNewContent(wmPersistent, kCityEvents); 2410 PanelPaint 2408 2411 end; 2409 end; { InitTurn } 2410 2412 if ShowCityList then 2413 ListDlg.ShowNewContent(wmPersistent, kCityEvents); 2414 end; 2415 end; 2416 2417 procedure TMainScreen.Client(Command, NewPlayer: integer; var Data); 2411 2418 var 2412 2419 i, j, p1, mix, ToLoc, AnimationSpeed, ShowMoveDomain, cix, ecix: integer; … … 2416 2423 mi: TModelInfo; 2417 2424 SkipTurn, IsAlpine, IsTreatyDeal: boolean; 2418 2419 begin { >>>client } 2425 begin 2420 2426 case Command of 2421 2427 cTurn, cResume, cContinue, cMovieTurn, scContact, scDipStart .. scDipBreak: … … 2629 2635 assert(TribeNames.Count > 0); 2630 2636 ModalSelectDlg.ShowNewContent(wmModal, kTribe); 2631 Application.ProcessMessages;2637 DpiApplication.ProcessMessages; 2632 2638 TribeInfo.FileName := UnusedTribeFiles[ModalSelectDlg.result]; 2633 2639 UnusedTribeFiles.Delete(ModalSelectDlg.result); … … 2746 2752 begin 2747 2753 if AILogo[pLogo] <> nil then 2748 DpiBit Blt(Canvas.Handle, (xRightPanel + 10) - (16 + 64),2749 ClientHeight - PanelHeight, 64, 64, AILogo[pLogo].Canvas .Handle,2750 0, 0 , SRCCOPY);2754 DpiBitCanvas(Canvas, (xRightPanel + 10) - (16 + 64), 2755 ClientHeight - PanelHeight, 64, 64, AILogo[pLogo].Canvas, 2756 0, 0); 2751 2757 end 2752 2758 end … … 2776 2782 2777 2783 if Jump[pTurn] > 0 then 2778 Application.ProcessMessages;2784 DpiApplication.ProcessMessages; 2779 2785 if Jump[pTurn] > 0 then 2780 2786 if G.RO[NewPlayer].Happened and phGameEnd <> 0 then … … 2825 2831 end; 2826 2832 InitTurn(NewPlayer); 2827 Application.ProcessMessages;2833 DpiApplication.ProcessMessages; 2828 2834 if MovieSpeed = 4 then 2829 2835 begin 2830 2836 Sleep(75); 2831 2837 // this break will ensure speed of fast forward does not depend on cpu speed 2832 Application.ProcessMessages;2838 DpiApplication.ProcessMessages; 2833 2839 end 2834 2840 end; … … 2991 2997 assert(NewPlayer = me); 2992 2998 if not idle or (GameMode = cMovie) then 2993 Application.ProcessMessages;2999 DpiApplication.ProcessMessages; 2994 3000 if Command = cShowCityChanged then 2995 3001 begin … … 3055 3061 assert(NewPlayer = me); 3056 3062 if not idle or (GameMode = cMovie) then 3057 Application.ProcessMessages;3063 DpiApplication.ProcessMessages; 3058 3064 with TShowMove(Data) do 3059 3065 begin … … 3236 3242 assert(NewPlayer = me); 3237 3243 if not idle or (GameMode = cMovie) then 3238 Application.ProcessMessages;3244 DpiApplication.ProcessMessages; 3239 3245 with TShowMove(Data) do 3240 3246 begin … … 3389 3395 end 3390 3396 end 3391 end; { <<<client }3397 end; 3392 3398 3393 3399 { *** main part *** } … … 3405 3411 procedure TMainScreen.FormCreate(Sender: TObject); 3406 3412 var 3407 DefaultOptionChecked: integer;3408 Reg: TRegistry;3409 3413 i, j: integer; 3410 3414 begin 3415 MainFormKeyDown := FormKeyDown; 3411 3416 BaseWin.CreateOffscreen(Offscreen); 3412 3417 … … 3434 3439 SaveOption[20] := mAlFastMoves.Tag; 3435 3440 SaveOption[21] := mAlNoMoves.Tag; 3436 DefaultOptionChecked := 1 shl 1 + 1 shl 7 + 1 shl 10 + 1 shl 12 + 1 shl 14 + 3437 1 shl 18 + 1 shl 19; 3438 3439 Reg := TRegistry.Create; 3440 with Reg do 3441 try 3442 OpenKey(AppRegistryKey, false); 3443 if ValueExists('TileWidth') then xxt := ReadInteger('TileWidth') div 2 3444 else xxt := 48; 3445 if ValueExists('TileHeight') then yyt := ReadInteger('TileHeight') div 2 3446 else yyt := 24; 3447 if ValueExists('OptionChecked') then OptionChecked := ReadInteger('OptionChecked') 3448 else OptionChecked := DefaultOptionChecked; 3449 if ValueExists('MapOptionChecked') then MapOptionChecked := ReadInteger('MapOptionChecked') 3450 else MapOptionChecked := 1 shl moCityNames; 3451 if ValueExists('CityReport') then CityRepMask := Cardinal(ReadInteger('CityReport')) 3452 else CityRepMask := Cardinal(not chPopIncrease and not chNoGrowthWarning and 3453 not chCaptured); 3454 if OptionChecked and (7 shl 16) = 0 then 3455 OptionChecked := OptionChecked or (1 shl 16); 3456 // old regver with no scrolling 3457 finally 3458 Free; 3459 end; 3460 3461 if 1 shl 13 and OptionChecked <> 0 then 3462 SoundMode := smOff 3463 else if 1 shl 15 and OptionChecked <> 0 then 3464 SoundMode := smOnAlt 3465 else 3466 SoundMode := smOn; 3467 3468 Screen.Cursors[crImpDrag] := LoadCursor(HInstance, 'DRAG'); 3469 Screen.Cursors[crFlatHand] := LoadCursor(HInstance, 'FLATHAND'); 3441 3442 LoadSettings; 3443 3444 DpiScreen.Cursors[crImpDrag] := LoadCursor(HInstance, 'DRAG'); 3445 DpiScreen.Cursors[crFlatHand] := LoadCursor(HInstance, 'FLATHAND'); 3470 3446 3471 3447 // tag-controlled language … … 3537 3513 procedure TMainScreen.FormDestroy(Sender: TObject); 3538 3514 var 3539 i: integer; 3540 begin 3515 I: Integer; 3516 begin 3517 MainFormKeyDown := nil; 3541 3518 FreeAndNil(sb); 3542 3519 FreeAndNil(TopBar); … … 3544 3521 FreeAndNil(Buffer); 3545 3522 FreeAndNil(Panel); 3546 for i:= 0 to nPl - 1 do3523 for I := 0 to nPl - 1 do 3547 3524 if AILogo[i] <> nil then 3548 FreeAndNil(AILogo[ i]);3525 FreeAndNil(AILogo[I]); 3549 3526 FreeAndNil(Offscreen); 3550 3527 end; … … 4034 4011 exit; 4035 4012 4036 NoMap.BitBlt (Panel, -xMap - MapOffset, -yMap + MapHeight - overlap, xMidPanel,4013 NoMap.BitBltBitmap(Panel, -xMap - MapOffset, -yMap + MapHeight - overlap, xMidPanel, 4037 4014 overlap, 0, 0, SRCCOPY); 4038 NoMap.BitBlt (Panel, -xMap - MapOffset + xRightPanel,4015 NoMap.BitBltBitmap(Panel, -xMap - MapOffset + xRightPanel, 4039 4016 -yMap + MapHeight - overlap, Panel.width - xRightPanel, overlap, 4040 4017 xRightPanel, 0, SRCCOPY); … … 4042 4019 begin 4043 4020 if xMap < 0 then 4044 DpiBit Blt(Canvas.Handle, MapOffset, TopBarHeight, width + xMap,4045 height + yMap, Buffer.Canvas .Handle, -xMap, -yMap, SRCCOPY)4021 DpiBitCanvas(Canvas, MapOffset, TopBarHeight, width + xMap, 4022 height + yMap, Buffer.Canvas, -xMap, -yMap) 4046 4023 else 4047 DpiBit Blt(Canvas.Handle, xMap + MapOffset, TopBarHeight, width,4048 height + yMap, Buffer.Canvas .Handle, 0, -yMap, SRCCOPY)4024 DpiBitCanvas(Canvas, xMap + MapOffset, TopBarHeight, width, 4025 height + yMap, Buffer.Canvas, 0, -yMap) 4049 4026 end 4050 4027 else 4051 4028 begin 4052 4029 if xMap < 0 then 4053 DpiBit Blt(Canvas.Handle, MapOffset, TopBarHeight + yMap, width + xMap,4054 height, Buffer.Canvas .Handle, -xMap, 0, SRCCOPY)4030 DpiBitCanvas(Canvas, MapOffset, TopBarHeight + yMap, width + xMap, 4031 height, Buffer.Canvas, -xMap, 0) 4055 4032 else 4056 DpiBit Blt(Canvas.Handle, xMap + MapOffset, TopBarHeight + yMap, width,4057 height, Buffer.Canvas .Handle, 0, 0, SRCCOPY);4033 DpiBitCanvas(Canvas, xMap + MapOffset, TopBarHeight + yMap, width, 4034 height, Buffer.Canvas, 0, 0); 4058 4035 end 4059 4036 end; … … 4098 4075 end; 4099 4076 Mini.BeginUpdate; 4100 MiniPixel .Init(Mini);4101 PrevMiniPixel .Init(Mini);4077 MiniPixel := PixelPointer(Mini); 4078 PrevMiniPixel := PixelPointer(Mini); 4102 4079 for y := 0 to G.ly - 1 do 4103 4080 begin … … 4179 4156 function ScrollDC(Canvas: TDpiCanvas; dx: longint; dy: longint; const lprcScroll:TRect; const lprcClip:TRect; hrgnUpdate:HRGN; lprcUpdate: PRect):Boolean; 4180 4157 begin 4181 BitBltCanvas(Canvas, lprcScroll.Left + dx, lprcScroll.Top + dy, lprcScroll.Right - lprcScroll.Left, lprcScroll.Bottom - lprcScroll.Top,4182 Canvas, lprcScroll.Left, lprcScroll.Top , SRCCOPY);4158 Result := DpiBitCanvas(Canvas, lprcScroll.Left + dx, lprcScroll.Top + dy, lprcScroll.Right - lprcScroll.Left, lprcScroll.Bottom - lprcScroll.Top, 4159 Canvas, lprcScroll.Left, lprcScroll.Top); 4183 4160 end; 4184 4161 {$ENDIF} … … 4325 4302 procedure TMainScreen.CopyMiniToPanel; 4326 4303 begin 4327 DpiBit Blt(Panel.Canvas.Handle, xMini + 2, yMini + 2, G.lx * 2, G.ly,4328 Mini.Canvas .Handle, 0, 0, SRCCOPY);4304 DpiBitCanvas(Panel.Canvas, xMini + 2, yMini + 2, G.lx * 2, G.ly, 4305 Mini.Canvas, 0, 0); 4329 4306 if MarkCityLoc >= 0 then 4330 4307 Sprite(Panel, HGrSystem, xMini - 2 + (4 * G.lx + 2 * (MarkCityLoc mod G.lx) … … 4414 4391 ClientWidth - xPalace + xSizeBig + 1, yPalace + ySizeBig + 1, 4415 4392 $FFFFFF, $B0B0B0); 4416 DpiBit Blt(Panel.Canvas.Handle, ClientWidth - xPalace, yPalace, xSizeBig,4417 ySizeBig, GrExt[HGrSystem2].Data.Canvas .Handle, 70, 123, SRCCOPY);4393 DpiBitCanvas(Panel.Canvas, ClientWidth - xPalace, yPalace, xSizeBig, 4394 ySizeBig, GrExt[HGrSystem2].Data.Canvas, 70, 123); 4418 4395 end 4419 4396 else if MyRO.NatBuilt[imPalace] > 0 then … … 5094 5071 else 5095 5072 begin 5096 if Application.Active and not mScrollOff.Checked then5073 if DpiApplication.Active and not mScrollOff.Checked then 5097 5074 begin 5098 5075 if mScrollFast.Checked then … … 5272 5249 PaintLoc(MouseLoc, 2); 5273 5250 MiniPaint; 5274 DpiBit Blt(Panel.Canvas.Handle, xMini + 2, yMini + 2, G.lx * 2, G.ly,5275 Mini.Canvas .Handle, 0, 0, SRCCOPY);5251 DpiBitCanvas(Panel.Canvas, xMini + 2, yMini + 2, G.lx * 2, G.ly, 5252 Mini.Canvas, 0, 0); 5276 5253 if ywmax <= 0 then 5277 5254 Frame(Panel.Canvas, xMini + 2 + G.lx - MapWidth div (2 * xxt), … … 6031 6008 var 6032 6009 ToLoc, xFromLoc, yFromLoc, xToLoc, yToLoc, xFrom, yFrom, xTo, yTo, xMin, yMin, 6033 xRange, yRange, xw1, Step, xMoving, yMoving, yl,SliceCount: integer;6010 xRange, yRange, xw1, Step, xMoving, yMoving, SliceCount: integer; 6034 6011 UnitInfo: TUnitInfo; 6035 6012 Ticks0, Ticks: TDateTime; … … 6096 6073 for Step := 0 to abs(Step1 - Step0) do 6097 6074 begin 6098 DpiBit Blt(Buffer.Canvas.Handle, 0, 0, xRange, yRange,6099 offscreen.Canvas .Handle, xMin, yMin, SRCCOPY);6075 DpiBitCanvas(Buffer.Canvas, 0, 0, xRange, yRange, 6076 offscreen.Canvas, xMin, yMin); 6100 6077 if Step1 <> Step0 then 6101 6078 begin … … 6123 6100 begin 6124 6101 if not idle or (GameMode = cMovie) then 6125 Application.ProcessMessages;6102 DpiApplication.ProcessMessages; 6126 6103 {$IFDEF LINUX} 6127 6104 // TODO: Force animation under linux 6128 Application.ProcessMessages;6105 DpiApplication.ProcessMessages; 6129 6106 {$ENDIF} 6130 6107 Sleep(1); … … 6138 6115 if Restore then 6139 6116 begin 6140 DpiBitBlt(Buffer.Canvas.Handle, 0, 0, xRange, yRange, offscreen.Canvas.Handle, 6141 xMin, yMin, SRCCOPY); 6117 DpiBitCanvas(Buffer.Canvas, 0, 0, xRange, yRange, offscreen.Canvas, xMin, yMin); 6142 6118 PaintBufferToScreen(xMin, yMin, xRange, yRange); 6143 6119 end; … … 6884 6860 end 6885 6861 else if Sender = mWebsite then 6886 OpenURL( 'http://c-evo.org')6862 OpenURL(CevoHomepage) 6887 6863 else if Sender = mRandomMap then 6888 6864 begin … … 7322 7298 mSmallTiles.Checked := xxt = 33; 7323 7299 mNormalTiles.Checked := xxt = 48; 7300 mBigTiles.Checked := xxt = 72; 7324 7301 end 7325 7302 else if Popup = StatPopup then … … 7489 7466 InitPopup(Popup); 7490 7467 if FullScreen then 7491 Popup.Popup(Left + T DpiControl(Sender).Left, Top + TDpiControl(Sender).Top)7468 Popup.Popup(Left + TControl(Sender).Left, Top + TControl(Sender).Top) 7492 7469 else 7493 Popup.Popup(Left + T DpiControl(Sender).Left + 4, Top + TDpiControl(Sender).Top +7470 Popup.Popup(Left + TControl(Sender).Left + 4, Top + TControl(Sender).Top + 7494 7471 GetSystemMetrics(SM_CYCAPTION) + 4); 7495 7472 end; … … 7553 7530 yw := ywmax; 7554 7531 end; 7555 DpiBitBlt(Buffer.Canvas.Handle, 0, 0, G.lx * 2, G.ly, Mini.Canvas.Handle, 0, 7556 0, SRCCOPY); 7532 DpiBitCanvas(Buffer.Canvas, 0, 0, G.lx * 2, G.ly, Mini.Canvas, 0, 0); 7557 7533 if ywmax <= 0 then 7558 7534 Frame(Buffer.Canvas, x - xMini - 2 - MapWidth div (xxt * 2), 0, … … 7563 7539 x - xMini - 2 + MapWidth div (xxt * 2) - 1, yw + MapHeight div yyt - 7564 7540 2, MainTexture.clMark, MainTexture.clMark); 7565 DpiBit Blt(Panel.Canvas.Handle, xMini + 2, yMini + 2, G.lx * 2, G.ly,7566 Buffer.Canvas .Handle, 0, 0, SRCCOPY);7541 DpiBitCanvas(Panel.Canvas, xMini + 2, yMini + 2, G.lx * 2, G.ly, 7542 Buffer.Canvas, 0, 0); 7567 7543 MainOffscreenPaint; 7568 7544 RectInvalidate(xMini + 2, TopBarHeight + MapHeight - overlap + yMini + 2, … … 7573 7549 end 7574 7550 else 7575 Tracking := false 7551 Tracking := false; 7576 7552 end; 7577 7553 … … 7715 7691 Brush.Style := bsClear; 7716 7692 end; 7717 DpiBit Blt(Canvas.Handle, MapOffset, TopBarHeight, MapWidth, MapHeight - overlap,7718 offscreen.Canvas .Handle, 0, 0, SRCCOPY);7719 DpiBit Blt(Canvas.Handle, 0, 0, ClientWidth, TopBarHeight, TopBar.Canvas.Handle,7720 0, 0 , SRCCOPY);7693 DpiBitCanvas(Canvas, MapOffset, TopBarHeight, MapWidth, MapHeight - overlap, 7694 offscreen.Canvas, 0, 0); 7695 DpiBitCanvas(Canvas, 0, 0, ClientWidth, TopBarHeight, TopBar.Canvas, 7696 0, 0); 7721 7697 if xMidPanel > MapOffset then 7722 DpiBit Blt(Canvas.Handle, xMidPanel, TopBarHeight + MapHeight - overlap,7723 ClientWidth div 2 - xMidPanel, overlap, offscreen.Canvas .Handle,7724 xMidPanel - MapOffset, MapHeight - overlap , SRCCOPY)7698 DpiBitCanvas(Canvas, xMidPanel, TopBarHeight + MapHeight - overlap, 7699 ClientWidth div 2 - xMidPanel, overlap, offscreen.Canvas, 7700 xMidPanel - MapOffset, MapHeight - overlap) 7725 7701 else 7726 DpiBit Blt(Canvas.Handle, MapOffset, TopBarHeight + MapHeight - overlap,7727 ClientWidth div 2 - MapOffset, overlap, offscreen.Canvas .Handle, 0,7728 MapHeight - overlap , SRCCOPY);7702 DpiBitCanvas(Canvas, MapOffset, TopBarHeight + MapHeight - overlap, 7703 ClientWidth div 2 - MapOffset, overlap, offscreen.Canvas, 0, 7704 MapHeight - overlap); 7729 7705 if xRightPanel < MapOffset + MapWidth then 7730 DpiBit Blt(Canvas.Handle, ClientWidth div 2, TopBarHeight + MapHeight - overlap,7731 xRightPanel - ClientWidth div 2, overlap, offscreen.Canvas .Handle,7732 ClientWidth div 2 - MapOffset, MapHeight - overlap , SRCCOPY)7706 DpiBitCanvas(Canvas, ClientWidth div 2, TopBarHeight + MapHeight - overlap, 7707 xRightPanel - ClientWidth div 2, overlap, offscreen.Canvas, 7708 ClientWidth div 2 - MapOffset, MapHeight - overlap) 7733 7709 else 7734 DpiBit Blt(Canvas.Handle, ClientWidth div 2, TopBarHeight + MapHeight - overlap,7710 DpiBitCanvas(Canvas, ClientWidth div 2, TopBarHeight + MapHeight - overlap, 7735 7711 MapOffset + MapWidth - ClientWidth div 2, overlap, 7736 offscreen.Canvas.Handle, ClientWidth div 2 - MapOffset, 7737 MapHeight - overlap, SRCCOPY); 7738 DpiBitBlt(Canvas.Handle, 0, TopBarHeight + MapHeight - overlap, xMidPanel, 7739 overlap, Panel.Canvas.Handle, 0, 0, SRCCOPY); 7740 DpiBitBlt(Canvas.Handle, xRightPanel, TopBarHeight + MapHeight - overlap, 7741 Panel.width - xRightPanel, overlap, Panel.Canvas.Handle, xRightPanel, 7742 0, SRCCOPY); 7743 DpiBitBlt(Canvas.Handle, 0, TopBarHeight + MapHeight, Panel.width, 7744 PanelHeight - overlap, Panel.Canvas.Handle, 0, overlap, SRCCOPY); 7712 offscreen.Canvas, ClientWidth div 2 - MapOffset, 7713 MapHeight - overlap); 7714 DpiBitCanvas(Canvas, 0, TopBarHeight + MapHeight - overlap, xMidPanel, 7715 overlap, Panel.Canvas, 0, 0); 7716 DpiBitCanvas(Canvas, xRightPanel, TopBarHeight + MapHeight - overlap, 7717 Panel.width - xRightPanel, overlap, Panel.Canvas, xRightPanel, 0); 7718 DpiBitCanvas(Canvas, 0, TopBarHeight + MapHeight, Panel.width, 7719 PanelHeight - overlap, Panel.Canvas, 0, overlap); 7745 7720 if (pLogo >= 0) and (G.RO[pLogo] = nil) and (AILogo[pLogo] <> nil) then 7746 DpiBitBlt(Canvas.Handle, xRightPanel + 10 - (16 + 64), 7747 ClientHeight - PanelHeight, 64, 64, AILogo[pLogo].Canvas.Handle, 0, 7748 0, SRCCOPY); 7721 DpiBitCanvas(Canvas, xRightPanel + 10 - (16 + 64), 7722 ClientHeight - PanelHeight, 64, 64, AILogo[pLogo].Canvas, 0, 0); 7749 7723 end; 7750 7724 … … 7774 7748 InvalidateRgn(Handle, r0, false); 7775 7749 DeleteObject(r0); 7750 end; 7751 7752 procedure TMainScreen.LoadSettings; 7753 var 7754 Reg: TRegistry; 7755 DefaultOptionChecked: Integer; 7756 begin 7757 DefaultOptionChecked := 1 shl 1 + 1 shl 7 + 1 shl 10 + 1 shl 12 + 1 shl 14 + 7758 1 shl 18 + 1 shl 19; 7759 Reg := TRegistry.Create; 7760 with Reg do try 7761 OpenKey(AppRegistryKey, False); 7762 if ValueExists('TileWidth') then xxt := ReadInteger('TileWidth') div 2 7763 else xxt := 48; 7764 if ValueExists('TileHeight') then yyt := ReadInteger('TileHeight') div 2 7765 else yyt := 24; 7766 if ValueExists('OptionChecked') then OptionChecked := ReadInteger('OptionChecked') 7767 else OptionChecked := DefaultOptionChecked; 7768 if ValueExists('MapOptionChecked') then MapOptionChecked := ReadInteger('MapOptionChecked') 7769 else MapOptionChecked := 1 shl moCityNames; 7770 if ValueExists('CityReport') then CityRepMask := Cardinal(ReadInteger('CityReport')) 7771 else CityRepMask := Cardinal(not chPopIncrease and not chNoGrowthWarning and 7772 not chCaptured); 7773 if OptionChecked and (7 shl 16) = 0 then 7774 OptionChecked := OptionChecked or (1 shl 16); 7775 // old regver with no scrolling 7776 finally 7777 Free; 7778 end; 7779 7780 if 1 shl 13 and OptionChecked <> 0 then 7781 SoundMode := smOff 7782 else if 1 shl 15 and OptionChecked <> 0 then 7783 SoundMode := smOnAlt 7784 else 7785 SoundMode := smOn; 7776 7786 end; 7777 7787 … … 7989 7999 begin 7990 8000 SetTileSize(48, 24); 8001 end; 8002 8003 procedure TMainScreen.mBigTilesClick(Sender: TObject); 8004 begin 8005 SetTileSize(72, 36); 7991 8006 end; 7992 8007 -
branches/highdpi/LocalPlayer/UnitStat.pas
r193 r210 5 5 6 6 uses 7 Protocol, ClientTools, Term, ScreenTools, BaseWin, UDpiControls,7 UDpiControls, Protocol, ClientTools, Term, ScreenTools, BaseWin, 8 8 LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, 9 9 ButtonB, ButtonC; … … 83 83 Template := TDpiBitmap.Create; 84 84 Template.PixelFormat := pf24bit; 85 LoadGraphicFile(Template, HomeDir + 'Graphics'+ DirectorySeparator + 'Unit.png', gfNoGamma);85 LoadGraphicFile(Template, GetGraphicsDir + DirectorySeparator + 'Unit.png', gfNoGamma); 86 86 end; 87 87 … … 97 97 begin 98 98 AgePrepared := MainTextureAge; 99 Dpi bitblt(Back.Canvas.Handle, 0, 0, wCommon, hOwnModel,100 MainTexture.Image.Canvas .Handle, (wMainTexture - wCommon) div 2,101 (hMainTexture - hOwnModel) div 2 , SRCCOPY);102 Dpi bitblt(Back.Canvas.Handle, wCommon, 0, wCommon, hEnemyModel,103 MainTexture.Image.Canvas .Handle, (wMainTexture - wCommon) div 2,104 (hMainTexture - hEnemyModel) div 2 , SRCCOPY);105 Dpi bitblt(Back.Canvas.Handle, 2 * wCommon, 0, wCommon, hEnemyUnit,106 MainTexture.Image.Canvas .Handle, (wMainTexture - wCommon) div 2,107 (hMainTexture - hEnemyUnit) div 2 , SRCCOPY);108 Dpi bitblt(Back.Canvas.Handle, 3 * wCommon, 0, wCommon, hEnemyCityDefense,109 MainTexture.Image.Canvas .Handle, (wMainTexture - wCommon) div 2,110 (hMainTexture - hEnemyCityDefense) div 2 , SRCCOPY);111 Dpi bitblt(Back.Canvas.Handle, 4 * wCommon, 0, wCommon, hEnemyCity,112 MainTexture.Image.Canvas .Handle, (wMainTexture - wCommon) div 2,113 (hMainTexture - hEnemyCity) div 2 , SRCCOPY);99 DpiBitCanvas(Back.Canvas, 0, 0, wCommon, hOwnModel, 100 MainTexture.Image.Canvas, (wMainTexture - wCommon) div 2, 101 (hMainTexture - hOwnModel) div 2); 102 DpiBitCanvas(Back.Canvas, wCommon, 0, wCommon, hEnemyModel, 103 MainTexture.Image.Canvas, (wMainTexture - wCommon) div 2, 104 (hMainTexture - hEnemyModel) div 2); 105 DpiBitCanvas(Back.Canvas, 2 * wCommon, 0, wCommon, hEnemyUnit, 106 MainTexture.Image.Canvas, (wMainTexture - wCommon) div 2, 107 (hMainTexture - hEnemyUnit) div 2); 108 DpiBitCanvas(Back.Canvas, 3 * wCommon, 0, wCommon, hEnemyCityDefense, 109 MainTexture.Image.Canvas, (wMainTexture - wCommon) div 2, 110 (hMainTexture - hEnemyCityDefense) div 2); 111 DpiBitCanvas(Back.Canvas, 4 * wCommon, 0, wCommon, hEnemyCity, 112 MainTexture.Image.Canvas, (wMainTexture - wCommon) div 2, 113 (hMainTexture - hEnemyCity) div 2); 114 114 ImageOp_B(Back, Template, 0, 0, 0, 0, 5 * wCommon, hMax); 115 115 end … … 387 387 dkOwnModel: 388 388 begin 389 Dpi bitblt(offscreen.Canvas.Handle, 0, 0, wCommon, hOwnModel,390 Back.Canvas .Handle, 0, 0, SRCCOPY);389 DpiBitCanvas(offscreen.Canvas, 0, 0, wCommon, hOwnModel, 390 Back.Canvas, 0, 0); 391 391 yView := 13; 392 392 yTotal := 92; … … 394 394 dkEnemyModel: 395 395 begin 396 Dpi bitblt(offscreen.Canvas.Handle, 0, 0, wCommon, hEnemyModel,397 Back.Canvas .Handle, wCommon, 0, SRCCOPY);396 DpiBitCanvas(offscreen.Canvas, 0, 0, wCommon, hEnemyModel, 397 Back.Canvas, wCommon, 0); 398 398 yView := 13; 399 399 yTotal := 92; … … 401 401 dkEnemyUnit, dkOwnUnit: 402 402 begin 403 Dpi bitblt(offscreen.Canvas.Handle, 0, 0, wCommon, hEnemyUnit,404 Back.Canvas .Handle, 2 * wCommon, 0, SRCCOPY);403 DpiBitCanvas(offscreen.Canvas, 0, 0, wCommon, hEnemyUnit, 404 Back.Canvas, 2 * wCommon, 0); 405 405 yView := 13; 406 406 yTotal := 123; … … 408 408 dkEnemyCityDefense: 409 409 begin 410 Dpi bitblt(offscreen.Canvas.Handle, 0, 0, wCommon, hEnemyCityDefense,411 Back.Canvas .Handle, 3 * wCommon, 0, SRCCOPY);410 DpiBitCanvas(offscreen.Canvas, 0, 0, wCommon, hEnemyCityDefense, 411 Back.Canvas, 3 * wCommon, 0); 412 412 yView := 171; 413 413 yTotal := 231; … … 415 415 dkEnemyCity: 416 416 begin 417 Dpi bitblt(offscreen.Canvas.Handle, 0, 0, wCommon, hEnemyCity,418 Back.Canvas .Handle, 4 * wCommon, 0, SRCCOPY);417 DpiBitCanvas(offscreen.Canvas, 0, 0, wCommon, hEnemyCity, 418 Back.Canvas, 4 * wCommon, 0); 419 419 end; 420 420 end; … … 445 445 yImp + ySizeSmall, MainTexture.clBevelLight, 446 446 MainTexture.clBevelShade); 447 Dpi bitblt(offscreen.Canvas.Handle, x, yImp, xSizeSmall, ySizeSmall,448 SmallImp.Canvas .Handle, j mod 7 * xSizeSmall,449 (j + SystemIconLines * 7) div 7 * ySizeSmall , SRCCOPY);447 DpiBitCanvas(offscreen.Canvas, x, yImp, xSizeSmall, ySizeSmall, 448 SmallImp.Canvas, j mod 7 * xSizeSmall, 449 (j + SystemIconLines * 7) div 7 * ySizeSmall); 450 450 inc(x, xSizeSmall + 4) 451 451 end; … … 564 564 * (yyt * 3 + 1)); 565 565 end; 566 Dpi bitblt(offscreen.Canvas.Handle, xView, yView + 16, 64, 32,567 Buffer.Canvas .Handle, 1, 0, SRCCOPY);566 DpiBitCanvas(offscreen.Canvas, xView, yView + 16, 64, 32, 567 Buffer.Canvas, 1, 0); 568 568 569 569 // show unit, experience and health -
branches/highdpi/LocalPlayer/Wonders.pas
r179 r210 5 5 6 6 uses 7 ScreenTools, BaseWin, Protocol, LCLIntf, LCLType, SysUtils, Classes, Graphics,7 UDpiControls, ScreenTools, BaseWin, Protocol, LCLIntf, LCLType, SysUtils, Classes, Graphics, 8 8 Controls, Forms, ButtonB; 9 9 … … 38 38 39 39 uses 40 Term, ClientTools, Help, Tribes, U DpiControls;40 Term, ClientTools, Help, Tribes, UPixelPointer; 41 41 42 42 {$R *.lfm} … … 104 104 Ch: Integer; 105 105 Line: array [0..1] of TPixelPointer; 106 begin 106 Width: Integer; 107 Height: Integer; 108 CenterNative: TPoint; 109 begin 110 Width := ScaleToVcl(180); 111 Height := ScaleToVcl(128); 112 CenterNative := ScalePointtoVcl(Center); 107 113 Offscreen.BeginUpdate; 108 Line[0] .Init(Offscreen);109 Line[1] .Init(Offscreen);110 for Y := 0 to 127do begin111 for X := 0 to 179do begin112 r := X * X * ( 32 * 32) + Y * Y * (45 * 45);113 ax := ((1 shl 16 div 32) * 45) * Y;114 if (r < 8 * 128 * 180 * 180) and115 ((r >= 32 * 64 * 90 * 90) and (ax < amax2 * X) and114 Line[0] := PixelPointer(Offscreen); 115 Line[1] := PixelPointer(Offscreen); 116 for Y := 0 to Height - 1 do begin 117 for X := 0 to Width - 1 do begin 118 r := X * X * ((Height div 4) * (Height div 4)) + Y * Y * ((Width div 4) * (Width div 4)); 119 ax := ((1 shl 16 div (Height div 4)) * (Width div 4)) * Y; 120 if (r < ScaleToVcl(8) * Height * Width * Width) and 121 ((r >= (Height div 4) * (Height div 2) * (Width div 2) * (Width div 2)) and (ax < amax2 * X) and 116 122 ((ax < amax0 * X) or (ax > amin2 * X)) or (ax > amin1 * X) and 117 123 ((ax < amax1 * X) or (ax > amin3 * X))) then 118 124 for i := 0 to 1 do 119 125 for ch := 0 to 2 do begin 120 Line[0].SetXY(Center .X + X, Center.Y + Y);121 Line[1].SetXY(Center .X + X, Center.Y - 1 - Y);126 Line[0].SetXY(CenterNative.X + X, CenterNative.Y + Y); 127 Line[1].SetXY(CenterNative.X + X, CenterNative.Y - 1 - Y); 122 128 c := Line[i].Pixel^.Planes[ch] - darken; 123 129 if c < 0 then Line[i].Pixel^.Planes[ch] := 0 124 130 else Line[i].Pixel^.Planes[ch] := c; 125 Line[0].SetXY(Center .X - 1 - X, Center.Y + Y);126 Line[1].SetXY(Center .X - 1 - X, Center.Y - 1 - Y);131 Line[0].SetXY(CenterNative.X - 1 - X, CenterNative.Y + Y); 132 Line[1].SetXY(CenterNative.X - 1 - X, CenterNative.Y - 1 - Y); 127 133 c := Line[i].Pixel^.Planes[ch] - darken; 128 134 if c < 0 then Line[i].Pixel^.Planes[ch] := 0 … … 144 150 x0Src := (i mod 7) * xSizeBig; 145 151 y0Src := (i div 7 + SystemIconLines) * ySizeBig; 146 Src.Init(BigImp, x0Src, y0Src); 147 Dst.Init(Offscreen, x0Dst, y0Dst); 148 for Y := 0 to ySizeBig - 1 do begin 149 for X := 0 to xSizeBig - 1 do begin 152 153 Src := PixelPointer(BigImp, ScaleToVcl(x0Src), ScaleToVcl(y0Src)); 154 Dst := PixelPointer(Offscreen, ScaleToVcl(x0Dst), ScaleToVcl(y0Dst)); 155 for Y := 0 to ScaleToVcl(ySizeBig) - 1 do begin 156 for X := 0 to ScaleToVcl(xSizeBig) - 1 do begin 150 157 Darken := ((255 - Src.Pixel^.B) * 3 + (255 - Src.Pixel^.G) * 151 158 15 + (255 - Src.Pixel^.R) * 9) div 128; … … 238 245 begin 239 246 case MyRO.Wonder[I].CityID of 240 - 247 -1: // not built yet 241 248 begin 242 249 Fill(Offscreen.Canvas, Center.X - xSizeBig div 2 + RingPosition[I].X - 3, … … 249 256 begin 250 257 HaveWonder := True; 251 DpiBit Blt(Offscreen.Canvas.Handle,258 DpiBitCanvas(Offscreen.Canvas, 252 259 Center.X - xSizeBig div 2 + RingPosition[I].X, 253 260 Center.Y - ySizeBig div 2 + RingPosition[I].Y, xSizeBig, 254 ySizeBig, BigImp.Canvas .Handle, 0, (SystemIconLines + 3) *255 ySizeBig , SRCCOPY);261 ySizeBig, BigImp.Canvas, 0, (SystemIconLines + 3) * 262 ySizeBig); 256 263 end; 257 264 else 258 265 begin 259 266 HaveWonder := True; 260 DpiBit Blt(Offscreen.Canvas.Handle,267 DpiBitCanvas(Offscreen.Canvas, 261 268 Center.X - xSizeBig div 2 + RingPosition[I].X, 262 269 Center.Y - ySizeBig div 2 + RingPosition[I].Y, xSizeBig, ySizeBig, 263 BigImp.Canvas .Handle, (I mod 7) * xSizeBig,264 (I div 7 + SystemIconLines) * ySizeBig , SRCCOPY);270 BigImp.Canvas, (I mod 7) * xSizeBig, 271 (I div 7 + SystemIconLines) * ySizeBig); 265 272 end; 266 273 end; -
branches/highdpi/Locale.lfm
r193 r210 1 1 object LocaleDlg: TLocaleDlg 2 ClientHeight = 456 2 Left = 766 3 Height = 448 4 Top = 240 5 Width = 483 6 BorderStyle = bsNone 7 Caption = 'LocaleDlg' 8 ClientHeight = 448 3 9 ClientWidth = 483 4 Top = 2405 Left = 7546 Width = 4837 Height = 4568 Caption = 'LocaleDlg'9 Enabled = True10 ShowHint = False11 Font.Color = clDefault12 Font.PixelsPerInch = 14413 Align = alNone14 Color = clDefault15 OnPaint = FormPaint16 HorzScrollBar.Visible = False17 VertScrollBar.Visible = False18 10 DesignTimePPI = 144 19 11 FormStyle = fsStayOnTop 20 BorderStyle = bsNone21 BorderIcons = []22 LCLVersion = '2.0.2.0'23 OnShow = FormShow24 12 OnCreate = FormCreate 25 13 OnDestroy = FormDestroy 14 OnPaint = FormPaint 15 OnShow = FormShow 16 LCLVersion = '2.0.2.0' 26 17 object List: TDpiListBox 27 18 Tag = 15360 28 ClientHeight = 36029 ClientWidth = 42419 Left = 24 20 Height = 336 30 21 Top = 16 31 Left = 2432 22 Width = 424 33 Height = 36034 Visible = True35 Enabled = True36 ShowHint = False23 Anchors = [akTop, akLeft, akRight, akBottom] 24 BorderStyle = bsNone 25 Color = clBlack 26 ExtendedSelect = False 37 27 Font.Color = 4176863 28 Font.Height = -15 38 29 Font.Name = 'Times New Roman' 39 30 Font.Style = [fsBold] 40 Font.PixelsPerInch = 144 41 Font.Height = -15 42 Align = alNone 43 Color = clBlack 31 IntegralHeight = True 32 ItemHeight = 0 33 ParentFont = False 34 ScrollWidth = 424 35 TabOrder = 0 36 TabStop = False 37 TopIndex = -1 44 38 end 45 39 object OKBtn: TButtonA 46 ClientHeight = 2547 ClientWidth = 10040 Left = 272 41 Height = 25 48 42 Top = 400 49 Left = 27250 43 Width = 100 51 Height = 2552 Visible = True53 Enabled = True54 ShowHint = False55 Font.Color = clDefault56 Font.PixelsPerInch = 14457 Align = alNone58 Color = clDefault59 OnClick = OKBtnClick60 44 Down = False 61 45 Permanent = False 46 OnClick = OKBtnClick 62 47 end 63 48 object CancelBtn: TButtonA 64 ClientHeight = 2565 ClientWidth = 10049 Left = 96 50 Height = 25 66 51 Top = 400 67 Left = 9668 52 Width = 100 69 Height = 2570 Visible = True71 Enabled = True72 ShowHint = False73 Font.Color = clDefault74 Font.PixelsPerInch = 14475 Align = alNone76 Color = clDefault77 OnClick = CancelBtnClick78 53 Down = False 79 54 Permanent = False 55 OnClick = CancelBtnClick 56 end 57 object ButtonFullscreen: TButtonC 58 Left = 24 59 Height = 18 60 Top = 368 61 Width = 18 62 Down = False 63 Permanent = False 64 OnClick = ButtonFullscreenClick 65 ButtonIndex = 0 80 66 end 81 67 end -
branches/highdpi/Locale.pas
r178 r210 6 6 7 7 uses 8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,9 ScreenTools, Messg, ButtonA, Registry, fgl, Directories, DrawDlg, UDpiControls;8 UDpiControls, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 9 ScreenTools, Messg, ButtonA, Registry, fgl, Directories, DrawDlg, ButtonC; 10 10 11 11 type … … 27 27 28 28 TLocaleDlg = class(TDrawDlg) 29 ButtonFullscreen: TButtonC; 29 30 List: TDpiListBox; 30 31 OKBtn: TButtonA; 31 32 CancelBtn: TButtonA; 33 procedure ButtonFullscreenClick(Sender: TObject); 32 34 procedure CancelBtnClick(Sender: TObject); 33 35 procedure FormCreate(Sender: TObject); … … 101 103 OkBtn.Graphic := GrExt[HGrSystem].Data; 102 104 CancelBtn.Graphic := GrExt[HGrSystem].Data; 105 106 ButtonFullscreen.Graphic := GrExt[HGrSystem].Data; 107 if FullScreen then ButtonFullscreen.ButtonIndex := 3 108 else ButtonFullscreen.ButtonIndex := 2; 103 109 end; 104 110 105 111 procedure TLocaleDlg.CancelBtnClick(Sender: TObject); 106 112 begin 107 ModalResult := mrOk; 113 ModalResult := mrCancel; 114 end; 115 116 procedure TLocaleDlg.ButtonFullscreenClick(Sender: TObject); 117 begin 118 FullScreen := not FullScreen; 119 ButtonFullscreen.ButtonIndex := ButtonFullscreen.ButtonIndex xor 1; 108 120 end; 109 121 … … 114 126 115 127 procedure TLocaleDlg.FormPaint(Sender: TObject); 128 var 129 S: string; 116 130 begin 117 131 PaintBackground(self, 3, 3, ClientWidth - 6, ClientHeight - 6); … … 124 138 BtnFrame(Canvas, OKBtn.BoundsRect, MainTexture); 125 139 BtnFrame(Canvas, CancelBtn.BoundsRect, MainTexture); 140 141 RFrame(Canvas, ButtonFullscreen.Left - 1, ButtonFullscreen.Top - 1, 142 ButtonFullscreen.Left + 12, ButtonFullscreen.Top + 12, MainTexture.clBevelShade, 143 MainTexture.clBevelLight); 144 145 s := Phrases.Lookup('SETTINGS', 0); 146 LoweredTextOut(Canvas, -2, MainTexture, ButtonFullscreen.Left + 32, 147 ButtonFullscreen.Top - 4, s); 126 148 end; 127 149 … … 138 160 begin 139 161 LocaleCode := Languages[List.ItemIndex].ShortName; 140 ModalResult := mr Cancel;162 ModalResult := mrOk; 141 163 end; 142 164 -
branches/highdpi/Localization/cs/Language.txt
r178 r210 942 942 Uspíšit\produkci 943 943 Maximální\produkce 944 945 #SETTINGS 946 Celá obrazovka -
branches/highdpi/Localization/de/Language.txt
r178 r210 960 960 beschleunigte\Produktion 961 961 maximale\Produktion 962 963 #SETTINGS 964 Full screen -
branches/highdpi/Localization/it/Language.txt
r178 r210 932 932 Favorisci\produzione 933 933 Massimizza\produzione 934 935 #SETTINGS 936 Full screen -
branches/highdpi/Localization/ru/Language.txt
r178 r210 968 968 Максимум\Производства 969 969 970 #SETTINGS 971 Full screen -
branches/highdpi/Localization/zh-Hans/language.txt
r178 r210 960 960 Éú²ú×î´ó»¯ 961 961 962 #SETTINGS 963 Full screen -
branches/highdpi/Localization/zh-Hant/language.txt
r178 r210 960 960 ¥Í²£³Ì¤j¤Æ 961 961 962 #SETTINGS 963 Full screen -
branches/highdpi/Log.pas
r178 r210 5 5 6 6 uses 7 LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls, Forms,8 StdCtrls, Menus , UDpiControls;7 UDpiControls, LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls, Forms, 8 StdCtrls, Menus; 9 9 10 10 type 11 TLogDlg = class(T Form)11 TLogDlg = class(TDpiForm) 12 12 LogPopup: TPopupMenu; 13 13 mLog0: TMenuItem; … … 41 41 var 42 42 LogDlg: TLogDlg; 43 43 44 44 45 implementation -
branches/highdpi/Messg.pas
r178 r210 43 43 implementation 44 44 45 uses 46 Sound; 47 45 48 {$R *.lfm} 46 49 … … 79 82 if OpenSound <> '' then 80 83 PostMessage(Handle, WM_PLAYSOUND, 0, 0); 81 end; { FormPaint }84 end; 82 85 83 86 procedure TMessgDlg.Button1Click(Sender: TObject); … … 94 97 begin 95 98 if Key = #13 then 96 ModalResult := mrOK 99 ModalResult := mrOK; 97 100 // else if (Key=#27) and (Button2.Visible) then ModalResult:=mrCancel 98 101 end; … … 105 108 Kind := mkOK; 106 109 ShowModal; 107 end 110 end; 108 111 end; 109 112 … … 116 119 Kind := mkOK; 117 120 ShowModal; 118 end 121 end; 119 122 end; 120 123 -
branches/highdpi/NoTerm.pas
r193 r210 5 5 6 6 uses 7 ScreenTools, Protocol, Messg, LCLIntf, LCLType, dateutils, Platform,8 SysUtils, Classes, Graphics, Controls, Forms, ButtonB, DrawDlg , UDpiControls;7 UDpiControls, ScreenTools, Protocol, Messg, LCLIntf, LCLType, dateutils, Platform, 8 SysUtils, Classes, Graphics, Controls, Forms, ButtonB, DrawDlg; 9 9 10 10 type … … 127 127 RisedTextOut(State.Canvas, 0, 0, Format(Phrases.Lookup('AIT_ROUND'), [Round]) 128 128 + ' ' + TurnToString(G.RO[me].Turn)); 129 DpiBitBlt(Canvas.Handle, 64, 287 + 138, 192, 20, State.Canvas.Handle, 0, 130 0, SRCCOPY); 129 DpiBitCanvas(Canvas, 64, 287 + 138, 192, 20, State.Canvas, 0, 0); 131 130 end; 132 131 … … 174 173 begin 175 174 Invalidate; 176 Update ;175 Update 177 176 end 178 177 else … … 228 227 ToldAlive := G.RO[me].Alive; 229 228 end; 230 Application.ProcessMessages;229 DpiApplication.ProcessMessages; 231 230 if Mode = Quit then 232 231 EndPlaying … … 331 330 yBrain[i] - 16, 64, 64, 0, 0); 332 331 if 1 shl i and G.RO[me].Alive = 0 then 333 DpiBit Blt(Canvas.Handle, xBrain[i], yBrain[i] - 16, 64, 64,334 Shade.Canvas .Handle, 0, 0, SRCAND);332 DpiBitCanvas(Canvas, xBrain[i], yBrain[i] - 16, 64, 64, 333 Shade.Canvas, 0, 0, SRCAND); 335 334 Sprite(Canvas, HGrSystem, xBrain[i] + 30 - 14, yBrain[i] + 53, 14, 336 335 14, 1, 316); … … 368 367 begin 369 368 FormsCreated := true; 370 Application.CreateForm(TNoTermDlg, NoTermDlg);369 DpiApplication.CreateForm(TNoTermDlg, NoTermDlg); 371 370 end; 372 371 NoTermDlg.Client(Command, Player, Data); -
branches/highdpi/Packages/CevoComponents/Area.pas
r178 r210 4 4 5 5 uses 6 Classes, Graphics, Controls, UDpiControls;6 UDpiControls, Classes, Graphics, Controls; 7 7 8 8 type … … 20 20 procedure Register; 21 21 begin 22 RegisterComponents(' Samples', [TArea]);22 RegisterComponents('C-evo', [TArea]); 23 23 end; 24 24 … … 36 36 begin 37 37 Brush.Color := $FF0000; 38 FrameRect(Rect(0, 0, width, height));38 FrameRect(Rect(0, 0, Width, Height)); 39 39 end; 40 40 end; -
branches/highdpi/Packages/CevoComponents/BaseWin.pas
r193 r210 4 4 5 5 uses 6 ScreenTools, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms,7 DrawDlg , UDpiControls;6 UDpiControls, ScreenTools, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, 7 DrawDlg; 8 8 9 9 type … … 100 100 TitleHeight := WideFrame; 101 101 ModalFrameIndent := 45; 102 UserLeft := ( Screen.Width - Width) div 2;103 UserTop := ( Screen.Height - Height) div 2;102 UserLeft := (DpiScreen.Width - Width) div 2; 103 UserTop := (DpiScreen.Height - Height) div 2; 104 104 end; 105 105 … … 165 165 procedure TBufferedDrawDlg.VPaint; 166 166 begin 167 DpiBitBlt(Canvas.Handle, 0, 0, ClientWidth, ClientHeight, 168 Offscreen.Canvas.Handle, 0, 0, SRCCOPY); 167 DpiBitCanvas(Canvas, 0, 0, ClientWidth, ClientHeight, Offscreen.Canvas, 0, 0); 169 168 end; 170 169 … … 238 237 SaveOnShow, SaveOnPaint: TNotifyEvent; 239 238 begin 240 Top := Screen.Height;239 Top := DpiScreen.Height; 241 240 SaveOnShow := OnShow; 242 241 OnShow := nil; … … 454 453 end; 455 454 456 DpiBit Blt(Canvas.Handle, SideFrame, TitleHeight, ClientWidth - 2 * SideFrame,457 InnerBottom - TitleHeight, Offscreen.Canvas .Handle, 0, 0, SRCCOPY);455 DpiBitCanvas(Canvas, SideFrame, TitleHeight, ClientWidth - 2 * SideFrame, 456 InnerBottom - TitleHeight, Offscreen.Canvas, 0, 0); 458 457 end; 459 458 -
branches/highdpi/Packages/CevoComponents/ButtonA.pas
r178 r210 4 4 5 5 uses 6 ButtonBase, 7 Classes, Graphics, LCLIntf, LCLType, UDpiControls; 6 UDpiControls, ButtonBase, Classes, Graphics, LCLIntf, LCLType, ScreenTools; 8 7 9 8 type … … 12 11 private 13 12 FCaption: string; 14 procedure SetCaption( x: string);15 procedure SetFont(const x: TDpiFont);13 procedure SetCaption(Text: string); 14 procedure SetFont(const Font: TDpiFont); 16 15 published 17 16 property Visible; … … 26 25 procedure Register; 27 26 27 28 28 implementation 29 29 30 30 procedure Register; 31 31 begin 32 RegisterComponents(' Samples', [TButtonA]);32 RegisterComponents('C-evo', [TButtonA]); 33 33 end; 34 34 … … 43 43 begin 44 44 with Canvas do 45 if FGraphic <> nil then begin 46 DpiBitBlt(Canvas.Handle, 0, 0, 100, 25, Graphic.Canvas.Handle, 195, 47 243 + 26 * Byte(Down), SRCCOPY); 45 if FGraphic <> nil then 46 begin 47 DpiBitCanvas(Canvas, 0, 0, 100, 25, Graphic.Canvas, 195, 48 243 + 26 * Byte(Down)); 48 49 Canvas.Brush.Style := bsClear; 49 Text Out(50 - (TextWidth(FCaption) + 1) div 2, 12 - TextHeight(FCaption)50 Textout(50 - (TextWidth(FCaption) + 1) div 2, 12 - textheight(FCaption) 50 51 div 2, FCaption); 51 end else begin 52 end 53 else 54 begin 52 55 Brush.Color := $0000FF; 53 56 FrameRect(Rect(0, 0, 100, 25)) 54 end 57 end; 55 58 end; 56 59 57 procedure TButtonA.SetCaption( x: string);60 procedure TButtonA.SetCaption(Text: string); 58 61 begin 59 if x <> FCaption then 60 begin 61 FCaption := x; 62 Invalidate 63 end 62 if Text <> FCaption then begin 63 FCaption := Text; 64 Invalidate; 65 end; 64 66 end; 65 67 66 procedure TButtonA.SetFont(const x: TDpiFont);68 procedure TButtonA.SetFont(const Font: TDpiFont); 67 69 begin 68 Canvas.Font.Assign( x);70 Canvas.Font.Assign(Font); 69 71 Canvas.Font.Color := $000000; 70 72 end; -
branches/highdpi/Packages/CevoComponents/ButtonB.pas
r179 r210 4 4 5 5 uses 6 ButtonBase, Classes, Graphics, LCLIntf, LCLType, UDpiControls;6 UDpiControls, ButtonBase, Classes, Graphics, LCLIntf, LCLType; 7 7 8 8 type … … 12 12 FMask: TDpiBitmap; 13 13 FIndex: integer; 14 procedure SetIndex( x: integer);14 procedure SetIndex(Text: integer); 15 15 public 16 16 property Mask: TDpiBitmap read FMask write FMask; … … 25 25 procedure Register; 26 26 27 27 28 implementation 29 30 uses 31 ScreenTools; 28 32 29 33 procedure Register; 30 34 begin 31 RegisterComponents(' Samples', [TButtonB]);35 RegisterComponents('C-evo', [TButtonB]); 32 36 end; 33 37 … … 35 39 begin 36 40 inherited Create(aOwner); 37 ShowHint := true;41 ShowHint := True; 38 42 SetBounds(0, 0, 25, 25); 39 43 end; … … 42 46 begin 43 47 with Canvas do 44 if FGraphic <> nil then 45 begin 46 DpiBitBlt(Canvas.Handle, 0, 0, 25, 25, FGraphic.Canvas.Handle, 169, 47 243 + 26 * Byte(FDown), SRCCOPY); 48 if FIndex >= 0 then 49 begin 50 DpiBitBlt(Canvas.Handle, 0, 0, 25, 25, FMask.Canvas.Handle, 48 if FGraphic <> nil then begin 49 DpiBitCanvas(Canvas, 0, 0, 25, 25, FGraphic.Canvas, 169, 50 243 + 26 * Byte(FDown)); 51 if FIndex >= 0 then begin 52 DpiBitCanvas(Canvas, 0, 0, 25, 25, FMask.Canvas, 51 53 1 + FIndex mod 12 * 26, 337 + FIndex div 12 * 26, SRCAND); 52 DpiBit Blt(Canvas.Handle, 0, 0, 25, 25, FGraphic.Canvas.Handle,54 DpiBitCanvas(Canvas, 0, 0, 25, 25, FGraphic.Canvas, 53 55 1 + FIndex mod 12 * 26, 337 + FIndex div 12 * 26, SRCPAINT); 54 56 end 55 end 56 else 57 begin 57 end else begin 58 58 Brush.Color := $0000FF; 59 FrameRect(Rect(0, 0, 25, 25)) 60 end 59 FrameRect(Rect(0, 0, 25, 25)); 60 end; 61 61 end; 62 62 63 procedure TButtonB.SetIndex( x: integer);63 procedure TButtonB.SetIndex(Text: integer); 64 64 begin 65 if x <> FIndex then 66 begin 67 FIndex := x; 68 Invalidate 69 end 65 if Text <> FIndex then begin 66 FIndex := Text; 67 Invalidate; 68 end; 70 69 end; 71 70 -
branches/highdpi/Packages/CevoComponents/ButtonBase.pas
r179 r210 4 4 5 5 uses 6 Classes, Graphics, Controls, UDpiControls;6 UDpiControls, Classes, Graphics, Controls; 7 7 8 8 type 9 10 { TButtonBase }11 12 9 TButtonBase = class(TDpiGraphicControl) 13 10 protected … … 27 24 private 28 25 Active: boolean; 29 procedure SetGraphic(AValue: TDpiBitmap);30 26 public 31 27 constructor Create(aOwner: TComponent); override; 32 property Graphic: TDpiBitmap read FGraphic write SetGraphic;28 property Graphic: TDpiBitmap read FGraphic write FGraphic; 33 29 // property DownSound: string read FDownSound write FDownSound; 34 30 // property UpSound: string read FUpSound write FUpSound; … … 123 119 end; 124 120 125 procedure TButtonBase.SetGraphic(AValue: TDpiBitmap);126 begin127 if FGraphic = AValue then Exit;128 FGraphic := AValue;129 end;130 131 121 procedure TButtonBase.SetDown(x: boolean); 132 122 begin -
branches/highdpi/Packages/CevoComponents/ButtonC.pas
r179 r210 4 4 5 5 uses 6 ButtonBase, Classes, Graphics, LCLIntf, LCLType, UDpiControls;6 UDpiControls, ButtonBase, Classes, Graphics, LCLIntf, LCLType, ScreenTools; 7 7 8 8 type … … 11 11 private 12 12 FIndex: Integer; 13 procedure SetIndex( x: Integer);13 procedure SetIndex(Text: Integer); 14 14 published 15 15 property Visible; … … 22 22 procedure Register; 23 23 24 24 25 implementation 25 26 26 27 procedure Register; 27 28 begin 28 RegisterComponents(' Samples', [TButtonC]);29 RegisterComponents('C-evo', [TButtonC]); 29 30 end; 30 31 … … 40 41 with Canvas do 41 42 if FGraphic <> nil then 42 DpiBit Blt(Canvas.Handle, 0, 0, 12, 12, FGraphic.Canvas.Handle,43 169 + 13 * Byte(FDown), 159 + 13 * FIndex , SRCCOPY)43 DpiBitCanvas(Canvas, 0, 0, 12, 12, FGraphic.Canvas, 44 169 + 13 * Byte(FDown), 159 + 13 * FIndex) 44 45 else 45 46 begin 46 47 Brush.Color := $0000FF; 47 48 FrameRect(Rect(0, 0, 12, 12)) 48 end 49 end; 49 50 end; 50 51 51 procedure TButtonC.SetIndex( x: integer);52 procedure TButtonC.SetIndex(Text: integer); 52 53 begin 53 if x<> FIndex then54 if Text <> FIndex then 54 55 begin 55 FIndex := x;56 FIndex := Text; 56 57 Invalidate; 57 58 end; -
branches/highdpi/Packages/CevoComponents/ButtonN.pas
r180 r210 4 4 5 5 uses 6 Classes, Graphics, Controls, LCLIntf, LCLType, UDpiControls;6 UDpiControls, Classes, Graphics, Controls, LCLIntf, LCLType, ScreenTools; 7 7 8 8 type 9 TButtonN = class(T GraphicControl)9 TButtonN = class(TDpiGraphicControl) 10 10 constructor Create(aOwner: TComponent); override; 11 11 private … … 40 40 procedure Register; 41 41 begin 42 RegisterComponents(' Samples', [TButtonN]);42 RegisterComponents('C-evo', [TButtonN]); 43 43 end; 44 44 … … 62 62 if FGraphic <> nil then 63 63 begin 64 DpiBit Blt(Canvas.Handle, 1, 1, 40, 40, FBackGraphic.Canvas.Handle,65 1 + 80 * BackIndex + 40 * byte(FPossible and FLit), 176 , SRCCOPY);64 DpiBitCanvas(Canvas, 1, 1, 40, 40, FBackGraphic.Canvas, 65 1 + 80 * BackIndex + 40 * byte(FPossible and FLit), 176); 66 66 if FPossible then 67 67 begin 68 DpiBit Blt(Canvas.Handle, 3, 3, 36, 36, FMask.Canvas.Handle,68 DpiBitCanvas(Canvas, 3, 3, 36, 36, FMask.Canvas, 69 69 195 + 37 * (FIndex mod 3), 21 + 37 * (FIndex div 3), SRCAND); 70 DpiBit Blt(Canvas.Handle, 3, 3, 36, 36, FGraphic.Canvas.Handle,70 DpiBitCanvas(Canvas, 3, 3, 36, 36, FGraphic.Canvas, 71 71 195 + 37 * (FIndex mod 3), 21 + 37 * (FIndex div 3), SRCPAINT); 72 end 72 end; 73 73 end; 74 74 MoveTo(0, 41); … … 79 79 LineTo(41, 41); 80 80 LineTo(0, 41); 81 end 81 end; 82 82 end; 83 83 … … 86 86 begin 87 87 if FPossible and (Button = mbLeft) and (@ChangeProc <> nil) then 88 ChangeProc(Self) 88 ChangeProc(Self); 89 89 end; 90 90 … … 98 98 else 99 99 Hint := ''; 100 Invalidate 101 end 100 Invalidate; 101 end; 102 102 end; 103 103 … … 107 107 begin 108 108 FLit := x; 109 Invalidate 110 end 109 Invalidate; 110 end; 111 111 end; 112 112 … … 120 120 else 121 121 BackIndex := 0; 122 Invalidate 123 end 122 Invalidate; 123 end; 124 124 end; 125 125 … … 131 131 if FPossible then 132 132 Hint := x; 133 end 133 end; 134 134 end; 135 135 -
branches/highdpi/Packages/CevoComponents/CevoComponents.lpk
r178 r210 35 35 </Other> 36 36 </CompilerOptions> 37 <Files Count="13"> 37 <Description Value="C-evo components"/> 38 <Version Major="1" Minor="2"/> 39 <Files Count="14"> 38 40 <Item1> 39 41 <Filename Value="Area.pas"/> … … 93 95 <Item13> 94 96 <Filename Value="BaseWin.pas"/> 97 <HasRegisterProc Value="True"/> 95 98 <UnitName Value="BaseWin"/> 96 99 </Item13> 100 <Item14> 101 <Filename Value="UPixelPointer.pas"/> 102 <UnitName Value="UPixelPointer"/> 103 </Item14> 97 104 </Files> 98 105 <RequiredPkgs Count="3"> 99 106 <Item1> 100 107 <PackageName Value="DpiControls"/> 108 <DefaultFilename Value="..\DpiControls\DpiControls.lpk" Prefer="True"/> 101 109 </Item1> 102 110 <Item2> -
branches/highdpi/Packages/CevoComponents/CevoComponents.pas
r178 r210 10 10 uses 11 11 Area, ButtonA, ButtonB, ButtonC, ButtonN, EOTButton, ButtonBase, DrawDlg, 12 Sound, BaseWin, LazarusPackageIntf;12 Sound, BaseWin, UPixelPointer, LazarusPackageIntf; 13 13 14 14 implementation … … 23 23 RegisterUnit('EOTButton', @EOTButton.Register); 24 24 RegisterUnit('DrawDlg', @DrawDlg.Register); 25 RegisterUnit('BaseWin', @BaseWin.Register); 25 26 end; 26 27 -
branches/highdpi/Packages/CevoComponents/Directories.pas
r178 r210 4 4 5 5 var 6 HomeDir, DataDir: string; 6 HomeDir: string; 7 DataDir: string; 7 8 LocaleCode: string = ''; 8 9 LocaleCodeAuto: string = ''; 9 10 10 11 function LocalizedFilePath(const Path: string): string; 11 procedure InitUnit; 12 procedure UnitInit; 13 function GetSavedDir(Home: Boolean = False): string; 14 function GetMapsDir(Home: Boolean = False): string; 15 function GetGraphicsDir: string; 16 function GetSoundsDir: string; 17 function GetAiDir: string; 12 18 13 19 … … 27 33 28 34 if Lang = '' then begin 29 30 31 35 for i := 1 to Paramcount - 1 do 36 if (ParamStrUTF8(i) = '--LANG') or (ParamStrUTF8(i) = '-l') or 37 (ParamStrUTF8(i) = '--lang') then 32 38 Lang := ParamStrUTF8(i + 1); 33 39 end; 34 40 if Lang = '' then begin 41 T := ''; 35 42 LazGetLanguageIDs(Lang, T); 36 43 Lang := Copy(Lang, 1, 2); … … 51 58 if LocaleCode <> 'en' then begin 52 59 Result := HomeDir + 'Localization' + DirectorySeparator + LocaleCodeDir + DirectorySeparator + Path; 53 if not FileExists(Result) then60 if not DirectoryExists(Result) and not FileExists(Result) then 54 61 Result := HomeDir + Path; 55 62 end else Result := HomeDir + Path; 56 63 end; 57 64 58 procedure InitUnit;65 procedure UnitInit; 59 66 var 60 67 AppDataDir: string; … … 69 76 else 70 77 begin 71 if not DirectoryExists(AppDataDir) then 72 CreateDir(AppDataDir); 78 if not DirectoryExists(AppDataDir) then CreateDir(AppDataDir); 73 79 DataDir := AppDataDir; 74 80 end; 75 if not DirectoryExists(DataDir + 'Saved') then 76 CreateDir(DataDir + 'Saved'); 77 if not DirectoryExists(DataDir + 'Maps') then 78 CreateDir(DataDir + 'Maps'); 81 if not DirectoryExists(GetSavedDir) then CreateDir(GetSavedDir); 82 if not DirectoryExists(GetMapsDir) then CreateDir(GetMapsDir); 79 83 80 84 // Copy appdata if not done yet 81 if FindFirst( HomeDir + 'Saved'+ DirectorySeparator + '*.cevo', $21, src) = 0 then85 if FindFirst(GetSavedDir(True) + DirectorySeparator + '*.cevo', $21, src) = 0 then 82 86 repeat 83 if (FindFirst( DataDir + 'Saved'+ DirectorySeparator + src.Name, $21, dst) <> 0) or87 if (FindFirst(GetSavedDir(True) + DirectorySeparator + src.Name, $21, dst) <> 0) or 84 88 (dst.Time < src.Time) then 85 CopyFile(PChar( HomeDir + 'Saved'+ DirectorySeparator + src.Name),86 PChar( DataDir + 'Saved'+ DirectorySeparator + src.Name), false);89 CopyFile(PChar(GetSavedDir(True) + DirectorySeparator + src.Name), 90 PChar(GetSavedDir(True) + DirectorySeparator + src.Name), false); 87 91 FindClose(dst); 88 92 until FindNext(src) <> 0; … … 90 94 91 95 // Copy appdata if not done yet 92 if FindFirst( HomeDir + 'Maps'+ DirectorySeparator + '*.*', $21, src) = 0 then96 if FindFirst(GetMapsDir(True) + DirectorySeparator + '*.*', $21, src) = 0 then 93 97 repeat 94 if (FindFirst( DataDir + 'Maps'+ DirectorySeparator + src.Name, $21, dst) <> 0) or98 if (FindFirst(GetMapsDir(True) + DirectorySeparator + src.Name, $21, dst) <> 0) or 95 99 (dst.Time < src.Time) then 96 CopyFile(PChar( HomeDir + 'Maps'+ DirectorySeparator + src.Name),97 PChar( DataDir + 'Maps'+ DirectorySeparator + src.Name), false);100 CopyFile(PChar(GetMapsDir(True) + DirectorySeparator + src.Name), 101 PChar(GetMapsDir(True) + DirectorySeparator + src.Name), false); 98 102 FindClose(dst); 99 103 until FindNext(src) <> 0; … … 101 105 end; 102 106 107 function GetSavedDir(Home: Boolean = False): string; 108 begin 109 if Home then Result := HomeDir + 'Saved' 110 else Result := DataDir + 'Saved'; 111 end; 112 113 function GetMapsDir(Home: Boolean = False): string; 114 begin 115 if Home then Result := HomeDir + 'Maps' 116 else Result := DataDir + 'Maps'; 117 end; 118 119 function GetGraphicsDir: string; 120 begin 121 Result := HomeDir + 'Graphics'; 122 end; 123 124 function GetSoundsDir: string; 125 begin 126 Result := HomeDir + 'Sounds'; 127 end; 128 129 function GetAiDir: string; 130 begin 131 Result := HomeDir + 'AI'; 132 end; 133 103 134 end. -
branches/highdpi/Packages/CevoComponents/DrawDlg.pas
r178 r210 6 6 7 7 uses 8 Classes, SysUtils, Forms, LCLIntf, LCLType, LMessages, Messages, Graphics,9 Controls, ButtonBase, ButtonA, ButtonB, Area, ScreenTools, UDpiControls;8 UDpiControls, Classes, SysUtils, Forms, LCLIntf, LCLType, {$IFDEF LINUX}LMessages,{$ENDIF} 9 Messages, Graphics, Controls, ButtonBase, ButtonA, ButtonB, Area, ScreenTools; 10 10 11 11 type … … 15 15 public 16 16 constructor Create(AOwner: TComponent); override; 17 destructor Destroy; override; 17 18 procedure SmartInvalidate; virtual; 19 private 20 MoveFormPos: TPoint; 21 MoveMousePos: TPoint; 22 MoveActive: Boolean; 23 procedure VisibleChangedHandler(Sender: TObject); 18 24 protected 19 TitleHeight: integer;25 TitleHeight: Integer; 20 26 // defines area to grip the window for moving (from top) 21 27 procedure InitButtons; 22 28 procedure OnEraseBkgnd(var m: TMessage); message WM_ERASEBKGND; 23 29 procedure OnHitTest(var Msg: TMessage); message WM_NCHITTEST; 30 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 31 override; 32 procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; 33 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 34 procedure MouseLeave; override; 24 35 end; 25 36 … … 58 69 inherited; 59 70 TitleHeight := 0; 71 MoveActive := False; 72 AddHandlerOnVisibleChanged(VisibleChangedHandler); 73 end; 74 75 destructor TDrawDlg.Destroy; 76 begin 77 RemoveHandlerOnVisibleChanged(VisibleChangedHandler); 78 inherited Destroy; 60 79 end; 61 80 … … 98 117 end; 99 118 119 procedure TDrawDlg.MouseDown(Button: TMouseButton; Shift: TShiftState; X, 120 Y: Integer); 121 {$IFDEF LINUX} 122 var 123 MousePosNew: TPoint; 124 NewFormPos: TPoint; 125 {$ENDIF} 126 begin 127 inherited; 128 {$IFDEF LINUX} 129 // HitTest is not supported under Linux GTK2 so use form inside move mechanizm 130 NewFormPos := ScreenToClient(Mouse.CursorPos); 131 if (NewFormPos.X >= 0) and (NewFormPos.X < Width) and 132 (NewFormPos.Y >= 0) and (NewFormPos.Y < Height) then begin 133 MoveMousePos := ClientToScreen(Point(X, Y)); 134 MoveFormPos := Point(Left, Top); 135 MousePosNew := Mouse.CursorPos; 136 // Activate move only if mouse position was not changed during inherited call 137 if (MousePosNew.X = MoveMousePos.X) and (MousePosNew.Y = MoveMousePos.Y) then begin 138 MoveActive := True; 139 end; 140 end else MoveActive := False; 141 {$ENDIF} 142 end; 143 144 procedure TDrawDlg.MouseMove(Shift: TShiftState; X, Y: Integer); 145 var 146 MousePos: TPoint; 147 begin 148 inherited; 149 if MoveActive then begin 150 MousePos := ClientToScreen(Point(X, Y)); 151 SetBounds(MoveFormPos.X + MousePos.X - MoveMousePos.X, 152 MoveFormPos.Y + MousePos.Y - MoveMousePos.Y, 153 Width, Height); 154 end; 155 end; 156 157 procedure TDrawDlg.MouseUp(Button: TMouseButton; Shift: TShiftState; X, 158 Y: Integer); 159 begin 160 MoveActive := False; 161 inherited; 162 end; 163 164 procedure TDrawDlg.MouseLeave; 165 begin 166 MoveActive := False; 167 inherited; 168 end; 169 170 procedure TDrawDlg.VisibleChangedHandler(Sender: TObject); 171 begin 172 MoveActive := False; 173 end; 174 100 175 procedure TDrawDlg.InitButtons; 101 176 var … … 103 178 // ButtonDownSound, ButtonUpSound: string; 104 179 begin 105 // ButtonDownSound :=Sounds.Lookup('BUTTON_DOWN');106 // ButtonUpSound :=Sounds.Lookup('BUTTON_UP');180 // ButtonDownSound := Sounds.Lookup('BUTTON_DOWN'); 181 // ButtonUpSound := Sounds.Lookup('BUTTON_UP'); 107 182 for cix := 0 to ComponentCount - 1 do 108 183 if Components[cix] is TButtonBase then 109 184 begin 110 185 TButtonBase(Components[cix]).Graphic := GrExt[HGrSystem].Data; 111 // if ButtonDownSound <>'*' then112 // DownSound :=HomeDir+'Sounds'+ DirectorySeparator + ButtonDownSound + '.wav';113 // if ButtonUpSound <>'*' then114 // UpSound :=HomeDir+'Sounds'+ DirectorySeparator + ButtonUpSound + '.wav';186 // if ButtonDownSound <> '*' then 187 // DownSound := GetSoundsDir + DirectorySeparator + ButtonDownSound + '.wav'; 188 // if ButtonUpSound <> '*' then 189 // UpSound := GetSoundsDir + DirectorySeparator + ButtonUpSound + '.wav'; 115 190 if Components[cix] is TButtonA then 116 191 TButtonA(Components[cix]).Font := UniFont[ftButton]; … … 125 200 r0, r1: HRgn; 126 201 begin 127 r0 := CreateRectRgn(0, 0, ClientWidth, ClientHeight);202 r0 := DpiCreateRectRgn(0, 0, ClientWidth, ClientHeight); 128 203 for i := 0 to ControlCount - 1 do 129 204 if not(Controls[i] is TArea) and Controls[i].Visible then 130 205 begin 131 206 with Controls[i].BoundsRect do 132 r1 := CreateRectRgn(Left, Top, Right, Bottom);207 r1 := DpiCreateRectRgn(Left, Top, Right, Bottom); 133 208 CombineRgn(r0, r0, r1, RGN_DIFF); 134 209 DeleteObject(r1); … … 142 217 procedure TBaseMessgDlg.FormCreate(Sender: TObject); 143 218 begin 144 Left := ( Screen.Width - Width) div 2;219 Left := (DpiScreen.Width - Width) div 2; 145 220 Canvas.Font.Assign(UniFont[ftNormal]); 146 221 Canvas.Brush.Style := bsClear; 147 222 MessgText := ''; 148 223 TopSpace := 0; 149 TitleHeight := Screen.Height;224 TitleHeight := DpiScreen.Height; 150 225 if csDesigning in ComponentState then Exit; 151 226 InitButtons; … … 157 232 begin 158 233 if csDesigning in ComponentState then Exit; 159 PaintBackground( Self, 3 + Border, 3 + Border, ClientWidth - (6 + 2 * Border),234 PaintBackground(self, 3 + Border, 3 + Border, ClientWidth - (6 + 2 * Border), 160 235 ClientHeight - (6 + 2 * Border)); 161 236 for i := 0 to Border do … … 218 293 begin 219 294 ClientHeight := 72 + Border + TopSpace + Lines * MessageLineSpacing; 220 Top := ( Screen.Height - ClientHeight) div 2;295 Top := (DpiScreen.Height - ClientHeight) div 2; 221 296 for i := 0 to ControlCount - 1 do 222 297 Controls[i].Top := ClientHeight - (34 + Border); -
branches/highdpi/Packages/CevoComponents/EOTButton.pas
r180 r210 4 4 5 5 uses 6 ButtonBase, Classes, SysUtils, Graphics, LCLIntf, LCLType, UDpiControls;6 UDpiControls, ButtonBase, Classes, SysUtils, Graphics, LCLIntf, LCLType; 7 7 8 8 const … … 14 14 15 15 type 16 // EndOfTurn button 16 17 TEOTButton = class(TButtonBase) 17 18 public … … 40 41 implementation 41 42 43 uses 44 ScreenTools; 42 45 43 46 procedure Register; 44 47 begin 45 RegisterComponents('Samples', [TEOTButton]); 46 end; 47 48 procedure ImageOp_CBC(Dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, w, h, Color0, 49 Color2: integer); 50 // Src is template 51 // B channel = Color0 amp 52 // G channel = background amp (old Dst content), 128=original brightness 53 // R channel = Color2 amp 54 type 55 TPixel = array [0 .. 2] of Byte; 56 var 57 ix, iy, amp0, amp1, trans, Value: integer; 58 SrcLine, DstLine: ^TPixel; 59 begin 60 Src.BeginUpdate; 61 Dst.BeginUpdate; 62 for iy := 0 to h - 1 do 63 begin 64 SrcLine := Src.ScanLine[ySrc + iy] + xSrc * (Src.RawImage.Description.BitsPerPixel shr 3); 65 DstLine := Dst.ScanLine[yDst + iy] + xDst * (Dst.RawImage.Description.BitsPerPixel shr 3); 66 for ix := 0 to w - 1 do 67 begin 68 trans := SrcLine[0] * 2; // green channel = transparency 69 amp0 := SrcLine[1] * 2; 70 amp1 := SrcLine[2] * 2; 71 if trans <> $FF then 72 begin 73 Value := (DstLine[0] * trans + (Color2 shr 16 and $FF) * amp1 74 + (Color0 shr 16 and $FF) * amp0) div $FF; 75 if Value < 256 then 76 DstLine[0] := Value 77 else 78 DstLine[0] := 255; 79 Value := (DstLine[1] * trans + (Color2 shr 8 and $FF) * amp1 80 + (Color0 shr 8 and $FF) * amp0) div $FF; 81 if Value < 256 then 82 DstLine[1] := Value 83 else 84 DstLine[1] := 255; 85 Value := (DstLine[2] * trans + (Color2 and $FF) * amp1 + 86 (Color0 and $FF) * amp0) div $FF; 87 if Value < 256 then 88 DstLine[2] := Value 89 else 90 DstLine[2] := 255; 91 end; 92 SrcLine := Pointer(SrcLine) + (Src.RawImage.Description.BitsPerPixel shr 3); 93 DstLine := Pointer(DstLine) + (Dst.RawImage.Description.BitsPerPixel shr 3); 94 end; 95 end; 96 Src.EndUpdate; 97 Dst.EndUpdate; 48 RegisterComponents('C-evo', [TEOTButton]); 98 49 end; 99 50 … … 126 77 begin 127 78 // TODO: For some reason BitBlt is not working with gray background here 128 //DpiBitBlt(Buffer.Canvas.Handle, 0, 0, 48, 48, Back.Canvas.Handle, 0, 129 // 0, SRCCOPY); 79 //DpiBitCanvas(Buffer.Canvas, 0, 0, 48, 48, Back.Canvas, 0, 0); 130 80 Buffer.Canvas.Draw(0, 0, Back); 131 81 ImageOp_CBC(Buffer, Template, 0, 0, 133, 149 + 48 * Byte(FDown), 48, 48, … … 134 84 ImageOp_CBC(Buffer, Template, 8, 8, 1 + 32 * Byte(FIndex), 246, 32, 32, 135 85 $000000, $FFFFFF); 136 DpiBit Blt(Canvas.Handle, 0, 0, 48, 48, Buffer.Canvas.Handle, 0, 0, SRCCOPY);86 DpiBitCanvas(Canvas, 0, 0, 48, 48, Buffer.Canvas, 0, 0); 137 87 end 138 88 else … … 140 90 Brush.Color := $0000FF; 141 91 FrameRect(Rect(0, 0, 48, 48)) 142 end 92 end; 143 93 end; 144 94 … … 148 98 begin 149 99 FIndex := x; 150 Invalidate 151 end 100 Invalidate; 101 end; 152 102 end; 153 103 … … 160 110 Paint 161 111 except 162 end 163 end 112 end; 113 end; 164 114 end; 165 115 166 116 procedure TEOTButton.SetBack(ca: TDpiCanvas; x, y: integer); 167 117 begin 168 DpiBit Blt(Back.Canvas.Handle, 0, 0, 48, 48, ca.Handle, x, y, SRCCOPY);118 DpiBitCanvas(Back.Canvas, 0, 0, 48, 48, ca, x, y); 169 119 end; 170 120 -
branches/highdpi/Packages/CevoComponents/ScreenTools.pas
r193 r210 4 4 5 5 uses 6 {$IFDEF WINDOWS}6 UDpiControls, {$IFDEF WINDOWS} 7 7 Windows, 8 8 {$ENDIF} 9 StringTables, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, 10 Forms, Menus, GraphType , UDpiControls;9 StringTables, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Math, 10 Forms, Menus, GraphType; 11 11 12 12 type … … 17 17 end; 18 18 19 TColor32 = type cardinal;20 TColor32Component = (ccBlue, ccGreen, ccRed, ccAlpha);21 TPixel32 = packed record22 case integer of23 0: (B, G, R, A: byte);24 1: (ARGB: TColor32);25 2: (Planes: array[0..3] of byte);26 3: (Components: array[TColor32Component] of byte);27 end;28 PPixel32 = ^TPixel32;29 30 { TPixelPointer }31 32 TPixelPointer = record33 Base: PPixel32;34 Pixel: PPixel32;35 Line: PPixel32;36 RelLine: PPixel32;37 BytesPerPixel: integer;38 BytesPerLine: integer;39 procedure NextLine; inline; // Move pointer to start of new base line40 procedure NextPixel; inline; // Move pointer to next pixel41 procedure SetXY(X, Y: integer); inline; // Set pixel position relative to base42 procedure SetX(X: integer); inline; // Set horizontal pixel position relative to base43 procedure Init(Bitmap: TDpiRasterImage; BaseX: integer = 0; BaseY: integer = 0); inline;44 end;45 PPixelPointer = ^TPixelPointer;46 47 19 {$IFDEF WINDOWS} 48 20 function ChangeResolution(x, y, bpp, freq: integer): boolean; 49 21 {$ENDIF} 50 22 procedure RestoreResolution; 51 function Play(Item: string; Index: integer = -1): boolean;52 procedure PreparePlay(Item: string; Index: integer = -1);53 23 procedure EmptyMenu(MenuItems: TMenuItem; Keep: Integer = 0); 54 24 function TurnToYear(Turn: integer): integer; … … 65 35 procedure Sprite(dst: TDpiBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer); 66 36 overload; 67 procedure MakeBlue(dst: TDpiBitmap; x, y, w, h: integer);68 procedure ImageOp_B(dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, w, h: integer);37 procedure MakeBlue(dst: TDpiBitmap; x, y, Width, Height: Integer); 38 procedure ImageOp_B(dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, Width, Height: Integer); 69 39 procedure ImageOp_BCC(dst, Src: TDpiBitmap; 70 xDst, yDst, xSrc, ySrc, w, h, Color1, Color2: integer); 71 procedure ImageOp_CCC(bmp: TDpiBitmap; x, y, w, h, Color0, Color1, Color2: integer); 72 function BitBltCanvas(DestCanvas: TDpiCanvas; X, Y, Width, Height: integer; 73 SrcCanvas: TDpiCanvas; XSrc, YSrc: integer; Rop: DWORD): boolean; 40 xDst, yDst, xSrc, ySrc, Width, Height, Color1, Color2: Integer); 41 procedure ImageOp_CBC(Dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, Width, Height, 42 Color0, Color2: Integer); 43 procedure ImageOp_CCC(bmp: TDpiBitmap; x, y, w, h, Color0, Color1, Color2: Integer); 44 function DpiBitCanvas(DestCanvas: TDpiCanvas; X, Y, Width, Height: Integer; 45 SrcCanvas: TDpiCanvas; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean; overload; 46 function DpiBitCanvas(Dest: TDpiCanvas; DestRect: TRect; 47 Src: TDpiCanvas; SrcPos: TPoint; Rop: DWORD = SRCCOPY): Boolean; overload; 48 function BitBltBitmap(Dest: TDpiBitmap; X, Y, Width, Height: Integer; 49 Src: TDpiBitmap; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean; overload; 50 function BitBltBitmap(Dest: TDpiBitmap; DestRect: TRect; 51 Src: TDpiBitmap; SrcPos: TPoint; Rop: DWORD = SRCCOPY): Boolean; overload; 74 52 procedure SLine(ca: TDpiCanvas; x0, x1, y: integer; cl: TColor); 75 53 procedure DLine(ca: TDpiCanvas; x0, x1, y: integer; cl0, cl1: TColor); … … 82 60 procedure InitOrnament; 83 61 procedure InitCityMark(const T: TTexture); 84 procedure Fill(ca: TDpiCanvas; Left, Top, Width, Height, xOffset, yOffset: integer); 62 procedure Fill(ca: TDpiCanvas; Left, Top, Width, Height, xOffset, yOffset: integer); overload; 63 procedure Fill(Canvas: TDpiCanvas; Rect: TRect; Offset: TPoint); overload; 85 64 procedure FillLarge(ca: TDpiCanvas; x0, y0, x1, y1, xm: integer); 86 65 procedure FillSeamless(ca: TDpiCanvas; Left, Top, Width, Height, xOffset, yOffset: integer; … … 88 67 procedure FillRectSeamless(ca: TDpiCanvas; x0, y0, x1, y1, xOffset, yOffset: integer; 89 68 const Texture: TDpiBitmap); 90 procedure PaintBackground(Form: TDpiForm; Left, Top, Width, Height: Integer);69 procedure PaintBackground(Form: TDpiForm; Left, Top, Width, Height: integer); 91 70 procedure Corner(ca: TDpiCanvas; x, y, Kind: integer; const T: TTexture); 92 71 procedure BiColorTextOut(ca: TDpiCanvas; clMain, clBack: TColor; x, y: integer; s: string); … … 111 90 function SetMainTextureByAge(Age: integer): boolean; 112 91 procedure LoadPhrases; 92 procedure Texturize(Dest, Texture: TDpiBitmap; TransparentColor: Integer); 93 procedure DarkenImage(Bitmap: TDpiBitmap; Change: Integer); 113 94 114 95 const … … 148 129 wOrna = 27; 149 130 hOrna = 26; // ornament 150 151 // sound modes152 smOff = 0;153 smOn = 1;154 smOnAlt = 2;155 131 156 132 // color matrix … … 188 164 TGrExtDescr = record { don't use dynamic strings here! } 189 165 Name: string[31]; 190 Data, Mask: TDpiBitmap; 191 pixUsed: array [byte] of byte; 166 Data: TDpiBitmap; 167 Mask: TDpiBitmap; 168 pixUsed: array [Byte] of Byte; 192 169 end; 193 170 … … 195 172 TGrExtDescr, but without pixUsed } 196 173 Name: string[31]; 197 Data, Mask: TBitmap; 174 Data: TDpiBitmap; 175 Mask: TDpiBitmap; 198 176 end; 199 177 … … 201 179 202 180 var 203 Phrases, Phrases2, Sounds: TStringTable; 204 nGrExt: integer; 181 Phrases: TStringTable; 182 Phrases2: TStringTable; 183 nGrExt: Integer; 205 184 GrExt: array [0 .. nGrExtmax - 1] of ^TGrExtDescr; 206 HGrSystem, HGrSystem2, ClickFrameColor, SoundMode, MainTextureAge: integer; 185 HGrSystem: Integer; 186 HGrSystem2: Integer; 187 ClickFrameColor: Integer; 188 MainTextureAge: Integer; 207 189 MainTexture: TTexture; 208 Templates, Colors, Paper, BigImp, LogoBuffer: TDpiBitmap; 209 FullScreen, GenerateNames, InitOrnamentDone, Phrases2FallenBackToEnglish: boolean; 190 Templates: TDpiBitmap; 191 Colors: TDpiBitmap; 192 Paper: TDpiBitmap; 193 BigImp: TDpiBitmap; 194 LogoBuffer: TDpiBitmap; 195 FullScreen: Boolean; 196 GenerateNames: Boolean; 197 InitOrnamentDone: Boolean; 198 Phrases2FallenBackToEnglish: Boolean; 210 199 211 200 UniFont: array [TFontType] of TDpiFont; 212 AppRegistryKey: string = '\SOFTWARE\C-evo'; 213 201 Gamma: Integer; // global gamma correction (cent) 202 203 procedure LoadAssets; 214 204 procedure UnitInit; 215 205 procedure UnitDone; 206 procedure InitGammaLookupTable; 207 216 208 217 209 implementation 218 210 219 211 uses 220 Directories, Sound, Registry;212 Directories, Sound, UPixelPointer; 221 213 222 214 var … … 226 218 {$ENDIF} 227 219 228 Gamma: Integer; // global gamma correction (cent) 229 GammaLookupTable: array [0 .. 255] of Byte; 220 GammaLookupTable: array [0..255] of Byte; 230 221 231 222 {$IFDEF WINDOWS} … … 255 246 ResolutionChanged := False; 256 247 {$ENDIF} 257 end;258 259 function Play(Item: string; Index: integer = -1): boolean;260 {$IFNDEF DEBUG}261 var262 WavFileName: string;263 {$ENDIF}264 begin265 Result := False;266 {$IFNDEF DEBUG}267 if (Sounds = nil) or (SoundMode = smOff) or (Item = '') then268 begin269 Result := True;270 Exit;271 end;272 WavFileName := Sounds.Lookup(Item, Index);273 Assert(WavFileName[1] <> '[');274 Result := (WavFileName <> '') and (WavFileName[1] <> '[') and (WavFileName <> '*');275 if Result then276 // SndPlaySound(pchar(HomeDir+'Sounds' +DirectorySeparator+WavFileName+'.wav'),SND_ASYNC)277 PlaySound(HomeDir + 'Sounds' + DirectorySeparator + WavFileName);278 {$ENDIF}279 end;280 281 procedure PreparePlay(Item: string; Index: Integer = -1);282 {$IFNDEF DEBUG}283 var284 WavFileName: string;285 {$ENDIF}286 begin287 {$IFNDEF DEBUG}288 if (Sounds = nil) or (SoundMode = smOff) or (Item = '') then289 Exit;290 WavFileName := Sounds.Lookup(Item, Index);291 Assert(WavFileName[1] <> '[');292 if (WavFileName <> '') and (WavFileName[1] <> '[') and (WavFileName <> '*') then293 PrepareSound(HomeDir + 'Sounds' + DirectorySeparator + WavFileName);294 {$ENDIF}295 248 end; 296 249 … … 409 362 begin 410 363 Bitmap.BeginUpdate; 411 PixelPtr .Init(Bitmap);364 PixelPtr := PixelPointer(Bitmap); 412 365 for Y := 0 to ScaleToVcl(Bitmap.Height) - 1 do begin 413 366 for X := 0 to ScaleToVcl(Bitmap.Width) - 1 do begin … … 420 373 end; 421 374 422 procedure CopyGray8BitTo24bitBitmap(Dst, Src: TDpi Bitmap);375 procedure CopyGray8BitTo24bitBitmap(Dst, Src: TDpiRasterImage); 423 376 var 424 377 SrcPtr, DstPtr: TPixelPointer; … … 426 379 begin 427 380 //Dst.SetSize(Src.Width, Src.Height); 428 SrcPtr .Init(Src);429 DstPtr .Init(Dst);381 SrcPtr := PixelPointer(Src); 382 DstPtr := PixelPointer(Dst); 430 383 for Y := 0 to ScaleToVcl(Src.Height) - 1 do begin 431 384 for X := 0 to ScaleToVcl(Src.Width) - 1 do begin … … 441 394 end; 442 395 443 procedure ResizeBitmap(Bitmap: TDpiBitmap; const NewWidth, NewHeight: Integer);444 var445 Buffer: TDpiBitmap;446 begin447 Buffer := TDpiBitmap.Create;448 try449 Buffer.SetSize(NewWidth, NewHeight);450 Buffer.Canvas.StretchDraw(Rect(0, 0, NewWidth, NewHeight), Bitmap);451 Bitmap.SetSize(NewWidth, NewHeight);452 Bitmap.Canvas.Draw(0, 0, Buffer);453 finally454 Buffer.Free;455 end;456 end;457 458 396 function LoadGraphicFile(bmp: TDpiBitmap; Path: string; Options: Integer): Boolean; 459 397 var … … 465 403 Path := Path + '.png'; 466 404 if ExtractFileExt(Path) = '.jpg' then begin 467 jtex := TDpiJpegImage.Create;405 jtex := tDpijpegimage.Create; 468 406 try 469 407 jtex.LoadFromFile(Path); 470 ResizeBitmap(jtex, ScaleToVcl(jtex.Width), ScaleToVcl(jtex.Height));471 408 except 472 409 Result := False; … … 487 424 try 488 425 Png.LoadFromFile(Path); 489 ResizeBitmap(Png, ScaleToVcl(Png.Width), ScaleToVcl(Png.Height));490 426 except 491 427 Result := False; … … 503 439 end 504 440 else 505 Bmp.Canvas. Draw(0, 0, Png);441 Bmp.Canvas.draw(0, 0, Png); 506 442 end; 507 443 Png.Free; … … 511 447 try 512 448 bmp.LoadFromFile(Path); 513 ResizeBitmap(bmp, ScaleToVcl(bmp.Width), ScaleToVcl(bmp.Height));514 449 except 515 450 Result := False; … … 546 481 Source := TDpiBitmap.Create; 547 482 Source.PixelFormat := pf24bit; 548 FileName := HomeDir + 'Graphics'+ DirectorySeparator + Name;483 FileName := GetGraphicsDir + DirectorySeparator + Name; 549 484 if not LoadGraphicFile(Source, FileName) then begin 550 485 Result := -1; … … 556 491 557 492 xmax := Source.Width - 1; // allows 4-byte access even for last pixel 558 if xmax > 970 then 559 xmax := 970; 493 // Why there was that limit? 494 //if xmax > 970 then 495 // xmax := 970; 560 496 561 497 GrExt[nGrExt].Data := Source; … … 567 503 GrExt[nGrExt].Data.BeginUpdate; 568 504 GrExt[nGrExt].Mask.BeginUpdate; 569 DataPixel .Init(GrExt[nGrExt].Data);570 MaskPixel .Init(GrExt[nGrExt].Mask);505 DataPixel := PixelPointer(GrExt[nGrExt].Data); 506 MaskPixel := PixelPointer(GrExt[nGrExt].Mask); 571 507 for y := 0 to ScaleToVcl(Source.Height) - 1 do begin 572 508 for x := 0 to ScaleToVcl(xmax) - 1 do begin … … 598 534 procedure Dump(dst: TDpiBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer); 599 535 begin 600 DpiBit Blt(dst.Canvas.Handle, xDst, yDst, Width, Height,601 GrExt[HGr].Data.Canvas .Handle, xGr, yGr, SRCCOPY);602 end; 603 604 procedure MakeBlue(dst: TDpiBitmap; x, y, w, h: integer);536 DpiBitCanvas(dst.Canvas, xDst, yDst, Width, Height, 537 GrExt[HGr].Data.Canvas, xGr, yGr); 538 end; 539 540 procedure MakeBlue(dst: TDpiBitmap; x, y, Width, Height: Integer); 605 541 var 606 542 XX, YY: integer; … … 609 545 X := ScaleToVcl(X); 610 546 Y := ScaleToVcl(Y); 611 W := ScaleToVcl(W);612 H := ScaleToVcl(H);547 Width := ScaleToVcl(Width); 548 Height := ScaleToVcl(Height); 613 549 Dst.BeginUpdate; 614 PixelPtr .Init(Dst, X, Y);615 for yy := 0 to h- 1 do begin616 for xx := 0 to w- 1 do begin550 PixelPtr := PixelPointer(Dst, X, Y); 551 for yy := 0 to Height - 1 do begin 552 for xx := 0 to Width - 1 do begin 617 553 PixelPtr.Pixel^.B := PixelPtr.Pixel^.B div 2; 618 554 PixelPtr.Pixel^.G := PixelPtr.Pixel^.G div 2; … … 625 561 end; 626 562 627 procedure ImageOp_B(dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, w, h: Integer);563 procedure ImageOp_B(dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, Width, Height: Integer); 628 564 // Src is template 629 565 // X channel = background amp (old Dst content), 128=original brightness … … 638 574 xSrc := ScaleToVcl(xSrc); 639 575 ySrc := ScaleToVcl(ySrc); 640 w := ScaleToVcl(w);641 h := ScaleToVcl(h);576 Width := ScaleToVcl(Width); 577 Height := ScaleToVcl(Height); 642 578 //Assert(Src.PixelFormat = pf8bit); 643 579 Assert(dst.PixelFormat = pf24bit); 644 580 if xDst < 0 then begin 645 w := w+ xDst;581 Width := Width + xDst; 646 582 xSrc := xSrc - xDst; 647 583 xDst := 0; 648 584 end; 649 585 if yDst < 0 then begin 650 h := h+ yDst;586 Height := Height + yDst; 651 587 ySrc := ySrc - yDst; 652 588 yDst := 0; 653 589 end; 654 if xDst + w> ScaleToVcl(dst.Width) then655 w:= ScaleToVcl(dst.Width) - xDst;656 if yDst + h> ScaleToVcl(dst.Height) then657 h:= ScaleToVcl(dst.Height) - yDst;658 if ( w < 0) or (h< 0) then590 if xDst + Width > ScaleToVcl(dst.Width) then 591 Width := ScaleToVcl(dst.Width) - xDst; 592 if yDst + Height > ScaleToVcl(dst.Height) then 593 Height := ScaleToVcl(dst.Height) - yDst; 594 if (Width < 0) or (Height < 0) then 659 595 exit; 660 596 661 597 dst.BeginUpdate; 662 598 Src.BeginUpdate; 663 PixelDst .Init(Dst, xDst, yDst);664 PixelSrc .Init(Src, xSrc, ySrc);665 for Y := 0 to h- 1 do begin666 for X := 0 to w- 1 do begin599 PixelDst := PixelPointer(Dst, xDst, yDst); 600 PixelSrc := PixelPointer(Src, xSrc, ySrc); 601 for Y := 0 to Height - 1 do begin 602 for X := 0 to Width - 1 do begin 667 603 Brightness := PixelSrc.Pixel^.B; // One byte for 8-bit color 668 604 test := (PixelDst.Pixel^.R * Brightness) shr 7; … … 691 627 end; 692 628 693 procedure ImageOp_BCC(dst, Src: TDpiBitmap; 694 xDst, yDst, xSrc, ySrc, w, h, Color1, Color2: integer);629 procedure ImageOp_BCC(dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, Width, Height, 630 Color1, Color2: Integer); 695 631 // Src is template 696 632 // B channel = background amp (old Dst content), 128=original brightness … … 698 634 // R channel = Color2 amp, 128=original brightness 699 635 var 700 ix, iy, amp1, amp2, trans, Value: integer; 701 SrcPixel, DstPixel: TPixelPointer; 636 ix, iy, amp1, amp2, trans, Value: Integer; 637 SrcPixel: TPixelPointer; 638 DstPixel: TPixelPointer; 702 639 begin 703 640 xDst := ScaleToVcl(xDst); … … 705 642 xSrc := ScaleToVcl(xSrc); 706 643 ySrc := ScaleToVcl(ySrc); 707 w := ScaleToVcl(w);708 h := ScaleToVcl(h);644 Width := ScaleToVcl(Width); 645 Height := ScaleToVcl(Height); 709 646 if xDst < 0 then begin 710 w := w+ xDst;647 Width := Width + xDst; 711 648 xSrc := xSrc - xDst; 712 649 xDst := 0; 713 650 end; 714 651 if yDst < 0 then begin 715 h := h+ yDst;652 Height := Height + yDst; 716 653 ySrc := ySrc - yDst; 717 654 yDst := 0; 718 655 end; 719 if xDst + w> ScaleToVcl(dst.Width) then720 w:= ScaleToVcl(dst.Width) - xDst;721 if yDst + h> ScaleToVcl(dst.Height) then722 h:= ScaleToVcl(dst.Height) - yDst;723 if ( w < 0) or (h< 0) then656 if xDst + Width > ScaleToVcl(dst.Width) then 657 Width := ScaleToVcl(dst.Width) - xDst; 658 if yDst + Height > ScaleToVcl(dst.Height) then 659 Height := ScaleToVcl(dst.Height) - yDst; 660 if (Width < 0) or (Height < 0) then 724 661 exit; 725 662 726 663 Src.BeginUpdate; 727 664 dst.BeginUpdate; 728 SrcPixel .Init(Src, xSrc, ySrc);729 DstPixel .Init(Dst, xDst, yDst);730 for iy := 0 to h- 1 do begin731 for ix := 0 to w- 1 do begin665 SrcPixel := PixelPointer(Src, xSrc, ySrc); 666 DstPixel := PixelPointer(Dst, xDst, yDst); 667 for iy := 0 to Height - 1 do begin 668 for ix := 0 to Width - 1 do begin 732 669 trans := SrcPixel.Pixel^.B * 2; // green channel = transparency 733 670 amp1 := SrcPixel.Pixel^.G * 2; … … 736 673 Value := (DstPixel.Pixel^.B * trans + ((Color2 shr 16) and $FF) * 737 674 amp2 + ((Color1 shr 16) and $FF) * amp1) div $FF; 738 if Value < 256 then 739 DstPixel.Pixel^.B := Value 740 else 741 DstPixel.Pixel^.B := 255; 675 DstPixel.Pixel^.B := Min(Value, 255); 676 742 677 Value := (DstPixel.Pixel^.G * trans + ((Color2 shr 8) and $FF) * 743 678 amp2 + ((Color1 shr 8) and $FF) * amp1) div $FF; 744 if Value < 256 then 745 DstPixel.Pixel^.G := Value 746 else 747 DstPixel.Pixel^.G := 255; 679 DstPixel.Pixel^.G := Min(Value, 255); 680 748 681 Value := (DstPixel.Pixel^.R * trans + (Color2 and $FF) * 749 682 amp2 + (Color1 and $FF) * amp1) div $FF; 750 if Value < 256 then 751 DstPixel.Pixel^.R := Value 752 else 753 DstPixel.Pixel^.R := 255; 683 DstPixel.Pixel^.R := Min(Value, 255); 684 end; 685 686 SrcPixel.NextPixel; 687 DstPixel.NextPixel; 688 end; 689 SrcPixel.NextLine; 690 DstPixel.NextLine; 691 end; 692 Src.EndUpdate; 693 dst.EndUpdate; 694 end; 695 696 procedure ImageOp_CBC(Dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, Width, Height, 697 Color0, Color2: Integer); 698 // Src is template 699 // B channel = Color0 amp 700 // G channel = background amp (old Dst content), 128=original brightness 701 // R channel = Color2 amp 702 var 703 ix, iy, amp0, amp1, trans, Value: integer; 704 SrcPixel: TPixelPointer; 705 DstPixel: TPixelPointer; 706 begin 707 xDst := ScaleToVcl(xDst); 708 yDst := ScaleToVcl(yDst); 709 xSrc := ScaleToVcl(xSrc); 710 ySrc := ScaleToVcl(ySrc); 711 Width := ScaleToVcl(Width); 712 Height := ScaleToVcl(Height); 713 Src.BeginUpdate; 714 Dst.BeginUpdate; 715 SrcPixel := PixelPointer(Src, xSrc, ySrc); 716 DstPixel := PixelPointer(Dst, xDst, yDst); 717 for iy := 0 to Height - 1 do begin 718 for ix := 0 to Width - 1 do begin 719 trans := SrcPixel.Pixel^.B * 2; // green channel = transparency 720 amp0 := SrcPixel.Pixel^.G * 2; 721 amp1 := SrcPixel.Pixel^.R * 2; 722 if trans <> $FF then begin 723 Value := (DstPixel.Pixel^.B * trans + (Color2 shr 16 and $FF) * amp1 + 724 (Color0 shr 16 and $FF) * amp0) div $FF; 725 DstPixel.Pixel^.B := Min(Value, 255); 726 727 Value := (DstPixel.Pixel^.G * trans + (Color2 shr 8 and $FF) * amp1 + 728 (Color0 shr 8 and $FF) * amp0) div $FF; 729 DstPixel.Pixel^.G := Min(Value, 255); 730 731 Value := (DstPixel.Pixel^.R * trans + (Color2 and $FF) * amp1 + 732 (Color0 and $FF) * amp0) div $FF; 733 DstPixel.Pixel^.R := Min(Value, 255); 754 734 end; 755 735 SrcPixel.NextPixel; … … 760 740 end; 761 741 Src.EndUpdate; 762 dst.EndUpdate;742 Dst.EndUpdate; 763 743 end; 764 744 … … 779 759 assert(bmp.PixelFormat = pf24bit); 780 760 h := y + h; 781 PixelPtr .Init(Bmp, x, y);761 PixelPtr := PixelPointer(Bmp, x, y); 782 762 while y < h do begin 783 763 for i := 0 to w - 1 do begin … … 802 782 procedure Sprite(Canvas: TDpiCanvas; HGr, xDst, yDst, Width, Height, xGr, yGr: integer); 803 783 begin 804 DpiBit Blt(Canvas.Handle, xDst, yDst, Width, Height,805 GrExt[HGr].Mask.Canvas .Handle, xGr, yGr, SRCAND);806 DpiBit Blt(Canvas.Handle, xDst, yDst, Width, Height,807 GrExt[HGr].Data.Canvas .Handle, xGr, yGr, SRCPAINT);784 DpiBitCanvas(Canvas, xDst, yDst, Width, Height, 785 GrExt[HGr].Mask.Canvas, xGr, yGr, SRCAND); 786 DpiBitCanvas(Canvas, xDst, yDst, Width, Height, 787 GrExt[HGr].Data.Canvas, xGr, yGr, SRCPAINT); 808 788 end; 809 789 810 790 procedure Sprite(dst: TDpiBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer); 811 791 begin 812 DpiBitBlt(dst.Canvas.Handle, xDst, yDst, Width, Height, 813 GrExt[HGr].Mask.Canvas.Handle, xGr, yGr, SRCAND); 814 DpiBitBlt(dst.Canvas.Handle, xDst, yDst, Width, Height, 815 GrExt[HGr].Data.Canvas.Handle, xGr, yGr, SRCPAINT); 816 end; 817 818 function BitBltCanvas(DestCanvas: TDpiCanvas; X, Y, Width, Height: integer; 819 SrcCanvas: TDpiCanvas; XSrc, YSrc: integer; Rop: DWORD): boolean; 820 begin 821 Assert(Rop = SRCCOPY); 822 DestCanvas.CopyRect(Rect(X, Y, X + Width, Y + Height), SrcCanvas, 823 Rect(XSrc, YSrc, XSrc + Width, YSrc + Height)); 824 Result := True; 792 DpiBitCanvas(dst.Canvas, xDst, yDst, Width, Height, 793 GrExt[HGr].Mask.Canvas, xGr, yGr, SRCAND); 794 DpiBitCanvas(dst.Canvas, xDst, yDst, Width, Height, 795 GrExt[HGr].Data.Canvas, xGr, yGr, SRCPAINT); 796 end; 797 798 function DpiBitCanvas(DestCanvas: TDpiCanvas; X, Y, Width, Height: Integer; 799 SrcCanvas: TDpiCanvas; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean; 800 begin 801 Result := DpiBitBlt(DestCanvas.Handle, X, Y, Width, Height, SrcCanvas.Handle, XSrc, YSrc, Rop); 802 end; 803 804 function DpiBitCanvas(Dest: TDpiCanvas; DestRect: TRect; Src: TDpiCanvas; 805 SrcPos: TPoint; Rop: DWORD): Boolean; 806 begin 807 Result := DpiBitCanvas(Dest, DestRect.Left, DestRect.Top, DestRect.Width, DestRect.Height, 808 Src, SrcPos.X, SrcPos.Y, Rop); 809 end; 810 811 function BitBltBitmap(Dest: TDpiBitmap; X, Y, Width, Height: Integer; 812 Src: TDpiBitmap; XSrc, YSrc: Integer; Rop: DWORD): Boolean; 813 begin 814 Result := DpiBitCanvas(Dest.Canvas, X, Y, Width, Height, Src.Canvas, XSrc, YSrc, Rop); 815 end; 816 817 function BitBltBitmap(Dest: TDpiBitmap; DestRect: TRect; Src: TDpiBitmap; 818 SrcPos: TPoint; Rop: DWORD): Boolean; 819 begin 820 Result := DpiBitCanvas(Dest.Canvas, DestRect, Src.Canvas, SrcPos, Rop); 825 821 end; 826 822 … … 904 900 end else 905 901 Frame(ca, x - 1, y - 1, x + Width, y + Height, $000000, $000000); 906 DpiBitBlt(ca.Handle, x, y, Width, Height, Src.Canvas.Handle, xSrc, ySrc, 907 SRCCOPY); 902 DpiBitCanvas(ca, x, y, Width, Height, Src.Canvas, xSrc, ySrc); 908 903 end; 909 904 … … 920 915 Height := ScaleToVcl(Height); 921 916 dst.BeginUpdate; 922 DstPtr .Init(dst, x0, y0);917 DstPtr := PixelPointer(dst, x0, y0); 923 918 for y := -DpiGlowRange + 1 to Height - 1 + DpiGlowRange - 1 do begin 924 919 for x := -DpiGlowRange + 1 to Width - 1 + DpiGlowRange - 1 do begin … … 946 941 if r = 0 then 947 942 r := 1; 948 if r < GlowRange then943 if r < DpiGlowRange then 949 944 for ch := 0 to 2 do 950 945 DstPtr.Pixel^.Planes[2 - ch] := … … 991 986 $FF * intensity div $FF shl 16; 992 987 end; 993 DpiBit Blt(GrExt[HGrSystem].Mask.Canvas.Handle, 77, 47, 10, 10,994 GrExt[HGrSystem].Mask.Canvas .Handle, 66, 47, SRCCOPY);988 DpiBitCanvas(GrExt[HGrSystem].Mask.Canvas, 77, 47, 10, 10, 989 GrExt[HGrSystem].Mask.Canvas, 66, 47); 995 990 end; 996 991 … … 999 994 Assert((Left + xOffset >= 0) and (Left + xOffset + Width <= wMainTexture) and 1000 995 (Top + yOffset >= 0) and (Top + yOffset + Height <= hMainTexture)); 1001 DpiBitBlt(ca.Handle, Left, Top, Width, Height, MainTexture.Image.Canvas.Handle, 1002 Left + xOffset, Top + yOffset, SRCCOPY); 996 DpiBitCanvas(ca, Left, Top, Width, Height, MainTexture.Image.Canvas, 997 Left + xOffset, Top + yOffset); 998 end; 999 1000 procedure Fill(Canvas: TDpiCanvas; Rect: TRect; Offset: TPoint); 1001 begin 1002 Fill(Canvas, Rect.Left, Rect.Top, Rect.Width, Rect.Height, Offset.X, Offset.Y); 1003 1003 end; 1004 1004 … … 1021 1021 begin 1022 1022 for I := 0 to (x1 - xm) div wMainTexture - 1 do 1023 DpiBit Blt(ca.Handle, xm + I * wMainTexture, y0, wMainTexture, y1 - y0,1024 MainTexture.Image.Canvas .Handle, 0, hMainTexture div 2 + Band(I) *1025 (y1 - y0) , SRCCOPY);1026 DpiBit Blt(ca.Handle, xm + ((x1 - xm) div wMainTexture) * wMainTexture, y0,1023 DpiBitCanvas(ca, xm + I * wMainTexture, y0, wMainTexture, y1 - y0, 1024 MainTexture.Image.Canvas, 0, hMainTexture div 2 + Band(I) * 1025 (y1 - y0)); 1026 DpiBitCanvas(ca, xm + ((x1 - xm) div wMainTexture) * wMainTexture, y0, 1027 1027 x1 - (xm + ((x1 - xm) div wMainTexture) * wMainTexture), y1 - y0, 1028 MainTexture.Image.Canvas .Handle, 0, hMainTexture div 2 + Band(1029 (x1 - xm) div wMainTexture) * (y1 - y0) , SRCCOPY);1028 MainTexture.Image.Canvas, 0, hMainTexture div 2 + Band( 1029 (x1 - xm) div wMainTexture) * (y1 - y0)); 1030 1030 for I := 0 to (xm - x0) div wMainTexture - 1 do 1031 DpiBit Blt(ca.Handle, xm - (I + 1) * wMainTexture, y0, wMainTexture, y1 - y0,1032 MainTexture.Image.Canvas .Handle, 0, hMainTexture div 2 +1033 Band(-I - 1) * (y1 - y0) , SRCCOPY);1034 DpiBit Blt(ca.Handle, x0, y0, xm - ((xm - x0) div wMainTexture) *1035 wMainTexture - x0, y1 - y0, MainTexture.Image.Canvas .Handle,1031 DpiBitCanvas(ca, xm - (I + 1) * wMainTexture, y0, wMainTexture, y1 - y0, 1032 MainTexture.Image.Canvas, 0, hMainTexture div 2 + 1033 Band(-I - 1) * (y1 - y0)); 1034 DpiBitCanvas(ca, x0, y0, xm - ((xm - x0) div wMainTexture) * 1035 wMainTexture - x0, y1 - y0, MainTexture.Image.Canvas, 1036 1036 ((xm - x0) div wMainTexture + 1) * wMainTexture - (xm - x0), 1037 hMainTexture div 2 + Band(-(xm - x0) div wMainTexture - 1) * (y1 - y0) , SRCCOPY);1037 hMainTexture div 2 + Band(-(xm - x0) div wMainTexture - 1) * (y1 - y0)); 1038 1038 end; 1039 1039 … … 1065 1065 if x1cut < 0 then 1066 1066 x1cut := 0; 1067 DpiBit Blt(ca.Handle, x * Texture.Width + x0cut - xOffset,1067 DpiBitCanvas(ca, x * Texture.Width + x0cut - xOffset, 1068 1068 y * Texture.Height + y0cut - yOffset, Texture.Width - x0cut - x1cut, 1069 Texture.Height - y0cut - y1cut, Texture.Canvas.Handle, x0cut, 1070 y0cut, SRCCOPY); 1069 Texture.Height - y0cut - y1cut, Texture.Canvas, x0cut, y0cut); 1071 1070 end; 1072 1071 end; … … 1087 1086 procedure Corner(ca: TDpiCanvas; x, y, Kind: Integer; const T: TTexture); 1088 1087 begin 1089 { DpiBit Blt(ca.Handle,x,y,8,8,GrExt[T.HGr].Mask.Canvas.Handle,1088 { DpiBitCanvas(ca,x,y,8,8,GrExt[T.HGr].Mask.Canvas, 1090 1089 T.xGr+29+Kind*9,T.yGr+89,SRCAND); 1091 DpiBit Blt(ca.Handle,x,y,8,8,GrExt[T.HGr].Data.Canvas.Handle,1090 DpiBitCanvas(ca,x,y,8,8,GrExt[T.HGr].Data.Canvas, 1092 1091 T.xGr+29+Kind*9,T.yGr+89,SRCPAINT); } 1093 1092 end; … … 1097 1096 procedure PaintIcon(x, y, Kind: Integer); 1098 1097 begin 1099 DpiBit Blt(ca.Handle, x, y + 6, 10, 10, GrExt[HGrSystem].Mask.Canvas.Handle,1098 DpiBitCanvas(ca, x, y + 6, 10, 10, GrExt[HGrSystem].Mask.Canvas, 1100 1099 66 + Kind mod 11 * 11, 115 + Kind div 11 * 11, SRCAND); 1101 DpiBit Blt(ca.Handle, x, y + 6, 10, 10, GrExt[HGrSystem].Data.Canvas.Handle,1100 DpiBitCanvas(ca, x, y + 6, 10, 10, GrExt[HGrSystem].Data.Canvas, 1102 1101 66 + Kind mod 11 * 11, 115 + Kind div 11 * 11, SRCPAINT); 1103 1102 end; … … 1321 1320 for i := 0 to val mod 10 - 1 do 1322 1321 begin 1323 DpiBit Blt(Handle, xIcon + 4 + i * (14 * ld div sd), yIcon + 2 + 1, 14,1324 14, GrExt[HGrSystem].Mask.Canvas .Handle, 67 + Kind mod 8 * 15,1322 DpiBitCanvas(dst.Canvas, xIcon + 4 + i * (14 * ld div sd), yIcon + 2 + 1, 14, 1323 14, GrExt[HGrSystem].Mask.Canvas, 67 + Kind mod 8 * 15, 1325 1324 70 + Kind div 8 * 15, SRCAND); 1326 1325 Sprite(dst, HGrSystem, xIcon + 3 + i * (14 * ld div sd), yIcon + 2, … … 1329 1328 for i := 0 to val div 10 - 1 do 1330 1329 begin 1331 DpiBit Blt(dst.Canvas.Handle, xIcon + 4 + (val mod 10) *1330 DpiBitCanvas(dst.Canvas, xIcon + 4 + (val mod 10) * 1332 1331 (14 * ld div sd) + i * (14 * ld div sd), yIcon + 3, 14, 14, 1333 GrExt[HGrSystem].Mask.Canvas .Handle, 67 + 7 mod 8 * 15,1332 GrExt[HGrSystem].Mask.Canvas, 67 + 7 mod 8 * 15, 1334 1333 70 + 7 div 8 * 15, SRCAND); 1335 1334 Sprite(dst, HGrSystem, xIcon + 3 + (val mod 10) * … … 1354 1353 for i := 0 to val div 10 - 1 do 1355 1354 begin 1356 DpiBit Blt(Handle, xIcon + 4 + i * (14 * ld div sd), yIcon + 3, 14, 14,1357 GrExt[HGrSystem].Mask.Canvas .Handle, 67 + Kind mod 8 * 15,1355 DpiBitCanvas(dst.Canvas, xIcon + 4 + i * (14 * ld div sd), yIcon + 3, 14, 14, 1356 GrExt[HGrSystem].Mask.Canvas, 67 + Kind mod 8 * 15, 1358 1357 70 + Kind div 8 * 15, SRCAND); 1359 1358 Sprite(dst, HGrSystem, xIcon + 3 + i * (14 * ld div sd), yIcon + 2, … … 1362 1361 for i := 0 to val mod 10 - 1 do 1363 1362 begin 1364 DpiBit Blt(dst.Canvas.Handle, xIcon + 4 + (val div 10) *1363 DpiBitCanvas(dst.Canvas, xIcon + 4 + (val div 10) * 1365 1364 (14 * ld div sd) + i * (10 * ld div sd), yIcon + 7, 10, 10, 1366 GrExt[HGrSystem].Mask.Canvas .Handle, 66 + Kind mod 11 * 11,1365 GrExt[HGrSystem].Mask.Canvas, 66 + Kind mod 11 * 11, 1367 1366 115 + Kind div 11 * 11, SRCAND); 1368 1367 Sprite(dst, HGrSystem, xIcon + 3 + (val div 10) * … … 1399 1398 begin 1400 1399 for i := 0 to pos div 8 - 1 do 1401 DpiBit Blt(Handle, x + i * 8, y, 8, 7,1402 GrExt[HGrSystem].Data.Canvas .Handle, 104, 9 + 8 * Kind, SRCCOPY);1403 DpiBit Blt(Handle, x + 8 * (pos div 8), y, pos - 8 * (pos div 8), 7,1404 GrExt[HGrSystem].Data.Canvas .Handle, 104, 9 + 8 * Kind, SRCCOPY);1400 DpiBitCanvas(ca, x + i * 8, y, 8, 7, 1401 GrExt[HGrSystem].Data.Canvas, 104, 9 + 8 * Kind); 1402 DpiBitCanvas(ca, x + 8 * (pos div 8), y, pos - 8 * (pos div 8), 7, 1403 GrExt[HGrSystem].Data.Canvas, 104, 9 + 8 * Kind); 1405 1404 if Growth > 0 then 1406 1405 begin 1407 1406 for i := 0 to Growth div 8 - 1 do 1408 DpiBit Blt(Handle, x + pos + i * 8, y, 8, 7,1409 GrExt[HGrSystem].Data.Canvas .Handle, 112, 9 + 8 * Kind, SRCCOPY);1410 DpiBit Blt(Handle, x + pos + 8 * (Growth div 8), y,1411 Growth - 8 * (Growth div 8), 7, GrExt[HGrSystem].Data.Canvas .Handle,1412 112, 9 + 8 * Kind , SRCCOPY);1407 DpiBitCanvas(ca, x + pos + i * 8, y, 8, 7, 1408 GrExt[HGrSystem].Data.Canvas, 112, 9 + 8 * Kind); 1409 DpiBitCanvas(ca, x + pos + 8 * (Growth div 8), y, 1410 Growth - 8 * (Growth div 8), 7, GrExt[HGrSystem].Data.Canvas, 1411 112, 9 + 8 * Kind); 1413 1412 end 1414 1413 else if Growth < 0 then 1415 1414 begin 1416 1415 for i := 0 to -Growth div 8 - 1 do 1417 DpiBit Blt(Handle, x + pos + i * 8, y, 8, 7,1418 GrExt[HGrSystem].Data.Canvas .Handle, 104, 1, SRCCOPY);1419 DpiBit Blt(Handle, x + pos + 8 * (-Growth div 8), y, -Growth -1416 DpiBitCanvas(ca, x + pos + i * 8, y, 8, 7, 1417 GrExt[HGrSystem].Data.Canvas, 104, 1); 1418 DpiBitCanvas(ca, x + pos + 8 * (-Growth div 8), y, -Growth - 1420 1419 8 * (-Growth div 8), 7, 1421 GrExt[HGrSystem].Data.Canvas .Handle, 104, 1, SRCCOPY);1420 GrExt[HGrSystem].Data.Canvas, 104, 1); 1422 1421 end; 1423 1422 Brush.Color := $000000; … … 1444 1443 procedure PaintLogo(ca: TDpiCanvas; x, y, clLight, clShade: Integer); 1445 1444 begin 1446 BitBltCanvas(LogoBuffer.Canvas, 0, 0, wLogo, hLogo, ca, x, 1447 y, SRCCOPY); 1445 // TODO: Explicitly clear background to black but in fact BitBlt SRCCOPY should do it 1446 LogoBuffer.Canvas.FillRect(0, 0, LogoBuffer.Width, LogoBuffer.Height); 1447 DpiBitCanvas(LogoBuffer.Canvas, 0, 0, wLogo, hLogo, ca, x, y); 1448 1448 ImageOp_BCC(LogoBuffer, Templates, 0, 0, 1, 1, wLogo, hLogo, 1449 1449 clLight, clShade); 1450 DpiBitBlt(ca.Handle, x, y, wLogo, hLogo, LogoBuffer.Canvas.Handle, 0, 1451 0, SRCCOPY); 1450 DpiBitCanvas(ca, x, y, wLogo, hLogo, LogoBuffer.Canvas, 0, 0); 1452 1451 end; 1453 1452 … … 1457 1456 with MainTexture do begin 1458 1457 MainTextureAge := Age; 1459 LoadGraphicFile(Image, HomeDir + 'Graphics'+ DirectorySeparator +1458 LoadGraphicFile(Image, GetGraphicsDir + DirectorySeparator + 1460 1459 'Texture' + IntToStr(Age + 1) + '.jpg'); 1461 1460 clBevelLight := Colors.Canvas.Pixels[clkAge0 + Age, cliBevelLight]; … … 1473 1472 end; 1474 1473 1475 { TPixelPointer }1476 1477 procedure TPixelPointer.NextLine; inline;1478 begin1479 Line := Pointer(Line) + BytesPerLine;1480 Pixel := Line;1481 end;1482 1483 procedure TPixelPointer.NextPixel; inline;1484 begin1485 Pixel := Pointer(Pixel) + BytesPerPixel;1486 end;1487 1488 procedure TPixelPointer.SetXY(X, Y: Integer); inline;1489 begin1490 Line := Pointer(Base) + Y * BytesPerLine;1491 SetX(X);1492 end;1493 1494 procedure TPixelPointer.SetX(X: Integer); inline;1495 begin1496 Pixel := Pointer(Line) + X * BytesPerPixel;1497 end;1498 1499 procedure TPixelPointer.Init(Bitmap: TDpiRasterImage; BaseX: Integer = 0;1500 BaseY: integer = 0); inline;1501 begin1502 BytesPerLine := Bitmap.RawImage.Description.BytesPerLine;1503 BytesPerPixel := Bitmap.RawImage.Description.BitsPerPixel shr 3;1504 Base := PPixel32(Bitmap.RawImage.Data + BaseX * BytesPerPixel + BaseY * BytesPerLine);1505 SetXY(0, 0);1506 end;1507 1508 1474 procedure LoadPhrases; 1509 1475 begin 1510 if Phrases = nil then 1511 Phrases := TStringTable.Create; 1512 if Phrases2 = nil then 1513 Phrases2 := TStringTable.Create; 1476 if Phrases = nil then Phrases := TStringTable.Create; 1477 if Phrases2 = nil then Phrases2 := TStringTable.Create; 1514 1478 Phrases2FallenBackToEnglish := False; 1515 1479 if FileExists(LocalizedFilePath('Language.txt')) then 1516 1480 begin 1517 Phrases. loadfromfile(LocalizedFilePath('Language.txt'));1481 Phrases.LoadFromFile(LocalizedFilePath('Language.txt')); 1518 1482 if FileExists(LocalizedFilePath('Language2.txt')) then 1519 Phrases2. loadfromfile(LocalizedFilePath('Language2.txt'))1483 Phrases2.LoadFromFile(LocalizedFilePath('Language2.txt')) 1520 1484 else 1521 1485 begin 1522 Phrases2. loadfromfile(HomeDir + 'Language2.txt');1486 Phrases2.LoadFromFile(HomeDir + 'Language2.txt'); 1523 1487 Phrases2FallenBackToEnglish := True; 1524 1488 end; … … 1526 1490 else 1527 1491 begin 1528 Phrases.loadfromfile(HomeDir + 'Language.txt'); 1529 Phrases2.loadfromfile(HomeDir + 'Language2.txt'); 1530 end; 1531 1532 if Sounds = nil then 1533 Sounds := TStringTable.Create; 1534 if not Sounds.loadfromfile(HomeDir + 'Sounds' + DirectorySeparator + 'sound.txt') then 1492 Phrases.LoadFromFile(HomeDir + 'Language.txt'); 1493 Phrases2.LoadFromFile(HomeDir + 'Language2.txt'); 1494 end; 1495 1496 if Sounds = nil then Sounds := TStringTable.Create; 1497 if not Sounds.LoadFromFile(GetSoundsDir + DirectorySeparator + 'sound.txt') then 1535 1498 begin 1536 1499 FreeAndNil(Sounds); 1537 1500 end; 1501 end; 1502 1503 procedure Texturize(Dest, Texture: TDpiBitmap; TransparentColor: Integer); 1504 var 1505 SrcPixel, DstPixel: TPixelPointer; 1506 X, Y: Integer; 1507 TexWidth, TexHeight: Integer; 1508 begin 1509 // texturize background 1510 Dest.BeginUpdate; 1511 TexWidth := ScaleToVcl(Texture.Width); 1512 TexHeight := ScaleToVcl(Texture.Height); 1513 DstPixel := PixelPointer(Dest); 1514 SrcPixel := PixelPointer(Texture); 1515 for Y := 0 to ScaleToVcl(Dest.Height) - 1 do begin 1516 for X := 0 to ScaleToVcl(Dest.Width) - 1 do begin 1517 if (DstPixel.Pixel^.ARGB and $FFFFFF) = TransparentColor then begin 1518 SrcPixel.SetXY(X mod TexWidth, Y mod TexHeight); 1519 DstPixel.Pixel^.B := SrcPixel.Pixel^.B; 1520 DstPixel.Pixel^.G := SrcPixel.Pixel^.G; 1521 DstPixel.Pixel^.R := SrcPixel.Pixel^.R; 1522 end; 1523 DstPixel.NextPixel; 1524 end; 1525 DstPixel.NextLine; 1526 end; 1527 Dest.EndUpdate; 1528 end; 1529 1530 procedure DarkenImage(Bitmap: TDpiBitmap; Change: Integer); 1531 var 1532 x, y: integer; 1533 PicturePixel: TPixelPointer; 1534 begin 1535 Bitmap.BeginUpdate; 1536 PicturePixel := PixelPointer(Bitmap); 1537 for y := 0 to ScaleToVcl(Bitmap.Height) - 1 do begin 1538 for x := 0 to ScaleToVcl(Bitmap.Width) - 1 do begin 1539 PicturePixel.Pixel^.B := Max(PicturePixel.Pixel^.B - Change, 0); 1540 PicturePixel.Pixel^.G := Max(PicturePixel.Pixel^.G - Change, 0); 1541 PicturePixel.Pixel^.R := Max(PicturePixel.Pixel^.R - Change, 0); 1542 PicturePixel.NextPixel; 1543 end; 1544 PicturePixel.NextLine; 1545 end; 1546 Bitmap.EndUpdate; 1538 1547 end; 1539 1548 … … 1547 1556 P: integer; 1548 1557 begin 1549 for Section := Low(TFontType) to High(TFontType) do1550 UniFont[Section] := TDpiFont.Create;1551 1552 1558 Section := ftNormal; 1553 1559 AssignFile(FontScript, LocalizedFilePath('Fonts.txt')); 1554 1560 try 1555 Reset( fontscript);1556 while not E OF(FontScript) do begin1561 Reset(FontScript); 1562 while not Eof(FontScript) do begin 1557 1563 ReadLn(FontScript, s); 1558 1564 if s <> '' then 1559 1565 if s[1] = '#' then begin 1560 1566 s := TrimRight(s); 1561 if s = '#SMALL' then 1562 Section := ftSmall 1563 else if s = '#TINY' then 1564 Section := ftTiny 1565 else if s = '#CAPTION' then 1566 Section := ftCaption 1567 else if s = '#BUTTON' then 1568 Section := ftButton 1569 else 1570 Section := ftNormal; 1567 if s = '#SMALL' then Section := ftSmall 1568 else if s = '#TINY' then Section := ftTiny 1569 else if s = '#CAPTION' then Section := ftCaption 1570 else if s = '#BUTTON' then Section := ftButton 1571 else Section := ftNormal; 1571 1572 end else begin 1572 1573 p := Pos(',', s); 1573 1574 if p > 0 then begin 1574 UniFont[ Section].Name := Trim(Copy(s, 1, p - 1));1575 UniFont[section].Name := Trim(Copy(s, 1, p - 1)); 1575 1576 Size := 0; 1576 1577 for i := p + 1 to Length(s) do … … 1585 1586 // 0.8 constant is compensation for Lazarus as size of fonts against Delphi differs 1586 1587 UniFont[section].Size := 1587 Round( Size * Screen.PixelsPerInch / UniFont[section].PixelsPerInch);1588 Round(size * DpiScreen.PixelsPerInch / UniFont[section].PixelsPerInch * 0.8); 1588 1589 end; 1589 1590 end; … … 1615 1616 end; 1616 1617 1618 procedure LoadAssets; 1619 begin 1620 LoadPhrases; 1621 LoadFonts; 1622 LoadGraphicFile(Templates, GetGraphicsDir + DirectorySeparator + 1623 'Templates.png', gfNoGamma); 1624 LoadGraphicFile(Colors, GetGraphicsDir + DirectorySeparator + 'Colors.png'); 1625 LoadGraphicFile(Paper, GetGraphicsDir + DirectorySeparator + 'Paper.jpg'); 1626 LoadGraphicFile(BigImp, GetGraphicsDir + DirectorySeparator + 'Icons.png'); 1627 end; 1628 1617 1629 procedure UnitInit; 1618 1630 var 1619 Reg: TRegistry; 1620 begin 1621 Reg := TRegistry.Create; 1622 with Reg do 1623 try 1624 OpenKey(AppRegistryKey, True); 1625 if ValueExists('Gamma') then 1626 Gamma := ReadInteger('Gamma') 1627 else 1628 begin 1629 Gamma := 100; 1630 WriteInteger('Gamma', Gamma); 1631 end; 1632 if ValueExists('Locale') then 1633 LocaleCode := ReadString('Locale') 1634 else 1635 LocaleCode := ''; 1636 finally 1637 Free; 1638 end; 1639 1640 if Gamma <> 100 then InitGammaLookupTable; 1631 Section: TFontType; 1632 begin 1633 Gamma := 100; 1634 InitGammaLookupTable; 1641 1635 1642 1636 {$IFDEF WINDOWS} … … 1645 1639 {$ENDIF} 1646 1640 1647 LoadPhrases;1648 1649 1641 LogoBuffer := TDpiBitmap.Create; 1650 1642 LogoBuffer.PixelFormat := pf24bit; 1651 1643 LogoBuffer.SetSize(wBBook, hBBook); 1652 1644 1653 LoadFonts; 1645 for Section := Low(TFontType) to High(TFontType) do 1646 UniFont[Section] := TDpiFont.Create; 1654 1647 1655 1648 nGrExt := 0; … … 1658 1651 Templates := TDpiBitmap.Create; 1659 1652 Templates.PixelFormat := pf24bit; 1660 LoadGraphicFile(Templates, HomeDir + 'Graphics' + DirectorySeparator +1661 'Templates.png', gfNoGamma);1662 1653 Colors := TDpiBitmap.Create; 1663 1654 Colors.PixelFormat := pf24bit; 1664 LoadGraphicFile(Colors, HomeDir + 'Graphics' + DirectorySeparator + 'Colors.png');1665 1655 Paper := TDpiBitmap.Create; 1666 1656 Paper.PixelFormat := pf24bit; 1667 LoadGraphicFile(Paper, HomeDir + 'Graphics' + DirectorySeparator + 'Paper.jpg');1668 1657 BigImp := TDpiBitmap.Create; 1669 1658 BigImp.PixelFormat := pf24bit; 1670 LoadGraphicFile(BigImp, HomeDir + 'Graphics' + DirectorySeparator + 'Icons.png');1671 1659 MainTexture.Image := TDpiBitmap.Create; 1672 1660 MainTextureAge := -2; … … 1674 1662 InitOrnamentDone := False; 1675 1663 GenerateNames := True; 1664 1665 LoadAssets; 1676 1666 end; 1677 1667 1678 1668 procedure UnitDone; 1679 1669 var 1680 Reg: TRegistry;1681 1670 I: integer; 1682 1671 begin 1683 Reg := TRegistry.Create;1684 with Reg do1685 try1686 OpenKey(AppRegistryKey, True);1687 WriteString('Locale', LocaleCode);1688 WriteInteger('Gamma', Gamma);1689 finally1690 Free;1691 end;1692 1693 1672 RestoreResolution; 1694 1673 for I := 0 to nGrExt - 1 do begin … … 1702 1681 FreeAndNil(Phrases); 1703 1682 FreeAndNil(Phrases2); 1704 if Sounds <> nil then1705 FreeAndNil(Sounds);1706 1683 FreeAndNil(LogoBuffer); 1707 1684 FreeAndNil(BigImp); -
branches/highdpi/Packages/CevoComponents/Sound.pas
r178 r210 4 4 5 5 uses 6 Messages, SysUtils, Classes, Graphics, Controls, Forms, fgl 7 {$IFDEF WINDOWS}, MMSystem, Windows{$ENDIF}; 6 UDpiControls, SysUtils, Classes, Graphics, Controls, Forms, fgl, FileUtil, 7 StringTables, Directories 8 {$IFDEF WINDOWS}, MMSystem, Windows{$ENDIF} 9 {$IFDEF LINUX}, Process, AsyncProcess{$ENDIF}; 8 10 9 11 type 10 TSoundPlayer = class(TForm) 12 TPlayStyle = (psAsync, psSync); 13 14 { TSoundPlayer } 15 16 TSoundPlayer = class(TDpiForm) 11 17 private 12 18 {$IFDEF WINDOWS} 19 PrevWndProc: WNDPROC; 13 20 procedure OnMCI(var m: TMessage); message MM_MCINOTIFY; 21 public 22 constructor Create(AOwner: TComponent); override; 14 23 {$ENDIF} 15 24 end; 16 25 17 function PrepareSound(FileName: string): integer; 18 procedure PlaySound(FileName: string); 19 20 implementation 21 22 {$R *.lfm} 23 24 type 26 { TSound } 27 25 28 TSound = class 29 private 30 {$IFDEF LINUX} 31 PlayCommand: string; 32 SoundPlayerAsyncProcess: TAsyncProcess; 33 SoundPlayerSyncProcess: TProcess; 34 {$ENDIF} 35 function GetNonWindowsPlayCommand: string; 26 36 public 27 FDeviceID: word;37 FDeviceID: Word; 28 38 FFileName: string; 39 PlayStyle: TPlayStyle; 29 40 constructor Create(const FileName: string); 30 41 destructor Destroy; override; … … 34 45 end; 35 46 47 function PrepareSound(FileName: string): Integer; 48 procedure PlaySound(FileName: string); 49 function Play(Item: string; Index: Integer = -1): Boolean; 50 procedure PreparePlay(Item: string; Index: Integer = -1); 51 52 const 53 // sound modes 54 smOff = 0; 55 smOn = 1; 56 smOnAlt = 2; 57 58 var 59 Sounds: TStringTable; 60 SoundMode: Integer; 61 SoundPlayer: TSoundPlayer; 62 SoundList: TFPGObjectList<TSound>; 63 PlayingSound: TSound; 64 65 66 implementation 67 68 {$R *.lfm} 69 70 resourcestring 71 SUnableToPlay = 'PlayStyle=%s: Unable to play %s Message:%s'; 72 SPlayCommandNotWork = 'The play command %s does not work on your system'; 36 73 37 74 constructor TSound.Create(const FileName: string); … … 41 78 {$ENDIF} 42 79 begin 80 PlayStyle := psAsync; 81 FFileName := FileName; 43 82 {$IFDEF WINDOWS} 44 83 FDeviceID := 0; 45 FFileName := FileName; 46 if FileExists(FFileName) then 47 begin 84 if FileExists(FFileName) then begin 48 85 OpenParm.dwCallback := 0; 49 86 OpenParm.lpstrDeviceType := 'WaveAudio'; 50 87 OpenParm.lpstrElementName := PChar(FFileName); 51 88 mciSendCommand(0, MCI_Open, MCI_WAIT or MCI_OPEN_ELEMENT or 52 MCI_OPEN_SHAREABLE, integer(@OpenParm));89 MCI_OPEN_SHAREABLE, DWORD_PTR(@OpenParm)); 53 90 FDeviceID := OpenParm.wDeviceID; 54 91 end 55 92 {$ENDIF} 93 {$IFDEF LINUX} 94 PlayCommand := GetNonWindowsPlayCommand; 95 FDeviceID := 1; 96 {$ENDIF} 56 97 end; 57 98 … … 62 103 mciSendCommand(FDeviceID, MCI_CLOSE, MCI_WAIT, 0); 63 104 {$ENDIF} 64 inherited Destroy; 65 end; 105 {$IFDEF LINUX} 106 FreeAndNil(SoundPlayerSyncProcess); 107 FreeAndNil(SoundPlayerAsyncProcess); 108 {$ENDIF} 109 inherited; 110 end; 111 112 function TSound.GetNonWindowsPlayCommand: string; 113 begin 114 Result := ''; 115 // Try play 116 if (FindDefaultExecutablePath('play') <> '') then 117 Result := 'play'; 118 // Try aplay 119 if (result = '') then 120 if (FindDefaultExecutablePath('aplay') <> '') then 121 Result := 'aplay -q'; 122 // Try paplay 123 if (Result = '') then 124 if (FindDefaultExecutablePath('paplay') <> '') then 125 Result := 'paplay'; 126 // Try mplayer 127 if (Result = '') then 128 if (FindDefaultExecutablePath('mplayer') <> '') then 129 Result := 'mplayer -really-quiet'; 130 // Try CMus 131 if (Result = '') then 132 if (FindDefaultExecutablePath('CMus') <> '') then 133 Result := 'CMus'; 134 // Try pacat 135 if (Result = '') then 136 if (FindDefaultExecutablePath('pacat') <> '') then 137 Result := 'pacat -p'; 138 // Try ffplay 139 if (Result = '') then 140 if (FindDefaultExecutablePath('ffplay') <> '') then 141 result := 'ffplay -autoexit -nodisp'; 142 // Try cvlc 143 if (Result = '') then 144 if (FindDefaultExecutablePath('cvlc') <> '') then 145 result := 'cvlc -q --play-and-exit'; 146 // Try canberra-gtk-play 147 if (Result = '') then 148 if (FindDefaultExecutablePath('canberra-gtk-play') <> '') then 149 Result := 'canberra-gtk-play -c never -f'; 150 // Try Macintosh command? 151 if (Result = '') then 152 if (FindDefaultExecutablePath('afplay') <> '') then 153 Result := 'afplay'; 154 end; 155 66 156 67 157 procedure TSound.Play(HWND: DWORD); … … 69 159 var 70 160 PlayParm: TMCI_Play_Parms; 161 {$ENDIF} 162 {$IFDEF LINUX} 163 var 164 L: TStringList; 165 I: Integer; 71 166 {$ENDIF} 72 167 begin … … 78 173 end 79 174 {$ENDIF} 175 {$IFDEF LINUX} 176 // How to play in Linux? Use generic Linux commands 177 // Use asyncprocess to play sound as SND_ASYNC 178 // proceed if we managed to find a valid command 179 if PlayCommand <> '' then begin 180 L := TStringList.Create; 181 try 182 L.Delimiter := ' '; 183 L.DelimitedText := PlayCommand; 184 if PlayStyle = psASync then begin 185 if SoundPlayerAsyncProcess = nil then 186 SoundPlayerAsyncProcess := TAsyncProcess.Create(nil); 187 SoundPlayerAsyncProcess.CurrentDirectory := ExtractFileDir(FFilename); 188 SoundPlayerAsyncProcess.Executable := FindDefaultExecutablePath(L[0]); 189 SoundPlayerAsyncProcess.Parameters.Clear; 190 for I := 1 to L.Count - 1 do 191 SoundPlayerAsyncProcess.Parameters.Add(L[I]); 192 SoundPlayerAsyncProcess.Parameters.Add(FFilename); 193 try 194 SoundPlayerAsyncProcess.Execute; 195 except 196 On E: Exception do 197 E.CreateFmt(SUnableToPlay, ['paASync', FFilename, E.Message]); 198 end; 199 PlayingSound := nil; 200 end else begin 201 if SoundPlayerSyncProcess = nil then 202 SoundPlayerSyncProcess := TProcess.Create(nil); 203 SoundPlayerSyncProcess.CurrentDirectory := ExtractFileDir(FFilename); 204 SoundPlayerSyncProcess.Executable := FindDefaultExecutablePath(L[0]); 205 SoundPlayersyncProcess.Parameters.Clear; 206 for I := 1 to L.Count - 1 do 207 SoundPlayerSyncProcess.Parameters.Add(L[I]); 208 SoundPlayerSyncProcess.Parameters.Add(FFilename); 209 try 210 SoundPlayerSyncProcess.Execute; 211 SoundPlayersyncProcess.WaitOnExit; 212 except 213 On E: Exception do 214 E.CreateFmt(SUnableToPlay, ['paSync', FFilename, E.Message]); 215 end; 216 PlayingSound := nil; 217 end; 218 finally 219 L.Free; 220 end; 221 end 222 else 223 raise Exception.CreateFmt(SPlayCommandNotWork, [PlayCommand]); 224 {$ENDIF} 80 225 end; 81 226 … … 85 230 mciSendCommand(FDeviceID, MCI_STOP, 0, 0); 86 231 {$ENDIF} 232 {$IFDEF LINUX} 233 if SoundPlayerSyncProcess <> nil then SoundPlayerSyncProcess.Terminate(1); 234 if SoundPlayerAsyncProcess <> nil then SoundPlayerAsyncProcess.Terminate(1); 235 {$ENDIF} 87 236 end; 88 237 … … 94 243 end; 95 244 96 97 var98 SoundPlayer: TSoundPlayer;99 SoundList: TFPGObjectList<TSound>;100 PlayingSound: TSound;101 102 245 {$IFDEF WINDOWS} 246 function WndCallback(Ahwnd: HWND; uMsg: UINT; wParam: WParam; lParam: LParam):LRESULT; stdcall; 247 var 248 Message: TMessage; 249 begin 250 if (uMsg = MM_MCINOTIFY) then begin 251 Message.msg := uMsg; 252 Message.wParam := wParam; 253 Message.lParam := lParam; 254 SoundPlayer.OnMCI(Message); 255 end; 256 Result := CallWindowProc(SoundPlayer.PrevWndProc, Ahwnd, uMsg, WParam, LParam); 257 end; 258 103 259 procedure TSoundPlayer.OnMCI(var m: TMessage); 104 260 begin 105 if (m.wParam = MCI_N otify_Successful) and (PlayingSound <> nil) then261 if (m.wParam = MCI_NOTIFY_SUCCESSFUL) and (PlayingSound <> nil) then 106 262 begin 107 263 PlayingSound.Reset; … … 109 265 end; 110 266 end; 267 268 constructor TSoundPlayer.Create(AOwner: TComponent); 269 begin 270 inherited; 271 // MM_MCINOTIFY is not handled by LCL, fallback to low lever handling 272 // https://wiki.lazarus.freepascal.org/Win32/64_Interface#Processing_non-user_messages_in_your_window 273 PrevWndProc := Windows.WNDPROC(SetWindowLongPtr(Self.Handle, GWL_WNDPROC, PtrInt(@WndCallback))); 274 end; 111 275 {$ENDIF} 112 276 113 function PrepareSound(FileName: string): integer;277 function PrepareSound(FileName: string): Integer; 114 278 begin 115 279 Result := 0; 116 while ( result < SoundList.Count) and (SoundList[result].FFileName <> FileName) do117 inc(result);118 if result = SoundList.Count then begin119 // first time this sound is played280 while (Result < SoundList.Count) and (SoundList[result].FFileName <> FileName) do 281 Inc(Result); 282 if Result = SoundList.Count then begin 283 // First time this sound is played 120 284 SoundList.Add(TSound.Create(FileName)); 121 285 Result := SoundList.Count - 1; … … 125 289 procedure PlaySound(FileName: string); 126 290 begin 127 if PlayingSound <> nil then 128 exit; 291 if PlayingSound <> nil then Exit; 129 292 if SoundPlayer = nil then 130 Application.CreateForm(TSoundPlayer, SoundPlayer);293 DpiApplication.CreateForm(TSoundPlayer, SoundPlayer); 131 294 PlayingSound := SoundList[PrepareSound(FileName)]; 132 295 if PlayingSound.FDeviceID = 0 then … … 136 299 end; 137 300 301 function Play(Item: string; Index: Integer = -1): Boolean; 302 var 303 WavFileName: string; 304 begin 305 Result := False; 306 if (Sounds = nil) or (SoundMode = smOff) or (Item = '') then 307 begin 308 Result := True; 309 Exit; 310 end; 311 WavFileName := Sounds.Lookup(Item, Index); 312 Assert(WavFileName[1] <> '['); 313 Result := (WavFileName <> '') and (WavFileName[1] <> '[') and (WavFileName <> '*'); 314 if Result then 315 // SndPlaySound(pchar(GetSoundsDir + DirectorySeparator + WavFileName + '.wav'), SND_ASYNC) 316 PlaySound(GetSoundsDir + DirectorySeparator + WavFileName); 317 end; 318 319 procedure PreparePlay(Item: string; Index: Integer = -1); 320 var 321 WavFileName: string; 322 begin 323 if (Sounds = nil) or (SoundMode = smOff) or (Item = '') then 324 Exit; 325 WavFileName := Sounds.Lookup(Item, Index); 326 Assert(WavFileName[1] <> '['); 327 if (WavFileName <> '') and (WavFileName[1] <> '[') and (WavFileName <> '*') then 328 PrepareSound(GetSoundsDir + DirectorySeparator + WavFileName); 329 end; 330 138 331 procedure UnitInit; 139 332 begin … … 150 343 end; 151 344 FreeAndNil(SoundList); 345 if Sounds <> nil then 346 FreeAndNil(Sounds); 152 347 end; 153 348 -
branches/highdpi/Packages/CevoComponents/StringTables.pas
r178 r210 17 17 destructor Destroy; override; 18 18 function LoadFromFile(const FileName: String): boolean; 19 function GetHandle(const Item: AnsiString): integer;19 function GetHandle(const Item: string): integer; 20 20 function LookupByHandle(Handle: integer; Index: integer = -1): string; 21 21 function Lookup(const Item: string; Index: integer = -1): string; … … 55 55 end; 56 56 57 function TStringTable.GetHandle(const Item: AnsiString): integer;57 function TStringTable.GetHandle(const Item: string): integer; 58 58 var 59 59 I: Integer; -
branches/highdpi/Packages/CevoComponents/UPixelPointer.pas
r209 r210 1 unit PixelPointer;1 unit UPixelPointer; 2 2 3 3 interface 4 4 5 5 uses 6 Classes, SysUtils, Graphics;6 UDpiControls, Classes, SysUtils, Graphics; 7 7 8 8 type … … 31 31 procedure SetXY(X, Y: Integer); inline; // Set pixel position relative to base 32 32 procedure SetX(X: Integer); inline; // Set horizontal pixel position relative to base 33 procedure Init(Bitmap: TRasterImage; BaseX: Integer = 0; BaseY: Integer = 0); inline;34 33 end; 35 34 PPixelPointer = ^TPixelPointer; 35 36 function PixelPointer(Bitmap: TDpiRasterImage; BaseX: Integer = 0; BaseY: Integer = 0): TPixelPointer; inline; 36 37 37 38 … … 62 63 end; 63 64 64 procedure TPixelPointer.Init(Bitmap: TRasterImage; BaseX: Integer = 0;65 BaseY: Integer = 0); inline;65 function PixelPointer(Bitmap: TDpiRasterImage; BaseX: Integer; 66 BaseY: Integer): TPixelPointer; 66 67 begin 67 BytesPerLine := Bitmap.RawImage.Description.BytesPerLine; 68 BytesPerPixel := Bitmap.RawImage.Description.BitsPerPixel shr 3; 69 Base := PPixel32(Bitmap.RawImage.Data + BaseX * BytesPerPixel + BaseY * BytesPerLine); 70 SetXY(0, 0); 68 Result.BytesPerLine := Bitmap.RawImage.Description.BytesPerLine; 69 Result.BytesPerPixel := Bitmap.RawImage.Description.BitsPerPixel shr 3; 70 Result.Base := PPixel32(Bitmap.RawImage.Data + BaseX * Result.BytesPerPixel + 71 BaseY * Result.BytesPerLine); 72 Result.SetXY(0, 0); 71 73 end; 72 74 -
branches/highdpi/Packages/DpiControls/UDpiControls.pas
r193 r210 131 131 FParent: TDpiWinControl; 132 132 function GetAlign: TAlign; 133 function GetAnchors: TAnchors; 133 134 function GetBoundsRect: TRect; 134 135 function GetClientHeight: Integer; … … 141 142 function GetShowHint: Boolean; 142 143 function GetVisible: Boolean; 144 function IsAnchorsStored: Boolean; 143 145 procedure SetAlign(AValue: TAlign); 146 procedure SetAnchors(AValue: TAnchors); 144 147 procedure SetBoundsRect(AValue: TRect); 145 148 procedure SetClientHeight(AValue: Integer); … … 183 186 X, Y: Integer); virtual; 184 187 procedure MouseMove(Shift: TShiftState; X, Y: Integer); virtual; 188 procedure MouseLeave; virtual; 185 189 public 190 function ScreenToClient(const APoint: TPoint): TPoint; virtual; 191 function ClientToScreen(const APoint: TPoint): TPoint; virtual; 192 procedure AddHandlerOnVisibleChanged(const OnVisibleChangedEvent: TNotifyEvent; 193 AsFirst: boolean = false); 194 procedure RemoveHandlerOnVisibleChanged(const OnVisibleChangedEvent: TNotifyEvent); 186 195 procedure ScreenChanged; virtual; 187 196 procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); virtual; … … 196 205 property BoundsRect: TRect read GetBoundsRect write SetBoundsRect; 197 206 property Visible: Boolean read GetVisible write SetVisible; 207 property Anchors: TAnchors read GetAnchors write SetAnchors stored IsAnchorsStored default [akLeft, akTop]; 198 208 published 199 209 property ClientHeight: Integer read GetClientHeight write SetClientHeight; … … 237 247 function GetDpi: Integer; virtual; 238 248 public 239 constructor Create; 249 VclGraphicClass: TGraphicClass; 250 constructor Create; virtual; 240 251 procedure LoadFromFile(const Filename: string); virtual; 252 procedure SaveToFile(const Filename: string); virtual; 241 253 property Width: Integer read GetWidth write SetWidth; 242 254 property Height: Integer read GetHeight write SetHeight; … … 261 273 private 262 274 FFont: TDpiFont; 275 FVclCanvas: TCanvas; 263 276 function GetBrush: TBrush; 264 277 function GetHandle: HDC; … … 272 285 procedure SetPen(AValue: TPen); 273 286 procedure SetPixel(X, Y: Integer; AValue: TColor); 287 procedure SetVclCanvas(AValue: TCanvas); 274 288 protected 275 289 function GetVclCanvas: TCanvas; virtual; 276 290 public 277 VclCanvas: TCanvas;291 property VclCanvas: TCanvas read FVclCanvas write SetVclCanvas; 278 292 procedure StretchDraw(const DestRect: TRect; SrcGraphic: TDpiGraphic); virtual; 279 293 procedure FrameRect(Rect: TRect); … … 458 472 function GetVclForm: TForm; virtual; 459 473 procedure UpdateVclControl; override; 474 procedure AfterConstruction; override; 460 475 public 461 476 VclForm: TForm; … … 465 480 procedure BringToFront; 466 481 constructor Create(TheOwner: TComponent); override; 482 constructor CreateNew(AOwner: TComponent; Num: Integer = 0); virtual; 467 483 destructor Destroy; override; 468 484 published … … 547 563 property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle default bsNone; 548 564 property Visible; 565 property Anchors; 549 566 end; 550 567 … … 607 624 procedure EndUpdate; 608 625 procedure SetSize(AWidth, AHeight: Integer); 609 constructor Create; 626 constructor Create; override; 610 627 destructor Destroy; override; 611 628 procedure Assign(Source: TPersistent); override; … … 667 684 TDpiScreen = class 668 685 private 686 // TScreen 669 687 FDpi: Integer; 670 688 FActiveForm: TDpiForm; 689 FForms: TDpiForms; 690 procedure AddForm(AForm: TDpiForm); 671 691 function GetActiveForm: TDpiForm; 692 function GetCursor: TCursor; 693 function GetCursors(Index: Integer): HCURSOR; 672 694 function GetFormCount: Integer; 695 function GetForms(Index: Integer): TDpiForm; 673 696 function GetHeight: Integer; 674 697 function GetWidth: Integer; 675 698 procedure SetActiveForm(AValue: TDpiForm); 699 procedure SetCursor(AValue: TCursor); 700 procedure SetCursors(Index: Integer; AValue: HCURSOR); 676 701 procedure SetDpi(AValue: Integer); 677 702 procedure UpdateForms; 678 703 public 679 Forms: TDpiForms;680 704 constructor Create; 681 705 destructor Destroy; override; 682 706 property FormCount: Integer read GetFormCount; 707 property Forms[Index: Integer]: TDpiForm read GetForms; 683 708 property ActiveForm: TDpiForm read GetActiveForm write SetActiveForm; 709 property Cursor: TCursor read GetCursor write SetCursor; 710 property Cursors[Index: Integer]: HCURSOR read GetCursors write SetCursors; 684 711 published 685 712 property Dpi: Integer read FDpi write SetDpi; 713 property PixelsPerInch: Integer read FDpi; 686 714 property Width: Integer read GetWidth; 687 715 property Height: Integer read GetHeight; … … 696 724 public 697 725 VclJpeg: TJPEGImage; 698 procedure LoadFromFile(const Filename: string); override;726 constructor Create; override; 699 727 end; 700 728 … … 707 735 public 708 736 VclPng: TPortableNetworkGraphic; 709 procedure LoadFromFile(const Filename: string); override;737 constructor Create; override; 710 738 end; 711 739 … … 716 744 FMainForm: TDpiForm; 717 745 FCreatingForm: TDpiForm; 746 function GetActive: Boolean; 718 747 function GetShowMainForm: Boolean; 719 748 function GetTitle: string; … … 725 754 function GetVclApplication: TApplication; virtual; 726 755 public 756 constructor Create(AOwner: TComponent); override; 727 757 procedure Run; 728 758 procedure Initialize; … … 730 760 procedure UpdateMainForm(AForm: TDpiForm); 731 761 procedure CreateForm(InstanceClass: TComponentClass; out Reference); 762 function MessageBox(Text, Caption: PChar; Flags: Longint = MB_OK): Integer; 732 763 property MainForm: TDpiForm read GetMainForm write SetMainForm; 733 764 property ShowMainForm: Boolean read GetShowMainForm write SetShowMainForm default True; 734 765 property Title: string read GetTitle write SetTitle; 766 property Active: Boolean read GetActive; 735 767 end; 736 768 … … 934 966 end; 935 967 968 function TDpiApplication.GetActive: Boolean; 969 begin 970 Result := Application.Active; 971 end; 972 936 973 function TDpiApplication.GetMainForm: TDpiForm; 937 974 begin … … 952 989 begin 953 990 Result := Application; 991 end; 992 993 function DpiFindApplicationComponent(const ComponentName: string): TComponent; 994 // Note: this function is used by TReader to auto rename forms to unique names. 995 begin 996 Result := DpiApplication.FindComponent(ComponentName); 997 end; 998 999 constructor TDpiApplication.Create(AOwner: TComponent); 1000 begin 1001 RegisterFindGlobalComponentProc(@DpiFindApplicationComponent); 1002 inherited; 954 1003 end; 955 1004 … … 1021 1070 end; 1022 1071 1072 function TDpiApplication.MessageBox(Text, Caption: PChar; Flags: Longint 1073 ): Integer; 1074 begin 1075 Result := Application.MessageBox(Text, Caption, Flags); 1076 end; 1077 1023 1078 { TDpiJpegImage } 1024 1079 … … 1034 1089 end; 1035 1090 1036 procedure TDpiJpegImage.LoadFromFile(const Filename: string); 1037 var 1038 Bitmap: TJPEGImage; 1039 begin 1040 Bitmap := TJPEGImage.Create; 1041 Bitmap.LoadFromFile(FileName); 1042 Width := ScaleFromVcl(Bitmap.Width); 1043 Height := ScaleFromVcl(Bitmap.Height); 1044 if Self is TDpiBitmap then 1045 TBitmap(GetVclGraphic).Canvas.StretchDraw(Bounds(0, 0, Bitmap.Width, Bitmap.Height), Bitmap) 1046 else raise Exception.Create('Unsupported class ' + Self.ClassName); 1047 Bitmap.Free; 1091 constructor TDpiJpegImage.Create; 1092 begin 1093 inherited; 1094 VclGraphicClass := TJPEGImage; 1048 1095 end; 1049 1096 … … 1061 1108 end; 1062 1109 1063 procedure TDpiPortableNetworkGraphic.LoadFromFile(const Filename: string); 1064 var 1065 Bitmap: TPortableNetworkGraphic; 1066 begin 1067 Bitmap := TPortableNetworkGraphic.Create; 1068 Bitmap.LoadFromFile(FileName); 1069 Width := ScaleFromVcl(Bitmap.Width); 1070 Height := ScaleFromVcl(Bitmap.Height); 1071 if Self is TDpiBitmap then 1072 TBitmap(GetVclGraphic).Canvas.StretchDraw(Bounds(0, 0, Bitmap.Width, Bitmap.Height), Bitmap) 1073 else raise Exception.Create('Unsupported class ' + Self.ClassName); 1074 Bitmap.Free; 1110 constructor TDpiPortableNetworkGraphic.Create; 1111 begin 1112 inherited; 1113 VclGraphicClass := TPortableNetworkGraphic; 1075 1114 end; 1076 1115 … … 1246 1285 procedure TDpiGraphic.LoadFromFile(const Filename: string); 1247 1286 var 1248 Bitmap: T Bitmap;1249 begin 1250 Bitmap := TBitmap.Create;1287 Bitmap: TGraphic; 1288 begin 1289 Bitmap := VclGraphicClass.Create; 1251 1290 Bitmap.LoadFromFile(FileName); 1252 Width := ScaleFromVcl(Bitmap.Width);1253 Height := ScaleFromVcl(Bitmap.Height);1291 Width := Bitmap.Width; 1292 Height := Bitmap.Height; 1254 1293 if Self is TDpiBitmap then 1255 TBitmap(GetVclGraphic).Canvas.StretchDraw(Bounds(0, 0, Bitmap.Width, Bitmap.Height), Bitmap) 1294 TBitmap(GetVclGraphic).Canvas.StretchDraw(Bounds(0, 0, 1295 TBitmap(GetVclGraphic).Width, TBitmap(GetVclGraphic).Height), Bitmap) 1256 1296 else raise Exception.Create('Unsupported class ' + Self.ClassName); 1297 Bitmap.Free; 1298 end; 1299 1300 procedure TDpiGraphic.SaveToFile(const Filename: string); 1301 var 1302 Bitmap: TGraphic; 1303 begin 1304 Bitmap := VclGraphicClass.Create; 1305 Bitmap.Width := Width; 1306 Bitmap.Height := Height; 1307 if Self is TDpiBitmap then begin 1308 if Bitmap is TRasterImage then 1309 (Bitmap as TRasterImage).Canvas.StretchDraw(Bounds(0, 0, Bitmap.Width, Bitmap.Height), TBitmap(GetVclGraphic)) 1310 else raise Exception.Create('Expected TRasterImage but got ' + Bitmap.ClassName); 1311 end else raise Exception.Create('Unsupported class ' + Self.ClassName); 1312 Bitmap.SaveToFile(FileName); 1257 1313 Bitmap.Free; 1258 1314 end; … … 1355 1411 begin 1356 1412 inherited; 1413 VclGraphicClass := TBitmap; 1357 1414 end; 1358 1415 … … 1601 1658 } 1602 1659 GetVclCanvas.Pixels[ScaleToVcl(X), ScaleToVcl(Y)] := AValue; 1660 end; 1661 1662 procedure TDpiCanvas.SetVclCanvas(AValue: TCanvas); 1663 begin 1664 if FVclCanvas = AValue then Exit; 1665 FVclCanvas := AValue; 1666 FFont.VclFont := FVclCanvas.Font; 1603 1667 end; 1604 1668 … … 1809 1873 if FSize = AValue then Exit; 1810 1874 FSize := AValue; 1875 GetVclFont.Size := AValue; 1811 1876 DoChange; 1812 1877 end; … … 2036 2101 end; 2037 2102 2103 procedure TDpiScreen.SetCursor(AValue: TCursor); 2104 begin 2105 Screen.Cursor := AValue; 2106 end; 2107 2108 procedure TDpiScreen.SetCursors(Index: Integer; AValue: HCURSOR); 2109 begin 2110 Screen.Cursors[Index] := AValue; 2111 end; 2112 2038 2113 function TDpiScreen.GetHeight: Integer; 2039 2114 begin … … 2043 2118 function TDpiScreen.GetFormCount: Integer; 2044 2119 begin 2045 Result := Forms.Count; 2120 Result := FForms.Count; 2121 end; 2122 2123 function TDpiScreen.GetForms(Index: Integer): TDpiForm; 2124 begin 2125 Result := FForms[Index]; 2126 end; 2127 2128 procedure TDpiScreen.AddForm(AForm: TDpiForm); 2129 begin 2130 if AForm is TDpiForm then begin 2131 FForms.Add(AForm); 2132 //DpiApplication.UpdateVisible; 2133 end; 2046 2134 end; 2047 2135 … … 2049 2137 begin 2050 2138 Result := FActiveForm; 2139 end; 2140 2141 function TDpiScreen.GetCursor: TCursor; 2142 begin 2143 Result := Screen.Cursor; 2144 end; 2145 2146 function TDpiScreen.GetCursors(Index: Integer): HCURSOR; 2147 begin 2148 Result := Screen.Cursors[Index]; 2051 2149 end; 2052 2150 … … 2055 2153 I: Integer; 2056 2154 begin 2057 for I := 0 to F orms.Count - 1 do2058 F orms[I].ScreenChanged;2155 for I := 0 to FForms.Count - 1 do 2156 FForms[I].ScreenChanged; 2059 2157 end; 2060 2158 2061 2159 constructor TDpiScreen.Create; 2062 2160 begin 2063 F orms := TDpiForms.Create;2064 F orms.FreeObjects := False;2161 FForms := TDpiForms.Create; 2162 FForms.FreeObjects := False; 2065 2163 Dpi := 150; 2066 2164 end; … … 2068 2166 destructor TDpiScreen.Destroy; 2069 2167 begin 2070 FreeAndNil(F orms);2168 FreeAndNil(FForms); 2071 2169 inherited Destroy; 2072 2170 end; … … 2158 2256 procedure TDpiControl.MouseMove(Shift: TShiftState; X, Y: Integer); 2159 2257 begin 2258 end; 2259 2260 procedure TDpiControl.MouseLeave; 2261 begin 2262 2263 end; 2264 2265 function TDpiControl.ScreenToClient(const APoint: TPoint): TPoint; 2266 begin 2267 Result := ScalePointFromVcl(GetVclControl.ScreenToClient(ScalePointToVcl(APoint))); 2268 end; 2269 2270 function TDpiControl.ClientToScreen(const APoint: TPoint): TPoint; 2271 begin 2272 Result := ScalePointFromVcl(GetVclControl.ClientToScreen(ScalePointToVcl(APoint))); 2273 end; 2274 2275 procedure TDpiControl.AddHandlerOnVisibleChanged( 2276 const OnVisibleChangedEvent: TNotifyEvent; AsFirst: boolean); 2277 begin 2278 GetVclControl.AddHandlerOnVisibleChanged(OnVisibleChangedEvent, AsFirst); 2279 end; 2280 2281 procedure TDpiControl.RemoveHandlerOnVisibleChanged( 2282 const OnVisibleChangedEvent: TNotifyEvent); 2283 begin 2284 GetVclControl.RemoveHandlerOnVisibleChanged(OnVisibleChangedEvent); 2160 2285 end; 2161 2286 … … 2272 2397 end; 2273 2398 2399 function TDpiControl.GetAnchors: TAnchors; 2400 begin 2401 Result := GetVclControl.Anchors; 2402 end; 2403 2274 2404 function TDpiControl.GetClientHeight: Integer; 2275 2405 begin … … 2317 2447 end; 2318 2448 2449 function TDpiControl.IsAnchorsStored: Boolean; 2450 begin 2451 2452 end; 2453 2319 2454 procedure TDpiControl.SetAlign(AValue: TAlign); 2320 2455 begin 2321 2456 GetVclControl.Align := AValue; 2457 end; 2458 2459 procedure TDpiControl.SetAnchors(AValue: TAnchors); 2460 begin 2461 GetVclControl.Anchors := AValue; 2322 2462 end; 2323 2463 … … 2684 2824 end; 2685 2825 2826 procedure TDpiForm.AfterConstruction; 2827 begin 2828 inherited; 2829 DoOnCreate; 2830 end; 2831 2686 2832 function TDpiForm.ShowModal: Integer; 2687 2833 begin … … 2701 2847 // Init the component with an IDE resource 2702 2848 constructor TDpiForm.Create(TheOwner: TComponent); 2703 begin 2704 inherited; 2849 var 2850 C: TComponent; 2851 begin 2852 //inherited; 2705 2853 //DebugLn(['TDpiForm.Create ', DbgSName(TheOwner)]); 2706 2854 GlobalNameSpace.BeginWrite; 2707 2855 try 2856 CreateNew(TheOwner, 1); // this calls BeginFormUpdate, which is ended in AfterConstruction 2857 // Self 2858 C := FindGlobalComponent('TListDlg'); 2708 2859 if (ClassType <> TDpiForm) and not (csDesigning in ComponentState) then begin 2709 2860 if not InitResourceComponent(Self, TDataModule) then begin … … 2716 2867 ScreenChanged; 2717 2868 UpdateVclControl; 2718 DoOnCreate; 2869 end; 2870 2871 constructor TDpiForm.CreateNew(AOwner: TComponent; Num: Integer); 2872 begin 2873 inherited Create(AOwner); 2874 DpiScreen.AddForm(Self); 2719 2875 end; 2720 2876 -
branches/highdpi/Platform.pas
r17 r210 7 7 uses 8 8 {$IFDEF Windows}Windows,{$ENDIF} 9 {$IFDEF Linux} BaseUnix, UnixUtil,Unix,{$ENDIF}9 {$IFDEF Linux}Unix,{$ENDIF} 10 10 Classes, SysUtils, DateUtils, SyncObjs; 11 11 12 12 function NowPrecise: TDateTime; 13 function GetLogicalProcessorCount: Integer;14 13 15 14 implementation … … 50 49 end; 51 50 52 function GetLogicalProcessorCount: Integer;53 {$IFDEF Windows}54 var55 SystemInfo: _SYSTEM_INFO;56 {$ENDIF}57 begin58 {$IFDEF Windows}59 GetSystemInfo(SystemInfo);60 Result := SystemInfo.dwNumberOfProcessors;61 {$ENDIF}62 end;63 64 51 initialization 65 52 -
branches/highdpi/Protocol.pas
r148 r210 1115 1115 // cost values accumulate if prerequisite is future tech / are maximized if not 1116 1116 nUpgrade = 15; 1117 upgrade: 1118 array [0 .. nDomains - 1, 0 .. nUpgrade - 1] of record 1117 upgrade: array [0 .. nDomains - 1, 0 .. nUpgrade - 1] of record 1119 1118 Preq: Integer; 1120 1119 Strength: Integer; -
branches/highdpi/Start.lfm
r193 r210 26 26 BorderStyle = bsNone 27 27 BorderIcons = [] 28 LCLVersion = '2.0. 2.0'28 LCLVersion = '2.0.8.0' 29 29 OnShow = FormShow 30 30 OnHide = FormHide … … 40 40 Width = 100 41 41 Height = 25 42 Visible = True43 42 Enabled = True 44 43 ShowHint = False … … 48 47 Color = clBtnFace 49 48 OnClick = StartBtnClick 49 Visible = True 50 50 Down = False 51 51 Permanent = False … … 59 59 Width = 12 60 60 Height = 12 61 Visible = True62 61 Enabled = True 63 62 ShowHint = True … … 67 66 Color = clBtnFace 68 67 OnClick = Down1BtnClick 68 Visible = True 69 69 Down = False 70 70 Permanent = False … … 79 79 Width = 12 80 80 Height = 12 81 Visible = True82 81 Enabled = True 83 82 ShowHint = True … … 87 86 Color = clBtnFace 88 87 OnClick = Up1BtnClick 88 Visible = True 89 89 Down = False 90 90 Permanent = False … … 99 99 Width = 25 100 100 Height = 25 101 Visible = False102 101 Enabled = True 103 102 ShowHint = True … … 107 106 Color = clBtnFace 108 107 OnClick = RenameBtnClick 108 Visible = False 109 109 Down = False 110 110 Permanent = False … … 119 119 Width = 25 120 120 Height = 25 121 Visible = False122 121 Enabled = True 123 122 ShowHint = True … … 127 126 Color = clBtnFace 128 127 OnClick = DeleteBtnClick 128 Visible = False 129 129 Down = False 130 130 Permanent = False … … 139 139 Width = 12 140 140 Height = 12 141 Visible = False142 141 Enabled = True 143 142 ShowHint = True … … 147 146 Color = clBtnFace 148 147 OnClick = Down2BtnClick 148 Visible = False 149 149 Down = False 150 150 Permanent = False … … 159 159 Width = 12 160 160 Height = 12 161 Visible = False162 161 Enabled = True 163 162 ShowHint = True … … 167 166 Color = clBtnFace 168 167 OnClick = Up2BtnClick 168 Visible = False 169 169 Down = False 170 170 Permanent = False … … 179 179 Width = 25 180 180 Height = 25 181 Visible = True182 181 Enabled = True 183 182 ShowHint = True … … 187 186 Color = clBtnFace 188 187 OnClick = QuitBtnClick 188 Visible = True 189 189 Down = False 190 190 Permanent = False … … 199 199 Width = 12 200 200 Height = 12 201 Visible = True202 201 Enabled = True 203 202 ShowHint = True … … 207 206 Color = clBtnFace 208 207 OnClick = CustomizeBtnClick 208 Visible = True 209 209 Down = False 210 210 Permanent = False … … 218 218 Width = 12 219 219 Height = 12 220 Visible = True221 220 Enabled = True 222 221 ShowHint = True … … 226 225 Color = clBtnFace 227 226 OnClick = AutoDiffUpBtnClick 227 Visible = True 228 228 Down = False 229 229 Permanent = False … … 237 237 Width = 12 238 238 Height = 12 239 Visible = True240 239 Enabled = True 241 240 ShowHint = True … … 245 244 Color = clBtnFace 246 245 OnClick = AutoDiffDownBtnClick 246 Visible = True 247 247 Down = False 248 248 Permanent = False … … 256 256 Width = 12 257 257 Height = 12 258 Visible = True259 258 Enabled = True 260 259 ShowHint = True … … 264 263 Color = clBtnFace 265 264 OnClick = AutoEnemyUpBtnClick 265 Visible = True 266 266 Down = False 267 267 Permanent = False … … 275 275 Width = 12 276 276 Height = 12 277 Visible = True278 277 Enabled = True 279 278 ShowHint = True … … 283 282 Color = clBtnFace 284 283 OnClick = AutoEnemyDownBtnClick 284 Visible = True 285 285 Down = False 286 286 Permanent = False … … 295 295 Width = 25 296 296 Height = 25 297 Visible = True298 297 Enabled = True 299 298 ShowHint = True … … 303 302 Color = clBtnFace 304 303 OnClick = ReplayBtnClick 304 Visible = True 305 305 Down = False 306 306 Permanent = False … … 310 310 Tag = 15360 311 311 ClientHeight = 238 312 ClientWidth = 26 5312 ClientWidth = 266 313 313 Top = 64 314 314 Left = 45 315 315 Width = 266 316 316 Height = 238 317 Visible = False318 317 Enabled = True 319 318 ShowHint = False … … 326 325 Color = clBlack 327 326 OnClick = ListClick 327 TabOrder = 0 328 TabStop = True 329 TopIndex = -1 330 ScrollWidth = 266 331 ParentFont = False 332 ItemHeight = 0 333 IntegralHeight = True 334 ExtendedSelect = False 335 BorderStyle = bsSingle 336 Visible = False 328 337 end 329 338 object PopupMenu1: TPopupMenu 330 left = 112331 top = 232339 left = 8 340 top = 8 332 341 end 333 342 end -
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. -
branches/highdpi/readme.txt
r146 r210 1 1 C-evo 1.2.0 sources ported to Lazarus/FPC 2 2 3 * Used development environment: Lazarus 1.8.2(https://www.lazarus-ide.org/)3 * Used development environment: Lazarus 2.0.8 (https://www.lazarus-ide.org/) 4 4 * Supported platforms: Windows and Linux 5 5 * Supported architectures: 32-bit and 64-bit x86
Note:
See TracChangeset
for help on using the changeset viewer.