Changeset 405


Ignore:
Timestamp:
Nov 3, 2021, 11:22:02 AM (3 years ago)
Author:
chronos
Message:
  • Modified: Merged changes from trunk r404.
Location:
branches/highdpi
Files:
54 added
5 deleted
41 edited

Legend:

Unmodified
Added
Removed
  • branches/highdpi/Direct.pas

    r378 r405  
    194194
    195195procedure TDirectDlg.FormShow(Sender: TObject);
    196 var
    197   I: Integer;
    198196begin
    199197  if not Gone then
  • branches/highdpi/GameServer.pas

    r378 r405  
    88uses
    99  Protocol, Database, dynlibs, Platform, dateutils, fgl, LazFileUtils,
    10   Graphics, UBrain;
     10  Graphics, UBrain, Global;
    1111
    1212const
    13   Version = $010300;
    1413  FirstAICompatibleVersion = $000D00;
    1514  FirstBookCompatibleVersion = $010103;
     
    224223    BrainNetworkClient.Flags := fMultiple;
    225224    BrainNetworkClient.Initialized := False;
    226     BrainNetworkClient.ServerVersion := Version;
     225    BrainNetworkClient.ServerVersion := CevoVersion;
    227226    BrainNetworkClient.Kind := btNetworkClient;
    228227  end;
     
    231230  BrainTerm.Flags := fMultiple;
    232231  BrainTerm.Initialized := False;
    233   BrainTerm.ServerVersion := Version;
     232  BrainTerm.ServerVersion := CevoVersion;
    234233  BrainTerm.Kind := btTerm;
    235234  BrainRandom := Brains.AddNew;
     
    243242    BrainNetworkServer.Flags := fMultiple;
    244243    BrainNetworkServer.Initialized := False;
    245     BrainNetworkServer.ServerVersion := Version;
     244    BrainNetworkServer.ServerVersion := CevoVersion;
    246245    BrainNetworkServer.Kind := btNetworkServer;
    247246  end;
     
    255254      NewBrain.LoadFromFile(BasePath + DirectorySeparator + F.Name + '.ai.txt');
    256255      if (NewBrain.ServerVersion >= FirstAICompatibleVersion) and
    257         (NewBrain.ServerVersion <= Version) and
     256        (NewBrain.ServerVersion <= CevoVersion) and
    258257        ((NewBrain.Flags and fDotNet = 0) or (@DotNetClient <> nil)) then begin
    259258        end else Brains.Delete(Brains.Count - 1);
     
    405404          begin
    406405            CL.Put(sIntSetUnitStatus, p, ix, @Status);
    407             SavedStatus := Status
     406            SavedStatus := Status;
    408407          end;
    409408      // log city status changes
     
    413412          begin
    414413            CL.Put(sIntSetCityStatus, p, ix, @Status);
    415             SavedStatus := Status
     414            SavedStatus := Status;
    416415          end;
    417416      // log model status changes
     
    421420          begin
    422421            CL.Put(sIntSetModelStatus, p, ix, @Status);
    423             SavedStatus := Status
     422            SavedStatus := Status;
    424423          end;
    425424      // log enemy city status changes
     
    429428          begin
    430429            CL.Put(sIntSetECityStatus, p, ix, @Status);
    431             SavedStatus := Status
     430            SavedStatus := Status;
    432431          end;
    433432      // log data changes
     
    436435        CL.PutDataChanges(sIntDataChange, p, SavedData[p], RW[p].Data,
    437436          bix[p].DataSize);
    438         move(RW[p].Data^, SavedData[p]^, bix[p].DataSize * 4);
    439       end
     437        Move(RW[p].Data^, SavedData[p]^, bix[p].DataSize * 4);
     438      end;
    440439    end;
    441440end;
     
    461460          SavedStatus := Status;
    462461      if bix[p].DataSize > 0 then
    463         move(RW[p].Data^, SavedData[p]^, bix[p].DataSize * 4);
     462        Move(RW[p].Data^, SavedData[p]^, bix[p].DataSize * 4);
    464463    end;
    465464end;
     
    472471  ix: integer;
    473472begin
    474   result := false;
     473  Result := False;
    475474  for ix := 0 to RW[p].nUn - 1 do
    476475    with RW[p].Un[ix] do
    477476      if (Loc >= 0) and (SavedStatus <> Status) then
    478         result := true;
     477        Result := True;
    479478  for ix := 0 to RW[p].nCity - 1 do
    480479    with RW[p].City[ix] do
    481480      if (Loc >= 0) and (SavedStatus <> Status) then
    482         result := true;
     481        Result := True;
    483482  for ix := 0 to RW[p].nModel - 1 do
    484483    with RW[p].Model[ix] do
    485484      if SavedStatus <> Status then
    486         result := true;
     485        Result := True;
    487486  for ix := 0 to RW[p].nEnemyCity - 1 do
    488487    with RW[p].EnemyCity[ix] do
    489488      if (Loc >= 0) and (SavedStatus <> Status) then
    490         result := true;
     489        Result := True;
    491490  if RW[p].Data <> nil then
    492491    for ix := 0 to bix[p].DataSize - 1 do
    493492      if PDWortList(SavedData[p])[ix] <> PDWortList(RW[p].Data)[ix] then
    494         result := true
     493        Result := True;
    495494end;
    496495
     
    643642  s := 'cEvoBook';
    644643  LogFile.write(s[1], 8); { file id }
    645   i := Version;
     644  i := CevoVersion;
    646645  LogFile.write(i, 4); { c-evo version }
    647646  LogFile.write(ExeInfo.Time, 4);
     
    688687  begin
    689688    AutoSaveState := CL.State;
    690     AutoSaveExists := true
     689    AutoSaveExists := true;
    691690  end
    692691end;
     
    10961095      begin
    10971096        GiveCivilReport(pTurn, p1);
    1098         GiveMilReport(pTurn, p1)
     1097        GiveMilReport(pTurn, p1);
    10991098      end;
    11001099  end;
     
    11261125  LogFile.Read(J, 4); { exe time }
    11271126
    1128   if (i >= FirstBookCompatibleVersion) and (i <= Version) then
     1127  if (i >= FirstBookCompatibleVersion) and (i <= CevoVersion) then
    11291128  begin
    11301129    result := true;
     
    12231222    begin
    12241223      GenerateStat(pTurn);
    1225       StatRequest := false
     1224      StatRequest := false;
    12261225    end;
    12271226    // complete all internal commands following an sTurn before generating statistics
     
    12931292  begin
    12941293    Delete(LogFileName, 1, 1);
    1295     nLogOpened := -1
     1294    nLogOpened := -1;
    12961295  end
    12971296  else
     
    14341433  Game.RO[0] := @RW[0];
    14351434  Game.Difficulty[0] := 0;
    1436   for p1 := 1 to nPl - 1 do
    1437   begin
     1435  for p1 := 1 to nPl - 1 do begin
    14381436    Game.RO[p1] := nil;
    1439     Game.Difficulty[p1] := -1
     1437    Game.Difficulty[p1] := -1;
    14401438  end;
    14411439  BrainTerm.Client(cNewMap, -1, Game);
     
    14451443  bix[0].Client(cShowGame, 0, nil^);
    14461444  Notify(ntBackOff);
    1447   ChangeClientWhenDone(cEditMap, 0, nil^, 0)
     1445  ChangeClientWhenDone(cEditMap, 0, nil^, 0);
    14481446end;
    14491447
     
    14641462        Prod0 := 0;
    14651463        Project := cpImp + imTrGoods;
    1466         Project0 := cpImp + imTrGoods
     1464        Project0 := cpImp + imTrGoods;
    14671465      end;
    14681466
     
    16191617                  Flags := Flags or unWithdrawn;
    16201618                  Happened := Happened or phPeaceEvacuation;
    1621                 end
     1619                end;
    16221620          end;
    16231621
     
    16881686                  inc(ShowShipChange.Ship1Change[Project0 and cpIndex -
    16891687                    imShipComp]);
    1690               end
    1691             end
     1688              end;
     1689            end;
    16921690          end; { city loop 1 }
    16931691      if nUpdateLoc > 0 then
     
    17151713            begin
    17161714              Movement := 0;
    1717               Flags := Flags and not unMountainDelay
     1715              Flags := Flags and not unMountainDelay;
    17181716            end
    17191717            else
     
    17451743              if (Health <= 0) or TribeExtinct then
    17461744                RemoveUnit_UpdateMap(pTurn, uix);
    1747             end
     1745            end;
    17481746          end;
    17491747
     
    17701768                      (ObserveLevel[Loc1] and (3 shl (2 * p1)) > 0) then
    17711769                      CallPlayer(cShowCityChanged, p1, Loc1);
    1772               end
     1770              end;
    17731771            end;
    17741772
     
    18081806                begin
    18091807                  Territory[Loc1] := -1;
    1810                   Map[Loc1] := Map[Loc1] and not fPeace
    1811                 end
     1808                  Map[Loc1] := Map[Loc1] and not fPeace;
     1809                end;
    18121810            end;
    18131811          end;
     
    18331831      begin
    18341832        Happened := Happened or phTech;
    1835         ResearchTech := -1
     1833        ResearchTech := -1;
    18361834      end;
    18371835
     
    18421840          begin
    18431841            inc(Credibility);
    1844             Break
     1842            Break;
    18451843          end;
    18461844
     
    19001898      if (bix[pTurn].Kind <> btNoTerm) and
    19011899        ((Difficulty[pTurn] > 0) or (Mode > moLoading_Fast)) then
    1902         DiscoverAll(pTurn, lObserveSuper)
     1900        DiscoverAll(pTurn, lObserveSuper);
    19031901    end
    19041902    else
     
    19061904      DiscoverViewAreas(pTurn);
    19071905      if MirBuilt then
    1908         DiscoverAll(pTurn, lObserveUnhidden)
    1909     end
     1906        DiscoverAll(pTurn, lObserveUnhidden);
     1907    end;
    19101908  end;
    19111909  // CheckContact;
     
    19701968                    (ObserveLevel[Loc1] and (3 shl (2 * p1)) > 0) then
    19711969                    CallPlayer(cShowCityChanged, p1, Loc1);
    1972             end
     1970            end;
    19731971          end;
    19741972    end;
     
    19831981            begin
    19841982              Fuel := Model[mix].Cap[mcFuel];
    1985               Flags := Flags or unBombsLoaded
     1983              Flags := Flags or unBombsLoaded;
    19861984            end
    19871985            else if Model[mix].Kind = mkSpecial_Glider then { glider }
     
    19901988              begin
    19911989                RemoveUnit_UpdateMap(pTurn, uix); // unit lost
    1992                 Happened := Happened or phGliderLost
    1993               end
     1990                Happened := Happened or phGliderLost;
     1991              end;
    19941992            end
    19951993            else
     
    19991997              begin
    20001998                RemoveUnit_UpdateMap(pTurn, uix); // unit lost
    2001                 Happened := Happened or phPlaneLost
     1999                Happened := Happened or phPlaneLost;
    20022000              end
    20032001            end
     
    20072005            if Health < 0 then
    20082006              RemoveUnit_UpdateMap(pTurn, uix);
    2009           end
     2007          end;
    20102008        end; { unit loop 1 }
    20112009
     
    21422140          begin
    21432141            UpdateLoc[nUpdateLoc] := Loc;
    2144             inc(nUpdateLoc)
     2142            inc(nUpdateLoc);
    21452143          end;
    21462144      // unit will be removed -- remember position and update for all players
     
    21702168              Happened := Happened or phStealTech;
    21712169              GStealFrom := MoveInfo.Defender;
    2172               Break
    2173             end
     2170              Break;
     2171            end;
    21742172        end;
    21752173        if Mode = moPlaying then
     
    28562854
    28572855    sGetVersion:
    2858       integer(Data) := Version;
     2856      integer(Data) := CevoVersion;
    28592857
    28602858    sGetGameChanged:
     
    36663664            begin
    36673665              if Tech[Subject] >= MaxFutureTech_Computing then
    3668                 result := eInvalid
     3666                result := eInvalid;
    36693667            end
    36703668            else if Subject in FutureTech then
    36713669            begin
    36723670              if Tech[Subject] >= MaxFutureTech then
    3673                 result := eInvalid
     3671                result := eInvalid;
    36743672            end
    36753673            else if Tech[Subject] >= tsApplicable then
     
    36833681                    inc(i);
    36843682                if i < 2 then
    3685                   result := eNoPreq
     3683                  result := eNoPreq;
    36863684              end
    36873685              else if (AdvPreq[Subject, 0] <> preNone) and
     
    36893687                (AdvPreq[Subject, 1] <> preNone) and
    36903688                (Tech[AdvPreq[Subject, 1]] < tsApplicable) then
    3691                 result := eNoPreq
     3689                result := eNoPreq;
    36923690          end;
    36933691          if (result = eOK) and (Command >= sExecute) then
     
    36973695            // save DevModel, because sctModel commands are not logged
    36983696            ResearchTech := Subject;
    3699           end
     3697          end;
    37003698        end
    37013699        else
     
    37173715          SeeTech(Player, Subject);
    37183716          dec(RW[Player].Happened, phStealTech);
    3719         end
     3717        end;
    37203718      end;
    37213719
     
    37363734          RW[Player].Attitude[p1] := Subject;
    37373735          RW[p1].EnemyReport[Player].Attitude := Subject;
    3738         end
     3736        end;
    37393737      end;
    37403738
     
    38703868                  MaxCap := 3;
    38713869                if RW[Player].Tech[adSteel] >= tsApplicable then
    3872                   inc(MaxCap)
     3870                  inc(MaxCap);
    38733871              end
    38743872              else
     
    38943892                      Cap[mcCarrier] := 0;
    38953893                      if Cap[mcDefense] > 2 then
    3896                         Cap[mcDefense] := 2
     3894                        Cap[mcDefense] := 2;
    38973895                    end;
    38983896                  mcSeaTrans:
     
    39193917
    39203918                CalculateModel(RW[Player].DevModel);
    3921               end
     3919              end;
    39223920            end;
    39233921        end
     
    39973995              result := eViolation
    39983996            else if Command >= sExecute then
    3999               RW[Player].Un[Subject].Home := cix1
    4000           end
    4001         end
     3997              RW[Player].Un[Subject].Home := cix1;
     3998          end;
     3999        end;
    40024000      end;
    40034001
     
    40234021          result := eInvalid
    40244022        else
    4025           result := UnloadUnit(Player, Subject, Command < sExecute)
     4023          result := UnloadUnit(Player, Subject, Command < sExecute);
    40264024      end;
    40274025
     
    40584056          PlaceUnit(p1, RW[p1].nUn - 1);
    40594057          UpdateUnitMap(integer(Data));
    4060         end
     4058        end;
    40614059      end
    40624060      else
     
    41174115                  CityGrowth(Player, cix1);
    41184116                RemoveUnit_UpdateMap(Player, Subject);
    4119               end
    4120           end
    4121         end
     4117              end;
     4118          end;
     4119        end;
    41224120      end;
    41234121
     
    41504148                  (ObserveLevel[Loc0] and (3 shl (2 * p1)) > 0) then
    41514149                  CallPlayer(cShowCityChanged, p1, Loc0);
    4152           end
     4150          end;
    41534151        end;
    41544152      end;
     
    42754273                    if Preq = 0 then
    42764274                      result := eNoPreq;
    4277                   end
     4275                  end;
    42784276              end;
    42794277
     
    42904288                    Prod := 0;
    42914289                    Prod0 := 0;
    4292                     Project0 := cpImp + imTrGoods
     4290                    Project0 := cpImp + imTrGoods;
    42934291                  end
    42944292                  else
    42954293                    Prod := Prod0 * 2 div 3;
    42964294                Project := NewProject
    4297               end
    4298             end
    4299           end
     4295              end;
     4296            end;
     4297          end;
    43004298      end;
    43014299
     
    43864384                  imSpacePort:
    43874385                    DestroySpacePort_TellPlayers(Player, -1);
    4388                 end
     4386                end;
    43894387              end;
    43904388              inc(Flags, chImprovementSold);
    4391             end
     4389            end;
    43924390      end;
    43934391
     
    44324430                    imSpacePort:
    44334431                      DestroySpacePort_TellPlayers(Player, -1);
    4434                   end
     4432                  end;
    44354433                end;
    44364434                inc(Flags, chImprovementSold);
    4437               end
    4438         end
     4435              end;
     4436        end;
    44394437      end;
    44404438
  • branches/highdpi/Global.pas

    r378 r405  
    66  CevoExt = '.cevo';
    77  CevoMapExt = '.cevomap';
     8  CevoMapPictureExt = '.png';
    89  CevoTribeExt = '.tribe.txt';
    910  CevoHomepageShort = 'app.zdechov.net/c-evo';
     
    1617  AITemplateManual = 'AI development manual';
    1718  AITemplateFileName = 'AI Template' + DirectorySeparator + AITemplateManual + '.html';
     19  CevoVersionMajor = 1;
     20  CevoVersionMinor = 4;
     21  CevoVersionBugFix = 0;
     22  CevoVersion = ((CevoVersionMajor and $ff) shl 16) or
     23    ((CevoVersionMinor and $ff) shl 8) or
     24    ((CevoVersionBugFix and $ff) shl 0);
    1825
    1926
  • branches/highdpi/Help/help.txt

    r11 r405  
    14411441Unit attacks at full strength even if it has less than 1 MP left.
    144214422 tiles observation range. Unit fortifies if it has at least half of its initial MP left.
    1443 The unit’s production cost is halved when the same type of unit was produced immediately before, but doubled otherwise.
     1443The unit's production cost is halved when the same type of unit was produced immediately before, but doubled otherwise.
    14441444
    14451445#GOVHELP
  • branches/highdpi/Install/deb/debian/changelog

    r349 r405  
    1 c-evo (1.3.0-0) precise; urgency=low
     1c-evo (1.4.0-0) precise; urgency=low
    22
    3   * Original version 1.3.0 packaged with lazdebian
     3  * Original version 1.4.0 packaged with lazdebian
    44
    55 -- Chronos <robie@centrum.cz>  Sun, 17 Dec 2016 00:51:08 +0100
  • branches/highdpi/Install/deb/debian/control

    r349 r405  
    33Section: games
    44Priority: optional
    5 Standards-Version: 1.3.0
     5Standards-Version: 1.4.0
    66Build-Depends: fpc, lazarus, lcl, lcl-utils, debhelper (>= 8)
    77
  • branches/highdpi/Install/rpm/c-evo.spec

    r349 r405  
    11Name:           c-evo
    2 Version:        1.3.0
     2Version:        1.4.0
    33Release:        1%{?dist}
    44Summary:        Empire building game
     
    5555install -d -m 755 $RPM_BUILD_ROOT/usr/share/c-evo/Saved
    5656install -D -m 644 Saved/* $RPM_BUILD_ROOT/usr/share/c-evo/Saved
    57 #install -d -m 755 $RPM_BUILD_ROOT/usr/share/c-evo/AI\ Template
    58 #install -D -m 644 AI\ Template/* $RPM_BUILD_ROOT/usr/share/c-evo/AI\ Template
     57install -d -m 755 $RPM_BUILD_ROOT/usr/share/c-evo/AI\ Template
     58cp -R AI\ Template $RPM_BUILD_ROOT/usr/share/c-evo
    5959install -d -m 755 $RPM_BUILD_ROOT/usr/share/c-evo/Localization
    6060cp -R Localization $RPM_BUILD_ROOT/usr/share/c-evo
  • branches/highdpi/Install/snap/local/build.sh

    r378 r405  
    44
    55pushd ../../..
    6 snapcraft --debug
     6snapcraft --debug --use-lxd
    77popd
    88
  • branches/highdpi/Install/snap/snapcraft.yaml

    r378 r405  
    11name: c-evo
    22title: "C-evo: New Horizons"
    3 version: '1.3.0'
     3version: '1.4.0'
    44summary: A turn-based empire building game inspired by Civilization II game.
    55description: |
    6   This is a fork and Lazarus port of the original game which can be
    7   found at ​www.c-evo.org.
    8 confinement: devmode
     6  This is a fork and Lazarus/FPC port of the original C-evo 1.2.0 game.
     7  Now it is finally possible to play C-evo natively on Linux. 
     8  * Zoomable map by mouse wheel with three tile sizes
     9  * Many sample maps included
     10  * All available localizations include
     11  * Many other small improvements
     12confinement: strict
    913base: core20
    10 #base: core18
    11 grade: devel
     14grade: stable
    1215icon: Graphics/c-evo_64x64.png
     16license: NLPL
    1317
     18environment:
     19  LD_LIBRARY_PATH: $SNAP/usr/lib/$SNAPCRAFT_ARCH_TRIPLET/pulseaudio
     20  PULSE_SERVER: unix:/run/user/1000/pulse/native
     21
     22layout:
     23  /usr/lib/$SNAPCRAFT_ARCH_TRIPLET/sox:
     24    bind: $SNAP/usr/lib/$SNAPCRAFT_ARCH_TRIPLET/sox   
     25 
    1426parts:
    1527  c-evo:
     
    2335    - lcl-utils
    2436    stage-packages:   
     37    - sox
     38    - libsox-fmt-mp3
     39    - libsox-fmt-pulse
     40    - libpulse0
     41    # Autodetected dependencies
    2542    - libatk1.0-0
    2643    - libcairo2
     
    5370    - libxrandr2
    5471    - libxrender1
    55     #- sox
    56     #- libsox-fmt-mp3
    5772    override-build: |
     73      snapcraftctl build
    5874      (cd AI/StdAI &&lazbuild --build-mode=Release StdAI.lpi)
    5975      mv AI/StdAI/libstdai.so AI/StdAI/libstdai-amd64.so
     
    6278      install -d -m 755 $ROOT/usr/share/c-evo
    6379      install -s -m 755 c-evo $ROOT/usr/share/c-evo
    64       install -m 755 Install/snap/local/command-c-evo-gtk.wrapper $ROOT/usr/share/c-evo     
    6580      install -m 644 Language.txt $ROOT/usr/share/c-evo
    6681      install -m 644 Language2.txt $ROOT/usr/share/c-evo
    6782      install -m 644 Fonts.txt $ROOT/usr/share/c-evo
    68       #install -d -m 755 $ROOT/bin
    69       #install -m 755 Install/snap/local/desktop-launch $ROOT/bin
    70       #install -m 755 Install/snap/local/c-evo $ROOT/bin/c-evo
    71       #install -d -m 755 $ROOT/usr/bin     
    7283      install -d -m 755 $ROOT/usr/share/applications
    7384      install -m 755 Install/deb/c-evo.desktop $ROOT/usr/share/applications
     
    91102      cp -r "AI Template" $ROOT/usr/share/c-evo
    92103    stage:
    93       - bin
    94       - lib
    95104      - etc
    96105      - usr
     
    101110apps:
    102111  c-evo:
    103     #command: desktop-launch $SNAP/c-evo-snap
    104112    command: usr/share/c-evo/c-evo
    105     #command: usr/share/c-evo/command-c-evo-gtk.wrapper
    106113    desktop: usr/share/applications/c-evo.desktop   
    107     #extensions: [gnome-3-28]
    108114    plugs:
    109       - home     
    110       - pulseaudio
     115      - home
     116      - audio-playback
    111117      - desktop
    112       - desktop-legacy
    113118      - x11
    114  
  • branches/highdpi/Install/win/C-evo.iss

    r246 r405  
    2424
    2525[Files]
    26 Source: "{#MyAppSubDir}\lib\x86_64-win64-Release\{#MyAppExeName}"; DestDir: "{app}"; Flags: ignoreversion; Components: main; Check: not Is64BitInstallMode
    27 Source: "{#MyAppSubDir}\lib\i386-win32-Release\{#MyAppExeName}"; DestDir: "{app}"; Flags: ignoreversion; Components: main; Check: Is64BitInstallMode
     26Source: "{#MyAppSubDir}\lib\x86_64-win64-Release\{#MyAppExeName}"; DestDir: "{app}"; Flags: ignoreversion; Components: main; Check: Is64BitInstallMode
     27Source: "{#MyAppSubDir}\lib\i386-win32-Release\{#MyAppExeName}"; DestDir: "{app}"; Flags: ignoreversion; Components: main; Check: not Is64BitInstallMode
     28Source: "{#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
    2829Source: "{#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
    29 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
    3030Source: "{#MyAppSubDir}\AI\AI_UO\*.*"; DestDir: "{app}\AI\AI_UO"; Flags: ignoreversion; Components: ai\ai_uo; Check: not Is64BitInstallMode
    3131Source: "{#MyAppSubDir}\AI\AIAS\*.*"; DestDir: "{app}\AI\AIAS"; Flags: ignoreversion; Components: ai\aias; Check: not Is64BitInstallMode
  • branches/highdpi/Integrated.lpi

    r378 r405  
    7676      </Item2>
    7777      <SharedMatrixOptions Count="2">
    78         <Item1 ID="151739052537" Targets="CevoComponents" Modes="Debug" Value="-g -gl -gh -CirotR -O1"/>
    79         <Item2 ID="186701832267" Targets="CevoComponents" Modes="Release" Value="-CX -XX -O3"/>
     78        <Item1 ID="151739052537" Targets="CevoComponents,Common" Modes="Debug" Value="-g -gl -gh -CirotR -O1"/>
     79        <Item2 ID="186701832267" Targets="CevoComponents,Common" Modes="Release" Value="-CX -XX -O3"/>
    8080      </SharedMatrixOptions>
    8181    </BuildModes>
     
    8989      </Modes>
    9090    </RunParams>
    91     <RequiredPackages Count="3">
     91    <RequiredPackages Count="4">
    9292      <Item1>
     93        <PackageName Value="Common"/>
     94        <DefaultFilename Value="Packages\Common\Common.lpk" Prefer="True"/>
     95      </Item1>
     96      <Item2>
    9397        <PackageName Value="DpiControls"/>
    9498        <DefaultFilename Value="Packages\DpiControls\DpiControls.lpk" Prefer="True"/>
    95       </Item1>
    96       <Item2>
     99      </Item2>
     100      <Item3>
    97101        <PackageName Value="CevoComponents"/>
    98102        <DefaultFilename Value="Packages\CevoComponents\CevoComponents.lpk" Prefer="True"/>
    99       </Item2>
    100       <Item3>
     103      </Item3>
     104      <Item4>
    101105        <PackageName Value="LCL"/>
    102       </Item3>
     106      </Item4>
    103107    </RequiredPackages>
    104     <Units Count="47">
     108    <Units Count="48">
    105109      <Unit0>
    106110        <Filename Value="Integrated.lpr"/>
     
    363367        <IsPartOfProject Value="True"/>
    364368      </Unit46>
     369      <Unit47>
     370        <Filename Value="ULanguages.pas"/>
     371        <IsPartOfProject Value="True"/>
     372      </Unit47>
    365373    </Units>
    366374  </ProjectOptions>
     
    396404    <Linking>
    397405      <Debugging>
    398         <UseHeaptrc Value="True"/>
    399406        <UseExternalDbgSyms Value="True"/>
    400407      </Debugging>
  • branches/highdpi/Integrated.lpr

    r378 r405  
    33
    44uses
    5   UDpiControls, {$IFDEF UNIX}
    6   //cthreads,
    7   clocale,
     5  {$IFDEF UNIX}
     6  cthreads, clocale,
    87  {$ENDIF}
    9   Forms, Interfaces, SysUtils, Protocol, GameServer, Direct, Start, Messg, Inp,
     8  UDpiControls, Forms, Interfaces, SysUtils, Protocol, GameServer, Direct, Start, Messg, Inp,
    109  Back, Log, LocalPlayer, ClientTools, Tribes, IsoEngine, Term, CityScreen, Nego,
    1110  NoTerm, ScreenTools, Directories;
  • branches/highdpi/Language.txt

    r378 r405  
    341341#BTN_NO No
    342342#BTN_INFO Info
     343#BTN_RESET Reset
    343344
    344345'Button Tooltips
     
    547548Medium
    548549Big
     550Previous Unit
     551Next Unit
    549552
    550553#ADVANCES
     
    952955Gamma
    953956Restart is needed to apply changes
     957Primary
     958Secondary
     959Languages
     960Key bindings
  • branches/highdpi/LocalPlayer/CityScreen.pas

    r378 r405  
    88  Protocol, ClientTools, Term, ScreenTools, IsoEngine, BaseWin,
    99  LCLIntf, LCLType, Messages, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls,
    10   ButtonA, ButtonC, Area, GraphType;
     10  ButtonA, ButtonC, Area, GraphType, UTexture;
    1111
    1212const
  • branches/highdpi/LocalPlayer/ClientTools.pas

    r361 r405  
    636636procedure CityOptimizer_CityChange(cix: integer);
    637637begin
    638   if (MyRO.Government <> gAnarchy) and (MyCity[cix].Flags and
     638  if (MyRO.Government <> gAnarchy) and (cix <> -1) and (MyCity[cix].Flags and
    639639    chCaptured = 0) then
    640640  begin
     
    756756initialization
    757757
    758   Assert(nImp < 128);
    759   CalculateAdvValues;
     758Assert(nImp < 128);
     759CalculateAdvValues;
    760760
    761761end.
  • branches/highdpi/LocalPlayer/IsoEngine.pas

    r349 r405  
    10071007  end;
    10081008
    1009   if ShowObjects then
    1010   begin
    1011     if (Tile and fCanal <> 0) or (Tile and fCity <> 0) then
    1012     begin // paint canal connections
     1009  if ShowObjects then begin
     1010    // Paint canal connections
     1011    if (Tile and fCanal <> 0) or (Tile and fCity <> 0) then begin
    10131012      Conn := Connection8(Loc, fCanal or fCity);
    10141013      if Tile and fCanal <> 0 then
    10151014        Conn := Conn or ($FF - OceanConnection(Loc));
    1016       if Conn = 0 then
    1017       begin
     1015      if Conn = 0 then begin
    10181016        if Tile and fCanal <> 0 then
    1019           TSprite(x, y, spCanal)
     1017          TSprite(x, y, spCanal);
    10201018      end
    10211019      else
     
    10241022            TSprite(x, y, spCanal + 1 + Dir);
    10251023    end;
     1024
    10261025    if Tile and (fRR or fCity) <> 0 then
    10271026      RRConn := Connection8(Loc, fRR or fCity)
    10281027    else
    10291028      RRConn := 0;
    1030     if Tile and (fRoad or fRR or fCity) <> 0 then
    1031     begin // paint road connections
     1029
     1030    // Paint road connections
     1031    if Tile and (fRoad or fRR or fCity) <> 0 then begin
    10321032      Conn := Connection8(Loc, fRoad or fRR or fCity) and not RRConn;
    10331033      if (Conn = 0) and (Tile and (fRR or fCity) = 0) then
     
    10381038            TSprite(x, y, spRoad + 1 + Dir);
    10391039    end;
    1040     // paint railroad connections
     1040
     1041    // Paint railroad connections
    10411042    if (Tile and fRR <> 0) and (RRConn = 0) then
    10421043      TSprite(x, y, spRailRoad)
    1043     else if RRConn > 0 then
     1044    else if RRConn > 0 then begin
    10441045      for Dir := 0 to 7 do
    10451046        if (1 shl Dir) and RRConn <> 0 then
    10461047          TSprite(x, y, spRailRoad + 1 + Dir);
     1048    end;
    10471049  end;
    10481050end;
  • branches/highdpi/LocalPlayer/MessgEx.pas

    r361 r405  
    543543end;
    544544
    545 
    546 initialization
    547 
    548545end.
  • branches/highdpi/LocalPlayer/Term.lfm

    r349 r405  
    11object MainScreen: TMainScreen
    2   Left = 169
     2  Left = 516
    33  Height = 480
    4   Top = 596
     4  Top = 834
    55  Width = 800
    66  HorzScrollBar.Visible = False
     
    667667      OnClick = MenuClick
    668668    end
     669    object N13: TDpiMenuItem
     670      Caption = '-'
     671    end
     672    object mPrevUnit: TDpiMenuItem
     673      Tag = 100
     674      ShortCut = 46
     675      OnClick = MenuClick
     676    end
     677    object mNextUnit: TDpiMenuItem
     678      Tag = 101
     679      ShortCut = 45
     680      OnClick = MenuClick
     681    end
    669682  end
    670683  object StatPopup: TDpiPopupMenu
  • branches/highdpi/LocalPlayer/Term.pas

    r378 r405  
    2929  TMainScreen = class(TDrawDlg)
    3030    mBigTiles: TDpiMenuItem;
     31    mNextUnit: TDpiMenuItem;
     32    N13: TDpiMenuItem;
     33    mPrevUnit: TDpiMenuItem;
    3134    Timer1: TTimer;
    3235    GamePopup: TDpiPopupMenu;
     
    286289    procedure CopyMiniToPanel;
    287290    procedure PanelPaint;
    288     procedure NextUnit(NearLoc: integer; AutoTurn: boolean);
     291    procedure FocusNextUnit(Dir: Integer = 1);
     292    procedure NextUnit(NearLoc: Integer; AutoTurn: Boolean);
    289293    procedure Scroll(dx, dy: integer);
    290294    procedure SetMapPos(Loc: integer; MapPos: TPoint);
     
    24332437  begin
    24342438    SetTroopLoc(-1);
    2435     PaintAll
     2439    PaintAll;
    24362440  end { supervisor }
    24372441  { else if (ClientMode=cTurn) and (MyRO.Turn=0) then
     
    24552459          FocusOnLoc(G.lx * G.ly div 2);
    24562460      SetTroopLoc(-1);
    2457       PanelPaint
     2461      PanelPaint;
    24582462    end;
    24592463    if ShowCityList then
     
    34463450  NoMapPanel := TIsoMap.Create;
    34473451
    3448   KeyBindings.LoadFromRegistry(HKEY_CURRENT_USER, AppRegistryKey + '\KeyBindings');
    34493452  UpdateKeyShortcuts;
    34503453
     
    35453548  I: Integer;
    35463549begin
    3547   KeyBindings.SaveToRegistry(HKEY_CURRENT_USER, AppRegistryKey + '\KeyBindings');
    35483550  MainFormKeyDown := nil;
    35493551  FreeAndNil(sb);
     
    49044906end;
    49054907
     4908procedure TMainScreen.FocusNextUnit(Dir: Integer);
     4909var
     4910  i, uix, NewFocus: Integer;
     4911begin
     4912  if ClientMode >= scContact then
     4913    Exit;
     4914  DestinationMarkON := False;
     4915  PaintDestination;
     4916  NewFocus := -1;
     4917  for i := 1 to MyRO.nUn do begin
     4918    uix := (UnFocus + i * Dir + MyRO.nUn) mod MyRO.nUn;
     4919    if (MyUn[uix].Loc >= 0) and (MyUn[uix].Status and usStay = 0) then begin
     4920      NewFocus := uix;
     4921      Break;
     4922    end;
     4923  end;
     4924  if NewFocus >= 0 then begin
     4925    SetUnFocus(NewFocus);
     4926    SetTroopLoc(MyUn[NewFocus].Loc);
     4927    FocusOnLoc(TroopLoc, flRepaintPanel);
     4928  end;
     4929end;
     4930
    49064931procedure TMainScreen.FocusOnLoc(Loc: integer; Options: integer = 0);
    49074932var
     
    49304955end;
    49314956
    4932 procedure TMainScreen.NextUnit(NearLoc: integer; AutoTurn: boolean);
     4957procedure TMainScreen.NextUnit(NearLoc: Integer; AutoTurn: Boolean);
    49334958var
    4934   Dist, TestDist: single;
    4935   i, uix, NewFocus: integer;
    4936   GotoOnly: boolean;
     4959  Dist, TestDist: Single;
     4960  i, uix, NewFocus: Integer;
     4961  GotoOnly: Boolean;
    49374962begin
    49384963  Dist := 0;
    49394964  if ClientMode >= scContact then
    4940     exit;
    4941   DestinationMarkON := false;
     4965    Exit;
     4966  DestinationMarkON := False;
    49424967  PaintDestination;
    4943   for GotoOnly := GoOnPhase downto false do
    4944   begin
     4968  for GotoOnly := GoOnPhase downto False do begin
    49454969    NewFocus := -1;
    4946     for i := 1 to MyRO.nUn do
    4947     begin
     4970    for i := 1 to MyRO.nUn do begin
    49484971      uix := (UnFocus + i) mod MyRO.nUn;
    49494972      if (MyUn[uix].Loc >= 0) and (MyUn[uix].Job = jNone) and
    49504973        (MyUn[uix].Status and (usStay or usRecover or usWaiting) = usWaiting)
    49514974        and (not GotoOnly or (MyUn[uix].Status and usGoto <> 0)) then
    4952         if NearLoc < 0 then
    4953         begin
     4975        if NearLoc < 0 then begin
    49544976          NewFocus := uix;
    49554977          Break;
    4956         end
    4957         else
    4958         begin
     4978        end else begin
    49594979          TestDist := Distance(NearLoc, MyUn[uix].Loc);
    4960           if (NewFocus < 0) or (TestDist < Dist) then
    4961           begin
     4980          if (NewFocus < 0) or (TestDist < Dist) then begin
    49624981            NewFocus := uix;
    49634982            Dist := TestDist;
     
    49664985    end;
    49674986    if GotoOnly then
    4968       if NewFocus < 0 then
    4969         GoOnPhase := false
    4970       else
    4971         Break;
    4972   end;
    4973   if NewFocus >= 0 then
    4974   begin
     4987      if NewFocus < 0 then GoOnPhase := False
     4988        else Break;
     4989  end;
     4990  if NewFocus >= 0 then begin
    49754991    SetUnFocus(NewFocus);
    49764992    SetTroopLoc(MyUn[NewFocus].Loc);
    4977     FocusOnLoc(TroopLoc, flRepaintPanel)
    4978   end
    4979   else if AutoTurn and not mWaitTurn.Checked then
    4980   begin
    4981     TurnComplete := true;
     4993    FocusOnLoc(TroopLoc, flRepaintPanel);
     4994  end else
     4995  if AutoTurn and not mWaitTurn.Checked then begin
     4996    TurnComplete := True;
    49824997    SetUnFocus(-1);
    49834998    SetTroopLoc(-1);
    4984     PostMessage(Handle, WM_EOT, 0, 0)
    4985   end
    4986   else
    4987   begin
     4999    PostMessage(Handle, WM_EOT, 0, 0);
     5000  end else begin
    49885001    if { (UnFocus>=0) and } not TurnComplete and EOT.Visible then
    49895002      Play('TURNEND');
    4990     TurnComplete := true;
     5003    TurnComplete := True;
    49915004    SetUnFocus(-1);
    49925005    SetTroopLoc(-1);
     
    59625975        end
    59635976        else
    5964           NextUnit(UnStartLoc, true)
     5977          NextUnit(UnStartLoc, true);
    59655978    end
    59665979    else if (UnFocus < 0) and (Options and muAutoNext <> 0) then
     
    61676180        begin
    61686181          MyUn[uix].Status := MyUn[uix].Status and not usWaiting;
    6169           NextUnit(UnStartLoc, true)
     6182          NextUnit(UnStartLoc, true);
    61706183        end;
    61716184      end;
     
    63286341              trixFocus := TrCnt;
    63296342            inc(TrCnt);
    6330           end
     6343          end;
    63316344    end
    63326345    else // count enemy units here
     
    64436456  mStay.ShortCut := BStay.ShortCut;
    64446457  mNoOrders.ShortCut := BNoOrders.ShortCut;
     6458  mPrevUnit.ShortCut := BPrevUnit.ShortCut;
     6459  mNextUnit.ShortCut := BNextUnit.ShortCut;
    64456460  mCancel.ShortCut := BCancel.ShortCut;
    64466461  mPillage.ShortCut := BPillage.ShortCut;
     
    66366651    else if BStay.Test(ShortCut) then MenuClick(mStay)
    66376652    else if BNoOrders.Test(ShortCut) then MenuClick(mNoOrders)
     6653    else if BPrevUnit.Test(ShortCut) then MenuClick(mPrevUnit)
     6654    else if BNextUnit.Test(ShortCut) then MenuClick(mNextUnit)
    66386655    else if BCancel.Test(ShortCut) then MenuClick_Check(UnitPopup, mCancel)
    66396656    else if BPillage.Test(ShortCut) then MenuClick_Check(UnitPopup, mPillage)
     
    67186735          end
    67196736          else
    6720             PanelPaint
     6737            PanelPaint;
    67216738        end
    67226739        else
    67236740          NextUnit(UnStartLoc, true);
    6724       end
     6741      end;
    67256742    end;
    67266743    case result of
     
    67356752      if result < rExecuted then
    67366753        Play('INVALID')
    6737     end
     6754    end;
    67386755  end;
    67396756
     
    69146931  end
    69156932  else if UnFocus >= 0 then
    6916     with MyUn[UnFocus] do
     6933    with TUn(MyUn[UnFocus]) do
    69176934      if Sender = mGoOn then
    69186935      begin
     
    69456962      begin
    69466963        Centre(Loc);
    6947         PaintAllMaps
     6964        PaintAllMaps;
    69486965      end
    69496966      else if Sender = mCity then
     
    69576974            PaintAll;
    69586975            ZoomToCity(Loc0, true, chFounded);
    6959           end
     6976          end;
    69606977        end
    69616978        else
     
    70187035        if Job > jNone then
    70197036          Server(sStartJob + jNone shl 4, me, UnFocus, nil^);
    7020         NextUnit(UnStartLoc, true)
     7037        NextUnit(UnStartLoc, true);
    70217038      end
    70227039      else if Sender = mRecover then
     
    70277044        if Job > jNone then
    70287045          Server(sStartJob + jNone shl 4, me, UnFocus, nil^);
    7029         NextUnit(UnStartLoc, true)
     7046        NextUnit(UnStartLoc, true);
    70307047      end
    70317048      else if Sender = mNoOrders then
    70327049      begin
    70337050        Status := Status and not usWaiting;
    7034         NextUnit(UnStartLoc, true)
     7051        NextUnit(UnStartLoc, true);
     7052      end
     7053      else if Sender = mPrevUnit then
     7054      begin
     7055        Status := Status and not usWaiting;
     7056        FocusNextUnit(-1);
     7057      end
     7058      else if Sender = mNextUnit then
     7059      begin
     7060        Status := Status and not usWaiting;
     7061        FocusNextUnit(1);
    70357062      end
    70367063      else if Sender = mCancel then
     
    71137140              NextUnit(Loc, true)
    71147141            else
    7115               PanelPaint
     7142              PanelPaint;
    71167143          end
    71177144          else if i = eNoTime_Load then
     
    80358062end;
    80368063
    8037 initialization
    8038 
    80398064end.
    80408065
  • branches/highdpi/LocalPlayer/UKeyBindings.pas

    r303 r405  
    1717    ShortCut: TShortCut;
    1818    ShortCut2: TShortCut;
     19    DefaultShortCut: TShortCut;
     20    DefaultShortCut2: TShortCut;
    1921    function Test(AShortCut: TShortCut): Boolean;
     22    procedure Assign(Source: TKeyBinding);
     23    procedure SetDefault;
    2024  end;
    2125
     
    2327
    2428  TKeyBindings = class(TFPGObjectList<TKeyBinding>)
     29  private
    2530  public
    2631    function AddItem(const ShortName, FullName: string; ShortCut: TShortCut; ShortCut2: TShortCut = 0): TKeyBinding; overload;
     
    2934    procedure LoadFromRegistry(RootKey: HKEY; Key: string);
    3035    procedure SaveToRegistry(RootKey: HKEY; Key: string);
     36    procedure LoadToStrings(Strings: TStrings);
     37    procedure Assign(Source: TKeyBindings);
     38    procedure ResetToDefault;
     39    procedure RemoveShortCut(ShortCut: TShortCut);
    3140  end;
    3241
     
    5261  BStay: TKeyBinding;
    5362  BNoOrders: TKeyBinding;
     63  BPrevUnit: TKeyBinding;
     64  BNextUnit: TKeyBinding;
    5465  BCancel: TKeyBinding;
    5566  BPillage: TKeyBinding;
     
    123134end;
    124135
     136procedure TKeyBinding.Assign(Source: TKeyBinding);
     137begin
     138  ShortName := Source.ShortName;
     139  FullName := Source.FullName;
     140  ShortCut := Source.ShortCut;
     141  ShortCut2 := Source.ShortCut2;
     142  DefaultShortCut := Source.DefaultShortCut;
     143  DefaultShortCut2 := Source.DefaultShortCut2;
     144end;
     145
     146procedure TKeyBinding.SetDefault;
     147begin
     148  ShortCut := DefaultShortCut;
     149  ShortCut2 := DefaultShortCut2;
     150end;
     151
    125152{ TKeyBindings }
    126153
     
    133160  Result.ShortCut := ShortCut;
    134161  Result.ShortCut2 := ShortCut2;
     162  Result.DefaultShortCut := ShortCut;
     163  Result.DefaultShortCut2 := ShortCut2;
    135164  Add(Result);
    136165end;
     
    207236end;
    208237
     238procedure TKeyBindings.LoadToStrings(Strings: TStrings);
     239var
     240  I: Integer;
     241  Text: string;
     242begin
     243  Strings.Clear;
     244  for I := 0 to Count - 1 do begin
     245    Text:= '';
     246    if Items[I].ShortCut <> 0 then
     247      Text:= Text + ShortCutToText(Items[I].ShortCut);
     248    if Items[I].ShortCut2 <> 0 then begin
     249      if Text <> '' then Text := Text + ', ';
     250      Text:= Text + ShortCutToText(Items[I].ShortCut2);
     251    end;
     252    if Text <> '' then Text := Items[I].FullName + ' (' + Text + ')'
     253      else Text := Items[I].FullName;
     254    Strings.Add(Text);
     255  end;
     256end;
     257
     258procedure TKeyBindings.Assign(Source: TKeyBindings);
     259var
     260  I: Integer;
     261begin
     262  while Count < Source.Count do
     263    Add(TKeyBinding.Create);
     264  while Count > Source.Count do
     265    Delete(Count - 1);
     266  for I := 0 to Count - 1 do
     267    Items[I].Assign(Source.Items[I]);
     268end;
     269
     270procedure TKeyBindings.ResetToDefault;
     271var
     272  I: Integer;
     273begin
     274  for I := 0 to Count - 1 do
     275    Items[I].SetDefault;
     276end;
     277
     278procedure TKeyBindings.RemoveShortCut(ShortCut: TShortCut);
     279var
     280  I: Integer;
     281begin
     282  for I := 0 to Count - 1 do begin
     283    if Items[I].ShortCut = ShortCut then Items[I].ShortCut := 0;
     284    if Items[I].ShortCut2 = ShortCut then Items[I].ShortCut2 := 0;
     285  end;
     286end;
     287
    209288
    210289initialization
     
    231310  BStay := AddItem('Stay', 'Stay', 'S');
    232311  BNoOrders := AddItem('NoOrders', 'No orders', 'Space');
     312  BPrevUnit := AddItem('PrevUnit', 'Previous unit', 'Del');
     313  BNextUnit := AddItem('NextUnit', 'Next unit', 'Ins');
    233314  BCancel := AddItem('Cancel', 'Cancel', 'Ctrl+C');
    234315  BPillage := AddItem('Pillage', 'Pillage', 'Ctrl+P');
  • branches/highdpi/LocalPlayer/UnitStat.pas

    r361 r405  
    5252
    5353uses
    54   Tribes, Help, Directories;
     54  Tribes, Help, Directories, UTexture;
    5555
    5656{$R *.lfm}
  • branches/highdpi/Localization/cs/Language.txt

    r378 r405  
    341341#BTN_NO Ne
    342342#BTN_INFO Info
     343#BTN_RESET Výchozí
    343344
    344345'Button Tooltips
     
    547548Střední
    548549Velká
     550Předchozí jednotka
     551Další jednotka
    549552
    550553#ADVANCES
     
    952955Gamma
    953956Pro projevení změn je potřeba restart
     957Hlavní
     958Vedlejší
     959Jazyky
     960Klávesové zkratky
  • branches/highdpi/Localization/de/Language.txt

    r378 r405  
    344344#BTN_NO Nein
    345345#BTN_INFO Info
     346#BTN_RESET Reset
    346347
    347348'Button Tooltips
     
    556557Medium
    557558Big
     559Previous Unit
     560Next Unit
    558561
    559562#ADVANCES
     
    970973Gamma
    971974Restart is needed to apply changes
     975Primary
     976Secondary
     977Languages
     978Key bindings
  • branches/highdpi/Localization/it/Language.txt

    r378 r405  
    331331#BTN_NO No
    332332#BTN_INFO Dati
     333#BTN_RESET Reset
    333334
    334335'Button Tooltips
     
    537538Medium
    538539Big
     540Previous Unit
     541Next Unit
    539542
    540543#ADVANCES
     
    942945Gamma
    943946Restart is needed to apply changes
     947Primary
     948Secondary
     949Languages
     950Key bindings
  • branches/highdpi/Localization/ru/Language.txt

    r378 r405  
    351351#BTN_NO Нет
    352352#BTN_INFO Информация
     353#BTN_RESET Reset
    353354
    354355'Названия кнопок-инструментов
     
    563564Medium
    564565Big
     566Previous Unit
     567Next Unit
    565568
    566569#ADVANCES
     
    977980Gamma
    978981Restart is needed to apply changes
     982Primary
     983Secondary
     984Languages
     985Key bindings
  • branches/highdpi/Localization/zh-Hans/language.txt

    r378 r405  
    344344#BTN_NO ·ñ
    345345#BTN_INFO °ïÖú
     346#BTN_RESET Reset
    346347
    347348'Button Tooltips
     
    555556Medium
    556557Big
     558Previous Unit
     559Next Unit
    557560
    558561#ADVANCES
     
    969972Gamma
    970973Restart is needed to apply changes
     974Primary
     975Secondary
     976Languages
     977Key bindings
  • branches/highdpi/Localization/zh-Hant/language.txt

    r378 r405  
    344344#BTN_NO §_
    345345#BTN_INFO À°§U
     346#BTN_RESET Reset
    346347
    347348'Button Tooltips
     
    555556Medium
    556557Big
     558Previous Unit
     559Next Unit
    557560
    558561#ADVANCES
     
    969972Gamma
    970973Restart is needed to apply changes
     974Primary
     975Secondary
     976Languages
     977Key bindings
  • branches/highdpi/Network/UNetworkClient.pas

    r378 r405  
    4848
    4949uses
    50   LocalPlayer, Global, UNetworkCommon;
     50  LocalPlayer{$IFDEF LINUX}, Global, UNetworkCommon{$ENDIF};
    5151
    5252procedure Client(Command, Player: Integer; var Data);
     53{$IFDEF LINUX}
    5354var
    5455  Cmd: TCommand;
     56{$ENDIF}
    5557begin
    5658  {$IFDEF LINUX}
  • branches/highdpi/Network/UNetworkServer.pas

    r378 r405  
    66
    77uses
    8   Classes, SysUtils, fgl{$IFDEF LINUX}, fpAsync, fpsock{$ENDIF}, Protocol, fphttpclient;
     8  Classes, SysUtils{$IFDEF LINUX}, fgl, fpAsync, fpsock, fphttpclient{$ENDIF}, Protocol;
    99
    1010{$IFDEF LINUX}
     
    8787implementation
    8888
     89{$IFDEF LINUX}
    8990uses
    9091  Global, UNetworkCommon;
     92{$ENDIF}
    9193
    9294procedure Client(Command, Player: integer; var Data);
  • branches/highdpi/Packages/CevoComponents/CevoComponents.lpk

    r349 r405  
    3737    <Description Value="C-evo components"/>
    3838    <Version Major="1" Minor="2"/>
    39     <Files Count="17">
     39    <Files Count="16">
    4040      <Item1>
    4141        <Filename Value="Area.pas"/>
     
    9999      </Item13>
    100100      <Item14>
    101         <Filename Value="UPixelPointer.pas"/>
    102         <UnitName Value="UPixelPointer"/>
     101        <Filename Value="AsyncProcess2.pas"/>
     102        <UnitName Value="AsyncProcess2"/>
    103103      </Item14>
    104104      <Item15>
    105         <Filename Value="AsyncProcess2.pas"/>
    106         <UnitName Value="AsyncProcess2"/>
     105        <Filename Value="UGraphicSet.pas"/>
     106        <UnitName Value="UGraphicSet"/>
    107107      </Item15>
    108108      <Item16>
    109         <Filename Value="UGraphicSet.pas"/>
    110         <UnitName Value="UGraphicSet"/>
     109        <Filename Value="UTexture.pas"/>
     110        <UnitName Value="UTexture"/>
    111111      </Item16>
    112       <Item17>
    113         <Filename Value="UXMLUtils.pas"/>
    114         <UnitName Value="UXMLUtils"/>
    115       </Item17>
    116112    </Files>
    117113    <RequiredPkgs Count="3">
    118114      <Item1>
    119         <PackageName Value="DpiControls"/>
     115        <PackageName Value="Common"/>
    120116      </Item1>
    121117      <Item2>
  • branches/highdpi/Packages/CevoComponents/CevoComponents.pas

    r349 r405  
    1010uses
    1111  Area, ButtonA, ButtonB, ButtonC, ButtonN, EOTButton, ButtonBase, DrawDlg,
    12   Sound, BaseWin, UPixelPointer, AsyncProcess2, UGraphicSet, UXMLUtils,
    13   LazarusPackageIntf;
     12  Sound, BaseWin, AsyncProcess2, UGraphicSet, UTexture, LazarusPackageIntf;
    1413
    1514implementation
  • branches/highdpi/Packages/CevoComponents/Directories.pas

    r246 r405  
    6767  Src, Dst: TSearchRec;
    6868begin
    69   if not DirectoryExists(DestinationDir) then CreateDir(DestinationDir);
     69  if not DirectoryExists(DestinationDir) then ForceDirectories(DestinationDir);
    7070  if FindFirst(SourceDir + DirectorySeparator + Filter, $21, Src) = 0 then
    7171    repeat
     
    7979end;
    8080
     81procedure CopyFiles;
     82begin
     83  if DirectoryExists(GetSavedDir(True)) and not DirectoryExists(GetSavedDir(False)) then
     84    CopyDir(GetSavedDir(True), GetSavedDir(False), '*.*');
     85  if DirectoryExists(GetMapsDir(True)) and not DirectoryExists(GetMapsDir(False)) then
     86    CopyDir(GetMapsDir(True), GetMapsDir(False), '*.*');
     87end;
     88
    8189procedure UnitInit;
    8290var
     
    8795
    8896  AppDataDir := GetAppConfigDir(False);
    89   if AppDataDir = '' then
    90     DataDir := HomeDir
    91   else
    92   begin
    93     if not DirectoryExists(AppDataDir) then CreateDir(AppDataDir);
     97  if AppDataDir = '' then DataDir := HomeDir
     98  else begin
     99    if not DirectoryExists(AppDataDir) then ForceDirectories(AppDataDir);
    94100    DataDir := AppDataDir;
    95101  end;
    96 
    97   CopyDir(GetSavedDir(True), GetSavedDir(False), '*.*');
    98   CopyDir(GetMapsDir(True), GetMapsDir(False), '*.*');
     102  CopyFiles;
    99103end;
    100104
  • branches/highdpi/Packages/CevoComponents/DrawDlg.pas

    r378 r405  
    77uses
    88  UDpiControls, Classes, SysUtils, Forms, LCLIntf, LCLType, {$IFDEF LINUX}LMessages,{$ENDIF}
    9   Messages, Graphics, Controls, ButtonBase, ButtonA, ButtonB, Area, ScreenTools;
     9  Messages, Graphics, Controls, ButtonBase, ButtonA, ButtonB, Area, ScreenTools
     10  {$IFDEF LCLGTK2}, Gtk2Globals{$ENDIF};
    1011
    1112type
     
    187188begin
    188189  MoveActive := False;
     190
     191  {$IFDEF LCLGTK2}
     192  // GTK2 bug workaround https://bugs.freepascal.org/view.php?id=35720
     193  if Visible then LastMouse.WinControl := Self;
     194  {$ENDIF}
    189195end;
    190196
  • branches/highdpi/Packages/CevoComponents/ScreenTools.pas

    r378 r405  
    88  {$ENDIF}
    99  StringTables, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Math,
    10   Forms, Menus, GraphType, fgl, UGraphicSet, LazFileUtils;
     10  Forms, Menus, GraphType, fgl, UGraphicSet, LazFileUtils, UTexture;
    1111
    1212type
    13 
    14   { TTexture }
    15 
    16   TTexture = class
    17   private
    18     FAge: Integer;
    19     function GetHeight: Integer;
    20     function GetWidth: Integer;
    21     procedure SetAge(AValue: Integer);
    22   public
    23     Image: TDpiBitmap;
    24     ColorBevelLight: TColor;
    25     ColorBevelShade: TColor;
    26     ColorTextLight: TColor;
    27     ColorTextShade: TColor;
    28     ColorLitText: TColor;
    29     ColorMark: TColor;
    30     ColorPage: TColor;
    31     ColorCover: TColor;
    32     constructor Create;
    33     destructor Destroy; override;
    34     procedure Assign(Source: TTexture);
    35     property Age: Integer read FAge write SetAge;
    36     property Width: Integer read GetWidth;
    37     property Height: Integer read GetHeight;
    38   end;
    39 
    4013  TLoadGraphicFileOption = (gfNoError, gfNoGamma);
    4114  TLoadGraphicFileOptions = set of TLoadGraphicFileOption;
     
    18351808end;
    18361809
    1837 { TTexture }
    1838 
    1839 procedure TTexture.SetAge(AValue: Integer);
    1840 begin
    1841   if FAge = AValue then Exit;
    1842   FAge := AValue;
    1843   LoadGraphicFile(Image, GetGraphicsDir + DirectorySeparator +
    1844     'Texture' + IntToStr(Age + 1) + '.jpg');
    1845   ColorBevelLight := Colors.Canvas.Pixels[clkAge0 + Age, cliBevelLight];
    1846   ColorBevelShade := Colors.Canvas.Pixels[clkAge0 + Age, cliBevelShade];
    1847   ColorTextLight := Colors.Canvas.Pixels[clkAge0 + Age, cliTextLight];
    1848   ColorTextShade := Colors.Canvas.Pixels[clkAge0 + Age, cliTextShade];
    1849   ColorLitText := Colors.Canvas.Pixels[clkAge0 + Age, cliLitText];
    1850   ColorMark := Colors.Canvas.Pixels[clkAge0 + Age, cliMark];
    1851   ColorPage := Colors.Canvas.Pixels[clkAge0 + Age, cliPage];
    1852   ColorCover := Colors.Canvas.Pixels[clkAge0 + Age, cliCover];
    1853 end;
    1854 
    1855 function TTexture.GetHeight: Integer;
    1856 begin
    1857   Result := Image.Height;
    1858 end;
    1859 
    1860 function TTexture.GetWidth: Integer;
    1861 begin
    1862   Result := Image.Width;
    1863 end;
    1864 
    1865 constructor TTexture.Create;
    1866 begin
    1867   Image := TDpiBitmap.Create;
    1868   FAge := -2;
    1869 end;
    1870 
    1871 destructor TTexture.Destroy;
    1872 begin
    1873   FreeAndNil(Image);
    1874   inherited;
    1875 end;
    1876 
    1877 procedure TTexture.Assign(Source: TTexture);
    1878 begin
    1879   FAge := Source.FAge;
    1880   Image.Assign(Image);
    1881   ColorBevelLight := Source.ColorBevelLight;
    1882   ColorBevelShade := Source.ColorBevelShade;
    1883   ColorTextLight := Source.ColorTextLight;
    1884   ColorTextShade := Source.ColorTextShade;
    1885   ColorLitText := Source.ColorLitText;
    1886   ColorMark := Source.ColorMark;
    1887   ColorPage := Source.ColorPage;
    1888   ColorCover := Source.ColorCover;
    1889 end;
    1890 
    18911810end.
  • branches/highdpi/Packages/CevoComponents/Sound.pas

    r349 r405  
    150150    if (FindDefaultExecutablePath('afplay') <> '') then
    151151      Result := 'afplay';
     152  // Try mpg321
     153  if (Result = '') then
     154    if (FindDefaultExecutablePath('mpg321') <> '') then
     155      Result := 'mpg321 -q';
    152156end;
    153157
  • branches/highdpi/Packages/DpiControls/UDpiControls.pas

    r378 r405  
    66
    77uses
    8   {$IFDEF WINDOWS}Windows, {$ENDIF}Classes, SysUtils, LCLProc, LResources, Forms, FormEditingIntf, ProjectIntf,
    9   Controls, StdCtrls, fgl, Graphics, ComCtrls, ExtCtrls, LCLType, GraphType,
    10   Types, CustApp, LMessages, LCLIntf, Menus, Math, UPixelPointer2;
     8  {$IFDEF WINDOWS}Windows, {$ENDIF}Classes, SysUtils, LCLProc, LResources, Forms,
     9  FormEditingIntf, ProjectIntf, Controls, StdCtrls, fgl, Graphics, ComCtrls,
     10  ExtCtrls, LCLType, GraphType, Types, CustApp, LMessages, LCLIntf, Menus, Math,
     11  UPixelPointer2, Grids, Spin;
    1112
    1213const
     
    102103    destructor Destroy; override;
    103104    procedure Assign(Source: TPersistent); override;
     105    procedure GetTextSize(Text: string; var w, h: Integer);
     106    function GetTextHeight(Text: string): Integer;
     107    function GetTextWidth(Text: string): Integer;
    104108  published
    105109    property CharSet: TFontCharSet read GetCharSet write SetCharSet default DEFAULT_CHARSET;
     
    158162    function GetAlign: TAlign;
    159163    function GetAnchors: TAnchors;
     164    function GetAutoSize: Boolean;
    160165    function GetBoundsRect: TRect;
    161166    function GetClientHeight: Integer;
     
    173178    procedure SetAlign(AValue: TAlign);
    174179    procedure SetAnchors(AValue: TAnchors);
     180    procedure SetAutoSize(AValue: Boolean);
    175181    procedure SetBorderSpacing(AValue: TDpiControlBorderSpacing);
    176182    procedure SetBoundsRect(AValue: TRect);
     
    239245    procedure Repaint;
    240246    procedure Update;
     247    procedure Refresh;
    241248    function IsParentOf(AControl: TDpiControl): boolean; virtual;
     249    function Scale96ToScreen(const ASize: Integer): Integer;
    242250    constructor Create(TheOwner: TComponent); override;
    243251    destructor Destroy; override;
     
    248256    property BorderSpacing: TDpiControlBorderSpacing read FBorderSpacing write SetBorderSpacing;
    249257  published
     258    property AutoSize: Boolean read GetAutoSize write SetAutoSize default False;
    250259    property ClientHeight: Integer read GetClientHeight write SetClientHeight;
    251260    property ClientWidth: Integer read GetClientWidth write SetClientWidth;
     
    341350    function GetNativeRasterImage: TRasterImage; virtual;
    342351  public
     352    procedure BeginUpdate(ACanvasOnly: Boolean = False);
     353    procedure EndUpdate(AStreamIsValid: Boolean = False);
    343354    property RawImage: TRawImage read GetRawImage;
    344355  end;
     
    403414    FNativeCanvasFree: Boolean;
    404415    function GetHandle: HDC;
    405     function GetHeight: Integer;
    406416    function GetPixel(X, Y: Integer): TColor;
    407     function GetWidth: Integer;
    408417    procedure SetBrush(AValue: TDpiBrush);
    409418    procedure SetFont(AValue: TDpiFont);
     
    413422    procedure SetNativeCanvas(AValue: TCanvas);
    414423  protected
     424    procedure SetHeight(AValue: Integer); virtual;
     425    procedure SetWidth(AValue: Integer); virtual;
     426    function GetWidth: Integer; virtual;
     427    function GetHeight: Integer; virtual;
    415428    function GetNativeCanvas: TCanvas; virtual;
    416429  public
     
    423436    function TextHeight(Text: string): Integer;
    424437    function TextExtent(Text: string): TSize;
    425     procedure TextOut(X, Y: Integer; Text: string);
     438    procedure TextOut(X, Y: Integer; const Text: string); virtual;
    426439    procedure TextRect(ARect: TRect; X, Y: Integer; Text: string);
    427440    procedure MoveTo(X, Y: Integer);
    428441    procedure LineTo(X, Y: Integer);
    429     procedure FillRect(ARect: TRect);
     442    procedure FillRect(const ARect: TRect); virtual;
    430443    procedure FillRect(X1, Y1, X2, Y2: Integer);
    431444    procedure Draw(X, Y: Integer; Source: TDpiGraphic);
     
    581594    function GetOnShow: TNotifyEvent;
    582595    function GetPosition: TPosition;
     596    function GetRestoredHeight: Integer;
     597    function GetRestoredLeft: Integer;
     598    function GetRestoredTop: Integer;
     599    function GetRestoredWidth: Integer;
    583600    function GetWindowState: TWindowState;
    584601    procedure SetBorderIcons(AValue: TBorderIcons);
     
    624641    destructor Destroy; override;
    625642  published
     643    property RestoredLeft: integer read GetRestoredLeft;
     644    property RestoredTop: integer read GetRestoredTop;
     645    property RestoredWidth: integer read GetRestoredWidth;
     646    property RestoredHeight: integer read GetRestoredHeight;
    626647    property DesignTimePPI: Integer read GetDesignTimePPI write SetDesignTimePPI; // Not used
    627648    property FormState: TFormState read GetFormState;
     
    698719    function GetItemIndex: Integer;
    699720    function GetItems: TStrings;
     721    function GetOnSelectionChange: TSelectionChangeEvent;
    700722    function GetParentFont: Boolean;
    701723    function GetScrollWidth: Integer;
     
    707729    procedure SetItemIndex(AValue: Integer);
    708730    procedure SetItems(AValue: TStrings);
     731    procedure SetOnSelectionChange(AValue: TSelectionChangeEvent);
    709732    procedure SetParentFont(AValue: Boolean);
    710733    procedure SetScrollWidth(AValue: Integer);
     
    729752    property Visible;
    730753    property Anchors;
     754    property OnSelectionChange: TSelectionChangeEvent read GetOnSelectionChange
     755                                                      write SetOnSelectionChange;
    731756  end;
    732757
     
    773798    function GetPixelFormat: TPixelFormat;
    774799    function GetScanLine(Row: Integer): Pointer;
     800    function GetTransparent: Boolean;
     801    function GetTransparentColor: TColor;
    775802    procedure SetPixelFormat(AValue: TPixelFormat);
     803    procedure SetTransparent(AValue: Boolean);
     804    procedure SetTransparentColor(AValue: TColor);
    776805  protected
    777806    function GetHeight: Integer; override;
     
    796825    property Width: Integer read GetWidth write SetWidth;
    797826    property Canvas: TDpiCanvas read GetCanvas;
     827    property TransparentColor: TColor read GetTransparentColor
     828                                      write SetTransparentColor default clDefault;
     829    property Transparent: Boolean read GetTransparent write SetTransparent default False;
    798830  end;
    799831
     
    841873  end;
    842874
     875  { TDpiListView }
     876
     877  TDpiListView = class(TDpiWinControl)
     878  private
     879    NativeListView: TListView;
     880    function GetColumns: TListColumns;
     881    function GetItems: TListItems;
     882    procedure SetColumns(AValue: TListColumns);
     883    procedure SetItems(AValue: TListItems);
     884  public
     885    function GetNativeListView: TListView;
     886    constructor Create(TheOwner: TComponent); override;
     887    destructor Destroy; override;
     888    property Columns: TListColumns read GetColumns write SetColumns;
     889    property Items: TListItems read GetItems write SetItems;
     890  published
     891  end;
     892
     893  { TDpiPanel }
     894
     895  TDpiPanel = class(TDpiWinControl)
     896  private
     897    NativePanel: TPanel;
     898  public
     899    function GetNativePanel: TPanel;
     900    constructor Create(TheOwner: TComponent); override;
     901    destructor Destroy; override;
     902  end;
     903
     904  { TDpiCustomDrawGrid }
     905
     906  TDpiCustomDrawGrid = class(TDpiWinControl)
     907  private
     908    NativeCustomDrawGrid: TCustomDrawGrid;
     909    function GetEditor: TDpiWinControl;
     910    procedure SetEditor(AValue: TDpiWinControl);
     911  public
     912    function GetNativeCustomDrawGrid: TCustomDrawGrid;
     913    constructor Create(TheOwner: TComponent); override;
     914    destructor Destroy; override;
     915    property Editor: TDpiWinControl read GetEditor write SetEditor;
     916  end;
     917
     918  { TDpiPageControl }
     919
     920  TDpiPageControl = class(TDpiWinControl)
     921  private
     922    NativePageControl: TPageControl;
     923    function GetPageCount: Integer;
     924    function GetTabSheet(Index: Integer): TTabSheet;
     925  public
     926    function GetNativePageControl: TPageControl;
     927    constructor Create(TheOwner: TComponent); override;
     928    destructor Destroy; override;
     929    property PageCount: Integer read GetPageCount;
     930    property Pages[Index: Integer]: TTabSheet read GetTabSheet;
     931  end;
     932
     933  { TDpiRadioButton }
     934
     935  TDpiRadioButton = class(TDpiWinControl)
     936  private
     937    NativeRadioButton: TRadioButton;
     938  public
     939    function GetNativeRadioButton: TRadioButton;
     940    constructor Create(TheOwner: TComponent); override;
     941    destructor Destroy; override;
     942  end;
     943
     944  { TDpiSpinEdit }
     945
     946  TDpiSpinEdit = class(TDpiWinControl)
     947  private
     948    NativeSpinEdit: TSpinEdit;
     949  public
     950    function GetNativeSpinEdit: TSpinEdit;
     951    constructor Create(TheOwner: TComponent); override;
     952    destructor Destroy; override;
     953  end;
     954
     955  { TDpiComboBox }
     956
     957  TDpiComboBox = class(TDpiWinControl)
     958  private
     959    NativeComboBox: TComboBox;
     960  public
     961    function GetNativeComboBox: TComboBox;
     962    constructor Create(TheOwner: TComponent); override;
     963    destructor Destroy; override;
     964  end;
     965
     966  { TDpiCheckBox }
     967
     968  TDpiCheckBox = class(TDpiWinControl)
     969  private
     970    NativeCheckBox: TCheckBox;
     971  public
     972    function GetNativeCheckBox: TCheckBox;
     973    constructor Create(TheOwner: TComponent); override;
     974    destructor Destroy; override;
     975  end;
     976
     977  { TDpiMemo }
     978
     979  TDpiMemo = class(TDpiWinControl)
     980  private
     981    NativeMemo: TMemo;
     982    function GetLines: TStrings;
     983    procedure SetLines(AValue: TStrings);
     984  public
     985    procedure Clear;
     986    function GetNativeMemo: TMemo;
     987    constructor Create(TheOwner: TComponent); override;
     988    destructor Destroy; override;
     989    property Lines: TStrings read GetLines write SetLines;
     990  end;
     991
     992  { TDpiToolBar }
     993
     994  TDpiToolBar = class(TDpiCustomControl)
     995  private
     996    NativeToolBar: TToolBar;
     997    function ButtonHeightIsStored: Boolean;
     998    function ButtonWidthIsStored: Boolean;
     999    function GetButtonHeight: Integer;
     1000    function GetButtonWidth: Integer;
     1001    procedure SetButtonHeight(AValue: Integer);
     1002    procedure SetButtonWidth(AValue: Integer);
     1003  public
     1004    function GetNativeToolBar: TToolBar;
     1005    constructor Create(TheOwner: TComponent); override;
     1006    destructor Destroy; override;
     1007    property ButtonHeight: Integer read GetButtonHeight write SetButtonHeight stored ButtonHeightIsStored;
     1008    property ButtonWidth: Integer read GetButtonWidth write SetButtonWidth stored ButtonWidthIsStored;
     1009  end;
     1010
     1011  { TDpiCoolBand }
     1012
     1013  TDpiCoolBand = class(TDpiCustomControl)
     1014  private
     1015    NativeCoolBand: TCoolBand;
     1016    function GetMinHeight: Integer;
     1017    function GetMinWidth: Integer;
     1018    procedure SetMinHeight(AValue: Integer);
     1019    procedure SetMinWidth(AValue: Integer);
     1020  protected const
     1021    cDefMinHeight = 25;
     1022    cDefMinWidth = 100;
     1023  public
     1024    function GetNativeCoolBand: TCoolBand;
     1025    constructor Create(TheOwner: TComponent); override;
     1026    destructor Destroy; override;
     1027    property MinHeight: Integer read GetMinHeight write SetMinHeight default cDefMinHeight;
     1028    property MinWidth: Integer read GetMinWidth write SetMinWidth default cDefMinWidth;
     1029  end;
     1030
     1031  { TDpiCoolBands }
     1032
     1033  TDpiCoolBands = class(TCollection)
     1034  private
     1035    procedure SetItem(Index: Integer; AValue: TDpiCoolBand);
     1036    function GetItem(Index: Integer): TDpiCoolBand;
     1037  public
     1038    property Items[Index: Integer]: TDpiCoolBand read GetItem write SetItem; default;
     1039  end;
     1040
     1041  { TDpiCoolBar }
     1042
     1043  TDpiCoolBar = class(TDpiCustomControl)
     1044  private
     1045    NativeCoolBar: TCoolBar;
     1046    function GetBands: TDpiCoolBands;
     1047    function GetThemed: Boolean;
     1048    procedure SetBands(AValue: TDpiCoolBands);
     1049    procedure SetThemed(AValue: Boolean);
     1050  public
     1051    procedure BeginUpdate;
     1052    procedure EndUpdate;
     1053    function GetNativeCoolBar: TCoolBar;
     1054    constructor Create(TheOwner: TComponent); override;
     1055    destructor Destroy; override;
     1056    property Bands: TDpiCoolBands read GetBands write SetBands;
     1057    property Themed: Boolean read GetThemed write SetThemed default True;
     1058  end;
     1059
     1060  { TDpiImageList }
     1061
     1062  TDpiImageList = class(TComponent)
     1063  private
     1064    NativeImageList: TImageList;
     1065    function GetCount: Integer;
     1066    function GetHeight: Integer;
     1067    function GetWidth: Integer;
     1068    procedure SetHeight(AValue: Integer);
     1069    procedure SetWidth(AValue: Integer);
     1070  public
     1071    function GetNativeImageList: TImageList;
     1072    procedure GetBitmap(Index: Integer; Image: TDpiBitmap);
     1073    procedure BeginUpdate;
     1074    procedure EndUpdate;
     1075    procedure Clear;
     1076    function Add(Image, Mask: TDpiBitmap): Integer;
     1077    constructor Create(TheOwner: TComponent); override;
     1078    destructor Destroy; override;
     1079    property Width: Integer read GetWidth write SetWidth default 16;
     1080    property Height: Integer read GetHeight write SetHeight default 16;
     1081    property Count: Integer read GetCount;
     1082  end;
     1083
     1084  { TDpiStringGrid }
     1085
     1086  TDpiStringGrid = class(TDpiWinControl)
     1087  private
     1088    NativeStringGrid: TStringGrid;
     1089    function DefaultRowHeightIsStored: Boolean;
     1090    function GetDefRowHeight: Integer;
     1091    procedure SetDefRowHeight(AValue: Integer);
     1092  public
     1093    function GetNativeStringGrid: TStringGrid;
     1094    constructor Create(TheOwner: TComponent); override;
     1095    destructor Destroy; override;
     1096  published
     1097    property DefaultRowHeight: Integer read GetDefRowHeight write SetDefRowHeight stored DefaultRowHeightIsStored;
     1098  end;
     1099
    8431100  { TDpiScreen }
    8441101
     
    8511108    FForms: TDpiForms;
    8521109    procedure AddForm(AForm: TDpiForm);
     1110    function GetDesktopHeight: Integer;
     1111    function GetDesktopLeft: Integer;
     1112    function GetDesktopTop: Integer;
     1113    function GetDesktopWidth: Integer;
    8531114    procedure RemoveForm(AForm: TDpiForm);
    8541115    function GetActiveForm: TDpiForm;
     
    8681129    procedure UpdateScreen;
    8691130    procedure UpdateActiveFormFromNativeScreen;
     1131    function DisableForms(SkipForm: TDpiForm; DisabledList: TList = nil): TList;
     1132    procedure EnableForms(var AFormList: TList);
    8701133    property FormCount: Integer read GetFormCount;
    8711134    property Forms[Index: Integer]: TDpiForm read GetForms;
     
    8781141    property Width: Integer read GetWidth;
    8791142    property Height: Integer read GetHeight;
     1143    property DesktopLeft: Integer read GetDesktopLeft;
     1144    property DesktopTop: Integer read GetDesktopTop;
     1145    property DesktopWidth: Integer read GetDesktopWidth;
     1146    property DesktopHeight: Integer read GetDesktopHeight;
    8801147  end;
    8811148
     
    9121179    FOldExitProc: Pointer;
    9131180    function GetActive: Boolean;
     1181    function GetExeName: string;
    9141182    function GetShowMainForm: Boolean;
    9151183    function GetTitle: string;
     
    9351203    property Title: string read GetTitle write SetTitle;
    9361204    property Active: Boolean read GetActive;
     1205    property ExeName: string read GetExeName;
    9371206  end;
    9381207
     
    9941263    property Items[Index: Integer]: TDpiMenuItem read GetItem; default;
    9951264    property Count: Integer read GetCount;
     1265    procedure Clear;
    9961266  published
    9971267    property RadioItem: Boolean read GetRadioItem write SetRadioItem default False;
     
    12311501      ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
    12321502  end else begin
    1233     Result := StretchBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
     1503    Result := BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
     1504      DstWidth, DstHeight, SrcDC,
     1505      ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
     1506{    Result := StretchBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
    12341507      DstWidth, DstHeight, SrcDC,
    12351508      ScaleToNative(XSrc), ScaleToNative(YSrc),
    12361509      SrcWidth, SrcHeight, Rop);
    1237   end;
     1510}  end;
    12381511
    12391512{  Result := BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
     
    12421515 }
    12431516  {$ENDIF}
     1517end;
     1518
     1519{ TDpiRadioButton }
     1520
     1521function TDpiRadioButton.GetNativeRadioButton: TRadioButton;
     1522begin
     1523  if not Assigned(NativeRadioButton) then NativeRadioButton := TRadioButton.Create(nil);
     1524    Result := NativeRadioButton;
     1525end;
     1526
     1527constructor TDpiRadioButton.Create(TheOwner: TComponent);
     1528begin
     1529  inherited Create(TheOwner);
     1530end;
     1531
     1532destructor TDpiRadioButton.Destroy;
     1533begin
     1534  FreeAndNil(NativeRadioButton);
     1535  inherited;
     1536end;
     1537
     1538{ TDpiPageControl }
     1539
     1540function TDpiPageControl.GetPageCount: Integer;
     1541begin
     1542  Result := GetNativePageControl.PageCount;
     1543end;
     1544
     1545function TDpiPageControl.GetTabSheet(Index: Integer): TTabSheet;
     1546begin
     1547  Result := GetNativePageControl.Pages[Index];
     1548end;
     1549
     1550function TDpiPageControl.GetNativePageControl: TPageControl;
     1551begin
     1552  if not Assigned(NativePageControl) then NativePageControl := TPageControl.Create(nil);
     1553    Result := NativePageControl;
     1554end;
     1555
     1556constructor TDpiPageControl.Create(TheOwner: TComponent);
     1557begin
     1558  inherited Create(TheOwner);
     1559end;
     1560
     1561destructor TDpiPageControl.Destroy;
     1562begin
     1563  FreeAndNil(NativePageControl);
     1564  inherited;
     1565end;
     1566
     1567{ TDpiCustomDrawGrid }
     1568
     1569function TDpiCustomDrawGrid.GetEditor: TDpiWinControl;
     1570begin
     1571  //Result := GetNativeCustomDrawGrid.Editor;
     1572end;
     1573
     1574procedure TDpiCustomDrawGrid.SetEditor(AValue: TDpiWinControl);
     1575begin
     1576  //GetNativeCustomDrawGrid.Editor := AValue
     1577end;
     1578
     1579function TDpiCustomDrawGrid.GetNativeCustomDrawGrid: TCustomDrawGrid;
     1580begin
     1581  if not Assigned(NativeCustomDrawGrid) then NativeCustomDrawGrid := TCustomDrawGrid.Create(nil);
     1582    Result := NativeCustomDrawGrid;
     1583end;
     1584
     1585constructor TDpiCustomDrawGrid.Create(TheOwner: TComponent);
     1586begin
     1587  inherited Create(TheOwner);
     1588end;
     1589
     1590destructor TDpiCustomDrawGrid.Destroy;
     1591begin
     1592  FreeAndNil(NativeCustomDrawGrid);
     1593  inherited;
     1594end;
     1595
     1596{ TDpiCheckBox }
     1597
     1598function TDpiCheckBox.GetNativeCheckBox: TCheckBox;
     1599begin
     1600  if not Assigned(NativeCheckBox) then NativeCheckBox := TCheckBox.Create(nil);
     1601    Result := NativeCheckBox;
     1602end;
     1603
     1604constructor TDpiCheckBox.Create(TheOwner: TComponent);
     1605begin
     1606  inherited Create(TheOwner);
     1607end;
     1608
     1609destructor TDpiCheckBox.Destroy;
     1610begin
     1611  FreeAndNil(NativeCheckBox);
     1612  inherited;
     1613end;
     1614
     1615{ TDpiComboBox }
     1616
     1617function TDpiComboBox.GetNativeComboBox: TComboBox;
     1618begin
     1619  if not Assigned(NativeComboBox) then NativeComboBox := TComboBox.Create(nil);
     1620    Result := NativeComboBox;
     1621end;
     1622
     1623constructor TDpiComboBox.Create(TheOwner: TComponent);
     1624begin
     1625  inherited Create(TheOwner);
     1626end;
     1627
     1628destructor TDpiComboBox.Destroy;
     1629begin
     1630  FreeAndNil(NativeComboBox);
     1631  inherited;
     1632end;
     1633
     1634{ TDpiSpinEdit }
     1635
     1636function TDpiSpinEdit.GetNativeSpinEdit: TSpinEdit;
     1637begin
     1638  if not Assigned(NativeSpinEdit) then NativeSpinEdit := TSpinEdit.Create(nil);
     1639    Result := NativeSpinEdit;
     1640end;
     1641
     1642constructor TDpiSpinEdit.Create(TheOwner: TComponent);
     1643begin
     1644  inherited Create(TheOwner);
     1645end;
     1646
     1647destructor TDpiSpinEdit.Destroy;
     1648begin
     1649  FreeAndNil(NativeSpinEdit);
     1650  inherited;
     1651end;
     1652
     1653{ TDpiMemo }
     1654
     1655function TDpiMemo.GetLines: TStrings;
     1656begin
     1657  Result := GetNativeMemo.Lines;
     1658end;
     1659
     1660procedure TDpiMemo.SetLines(AValue: TStrings);
     1661begin
     1662  GetNativeMemo.Lines := AValue;
     1663end;
     1664
     1665procedure TDpiMemo.Clear;
     1666begin
     1667  GetNativeMemo.Clear;
     1668end;
     1669
     1670function TDpiMemo.GetNativeMemo: TMemo;
     1671begin
     1672  if not Assigned(NativeMemo) then NativeMemo := TMemo.Create(nil);
     1673    Result := NativeMemo;
     1674end;
     1675
     1676constructor TDpiMemo.Create(TheOwner: TComponent);
     1677begin
     1678  inherited Create(TheOwner);
     1679end;
     1680
     1681destructor TDpiMemo.Destroy;
     1682begin
     1683  FreeAndNil(NativeMemo);
     1684  inherited;
     1685end;
     1686
     1687{ TDpiImageList }
     1688
     1689function TDpiImageList.GetHeight: Integer;
     1690begin
     1691
     1692end;
     1693
     1694function TDpiImageList.GetCount: Integer;
     1695begin
     1696
     1697end;
     1698
     1699function TDpiImageList.GetWidth: Integer;
     1700begin
     1701
     1702end;
     1703
     1704procedure TDpiImageList.SetHeight(AValue: Integer);
     1705begin
     1706
     1707end;
     1708
     1709procedure TDpiImageList.SetWidth(AValue: Integer);
     1710begin
     1711
     1712end;
     1713
     1714function TDpiImageList.GetNativeImageList: TImageList;
     1715begin
     1716  if not Assigned(NativeImageList) then NativeImageList := TImageList.Create(nil);
     1717    Result := NativeImageList;
     1718end;
     1719
     1720procedure TDpiImageList.GetBitmap(Index: Integer; Image: TDpiBitmap);
     1721begin
     1722
     1723end;
     1724
     1725procedure TDpiImageList.BeginUpdate;
     1726begin
     1727
     1728end;
     1729
     1730procedure TDpiImageList.EndUpdate;
     1731begin
     1732
     1733end;
     1734
     1735procedure TDpiImageList.Clear;
     1736begin
     1737
     1738end;
     1739
     1740function TDpiImageList.Add(Image, Mask: TDpiBitmap): Integer;
     1741begin
     1742
     1743end;
     1744
     1745constructor TDpiImageList.Create(TheOwner: TComponent);
     1746begin
     1747  inherited Create(TheOwner);
     1748end;
     1749
     1750destructor TDpiImageList.Destroy;
     1751begin
     1752  FreeAndNil(NativeImageList);
     1753  inherited Destroy;
     1754end;
     1755
     1756{ TDpiCoolBands }
     1757
     1758procedure TDpiCoolBands.SetItem(Index: Integer; AValue: TDpiCoolBand);
     1759begin
     1760
     1761end;
     1762
     1763function TDpiCoolBands.GetItem(Index: Integer): TDpiCoolBand;
     1764begin
     1765
     1766end;
     1767
     1768{ TDpiCoolBand }
     1769
     1770function TDpiCoolBand.GetMinWidth: Integer;
     1771begin
     1772
     1773end;
     1774
     1775function TDpiCoolBand.GetMinHeight: Integer;
     1776begin
     1777
     1778end;
     1779
     1780procedure TDpiCoolBand.SetMinHeight(AValue: Integer);
     1781begin
     1782
     1783end;
     1784
     1785procedure TDpiCoolBand.SetMinWidth(AValue: Integer);
     1786begin
     1787
     1788end;
     1789
     1790function TDpiCoolBand.GetNativeCoolBand: TCoolBand;
     1791begin
     1792
     1793end;
     1794
     1795constructor TDpiCoolBand.Create(TheOwner: TComponent);
     1796begin
     1797  inherited Create(TheOwner);
     1798end;
     1799
     1800destructor TDpiCoolBand.Destroy;
     1801begin
     1802  inherited Destroy;
     1803end;
     1804
     1805{ TDpiCoolBar }
     1806
     1807function TDpiCoolBar.GetBands: TDpiCoolBands;
     1808begin
     1809
     1810end;
     1811
     1812function TDpiCoolBar.GetThemed: Boolean;
     1813begin
     1814  Result := GetNativeCoolBar.Themed;
     1815end;
     1816
     1817procedure TDpiCoolBar.SetBands(AValue: TDpiCoolBands);
     1818begin
     1819
     1820end;
     1821
     1822procedure TDpiCoolBar.SetThemed(AValue: Boolean);
     1823begin
     1824  GetNativeCoolBar.Themed := AValue
     1825end;
     1826
     1827procedure TDpiCoolBar.BeginUpdate;
     1828begin
     1829  GetNativeCoolBar.BeginUpdate;
     1830end;
     1831
     1832procedure TDpiCoolBar.EndUpdate;
     1833begin
     1834  GetNativeCoolBar.EndUpdate;
     1835end;
     1836
     1837function TDpiCoolBar.GetNativeCoolBar: TCoolBar;
     1838begin
     1839  if not Assigned(NativeCoolBar) then NativeCoolBar := TCoolBar.Create(nil);
     1840    Result := NativeCoolBar;
     1841end;
     1842
     1843constructor TDpiCoolBar.Create(TheOwner: TComponent);
     1844begin
     1845  inherited Create(TheOwner);
     1846end;
     1847
     1848destructor TDpiCoolBar.Destroy;
     1849begin
     1850  FreeAndNil(NativeCoolBar);
     1851  inherited Destroy;
     1852end;
     1853
     1854{ TDpiToolBar }
     1855
     1856function TDpiToolBar.ButtonHeightIsStored: Boolean;
     1857begin
     1858
     1859end;
     1860
     1861function TDpiToolBar.ButtonWidthIsStored: Boolean;
     1862begin
     1863
     1864end;
     1865
     1866function TDpiToolBar.GetButtonHeight: Integer;
     1867begin
     1868  Result := ScaleFromNative(GetNativeToolBar.ButtonHeight);
     1869end;
     1870
     1871function TDpiToolBar.GetButtonWidth: Integer;
     1872begin
     1873  Result := ScaleFromNative(GetNativeToolBar.ButtonWidth);
     1874end;
     1875
     1876procedure TDpiToolBar.SetButtonHeight(AValue: Integer);
     1877begin
     1878  GetNativeToolBar.ButtonHeight := ScaleToNative(AValue);
     1879end;
     1880
     1881procedure TDpiToolBar.SetButtonWidth(AValue: Integer);
     1882begin
     1883  GetNativeToolBar.ButtonWidth := ScaleToNative(AValue);
     1884end;
     1885
     1886function TDpiToolBar.GetNativeToolBar: TToolBar;
     1887begin
     1888  if not Assigned(NativeToolBar) then NativeToolBar := TToolBar.Create(nil);
     1889    Result := NativeToolBar;
     1890end;
     1891
     1892constructor TDpiToolBar.Create(TheOwner: TComponent);
     1893begin
     1894  inherited Create(TheOwner);
     1895end;
     1896
     1897destructor TDpiToolBar.Destroy;
     1898begin
     1899  FreeAndNil(NativeToolBar);
     1900  inherited;
     1901end;
     1902
     1903{ TDpiPanel }
     1904
     1905function TDpiPanel.GetNativePanel: TPanel;
     1906begin
     1907  if not Assigned(NativePanel) then NativePanel := TPanel.Create(nil);
     1908    Result := NativePanel;
     1909end;
     1910
     1911constructor TDpiPanel.Create(TheOwner: TComponent);
     1912begin
     1913  inherited Create(TheOwner);
     1914end;
     1915
     1916destructor TDpiPanel.Destroy;
     1917begin
     1918  FreeAndNil(NativePanel);
     1919  inherited;
     1920end;
     1921
     1922{ TDpiStringGrid }
     1923
     1924function TDpiStringGrid.DefaultRowHeightIsStored: Boolean;
     1925begin
     1926  Result := GetDefRowHeight>=0;
     1927end;
     1928
     1929function TDpiStringGrid.GetDefRowHeight: Integer;
     1930begin
     1931  Result := GetNativeStringGrid.DefaultRowHeight;
     1932end;
     1933
     1934procedure TDpiStringGrid.SetDefRowHeight(AValue: Integer);
     1935begin
     1936  GetNativeStringGrid.DefaultRowHeight := AValue;
     1937end;
     1938
     1939function TDpiStringGrid.GetNativeStringGrid: TStringGrid;
     1940begin
     1941  if not Assigned(NativeStringGrid) then NativeStringGrid := TStringGrid.Create(nil);
     1942    Result := NativeStringGrid;
     1943end;
     1944
     1945constructor TDpiStringGrid.Create(TheOwner: TComponent);
     1946begin
     1947  inherited Create(TheOwner);
     1948end;
     1949
     1950destructor TDpiStringGrid.Destroy;
     1951begin
     1952  FreeAndNil(NativeStringGrid);
     1953  inherited;
     1954end;
     1955
     1956{ TDpiListView }
     1957
     1958function TDpiListView.GetItems: TListItems;
     1959begin
     1960  Result := GetNativeListView.Items;
     1961end;
     1962
     1963function TDpiListView.GetColumns: TListColumns;
     1964begin
     1965  Result := NativeListView.Columns;
     1966end;
     1967
     1968procedure TDpiListView.SetColumns(AValue: TListColumns);
     1969begin
     1970  NativeListView.Columns := AValue;
     1971end;
     1972
     1973procedure TDpiListView.SetItems(AValue: TListItems);
     1974begin
     1975  GetNativeListView.Items := AValue;
     1976end;
     1977
     1978function TDpiListView.GetNativeListView: TListView;
     1979begin
     1980  if not Assigned(NativeListView) then NativeListView := TListView.Create(nil);
     1981    Result := NativeListView;
     1982end;
     1983
     1984constructor TDpiListView.Create(TheOwner: TComponent);
     1985begin
     1986  inherited Create(TheOwner);
     1987end;
     1988
     1989destructor TDpiListView.Destroy;
     1990begin
     1991  FreeAndNil(NativeListView);
     1992  inherited;
    12441993end;
    12451994
     
    16712420    raise EMenuError.Create(SMenuNotFound);
    16722421  Delete(I);
     2422end;
     2423
     2424procedure TDpiMenuItem.Clear;
     2425begin
     2426  GetNativeMenuItem.Clear;
    16732427end;
    16742428
     
    18812635begin
    18822636  Result := Application.Active;
     2637end;
     2638
     2639function TDpiApplication.GetExeName: string;
     2640begin
     2641  Result := GetNativeApplication.ExeName;
    18832642end;
    18842643
     
    22102969begin
    22112970  Result := nil;
     2971end;
     2972
     2973procedure TDpiRasterImage.BeginUpdate(ACanvasOnly: Boolean);
     2974begin
     2975  GetNativeRasterImage.BeginUpdate(ACanvasOnly);
     2976end;
     2977
     2978procedure TDpiRasterImage.EndUpdate(AStreamIsValid: Boolean);
     2979begin
     2980  GetNativeRasterImage.EndUpdate(AStreamIsValid);
    22122981end;
    22132982
     
    23493118end;
    23503119
     3120function TDpiBitmap.GetTransparent: Boolean;
     3121begin
     3122  Result := GetNativeBitmap.Transparent;
     3123end;
     3124
     3125function TDpiBitmap.GetTransparentColor: TColor;
     3126begin
     3127  Result := GetNativeBitmap.TransparentColor;
     3128end;
     3129
    23513130function TDpiBitmap.GetWidth: Integer;
    23523131begin
     
    23633142begin
    23643143  GetNativeBitmap.PixelFormat := AValue;
     3144end;
     3145
     3146procedure TDpiBitmap.SetTransparent(AValue: Boolean);
     3147begin
     3148  GetNativeBitmap.Transparent := AValue;
     3149end;
     3150
     3151procedure TDpiBitmap.SetTransparentColor(AValue: TColor);
     3152begin
     3153  GetNativeBitmap.TransparentColor := AValue;
    23653154end;
    23663155
     
    24783267end;
    24793268
     3269function TDpiListBox.GetOnSelectionChange: TSelectionChangeEvent;
     3270begin
     3271  Result := GetNativeListBox.OnSelectionChange;
     3272end;
     3273
    24803274function TDpiListBox.GetParentFont: Boolean;
    24813275begin
     
    25213315begin
    25223316  GetNativeListBox.Items := AValue;
     3317end;
     3318
     3319procedure TDpiListBox.SetOnSelectionChange(AValue: TSelectionChangeEvent);
     3320begin
     3321  GetNativeListBox.OnSelectionChange := AValue;
    25233322end;
    25243323
     
    26313430begin
    26323431  GetNativeCanvas.Handle := AValue;
     3432end;
     3433
     3434procedure TDpiCanvas.SetHeight(AValue: Integer);
     3435begin
     3436  GetNativeCanvas.Height;
     3437end;
     3438
     3439procedure TDpiCanvas.SetWidth(AValue: Integer);
     3440begin
     3441
    26333442end;
    26343443
     
    27113520end;
    27123521
    2713 procedure TDpiCanvas.TextOut(X, Y: Integer; Text: string);
     3522procedure TDpiCanvas.TextOut(X, Y: Integer; const Text: string);
    27143523begin
    27153524  GetNativeCanvas.TextOut(ScaleToNative(X), ScaleToNative(Y), Text);
     
    27313540end;
    27323541
    2733 procedure TDpiCanvas.FillRect(ARect: TRect);
     3542procedure TDpiCanvas.FillRect(const ARect: TRect);
    27343543begin
    27353544  GetNativeCanvas.FillRect(ScaleRectToNative(ARect));
     
    30123821end;
    30133822
     3823procedure TDpiFont.GetTextSize(Text: string; var w, h: Integer);
     3824begin
     3825  W := GetTextWidth(Text);
     3826  H := GetTextHeight(Text);
     3827end;
     3828
     3829function TDpiFont.GetTextHeight(Text: string): Integer;
     3830begin
     3831  Result := ScaleFromNative(GetNativeFont.GetTextHeight(Text));
     3832end;
     3833
     3834function TDpiFont.GetTextWidth(Text: string): Integer;
     3835begin
     3836  Result := ScaleFromNative(GetNativeFont.GetTextWidth(Text));
     3837end;
     3838
    30143839{ TDpiWinControl }
    30153840
     
    31884013    //DpiApplication.UpdateVisible;
    31894014  end;
     4015end;
     4016
     4017function TDpiScreen.GetDesktopHeight: Integer;
     4018begin
     4019  Result := ScaleFromNative(Screen.DesktopHeight);
     4020end;
     4021
     4022function TDpiScreen.GetDesktopLeft: Integer;
     4023begin
     4024  Result := ScaleFromNative(Screen.DesktopLeft);
     4025end;
     4026
     4027function TDpiScreen.GetDesktopTop: Integer;
     4028begin
     4029  Result := ScaleFromNative(Screen.DesktopTop);
     4030end;
     4031
     4032function TDpiScreen.GetDesktopWidth: Integer;
     4033begin
     4034  Result := ScaleFromNative(Screen.DesktopWidth);
    31904035end;
    31914036
     
    32204065  for I := 0 to FForms.Count - 1 do
    32214066    FForms[I].ScreenChanged;
     4067end;
     4068
     4069function TDpiScreen.DisableForms(SkipForm: TDpiForm; DisabledList: TList
     4070  ): TList;
     4071begin
     4072  Result := Screen.DisableForms(SkipForm.GetNativeForm, DisabledList);
     4073end;
     4074
     4075procedure TDpiScreen.EnableForms(var AFormList: TList);
     4076begin
     4077  Screen.EnableForms(AFormList);
    32224078end;
    32234079
     
    34544310end;
    34554311
     4312procedure TDpiControl.Refresh;
     4313begin
     4314  GetNativeControl.Refresh;
     4315end;
     4316
    34564317function TDpiControl.IsParentOf(AControl: TDpiControl): boolean;
    34574318begin
     
    34634324      Exit(True);
    34644325  end;
     4326end;
     4327
     4328function TDpiControl.Scale96ToScreen(const ASize: Integer): Integer;
     4329begin
     4330  Result := MulDiv(ASize, Screen.PixelsPerInch, 96);
    34654331end;
    34664332
     
    35444410end;
    35454411
     4412function TDpiControl.GetAutoSize: Boolean;
     4413begin
     4414  Result := GetNativeControl.AutoSize;
     4415end;
     4416
    35464417function TDpiControl.GetClientHeight: Integer;
    35474418begin
     
    36174488begin
    36184489  GetNativeControl.Anchors := AValue;
     4490end;
     4491
     4492procedure TDpiControl.SetAutoSize(AValue: Boolean);
     4493begin
     4494  GetNativeControl.AutoSize := AValue;
    36194495end;
    36204496
     
    38464722begin
    38474723  Result := GetNativeForm.Position;
     4724end;
     4725
     4726function TDpiForm.GetRestoredHeight: Integer;
     4727begin
     4728  Result := ScaleFromNative(GetNativeForm.RestoredHeight);
     4729end;
     4730
     4731function TDpiForm.GetRestoredLeft: Integer;
     4732begin
     4733  Result := ScaleFromNative(GetNativeForm.RestoredLeft);
     4734end;
     4735
     4736function TDpiForm.GetRestoredTop: Integer;
     4737begin
     4738  Result := ScaleFromNative(GetNativeForm.RestoredTop);
     4739end;
     4740
     4741function TDpiForm.GetRestoredWidth: Integer;
     4742begin
     4743  Result := ScaleFromNative(GetNativeForm.RestoredWidth);
    38484744end;
    38494745
  • branches/highdpi/Settings.lfm

    r349 r405  
    1010  DesignTimePPI = 144
    1111  FormStyle = fsStayOnTop
     12  OnClose = FormClose
    1213  OnCreate = FormCreate
    1314  OnDestroy = FormDestroy
     
    1718  LCLVersion = '2.0.12.0'
    1819  Scaled = False
    19   object List: TDpiListBox
     20  object ListLanguages: TDpiListBox
    2021    Tag = 15360
    21     Left = 24
    22     Height = 304
    23     Top = 16
    24     Width = 424
    25     Anchors = [akTop, akLeft, akRight, akBottom]
     22    Left = 16
     23    Height = 267
     24    Top = 32
     25    Width = 144
    2626    BorderStyle = bsNone
    2727    Color = clBlack
     
    3434    ItemHeight = 0
    3535    ParentFont = False
    36     ScrollWidth = 424
    37     TabOrder = 0
     36    ScrollWidth = 144
     37    TabOrder = 1
    3838    TabStop = False
    3939    TopIndex = -1
    4040  end
    41   object OKBtn: TButtonA
    42     Left = 272
     41  object ButtonOk: TButtonA
     42    Left = 364
    4343    Height = 25
    4444    Top = 400
     
    4646    Down = False
    4747    Permanent = False
    48     OnClick = OKBtnClick
     48    OnClick = ButtonOkClick
    4949  end
    50   object CancelBtn: TButtonA
    51     Left = 96
     50  object ButtonCancel: TButtonA
     51    Left = 244
    5252    Height = 25
    5353    Top = 400
     
    5555    Down = False
    5656    Permanent = False
    57     OnClick = CancelBtnClick
     57    OnClick = ButtonCancelClick
    5858  end
    5959  object ButtonFullscreen: TButtonC
     
    8989    ButtonIndex = 0
    9090  end
     91  object ListKeyBindings: TDpiListBox
     92    Tag = 15360
     93    Left = 176
     94    Height = 192
     95    Top = 32
     96    Width = 288
     97    BorderStyle = bsNone
     98    Color = clBlack
     99    ExtendedSelect = False
     100    Font.Color = 4176863
     101    Font.Height = -15
     102    Font.Name = 'Times New Roman'
     103    Font.Style = [fsBold]
     104    IntegralHeight = True
     105    ItemHeight = 0
     106    OnSelectionChange = ListKeyBindingsSelectionChange
     107    ParentFont = False
     108    ScrollWidth = 288
     109    TabOrder = 0
     110    TabStop = False
     111    TopIndex = -1
     112  end
     113  object EditShortCutPrimary: TDpiEdit
     114    Left = 176
     115    Height = 42
     116    Top = 256
     117    Width = 136
     118    Enabled = False
     119    OnKeyUp = EditShortCutPrimaryKeyUp
     120    TabOrder = 2
     121  end
     122  object EditShortCutSecondary: TDpiEdit
     123    Left = 328
     124    Height = 42
     125    Top = 257
     126    Width = 136
     127    Enabled = False
     128    OnKeyUp = EditShortCutSecondaryKeyUp
     129    TabOrder = 3
     130  end
     131  object ButtonReset: TButtonA
     132    Left = 16
     133    Height = 25
     134    Top = 400
     135    Width = 100
     136    Down = False
     137    Permanent = False
     138    OnClick = ButtonResetClick
     139  end
    91140end
  • branches/highdpi/Settings.pas

    r361 r405  
    77uses
    88  UDpiControls, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
    9   ScreenTools, Messg, ButtonA, Registry, fgl, Directories, DrawDlg, ButtonC;
     9  LCLProc, ScreenTools, Messg, ButtonA, Registry, fgl, Directories, DrawDlg,
     10  ButtonC, UKeyBindings, ULanguages;
    1011
    1112type
    12   TLanguage = class
    13     ShortName: string;
    14     FullName: string;
    15     Author: string;
    16   end;
    17 
    18   { TLanguages }
    19 
    20   TLanguages = class(TFPGObjectList<TLanguage>)
    21     procedure AddItem(const ShortName, FullName: string);
    22     procedure LoadToStrings(Strings: TStrings);
    23     function Search(ShortName: string): Integer;
    24   end;
    25 
    2613  { TSettingsDlg }
    2714
     
    2916    ButtonFullscreen: TButtonC;
    3017    Down2Btn: TButtonC;
    31     List: TDpiListBox;
    32     OKBtn: TButtonA;
    33     CancelBtn: TButtonA;
     18    EditShortCutPrimary: TDpiEdit;
     19    EditShortCutSecondary: TDpiEdit;
     20    ListLanguages: TDpiListBox;
     21    ListKeyBindings: TDpiListBox;
     22    ButtonOk: TButtonA;
     23    ButtonCancel: TButtonA;
     24    ButtonReset: TButtonA;
    3425    Up2Btn: TButtonC;
    3526    procedure ButtonFullscreenClick(Sender: TObject);
    36     procedure CancelBtnClick(Sender: TObject);
     27    procedure ButtonCancelClick(Sender: TObject);
     28    procedure ButtonResetClick(Sender: TObject);
    3729    procedure Down2BtnClick(Sender: TObject);
     30    procedure EditShortCutPrimaryKeyUp(Sender: TObject; var Key: Word;
     31      Shift: TShiftState);
     32    procedure EditShortCutSecondaryKeyUp(Sender: TObject; var Key: Word;
     33      Shift: TShiftState);
     34    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    3835    procedure FormCreate(Sender: TObject);
    3936    procedure FormDestroy(Sender: TObject);
    4037    procedure FormPaint(Sender: TObject);
    4138    procedure FormShow(Sender: TObject);
    42     procedure OKBtnClick(Sender: TObject);
     39    procedure ListKeyBindingsSelectionChange(Sender: TObject; User: boolean);
     40    procedure ButtonOkClick(Sender: TObject);
    4341    procedure Up2BtnClick(Sender: TObject);
    4442  private
    4543    LocalGamma: Integer;
     44    LocalKeyBindings: TKeyBindings;
     45    CurrentKeyBinding: TKeyBinding;
     46    procedure UpdateShortCutItem;
    4647  public
    47     Languages: TLanguages;
    4848    procedure LoadData;
    4949    procedure SaveData;
     
    5353  SettingsDlg: TSettingsDlg;
    5454
     55
    5556implementation
    5657
    5758{$R *.lfm}
    5859
    59 { TLanguages }
    60 
    61 procedure TLanguages.AddItem(const ShortName, FullName: string);
    6260var
    63   Language: TLanguage;
    64 begin
    65   Language := TLanguage.Create;
    66   Language.ShortName := ShortName;
    67   Language.FullName := FullName;
    68   Add(Language);
    69 end;
    70 
    71 procedure TLanguages.LoadToStrings(Strings: TStrings);
    72 var
    73   I: Integer;
    74 begin
    75   Strings.Clear;
    76   for I := 0 to Count - 1 do
    77     Strings.Add(Items[I].FullName);
    78 end;
    79 
    80 function TLanguages.Search(ShortName: string): Integer;
    81 var
    82   I: Integer;
    83 begin
    84   I := 0;
    85   while (I < Count) and (Items[I].ShortName <> ShortName) do Inc(I);
    86   if I < Count then Result := I
    87     else Result := -1;
     61  SFullScreen, SGamma, SRestartMsg, SShortCutPrimary, SShortCutSecondary,
     62  SLanguages, SKeyBindings: string;
     63
     64procedure ReloadLanguages;
     65begin
     66  SFullScreen := Phrases.Lookup('SETTINGS', 0);
     67  SGamma := Phrases.Lookup('SETTINGS', 1);
     68  SRestartMsg := Phrases.Lookup('SETTINGS', 2);
     69  SShortCutPrimary := Phrases.Lookup('SETTINGS', 3);
     70  SShortCutSecondary := Phrases.Lookup('SETTINGS', 4);
     71  SLanguages := Phrases.Lookup('SETTINGS', 5);
     72  SKeyBindings := Phrases.Lookup('SETTINGS', 6);
    8873end;
    8974
     
    9277procedure TSettingsDlg.FormCreate(Sender: TObject);
    9378begin
     79  LocalKeyBindings := TKeyBindings.Create;
     80
    9481  Canvas.Font.Assign(UniFont[ftNormal]);
    9582  Canvas.Brush.Style := bsClear;
    9683
    97   Languages := TLanguages.Create;
    98   Languages.AddItem('', 'System');
    99   Languages.AddItem('cs', 'Czech');
    100   Languages.AddItem('de', 'German');
    101   Languages.AddItem('en', 'English');
    102   Languages.AddItem('it', 'Italian');
    103   Languages.AddItem('ru', 'Russian');
    104   Languages.AddItem('zh-Hant', 'Traditional Chinese');
    105   Languages.AddItem('zh-Hans', 'Simplified Chinese');
    106 
    107   OKBtn.Caption := Phrases.Lookup('BTN_OK');
    108   CancelBtn.Caption := Phrases.Lookup('BTN_CANCEL');
     84  ButtonOk.Caption := Phrases.Lookup('BTN_OK');
     85  ButtonCancel.Caption := Phrases.Lookup('BTN_CANCEL');
     86  ButtonReset.Caption := Phrases.Lookup('BTN_RESET');
    10987  InitButtons;
    11088end;
    11189
    112 procedure TSettingsDlg.CancelBtnClick(Sender: TObject);
     90procedure TSettingsDlg.ButtonCancelClick(Sender: TObject);
    11391begin
    11492  ModalResult := mrCancel;
     93end;
     94
     95procedure TSettingsDlg.ButtonResetClick(Sender: TObject);
     96begin
     97  ListLanguages.ItemIndex := 0;
     98  ButtonFullscreen.ButtonIndex := 3;
     99  LocalGamma := 100;
     100  ListKeyBindings.ItemIndex := -1;
     101  ListKeyBindingsSelectionChange(nil, False);
     102  LocalKeyBindings.ResetToDefault;
     103  LocalKeyBindings.LoadToStrings(ListKeyBindings.Items);
     104  Repaint;
    115105end;
    116106
     
    124114end;
    125115
     116procedure TSettingsDlg.EditShortCutPrimaryKeyUp(Sender: TObject; var Key: Word;
     117  Shift: TShiftState);
     118begin
     119  if Assigned(CurrentKeyBinding) and not (Key in [16..18]) then begin
     120    CurrentKeyBinding.ShortCut := Key or
     121      (scShift * Integer(ssShift in Shift)) or
     122      (scCtrl * Integer(ssCtrl in Shift)) or
     123      (scAlt * Integer(ssAlt in Shift));
     124    EditShortCutPrimary.Text := ShortCutToText(CurrentKeyBinding.ShortCut);
     125    Key := 0;
     126    UpdateShortCutItem;
     127  end;
     128end;
     129
     130procedure TSettingsDlg.EditShortCutSecondaryKeyUp(Sender: TObject;
     131  var Key: Word; Shift: TShiftState);
     132begin
     133  if Assigned(CurrentKeyBinding) and not (Key in [16..18]) then begin
     134    CurrentKeyBinding.ShortCut2 := Key or
     135      (scShift * Integer(ssShift in Shift)) or
     136      (scCtrl * Integer(ssCtrl in Shift)) or
     137      (scAlt * Integer(ssAlt in Shift));
     138    EditShortCutSecondary.Text := ShortCutToText(CurrentKeyBinding.ShortCut2);
     139    Key := 0;
     140    UpdateShortCutItem;
     141  end;
     142end;
     143
     144procedure TSettingsDlg.FormClose(Sender: TObject; var CloseAction: TCloseAction
     145  );
     146begin
     147  ListKeyBindings.ItemIndex := -1;
     148end;
     149
    126150procedure TSettingsDlg.ButtonFullscreenClick(Sender: TObject);
    127151begin
     
    131155procedure TSettingsDlg.FormDestroy(Sender: TObject);
    132156begin
    133   FreeAndNil(Languages);
     157  FreeAndNil(LocalKeyBindings);
    134158end;
    135159
    136160procedure TSettingsDlg.FormPaint(Sender: TObject);
    137 var
    138   S: string;
    139161begin
    140162  PaintBackground(self, 3, 3, ClientWidth - 6, ClientHeight - 6);
     
    144166  Frame(Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3,
    145167    MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
    146   EditFrame(Canvas, List.BoundsRect, MainTexture);
    147   BtnFrame(Canvas, OKBtn.BoundsRect, MainTexture);
    148   BtnFrame(Canvas, CancelBtn.BoundsRect, MainTexture);
     168  EditFrame(Canvas, ListLanguages.BoundsRect, MainTexture);
     169  BtnFrame(Canvas, ButtonOk.BoundsRect, MainTexture);
     170  BtnFrame(Canvas, ButtonCancel.BoundsRect, MainTexture);
    149171
    150172  RFrame(Canvas, ButtonFullscreen.Left - 1, ButtonFullscreen.Top - 1,
     
    152174    MainTexture.ColorBevelLight);
    153175
    154   S := Phrases.Lookup('SETTINGS', 0);
     176  LoweredTextOut(Canvas, -2, MainTexture, ListLanguages.Left,
     177    ListLanguages.Top - 26, SLanguages);
     178  LoweredTextOut(Canvas, -2, MainTexture, ListKeyBindings.Left,
     179    ListKeyBindings.Top - 26, SKeyBindings);
    155180  LoweredTextOut(Canvas, -2, MainTexture, ButtonFullscreen.Left + 32,
    156     ButtonFullscreen.Top - 4, S);
    157 
    158   // Gamma
    159   UnderlinedTitleValue(Canvas, Phrases.Lookup('SETTINGS', 1), IntToStr(LocalGamma) + '%',
     181    ButtonFullscreen.Top - 4, SFullScreen);
     182  UnderlinedTitleValue(Canvas, SGamma, IntToStr(LocalGamma) + '%',
    160183    Up2Btn.Left - 150 - 4, Up2Btn.Top + 2, 150);
     184  LoweredTextOut(Canvas, -2, MainTexture, EditShortCutPrimary.Left,
     185    EditShortCutPrimary.Top - 26, SShortCutPrimary);
     186  LoweredTextOut(Canvas, -2, MainTexture, EditShortCutSecondary.Left,
     187    EditShortCutSecondary.Top - 26, SShortCutSecondary);
    161188end;
    162189
    163190procedure TSettingsDlg.FormShow(Sender: TObject);
    164191begin
    165   Languages.LoadToStrings(List.Items);
    166   List.Font.Color := MainTexture.ColorMark;
     192  ReloadLanguages;
     193  Languages.LoadToStrings(ListLanguages.Items);
     194  ListLanguages.Font.Color := MainTexture.ColorMark;
     195  ListKeyBindings.Font.Color := MainTexture.ColorMark;
    167196  LoadData;
    168 end;
    169 
    170 procedure TSettingsDlg.OKBtnClick(Sender: TObject);
     197  LocalKeyBindings.LoadToStrings(ListKeyBindings.Items);
     198end;
     199
     200procedure TSettingsDlg.ListKeyBindingsSelectionChange(Sender: TObject;
     201  User: boolean);
     202begin
     203  if Assigned(CurrentKeyBinding) then begin
     204    CurrentKeyBinding.ShortCut := TextToShortCut(EditShortCutPrimary.Text);
     205    CurrentKeyBinding.ShortCut2 := TextToShortCut(EditShortCutSecondary.Text);
     206  end;
     207
     208  if ListKeyBindings.ItemIndex >= 0 then
     209    CurrentKeyBinding := LocalKeyBindings[ListKeyBindings.ItemIndex]
     210    else CurrentKeyBinding := nil;
     211
     212  if Assigned(CurrentKeyBinding) then begin
     213    if CurrentKeyBinding.ShortCut <> 0 then
     214      EditShortCutPrimary.Text := ShortCutToText(CurrentKeyBinding.ShortCut)
     215      else EditShortCutPrimary.Text := '';
     216    EditShortCutPrimary.Enabled := True;
     217    if CurrentKeyBinding.ShortCut2 <> 0 then
     218      EditShortCutSecondary.Text := ShortCutToText(CurrentKeyBinding.ShortCut2)
     219      else EditShortCutSecondary.Text := '';
     220    EditShortCutSecondary.Enabled := True;
     221  end else begin
     222    EditShortCutPrimary.Text := '';
     223    EditShortCutPrimary.Enabled := False;
     224    EditShortCutSecondary.Text := '';
     225    EditShortCutSecondary.Enabled := False;
     226  end;
     227end;
     228
     229procedure TSettingsDlg.ButtonOkClick(Sender: TObject);
    171230begin
    172231  SaveData;
     
    182241end;
    183242
     243procedure TSettingsDlg.UpdateShortCutItem;
     244begin
     245  if Assigned(CurrentKeyBinding) then begin
     246    if CurrentKeyBinding.ShortCut > 0 then
     247      LocalKeyBindings.RemoveShortCut(CurrentKeyBinding.ShortCut);
     248    if CurrentKeyBinding.ShortCut2 > 0 then
     249      LocalKeyBindings.RemoveShortCut(CurrentKeyBinding.ShortCut2);
     250    CurrentKeyBinding.ShortCut := TextToShortCut(EditShortCutPrimary.Text);
     251    CurrentKeyBinding.ShortCut2 := TextToShortCut(EditShortCutSecondary.Text);
     252    LocalKeyBindings.LoadToStrings(ListKeyBindings.Items);
     253  end;
     254end;
     255
    184256procedure TSettingsDlg.LoadData;
    185257begin
    186   List.ItemIndex := Languages.Search(LocaleCode);
    187   if (List.ItemIndex = -1) and (Languages.Count > 0) then
    188     List.ItemIndex := 0;
     258  ListLanguages.ItemIndex := Languages.Search(LocaleCode);
     259  if (ListLanguages.ItemIndex = -1) and (Languages.Count > 0) then
     260    ListLanguages.ItemIndex := 0;
    189261  if FullScreen then ButtonFullscreen.ButtonIndex := 3
    190262    else ButtonFullscreen.ButtonIndex := 2;
    191263  LocalGamma := Gamma;
     264  LocalKeyBindings.Assign(KeyBindings);
    192265end;
    193266
     
    197270begin
    198271  NeedRestart := Gamma <> LocalGamma;
    199   LocaleCode := Languages[List.ItemIndex].ShortName;
     272  LocaleCode := Languages[ListLanguages.ItemIndex].ShortName;
    200273  FullScreen := (ButtonFullscreen.ButtonIndex and 1) = 1;
    201274  Gamma := LocalGamma;
    202   if NeedRestart then SimpleMessage(Phrases.Lookup('SETTINGS', 2));
     275  if NeedRestart then SimpleMessage(SRestartMsg);
     276  KeyBindings.Assign(LocalKeyBindings);
    203277end;
    204278
  • branches/highdpi/Start.pas

    r378 r405  
    428428    Free;
    429429  end;
     430
     431  KeyBindings.LoadFromRegistry(HKEY_CURRENT_USER, AppRegistryKey + '\KeyBindings');
    430432end;
    431433
     
    450452    Free;
    451453  end;
     454
     455  KeyBindings.SaveToRegistry(HKEY_CURRENT_USER, AppRegistryKey + '\KeyBindings');
    452456end;
    453457
     
    16241628  f: file;
    16251629  ok: boolean;
     1630  MapPictureFileName: string;
    16261631begin
    16271632  if List.ItemIndex >= 0 then
     
    16441649        begin
    16451650          SimpleMessage(Format(Phrases.Lookup('NOFILENAME'), [NewName[i]]));
    1646           exit
     1651          Exit;
    16471652        end;
    16481653      if Page = pgLoad then
     
    16591664      except
    16601665        // Play('INVALID');
    1661         ok := false
    1662       end;
    1663       if Page <> pgLoad then
    1664         try // rename map picture
     1666        ok := False;
     1667      end;
     1668      if Page <> pgLoad then begin
     1669        // Rename map picture
     1670        MapPictureFileName := GetMapsDir + DirectorySeparator +
     1671          List.Items[List.ItemIndex] + CevoMapPictureExt;
     1672        if FileExists(MapPictureFileName) then
     1673        try
    16651674          AssignFile(f, GetMapsDir + DirectorySeparator + List.Items[List.ItemIndex]
    1666             + '.png');
    1667           Rename(f, GetMapsDir + DirectorySeparator + NewName + '.png');
     1675            + CevoMapPictureExt);
     1676          Rename(f, GetMapsDir + DirectorySeparator + NewName + CevoMapPictureExt);
    16681677        except
    16691678        end;
    1670       if ok then
    1671       begin
     1679      end;
     1680      if ok then begin
    16721681        if Page = pgLoad then
    16731682          FormerGames[List.ItemIndex] := NewName
  • branches/highdpi/UMiniMap.pas

    r349 r405  
    115115  ImageFileName: string;
    116116begin
    117   ImageFileName := Copy(FileName, 1, Length(FileName) - Length(CevoMapExt)) + '.png';
     117  ImageFileName := Copy(FileName, 1, Length(FileName) - Length(CevoMapExt)) + CevoMapPictureExt;
    118118  Mode := mmPicture;
    119119  if LoadGraphicFile(Bitmap, ImageFileName, [gfNoError]) then
  • branches/highdpi/readme.txt

    r349 r405  
    2929== Release new version ==
    3030
    31 * Update version in GameServer.pas Version constant.
     31* Update version in Global.pas CevoVersion constants.
    3232* Update version in Install\win\Common.iss MyAppVersion define.
    3333* Update version in Install\rpm\c-evo.spec Version field.
Note: See TracChangeset for help on using the changeset viewer.