Changeset 405

branches/highdpi/Direct.pas

r378	r405
194	194
195	195	procedure TDirectDlg.FormShow(Sender: TObject);
196		~~var~~
197		~~I: Integer;~~
198	196	begin
199	197	if not Gone then

branches/highdpi/GameServer.pas

-              r378
+              r405
 uses
   Protocol, Database, dynlibs, Platform, dateutils, fgl, LazFileUtils,
   Graphics, UBrain;
+  Graphics, UBrain, Global;
 const
-  Version = $010300;
   FirstAICompatibleVersion = $000D00;
   FirstBookCompatibleVersion = $010103;
 …
     BrainNetworkClient.Flags := fMultiple;
     BrainNetworkClient.Initialized := False;
     BrainNetworkClient.ServerVersion := Version;
+    BrainNetworkClient.ServerVersion := CevoVersion;
     BrainNetworkClient.Kind := btNetworkClient;
   end;
 …
   BrainTerm.Flags := fMultiple;
   BrainTerm.Initialized := False;
   BrainTerm.ServerVersion := Version;
+  BrainTerm.ServerVersion := CevoVersion;
   BrainTerm.Kind := btTerm;
   BrainRandom := Brains.AddNew;
 …
     BrainNetworkServer.Flags := fMultiple;
     BrainNetworkServer.Initialized := False;
     BrainNetworkServer.ServerVersion := Version;
+    BrainNetworkServer.ServerVersion := CevoVersion;
     BrainNetworkServer.Kind := btNetworkServer;
   end;
 …
       NewBrain.LoadFromFile(BasePath + DirectorySeparator + F.Name + '.ai.txt');
       if (NewBrain.ServerVersion >= FirstAICompatibleVersion) and
         (NewBrain.ServerVersion <= Version) and
+        (NewBrain.ServerVersion <= CevoVersion) and
         ((NewBrain.Flags and fDotNet = 0) or (@DotNetClient <> nil)) then begin
         end else Brains.Delete(Brains.Count - 1);
 …
           begin
             CL.Put(sIntSetUnitStatus, p, ix, @Status);
             SavedStatus := Status
+            SavedStatus := Status;
           end;
       // log city status changes
 …
           begin
             CL.Put(sIntSetCityStatus, p, ix, @Status);
             SavedStatus := Status
+            SavedStatus := Status;
           end;
       // log model status changes
 …
           begin
             CL.Put(sIntSetModelStatus, p, ix, @Status);
             SavedStatus := Status
+            SavedStatus := Status;
           end;
       // log enemy city status changes
 …
           begin
             CL.Put(sIntSetECityStatus, p, ix, @Status);
             SavedStatus := Status
+            SavedStatus := Status;
           end;
       // log data changes
 …
         CL.PutDataChanges(sIntDataChange, p, SavedData[p], RW[p].Data,
           bix[p].DataSize);
         move(RW[p].Data^, SavedData[p]^, bix[p].DataSize * 4);
       end
+        Move(RW[p].Data^, SavedData[p]^, bix[p].DataSize * 4);
+      end;
     end;
 end;
 …
           SavedStatus := Status;
       if bix[p].DataSize > 0 then
         move(RW[p].Data^, SavedData[p]^, bix[p].DataSize * 4);
+        Move(RW[p].Data^, SavedData[p]^, bix[p].DataSize * 4);
     end;
 end;
 …
   ix: integer;
 begin
   result := false;
+  Result := False;
   for ix := 0 to RW[p].nUn - 1 do
     with RW[p].Un[ix] do
       if (Loc >= 0) and (SavedStatus <> Status) then
         result := true;
+        Result := True;
   for ix := 0 to RW[p].nCity - 1 do
     with RW[p].City[ix] do
       if (Loc >= 0) and (SavedStatus <> Status) then
         result := true;
+        Result := True;
   for ix := 0 to RW[p].nModel - 1 do
     with RW[p].Model[ix] do
       if SavedStatus <> Status then
         result := true;
+        Result := True;
   for ix := 0 to RW[p].nEnemyCity - 1 do
     with RW[p].EnemyCity[ix] do
       if (Loc >= 0) and (SavedStatus <> Status) then
         result := true;
+        Result := True;
   if RW[p].Data <> nil then
     for ix := 0 to bix[p].DataSize - 1 do
       if PDWortList(SavedData[p])[ix] <> PDWortList(RW[p].Data)[ix] then
         result := true
+        Result := True;
 end;
 …
   s := 'cEvoBook';
   LogFile.write(s[1], 8); { file id }
   i := Version;
+  i := CevoVersion;
   LogFile.write(i, 4); { c-evo version }
   LogFile.write(ExeInfo.Time, 4);
 …
   begin
     AutoSaveState := CL.State;
     AutoSaveExists := true
+    AutoSaveExists := true;
   end
 end;
 …
       begin
         GiveCivilReport(pTurn, p1);
         GiveMilReport(pTurn, p1)
+        GiveMilReport(pTurn, p1);
       end;
   end;
 …
   LogFile.Read(J, 4); { exe time }
   if (i >= FirstBookCompatibleVersion) and (i <= Version) then
+  if (i >= FirstBookCompatibleVersion) and (i <= CevoVersion) then
   begin
     result := true;
 …
     begin
       GenerateStat(pTurn);
       StatRequest := false
+      StatRequest := false;
     end;
     // complete all internal commands following an sTurn before generating statistics
 …
   begin
     Delete(LogFileName, 1, 1);
     nLogOpened := -1
+    nLogOpened := -1;
   end
   else
 …
   Game.RO[0] := @RW[0];
   Game.Difficulty[0] := 0;
+  for p1 := 1 to nPl - 1 do
+  begin
+  for p1 := 1 to nPl - 1 do begin
     Game.RO[p1] := nil;
     Game.Difficulty[p1] := -1
+    Game.Difficulty[p1] := -1;
   end;
   BrainTerm.Client(cNewMap, -1, Game);
 …
   bix[0].Client(cShowGame, 0, nil^);
   Notify(ntBackOff);
   ChangeClientWhenDone(cEditMap, 0, nil^, 0)
+  ChangeClientWhenDone(cEditMap, 0, nil^, 0);
 end;
 …
         Prod0 := 0;
         Project := cpImp + imTrGoods;
         Project0 := cpImp + imTrGoods
+        Project0 := cpImp + imTrGoods;
       end;
 …
                   Flags := Flags or unWithdrawn;
                   Happened := Happened or phPeaceEvacuation;
                 end
+                end;
           end;
 …
                   inc(ShowShipChange.Ship1Change[Project0 and cpIndex -
                     imShipComp]);
               end
             end
+              end;
+            end;
           end; { city loop 1 }
       if nUpdateLoc > 0 then
 …
             begin
               Movement := 0;
               Flags := Flags and not unMountainDelay
+              Flags := Flags and not unMountainDelay;
             end
             else
 …
               if (Health <= 0) or TribeExtinct then
                 RemoveUnit_UpdateMap(pTurn, uix);
             end
+            end;
           end;
 …
                       (ObserveLevel[Loc1] and (3 shl (2 * p1)) > 0) then
                       CallPlayer(cShowCityChanged, p1, Loc1);
               end
+              end;
             end;
 …
                 begin
                   Territory[Loc1] := -1;
                   Map[Loc1] := Map[Loc1] and not fPeace
                 end
+                  Map[Loc1] := Map[Loc1] and not fPeace;
+                end;
             end;
           end;
 …
       begin
         Happened := Happened or phTech;
         ResearchTech := -1
+        ResearchTech := -1;
       end;
 …
           begin
             inc(Credibility);
             Break
+            Break;
           end;
 …
       if (bix[pTurn].Kind <> btNoTerm) and
         ((Difficulty[pTurn] > 0) or (Mode > moLoading_Fast)) then
         DiscoverAll(pTurn, lObserveSuper)
+        DiscoverAll(pTurn, lObserveSuper);
     end
     else
 …
       DiscoverViewAreas(pTurn);
       if MirBuilt then
         DiscoverAll(pTurn, lObserveUnhidden)
     end
+        DiscoverAll(pTurn, lObserveUnhidden);
+    end;
   end;
   // CheckContact;
 …
                     (ObserveLevel[Loc1] and (3 shl (2 * p1)) > 0) then
                     CallPlayer(cShowCityChanged, p1, Loc1);
             end
+            end;
           end;
     end;
 …
             begin
               Fuel := Model[mix].Cap[mcFuel];
               Flags := Flags or unBombsLoaded
+              Flags := Flags or unBombsLoaded;
             end
             else if Model[mix].Kind = mkSpecial_Glider then { glider }
 …
               begin
                 RemoveUnit_UpdateMap(pTurn, uix); // unit lost
                 Happened := Happened or phGliderLost
               end
+                Happened := Happened or phGliderLost;
+              end;
             end
             else
 …
               begin
                 RemoveUnit_UpdateMap(pTurn, uix); // unit lost
                 Happened := Happened or phPlaneLost
+                Happened := Happened or phPlaneLost;
               end
             end
 …
             if Health < 0 then
               RemoveUnit_UpdateMap(pTurn, uix);
           end
+          end;
         end; { unit loop 1 }
 …
           begin
             UpdateLoc[nUpdateLoc] := Loc;
             inc(nUpdateLoc)
+            inc(nUpdateLoc);
           end;
       // unit will be removed -- remember position and update for all players
 …
               Happened := Happened or phStealTech;
               GStealFrom := MoveInfo.Defender;
               Break
             end
+              Break;
+            end;
         end;
         if Mode = moPlaying then
 …
     sGetVersion:
       integer(Data) := Version;
+      integer(Data) := CevoVersion;
     sGetGameChanged:
 …
             begin
               if Tech[Subject] >= MaxFutureTech_Computing then
                 result := eInvalid
+                result := eInvalid;
             end
             else if Subject in FutureTech then
             begin
               if Tech[Subject] >= MaxFutureTech then
                 result := eInvalid
+                result := eInvalid;
             end
             else if Tech[Subject] >= tsApplicable then
 …
                     inc(i);
                 if i < 2 then
                   result := eNoPreq
+                  result := eNoPreq;
               end
               else if (AdvPreq[Subject, 0] <> preNone) and
 …
                 (AdvPreq[Subject, 1] <> preNone) and
                 (Tech[AdvPreq[Subject, 1]] < tsApplicable) then
                 result := eNoPreq
+                result := eNoPreq;
           end;
           if (result = eOK) and (Command >= sExecute) then
 …
             // save DevModel, because sctModel commands are not logged
             ResearchTech := Subject;
           end
+          end;
         end
         else
 …
           SeeTech(Player, Subject);
           dec(RW[Player].Happened, phStealTech);
         end
+        end;
       end;
 …
           RW[Player].Attitude[p1] := Subject;
           RW[p1].EnemyReport[Player].Attitude := Subject;
         end
+        end;
       end;
 …
                   MaxCap := 3;
                 if RW[Player].Tech[adSteel] >= tsApplicable then
                   inc(MaxCap)
+                  inc(MaxCap);
               end
               else
 …
                       Cap[mcCarrier] := 0;
                       if Cap[mcDefense] > 2 then
                         Cap[mcDefense] := 2
+                        Cap[mcDefense] := 2;
                     end;
                   mcSeaTrans:
 …
                 CalculateModel(RW[Player].DevModel);
               end
+              end;
             end;
         end
 …
               result := eViolation
             else if Command >= sExecute then
               RW[Player].Un[Subject].Home := cix1
           end
         end
+              RW[Player].Un[Subject].Home := cix1;
+          end;
+        end;
       end;
 …
           result := eInvalid
         else
           result := UnloadUnit(Player, Subject, Command < sExecute)
+          result := UnloadUnit(Player, Subject, Command < sExecute);
       end;
 …
           PlaceUnit(p1, RW[p1].nUn - 1);
           UpdateUnitMap(integer(Data));
         end
+        end;
       end
       else
 …
                   CityGrowth(Player, cix1);
                 RemoveUnit_UpdateMap(Player, Subject);
               end
           end
         end
+              end;
+          end;
+        end;
       end;
 …
                   (ObserveLevel[Loc0] and (3 shl (2 * p1)) > 0) then
                   CallPlayer(cShowCityChanged, p1, Loc0);
           end
+          end;
         end;
       end;
 …
                     if Preq = 0 then
                       result := eNoPreq;
                   end
+                  end;
               end;
 …
                     Prod := 0;
                     Prod0 := 0;
                     Project0 := cpImp + imTrGoods
+                    Project0 := cpImp + imTrGoods;
                   end
                   else
                     Prod := Prod0 * 2 div 3;
                 Project := NewProject
               end
             end
           end
+              end;
+            end;
+          end;
       end;
 …
                   imSpacePort:
                     DestroySpacePort_TellPlayers(Player, -1);
                 end
+                end;
               end;
               inc(Flags, chImprovementSold);
             end
+            end;
       end;
 …
                     imSpacePort:
                       DestroySpacePort_TellPlayers(Player, -1);
                   end
+                  end;
                 end;
                 inc(Flags, chImprovementSold);
               end
         end
+              end;
+        end;
       end;

branches/highdpi/Global.pas

-              r378
+              r405
   CevoExt = '.cevo';
   CevoMapExt = '.cevomap';
+  CevoMapPictureExt = '.png';
   CevoTribeExt = '.tribe.txt';
   CevoHomepageShort = 'app.zdechov.net/c-evo';
 …
   AITemplateManual = 'AI development manual';
   AITemplateFileName = 'AI Template' + DirectorySeparator + AITemplateManual + '.html';
+  CevoVersionMajor = 1;
+  CevoVersionMinor = 4;
+  CevoVersionBugFix = 0;
+  CevoVersion = ((CevoVersionMajor and $ff) shl 16) or
+    ((CevoVersionMinor and $ff) shl 8) or
+    ((CevoVersionBugFix and $ff) shl 0);

branches/highdpi/Help/help.txt

r11	r405
1441	1441	Unit attacks at full strength even if it has less than 1 MP left.
1442	1442	2 tiles observation range. Unit fortifies if it has at least half of its initial MP left.
1443		The units production cost is halved when the same type of unit was produced immediately before, but doubled otherwise.
	1443	The unit's production cost is halved when the same type of unit was produced immediately before, but doubled otherwise.
1444	1444
1445	1445	#GOVHELP

branches/highdpi/Install/deb/debian/changelog

-              r349
+              r405
 c-evo (1.3.0-0) precise; urgency=low
+c-evo (1.4.0-0) precise; urgency=low
   * Original version 1.3.0 packaged with lazdebian
+  * Original version 1.4.0 packaged with lazdebian
  -- Chronos <robie@centrum.cz>  Sun, 17 Dec 2016 00:51:08 +0100

branches/highdpi/Install/deb/debian/control

r349	r405
3	3	Section: games
4	4	Priority: optional
5		Standards-Version: 1.3.0
	5	Standards-Version: 1.4.0
6	6	Build-Depends: fpc, lazarus, lcl, lcl-utils, debhelper (>= 8)
7	7

branches/highdpi/Install/rpm/c-evo.spec

-              r349
+              r405
 Name:           c-evo
 Version:        1.3.0
+Version:        1.4.0
 Release:        1%{?dist}
 Summary:        Empire building game
 …
 install -d -m 755 $RPM_BUILD_ROOT/usr/share/c-evo/Saved
 install -D -m 644 Saved/* $RPM_BUILD_ROOT/usr/share/c-evo/Saved
 #install -d -m 755 $RPM_BUILD_ROOT/usr/share/c-evo/AI\ Template
+#install -D -m 644 AI\ Template/* $RPM_BUILD_ROOT/usr/share/c-evo/AI\ Template
+install -d -m 755 $RPM_BUILD_ROOT/usr/share/c-evo/AI\ Template
+cp -R AI\ Template $RPM_BUILD_ROOT/usr/share/c-evo
 install -d -m 755 $RPM_BUILD_ROOT/usr/share/c-evo/Localization
 cp -R Localization $RPM_BUILD_ROOT/usr/share/c-evo

branches/highdpi/Install/snap/local/build.sh

r378	r405
4	4
5	5	pushd ../../..
6		snapcraft --debug
	6	snapcraft --debug --use-lxd
7	7	popd
8	8

branches/highdpi/Install/snap/snapcraft.yaml

-              r378
+              r405
 name: c-evo
 title: "C-evo: New Horizons"
 version: '1.3.0'
+version: '1.4.0'
 summary: A turn-based empire building game inspired by Civilization II game.
 description: |
+  This is a fork and Lazarus port of the original game which can be
+  found at www.c-evo.org.
+confinement: devmode
+  This is a fork and Lazarus/FPC port of the original C-evo 1.2.0 game.
+  Now it is finally possible to play C-evo natively on Linux.
+  * Zoomable map by mouse wheel with three tile sizes
+  * Many sample maps included
+  * All available localizations include
+  * Many other small improvements
+confinement: strict
 base: core20
+#base: core18
+grade: devel
+grade: stable
 icon: Graphics/c-evo_64x64.png
+license: NLPL
+environment:
+  LD_LIBRARY_PATH: $SNAP/usr/lib/$SNAPCRAFT_ARCH_TRIPLET/pulseaudio
+  PULSE_SERVER: unix:/run/user/1000/pulse/native
+layout:
+  /usr/lib/$SNAPCRAFT_ARCH_TRIPLET/sox:
+    bind: $SNAP/usr/lib/$SNAPCRAFT_ARCH_TRIPLET/sox
 parts:
   c-evo:
 …
     - lcl-utils
     stage-packages:
+    - sox
+    - libsox-fmt-mp3
+    - libsox-fmt-pulse
+    - libpulse0
+    # Autodetected dependencies
     - libatk1.0-0
     - libcairo2
 …
     - libxrandr2
     - libxrender1
-    #- sox
-    #- libsox-fmt-mp3
     override-build: |
+      snapcraftctl build
       (cd AI/StdAI &&lazbuild --build-mode=Release StdAI.lpi)
       mv AI/StdAI/libstdai.so AI/StdAI/libstdai-amd64.so
 …
       install -d -m 755 $ROOT/usr/share/c-evo
       install -s -m 755 c-evo $ROOT/usr/share/c-evo
-      install -m 755 Install/snap/local/command-c-evo-gtk.wrapper $ROOT/usr/share/c-evo
       install -m 644 Language.txt $ROOT/usr/share/c-evo
       install -m 644 Language2.txt $ROOT/usr/share/c-evo
       install -m 644 Fonts.txt $ROOT/usr/share/c-evo
-      #install -d -m 755 $ROOT/bin
-      #install -m 755 Install/snap/local/desktop-launch $ROOT/bin
-      #install -m 755 Install/snap/local/c-evo $ROOT/bin/c-evo
-      #install -d -m 755 $ROOT/usr/bin
       install -d -m 755 $ROOT/usr/share/applications
       install -m 755 Install/deb/c-evo.desktop $ROOT/usr/share/applications
 …
       cp -r "AI Template" $ROOT/usr/share/c-evo
     stage:
-      - bin
-      - lib
       - etc
       - usr
 …
 apps:
   c-evo:
-    #command: desktop-launch $SNAP/c-evo-snap
     command: usr/share/c-evo/c-evo
-    #command: usr/share/c-evo/command-c-evo-gtk.wrapper
     desktop: usr/share/applications/c-evo.desktop
-    #extensions: [gnome-3-28]
     plugs:
       - home
       - pulseaudio
+      - home
+      - audio-playback
       - desktop
-      - desktop-legacy
       - x11

branches/highdpi/Install/win/C-evo.iss

-              r246
+              r405
 [Files]
+Source: "{#MyAppSubDir}\lib\x86_64-win64-Release\{#MyAppExeName}"; DestDir: "{app}"; Flags: ignoreversion; Components: main; Check: not Is64BitInstallMode
+Source: "{#MyAppSubDir}\lib\i386-win32-Release\{#MyAppExeName}"; DestDir: "{app}"; Flags: ignoreversion; Components: main; Check: Is64BitInstallMode
+Source: "{#MyAppSubDir}\lib\x86_64-win64-Release\{#MyAppExeName}"; DestDir: "{app}"; Flags: ignoreversion; Components: main; Check: Is64BitInstallMode
+Source: "{#MyAppSubDir}\lib\i386-win32-Release\{#MyAppExeName}"; DestDir: "{app}"; Flags: ignoreversion; Components: main; Check: not Is64BitInstallMode
+Source: "{#MyAppSubDir}\AI\StdAI\lib\x86_64-win64-Release\StdAI.dll"; DestDir: "{app}\AI\StdAI"; DestName: "StdAI-win64.dll"; Flags: ignoreversion; Components: ai\stdai; Check: Is64BitInstallMode
 Source: "{#MyAppSubDir}\AI\StdAI\lib\i386-win32-Release\StdAI.dll"; DestDir: "{app}\AI\StdAI"; DestName: "StdAI-win32.dll"; Flags: ignoreversion; Components: ai\stdai; Check: not Is64BitInstallMode
-Source: "{#MyAppSubDir}\AI\StdAI\lib\x86_64-win64-Release\StdAI.dll"; DestDir: "{app}\AI\StdAI"; DestName: "StdAI-win64.dll"; Flags: ignoreversion; Components: ai\stdai; Check: Is64BitInstallMode
 Source: "{#MyAppSubDir}\AI\AI_UO\*.*"; DestDir: "{app}\AI\AI_UO"; Flags: ignoreversion; Components: ai\ai_uo; Check: not Is64BitInstallMode
 Source: "{#MyAppSubDir}\AI\AIAS\*.*"; DestDir: "{app}\AI\AIAS"; Flags: ignoreversion; Components: ai\aias; Check: not Is64BitInstallMode

branches/highdpi/Integrated.lpi

-              r378
+              r405
       </Item2>
       <SharedMatrixOptions Count="2">
         <Item1 ID="151739052537" Targets="CevoComponents" Modes="Debug" Value="-g -gl -gh -CirotR -O1"/>
         <Item2 ID="186701832267" Targets="CevoComponents" Modes="Release" Value="-CX -XX -O3"/>
+        <Item1 ID="151739052537" Targets="CevoComponents,Common" Modes="Debug" Value="-g -gl -gh -CirotR -O1"/>
+        <Item2 ID="186701832267" Targets="CevoComponents,Common" Modes="Release" Value="-CX -XX -O3"/>
       </SharedMatrixOptions>
     </BuildModes>
 …
       </Modes>
     </RunParams>
     <RequiredPackages Count="3">
+    <RequiredPackages Count="4">
       <Item1>
+        <PackageName Value="Common"/>
+        <DefaultFilename Value="Packages\Common\Common.lpk" Prefer="True"/>
+      </Item1>
+      <Item2>
         <PackageName Value="DpiControls"/>
         <DefaultFilename Value="Packages\DpiControls\DpiControls.lpk" Prefer="True"/>
       </Item1>
       <Item2>
+      </Item2>
+      <Item3>
         <PackageName Value="CevoComponents"/>
         <DefaultFilename Value="Packages\CevoComponents\CevoComponents.lpk" Prefer="True"/>
       </Item2>
       <Item3>
+      </Item3>
+      <Item4>
         <PackageName Value="LCL"/>
       </Item3>
+      </Item4>
     </RequiredPackages>
     <Units Count="47">
+    <Units Count="48">
       <Unit0>
         <Filename Value="Integrated.lpr"/>
 …
         <IsPartOfProject Value="True"/>
       </Unit46>
+      <Unit47>
+        <Filename Value="ULanguages.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit47>
     </Units>
   </ProjectOptions>
 …
     <Linking>
       <Debugging>
-        <UseHeaptrc Value="True"/>
         <UseExternalDbgSyms Value="True"/>
       </Debugging>

branches/highdpi/Integrated.lpr

-              r378
+              r405
 uses
+  UDpiControls, {$IFDEF UNIX}
+  //cthreads,
+  clocale,
+  {$IFDEF UNIX}
+  cthreads, clocale,
   {$ENDIF}
   Forms, Interfaces, SysUtils, Protocol, GameServer, Direct, Start, Messg, Inp,
+  UDpiControls, Forms, Interfaces, SysUtils, Protocol, GameServer, Direct, Start, Messg, Inp,
   Back, Log, LocalPlayer, ClientTools, Tribes, IsoEngine, Term, CityScreen, Nego,
   NoTerm, ScreenTools, Directories;

branches/highdpi/Language.txt

-              r378
+              r405
 #BTN_NO No
 #BTN_INFO Info
+#BTN_RESET Reset
 'Button Tooltips
 …
 Medium
 Big
+Previous Unit
+Next Unit
 #ADVANCES
 …
 Gamma
 Restart is needed to apply changes
+Primary
+Secondary
+Languages
+Key bindings

branches/highdpi/LocalPlayer/CityScreen.pas

r378	r405
8	8	Protocol, ClientTools, Term, ScreenTools, IsoEngine, BaseWin,
9	9	LCLIntf, LCLType, Messages, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls,
10		ButtonA, ButtonC, Area, GraphType;
	10	ButtonA, ButtonC, Area, GraphType, UTexture;
11	11
12	12	const

branches/highdpi/LocalPlayer/ClientTools.pas

-              r361
+              r405
 procedure CityOptimizer_CityChange(cix: integer);
 begin
   if (MyRO.Government <> gAnarchy) and (MyCity[cix].Flags and
+  if (MyRO.Government <> gAnarchy) and (cix <> -1) and (MyCity[cix].Flags and
     chCaptured = 0) then
   begin
 …
 initialization
   Assert(nImp < 128);
   CalculateAdvValues;
+Assert(nImp < 128);
+CalculateAdvValues;
 end.

branches/highdpi/LocalPlayer/IsoEngine.pas

-              r349
+              r405
   end;
+  if ShowObjects then
+  begin
+    if (Tile and fCanal <> 0) or (Tile and fCity <> 0) then
+    begin // paint canal connections
+  if ShowObjects then begin
+    // Paint canal connections
+    if (Tile and fCanal <> 0) or (Tile and fCity <> 0) then begin
       Conn := Connection8(Loc, fCanal or fCity);
       if Tile and fCanal <> 0 then
         Conn := Conn or ($FF - OceanConnection(Loc));
+      if Conn = 0 then
+      begin
+      if Conn = 0 then begin
         if Tile and fCanal <> 0 then
           TSprite(x, y, spCanal)
+          TSprite(x, y, spCanal);
       end
       else
 …
             TSprite(x, y, spCanal + 1 + Dir);
     end;
     if Tile and (fRR or fCity) <> 0 then
       RRConn := Connection8(Loc, fRR or fCity)
     else
       RRConn := 0;
+    if Tile and (fRoad or fRR or fCity) <> 0 then
+    begin // paint road connections
+    // Paint road connections
+    if Tile and (fRoad or fRR or fCity) <> 0 then begin
       Conn := Connection8(Loc, fRoad or fRR or fCity) and not RRConn;
       if (Conn = 0) and (Tile and (fRR or fCity) = 0) then
 …
             TSprite(x, y, spRoad + 1 + Dir);
     end;
+    // paint railroad connections
+    // Paint railroad connections
     if (Tile and fRR <> 0) and (RRConn = 0) then
       TSprite(x, y, spRailRoad)
     else if RRConn > 0 then
+    else if RRConn > 0 then begin
       for Dir := 0 to 7 do
         if (1 shl Dir) and RRConn <> 0 then
           TSprite(x, y, spRailRoad + 1 + Dir);
+    end;
   end;
 end;

branches/highdpi/LocalPlayer/MessgEx.pas

r361	r405
543	543	end;
544	544
545
546		~~initialization~~
547
548	545	end.

branches/highdpi/LocalPlayer/Term.lfm

-              r349
+              r405
 object MainScreen: TMainScreen
   Left = 169
+  Left = 516
   Height = 480
   Top = 596
+  Top = 834
   Width = 800
   HorzScrollBar.Visible = False
 …
       OnClick = MenuClick
     end
+    object N13: TDpiMenuItem
+      Caption = '-'
+    end
+    object mPrevUnit: TDpiMenuItem
+      Tag = 100
+      ShortCut = 46
+      OnClick = MenuClick
+    end
+    object mNextUnit: TDpiMenuItem
+      Tag = 101
+      ShortCut = 45
+      OnClick = MenuClick
+    end
   end
   object StatPopup: TDpiPopupMenu

branches/highdpi/LocalPlayer/Term.pas

-              r378
+              r405
   TMainScreen = class(TDrawDlg)
     mBigTiles: TDpiMenuItem;
+    mNextUnit: TDpiMenuItem;
+    N13: TDpiMenuItem;
+    mPrevUnit: TDpiMenuItem;
     Timer1: TTimer;
     GamePopup: TDpiPopupMenu;
 …
     procedure CopyMiniToPanel;
     procedure PanelPaint;
+    procedure NextUnit(NearLoc: integer; AutoTurn: boolean);
+    procedure FocusNextUnit(Dir: Integer = 1);
+    procedure NextUnit(NearLoc: Integer; AutoTurn: Boolean);
     procedure Scroll(dx, dy: integer);
     procedure SetMapPos(Loc: integer; MapPos: TPoint);
 …
   begin
     SetTroopLoc(-1);
     PaintAll
+    PaintAll;
   end { supervisor }
   { else if (ClientMode=cTurn) and (MyRO.Turn=0) then
 …
           FocusOnLoc(G.lx * G.ly div 2);
       SetTroopLoc(-1);
       PanelPaint
+      PanelPaint;
     end;
     if ShowCityList then
 …
   NoMapPanel := TIsoMap.Create;
-  KeyBindings.LoadFromRegistry(HKEY_CURRENT_USER, AppRegistryKey + '\KeyBindings');
   UpdateKeyShortcuts;
 …
   I: Integer;
 begin
-  KeyBindings.SaveToRegistry(HKEY_CURRENT_USER, AppRegistryKey + '\KeyBindings');
   MainFormKeyDown := nil;
   FreeAndNil(sb);
 …
 end;
+procedure TMainScreen.FocusNextUnit(Dir: Integer);
+var
+  i, uix, NewFocus: Integer;
+begin
+  if ClientMode >= scContact then
+    Exit;
+  DestinationMarkON := False;
+  PaintDestination;
+  NewFocus := -1;
+  for i := 1 to MyRO.nUn do begin
+    uix := (UnFocus + i * Dir + MyRO.nUn) mod MyRO.nUn;
+    if (MyUn[uix].Loc >= 0) and (MyUn[uix].Status and usStay = 0) then begin
+      NewFocus := uix;
+      Break;
+    end;
+  end;
+  if NewFocus >= 0 then begin
+    SetUnFocus(NewFocus);
+    SetTroopLoc(MyUn[NewFocus].Loc);
+    FocusOnLoc(TroopLoc, flRepaintPanel);
+  end;
+end;
 procedure TMainScreen.FocusOnLoc(Loc: integer; Options: integer = 0);
 var
 …
 end;
 procedure TMainScreen.NextUnit(NearLoc: integer; AutoTurn: boolean);
+procedure TMainScreen.NextUnit(NearLoc: Integer; AutoTurn: Boolean);
 var
   Dist, TestDist: single;
   i, uix, NewFocus: integer;
   GotoOnly: boolean;
+  Dist, TestDist: Single;
+  i, uix, NewFocus: Integer;
+  GotoOnly: Boolean;
 begin
   Dist := 0;
   if ClientMode >= scContact then
     exit;
   DestinationMarkON := false;
+    Exit;
+  DestinationMarkON := False;
   PaintDestination;
+  for GotoOnly := GoOnPhase downto false do
+  begin
+  for GotoOnly := GoOnPhase downto False do begin
     NewFocus := -1;
+    for i := 1 to MyRO.nUn do
+    begin
+    for i := 1 to MyRO.nUn do begin
       uix := (UnFocus + i) mod MyRO.nUn;
       if (MyUn[uix].Loc >= 0) and (MyUn[uix].Job = jNone) and
         (MyUn[uix].Status and (usStay or usRecover or usWaiting) = usWaiting)
         and (not GotoOnly or (MyUn[uix].Status and usGoto <> 0)) then
+        if NearLoc < 0 then
+        begin
+        if NearLoc < 0 then begin
           NewFocus := uix;
           Break;
+        end
+        else
+        begin
+        end else begin
           TestDist := Distance(NearLoc, MyUn[uix].Loc);
+          if (NewFocus < 0) or (TestDist < Dist) then
+          begin
+          if (NewFocus < 0) or (TestDist < Dist) then begin
             NewFocus := uix;
             Dist := TestDist;
 …
     end;
     if GotoOnly then
+      if NewFocus < 0 then
+        GoOnPhase := false
+      else
+        Break;
+  end;
+  if NewFocus >= 0 then
+  begin
+      if NewFocus < 0 then GoOnPhase := False
+        else Break;
+  end;
+  if NewFocus >= 0 then begin
     SetUnFocus(NewFocus);
     SetTroopLoc(MyUn[NewFocus].Loc);
+    FocusOnLoc(TroopLoc, flRepaintPanel)
+  end
+  else if AutoTurn and not mWaitTurn.Checked then
+  begin
+    TurnComplete := true;
+    FocusOnLoc(TroopLoc, flRepaintPanel);
+  end else
+  if AutoTurn and not mWaitTurn.Checked then begin
+    TurnComplete := True;
     SetUnFocus(-1);
     SetTroopLoc(-1);
+    PostMessage(Handle, WM_EOT, 0, 0)
+  end
+  else
+  begin
+    PostMessage(Handle, WM_EOT, 0, 0);
+  end else begin
     if { (UnFocus>=0) and } not TurnComplete and EOT.Visible then
       Play('TURNEND');
     TurnComplete := true;
+    TurnComplete := True;
     SetUnFocus(-1);
     SetTroopLoc(-1);
 …
         end
         else
           NextUnit(UnStartLoc, true)
+          NextUnit(UnStartLoc, true);
     end
     else if (UnFocus < 0) and (Options and muAutoNext <> 0) then
 …
         begin
           MyUn[uix].Status := MyUn[uix].Status and not usWaiting;
           NextUnit(UnStartLoc, true)
+          NextUnit(UnStartLoc, true);
         end;
       end;
 …
               trixFocus := TrCnt;
             inc(TrCnt);
           end
+          end;
     end
     else // count enemy units here
 …
   mStay.ShortCut := BStay.ShortCut;
   mNoOrders.ShortCut := BNoOrders.ShortCut;
+  mPrevUnit.ShortCut := BPrevUnit.ShortCut;
+  mNextUnit.ShortCut := BNextUnit.ShortCut;
   mCancel.ShortCut := BCancel.ShortCut;
   mPillage.ShortCut := BPillage.ShortCut;
 …
     else if BStay.Test(ShortCut) then MenuClick(mStay)
     else if BNoOrders.Test(ShortCut) then MenuClick(mNoOrders)
+    else if BPrevUnit.Test(ShortCut) then MenuClick(mPrevUnit)
+    else if BNextUnit.Test(ShortCut) then MenuClick(mNextUnit)
     else if BCancel.Test(ShortCut) then MenuClick_Check(UnitPopup, mCancel)
     else if BPillage.Test(ShortCut) then MenuClick_Check(UnitPopup, mPillage)
 …
           end
           else
             PanelPaint
+            PanelPaint;
         end
         else
           NextUnit(UnStartLoc, true);
       end
+      end;
     end;
     case result of
 …
       if result < rExecuted then
         Play('INVALID')
     end
+    end;
   end;
 …
   end
   else if UnFocus >= 0 then
     with MyUn[UnFocus] do
+    with TUn(MyUn[UnFocus]) do
       if Sender = mGoOn then
       begin
 …
       begin
         Centre(Loc);
         PaintAllMaps
+        PaintAllMaps;
       end
       else if Sender = mCity then
 …
             PaintAll;
             ZoomToCity(Loc0, true, chFounded);
           end
+          end;
         end
         else
 …
         if Job > jNone then
           Server(sStartJob + jNone shl 4, me, UnFocus, nil^);
         NextUnit(UnStartLoc, true)
+        NextUnit(UnStartLoc, true);
       end
       else if Sender = mRecover then
 …
         if Job > jNone then
           Server(sStartJob + jNone shl 4, me, UnFocus, nil^);
         NextUnit(UnStartLoc, true)
+        NextUnit(UnStartLoc, true);
       end
       else if Sender = mNoOrders then
       begin
         Status := Status and not usWaiting;
+        NextUnit(UnStartLoc, true)
+        NextUnit(UnStartLoc, true);
+      end
+      else if Sender = mPrevUnit then
+      begin
+        Status := Status and not usWaiting;
+        FocusNextUnit(-1);
+      end
+      else if Sender = mNextUnit then
+      begin
+        Status := Status and not usWaiting;
+        FocusNextUnit(1);
       end
       else if Sender = mCancel then
 …
               NextUnit(Loc, true)
             else
               PanelPaint
+              PanelPaint;
           end
           else if i = eNoTime_Load then
 …
 end;
-initialization
 end.

branches/highdpi/LocalPlayer/UKeyBindings.pas

-              r303
+              r405
     ShortCut: TShortCut;
     ShortCut2: TShortCut;
+    DefaultShortCut: TShortCut;
+    DefaultShortCut2: TShortCut;
     function Test(AShortCut: TShortCut): Boolean;
+    procedure Assign(Source: TKeyBinding);
+    procedure SetDefault;
   end;
 …
   TKeyBindings = class(TFPGObjectList<TKeyBinding>)
+  private
   public
     function AddItem(const ShortName, FullName: string; ShortCut: TShortCut; ShortCut2: TShortCut = 0): TKeyBinding; overload;
 …
     procedure LoadFromRegistry(RootKey: HKEY; Key: string);
     procedure SaveToRegistry(RootKey: HKEY; Key: string);
+    procedure LoadToStrings(Strings: TStrings);
+    procedure Assign(Source: TKeyBindings);
+    procedure ResetToDefault;
+    procedure RemoveShortCut(ShortCut: TShortCut);
   end;
 …
   BStay: TKeyBinding;
   BNoOrders: TKeyBinding;
+  BPrevUnit: TKeyBinding;
+  BNextUnit: TKeyBinding;
   BCancel: TKeyBinding;
   BPillage: TKeyBinding;
 …
 end;
+procedure TKeyBinding.Assign(Source: TKeyBinding);
+begin
+  ShortName := Source.ShortName;
+  FullName := Source.FullName;
+  ShortCut := Source.ShortCut;
+  ShortCut2 := Source.ShortCut2;
+  DefaultShortCut := Source.DefaultShortCut;
+  DefaultShortCut2 := Source.DefaultShortCut2;
+end;
+procedure TKeyBinding.SetDefault;
+begin
+  ShortCut := DefaultShortCut;
+  ShortCut2 := DefaultShortCut2;
+end;
 { TKeyBindings }
 …
   Result.ShortCut := ShortCut;
   Result.ShortCut2 := ShortCut2;
+  Result.DefaultShortCut := ShortCut;
+  Result.DefaultShortCut2 := ShortCut2;
   Add(Result);
 end;
 …
 end;
+procedure TKeyBindings.LoadToStrings(Strings: TStrings);
+var
+  I: Integer;
+  Text: string;
+begin
+  Strings.Clear;
+  for I := 0 to Count - 1 do begin
+    Text:= '';
+    if Items[I].ShortCut <> 0 then
+      Text:= Text + ShortCutToText(Items[I].ShortCut);
+    if Items[I].ShortCut2 <> 0 then begin
+      if Text <> '' then Text := Text + ', ';
+      Text:= Text + ShortCutToText(Items[I].ShortCut2);
+    end;
+    if Text <> '' then Text := Items[I].FullName + ' (' + Text + ')'
+      else Text := Items[I].FullName;
+    Strings.Add(Text);
+  end;
+end;
+procedure TKeyBindings.Assign(Source: TKeyBindings);
+var
+  I: Integer;
+begin
+  while Count < Source.Count do
+    Add(TKeyBinding.Create);
+  while Count > Source.Count do
+    Delete(Count - 1);
+  for I := 0 to Count - 1 do
+    Items[I].Assign(Source.Items[I]);
+end;
+procedure TKeyBindings.ResetToDefault;
+var
+  I: Integer;
+begin
+  for I := 0 to Count - 1 do
+    Items[I].SetDefault;
+end;
+procedure TKeyBindings.RemoveShortCut(ShortCut: TShortCut);
+var
+  I: Integer;
+begin
+  for I := 0 to Count - 1 do begin
+    if Items[I].ShortCut = ShortCut then Items[I].ShortCut := 0;
+    if Items[I].ShortCut2 = ShortCut then Items[I].ShortCut2 := 0;
+  end;
+end;
 initialization
 …
   BStay := AddItem('Stay', 'Stay', 'S');
   BNoOrders := AddItem('NoOrders', 'No orders', 'Space');
+  BPrevUnit := AddItem('PrevUnit', 'Previous unit', 'Del');
+  BNextUnit := AddItem('NextUnit', 'Next unit', 'Ins');
   BCancel := AddItem('Cancel', 'Cancel', 'Ctrl+C');
   BPillage := AddItem('Pillage', 'Pillage', 'Ctrl+P');

branches/highdpi/LocalPlayer/UnitStat.pas

r361	r405
52	52
53	53	uses
54		Tribes, Help, Directories;
	54	Tribes, Help, Directories, UTexture;
55	55
56	56	{$R *.lfm}

branches/highdpi/Localization/cs/Language.txt

-              r378
+              r405
 #BTN_NO Ne
 #BTN_INFO Info
+#BTN_RESET Výchozí
 'Button Tooltips
 …
 Střední
 Velká
+Předchozí jednotka
+Další jednotka
 #ADVANCES
 …
 Gamma
 Pro projevení změn je potřeba restart
+Hlavní
+Vedlejší
+Jazyky
+Klávesové zkratky

branches/highdpi/Localization/de/Language.txt

-              r378
+              r405
 #BTN_NO Nein
 #BTN_INFO Info
+#BTN_RESET Reset
 'Button Tooltips
 …
 Medium
 Big
+Previous Unit
+Next Unit
 #ADVANCES
 …
 Gamma
 Restart is needed to apply changes
+Primary
+Secondary
+Languages
+Key bindings

branches/highdpi/Localization/it/Language.txt

-              r378
+              r405
 #BTN_NO No
 #BTN_INFO Dati
+#BTN_RESET Reset
 'Button Tooltips
 …
 Medium
 Big
+Previous Unit
+Next Unit
 #ADVANCES
 …
 Gamma
 Restart is needed to apply changes
+Primary
+Secondary
+Languages
+Key bindings

branches/highdpi/Localization/ru/Language.txt

-              r378
+              r405
 #BTN_NO Нет
 #BTN_INFO Информация
+#BTN_RESET Reset
 'Названия кнопок-инструментов
 …
 Medium
 Big
+Previous Unit
+Next Unit
 #ADVANCES
 …
 Gamma
 Restart is needed to apply changes
+Primary
+Secondary
+Languages
+Key bindings

branches/highdpi/Localization/zh-Hans/language.txt

-              r378
+              r405
 #BTN_NO ·ñ
 #BTN_INFO °ïÖú
+#BTN_RESET Reset
 'Button Tooltips
 …
 Medium
 Big
+Previous Unit
+Next Unit
 #ADVANCES
 …
 Gamma
 Restart is needed to apply changes
+Primary
+Secondary
+Languages
+Key bindings

branches/highdpi/Localization/zh-Hant/language.txt

-              r378
+              r405
 #BTN_NO §_
 #BTN_INFO À°§U
+#BTN_RESET Reset
 'Button Tooltips
 …
 Medium
 Big
+Previous Unit
+Next Unit
 #ADVANCES
 …
 Gamma
 Restart is needed to apply changes
+Primary
+Secondary
+Languages
+Key bindings

branches/highdpi/Network/UNetworkClient.pas

-              r378
+              r405
 uses
   LocalPlayer, Global, UNetworkCommon;
+  LocalPlayer{$IFDEF LINUX}, Global, UNetworkCommon{$ENDIF};
 procedure Client(Command, Player: Integer; var Data);
+{$IFDEF LINUX}
 var
   Cmd: TCommand;
+{$ENDIF}
 begin
   {$IFDEF LINUX}

branches/highdpi/Network/UNetworkServer.pas

-              r378
+              r405
 uses
   Classes, SysUtils, fgl{$IFDEF LINUX}, fpAsync, fpsock{$ENDIF}, Protocol, fphttpclient;
+  Classes, SysUtils{$IFDEF LINUX}, fgl, fpAsync, fpsock, fphttpclient{$ENDIF}, Protocol;
 {$IFDEF LINUX}
 …
 implementation
+{$IFDEF LINUX}
 uses
   Global, UNetworkCommon;
+{$ENDIF}
 procedure Client(Command, Player: integer; var Data);

branches/highdpi/Packages/CevoComponents/CevoComponents.lpk

-              r349
+              r405
     <Description Value="C-evo components"/>
     <Version Major="1" Minor="2"/>
     <Files Count="17">
+    <Files Count="16">
       <Item1>
         <Filename Value="Area.pas"/>
 …
       </Item13>
       <Item14>
         <Filename Value="UPixelPointer.pas"/>
         <UnitName Value="UPixelPointer"/>
+        <Filename Value="AsyncProcess2.pas"/>
+        <UnitName Value="AsyncProcess2"/>
       </Item14>
       <Item15>
         <Filename Value="AsyncProcess2.pas"/>
         <UnitName Value="AsyncProcess2"/>
+        <Filename Value="UGraphicSet.pas"/>
+        <UnitName Value="UGraphicSet"/>
       </Item15>
       <Item16>
         <Filename Value="UGraphicSet.pas"/>
         <UnitName Value="UGraphicSet"/>
+        <Filename Value="UTexture.pas"/>
+        <UnitName Value="UTexture"/>
       </Item16>
-      <Item17>
-        <Filename Value="UXMLUtils.pas"/>
-        <UnitName Value="UXMLUtils"/>
-      </Item17>
     </Files>
     <RequiredPkgs Count="3">
       <Item1>
         <PackageName Value="DpiControls"/>
+        <PackageName Value="Common"/>
       </Item1>
       <Item2>

branches/highdpi/Packages/CevoComponents/CevoComponents.pas

-              r349
+              r405
 uses
   Area, ButtonA, ButtonB, ButtonC, ButtonN, EOTButton, ButtonBase, DrawDlg,
+  Sound, BaseWin, UPixelPointer, AsyncProcess2, UGraphicSet, UXMLUtils,
+  LazarusPackageIntf;
+  Sound, BaseWin, AsyncProcess2, UGraphicSet, UTexture, LazarusPackageIntf;
 implementation

branches/highdpi/Packages/CevoComponents/Directories.pas

-              r246
+              r405
   Src, Dst: TSearchRec;
 begin
   if not DirectoryExists(DestinationDir) then CreateDir(DestinationDir);
+  if not DirectoryExists(DestinationDir) then ForceDirectories(DestinationDir);
   if FindFirst(SourceDir + DirectorySeparator + Filter, $21, Src) = 0 then
     repeat
 …
 end;
+procedure CopyFiles;
+begin
+  if DirectoryExists(GetSavedDir(True)) and not DirectoryExists(GetSavedDir(False)) then
+    CopyDir(GetSavedDir(True), GetSavedDir(False), '*.*');
+  if DirectoryExists(GetMapsDir(True)) and not DirectoryExists(GetMapsDir(False)) then
+    CopyDir(GetMapsDir(True), GetMapsDir(False), '*.*');
+end;
 procedure UnitInit;
 var
 …
   AppDataDir := GetAppConfigDir(False);
+  if AppDataDir = '' then
+    DataDir := HomeDir
+  else
+  begin
+    if not DirectoryExists(AppDataDir) then CreateDir(AppDataDir);
+  if AppDataDir = '' then DataDir := HomeDir
+  else begin
+    if not DirectoryExists(AppDataDir) then ForceDirectories(AppDataDir);
     DataDir := AppDataDir;
   end;
+  CopyDir(GetSavedDir(True), GetSavedDir(False), '*.*');
+  CopyDir(GetMapsDir(True), GetMapsDir(False), '*.*');
+  CopyFiles;
 end;

branches/highdpi/Packages/CevoComponents/DrawDlg.pas

-              r378
+              r405
 uses
   UDpiControls, Classes, SysUtils, Forms, LCLIntf, LCLType, {$IFDEF LINUX}LMessages,{$ENDIF}
+  Messages, Graphics, Controls, ButtonBase, ButtonA, ButtonB, Area, ScreenTools;
+  Messages, Graphics, Controls, ButtonBase, ButtonA, ButtonB, Area, ScreenTools
+  {$IFDEF LCLGTK2}, Gtk2Globals{$ENDIF};
 type
 …
 begin
   MoveActive := False;
+  {$IFDEF LCLGTK2}
+  // GTK2 bug workaround https://bugs.freepascal.org/view.php?id=35720
+  if Visible then LastMouse.WinControl := Self;
+  {$ENDIF}
 end;

branches/highdpi/Packages/CevoComponents/ScreenTools.pas

-              r378
+              r405
   {$ENDIF}
   StringTables, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Math,
   Forms, Menus, GraphType, fgl, UGraphicSet, LazFileUtils;
+  Forms, Menus, GraphType, fgl, UGraphicSet, LazFileUtils, UTexture;
 type
-  { TTexture }
-  TTexture = class
-  private
-    FAge: Integer;
-    function GetHeight: Integer;
-    function GetWidth: Integer;
-    procedure SetAge(AValue: Integer);
-  public
-    Image: TDpiBitmap;
-    ColorBevelLight: TColor;
-    ColorBevelShade: TColor;
-    ColorTextLight: TColor;
-    ColorTextShade: TColor;
-    ColorLitText: TColor;
-    ColorMark: TColor;
-    ColorPage: TColor;
-    ColorCover: TColor;
-    constructor Create;
-    destructor Destroy; override;
-    procedure Assign(Source: TTexture);
-    property Age: Integer read FAge write SetAge;
-    property Width: Integer read GetWidth;
-    property Height: Integer read GetHeight;
-  end;
   TLoadGraphicFileOption = (gfNoError, gfNoGamma);
   TLoadGraphicFileOptions = set of TLoadGraphicFileOption;
 …
 end;
-{ TTexture }
-procedure TTexture.SetAge(AValue: Integer);
-begin
-  if FAge = AValue then Exit;
-  FAge := AValue;
-  LoadGraphicFile(Image, GetGraphicsDir + DirectorySeparator +
-    'Texture' + IntToStr(Age + 1) + '.jpg');
-  ColorBevelLight := Colors.Canvas.Pixels[clkAge0 + Age, cliBevelLight];
-  ColorBevelShade := Colors.Canvas.Pixels[clkAge0 + Age, cliBevelShade];
-  ColorTextLight := Colors.Canvas.Pixels[clkAge0 + Age, cliTextLight];
-  ColorTextShade := Colors.Canvas.Pixels[clkAge0 + Age, cliTextShade];
-  ColorLitText := Colors.Canvas.Pixels[clkAge0 + Age, cliLitText];
-  ColorMark := Colors.Canvas.Pixels[clkAge0 + Age, cliMark];
-  ColorPage := Colors.Canvas.Pixels[clkAge0 + Age, cliPage];
-  ColorCover := Colors.Canvas.Pixels[clkAge0 + Age, cliCover];
-end;
-function TTexture.GetHeight: Integer;
-begin
-  Result := Image.Height;
-end;
-function TTexture.GetWidth: Integer;
-begin
-  Result := Image.Width;
-end;
-constructor TTexture.Create;
-begin
-  Image := TDpiBitmap.Create;
-  FAge := -2;
-end;
-destructor TTexture.Destroy;
-begin
-  FreeAndNil(Image);
-  inherited;
-end;
-procedure TTexture.Assign(Source: TTexture);
-begin
-  FAge := Source.FAge;
-  Image.Assign(Image);
-  ColorBevelLight := Source.ColorBevelLight;
-  ColorBevelShade := Source.ColorBevelShade;
-  ColorTextLight := Source.ColorTextLight;
-  ColorTextShade := Source.ColorTextShade;
-  ColorLitText := Source.ColorLitText;
-  ColorMark := Source.ColorMark;
-  ColorPage := Source.ColorPage;
-  ColorCover := Source.ColorCover;
-end;
 end.

branches/highdpi/Packages/CevoComponents/Sound.pas

-              r349
+              r405
     if (FindDefaultExecutablePath('afplay') <> '') then
       Result := 'afplay';
+  // Try mpg321
+  if (Result = '') then
+    if (FindDefaultExecutablePath('mpg321') <> '') then
+      Result := 'mpg321 -q';
 end;

branches/highdpi/Packages/DpiControls/UDpiControls.pas

-              r378
+              r405
 uses
+  {$IFDEF WINDOWS}Windows, {$ENDIF}Classes, SysUtils, LCLProc, LResources, Forms, FormEditingIntf, ProjectIntf,
+  Controls, StdCtrls, fgl, Graphics, ComCtrls, ExtCtrls, LCLType, GraphType,
+  Types, CustApp, LMessages, LCLIntf, Menus, Math, UPixelPointer2;
+  {$IFDEF WINDOWS}Windows, {$ENDIF}Classes, SysUtils, LCLProc, LResources, Forms,
+  FormEditingIntf, ProjectIntf, Controls, StdCtrls, fgl, Graphics, ComCtrls,
+  ExtCtrls, LCLType, GraphType, Types, CustApp, LMessages, LCLIntf, Menus, Math,
+  UPixelPointer2, Grids, Spin;
 const
 …
     destructor Destroy; override;
     procedure Assign(Source: TPersistent); override;
+    procedure GetTextSize(Text: string; var w, h: Integer);
+    function GetTextHeight(Text: string): Integer;
+    function GetTextWidth(Text: string): Integer;
   published
     property CharSet: TFontCharSet read GetCharSet write SetCharSet default DEFAULT_CHARSET;
 …
     function GetAlign: TAlign;
     function GetAnchors: TAnchors;
+    function GetAutoSize: Boolean;
     function GetBoundsRect: TRect;
     function GetClientHeight: Integer;
 …
     procedure SetAlign(AValue: TAlign);
     procedure SetAnchors(AValue: TAnchors);
+    procedure SetAutoSize(AValue: Boolean);
     procedure SetBorderSpacing(AValue: TDpiControlBorderSpacing);
     procedure SetBoundsRect(AValue: TRect);
 …
     procedure Repaint;
     procedure Update;
+    procedure Refresh;
     function IsParentOf(AControl: TDpiControl): boolean; virtual;
+    function Scale96ToScreen(const ASize: Integer): Integer;
     constructor Create(TheOwner: TComponent); override;
     destructor Destroy; override;
 …
     property BorderSpacing: TDpiControlBorderSpacing read FBorderSpacing write SetBorderSpacing;
   published
+    property AutoSize: Boolean read GetAutoSize write SetAutoSize default False;
     property ClientHeight: Integer read GetClientHeight write SetClientHeight;
     property ClientWidth: Integer read GetClientWidth write SetClientWidth;
 …
     function GetNativeRasterImage: TRasterImage; virtual;
   public
+    procedure BeginUpdate(ACanvasOnly: Boolean = False);
+    procedure EndUpdate(AStreamIsValid: Boolean = False);
     property RawImage: TRawImage read GetRawImage;
   end;
 …
     FNativeCanvasFree: Boolean;
     function GetHandle: HDC;
-    function GetHeight: Integer;
     function GetPixel(X, Y: Integer): TColor;
-    function GetWidth: Integer;
     procedure SetBrush(AValue: TDpiBrush);
     procedure SetFont(AValue: TDpiFont);
 …
     procedure SetNativeCanvas(AValue: TCanvas);
   protected
+    procedure SetHeight(AValue: Integer); virtual;
+    procedure SetWidth(AValue: Integer); virtual;
+    function GetWidth: Integer; virtual;
+    function GetHeight: Integer; virtual;
     function GetNativeCanvas: TCanvas; virtual;
   public
 …
     function TextHeight(Text: string): Integer;
     function TextExtent(Text: string): TSize;
     procedure TextOut(X, Y: Integer; Text: string);
+    procedure TextOut(X, Y: Integer; const Text: string); virtual;
     procedure TextRect(ARect: TRect; X, Y: Integer; Text: string);
     procedure MoveTo(X, Y: Integer);
     procedure LineTo(X, Y: Integer);
     procedure FillRect(ARect: TRect);
+    procedure FillRect(const ARect: TRect); virtual;
     procedure FillRect(X1, Y1, X2, Y2: Integer);
     procedure Draw(X, Y: Integer; Source: TDpiGraphic);
 …
     function GetOnShow: TNotifyEvent;
     function GetPosition: TPosition;
+    function GetRestoredHeight: Integer;
+    function GetRestoredLeft: Integer;
+    function GetRestoredTop: Integer;
+    function GetRestoredWidth: Integer;
     function GetWindowState: TWindowState;
     procedure SetBorderIcons(AValue: TBorderIcons);
 …
     destructor Destroy; override;
   published
+    property RestoredLeft: integer read GetRestoredLeft;
+    property RestoredTop: integer read GetRestoredTop;
+    property RestoredWidth: integer read GetRestoredWidth;
+    property RestoredHeight: integer read GetRestoredHeight;
     property DesignTimePPI: Integer read GetDesignTimePPI write SetDesignTimePPI; // Not used
     property FormState: TFormState read GetFormState;
 …
     function GetItemIndex: Integer;
     function GetItems: TStrings;
+    function GetOnSelectionChange: TSelectionChangeEvent;
     function GetParentFont: Boolean;
     function GetScrollWidth: Integer;
 …
     procedure SetItemIndex(AValue: Integer);
     procedure SetItems(AValue: TStrings);
+    procedure SetOnSelectionChange(AValue: TSelectionChangeEvent);
     procedure SetParentFont(AValue: Boolean);
     procedure SetScrollWidth(AValue: Integer);
 …
     property Visible;
     property Anchors;
+    property OnSelectionChange: TSelectionChangeEvent read GetOnSelectionChange
+                                                      write SetOnSelectionChange;
   end;
 …
     function GetPixelFormat: TPixelFormat;
     function GetScanLine(Row: Integer): Pointer;
+    function GetTransparent: Boolean;
+    function GetTransparentColor: TColor;
     procedure SetPixelFormat(AValue: TPixelFormat);
+    procedure SetTransparent(AValue: Boolean);
+    procedure SetTransparentColor(AValue: TColor);
   protected
     function GetHeight: Integer; override;
 …
     property Width: Integer read GetWidth write SetWidth;
     property Canvas: TDpiCanvas read GetCanvas;
+    property TransparentColor: TColor read GetTransparentColor
+                                      write SetTransparentColor default clDefault;
+    property Transparent: Boolean read GetTransparent write SetTransparent default False;
   end;
 …
   end;
+  { TDpiListView }
+  TDpiListView = class(TDpiWinControl)
+  private
+    NativeListView: TListView;
+    function GetColumns: TListColumns;
+    function GetItems: TListItems;
+    procedure SetColumns(AValue: TListColumns);
+    procedure SetItems(AValue: TListItems);
+  public
+    function GetNativeListView: TListView;
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+    property Columns: TListColumns read GetColumns write SetColumns;
+    property Items: TListItems read GetItems write SetItems;
+  published
+  end;
+  { TDpiPanel }
+  TDpiPanel = class(TDpiWinControl)
+  private
+    NativePanel: TPanel;
+  public
+    function GetNativePanel: TPanel;
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+  end;
+  { TDpiCustomDrawGrid }
+  TDpiCustomDrawGrid = class(TDpiWinControl)
+  private
+    NativeCustomDrawGrid: TCustomDrawGrid;
+    function GetEditor: TDpiWinControl;
+    procedure SetEditor(AValue: TDpiWinControl);
+  public
+    function GetNativeCustomDrawGrid: TCustomDrawGrid;
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+    property Editor: TDpiWinControl read GetEditor write SetEditor;
+  end;
+  { TDpiPageControl }
+  TDpiPageControl = class(TDpiWinControl)
+  private
+    NativePageControl: TPageControl;
+    function GetPageCount: Integer;
+    function GetTabSheet(Index: Integer): TTabSheet;
+  public
+    function GetNativePageControl: TPageControl;
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+    property PageCount: Integer read GetPageCount;
+    property Pages[Index: Integer]: TTabSheet read GetTabSheet;
+  end;
+  { TDpiRadioButton }
+  TDpiRadioButton = class(TDpiWinControl)
+  private
+    NativeRadioButton: TRadioButton;
+  public
+    function GetNativeRadioButton: TRadioButton;
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+  end;
+  { TDpiSpinEdit }
+  TDpiSpinEdit = class(TDpiWinControl)
+  private
+    NativeSpinEdit: TSpinEdit;
+  public
+    function GetNativeSpinEdit: TSpinEdit;
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+  end;
+  { TDpiComboBox }
+  TDpiComboBox = class(TDpiWinControl)
+  private
+    NativeComboBox: TComboBox;
+  public
+    function GetNativeComboBox: TComboBox;
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+  end;
+  { TDpiCheckBox }
+  TDpiCheckBox = class(TDpiWinControl)
+  private
+    NativeCheckBox: TCheckBox;
+  public
+    function GetNativeCheckBox: TCheckBox;
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+  end;
+  { TDpiMemo }
+  TDpiMemo = class(TDpiWinControl)
+  private
+    NativeMemo: TMemo;
+    function GetLines: TStrings;
+    procedure SetLines(AValue: TStrings);
+  public
+    procedure Clear;
+    function GetNativeMemo: TMemo;
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+    property Lines: TStrings read GetLines write SetLines;
+  end;
+  { TDpiToolBar }
+  TDpiToolBar = class(TDpiCustomControl)
+  private
+    NativeToolBar: TToolBar;
+    function ButtonHeightIsStored: Boolean;
+    function ButtonWidthIsStored: Boolean;
+    function GetButtonHeight: Integer;
+    function GetButtonWidth: Integer;
+    procedure SetButtonHeight(AValue: Integer);
+    procedure SetButtonWidth(AValue: Integer);
+  public
+    function GetNativeToolBar: TToolBar;
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+    property ButtonHeight: Integer read GetButtonHeight write SetButtonHeight stored ButtonHeightIsStored;
+    property ButtonWidth: Integer read GetButtonWidth write SetButtonWidth stored ButtonWidthIsStored;
+  end;
+  { TDpiCoolBand }
+  TDpiCoolBand = class(TDpiCustomControl)
+  private
+    NativeCoolBand: TCoolBand;
+    function GetMinHeight: Integer;
+    function GetMinWidth: Integer;
+    procedure SetMinHeight(AValue: Integer);
+    procedure SetMinWidth(AValue: Integer);
+  protected const
+    cDefMinHeight = 25;
+    cDefMinWidth = 100;
+  public
+    function GetNativeCoolBand: TCoolBand;
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+    property MinHeight: Integer read GetMinHeight write SetMinHeight default cDefMinHeight;
+    property MinWidth: Integer read GetMinWidth write SetMinWidth default cDefMinWidth;
+  end;
+  { TDpiCoolBands }
+  TDpiCoolBands = class(TCollection)
+  private
+    procedure SetItem(Index: Integer; AValue: TDpiCoolBand);
+    function GetItem(Index: Integer): TDpiCoolBand;
+  public
+    property Items[Index: Integer]: TDpiCoolBand read GetItem write SetItem; default;
+  end;
+  { TDpiCoolBar }
+  TDpiCoolBar = class(TDpiCustomControl)
+  private
+    NativeCoolBar: TCoolBar;
+    function GetBands: TDpiCoolBands;
+    function GetThemed: Boolean;
+    procedure SetBands(AValue: TDpiCoolBands);
+    procedure SetThemed(AValue: Boolean);
+  public
+    procedure BeginUpdate;
+    procedure EndUpdate;
+    function GetNativeCoolBar: TCoolBar;
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+    property Bands: TDpiCoolBands read GetBands write SetBands;
+    property Themed: Boolean read GetThemed write SetThemed default True;
+  end;
+  { TDpiImageList }
+  TDpiImageList = class(TComponent)
+  private
+    NativeImageList: TImageList;
+    function GetCount: Integer;
+    function GetHeight: Integer;
+    function GetWidth: Integer;
+    procedure SetHeight(AValue: Integer);
+    procedure SetWidth(AValue: Integer);
+  public
+    function GetNativeImageList: TImageList;
+    procedure GetBitmap(Index: Integer; Image: TDpiBitmap);
+    procedure BeginUpdate;
+    procedure EndUpdate;
+    procedure Clear;
+    function Add(Image, Mask: TDpiBitmap): Integer;
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+    property Width: Integer read GetWidth write SetWidth default 16;
+    property Height: Integer read GetHeight write SetHeight default 16;
+    property Count: Integer read GetCount;
+  end;
+  { TDpiStringGrid }
+  TDpiStringGrid = class(TDpiWinControl)
+  private
+    NativeStringGrid: TStringGrid;
+    function DefaultRowHeightIsStored: Boolean;
+    function GetDefRowHeight: Integer;
+    procedure SetDefRowHeight(AValue: Integer);
+  public
+    function GetNativeStringGrid: TStringGrid;
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+  published
+    property DefaultRowHeight: Integer read GetDefRowHeight write SetDefRowHeight stored DefaultRowHeightIsStored;
+  end;
   { TDpiScreen }
 …
     FForms: TDpiForms;
     procedure AddForm(AForm: TDpiForm);
+    function GetDesktopHeight: Integer;
+    function GetDesktopLeft: Integer;
+    function GetDesktopTop: Integer;
+    function GetDesktopWidth: Integer;
     procedure RemoveForm(AForm: TDpiForm);
     function GetActiveForm: TDpiForm;
 …
     procedure UpdateScreen;
     procedure UpdateActiveFormFromNativeScreen;
+    function DisableForms(SkipForm: TDpiForm; DisabledList: TList = nil): TList;
+    procedure EnableForms(var AFormList: TList);
     property FormCount: Integer read GetFormCount;
     property Forms[Index: Integer]: TDpiForm read GetForms;
 …
     property Width: Integer read GetWidth;
     property Height: Integer read GetHeight;
+    property DesktopLeft: Integer read GetDesktopLeft;
+    property DesktopTop: Integer read GetDesktopTop;
+    property DesktopWidth: Integer read GetDesktopWidth;
+    property DesktopHeight: Integer read GetDesktopHeight;
   end;
 …
     FOldExitProc: Pointer;
     function GetActive: Boolean;
+    function GetExeName: string;
     function GetShowMainForm: Boolean;
     function GetTitle: string;
 …
     property Title: string read GetTitle write SetTitle;
     property Active: Boolean read GetActive;
+    property ExeName: string read GetExeName;
   end;
 …
     property Items[Index: Integer]: TDpiMenuItem read GetItem; default;
     property Count: Integer read GetCount;
+    procedure Clear;
   published
     property RadioItem: Boolean read GetRadioItem write SetRadioItem default False;
 …
       ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
   end else begin
+    Result := StretchBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
+    Result := BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
+      DstWidth, DstHeight, SrcDC,
+      ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
+{    Result := StretchBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
       DstWidth, DstHeight, SrcDC,
       ScaleToNative(XSrc), ScaleToNative(YSrc),
       SrcWidth, SrcHeight, Rop);
   end;
+}  end;
 {  Result := BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
 …
+ }
   {$ENDIF}
+end;
+{ TDpiRadioButton }
+function TDpiRadioButton.GetNativeRadioButton: TRadioButton;
+begin
+  if not Assigned(NativeRadioButton) then NativeRadioButton := TRadioButton.Create(nil);
+    Result := NativeRadioButton;
+end;
+constructor TDpiRadioButton.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+end;
+destructor TDpiRadioButton.Destroy;
+begin
+  FreeAndNil(NativeRadioButton);
+  inherited;
+end;
+{ TDpiPageControl }
+function TDpiPageControl.GetPageCount: Integer;
+begin
+  Result := GetNativePageControl.PageCount;
+end;
+function TDpiPageControl.GetTabSheet(Index: Integer): TTabSheet;
+begin
+  Result := GetNativePageControl.Pages[Index];
+end;
+function TDpiPageControl.GetNativePageControl: TPageControl;
+begin
+  if not Assigned(NativePageControl) then NativePageControl := TPageControl.Create(nil);
+    Result := NativePageControl;
+end;
+constructor TDpiPageControl.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+end;
+destructor TDpiPageControl.Destroy;
+begin
+  FreeAndNil(NativePageControl);
+  inherited;
+end;
+{ TDpiCustomDrawGrid }
+function TDpiCustomDrawGrid.GetEditor: TDpiWinControl;
+begin
+  //Result := GetNativeCustomDrawGrid.Editor;
+end;
+procedure TDpiCustomDrawGrid.SetEditor(AValue: TDpiWinControl);
+begin
+  //GetNativeCustomDrawGrid.Editor := AValue
+end;
+function TDpiCustomDrawGrid.GetNativeCustomDrawGrid: TCustomDrawGrid;
+begin
+  if not Assigned(NativeCustomDrawGrid) then NativeCustomDrawGrid := TCustomDrawGrid.Create(nil);
+    Result := NativeCustomDrawGrid;
+end;
+constructor TDpiCustomDrawGrid.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+end;
+destructor TDpiCustomDrawGrid.Destroy;
+begin
+  FreeAndNil(NativeCustomDrawGrid);
+  inherited;
+end;
+{ TDpiCheckBox }
+function TDpiCheckBox.GetNativeCheckBox: TCheckBox;
+begin
+  if not Assigned(NativeCheckBox) then NativeCheckBox := TCheckBox.Create(nil);
+    Result := NativeCheckBox;
+end;
+constructor TDpiCheckBox.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+end;
+destructor TDpiCheckBox.Destroy;
+begin
+  FreeAndNil(NativeCheckBox);
+  inherited;
+end;
+{ TDpiComboBox }
+function TDpiComboBox.GetNativeComboBox: TComboBox;
+begin
+  if not Assigned(NativeComboBox) then NativeComboBox := TComboBox.Create(nil);
+    Result := NativeComboBox;
+end;
+constructor TDpiComboBox.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+end;
+destructor TDpiComboBox.Destroy;
+begin
+  FreeAndNil(NativeComboBox);
+  inherited;
+end;
+{ TDpiSpinEdit }
+function TDpiSpinEdit.GetNativeSpinEdit: TSpinEdit;
+begin
+  if not Assigned(NativeSpinEdit) then NativeSpinEdit := TSpinEdit.Create(nil);
+    Result := NativeSpinEdit;
+end;
+constructor TDpiSpinEdit.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+end;
+destructor TDpiSpinEdit.Destroy;
+begin
+  FreeAndNil(NativeSpinEdit);
+  inherited;
+end;
+{ TDpiMemo }
+function TDpiMemo.GetLines: TStrings;
+begin
+  Result := GetNativeMemo.Lines;
+end;
+procedure TDpiMemo.SetLines(AValue: TStrings);
+begin
+  GetNativeMemo.Lines := AValue;
+end;
+procedure TDpiMemo.Clear;
+begin
+  GetNativeMemo.Clear;
+end;
+function TDpiMemo.GetNativeMemo: TMemo;
+begin
+  if not Assigned(NativeMemo) then NativeMemo := TMemo.Create(nil);
+    Result := NativeMemo;
+end;
+constructor TDpiMemo.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+end;
+destructor TDpiMemo.Destroy;
+begin
+  FreeAndNil(NativeMemo);
+  inherited;
+end;
+{ TDpiImageList }
+function TDpiImageList.GetHeight: Integer;
+begin
+end;
+function TDpiImageList.GetCount: Integer;
+begin
+end;
+function TDpiImageList.GetWidth: Integer;
+begin
+end;
+procedure TDpiImageList.SetHeight(AValue: Integer);
+begin
+end;
+procedure TDpiImageList.SetWidth(AValue: Integer);
+begin
+end;
+function TDpiImageList.GetNativeImageList: TImageList;
+begin
+  if not Assigned(NativeImageList) then NativeImageList := TImageList.Create(nil);
+    Result := NativeImageList;
+end;
+procedure TDpiImageList.GetBitmap(Index: Integer; Image: TDpiBitmap);
+begin
+end;
+procedure TDpiImageList.BeginUpdate;
+begin
+end;
+procedure TDpiImageList.EndUpdate;
+begin
+end;
+procedure TDpiImageList.Clear;
+begin
+end;
+function TDpiImageList.Add(Image, Mask: TDpiBitmap): Integer;
+begin
+end;
+constructor TDpiImageList.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+end;
+destructor TDpiImageList.Destroy;
+begin
+  FreeAndNil(NativeImageList);
+  inherited Destroy;
+end;
+{ TDpiCoolBands }
+procedure TDpiCoolBands.SetItem(Index: Integer; AValue: TDpiCoolBand);
+begin
+end;
+function TDpiCoolBands.GetItem(Index: Integer): TDpiCoolBand;
+begin
+end;
+{ TDpiCoolBand }
+function TDpiCoolBand.GetMinWidth: Integer;
+begin
+end;
+function TDpiCoolBand.GetMinHeight: Integer;
+begin
+end;
+procedure TDpiCoolBand.SetMinHeight(AValue: Integer);
+begin
+end;
+procedure TDpiCoolBand.SetMinWidth(AValue: Integer);
+begin
+end;
+function TDpiCoolBand.GetNativeCoolBand: TCoolBand;
+begin
+end;
+constructor TDpiCoolBand.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+end;
+destructor TDpiCoolBand.Destroy;
+begin
+  inherited Destroy;
+end;
+{ TDpiCoolBar }
+function TDpiCoolBar.GetBands: TDpiCoolBands;
+begin
+end;
+function TDpiCoolBar.GetThemed: Boolean;
+begin
+  Result := GetNativeCoolBar.Themed;
+end;
+procedure TDpiCoolBar.SetBands(AValue: TDpiCoolBands);
+begin
+end;
+procedure TDpiCoolBar.SetThemed(AValue: Boolean);
+begin
+  GetNativeCoolBar.Themed := AValue
+end;
+procedure TDpiCoolBar.BeginUpdate;
+begin
+  GetNativeCoolBar.BeginUpdate;
+end;
+procedure TDpiCoolBar.EndUpdate;
+begin
+  GetNativeCoolBar.EndUpdate;
+end;
+function TDpiCoolBar.GetNativeCoolBar: TCoolBar;
+begin
+  if not Assigned(NativeCoolBar) then NativeCoolBar := TCoolBar.Create(nil);
+    Result := NativeCoolBar;
+end;
+constructor TDpiCoolBar.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+end;
+destructor TDpiCoolBar.Destroy;
+begin
+  FreeAndNil(NativeCoolBar);
+  inherited Destroy;
+end;
+{ TDpiToolBar }
+function TDpiToolBar.ButtonHeightIsStored: Boolean;
+begin
+end;
+function TDpiToolBar.ButtonWidthIsStored: Boolean;
+begin
+end;
+function TDpiToolBar.GetButtonHeight: Integer;
+begin
+  Result := ScaleFromNative(GetNativeToolBar.ButtonHeight);
+end;
+function TDpiToolBar.GetButtonWidth: Integer;
+begin
+  Result := ScaleFromNative(GetNativeToolBar.ButtonWidth);
+end;
+procedure TDpiToolBar.SetButtonHeight(AValue: Integer);
+begin
+  GetNativeToolBar.ButtonHeight := ScaleToNative(AValue);
+end;
+procedure TDpiToolBar.SetButtonWidth(AValue: Integer);
+begin
+  GetNativeToolBar.ButtonWidth := ScaleToNative(AValue);
+end;
+function TDpiToolBar.GetNativeToolBar: TToolBar;
+begin
+  if not Assigned(NativeToolBar) then NativeToolBar := TToolBar.Create(nil);
+    Result := NativeToolBar;
+end;
+constructor TDpiToolBar.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+end;
+destructor TDpiToolBar.Destroy;
+begin
+  FreeAndNil(NativeToolBar);
+  inherited;
+end;
+{ TDpiPanel }
+function TDpiPanel.GetNativePanel: TPanel;
+begin
+  if not Assigned(NativePanel) then NativePanel := TPanel.Create(nil);
+    Result := NativePanel;
+end;
+constructor TDpiPanel.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+end;
+destructor TDpiPanel.Destroy;
+begin
+  FreeAndNil(NativePanel);
+  inherited;
+end;
+{ TDpiStringGrid }
+function TDpiStringGrid.DefaultRowHeightIsStored: Boolean;
+begin
+  Result := GetDefRowHeight>=0;
+end;
+function TDpiStringGrid.GetDefRowHeight: Integer;
+begin
+  Result := GetNativeStringGrid.DefaultRowHeight;
+end;
+procedure TDpiStringGrid.SetDefRowHeight(AValue: Integer);
+begin
+  GetNativeStringGrid.DefaultRowHeight := AValue;
+end;
+function TDpiStringGrid.GetNativeStringGrid: TStringGrid;
+begin
+  if not Assigned(NativeStringGrid) then NativeStringGrid := TStringGrid.Create(nil);
+    Result := NativeStringGrid;
+end;
+constructor TDpiStringGrid.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+end;
+destructor TDpiStringGrid.Destroy;
+begin
+  FreeAndNil(NativeStringGrid);
+  inherited;
+end;
+{ TDpiListView }
+function TDpiListView.GetItems: TListItems;
+begin
+  Result := GetNativeListView.Items;
+end;
+function TDpiListView.GetColumns: TListColumns;
+begin
+  Result := NativeListView.Columns;
+end;
+procedure TDpiListView.SetColumns(AValue: TListColumns);
+begin
+  NativeListView.Columns := AValue;
+end;
+procedure TDpiListView.SetItems(AValue: TListItems);
+begin
+  GetNativeListView.Items := AValue;
+end;
+function TDpiListView.GetNativeListView: TListView;
+begin
+  if not Assigned(NativeListView) then NativeListView := TListView.Create(nil);
+    Result := NativeListView;
+end;
+constructor TDpiListView.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+end;
+destructor TDpiListView.Destroy;
+begin
+  FreeAndNil(NativeListView);
+  inherited;
 end;
 …
     raise EMenuError.Create(SMenuNotFound);
   Delete(I);
+end;
+procedure TDpiMenuItem.Clear;
+begin
+  GetNativeMenuItem.Clear;
 end;
 …
 begin
   Result := Application.Active;
+end;
+function TDpiApplication.GetExeName: string;
+begin
+  Result := GetNativeApplication.ExeName;
 end;
 …
 begin
   Result := nil;
+end;
+procedure TDpiRasterImage.BeginUpdate(ACanvasOnly: Boolean);
+begin
+  GetNativeRasterImage.BeginUpdate(ACanvasOnly);
+end;
+procedure TDpiRasterImage.EndUpdate(AStreamIsValid: Boolean);
+begin
+  GetNativeRasterImage.EndUpdate(AStreamIsValid);
 end;
 …
 end;
+function TDpiBitmap.GetTransparent: Boolean;
+begin
+  Result := GetNativeBitmap.Transparent;
+end;
+function TDpiBitmap.GetTransparentColor: TColor;
+begin
+  Result := GetNativeBitmap.TransparentColor;
+end;
 function TDpiBitmap.GetWidth: Integer;
 begin
 …
 begin
   GetNativeBitmap.PixelFormat := AValue;
+end;
+procedure TDpiBitmap.SetTransparent(AValue: Boolean);
+begin
+  GetNativeBitmap.Transparent := AValue;
+end;
+procedure TDpiBitmap.SetTransparentColor(AValue: TColor);
+begin
+  GetNativeBitmap.TransparentColor := AValue;
 end;
 …
 end;
+function TDpiListBox.GetOnSelectionChange: TSelectionChangeEvent;
+begin
+  Result := GetNativeListBox.OnSelectionChange;
+end;
 function TDpiListBox.GetParentFont: Boolean;
 begin
 …
 begin
   GetNativeListBox.Items := AValue;
+end;
+procedure TDpiListBox.SetOnSelectionChange(AValue: TSelectionChangeEvent);
+begin
+  GetNativeListBox.OnSelectionChange := AValue;
 end;
 …
 begin
   GetNativeCanvas.Handle := AValue;
+end;
+procedure TDpiCanvas.SetHeight(AValue: Integer);
+begin
+  GetNativeCanvas.Height;
+end;
+procedure TDpiCanvas.SetWidth(AValue: Integer);
+begin
 end;
 …
 end;
 procedure TDpiCanvas.TextOut(X, Y: Integer; Text: string);
+procedure TDpiCanvas.TextOut(X, Y: Integer; const Text: string);
 begin
   GetNativeCanvas.TextOut(ScaleToNative(X), ScaleToNative(Y), Text);
 …
 end;
 procedure TDpiCanvas.FillRect(ARect: TRect);
+procedure TDpiCanvas.FillRect(const ARect: TRect);
 begin
   GetNativeCanvas.FillRect(ScaleRectToNative(ARect));
 …
 end;
+procedure TDpiFont.GetTextSize(Text: string; var w, h: Integer);
+begin
+  W := GetTextWidth(Text);
+  H := GetTextHeight(Text);
+end;
+function TDpiFont.GetTextHeight(Text: string): Integer;
+begin
+  Result := ScaleFromNative(GetNativeFont.GetTextHeight(Text));
+end;
+function TDpiFont.GetTextWidth(Text: string): Integer;
+begin
+  Result := ScaleFromNative(GetNativeFont.GetTextWidth(Text));
+end;
 { TDpiWinControl }
 …
     //DpiApplication.UpdateVisible;
   end;
+end;
+function TDpiScreen.GetDesktopHeight: Integer;
+begin
+  Result := ScaleFromNative(Screen.DesktopHeight);
+end;
+function TDpiScreen.GetDesktopLeft: Integer;
+begin
+  Result := ScaleFromNative(Screen.DesktopLeft);
+end;
+function TDpiScreen.GetDesktopTop: Integer;
+begin
+  Result := ScaleFromNative(Screen.DesktopTop);
+end;
+function TDpiScreen.GetDesktopWidth: Integer;
+begin
+  Result := ScaleFromNative(Screen.DesktopWidth);
 end;
 …
   for I := 0 to FForms.Count - 1 do
     FForms[I].ScreenChanged;
+end;
+function TDpiScreen.DisableForms(SkipForm: TDpiForm; DisabledList: TList
+  ): TList;
+begin
+  Result := Screen.DisableForms(SkipForm.GetNativeForm, DisabledList);
+end;
+procedure TDpiScreen.EnableForms(var AFormList: TList);
+begin
+  Screen.EnableForms(AFormList);
 end;
 …
 end;
+procedure TDpiControl.Refresh;
+begin
+  GetNativeControl.Refresh;
+end;
 function TDpiControl.IsParentOf(AControl: TDpiControl): boolean;
 begin
 …
       Exit(True);
   end;
+end;
+function TDpiControl.Scale96ToScreen(const ASize: Integer): Integer;
+begin
+  Result := MulDiv(ASize, Screen.PixelsPerInch, 96);
 end;
 …
 end;
+function TDpiControl.GetAutoSize: Boolean;
+begin
+  Result := GetNativeControl.AutoSize;
+end;
 function TDpiControl.GetClientHeight: Integer;
 begin
 …
 begin
   GetNativeControl.Anchors := AValue;
+end;
+procedure TDpiControl.SetAutoSize(AValue: Boolean);
+begin
+  GetNativeControl.AutoSize := AValue;
 end;
 …
 begin
   Result := GetNativeForm.Position;
+end;
+function TDpiForm.GetRestoredHeight: Integer;
+begin
+  Result := ScaleFromNative(GetNativeForm.RestoredHeight);
+end;
+function TDpiForm.GetRestoredLeft: Integer;
+begin
+  Result := ScaleFromNative(GetNativeForm.RestoredLeft);
+end;
+function TDpiForm.GetRestoredTop: Integer;
+begin
+  Result := ScaleFromNative(GetNativeForm.RestoredTop);
+end;
+function TDpiForm.GetRestoredWidth: Integer;
+begin
+  Result := ScaleFromNative(GetNativeForm.RestoredWidth);
 end;

branches/highdpi/Settings.lfm

-              r349
+              r405
   DesignTimePPI = 144
   FormStyle = fsStayOnTop
+  OnClose = FormClose
   OnCreate = FormCreate
   OnDestroy = FormDestroy
 …
   LCLVersion = '2.0.12.0'
   Scaled = False
   object List: TDpiListBox
+  object ListLanguages: TDpiListBox
     Tag = 15360
+    Left = 24
+    Height = 304
+    Top = 16
+    Width = 424
+    Anchors = [akTop, akLeft, akRight, akBottom]
+    Left = 16
+    Height = 267
+    Top = 32
+    Width = 144
     BorderStyle = bsNone
     Color = clBlack
 …
     ItemHeight = 0
     ParentFont = False
     ScrollWidth = 424
     TabOrder = 0
+    ScrollWidth = 144
+    TabOrder = 1
     TabStop = False
     TopIndex = -1
   end
   object OKBtn: TButtonA
     Left = 272
+  object ButtonOk: TButtonA
+    Left = 364
     Height = 25
     Top = 400
 …
     Down = False
     Permanent = False
     OnClick = OKBtnClick
+    OnClick = ButtonOkClick
   end
   object CancelBtn: TButtonA
     Left = 96
+  object ButtonCancel: TButtonA
+    Left = 244
     Height = 25
     Top = 400
 …
     Down = False
     Permanent = False
     OnClick = CancelBtnClick
+    OnClick = ButtonCancelClick
   end
   object ButtonFullscreen: TButtonC
 …
     ButtonIndex = 0
   end
+  object ListKeyBindings: TDpiListBox
+    Tag = 15360
+    Left = 176
+    Height = 192
+    Top = 32
+    Width = 288
+    BorderStyle = bsNone
+    Color = clBlack
+    ExtendedSelect = False
+    Font.Color = 4176863
+    Font.Height = -15
+    Font.Name = 'Times New Roman'
+    Font.Style = [fsBold]
+    IntegralHeight = True
+    ItemHeight = 0
+    OnSelectionChange = ListKeyBindingsSelectionChange
+    ParentFont = False
+    ScrollWidth = 288
+    TabOrder = 0
+    TabStop = False
+    TopIndex = -1
+  end
+  object EditShortCutPrimary: TDpiEdit
+    Left = 176
+    Height = 42
+    Top = 256
+    Width = 136
+    Enabled = False
+    OnKeyUp = EditShortCutPrimaryKeyUp
+    TabOrder = 2
+  end
+  object EditShortCutSecondary: TDpiEdit
+    Left = 328
+    Height = 42
+    Top = 257
+    Width = 136
+    Enabled = False
+    OnKeyUp = EditShortCutSecondaryKeyUp
+    TabOrder = 3
+  end
+  object ButtonReset: TButtonA
+    Left = 16
+    Height = 25
+    Top = 400
+    Width = 100
+    Down = False
+    Permanent = False
+    OnClick = ButtonResetClick
+  end
 end

branches/highdpi/Settings.pas

-              r361
+              r405
 uses
   UDpiControls, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
+  ScreenTools, Messg, ButtonA, Registry, fgl, Directories, DrawDlg, ButtonC;
+  LCLProc, ScreenTools, Messg, ButtonA, Registry, fgl, Directories, DrawDlg,
+  ButtonC, UKeyBindings, ULanguages;
 type
-  TLanguage = class
-    ShortName: string;
-    FullName: string;
-    Author: string;
-  end;
-  { TLanguages }
-  TLanguages = class(TFPGObjectList<TLanguage>)
-    procedure AddItem(const ShortName, FullName: string);
-    procedure LoadToStrings(Strings: TStrings);
-    function Search(ShortName: string): Integer;
-  end;
   { TSettingsDlg }
 …
     ButtonFullscreen: TButtonC;
     Down2Btn: TButtonC;
+    List: TDpiListBox;
+    OKBtn: TButtonA;
+    CancelBtn: TButtonA;
+    EditShortCutPrimary: TDpiEdit;
+    EditShortCutSecondary: TDpiEdit;
+    ListLanguages: TDpiListBox;
+    ListKeyBindings: TDpiListBox;
+    ButtonOk: TButtonA;
+    ButtonCancel: TButtonA;
+    ButtonReset: TButtonA;
     Up2Btn: TButtonC;
     procedure ButtonFullscreenClick(Sender: TObject);
+    procedure CancelBtnClick(Sender: TObject);
+    procedure ButtonCancelClick(Sender: TObject);
+    procedure ButtonResetClick(Sender: TObject);
     procedure Down2BtnClick(Sender: TObject);
+    procedure EditShortCutPrimaryKeyUp(Sender: TObject; var Key: Word;
+      Shift: TShiftState);
+    procedure EditShortCutSecondaryKeyUp(Sender: TObject; var Key: Word;
+      Shift: TShiftState);
+    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
     procedure FormPaint(Sender: TObject);
     procedure FormShow(Sender: TObject);
+    procedure OKBtnClick(Sender: TObject);
+    procedure ListKeyBindingsSelectionChange(Sender: TObject; User: boolean);
+    procedure ButtonOkClick(Sender: TObject);
     procedure Up2BtnClick(Sender: TObject);
   private
     LocalGamma: Integer;
+    LocalKeyBindings: TKeyBindings;
+    CurrentKeyBinding: TKeyBinding;
+    procedure UpdateShortCutItem;
   public
-    Languages: TLanguages;
     procedure LoadData;
     procedure SaveData;
 …
   SettingsDlg: TSettingsDlg;
 implementation
 {$R *.lfm}
-{ TLanguages }
-procedure TLanguages.AddItem(const ShortName, FullName: string);
 var
+  Language: TLanguage;
+begin
+  Language := TLanguage.Create;
+  Language.ShortName := ShortName;
+  Language.FullName := FullName;
+  Add(Language);
+end;
+procedure TLanguages.LoadToStrings(Strings: TStrings);
+var
+  I: Integer;
+begin
+  Strings.Clear;
+  for I := 0 to Count - 1 do
+    Strings.Add(Items[I].FullName);
+end;
+function TLanguages.Search(ShortName: string): Integer;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Count) and (Items[I].ShortName <> ShortName) do Inc(I);
+  if I < Count then Result := I
+    else Result := -1;
+  SFullScreen, SGamma, SRestartMsg, SShortCutPrimary, SShortCutSecondary,
+  SLanguages, SKeyBindings: string;
+procedure ReloadLanguages;
+begin
+  SFullScreen := Phrases.Lookup('SETTINGS', 0);
+  SGamma := Phrases.Lookup('SETTINGS', 1);
+  SRestartMsg := Phrases.Lookup('SETTINGS', 2);
+  SShortCutPrimary := Phrases.Lookup('SETTINGS', 3);
+  SShortCutSecondary := Phrases.Lookup('SETTINGS', 4);
+  SLanguages := Phrases.Lookup('SETTINGS', 5);
+  SKeyBindings := Phrases.Lookup('SETTINGS', 6);
 end;
 …
 procedure TSettingsDlg.FormCreate(Sender: TObject);
 begin
+  LocalKeyBindings := TKeyBindings.Create;
   Canvas.Font.Assign(UniFont[ftNormal]);
   Canvas.Brush.Style := bsClear;
+  Languages := TLanguages.Create;
+  Languages.AddItem('', 'System');
+  Languages.AddItem('cs', 'Czech');
+  Languages.AddItem('de', 'German');
+  Languages.AddItem('en', 'English');
+  Languages.AddItem('it', 'Italian');
+  Languages.AddItem('ru', 'Russian');
+  Languages.AddItem('zh-Hant', 'Traditional Chinese');
+  Languages.AddItem('zh-Hans', 'Simplified Chinese');
+  OKBtn.Caption := Phrases.Lookup('BTN_OK');
+  CancelBtn.Caption := Phrases.Lookup('BTN_CANCEL');
+  ButtonOk.Caption := Phrases.Lookup('BTN_OK');
+  ButtonCancel.Caption := Phrases.Lookup('BTN_CANCEL');
+  ButtonReset.Caption := Phrases.Lookup('BTN_RESET');
   InitButtons;
 end;
 procedure TSettingsDlg.CancelBtnClick(Sender: TObject);
+procedure TSettingsDlg.ButtonCancelClick(Sender: TObject);
 begin
   ModalResult := mrCancel;
+end;
+procedure TSettingsDlg.ButtonResetClick(Sender: TObject);
+begin
+  ListLanguages.ItemIndex := 0;
+  ButtonFullscreen.ButtonIndex := 3;
+  LocalGamma := 100;
+  ListKeyBindings.ItemIndex := -1;
+  ListKeyBindingsSelectionChange(nil, False);
+  LocalKeyBindings.ResetToDefault;
+  LocalKeyBindings.LoadToStrings(ListKeyBindings.Items);
+  Repaint;
 end;
 …
 end;
+procedure TSettingsDlg.EditShortCutPrimaryKeyUp(Sender: TObject; var Key: Word;
+  Shift: TShiftState);
+begin
+  if Assigned(CurrentKeyBinding) and not (Key in [16..18]) then begin
+    CurrentKeyBinding.ShortCut := Key or
+      (scShift * Integer(ssShift in Shift)) or
+      (scCtrl * Integer(ssCtrl in Shift)) or
+      (scAlt * Integer(ssAlt in Shift));
+    EditShortCutPrimary.Text := ShortCutToText(CurrentKeyBinding.ShortCut);
+    Key := 0;
+    UpdateShortCutItem;
+  end;
+end;
+procedure TSettingsDlg.EditShortCutSecondaryKeyUp(Sender: TObject;
+  var Key: Word; Shift: TShiftState);
+begin
+  if Assigned(CurrentKeyBinding) and not (Key in [16..18]) then begin
+    CurrentKeyBinding.ShortCut2 := Key or
+      (scShift * Integer(ssShift in Shift)) or
+      (scCtrl * Integer(ssCtrl in Shift)) or
+      (scAlt * Integer(ssAlt in Shift));
+    EditShortCutSecondary.Text := ShortCutToText(CurrentKeyBinding.ShortCut2);
+    Key := 0;
+    UpdateShortCutItem;
+  end;
+end;
+procedure TSettingsDlg.FormClose(Sender: TObject; var CloseAction: TCloseAction
+  );
+begin
+  ListKeyBindings.ItemIndex := -1;
+end;
 procedure TSettingsDlg.ButtonFullscreenClick(Sender: TObject);
 begin
 …
 procedure TSettingsDlg.FormDestroy(Sender: TObject);
 begin
   FreeAndNil(Languages);
+  FreeAndNil(LocalKeyBindings);
 end;
 procedure TSettingsDlg.FormPaint(Sender: TObject);
-var
-  S: string;
 begin
   PaintBackground(self, 3, 3, ClientWidth - 6, ClientHeight - 6);
 …
   Frame(Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3,
     MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
   EditFrame(Canvas, List.BoundsRect, MainTexture);
   BtnFrame(Canvas, OKBtn.BoundsRect, MainTexture);
   BtnFrame(Canvas, CancelBtn.BoundsRect, MainTexture);
+  EditFrame(Canvas, ListLanguages.BoundsRect, MainTexture);
+  BtnFrame(Canvas, ButtonOk.BoundsRect, MainTexture);
+  BtnFrame(Canvas, ButtonCancel.BoundsRect, MainTexture);
   RFrame(Canvas, ButtonFullscreen.Left - 1, ButtonFullscreen.Top - 1,
 …
     MainTexture.ColorBevelLight);
+  S := Phrases.Lookup('SETTINGS', 0);
+  LoweredTextOut(Canvas, -2, MainTexture, ListLanguages.Left,
+    ListLanguages.Top - 26, SLanguages);
+  LoweredTextOut(Canvas, -2, MainTexture, ListKeyBindings.Left,
+    ListKeyBindings.Top - 26, SKeyBindings);
   LoweredTextOut(Canvas, -2, MainTexture, ButtonFullscreen.Left + 32,
+    ButtonFullscreen.Top - 4, S);
+  // Gamma
+  UnderlinedTitleValue(Canvas, Phrases.Lookup('SETTINGS', 1), IntToStr(LocalGamma) + '%',
+    ButtonFullscreen.Top - 4, SFullScreen);
+  UnderlinedTitleValue(Canvas, SGamma, IntToStr(LocalGamma) + '%',
     Up2Btn.Left - 150 - 4, Up2Btn.Top + 2, 150);
+  LoweredTextOut(Canvas, -2, MainTexture, EditShortCutPrimary.Left,
+    EditShortCutPrimary.Top - 26, SShortCutPrimary);
+  LoweredTextOut(Canvas, -2, MainTexture, EditShortCutSecondary.Left,
+    EditShortCutSecondary.Top - 26, SShortCutSecondary);
 end;
 procedure TSettingsDlg.FormShow(Sender: TObject);
 begin
+  Languages.LoadToStrings(List.Items);
+  List.Font.Color := MainTexture.ColorMark;
+  ReloadLanguages;
+  Languages.LoadToStrings(ListLanguages.Items);
+  ListLanguages.Font.Color := MainTexture.ColorMark;
+  ListKeyBindings.Font.Color := MainTexture.ColorMark;
   LoadData;
+end;
+procedure TSettingsDlg.OKBtnClick(Sender: TObject);
+  LocalKeyBindings.LoadToStrings(ListKeyBindings.Items);
+end;
+procedure TSettingsDlg.ListKeyBindingsSelectionChange(Sender: TObject;
+  User: boolean);
+begin
+  if Assigned(CurrentKeyBinding) then begin
+    CurrentKeyBinding.ShortCut := TextToShortCut(EditShortCutPrimary.Text);
+    CurrentKeyBinding.ShortCut2 := TextToShortCut(EditShortCutSecondary.Text);
+  end;
+  if ListKeyBindings.ItemIndex >= 0 then
+    CurrentKeyBinding := LocalKeyBindings[ListKeyBindings.ItemIndex]
+    else CurrentKeyBinding := nil;
+  if Assigned(CurrentKeyBinding) then begin
+    if CurrentKeyBinding.ShortCut <> 0 then
+      EditShortCutPrimary.Text := ShortCutToText(CurrentKeyBinding.ShortCut)
+      else EditShortCutPrimary.Text := '';
+    EditShortCutPrimary.Enabled := True;
+    if CurrentKeyBinding.ShortCut2 <> 0 then
+      EditShortCutSecondary.Text := ShortCutToText(CurrentKeyBinding.ShortCut2)
+      else EditShortCutSecondary.Text := '';
+    EditShortCutSecondary.Enabled := True;
+  end else begin
+    EditShortCutPrimary.Text := '';
+    EditShortCutPrimary.Enabled := False;
+    EditShortCutSecondary.Text := '';
+    EditShortCutSecondary.Enabled := False;
+  end;
+end;
+procedure TSettingsDlg.ButtonOkClick(Sender: TObject);
 begin
   SaveData;
 …
 end;
+procedure TSettingsDlg.UpdateShortCutItem;
+begin
+  if Assigned(CurrentKeyBinding) then begin
+    if CurrentKeyBinding.ShortCut > 0 then
+      LocalKeyBindings.RemoveShortCut(CurrentKeyBinding.ShortCut);
+    if CurrentKeyBinding.ShortCut2 > 0 then
+      LocalKeyBindings.RemoveShortCut(CurrentKeyBinding.ShortCut2);
+    CurrentKeyBinding.ShortCut := TextToShortCut(EditShortCutPrimary.Text);
+    CurrentKeyBinding.ShortCut2 := TextToShortCut(EditShortCutSecondary.Text);
+    LocalKeyBindings.LoadToStrings(ListKeyBindings.Items);
+  end;
+end;
 procedure TSettingsDlg.LoadData;
 begin
   List.ItemIndex := Languages.Search(LocaleCode);
   if (List.ItemIndex = -1) and (Languages.Count > 0) then
     List.ItemIndex := 0;
+  ListLanguages.ItemIndex := Languages.Search(LocaleCode);
+  if (ListLanguages.ItemIndex = -1) and (Languages.Count > 0) then
+    ListLanguages.ItemIndex := 0;
   if FullScreen then ButtonFullscreen.ButtonIndex := 3
     else ButtonFullscreen.ButtonIndex := 2;
   LocalGamma := Gamma;
+  LocalKeyBindings.Assign(KeyBindings);
 end;
 …
 begin
   NeedRestart := Gamma <> LocalGamma;
   LocaleCode := Languages[List.ItemIndex].ShortName;
+  LocaleCode := Languages[ListLanguages.ItemIndex].ShortName;
   FullScreen := (ButtonFullscreen.ButtonIndex and 1) = 1;
   Gamma := LocalGamma;
+  if NeedRestart then SimpleMessage(Phrases.Lookup('SETTINGS', 2));
+  if NeedRestart then SimpleMessage(SRestartMsg);
+  KeyBindings.Assign(LocalKeyBindings);
 end;

branches/highdpi/Start.pas

-              r378
+              r405
     Free;
   end;
+  KeyBindings.LoadFromRegistry(HKEY_CURRENT_USER, AppRegistryKey + '\KeyBindings');
 end;
 …
     Free;
   end;
+  KeyBindings.SaveToRegistry(HKEY_CURRENT_USER, AppRegistryKey + '\KeyBindings');
 end;
 …
   f: file;
   ok: boolean;
+  MapPictureFileName: string;
 begin
   if List.ItemIndex >= 0 then
 …
         begin
           SimpleMessage(Format(Phrases.Lookup('NOFILENAME'), [NewName[i]]));
           exit
+          Exit;
         end;
       if Page = pgLoad then
 …
       except
         // Play('INVALID');
+        ok := false
+      end;
+      if Page <> pgLoad then
+        try // rename map picture
+        ok := False;
+      end;
+      if Page <> pgLoad then begin
+        // Rename map picture
+        MapPictureFileName := GetMapsDir + DirectorySeparator +
+          List.Items[List.ItemIndex] + CevoMapPictureExt;
+        if FileExists(MapPictureFileName) then
+        try
           AssignFile(f, GetMapsDir + DirectorySeparator + List.Items[List.ItemIndex]
             + '.png');
           Rename(f, GetMapsDir + DirectorySeparator + NewName + '.png');
+            + CevoMapPictureExt);
+          Rename(f, GetMapsDir + DirectorySeparator + NewName + CevoMapPictureExt);
         except
         end;
       if ok then
       begin
+      end;
+      if ok then begin
         if Page = pgLoad then
           FormerGames[List.ItemIndex] := NewName

branches/highdpi/UMiniMap.pas

r349	r405
115	115	ImageFileName: string;
116	116	begin
117		ImageFileName := Copy(FileName, 1, Length(FileName) - Length(CevoMapExt)) + ~~'.png'~~;
	117	ImageFileName := Copy(FileName, 1, Length(FileName) - Length(CevoMapExt)) + CevoMapPictureExt;
118	118	Mode := mmPicture;
119	119	if LoadGraphicFile(Bitmap, ImageFileName, [gfNoError]) then

branches/highdpi/readme.txt

r349	r405
29	29	== Release new version ==
30	30
31		* Update version in G~~ameServer.pas Version constant~~.
	31	* Update version in Global.pas CevoVersion constants.
32	32	* Update version in Install\win\Common.iss MyAppVersion define.
33	33	* Update version in Install\rpm\c-evo.spec Version field.

Context Navigation

Legend:

Download in other formats: