Changeset 178


Ignore:
Timestamp:
Jun 23, 2019, 3:15:29 PM (6 years ago)
Author:
chronos
Message:
  • Modified: Use DpiControls package for High DPI support.
Location:
branches/highdpi
Files:
4 added
50 edited

Legend:

Unmodified
Added
Removed

  • branches/highdpi/Back.lfm

    r10 r178  
    11object Background: TBackground
    22  Left = 581
    3   Height = 172
     3  Height = 258
    44  Top = 638
    5   Width = 202
     5  Width = 303
    66  BorderIcons = []
    77  BorderStyle = bsNone
    88  Caption = 'C-evo'
    99  Color = clBlack
     10  DesignTimePPI = 144
    1011  Font.Color = clWindowText
    11   Font.Height = -13
     12  Font.Height = -20
    1213  Font.Name = 'MS Sans Serif'
    1314  OnClose = FormClose
    … …  
    1617  OnPaint = FormPaint
    1718  OnShow = FormShow
    18   LCLVersion = '1.6.2.0'
     19  LCLVersion = '2.0.2.0'
    1920  WindowState = wsMaximized
    2021end

  • branches/highdpi/Back.pas

    r105 r178  
    55
    66uses
    7   LCLIntf, LCLType, SysUtils, Classes, Graphics, Forms, Controls;
     7  LCLIntf, LCLType, SysUtils, Classes, Graphics, Forms, Controls, UDpiControls;
    88
    99type
    … …  
    1818    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    1919  private
    20     Img: TBitmap;
     20    Img: TDpiBitmap;
    2121  end;
    2222
    … …  
    4444      FileName := HomeDir + 'Graphics' + DirectorySeparator + 'Background.png';
    4545      if FileExists(FileName) then begin
    46         Img := TBitmap.Create;
     46        Img := TDpiBitmap.Create;
    4747        LoadGraphicFile(img, FileName);
    4848      end;

  • branches/highdpi/GameServer.pas

    r169 r178  
    77
    88uses
    9   Protocol, Database, dynlibs, Platform, dateutils, fgl, FileUtil, Graphics;
     9  Protocol, Database, dynlibs, Platform, dateutils, fgl, FileUtil, Graphics,
     10  UDpiControls;
    1011
    1112const
    … …  
    7172    Initialized: Boolean;
    7273    Kind: TBrainType;
    73     Picture: TBitmap;
     74    Picture: TDpiBitmap;
    7475    procedure LoadFromFile(AIFileName: string);
    7576    constructor Create;
    … …  
    556557  s: string[255];
    557558begin
    558   MapFile := TFileStream.Create(GetMapsDir + DirectorySeparator + FileName,
     559  MapFile := TFileStream.Create(DataDir + 'Maps' + DirectorySeparator + FileName,
    559560    fmCreate or fmShareExclusive);
    560561  MapFile.Position := 0;
    … …  
    579580  MapFile := nil;
    580581  try
    581     MapFile := TFileStream.Create(GetMapsDir + DirectorySeparator + FileName,
     582    MapFile := TFileStream.Create(DataDir + 'Maps' + DirectorySeparator + FileName,
    582583      fmOpenRead or fmShareExclusive);
    583584    MapFile.Position := 0;

  • branches/highdpi/Install/deb/debian/control

    r173 r178  
    88Package: c-evo
    99Architecture: any
    10 Depends: ${shlibs:Depends}, ${misc:Depends}, sox, libsox-fmt-mp3
     10Depends: ${shlibs:Depends}, ${misc:Depends},
    1111Description: Empire building game
    1212HomePage: https://app.zdechov.net/c-evo

  • branches/highdpi/Integrated.lpi

    r166 r178  
    8686      </Modes>
    8787    </RunParams>
    88     <RequiredPackages Count="2">
     88    <RequiredPackages Count="3">
    8989      <Item1>
     90        <PackageName Value="DpiControls"/>
     91        <DefaultFilename Value="Packages\DpiControls\DpiControls.lpk" Prefer="True"/>
     92      </Item1>
     93      <Item2>
    9094        <PackageName Value="CevoComponents"/>
    9195        <DefaultFilename Value="Packages\CevoComponents\CevoComponents.lpk" Prefer="True"/>
    92       </Item1>
    93       <Item2>
     96      </Item2>
     97      <Item3>
    9498        <PackageName Value="LCL"/>
    95       </Item2>
     99      </Item3>
    96100    </RequiredPackages>
    97     <Units Count="40">
     101    <Units Count="41">
    98102      <Unit0>
    99103        <Filename Value="Integrated.lpr"/>
    … …  
    129133        <ComponentName Value="DirectDlg"/>
    130134        <HasResources Value="True"/>
    131         <ResourceBaseClass Value="Form"/>
    132135      </Unit7>
    133136      <Unit8>
    … …  
    136139        <ComponentName Value="StartDlg"/>
    137140        <HasResources Value="True"/>
    138         <ResourceBaseClass Value="Form"/>
    139141      </Unit8>
    140142      <Unit9>
    … …  
    205207      </Unit20>
    206208      <Unit21>
    207         <Filename Value="LocalPlayer\Help.pas"/>
    208         <IsPartOfProject Value="True"/>
    209         <ComponentName Value="HelpDlg"/>
    210         <HasResources Value="True"/>
    211         <ResourceBaseClass Value="Form"/>
     209        <Filename Value="LocalPlayer\BaseWin.pas"/>
     210        <IsPartOfProject Value="True"/>
    212211      </Unit21>
    213212      <Unit22>
    214         <Filename Value="LocalPlayer\Select.pas"/>
    215         <IsPartOfProject Value="True"/>
    216         <ComponentName Value="ListDlg"/>
     213        <Filename Value="LocalPlayer\Help.pas"/>
     214        <IsPartOfProject Value="True"/>
     215        <ComponentName Value="HelpDlg"/>
    217216        <HasResources Value="True"/>
    218217        <ResourceBaseClass Value="Form"/>
    219218      </Unit22>
    220219      <Unit23>
    221         <Filename Value="LocalPlayer\CityScreen.pas"/>
    222         <IsPartOfProject Value="True"/>
    223         <ComponentName Value="CityDlg"/>
     220        <Filename Value="LocalPlayer\Select.pas"/>
     221        <IsPartOfProject Value="True"/>
     222        <ComponentName Value="ListDlg"/>
    224223        <HasResources Value="True"/>
    225224        <ResourceBaseClass Value="Form"/>
    226225      </Unit23>
    227226      <Unit24>
    228         <Filename Value="LocalPlayer\UnitStat.pas"/>
    229         <IsPartOfProject Value="True"/>
    230         <ComponentName Value="UnitStatDlg"/>
     227        <Filename Value="LocalPlayer\CityScreen.pas"/>
     228        <IsPartOfProject Value="True"/>
     229        <ComponentName Value="CityDlg"/>
    231230        <HasResources Value="True"/>
    232231        <ResourceBaseClass Value="Form"/>
    233232      </Unit24>
    234233      <Unit25>
    235         <Filename Value="LocalPlayer\Draft.pas"/>
    236         <IsPartOfProject Value="True"/>
    237         <ComponentName Value="DraftDlg"/>
     234        <Filename Value="LocalPlayer\UnitStat.pas"/>
     235        <IsPartOfProject Value="True"/>
     236        <ComponentName Value="UnitStatDlg"/>
    238237        <HasResources Value="True"/>
    239238        <ResourceBaseClass Value="Form"/>
    240239      </Unit25>
    241240      <Unit26>
    242         <Filename Value="LocalPlayer\NatStat.pas"/>
    243         <IsPartOfProject Value="True"/>
    244         <ComponentName Value="NatStatDlg"/>
     241        <Filename Value="LocalPlayer\Draft.pas"/>
     242        <IsPartOfProject Value="True"/>
     243        <ComponentName Value="DraftDlg"/>
    245244        <HasResources Value="True"/>
    246245        <ResourceBaseClass Value="Form"/>
    247246      </Unit26>
    248247      <Unit27>
    249         <Filename Value="LocalPlayer\Diagram.pas"/>
    250         <IsPartOfProject Value="True"/>
    251         <ComponentName Value="DiaDlg"/>
     248        <Filename Value="LocalPlayer\NatStat.pas"/>
     249        <IsPartOfProject Value="True"/>
     250        <ComponentName Value="NatStatDlg"/>
    252251        <HasResources Value="True"/>
    253252        <ResourceBaseClass Value="Form"/>
    254253      </Unit27>
    255254      <Unit28>
    256         <Filename Value="LocalPlayer\Wonders.pas"/>
    257         <IsPartOfProject Value="True"/>
    258         <ComponentName Value="WondersDlg"/>
     255        <Filename Value="LocalPlayer\Diagram.pas"/>
     256        <IsPartOfProject Value="True"/>
     257        <ComponentName Value="DiaDlg"/>
    259258        <HasResources Value="True"/>
    260259        <ResourceBaseClass Value="Form"/>
    261260      </Unit28>
    262261      <Unit29>
    263         <Filename Value="LocalPlayer\Nego.pas"/>
    264         <IsPartOfProject Value="True"/>
    265         <ComponentName Value="NegoDlg"/>
     262        <Filename Value="LocalPlayer\Wonders.pas"/>
     263        <IsPartOfProject Value="True"/>
     264        <ComponentName Value="WondersDlg"/>
    266265        <HasResources Value="True"/>
    267266        <ResourceBaseClass Value="Form"/>
    268267      </Unit29>
    269268      <Unit30>
    270         <Filename Value="LocalPlayer\CityType.pas"/>
    271         <IsPartOfProject Value="True"/>
    272         <ComponentName Value="CityTypeDlg"/>
     269        <Filename Value="LocalPlayer\Nego.pas"/>
     270        <IsPartOfProject Value="True"/>
     271        <ComponentName Value="NegoDlg"/>
    273272        <HasResources Value="True"/>
    274273        <ResourceBaseClass Value="Form"/>
    275274      </Unit30>
    276275      <Unit31>
    277         <Filename Value="LocalPlayer\Enhance.pas"/>
    278         <IsPartOfProject Value="True"/>
    279         <ComponentName Value="EnhanceDlg"/>
     276        <Filename Value="LocalPlayer\CityType.pas"/>
     277        <IsPartOfProject Value="True"/>
     278        <ComponentName Value="CityTypeDlg"/>
    280279        <HasResources Value="True"/>
    281280        <ResourceBaseClass Value="Form"/>
    282281      </Unit31>
    283282      <Unit32>
    284         <Filename Value="NoTerm.pas"/>
    285         <IsPartOfProject Value="True"/>
    286         <ComponentName Value="NoTermDlg"/>
     283        <Filename Value="LocalPlayer\Enhance.pas"/>
     284        <IsPartOfProject Value="True"/>
     285        <ComponentName Value="EnhanceDlg"/>
    287286        <HasResources Value="True"/>
    288287        <ResourceBaseClass Value="Form"/>
    289288      </Unit32>
    290289      <Unit33>
    291         <Filename Value="LocalPlayer\Battle.pas"/>
    292         <IsPartOfProject Value="True"/>
    293         <ComponentName Value="BattleDlg"/>
     290        <Filename Value="NoTerm.pas"/>
     291        <IsPartOfProject Value="True"/>
     292        <ComponentName Value="NoTermDlg"/>
    294293        <HasResources Value="True"/>
    295294        <ResourceBaseClass Value="Form"/>
    296295      </Unit33>
    297296      <Unit34>
    298         <Filename Value="LocalPlayer\Rates.pas"/>
    299         <IsPartOfProject Value="True"/>
    300         <ComponentName Value="RatesDlg"/>
     297        <Filename Value="LocalPlayer\Battle.pas"/>
     298        <IsPartOfProject Value="True"/>
     299        <ComponentName Value="BattleDlg"/>
    301300        <HasResources Value="True"/>
    302301        <ResourceBaseClass Value="Form"/>
    303302      </Unit34>
    304303      <Unit35>
    305         <Filename Value="LocalPlayer\TechTree.pas"/>
    306         <IsPartOfProject Value="True"/>
    307         <ComponentName Value="TechTreeDlg"/>
     304        <Filename Value="LocalPlayer\Rates.pas"/>
     305        <IsPartOfProject Value="True"/>
     306        <ComponentName Value="RatesDlg"/>
    308307        <HasResources Value="True"/>
    309308        <ResourceBaseClass Value="Form"/>
    310309      </Unit35>
    311310      <Unit36>
    312         <Filename Value="Platform.pas"/>
    313         <IsPartOfProject Value="True"/>
     311        <Filename Value="LocalPlayer\TechTree.pas"/>
     312        <IsPartOfProject Value="True"/>
     313        <ComponentName Value="TechTreeDlg"/>
     314        <HasResources Value="True"/>
     315        <ResourceBaseClass Value="Form"/>
    314316      </Unit36>
    315317      <Unit37>
    316         <Filename Value="Switches.inc"/>
     318        <Filename Value="Platform.pas"/>
    317319        <IsPartOfProject Value="True"/>
    318320      </Unit37>
    319321      <Unit38>
    320         <Filename Value="Locale.pas"/>
    321         <IsPartOfProject Value="True"/>
    322         <ComponentName Value="LocaleDlg"/>
    323         <HasResources Value="True"/>
    324         <ResourceBaseClass Value="Form"/>
     322        <Filename Value="Switches.inc"/>
     323        <IsPartOfProject Value="True"/>
    325324      </Unit38>
    326325      <Unit39>
     326        <Filename Value="Locale.pas"/>
     327        <IsPartOfProject Value="True"/>
     328        <ComponentName Value="LocaleDlg"/>
     329        <HasResources Value="True"/>
     330      </Unit39>
     331      <Unit40>
    327332        <Filename Value="IPQ.pas"/>
    328333        <IsPartOfProject Value="True"/>
    329       </Unit39>
     334      </Unit40>
    330335    </Units>
    331336  </ProjectOptions>
    … …  
    361366    <Linking>
    362367      <Debugging>
    363         <UseHeaptrc Value="True"/>
    364368        <UseExternalDbgSyms Value="True"/>
    365369      </Debugging>
    … …  
    378382  </CompilerOptions>
    379383  <Debugging>
    380     <Exceptions Count="3">
     384    <Exceptions Count="4">
    381385      <Item1>
    382386        <Name Value="EAbort"/>
    … …  
    388392        <Name Value="EFOpenError"/>
    389393      </Item3>
     394      <Item4>
     395        <Name Value="EReadError"/>
     396      </Item4>
    390397    </Exceptions>
    391398  </Debugging>

  • branches/highdpi/Integrated.lpr

    r166 r178  
    2424  Term in 'LocalPlayer\Term.pas' {MainScreen} ,
    2525  MessgEx in 'LocalPlayer\MessgEx.pas' {MessgExDlg} ,
     26  BaseWin in 'LocalPlayer\BaseWin.pas',
    2627  Help in 'LocalPlayer\Help.pas' {HelpDlg} ,
    2728  Select in 'LocalPlayer\Select.pas' {ListDlg} ,
    … …  
    3940  Rates in 'LocalPlayer\Rates.pas' {RatesDlg} ,
    4041  TechTree in 'LocalPlayer\TechTree.pas' {TechTreeDlg},
    41   ScreenTools, Directories;
     42  ScreenTools, Directories, UDpiControls;
    4243
    4344{$if declared(UseHeapTrace)}
    … …  
    5657
    5758  DotNetClient := nil;
    58   Application.Initialize;
    59   Application.Title := 'c-evo';
     59  DpiApplication.Initialize;
     60  DpiApplication.Title := 'c-evo';
    6061  Directories.InitUnit;
    6162  ScreenTools.UnitInit;
    62   Application.CreateForm(TDirectDlg, DirectDlg);
    63   Application.CreateForm(TStartDlg, StartDlg);
    64   Application.CreateForm(TMessgDlg, MessgDlg);
    65   Application.CreateForm(TInputDlg, InputDlg);
    66   Application.CreateForm(TBackground, Background);
    67   Application.CreateForm(TLogDlg, LogDlg);
    68   Application.Run;
     63  DpiApplication.CreateForm(TDirectDlg, DirectDlg);
     64  DpiApplication.CreateForm(TStartDlg, StartDlg);
     65  DpiApplication.CreateForm(TMessgDlg, MessgDlg);
     66  DpiApplication.CreateForm(TInputDlg, InputDlg);
     67  DpiApplication.CreateForm(TBackground, Background);
     68  DpiApplication.CreateForm(TLogDlg, LogDlg);
     69  DpiApplication.Run;
    6970  ScreenTools.UnitDone;
    7071end.

  • branches/highdpi/Language.txt

    r167 r178  
    942942Hurry\Production
    943943Maximize\Production
    944 
    945 #SETTINGS
    946 Full screen

  • branches/highdpi/LocalPlayer/Battle.pas

    r111 r178  
    66uses
    77  ScreenTools, Protocol, Messg, ButtonBase, ButtonA, Types, LCLIntf, LCLType,
    8   SysUtils, Classes, Graphics, Controls, Forms, DrawDlg;
     8  SysUtils, Classes, Graphics, Controls, Forms, DrawDlg, UDpiControls;
    99
    1010type
    … …  
    3030  BattleDlg: TBattleDlg;
    3131
    32 procedure PaintBattleOutcome(ca: TCanvas; xm, ym, uix, ToLoc: Integer;
     32procedure PaintBattleOutcome(ca: TDpiCanvas; xm, ym, uix, ToLoc: Integer;
    3333  Forecast: TBattleForecastEx);
    3434
    … …  
    4848  FirstStrikeColor = $A0A0A0;
    4949
    50 procedure PaintBattleOutcome(ca: TCanvas; xm, ym, uix, ToLoc: Integer;
     50procedure PaintBattleOutcome(ca: TDpiCanvas; xm, ym, uix, ToLoc: Integer;
    5151  Forecast: TBattleForecastEx);
    5252var

  • branches/highdpi/LocalPlayer/CityScreen.pas

    r173 r178  
    88  LMessages,
    99  {$ENDIF}
    10   Protocol, ClientTools, Term, ScreenTools, IsoEngine, BaseWin,
     10  Protocol, ClientTools, Term, ScreenTools, IsoEngine, BaseWin, UDpiControls,
    1111  LCLIntf, LCLType, Messages, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls,
    1212  ButtonA, ButtonC, Area, GraphType;
    … …  
    7474    AreaMap: TIsoMap;
    7575    CityMapTemplate, SmallCityMapTemplate, Back, SmallCityMap, ZoomCityMap,
    76       Template: TBitmap;
     76      Template: TDpiBitmap;
    7777    IsPort, ProdHint, AllowChange: boolean;
    7878    procedure InitSmallCityMap;
    … …  
    9090
    9191uses
    92   Select, Messg, MessgEx, Help, Tribes, Directories, Math, PixelPointer, Sound;
     92  Select, Messg, MessgEx, Help, Tribes, Directories, Math;
    9393
    9494{$R *.lfm}
    … …  
    210210  end;
    211211
    212   Back := TBitmap.Create;
     212  Back := TDpiBitmap.Create;
    213213  Back.PixelFormat := pf24bit;
    214214  Back.SetSize(Width, Height);
    215215  Back.Canvas.FillRect(0, 0, Back.Width, Back.Height);
    216   Template := TBitmap.Create;
     216  Template := TDpiBitmap.Create;
    217217  Template.PixelFormat := pf24bit;
    218218  LoadGraphicFile(Template, HomeDir + 'Graphics' + DirectorySeparator + 'City.png', gfNoGamma);
    219   CityMapTemplate := TBitmap.Create;
     219  CityMapTemplate := TDpiBitmap.Create;
    220220  CityMapTemplate.PixelFormat := pf24bit;
    221221  LoadGraphicFile(CityMapTemplate, HomeDir + 'Graphics' + DirectorySeparator + 'BigCityMap.png', gfNoGamma);
    222   SmallCityMapTemplate := TBitmap.Create;
     222  SmallCityMapTemplate := TDpiBitmap.Create;
    223223  SmallCityMapTemplate.PixelFormat := pf24bit;
    224224  LoadGraphicFile(SmallCityMapTemplate, HomeDir + 'Graphics' + DirectorySeparator + 'SmallCityMap.png',
    225225    gfNoGamma);
    226   SmallCityMap := TBitmap.Create;
     226  SmallCityMap := TDpiBitmap.Create;
    227227  SmallCityMap.PixelFormat := pf24bit;
    228228  SmallCityMap.SetSize(98, 74);
    229229  SmallCityMap.Canvas.FillRect(0, 0, SmallCityMap.Width, SmallCityMap.Height);
    230   ZoomCityMap := TBitmap.Create;
     230  ZoomCityMap := TDpiBitmap.Create;
    231231  ZoomCityMap.PixelFormat := pf24bit;
    232232  ZoomCityMap.SetSize(228, 124);

  • branches/highdpi/LocalPlayer/Diagram.pas

    r135 r178  
    66uses
    77  BaseWin, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms,
    8   ButtonB, Menus;
     8  ButtonB, Menus, UDpiControls;
    99
    1010type
    … …  
    3434  DiaDlg: TDiaDlg;
    3535
    36 procedure PaintColonyShip(canvas: TCanvas; Player, Left, Width, Top: integer);
     36procedure PaintColonyShip(canvas: TDpiCanvas; Player, Left, Width, Top: integer);
    3737
    3838implementation
    … …  
    5555  yHab: array [0 .. 1] of integer = (-81, 1);
    5656
    57 procedure PaintColonyShip(canvas: TCanvas; Player, Left, Width, Top: integer);
     57procedure PaintColonyShip(canvas: TDpiCanvas; Player, Left, Width, Top: integer);
    5858var
    5959  i, x, r, nComp, nPow, nHab: integer;

  • branches/highdpi/LocalPlayer/Draft.pas

    r104 r178  
    55
    66uses
    7   Protocol, ClientTools, Term, ScreenTools, BaseWin,
    8 
     7  Protocol, ClientTools, Term, ScreenTools, BaseWin, UDpiControls,
    98  LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls,
    109  ButtonA,
    … …  
    3534      IncCap, DecCap: integer;
    3635    code: array [0 .. nFeature - 1] of integer;
    37     Template, Back: TBitmap;
     36    Template, Back: TDpiBitmap;
    3837    function IsFeatureInList(d, i: integer): boolean;
    3938    procedure SetDomain(d: integer);
    … …  
    8685  end;
    8786
    88   Back := TBitmap.Create;
     87  Back := TDpiBitmap.Create;
    8988  Back.PixelFormat := pf24bit;
    9089  Back.SetSize(Width, Height);
    9190  Back.Canvas.FillRect(0, 0, Back.Width, Back.Height);
    92   Template := TBitmap.Create;
     91  Template := TDpiBitmap.Create;
    9392  Template.PixelFormat := pf24bit;
    9493  LoadGraphicFile(Template, HomeDir + 'Graphics' + DirectorySeparator + 'MiliRes.png', gfNoGamma);

  • branches/highdpi/LocalPlayer/Help.pas

    r172 r178  
    55
    66uses
    7   Protocol, ScreenTools, BaseWin, StringTables, Math,
     7  Protocol, ScreenTools, BaseWin, StringTables, Math, UDpiControls,
    88  LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls, Forms,
    9   ExtCtrls, ButtonB, PVSB, Types, fgl;
     9  ExtCtrls, ButtonB, PVSB, Types;
    1010
    1111const
    … …  
    4141  THyperText = class(TStringList)
    4242  public
    43     procedure AddLine(s: String = ''; Format: integer = 0; Picpix: Integer = 0;
     43    procedure AddLine(s: String = ''; Format: integer = 0; Picpix: integer = 0;
    4444      LinkCategory: integer = 0; LinkIndex: integer = 0);
    45     procedure LineFeed;
    46     procedure AppendList(Source: THyperText);
     45    procedure LF;
    4746    destructor Destroy; override;
    48   end;
    49 
    50   { THistItem }
    51 
    52   THistItem = class
    53     Kind: Integer;
    54     No: Integer;
    55     Pos: Integer;
    56     SearchContent: string;
    57     procedure Assign(Source: THistItem);
    58   end;
    59 
    60   { THistItems }
    61 
    62   THistItems = class(TFPGObjectList<THistItem>)
    63     function AddNew(Kind, No, Pos: Integer; SearchContent: string): THistItem;
    6447  end;
    6548
    … …  
    8972    procedure OffscreenPaint; override;
    9073  private
    91     Kind: Integer;
    92     no: Integer;
    93     Sel: Integer;
    94     CaptionColor: Integer;
    95     hADVHELP, hIMPHELP, hFEATUREHELP, hGOVHELP, hSPECIALMODEL, hJOBHELP: Integer;
    96     SearchContent: string;
    97     NewSearchContent: string;
    98     CaptionFont: TFont;
    99     MainText: THyperText;
    100     SearchResult: THyperText;
     74    Kind, no, Sel, nHist, CaptionColor: integer;
     75    hADVHELP, hIMPHELP, hFEATUREHELP, hGOVHELP, hSPECIALMODEL,
     76      hJOBHELP: integer;
     77    SearchContent, NewSearchContent: string;
     78    CaptionFont: TDpiFont;
     79    MainText, SearchResult: THyperText;
    10180    HelpText: TStringTable;
    102     ExtPic, TerrIcon: TBitmap;
    103     ScrollBar: TPVScrollbar;
    104     x0: array [-2..180] of Integer;
    105     procedure PaintTerrIcon(x, y, xSrc, ySrc: Integer);
     81    ExtPic, TerrIcon: TDpiBitmap;
     82    sb: TPVScrollbar;
     83    x0: array [-2 .. 180] of integer;
     84    HistKind: array [0 .. MaxHist - 1] of integer;
     85    HistNo: array [0 .. MaxHist - 1] of integer;
     86    HistPos: array [0 .. MaxHist - 1] of integer;
     87    HistSearchContent: array [0 .. MaxHist - 1] of shortstring;
    10688    procedure ScrollBarUpdate(Sender: TObject);
    107     procedure Line(ca: TCanvas; i: Integer; lit: Boolean);
    108     procedure Prepare(sbPos: Integer = 0);
    109     procedure ShowNewContentProcExecute(NewMode: Integer; HelpContext: string);
    110     procedure WaterSign(x0, y0, iix: Integer);
     89    procedure line(ca: TDpiCanvas; i: integer; lit: boolean);
     90    procedure Prepare(sbPos: integer = 0);
     91    procedure WaterSign(x0, y0, iix: integer);
    11192    procedure Search(SearchString: string);
    11293    procedure OnScroll(var m: TMessage); message WM_VSCROLL;
    11394    procedure OnMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    11495  public
    115     HistItems: THistItems;
    116     Difficulty: Integer;
     96    Difficulty: integer;
     97    procedure ShowNewContent(NewMode, Category, Index: integer);
    11798    procedure ClearHistory;
    118     procedure ShowNewContent(NewMode, Category, Index: Integer);
    119     function TextIndex(Item: string): Integer;
     99    function TextIndex(Item: string): integer;
    120100  end;
    121101
    … …  
    126106
    127107uses
    128   Directories, ClientTools, Term, Tribes, Inp, Messg, PixelPointer;
     108  Directories, ClientTools, Term, Tribes, Inp, Messg;
    129109
    130110{$R *.lfm}
    131111
    132112type
    133 
    134   { THelpLineInfo }
    135 
    136113  THelpLineInfo = class
    137     Format: Byte;
    138     Picpix: Byte;
     114    Format, Picpix: Byte;
    139115    Link: Word;
    140     procedure Assign(Source: THelpLineInfo);
    141   end;
    142 
    143 { THelpLineInfo }
    144 
    145 procedure THelpLineInfo.Assign(Source: THelpLineInfo);
    146 begin
    147   Format := Source.Format;
    148   PicPix := Source.PicPix;
    149   Link := Source.Link;
    150 end;
    151 
    152 { THistItem }
    153 
    154 procedure THistItem.Assign(Source: THistItem);
    155 begin
    156   Kind := Source.Kind;
    157   No := Source.No;
    158   Pos := Source.Pos;
    159   SearchContent := Source.SearchContent;
    160 end;
    161 
    162 { THistItems }
    163 
    164 function THistItems.AddNew(Kind, No, Pos: Integer; SearchContent: string
    165   ): THistItem;
    166 begin
    167   Result := THistItem.Create;
    168   Result.Kind := Kind;
    169   Result.No := No;
    170   Result.Pos := Pos;
    171   Result.SearchContent := SearchContent;
    172   Add(Result);
    173 end;
     116  end;
    174117
    175118procedure THyperText.AddLine(s: String; Format: integer; Picpix: integer;
    … …  
    187130end;
    188131
    189 procedure THyperText.LineFeed;
     132procedure THyperText.LF;
    190133begin
    191134  AddLine;
    192 end;
    193 
    194 procedure THyperText.AppendList(Source: THyperText);
    195 var
    196   I: Integer;
    197   HelpLineInfo: THelpLineInfo;
    198 begin
    199   for I := 0 to Source.Count - 1 do begin
    200     HelpLineInfo := THelpLineInfo.Create;
    201     HelpLineInfo.Assign(THelpLineInfo(Source.Objects[I]));
    202     AddObject(Source.Strings[I], HelpLineInfo);
    203   end;
    204135end;
    205136
    … …  
    267198begin
    268199  inherited;
    269   HistItems := THistItems.Create;
    270 
    271200  CaptionLeft := BackBtn.Left + BackBtn.Width;
    272201  CaptionRight := SearchBtn.Left;
    … …  
    276205  SearchResult := THyperText.Create;
    277206  SearchResult.OwnsObjects := True;
    278   ScrollBar := TPVScrollbar.Create(Self);
    279   ScrollBar.SetBorderSpacing(36, 9, 11);
    280   ScrollBar.OnUpdate := ScrollBarUpdate;
     207  sb := TPVScrollbar.Create(Self);
     208  sb.SetBorderSpacing(36, 9, 11);
     209  sb.OnUpdate := ScrollBarUpdate;
    281210
    282211  HelpText := TStringTable.Create;
    … …  
    289218  hJOBHELP := HelpText.Gethandle('JOBHELP');
    290219
    291   CaptionFont := Font.Create;
     220  CaptionFont := TDpiFont.Create;
    292221  CaptionFont.Assign(UniFont[ftNormal]);
    293222  CaptionFont.Style := CaptionFont.Style + [fsItalic, fsBold];
    … …  
    298227  SearchBtn.Hint := Phrases.Lookup('BTN_SEARCH');
    299228
    300   ExtPic := TBitmap.Create;
    301   TerrIcon := TBitmap.Create;
     229  ExtPic := TDpiBitmap.Create;
     230  TerrIcon := TDpiBitmap.Create;
    302231  TerrIcon.PixelFormat := pf24bit;
    303232  TerrIcon.SetSize(xSizeBig, ySizeBig);
    304233  TerrIcon.Canvas.FillRect(0, 0, TerrIcon.Width, TerrIcon.Height);
    305234  SearchContent := '';
    306   ShowNewContentProc := ShowNewContentProcExecute;
     235  nHist := -1;
    307236end;
    308237
    309 procedure THelpDlg.ShowNewContentProcExecute(NewMode: Integer;
    310   HelpContext: string);
    311 begin
    312   HelpDlg.ShowNewContent(NewMode, hkText,
    313     HelpDlg.TextIndex(HelpContext))
     238procedure THelpDlg.ClearHistory;
     239begin
     240  nHist := -1;
    314241end;
    315242
    316243procedure THelpDlg.FormDestroy(Sender: TObject);
    317244begin
    318   ShowNewContentProc := nil;
    319   FreeAndNil(ScrollBar);
     245  FreeAndNil(sb);
    320246  FreeAndNil(MainText);
    321247  FreeAndNil(SearchResult);
    … …  
    324250  FreeAndNil(HelpText);
    325251  // FreeAndNil(CaptionFont);
    326   FreeAndNil(HistItems);
    327252end;
    328253
    … …  
    330255  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    331256begin
    332   if ScrollBar.ProcessMouseWheel(WheelDelta) then begin
     257  if sb.ProcessMouseWheel(WheelDelta) then begin
    333258    PaintBox1MouseMove(nil, [], MousePos.X - Left,
    334259      MousePos.Y - Top);
    … …  
    344269begin
    345270  { TODO: Handled by MouseWheel event
    346   if ScrollBar.Process(m) then begin
     271  if sb.Process(m) then begin
    347272    Sel := -1;
    348273    SmartUpdateContent(true)
    … …  
    354279begin
    355280  if Sel <> -1 then begin
    356     Line(Canvas, Sel, false);
     281    line(Canvas, Sel, false);
    357282    Sel := -1
    358283  end
    359284end;
    360285
    361 procedure THelpDlg.ClearHistory;
    362 begin
    363   HistItems.Clear;
    364 end;
    365 
    366286procedure THelpDlg.FormPaint(Sender: TObject);
    367287begin
    … …  
    370290end;
    371291
    372 procedure THelpDlg.Line(ca: TCanvas; i: Integer; lit: Boolean);
     292procedure THelpDlg.line(ca: TDpiCanvas; i: integer; lit: boolean);
    373293var
    374   TextColor, x, y: Integer;
     294  TextColor, x, y: integer;
    375295  TextSize: TSize;
    376296  s: string;
    377297begin
    378   s := MainText[ScrollBar.Position + i];
     298  s := MainText[sb.Position + i];
    379299  if s = '' then
    380     Exit;
     300    exit;
    381301  x := x0[i];
    382302  y := 2 + i * 24;
    … …  
    386306    y := y + WideFrame
    387307  end;
    388   if THelpLineInfo(MainText.Objects[ScrollBar.Position + i]).Format
     308  if THelpLineInfo(MainText.Objects[sb.Position + i]).Format
    389309    in [pkCaption, pkBigTer, pkRightIcon, pkBigFeature] then
    390310  begin
    … …  
    402322    ca.Font.Assign(UniFont[ftNormal]);
    403323  end
    404   else if THelpLineInfo(MainText.Objects[ScrollBar.Position + i]).Format = pkSection
     324  else if THelpLineInfo(MainText.Objects[sb.Position + i]).Format = pkSection
    405325  then
    406326  begin
    … …  
    421341        TextSize.cy := WideFrame + InnerHeight - y;
    422342      FillSeamless(ca, x, y, TextSize.cx, TextSize.cy, -SideFrame,
    423         ScrollBar.Position * 24 - WideFrame, Paper);
     343        sb.Position * 24 - WideFrame, Paper);
    424344    end;
    425345    BiColorTextOut(ca, TextColor, $7F007F, x, y, s);
    … …  
    427347      with ca do
    428348      begin
    429         Assert(ca = Canvas);
    430         Pen.Color := TextColor;
    431         MoveTo(x + 1, y + TextSize.cy - 2);
    432         LineTo(x + TextSize.cx, y + TextSize.cy - 2);
     349        assert(ca = Canvas);
     350        pen.color := TextColor;
     351        moveto(x + 1, y + TextSize.cy - 2);
     352        lineto(x + TextSize.cx, y + TextSize.cy - 2);
    433353      end;
    434354    if (Kind = hkMisc) and (no = miscMain) then
    … …  
    443363var
    444364  x, y, dx, dy, xSrc, ySrc, sum, xx: integer;
    445   Heaven: array [0..nHeaven] of integer;
     365  Heaven: array [0 .. nHeaven] of integer;
    446366  PaintPtr, CoalPtr: TPixelPointer;
    447   ImpPtr: array [-1..1] of TPixelPointer;
     367  ImpPtr: array [-1 .. 1] of TPixelPointer;
    448368begin
    449369  // assume eiffel tower has free common heaven
    … …  
    494414end;
    495415
    496 procedure THelpDlg.PaintTerrIcon(x, y, xSrc, ySrc: integer);
    497 begin
    498   Frame(OffScreen.Canvas, x - 1, y - 1, x + xSizeBig, y + ySizeBig,
    499     $000000, $000000);
    500   if 2 * yyt < 40 then begin
    501     Sprite(OffScreen, HGrTerrain, x, y, 56, 2 * yyt, xSrc, ySrc);
    502     Sprite(OffScreen, HGrTerrain, x, y + 2 * yyt, 56, 40 - 2 * yyt,
     416procedure THelpDlg.OffscreenPaint;
     417
     418  procedure PaintTerrIcon(x, y, xSrc, ySrc: integer);
     419  begin
     420    Frame(OffScreen.Canvas, x - 1, y - 1, x + xSizeBig, y + ySizeBig,
     421      $000000, $000000);
     422    if 2 * yyt < 40 then
     423    begin
     424      Sprite(OffScreen, HGrTerrain, x, y, 56, 2 * yyt, xSrc, ySrc);
     425      Sprite(OffScreen, HGrTerrain, x, y + 2 * yyt, 56, 40 - 2 * yyt,
     426        xSrc, ySrc);
     427    end
     428    else
     429      Sprite(OffScreen, HGrTerrain, x, y, 56, 40, xSrc, ySrc);
     430    Sprite(OffScreen, HGrTerrain, x, y, xxt, yyt, xSrc + xxt, ySrc + yyt);
     431    Sprite(OffScreen, HGrTerrain, x, y + yyt, xxt, 40 - yyt, xSrc + xxt, ySrc);
     432    Sprite(OffScreen, HGrTerrain, x + xxt, y, 56 - xxt, yyt, xSrc, ySrc + yyt);
     433    Sprite(OffScreen, HGrTerrain, x + xxt, y + yyt, 56 - xxt, 40 - yyt,
    503434      xSrc, ySrc);
    504   end else
    505     Sprite(OffScreen, HGrTerrain, x, y, 56, 40, xSrc, ySrc);
    506   Sprite(OffScreen, HGrTerrain, x, y, xxt, yyt, xSrc + xxt, ySrc + yyt);
    507   Sprite(OffScreen, HGrTerrain, x, y + yyt, xxt, 40 - yyt, xSrc + xxt, ySrc);
    508   Sprite(OffScreen, HGrTerrain, x + xxt, y, 56 - xxt, yyt, xSrc, ySrc + yyt);
    509   Sprite(OffScreen, HGrTerrain, x + xxt, y + yyt, 56 - xxt, 40 - yyt,
    510     xSrc, ySrc);
    511 end;
    512 
    513 procedure THelpDlg.OffscreenPaint;
     435  end;
     436
    514437var
    515   i, j, yl, srcno, ofs, cnt, y: Integer;
     438  i, j, yl, srcno, ofs, cnt, y: integer;
    516439  s: string;
    517440  HelpLineInfo: THelpLineInfo;
    … …  
    520443  CaptionColor := Colors.Canvas.Pixels[clkMisc, cliPaperCaption];
    521444  FillSeamless(OffScreen.Canvas, 0, 0, InnerWidth, InnerHeight, 0,
    522     ScrollBar.Position * 24, Paper);
     445    sb.Position * 24, Paper);
    523446  with OffScreen.Canvas do
    524447  begin
    525448    Font.Assign(UniFont[ftNormal]);
    526     for i := -ScrollBar.Position to InnerHeight div 24 do
    527       if ScrollBar.Position + i < MainText.Count then
     449    for i := -sb.Position to InnerHeight div 24 do
     450      if sb.Position + i < MainText.Count then
    528451      begin
    529         HelpLineInfo := THelpLineInfo(MainText.Objects[ScrollBar.Position + i]);
     452        HelpLineInfo := THelpLineInfo(MainText.Objects[sb.Position + i]);
    530453        if HelpLineInfo.Format = pkExternal then
    531454        begin
    … …  
    538461      end;
    539462    for i := -2 to InnerHeight div 24 do
    540       if (ScrollBar.Position + i >= 0) and (ScrollBar.Position + i < MainText.Count) then
     463      if (sb.Position + i >= 0) and (sb.Position + i < MainText.Count) then
    541464      begin
    542         HelpLineInfo := THelpLineInfo(MainText.Objects[ScrollBar.Position + i]);
     465        HelpLineInfo := THelpLineInfo(MainText.Objects[sb.Position + i]);
    543466        if HelpLineInfo.Link <> 0 then
    544467        begin
    … …  
    844767            x0[i] := 64 + 8 + 8;
    845768        else
    846           x0[i] := x0[i] + 8;
     769          x0[i] := x0[i] + 8
    847770        end;
    848         Self.Line(OffScreen.Canvas, i, False)
     771        Self.line(OffScreen.Canvas, i, false)
    849772      end;
    850773  end;
    851774  MarkUsedOffscreen(InnerWidth, InnerHeight + 13 + 48);
    852 end;
     775end; { OffscreenPaint }
    853776
    854777procedure THelpDlg.ScrollBarUpdate(Sender: TObject);
    … …  
    860783procedure THelpDlg.Prepare(sbPos: integer = 0);
    861784var
    862   i, j, Special, Domain, Headline, TerrType, TerrSubType: integer;
     785  i, j, special, Domain, Headline, TerrType, TerrSubType: integer;
    863786  s: string;
    864787  ps: pchar;
    865788  List: THyperText;
    866   CheckSeeAlso: Boolean;
    867 
    868   procedure AddAdvance(i: integer);
     789  CheckSeeAlso: boolean;
     790
     791  procedure AddAdv(i: integer);
    869792  begin
    870793    MainText.AddLine(Phrases.Lookup('ADVANCES', i), pkAdvIcon, i,
    … …  
    878801  end;
    879802
    880   procedure AddImprovement(i: integer);
     803  procedure AddImp(i: integer);
    881804  begin
    882805    MainText.AddLine(Phrases.Lookup('IMPROVEMENTS', i), pkSmallIcon, i,
    … …  
    890813  end;
    891814
    892   procedure AddTerrain(i: integer);
     815  procedure AddTer(i: integer);
    893816  begin
    894817    if MainText.Count > 1 then
    895818    begin
    896       MainText.LineFeed;
     819      MainText.LF;
    897820    end;
    898821    MainText.AddLine(Phrases.Lookup('TERRAIN', i), pkTer, i, hkTer, i);
    … …  
    911834  begin
    912835    if MainText.Count > 1 then
    913       MainText.LineFeed;
     836      MainText.LF;
    914837    FindStdModelPicture(SpecialModelPictureCode[i], pix, Name);
    915838    MainText.AddLine(Name, pkModel, pix, hkModel + hkCrossLink, i)
    … …  
    925848      begin
    926849        AddLine('', pkLogo);
    927         LineFeed;
     850        LF;
    928851      end
    929852      else if Item = 'TECHFORMULA' then
    … …  
    941864        for i := 1 to 3 do
    942865        begin
    943           LineFeed;
     866          LF;
    944867          AddLine(Phrases.Lookup('TERRAIN', 3 * 12 + i), pkTer, 3 * 12 + i);
    945868        end
    … …  
    952875  end;
    953876
    954   procedure DecodeItem(s: string; var Category, Index: Integer);
     877  procedure DecodeItem(s: string; var Category, Index: integer);
    955878  var
    956     i: Integer;
    957   begin
    958     if (Length(s) > 0) and (s[1] = ':') then begin
     879    i: integer;
     880  begin
     881    if (length(s) > 0) and (s[1] = ':') then
     882    begin
    959883      Category := hkMisc;
    960884      Index := 0;
    961885      for i := 3 to length(s) do
    962         Index := Index * 10 + Ord(s[i]) - 48;
     886        Index := Index * 10 + ord(s[i]) - 48;
    963887      case s[2] of
    964         'A': Category := hkAdv;
    965         'B': Category := hkImp;
    966         'T': Category := hkTer;
    967         'F': Category := hkFeature;
    968         'E': Category := hkInternet;
    969         'S': Category := hkModel;
    970         'C': Index := miscCredits;
    971         'J': Index := miscJobList;
    972         'G': Index := miscGovList;
     888        'A':
     889          Category := hkAdv;
     890        'B':
     891          Category := hkImp;
     892        'T':
     893          Category := hkTer;
     894        'F':
     895          Category := hkFeature;
     896        'E':
     897          Category := hkInternet;
     898        'S':
     899          Category := hkModel;
     900        'C':
     901          Index := miscCredits;
     902        'J':
     903          Index := miscJobList;
     904        'G':
     905          Index := miscGovList;
    973906      end;
    974907      if (Category <> hkMisc) and (Index = 0) then
    975908        Index := 200;
    976     end else begin
     909    end
     910    else
     911    begin
    977912      Category := hkText;
    978       Index := HelpText.Gethandle(Copy(s, 1, 255));
     913      Index := HelpText.Gethandle(copy(s, 1, 255));
    979914    end;
    980915  end;
    … …  
    998933        repeat
    999934          inc(p)
    1000         until (p > Length(s)) or (s[p] = '\');
    1001         Caption := Copy(s, 2, p - 2);
     935        until (p > length(s)) or (s[p] = '\');
     936        Caption := copy(s, 2, p - 2);
    1002937        Delete(s, 1, p);
    1003938      end
    … …  
    1007942        repeat
    1008943          inc(p)
    1009         until (p > Length(s)) or (s[p] = '\');
    1010         AddStandardBlock(Copy(s, 2, p - 2));
     944        until (p > length(s)) or (s[p] = '\');
     945        AddStandardBlock(copy(s, 2, p - 2));
    1011946        Delete(s, 1, p);
    1012947      end
    1013948      else if s[1] = '@' then
    1014949      begin // image
    1015         if (Length(s) >= 2) and (s[2] = '@') then
     950        if (length(s) >= 2) and (s[2] = '@') then
    1016951        begin // generate from icon
    1017952          Picpix := 0;
    1018953          p := 3;
    1019           while (p <= Length(s)) and (s[p] <> '\') do
     954          while (p <= length(s)) and (s[p] <> '\') do
    1020955          begin
    1021             Picpix := Picpix * 10 + Ord(s[p]) - 48;
     956            Picpix := Picpix * 10 + ord(s[p]) - 48;
    1022957            inc(p)
    1023958          end;
    … …  
    1025960            Picpix := 0;
    1026961          MainText.AddLine('', pkIllu, Picpix);
    1027           MainText.LineFeed;
    1028           MainText.LineFeed;
     962          MainText.LF;
     963          MainText.LF;
    1029964        end
    1030965        else
    … …  
    1032967          p := 1;
    1033968          repeat
    1034             Inc(p)
    1035           until (p > Length(s)) or (s[p] = '\');
     969            inc(p)
     970          until (p > length(s)) or (s[p] = '\');
    1036971          if LoadGraphicFile(ExtPic, LocalizedFilePath('Help' +
    1037             DirectorySeparator + Copy(s, 2, p - 2)) + '.png') then
     972            DirectorySeparator + copy(s, 2, p - 2)) + '.png') then
    1038973          begin
    1039974            MainText.AddLine('', pkExternal);
    1040975            for i := 0 to (ExtPic.Height - 12) div 24 do
    1041               MainText.LineFeed;
     976              MainText.LF;
    1042977          end;
    1043978        end;
    … …  
    1052987              repeat
    1053988                inc(p)
    1054               until (p > Length(s)) or (s[p] = '\') or (s[p] = ' ');
    1055               DecodeItem(Copy(s, 2, p - 2), LinkCategory, LinkIndex);
     989              until (p > length(s)) or (s[p] = '\') or (s[p] = ' ');
     990              DecodeItem(copy(s, 2, p - 2), LinkCategory, LinkIndex);
    1056991              CurrentFormat := 0;
    1057992              if (LinkCategory <> hkText) and (LinkIndex < 200) then
    … …  
    10711006                    begin
    10721007                      CurrentFormat := pkTer;
    1073                       Picpix := LinkIndex;
     1008                      Picpix := LinkIndex
    10741009                    end;
    10751010                  hkFeature:
    … …  
    10871022              if s[1] = ':' then
    10881023                LinkCategory := LinkCategory + hkCrossLink;
    1089               if (p > Length(s)) or (s[p] = ' ') then
     1024              if (p > length(s)) or (s[p] = ' ') then
    10901025                Delete(s, 1, p)
    10911026              else
    … …  
    10931028            end;
    10941029          '!': // highlited
    1095             if (Length(s) >= 2) and (s[2] = '!') then
     1030            if (length(s) >= 2) and (s[2] = '!') then
    10961031            begin
    10971032              if MainText.Count > 1 then
    1098                 MainText.LineFeed;
     1033                MainText.LF;
    10991034              FollowFormat := pkCaption;
    11001035              CurrentFormat := pkCaption;
    … …  
    11231058        repeat
    11241059          repeat
    1125             Inc(p)
    1126           until (p > Length(s)) or (s[p] = ' ') or (s[p] = '\');
    1127           if (BiColorTextWidth(OffScreen.Canvas, Copy(s, 1, p - 1)) <=
     1060            inc(p)
     1061          until (p > length(s)) or (s[p] = ' ') or (s[p] = '\');
     1062          if (BiColorTextWidth(OffScreen.Canvas, copy(s, 1, p - 1)) <=
    11281063            RightMargin - ofs) then
    11291064            l := p - 1
    11301065          else
    11311066            Break;
    1132         until (p >= Length(s)) or (s[l + 1] = '\');
    1133         MainText.AddLine(Copy(s, 1, l), CurrentFormat, Picpix, LinkCategory,
     1067        until (p >= length(s)) or (s[l + 1] = '\');
     1068        MainText.AddLine(copy(s, 1, l), CurrentFormat, Picpix, LinkCategory,
    11341069          LinkIndex);
    1135         if (l < Length(s)) and (s[l + 1] = '\') then
     1070        if (l < length(s)) and (s[l + 1] = '\') then
    11361071          FollowFormat := pkNormal;
    11371072        Delete(s, 1, l + 1);
    … …  
    11451080  end;
    11461081
    1147   procedure AddModelText(i: Integer);
     1082  procedure AddModelText(i: integer);
    11481083  var
    1149     pix: Integer;
     1084    pix: integer;
    11501085    s: string;
    11511086  begin
    1152     with MainText do begin
    1153       if Count > 1 then begin
    1154         LineFeed;
    1155         LineFeed;
     1087    with MainText do
     1088    begin
     1089      if Count > 1 then
     1090      begin
     1091        LF;
     1092        LF;
    11561093      end;
    11571094      FindStdModelPicture(SpecialModelPictureCode[i], pix, s);
    … …  
    11871124  procedure AddJobList;
    11881125  var
    1189     i, JobCost: Integer;
    1190   begin
    1191     with MainText do begin
    1192       for i := 0 to nJobHelp - 1 do begin
    1193         if i > 0 then begin
    1194           LineFeed;
    1195           LineFeed;
     1126    i, JobCost: integer;
     1127  begin
     1128    with MainText do
     1129    begin
     1130      for i := 0 to nJobHelp - 1 do
     1131      begin
     1132        if i > 0 then
     1133        begin
     1134          LF;
     1135          LF
    11961136        end;
    11971137        AddLine(Phrases.Lookup('JOBRESULT', JobHelp[i]), pkSection);
    … …  
    12021142        JobCost := -1;
    12031143        case JobHelp[i] of
    1204           jCanal: JobCost := CanalWork;
    1205           jFort: JobCost := FortWork;
    1206           jBase: JobCost := BaseWork;
     1144          jCanal:
     1145            JobCost := CanalWork;
     1146          jFort:
     1147            JobCost := FortWork;
     1148          jBase:
     1149            JobCost := BaseWork;
    12071150        end;
    12081151        if JobCost >= 0 then
    … …  
    12111154        else
    12121155          AddTextual(HelpText.Lookup('JOBCOSTVAR'));
    1213         if JobPreq[JobHelp[i]] <> preNone then begin
     1156        if JobPreq[JobHelp[i]] <> preNone then
     1157        begin
    12141158          AddPreqAdv(JobPreq[JobHelp[i]]);
    12151159          MainText[Count - 1] := Format(HelpText.Lookup('REQUIRED'),
    … …  
    12221166  procedure AddGraphicCredits;
    12231167  var
    1224     i: Integer;
     1168    i: integer;
    12251169    s: string;
    12261170    sr: TSearchRec;
    1227     List, Plus: TStringList;
     1171    List, plus: TStringList;
    12281172  begin
    12291173    List := TStringList.Create;
    1230     Plus := TStringList.Create;
     1174    plus := TStringList.Create;
    12311175    if FindFirst(HomeDir + 'Graphics' + DirectorySeparator + '*.credits.txt', $27, sr) = 0 then
    12321176      repeat
    1233         Plus.LoadFromFile(HomeDir + 'Graphics' + DirectorySeparator + sr.Name);
    1234         List.AddStrings(Plus);
     1177        plus.LoadFromFile(HomeDir + 'Graphics' + DirectorySeparator + sr.Name);
     1178        List.AddStrings(plus);
    12351179      until FindNext(sr) <> 0;
    12361180    FindClose(sr);
    1237     Plus.Free;
     1181    plus.Free;
    12381182
    12391183    List.Sort;
    … …  
    12431187        List.Delete(i)
    12441188      else
    1245         Inc(i);
    1246 
    1247     for i := 0 to List.Count - 1 do begin
     1189        inc(i);
     1190
     1191    for i := 0 to List.Count - 1 do
     1192    begin
    12481193      s := List[i];
    12491194      while BiColorTextWidth(OffScreen.Canvas, s) > InnerWidth - 16 -
    … …  
    12571202  procedure AddSoundCredits;
    12581203  var
    1259     i: Integer;
     1204    i: integer;
    12601205    s: string;
    12611206    List: TStringList;
    … …  
    12631208    List := TStringList.Create;
    12641209    List.LoadFromFile(HomeDir + 'Sounds' + DirectorySeparator + 'sound.credits.txt');
    1265     for i := 0 to List.Count - 1 do begin
     1210    for i := 0 to List.Count - 1 do
     1211    begin
    12661212      s := List[i];
    12671213      while BiColorTextWidth(OffScreen.Canvas, s) > InnerWidth - 16 -
    … …  
    12791225        MainText.Delete(Headline)
    12801226      else
    1281         MainText.LineFeed;
     1227        MainText.LF;
    12821228    MainText.AddLine(HelpText.Lookup(Item), pkSection);
    12831229    Headline := MainText.Count - 1;
    … …  
    12851231
    12861232begin { Prepare }
    1287   with MainText do begin
     1233  with MainText do
     1234  begin
    12881235    OffScreen.Canvas.Font.Assign(UniFont[ftNormal]);
    1289     CheckSeeAlso := False;
     1236    CheckSeeAlso := false;
    12901237    Clear;
    12911238    Headline := -1;
    12921239    if (no >= 200) or not(Kind in [hkAdv, hkImp, hkTer, hkFeature]) then
    1293       LineFeed;
     1240      LF;
    12941241    case Kind of
    12951242      hkText:
    … …  
    13031250                AddLine(HelpText.Lookup('HELPTITLE_QUICKSTART'), pkSpecialIcon,
    13041251                  0, { pkBigIcon,22, } hkText, HelpText.Gethandle('QUICK'));
    1305                 LineFeed;
     1252                LF;
    13061253                AddLine(HelpText.Lookup('HELPTITLE_CONCEPTS'), pkBigIcon, 6,
    13071254                  hkText, HelpText.Gethandle('CONCEPTS'));
    1308                 LineFeed;
     1255                LF;
    13091256                AddLine(HelpText.Lookup('HELPTITLE_TERLIST'), pkSpecialIcon, 1,
    13101257                  hkTer, 200);
    1311                 LineFeed;
     1258                LF;
    13121259                AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'), pkSpecialIcon, 2,
    13131260                  hkMisc, miscJobList);
    1314                 LineFeed;
     1261                LF;
    13151262                AddLine(HelpText.Lookup('HELPTITLE_TECHLIST'), pkBigIcon, 39,
    13161263                  hkAdv, 200);
    1317                 LineFeed;
     1264                LF;
    13181265                FindStdModelPicture(SpecialModelPictureCode[6], i, s);
    13191266                AddLine(HelpText.Lookup('HELPTITLE_MODELLIST'), pkModel, i,
    13201267                  hkModel, 0);
    1321                 LineFeed;
     1268                LF;
    13221269                AddLine(HelpText.Lookup('HELPTITLE_FEATURELIST'), pkBigIcon, 28,
    13231270                  hkFeature, 200);
    1324                 LineFeed;
     1271                LF;
    13251272                AddLine(HelpText.Lookup('HELPTITLE_IMPLIST'), pkBigIcon,
    13261273                  7 * SystemIconLines + imCourt, hkImp, 200);
    1327                 LineFeed;
     1274                LF;
    13281275                AddLine(HelpText.Lookup('HELPTITLE_UNIQUELIST'), pkBigIcon,
    13291276                  7 * SystemIconLines + imStockEx, hkImp, 201);
    1330                 LineFeed;
     1277                LF;
    13311278                AddLine(HelpText.Lookup('HELPTITLE_WONDERLIST'), pkBigIcon,
    13321279                  7 * SystemIconLines, hkImp, 202);
    1333                 LineFeed;
     1280                LF;
    13341281                AddLine(HelpText.Lookup('HELPTITLE_GOVLIST'), pkBigIcon,
    13351282                  gDemocracy + 6, hkMisc, miscGovList);
    1336                 LineFeed;
     1283                LF;
    13371284                AddLine(HelpText.Lookup('HELPTITLE_KEYS'), pkBigIcon, 2, hkText,
    13381285                  HelpText.Gethandle('HOTKEYS'));
    1339                 LineFeed;
     1286                LF;
    13401287                AddLine(HelpText.Lookup('HELPTITLE_ABOUT'), pkBigIcon, 1,
    13411288                  hkText, HelpText.Gethandle('ABOUT'));
    1342                 LineFeed;
     1289                LF;
    13431290                AddLine(HelpText.Lookup('HELPTITLE_CREDITS'), pkBigIcon, 22,
    13441291                  hkMisc, miscCredits);
    … …  
    13471294              begin
    13481295                AddItem('CREDITS');
    1349                 LineFeed;
     1296                LF;
    13501297                AddGraphicCredits;
    13511298                NextSection('CRED_CAPSOUND');
    … …  
    13611308                Caption := HelpText.Lookup('HELPTITLE_JOBLIST');
    13621309                AddJobList;
    1363                 LineFeed;
     1310                LF;
    13641311                AddItem('TERIMPEXCLUDE');
    1365                 LineFeed;
     1312                LF;
    13661313                AddItem('TERIMPCITY');
    13671314              end;
    … …  
    13721319                begin
    13731320                  AddLine(Phrases.Lookup('GOVERNMENT', i mod nGov), pkSection);
    1374                   LineFeed;
     1321                  LF;
    13751322                  if i = nGov then
    13761323                    AddLine('', pkBigIcon, 7 * SystemIconLines + imPalace)
    13771324                  else
    13781325                    AddLine('', pkBigIcon, i + 6);
    1379                   LineFeed;
     1326                  LF;
    13801327                  AddTextual(HelpText.LookupByHandle(hGOVHELP, i mod nGov));
    13811328                  if i mod nGov >= 2 then
    … …  
    13871334                  if i < nGov then
    13881335                  begin
    1389                     LineFeed;
    1390                     LineFeed;
     1336                    LF;
     1337                    LF;
    13911338                  end
    13921339                end
    … …  
    13961343                Caption := HelpText.Lookup('HELPTITLE_SEARCHRESULTS');
    13971344                AddTextual(Format(HelpText.Lookup('MATCHES'), [SearchContent]));
    1398                 MainText.AppendList(SearchResult);
    1399               end;
     1345                MainText.AddStrings(SearchResult);
     1346              end
    14001347          end; // case no
    14011348        end;
    … …  
    14061353          Caption := HelpText.Lookup('HELPTITLE_TECHLIST');
    14071354          List := THyperText.Create;
    1408           List.OwnsObjects := True;
    14091355          for j := 0 to 3 do
    14101356          begin
    14111357            if j > 0 then
    14121358            begin
    1413               LineFeed;
    1414               LineFeed;
     1359              LF;
     1360              LF;
    14151361            end;
    14161362            AddLine(HelpText.Lookup('TECHAGE', j), pkSection);
    … …  
    14301376                  hkAdv, i);
    14311377            List.Sort;
    1432             AppendList(List);
     1378            AddStrings(List);
    14331379          end;
    1434           List.Free;
     1380          List.Free
    14351381        end
    14361382        else // single advance
    14371383        begin
    14381384          Caption := Phrases.Lookup('ADVANCES', no);
    1439           LineFeed;
     1385          LF;
    14401386          AddLine(Phrases.Lookup('ADVANCES', no), pkCaption);
    14411387          if no in FutureTech then
    14421388          begin
    14431389            AddLine(HelpText.Lookup('HELPSPEC_FUTURE'));
    1444             LineFeed;
     1390            LF;
    14451391            if no = futResearchTechnology then
    14461392              AddItem('FUTURETECHHELP100')
    … …  
    14651411          for i := 0 to 27 do
    14661412            if Imp[i].Preq = no then
    1467               AddImprovement(i);
     1413              AddImp(i);
    14681414          for i := 28 to nImp - 1 do
    14691415            if (Imp[i].Preq = no) and (Imp[i].Kind <> ikCommon) then
    1470               AddImprovement(i);
     1416              AddImp(i);
    14711417          for i := 28 to nImp - 1 do
    14721418            if (Imp[i].Preq = no) and (Imp[i].Kind = ikCommon) then
    1473               AddImprovement(i);
     1419              AddImp(i);
    14741420          NextSection('MODELALLOW');
    14751421          for i := 0 to nSpecialModel - 1 do
    … …  
    14841430            if (AdvPreq[i, 0] = no) or (AdvPreq[i, 1] = no) or
    14851431              (AdvPreq[i, 2] = no) then
    1486               AddAdvance(i);
     1432              AddAdv(i);
    14871433          NextSection('UPGRADEALLOW');
    14881434          for Domain := 0 to nDomains - 1 do
    … …  
    15081454          for i := 0 to 27 do
    15091455            if (Imp[i].Preq <> preNA) and (Imp[i].Expiration = no) then
    1510               AddImprovement(i);
     1456              AddImp(i);
    15111457          NextSection('ADVEFFECT');
    15121458          s := HelpText.LookupByHandle(hADVHELP, no);
    … …  
    15231469          // AddLine(HelpText.Lookup('HELPTITLE_IMPLIST'),pkSection);
    15241470          List := THyperText.Create;
    1525           List.OwnsObjects := True;
    15261471          for i := 28 to nImp - 1 do
    15271472            if (i <> imTrGoods) and (Imp[i].Preq <> preNA) and
    … …  
    15301475                i, hkImp, i);
    15311476          List.Sort;
    1532           AppendList(List);
    1533           List.Free;
     1477          AddStrings(List);
     1478          List.Free
    15341479        end
    15351480        else if no = 201 then
    … …  
    15421487              AddLine(Phrases.Lookup('IMPROVEMENTS', i), pkSmallIcon, i,
    15431488                hkImp, i);
    1544           { LineFeed;
    1545             LineFeed;
     1489          { LF;
     1490            LF;
    15461491            AddLine(HelpText.Lookup('HELPTITLE_SHIPPARTLIST'),pkSection);
    15471492            for i:=28 to nImp-1 do
    … …  
    15611506        begin // single building
    15621507          Caption := Phrases.Lookup('IMPROVEMENTS', no);
    1563           LineFeed;
     1508          LF;
    15641509          AddLine(Phrases.Lookup('IMPROVEMENTS', no), pkRightIcon, no);
    15651510          case Imp[no].Kind of
    1566             ikWonder: AddLine(HelpText.Lookup('HELPSPEC_WONDER'));
    1567             ikCommon: AddLine(HelpText.Lookup('HELPSPEC_IMP'));
    1568             ikShipPart: AddLine(HelpText.Lookup('HELPSPEC_SHIPPART'));
     1511            ikWonder:
     1512              AddLine(HelpText.Lookup('HELPSPEC_WONDER'));
     1513            ikCommon:
     1514              AddLine(HelpText.Lookup('HELPSPEC_IMP'));
     1515            ikShipPart:
     1516              AddLine(HelpText.Lookup('HELPSPEC_SHIPPART'));
    15691517          else
    15701518            AddLine(HelpText.Lookup('HELPSPEC_NAT'))
    15711519          end;
    1572           if Imp[no].Kind <> ikShipPart then begin
     1520          if Imp[no].Kind <> ikShipPart then
     1521          begin
    15731522            NextSection('EFFECT');
    15741523            AddTextual(HelpText.LookupByHandle(hIMPHELP, no));
    15751524          end;
    1576           if no = woSun then begin
     1525          if no = woSun then
     1526          begin
    15771527            AddFeature(mcFirst);
    15781528            AddFeature(mcWill);
    … …  
    15811531          if (no < 28) and not Phrases2FallenBackToEnglish then
    15821532          begin
    1583             LineFeed;
     1533            LF;
    15841534            if Imp[no].Expiration >= 0 then
    15851535              AddTextual(Phrases2.Lookup('HELP_WONDERMORALE1'))
    … …  
    16111561                j := 1
    16121562              end;
    1613               AddImprovement(ImpReplacement[i].OldImp);
     1563              AddImp(ImpReplacement[i].OldImp);
    16141564            end;
    16151565          if Imp[no].Kind = ikShipPart then
    16161566          begin
    1617             LineFeed;
     1567            LF;
    16181568            if no = imShipComp then
    16191569              i := 1
    … …  
    16361586          NextSection('SEEALSO');
    16371587          if (no < 28) and (Imp[no].Expiration >= 0) then
    1638             AddImprovement(woEiffel);
     1588            AddImp(woEiffel);
    16391589          for i := 0 to nImpReplacement - 1 do
    16401590            if ImpReplacement[i].OldImp = no then
    1641               AddImprovement(ImpReplacement[i].NewImp);
     1591              AddImp(ImpReplacement[i].NewImp);
    16421592          if no = imSupermarket then
    16431593            AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'), pkNormal, 0,
    … …  
    16521602          // AddLine(HelpText.Lookup('HELPTITLE_TERLIST'),pkSection);
    16531603          for i := 0 to nTerrainHelp - 1 do
    1654             AddTerrain(TerrainHelp[i]);
     1604            AddTer(TerrainHelp[i]);
    16551605        end
    16561606        else
    … …  
    16681618          begin
    16691619            Caption := Phrases.Lookup('TERRAIN', no);
    1670             LineFeed;
     1620            LF;
    16711621            AddLine(Phrases.Lookup('TERRAIN', no), pkBigTer, no);
    16721622            AddLine(HelpText.Lookup('HELPSPEC_TER'));
    1673             LineFeed;
     1623            LF;
    16741624            if (ProdRes[TerrSubType] > 0) or (MineEff > 0) then
    16751625              AddLine(Format(HelpText.Lookup('RESPROD'),
    … …  
    16971647            if no = 3 * 12 then
    16981648            begin
    1699               LineFeed;
     1649              LF;
    17001650              AddTextual(HelpText.Lookup('DEADLANDS'));
    17011651            end;
    17021652            if (TerrType = fDesert) and (no <> fDesert + 12) then
    17031653            begin
    1704               LineFeed;
     1654              LF;
    17051655              AddTextual(Format(HelpText.Lookup('HOSTILE'), [DesertThurst]));
    17061656            end;
    17071657            if TerrType = fArctic then
    17081658            begin
    1709               LineFeed;
     1659              LF;
    17101660              AddTextual(Format(HelpText.Lookup('HOSTILE'), [ArcticThurst]));
    17111661            end;
    17121662            if (no < 3 * 12) and (TransTerrain >= 0) then
    17131663            begin
    1714               LineFeed;
     1664              LF;
    17151665              i := TransTerrain;
    17161666              if (TerrType <> fGrass) and (i <> fGrass) then
    17171667                i := i + TerrSubType * 12;
    1718               // trafo to same Special resource group
     1668              // trafo to same special resource group
    17191669              AddLine(Format(HelpText.Lookup('TRAFO'),
    17201670                [Phrases.Lookup('TERRAIN', i)]), pkTer, i,
    … …  
    17221672              if no = fSwamp + 12 then
    17231673              begin
    1724                 LineFeed;
     1674                LF;
    17251675                AddLine(Format(HelpText.Lookup('TRAFO'),
    17261676                  [Phrases.Lookup('TERRAIN', TransTerrain + 24)]), pkTer,
    … …  
    17291679              else if i = fGrass then
    17301680              begin
    1731                 LineFeed;
     1681                LF;
    17321682                AddLine(Format(HelpText.Lookup('TRAFO'),
    17331683                  [Phrases.Lookup('TERRAIN', fGrass + 12)]), pkTer, fGrass + 12,
    … …  
    17381688            if no = 3 * 12 then
    17391689            begin
    1740               LineFeed;
    1741               for Special := 1 to 3 do
     1690              LF;
     1691              for special := 1 to 3 do
    17421692              begin
    1743                 if Special > 1 then
    1744                   LineFeed;
    1745                 AddLine(Phrases.Lookup('TERRAIN', 3 * 12 + Special), pkTer,
    1746                   3 * 12 + Special);
     1693                if special > 1 then
     1694                  LF;
     1695                AddLine(Phrases.Lookup('TERRAIN', 3 * 12 + special), pkTer,
     1696                  3 * 12 + special);
    17471697              end
    17481698            end
    17491699            else if (no < 12) and (no <> fGrass) and (no <> fOcean) then
    17501700            begin
    1751               LineFeed;
    1752               for Special := 1 to 2 do
    1753                 if (no <> fArctic) and (no <> fSwamp) or (Special < 2) then
     1701              LF;
     1702              for special := 1 to 2 do
     1703                if (no <> fArctic) and (no <> fSwamp) or (special < 2) then
    17541704                begin
    1755                   if Special > 1 then
    1756                     LineFeed;
    1757                   AddLine(Phrases.Lookup('TERRAIN', no + Special * 12), pkTer,
    1758                     no + Special * 12);
    1759                   i := FoodRes[Special] - FoodRes[0];
     1705                  if special > 1 then
     1706                    LF;
     1707                  AddLine(Phrases.Lookup('TERRAIN', no + special * 12), pkTer,
     1708                    no + special * 12);
     1709                  i := FoodRes[special] - FoodRes[0];
    17601710                  if i <> 0 then
    17611711                    MainText[Count - 1] := MainText[Count - 1] +
    17621712                      Format(HelpText.Lookup('SPECIALFOOD'), [i]);
    1763                   i := ProdRes[Special] - ProdRes[0];
     1713                  i := ProdRes[special] - ProdRes[0];
    17641714                  if i <> 0 then
    17651715                    MainText[Count - 1] := MainText[Count - 1] +
    17661716                      Format(HelpText.Lookup('SPECIALPROD'), [i]);
    1767                   i := TradeRes[Special] - TradeRes[0];
     1717                  i := TradeRes[special] - TradeRes[0];
    17681718                  if i <> 0 then
    17691719                    MainText[Count - 1] := MainText[Count - 1] +
    … …  
    17731723            if no = 3 * 12 then
    17741724            begin
    1775               LineFeed;
     1725              LF;
    17761726              AddTextual(HelpText.Lookup('RARE'));
    17771727            end;
    … …  
    17791729            begin
    17801730              NextSection('SEEALSO');
    1781               AddImprovement(woGardens);
     1731              AddImp(woGardens);
    17821732              CheckSeeAlso := true
    17831733            end
    … …  
    17901740          Caption := HelpText.Lookup('HELPTITLE_FEATURELIST');
    17911741          List := THyperText.Create;
    1792           List.OwnsObjects := True;
    1793           for Special := 0 to 2 do
     1742          for special := 0 to 2 do
    17941743          begin
    1795             if Special > 0 then
    1796             begin
    1797               LineFeed;
    1798               LineFeed;
    1799             end;
    1800             case Special of
    1801               0: AddLine(HelpText.Lookup('HELPTITLE_FEATURE1LIST'), pkSection);
    1802               1: AddLine(HelpText.Lookup('HELPTITLE_FEATURE2LIST'), pkSection);
    1803               2: AddLine(HelpText.Lookup('HELPTITLE_FEATURE3LIST'), pkSection);
     1744            if special > 0 then
     1745            begin
     1746              LF;
     1747              LF
     1748            end;
     1749            case special of
     1750              0:
     1751                AddLine(HelpText.Lookup('HELPTITLE_FEATURE1LIST'), pkSection);
     1752              1:
     1753                AddLine(HelpText.Lookup('HELPTITLE_FEATURE2LIST'), pkSection);
     1754              2:
     1755                AddLine(HelpText.Lookup('HELPTITLE_FEATURE3LIST'), pkSection);
    18041756            end;
    18051757            List.Clear;
    … …  
    18131765                else
    18141766                  j := 1;
    1815                 if j = Special then
     1767                if j = special then
    18161768                  List.AddLine(Phrases.Lookup('FEATURES', i), pkFeature, i,
    18171769                    hkFeature, i);
    18181770              end;
    18191771            List.Sort;
    1820             AppendList(List);
     1772            AddStrings(List);
    18211773          end;
    1822           List.Free;
     1774          List.Free
    18231775        end
    18241776        else
    18251777        begin // single feature
    18261778          Caption := Phrases.Lookup('FEATURES', no);
    1827           LineFeed;
     1779          LF;
    18281780          AddLine(Phrases.Lookup('FEATURES', no), pkBigFeature, no);
    18291781          if no < mcFirstNonCap then
    … …  
    18531805          if Feature[no].Preq <> preNone then
    18541806          begin
    1855             LineFeed;
     1807            LF;
    18561808            if Feature[no].Preq = preSun then
    18571809              AddPreqImp(woSun) // sun tsu feature
    … …  
    18621814          end;
    18631815          NextSection('SEEALSO');
    1864           CheckSeeAlso := True;
     1816          CheckSeeAlso := true
    18651817        end;
    18661818
    … …  
    18711823            if i <> 2 then
    18721824              AddModelText(i);
    1873           LineFeed;
     1825          LF;
    18741826          AddItem('MODELNOTE');
    18751827        end;
    … …  
    18801832        if (SeeAlso[i].Kind = Kind) and (SeeAlso[i].no = no) then
    18811833          case SeeAlso[i].SeeKind of
    1882             hkImp: AddImprovement(SeeAlso[i].SeeNo);
    1883             hkAdv: AddAdvance(SeeAlso[i].SeeNo);
    1884             hkFeature: AddFeature(SeeAlso[i].SeeNo);
     1834            hkImp:
     1835              AddImp(SeeAlso[i].SeeNo);
     1836            hkAdv:
     1837              AddAdv(SeeAlso[i].SeeNo);
     1838            hkFeature:
     1839              AddFeature(SeeAlso[i].SeeNo);
    18851840          end;
    18861841    if (Headline >= 0) and (Count = Headline + 1) then
    18871842      Delete(Headline)
    18881843    else
    1889       LineFeed;
     1844      LF;
    18901845
    18911846    //Self.Show;
    1892     ScrollBar.Init(Count - 1, InnerHeight div 24);
    1893     ScrollBar.SetPos(sbPos);
    1894     BackBtn.Visible := HistItems.Count > 1;
    1895     TopBtn.Visible := (HistItems.Count > 1) or (Kind <> hkMisc) or (no <> miscMain);
     1847    sb.Init(Count - 1, InnerHeight div 24);
     1848    sb.SetPos(sbPos);
     1849    BackBtn.Visible := nHist > 0;
     1850    TopBtn.Visible := (nHist > 0) or (Kind <> hkMisc) or (no <> miscMain);
    18961851    Sel := -1;
    18971852  end; // with MainText
    1898 end;
    1899 
    1900 procedure THelpDlg.ShowNewContent(NewMode, Category, Index: Integer);
     1853end; { Prepare }
     1854
     1855procedure THelpDlg.ShowNewContent(NewMode, Category, Index: integer);
    19011856begin
    19021857  if (Category <> Kind) or (Index <> no) or (Category = hkMisc) and
    1903     (Index = miscSearchResult) then begin
    1904     if HistItems.Count = MaxHist then HistItems.Delete(0);
    1905     if HistItems.Count = 0 then
    1906       HistItems.AddNew(Category, Index, ScrollBar.Position, NewSearchContent)
    1907       else HistItems.AddNew(Kind, No, ScrollBar.Position, SearchContent);
     1858    (Index = miscSearchResult) then
     1859  begin
     1860    if nHist = MaxHist then
     1861    begin
     1862      move(HistKind[2], HistKind[1], 4 * (nHist - 2));
     1863      move(HistNo[2], HistNo[1], 4 * (nHist - 2));
     1864      move(HistPos[2], HistPos[1], 4 * (nHist - 2));
     1865      move(HistSearchContent[2], HistSearchContent[1],
     1866        sizeof(shortstring) * (nHist - 2));
     1867    end
     1868    else
     1869      inc(nHist);
     1870    if nHist > 0 then
     1871    begin
     1872      HistKind[nHist - 1] := Kind;
     1873      HistNo[nHist - 1] := no;
     1874      HistPos[nHist - 1] := sb.Position;
     1875      HistSearchContent[nHist - 1] := SearchContent
     1876    end
    19081877  end;
    19091878  Kind := Category;
    … …  
    19181887  x, y: integer);
    19191888var
    1920   i0, Sel0: Integer;
     1889  i0, Sel0: integer;
    19211890begin
    19221891  y := y - WideFrame;
    1923   i0 := ScrollBar.Position;
     1892  i0 := sb.Position;
    19241893  Sel0 := Sel;
    19251894  if (x >= SideFrame) and (x < SideFrame + InnerWidth) and (y >= 0) and
    … …  
    19341903  begin
    19351904    if Sel0 <> -1 then
    1936       Line(Canvas, Sel0, False);
     1905      line(Canvas, Sel0, false);
    19371906    if Sel <> -1 then
    1938       Line(Canvas, Sel, True)
     1907      line(Canvas, Sel, true)
    19391908  end
    19401909end;
    … …  
    19441913begin
    19451914  if Sel >= 0 then
    1946     with THelpLineInfo(MainText.Objects[Sel + ScrollBar.Position]) do
     1915    with THelpLineInfo(MainText.Objects[Sel + sb.Position]) do
    19471916      if Link shr 8 and $3F = hkInternet then
    19481917        case Link and $FF of
    … …  
    19631932
    19641933procedure THelpDlg.BackBtnClick(Sender: TObject);
    1965 var
    1966   HistItem: THistItem;
    1967 begin
    1968   if HistItems.Count > 1 then begin
    1969     HistItem := THistItem.Create;
    1970     HistItem.Assign(HistItems.Last);
    1971     HistItems.Delete(HistItems.Count - 1);
    1972     if (HistItem.Kind = hkMisc) and (HistItem.No = miscSearchResult) and
    1973       (HistItem.SearchContent <> SearchContent) then
    1974     begin
    1975       SearchContent := HistItem.SearchContent;
     1934begin
     1935  if nHist > 0 then
     1936  begin
     1937    dec(nHist);
     1938    if (HistKind[nHist] = hkMisc) and (HistNo[nHist] = miscSearchResult) and
     1939      (HistSearchContent[nHist] <> SearchContent) then
     1940    begin
     1941      SearchContent := HistSearchContent[nHist];
    19761942      Search(SearchContent);
    19771943    end;
    1978     Kind := HistItem.Kind;
    1979     no := HistItem.No;
    1980     Prepare(HistItem.Pos);
     1944    Kind := HistKind[nHist];
     1945    no := HistNo[nHist];
     1946    Prepare(HistPos[nHist]);
    19811947    OffscreenPaint;
    19821948    Invalidate;
    1983     HistItem.Free;
    1984   end;
     1949  end
    19851950end;
    19861951
    19871952procedure THelpDlg.TopBtnClick(Sender: TObject);
    19881953begin
    1989   while HistItems.Count > 1 do HistItems.Delete(HistItems.Count - 1);
     1954  nHist := 0;
    19901955  Kind := hkMisc;
    19911956  no := miscMain;
    … …  
    20011966end;
    20021967
    2003 function THelpDlg.TextIndex(Item: string): Integer;
    2004 begin
    2005   Result := HelpText.Gethandle(Item)
     1968function THelpDlg.TextIndex(Item: string): integer;
     1969begin
     1970  result := HelpText.Gethandle(Item)
    20061971end;
    20071972
    … …  
    20201985  InputDlg.CenterToRect(BoundsRect);
    20211986  InputDlg.ShowModal;
    2022   if (InputDlg.ModalResult = mrOK) and (Length(InputDlg.EInput.Text) >= 2) then
     1987  if (InputDlg.ModalResult = mrOK) and (length(InputDlg.EInput.Text) >= 2) then
    20231988  begin
    20241989    Search(InputDlg.EInput.Text);
    … …  
    20372002        NewSearchContent := InputDlg.EInput.Text;
    20382003        ShowNewContent(FWindowMode, hkMisc, miscSearchResult);
    2039       end;
    2040     end;
    2041   end;
     2004      end
     2005    end
     2006  end
    20422007end;
    20432008
    20442009procedure THelpDlg.Search(SearchString: string);
    20452010var
    2046   h, i, PrevHandle, PrevIndex, p, RightMargin: Integer;
     2011  h, i, PrevHandle, PrevIndex, p, RightMargin: integer;
    20472012  s: string;
    20482013  mADVHELP, mIMPHELP, mFEATUREHELP: set of 0 .. 255;
    2049   bGOVHELP, bSPECIALMODEL, bJOBHELP: Boolean;
     2014  bGOVHELP, bSPECIALMODEL, bJOBHELP: boolean;
    20502015begin
    20512016  SearchResult.Clear;
    … …  
    20532018  mIMPHELP := [];
    20542019  mFEATUREHELP := [];
    2055   bGOVHELP := False;
    2056   bSPECIALMODEL := False;
    2057   bJOBHELP := False;
     2020  bGOVHELP := false;
     2021  bSPECIALMODEL := false;
     2022  bJOBHELP := false;
    20582023
    20592024  // search in generic reference
    20602025  SearchString := UpperCase(SearchString);
    2061   for i := 0 to 35 + 4 do begin
     2026  for i := 0 to 35 + 4 do
     2027  begin
    20622028    s := Phrases.Lookup('TERRAIN', i);
    20632029    if pos(SearchString, UpperCase(s)) > 0 then
    … …  
    20742040            imShipComp + i - 37) + ' ' + HelpText.Lookup('HELPSPEC_SHIPPART'),
    20752041            pkNormal, 0, hkImp + hkCrossLink, imShipComp + i - 37);
    2076         Break;
    2077       end;
     2042        Break
     2043      end
    20782044  end;
    20792045  for i := 0 to nJobHelp - 1 do
    … …  
    20832049      SearchResult.AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'), pkNormal, 0,
    20842050        hkMisc + hkCrossLink, miscJobList);
    2085       bJOBHELP := True;
    2086       Break;
     2051      bJOBHELP := true;
     2052      Break
    20872053    end;
    20882054  for i := 0 to nAdv - 1 do
    … …  
    20972063      SearchResult.AddLine(s, pkNormal, 0, hkAdv + hkCrossLink, i);
    20982064      include(mADVHELP, i);
    2099     end;
     2065    end
    21002066  end;
    21012067  for i := 0 to nSpecialModel - 1 do
    … …  
    21062072      SearchResult.AddLine(HelpText.Lookup('HELPTITLE_MODELLIST'), pkNormal, 0,
    21072073        hkModel + hkCrossLink, 0);
    2108       bSPECIALMODEL := True;
    2109       Break;
     2074      bSPECIALMODEL := true;
     2075      Break
    21102076    end;
    21112077  end;
    … …  
    21132079  begin
    21142080    s := Phrases.Lookup('FEATURES', i);
    2115     if Pos(SearchString, UpperCase(s)) > 0 then
     2081    if pos(SearchString, UpperCase(s)) > 0 then
    21162082    begin
    21172083      if i < mcFirstNonCap then
    … …  
    21222088        s := s + ' ' + HelpText.Lookup('HELPSPEC_FEATURE');
    21232089      SearchResult.AddLine(s, pkNormal, 0, hkFeature + hkCrossLink, i);
    2124       Include(mFEATUREHELP, i);
    2125     end;
     2090      include(mFEATUREHELP, i);
     2091    end
    21262092  end;
    21272093  for i := 0 to nImp - 1 do
    21282094  begin
    21292095    s := Phrases.Lookup('IMPROVEMENTS', i);
    2130     if Pos(SearchString, UpperCase(s)) > 0 then
     2096    if pos(SearchString, UpperCase(s)) > 0 then
    21312097    begin
    21322098      case Imp[i].Kind of
    … …  
    21412107      end;
    21422108      SearchResult.AddLine(s, pkNormal, 0, hkImp + hkCrossLink, i);
    2143       Include(mIMPHELP, i);
     2109      include(mIMPHELP, i);
    21442110    end
    21452111  end;
    21462112  for i := 0 to nGov - 1 do
    2147     if Pos(SearchString, UpperCase(Phrases.Lookup('GOVERNMENT', i))) > 0 then
     2113    if pos(SearchString, UpperCase(Phrases.Lookup('GOVERNMENT', i))) > 0 then
    21482114    begin
    21492115      SearchResult.AddLine(HelpText.Lookup('HELPTITLE_GOVLIST'), pkNormal, 0,
    21502116        hkMisc + hkCrossLink, miscGovList);
    2151       bGOVHELP := True;
    2152       Break;
     2117      bGOVHELP := true;
     2118      Break
    21532119    end;
    21542120
    … …  
    21712137          s := s + ' ' + HelpText.Lookup('HELPSPEC_ADV');
    21722138        SearchResult.AddLine(s, pkNormal, 0, hkAdv + hkCrossLink, i)
    2173       end;
     2139      end
    21742140    end
    21752141    else if h = hIMPHELP then
    … …  
    21902156        end;
    21912157        SearchResult.AddLine(s, pkNormal, 0, hkImp + hkCrossLink, i)
    2192       end;
     2158      end
    21932159    end
    21942160    else if h = hFEATUREHELP then
    … …  
    22052171          s := s + ' ' + HelpText.Lookup('HELPSPEC_FEATURE');
    22062172        SearchResult.AddLine(s, pkNormal, 0, hkFeature + hkCrossLink, i);
    2207       end;
     2173      end
    22082174    end
    22092175    else if h = hGOVHELP then
    … …  
    22282194    begin
    22292195      s := HelpText.LookupByHandle(h);
    2230       p := Pos('$', s);
     2196      p := pos('$', s);
    22312197      if p > 0 then
    22322198      begin
    2233         s := Copy(s, p + 1, maxint);
    2234         p := Pos('\', s);
     2199        s := copy(s, p + 1, maxint);
     2200        p := pos('\', s);
    22352201        if p > 0 then
    2236           s := Copy(s, 1, p - 1);
     2202          s := copy(s, 1, p - 1);
    22372203        SearchResult.AddLine(s, pkNormal, 0, hkText + hkCrossLink, h);
    2238       end;
    2239     end;
    2240     until False;
     2204      end
     2205    end
     2206    until false;
    22412207
    22422208    // cut lines to fit to window

  • branches/highdpi/LocalPlayer/IsoEngine.pas

    r170 r178  
    55
    66uses
    7   Protocol, ClientTools, ScreenTools, Tribes,
     7  Protocol, ClientTools, ScreenTools, Tribes, UDpiControls,
    88{$IFNDEF SCR}Term, {$ENDIF}
    9   LCLIntf, LCLType, SysUtils, Classes, Graphics, PixelPointer;
     9  LCLIntf, LCLType, SysUtils, Classes, Graphics;
    1010
    1111type
    … …  
    1616  TIsoMap = class
    1717    constructor Create;
    18     procedure SetOutput(Output: TBitmap);
     18    procedure SetOutput(Output: TDpiBitmap);
    1919    procedure SetPaintBounds(Left, Top, Right, Bottom: integer);
    2020    procedure Paint(x, y, Loc, nx, ny, CityLoc, CityOwner: integer;
    … …  
    2424    procedure PaintCity(x, y: integer; const CityInfo: TCityInfo;
    2525      accessory: boolean = true);
    26     procedure BitBlt(Src: TBitmap; x, y, Width, Height, xSrc, ySrc,
     26    procedure BitBlt(Src: TDpiBitmap; x, y, Width, Height, xSrc, ySrc,
    2727      Rop: integer);
    2828
    … …  
    3737    procedure ShadeOutside(x0, y0, x1, y1, xm, ym: integer);
    3838  protected
    39     FOutput: TBitmap;
     39    FOutput: TDpiBitmap;
    4040    FLeft, FTop, FRight, FBottom, RealTop, RealBottom, AttLoc, DefLoc,
    4141      DefHealth, FAdviceLoc: integer;
    … …  
    113113  BordersOK: integer;
    114114  OnInitEnemyModel: TInitEnemyModelEvent;
    115   LandPatch, OceanPatch, Borders: TBitmap;
     115  LandPatch, OceanPatch, Borders: TDpiBitmap;
    116116  TSpriteSize: array [0 .. TerrainIconLines * 9 - 1] of TRect;
    117117  DebugMap: ^TTileList;
    … …  
    136136var
    137137  i, x, y, xSrc, ySrc, HGrTerrainNew, HGrCitiesNew, age, size: integer;
    138   LandMore, OceanMore, DitherMask, Mask24: TBitmap;
     138  LandMore, OceanMore, DitherMask, Mask24: TDpiBitmap;
    139139  MaskLine: array [0 .. 32 * 3 - 1] of TPixelPointer; // 32 = assumed maximum for yyt
    140140  Border: boolean;
    … …  
    165165  if LandPatch <> nil then
    166166    LandPatch.Free;
    167   LandPatch := TBitmap.Create;
     167  LandPatch := TDpiBitmap.Create;
    168168  LandPatch.PixelFormat := pf24bit;
    169169  LandPatch.Canvas.Brush.Color := 0;
    … …  
    172172  if OceanPatch <> nil then
    173173    OceanPatch.Free;
    174   OceanPatch := TBitmap.Create;
     174  OceanPatch := TDpiBitmap.Create;
    175175  OceanPatch.PixelFormat := pf24bit;
    176176  OceanPatch.Canvas.Brush.Color := 0;
    177177  OceanPatch.SetSize(xxt * 8, yyt * 4);
    178178  OceanPatch.Canvas.FillRect(0, 0, OceanPatch.Width, OceanPatch.Height);
    179   LandMore := TBitmap.Create;
     179  LandMore := TDpiBitmap.Create;
    180180  LandMore.PixelFormat := pf24bit;
    181181  LandMore.Canvas.Brush.Color := 0;
    182182  LandMore.SetSize(xxt * 18, yyt * 9);
    183183  LandMore.Canvas.FillRect(0, 0, LandMore.Width, LandMore.Height);
    184   OceanMore := TBitmap.Create;
     184  OceanMore := TDpiBitmap.Create;
    185185  OceanMore.PixelFormat := pf24bit;
    186186  OceanMore.Canvas.Brush.Color := 0;
    187187  OceanMore.SetSize(xxt * 8, yyt * 4);
    188188  OceanMore.Canvas.FillRect(0, 0, OceanMore.Width, OceanMore.Height);
    189   DitherMask := TBitmap.Create;
     189  DitherMask := TDpiBitmap.Create;
    190190  DitherMask.PixelFormat := pf24bit;
    191191  DitherMask.SetSize(xxt * 2, yyt * 2);
    … …  
    366366
    367367  // reduce size of terrain icons
    368   Mask24 := TBitmap.Create;
     368  Mask24 := TDpiBitmap.Create;
    369369  Mask24.Assign(GrExt[HGrTerrain].Mask);
    370370  Mask24.PixelFormat := pf24bit;
    … …  
    420420  if Borders <> nil then
    421421    Borders.Free;
    422   Borders := TBitmap.Create;
     422  Borders := TDpiBitmap.Create;
    423423  Borders.PixelFormat := pf24bit;
    424424  Borders.SetSize(xxt * 2,(yyt * 2) * nPl);
    … …  
    452452end;
    453453
    454 procedure TIsoMap.SetOutput(Output: TBitmap);
     454procedure TIsoMap.SetOutput(Output: TDpiBitmap);
    455455begin
    456456  FOutput := Output;
    … …  
    499499end;
    500500
    501 procedure TIsoMap.BitBlt(Src: TBitmap; x, y, Width, Height, xSrc, ySrc,
     501procedure TIsoMap.BitBlt(Src: TDpiBitmap; x, y, Width, Height, xSrc, ySrc,
    502502  Rop: integer);
    503503begin

  • branches/highdpi/LocalPlayer/MessgEx.pas

    r173 r178  
    55
    66uses
    7   Messg, Protocol, ScreenTools, Platform, DateUtils,
     7  Messg, Protocol, ScreenTools, Platform, DateUtils, UDpiControls,
    88  LCLIntf, LCLType, Messages, SysUtils, Classes, Graphics, Controls, Forms, ButtonA,
    99  ButtonB, StdCtrls, DrawDlg;
    … …  
    3232  private
    3333    MovieCancelled: boolean;
    34     procedure PaintBook(ca: TCanvas; x, y, clPage, clCover: integer);
     34    procedure PaintBook(ca: TDpiCanvas; x, y, clPage, clCover: integer);
    3535    procedure PaintMyArmy;
    3636    procedure PaintEnemyArmy;
    … …  
    7373
    7474uses
    75   ClientTools, BaseWin, Term, Help, UnitStat, Tribes, PixelPointer,
    76   IsoEngine, Diagram, Sound;
     75  ClientTools, BaseWin, Term, Help, UnitStat, Tribes,
     76  IsoEngine, Diagram;
    7777
    7878{$R *.lfm}
    … …  
    226226end;
    227227
    228 procedure TMessgExDlg.PaintBook(ca: TCanvas; x, y, clPage, clCover: integer);
     228procedure TMessgExDlg.PaintBook(ca: TDpiCanvas; x, y, clPage, clCover: integer);
    229229const
    230230  xScrewed = 77;

  • branches/highdpi/LocalPlayer/NatStat.pas

    r104 r178  
    55
    66uses
    7   Protocol, ClientTools, Term, ScreenTools, BaseWin,
    8 
     7  Protocol, ClientTools, Term, ScreenTools, BaseWin, UDpiControls,
    98  LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms,
    109  ButtonB, ButtonC, Menus, EOTButton;
    … …  
    4544    SelfReport, CurrentReport: PEnemyReport;
    4645    ShowContact, ContactEnabled: boolean;
    47     Back, Template: TBitmap;
     46    Back, Template: TDpiBitmap;
    4847    ReportText: TStringList;
    4948    procedure GenerateReportText;
    … …  
    8786  ContactBtn.Hint := Phrases.Lookup('BTN_DIALOG');
    8887
    89   Back := TBitmap.Create;
     88  Back := TDpiBitmap.Create;
    9089  Back.PixelFormat := pf24bit;
    9190  Back.SetSize(Width, Height);
    9291  Back.Canvas.FillRect(0, 0, Back.Width, Back.Height);
    93   Template := TBitmap.Create;
     92  Template := TDpiBitmap.Create;
    9493  Template.PixelFormat := pf24bit;
    9594  LoadGraphicFile(Template, HomeDir + 'Graphics' + DirectorySeparator + 'Nation.png', gfNoGamma);

  • branches/highdpi/LocalPlayer/Nego.pas

    r174 r178  
    66uses
    77  ScreenTools, BaseWin, Protocol, Term, LCLType, SysUtils, Classes, Graphics,
    8   Controls, Forms, ButtonA, ButtonB, ButtonN;
     8  Controls, Forms, ButtonA, ButtonB, ButtonN, UDpiControls;
    99
    1010const
    … …  
    1515type
    1616  THistory = record
    17     n: Integer;
    18     Text: array[0 .. MaxHistory - 1] of ansistring;
    19   end;
    20 
    21   TCommandAllowedEnum = scDipNoticeStart..scDipBreakStart;
     17    n: integer;
     18    Text: array [0 .. MaxHistory - 1] of ansistring;
     19  end;
     20
     21  TCommandAllowedEnum = scDipNoticeStart .. scDipBreakStart;
    2222
    2323  { TNegoDlg }
    … …  
    8383    CommandAllowed: set of TCommandAllowedEnum;
    8484    History: array [0 .. nPl - 1] of THistory;
    85     RomanFont: TFont;
     85    RomanFont: TDpiFont;
    8686    Costs, Delivers: array [0 .. 11] of cardinal;
    8787    procedure ResetCurrentOffer;
    … …  
    161161
    162162  fillchar(History, sizeof(History), 0);
    163   RomanFont := TFont.Create;
     163  RomanFont := TDpiFont.Create;
    164164  RomanFont.Name := 'Times New Roman';
    165165  RomanFont.Size := Round(144 * 72 / RomanFont.PixelsPerInch);

  • branches/highdpi/LocalPlayer/PVSB.pas

    r172 r178  
    99  {$ENDIF}
    1010  Classes, Controls, Forms, LCLIntf, LCLType, LMessages, Messages, SysUtils,
    11   StdCtrls, Math;
     11  StdCtrls, Math, UDpiControls;
    1212
    1313type
    … …  
    1818  private
    1919    FOnUpdate: TNotifyEvent;
    20     ScrollBar: TScrollBar;
     20    ScrollBar: TDpiScrollBar;
    2121    FMax: Integer;
    2222    function GetMax: Integer;
    … …  
    2828    procedure SetPosition(AValue: Integer);
    2929  public
    30     constructor Create(Parent: TWinControl);
     30    constructor Create(Parent: TDpiWinControl);
    3131    destructor Destroy; override;
    3232    procedure Init(Max, PageSize: Integer);
    … …  
    109109    if Max < ScrollBar.PageSize then Result := False
    110110    else begin
    111       NewPos := ScrollBar.Position - Delta div 30;
     111      NewPos := ScrollBar.Position - Delta div 300;
    112112      if NewPos < 0 then NewPos := 0;
    113113      if NewPos > Max - ScrollBar.PageSize + 1 then
    … …  
    153153begin
    154154  FMax := AValue;
    155   ScrollBar.Max := Math.Max(0, FMax);
     155  ScrollBar.Max := Math.Max(0, Max{$IFDEF LINUX} - PageSize + 1{$ENDIF});
    156156end;
    157157
    … …  
    181181end;
    182182
    183 constructor TPVScrollBar.Create(Parent: TWinControl);
     183constructor TPVScrollBar.Create(Parent: TDpiWinControl);
    184184begin
    185185  Inc(Count);
    186   ScrollBar := TScrollBar.Create(Parent);
     186  ScrollBar := TDpiScrollBar.Create(Parent);
    187187  ScrollBar.Kind := sbVertical;
    188188  ScrollBar.Name := 'PVSB' + IntToStr(Count);

  • branches/highdpi/LocalPlayer/Select.pas

    r89 r178  
    55
    66uses
    7   Protocol, ClientTools, Term, ScreenTools, IsoEngine, PVSB, BaseWin,
    8 
     7  Protocol, ClientTools, Term, ScreenTools, IsoEngine, PVSB, BaseWin, UDpiControls,
    98  LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls, Forms,
    109  ExtCtrls, ButtonB, ButtonBase, Menus, Types;
    … …  
    5352    Column: array [0 .. nPl - 1] of integer;
    5453    Closable, MultiPage: boolean;
    55     ScienceNationDot: TBitmap;
     54    ScienceNationDot: TDpiBitmap;
    5655    procedure ScrollBarUpdate(Sender: TObject);
    5756    procedure InitLines;
    58     procedure line(ca: TCanvas; l: integer; NonText, lit: boolean);
     57    procedure line(ca: TDpiCanvas; l: integer; NonText, lit: boolean);
    5958    function RenameCity(cix: integer): boolean;
    6059    function RenameModel(mix: integer): boolean;
    … …  
    110109  Layer1Btn.Hint := Phrases.Lookup('BTN_WONDERS');
    111110  Layer2Btn.Hint := Phrases.Lookup('BTN_CLASSES');
    112   ScienceNationDot := TBitmap.Create;
     111  ScienceNationDot := TDpiBitmap.Create;
    113112  ScienceNationDot.PixelFormat := pf24bit;
    114113  ScienceNationDot.SetSize(17, 17);
    … …  
    181180end;
    182181
    183 procedure TListDlg.line(ca: TCanvas; l: integer; NonText, lit: boolean);
     182procedure TListDlg.line(ca: TDpiCanvas; l: integer; NonText, lit: boolean);
    184183// paint a line
    185184

  • branches/highdpi/LocalPlayer/TechTree.pas

    r170 r178  
    66uses
    77  ScreenTools, Messg, LCLIntf, LCLType, Messages, SysUtils, Classes, Graphics,
    8   Controls, Forms, ButtonBase, ButtonB, DrawDlg;
     8  Controls, Forms, ButtonBase, ButtonB, DrawDlg, UDpiControls;
    99
    1010type
    … …  
    2323  private
    2424    xOffset, yOffset, xDown, yDown: Integer;
    25     Image: TBitmap;
     25    Image: TDpiBitmap;
    2626    dragging: boolean;
    2727  end;
    … …  
    3030  TechTreeDlg: TTechTreeDlg;
    3131
    32 
    3332implementation
    3433
    3534uses
    36   Directories, PixelPointer;
     35  Directories;
    3736
    3837{$R *.lfm}
    … …  
    126125  if Image = nil then
    127126  begin
    128     Image := TBitmap.Create;
     127    Image := TDpiBitmap.Create;
    129128    Image.PixelFormat := pf24bit;
    130129    LoadGraphicFile(Image, HomeDir + 'Help' + DirectorySeparator + 'AdvTree.png', gfNoGamma);

  • branches/highdpi/LocalPlayer/Term.pas

    r173 r178  
    1313  Protocol, Tribes, PVSB, ClientTools, ScreenTools, BaseWin, Messg, ButtonBase,
    1414  LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, DrawDlg, Types,
    15   Forms, Menus, ExtCtrls, dateutils, Platform, ButtonB, ButtonC, EOTButton, Area;
     15  Forms, Menus, ExtCtrls, dateutils, Platform, ButtonB, ButtonC, EOTButton, Area,
     16  UDpiControls;
    1617
    1718const
    … …  
    228229    BrushType: Cardinal;
    229230    trix: array [0 .. 63] of integer;
    230     AILogo: array [0 .. nPl - 1] of TBitmap;
    231     Mini, Panel, TopBar: TBitmap;
     231    AILogo: array [0 .. nPl - 1] of TDpiBitmap;
     232    Mini, Panel, TopBar: TDpiBitmap;
    232233    sb: TPVScrollbar;
    233234    Closable, RepaintOnResize, Tracking, TurnComplete, Edited, GoOnPhase,
    … …  
    276277  public
    277278    UsedOffscreenWidth, UsedOffscreenHeight: integer;
    278     Offscreen: TBitmap;
    279     OffscreenUser: TForm;
     279    Offscreen: TDpiBitmap;
     280    OffscreenUser: TDpiForm;
    280281    procedure CreateParams(var p: TCreateParams); override;
    281282    procedure Client(Command, NewPlayer: integer; var Data);
    … …  
    428429  CityRepMask: Cardinal;
    429430  ReceivedOffer: TOffer;
    430   Buffer: TBitmap;
    431   SmallImp: TBitmap;
     431  Buffer: TDpiBitmap;
     432  SmallImp: TDpiBitmap;
    432433  BlinkON: Boolean;
    433434  DestinationMarkON: Boolean;
    … …  
    455456procedure InitMyModel(mix: integer; final: boolean);
    456457
    457 procedure ImpImage(ca: TCanvas; x, y, iix: integer; Government: integer = -1;
     458procedure ImpImage(ca: TDpiCanvas; x, y, iix: integer; Government: integer = -1;
    458459  IsControl: boolean = false);
    459460procedure HelpOnTerrain(Loc, NewMode: integer);
    460461
    461 
    462462implementation
    463463
    464464uses
    465465  Directories, IsoEngine, CityScreen, Draft, MessgEx, Select, CityType, Help,
    466   UnitStat, Log, Diagram, NatStat, Wonders, Enhance, Nego, PixelPointer, Sound,
     466  UnitStat, Log, Diagram, NatStat, Wonders, Enhance, Nego,
    467467  Battle, Rates, TechTree, Registry;
    468468
    … …  
    620620end;
    621621
    622 procedure ImpImage(ca: TCanvas; x, y, iix: integer; Government: integer;
     622procedure ImpImage(ca: TDpiCanvas; x, y, iix: integer; Government: integer;
    623623  IsControl: boolean);
    624624begin
    … …  
    859859end;
    860860
    861 procedure PaintZoomedTile(dst: TBitmap; x, y, Loc: integer);
     861procedure PaintZoomedTile(dst: TDpiBitmap; x, y, Loc: integer);
    862862
    863863  procedure TSprite(xDst, yDst, xSrc, ySrc: integer);
    … …  
    10881088    if G.RO[DipMem[me].pContact] <> nil then
    10891089    begin // close windows for next player
    1090       for i := 0 to Screen.FormCount - 1 do
    1091         if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg)
     1090      for i := 0 to DpiScreen.FormCount - 1 do
     1091        if DpiScreen.Forms[i].Visible and (DpiScreen.Forms[i] is TBufferedDrawDlg)
    10921092        then
    1093           Screen.Forms[i].Close;
     1093          DpiScreen.Forms[i].Close;
    10941094    end
    10951095    else
    … …  
    11161116    if G.RO[DipMem[me].pContact] <> nil then
    11171117    begin // close windows for next player
    1118       for i := 0 to Screen.FormCount - 1 do
    1119         if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg)
     1118      for i := 0 to DpiScreen.FormCount - 1 do
     1119        if DpiScreen.Forms[i].Visible and (DpiScreen.Forms[i] is TBufferedDrawDlg)
    11201120        then
    1121           Screen.Forms[i].Close;
     1121          DpiScreen.Forms[i].Close;
    11221122    end
    11231123    else
    … …  
    12311231  begin
    12321232    if AILogo[p] = nil then
    1233       AILogo[p] := TBitmap.Create;
     1233      AILogo[p] := TDpiBitmap.Create;
    12341234    if not LoadGraphicFile(AILogo[p], HomeDir + Name + '.png', gfNoError) then
    12351235    begin
    … …  
    14971497
    14981498    HGrStdUnits := LoadGraphicSet('StdUnits.png');
    1499     SmallImp := TBitmap.Create;
     1499    SmallImp := TDpiBitmap.Create;
    15001500    SmallImp.PixelFormat := pf24bit;
    15011501    InitSmallImp;
    … …  
    18111811    end;
    18121812
    1813     for i := 0 to Screen.FormCount - 1 do
    1814       if Screen.Forms[i] is TBufferedDrawDlg then
    1815         Screen.Forms[i].Enabled := true;
     1813    for i := 0 to DpiScreen.FormCount - 1 do
     1814      if DpiScreen.Forms[i] is TBufferedDrawDlg then
     1815        DpiScreen.Forms[i].Enabled := true;
    18161816
    18171817    if ClientMode <> cResume then
    … …  
    18241824      // first turn after anarchy -- don't show despotism palace!
    18251825      Update;
    1826       for i := 0 to Screen.FormCount - 1 do
    1827         if (Screen.Forms[i].Visible) and (Screen.Forms[i] is TBufferedDrawDlg)
     1826      for i := 0 to DpiScreen.FormCount - 1 do
     1827        if (DpiScreen.Forms[i].Visible) and (DpiScreen.Forms[i] is TBufferedDrawDlg)
    18281828        then
    18291829        begin
    1830           if @Screen.Forms[i].OnShow <> nil then
    1831             Screen.Forms[i].OnShow(nil);
    1832           Screen.Forms[i].Invalidate;
    1833           Screen.Forms[i].Update;
     1830          if @DpiScreen.Forms[i].OnShow <> nil then
     1831            DpiScreen.Forms[i].OnShow(nil);
     1832          DpiScreen.Forms[i].Invalidate;
     1833          DpiScreen.Forms[i].Update;
    18341834        end;
    18351835
    … …  
    26652665        SaveSettings;
    26662666        CityDlg.CloseAction := None;
    2667         for i := 0 to Screen.FormCount - 1 do
    2668           if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg)
     2667        for i := 0 to DpiScreen.FormCount - 1 do
     2668          if DpiScreen.Forms[i].Visible and (DpiScreen.Forms[i] is TBufferedDrawDlg)
    26692669          then
    2670             Screen.Forms[i].Close;
     2670            DpiScreen.Forms[i].Close;
    26712671        if LogDlg.Visible then
    26722672          LogDlg.Close;
    … …  
    34093409  i, j: integer;
    34103410begin
    3411   MainFormKeyDown := FormKeyDown;
    34123411  BaseWin.CreateOffscreen(Offscreen);
    34133412
    … …  
    35083507  end;
    35093508
    3510   Mini := TBitmap.Create;
     3509  Mini := TDpiBitmap.Create;
    35113510  Mini.PixelFormat := pf24bit;
    3512   Panel := TBitmap.Create;
     3511  Panel := TDpiBitmap.Create;
    35133512  Panel.PixelFormat := pf24bit;
    35143513  Panel.Canvas.Font.Assign(UniFont[ftSmall]);
    35153514  Panel.Canvas.Brush.Style := bsClear;
    3516   TopBar := TBitmap.Create;
     3515  TopBar := TDpiBitmap.Create;
    35173516  TopBar.PixelFormat := pf24bit;
    35183517  TopBar.Canvas.Font.Assign(UniFont[ftNormal]);
    35193518  TopBar.Canvas.Brush.Style := bsClear;
    3520   Buffer := TBitmap.Create;
     3519  Buffer := TDpiBitmap.Create;
    35213520  Buffer.PixelFormat := pf24bit;
    35223521  if 2 * lxmax > 3 * xSizeBig then
    … …  
    35383537procedure TMainScreen.FormDestroy(Sender: TObject);
    35393538var
    3540   I: Integer;
    3541 begin
    3542   MainFormKeyDown := nil;
     3539  i: integer;
     3540begin
    35433541  FreeAndNil(sb);
    35443542  FreeAndNil(TopBar);
    … …  
    35463544  FreeAndNil(Buffer);
    35473545  FreeAndNil(Panel);
    3548   for I := 0 to nPl - 1 do
     3546  for i := 0 to nPl - 1 do
    35493547    if AILogo[i] <> nil then
    3550       FreeAndNil(AILogo[I]);
     3548      FreeAndNil(AILogo[i]);
    35513549  FreeAndNil(Offscreen);
    35523550end;
    … …  
    37533751  if supervising and (me <> 0) then
    37543752  begin
    3755     for i := 0 to Screen.FormCount - 1 do
    3756       if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then
    3757         Screen.Forms[i].Close; // close windows
     3753    for i := 0 to DpiScreen.FormCount - 1 do
     3754      if DpiScreen.Forms[i].Visible and (DpiScreen.Forms[i] is TBufferedDrawDlg) then
     3755        DpiScreen.Forms[i].Close; // close windows
    37583756    ItsMeAgain(0);
    37593757  end;
    … …  
    38993897  if IsMultiPlayerGame then
    39003898  begin // close windows for next player
    3901     for i := 0 to Screen.FormCount - 1 do
    3902       if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then
    3903         Screen.Forms[i].Close;
     3899    for i := 0 to DpiScreen.FormCount - 1 do
     3900      if DpiScreen.Forms[i].Visible and (DpiScreen.Forms[i] is TBufferedDrawDlg) then
     3901        DpiScreen.Forms[i].Close;
    39043902  end
    39053903  else
    … …  
    39113909  end;
    39123910  for i := 0 to Screen.FormCount - 1 do
    3913     if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then
    3914       Screen.Forms[i].Enabled := false;
     3911    if DpiScreen.Forms[i].Visible and (DpiScreen.Forms[i] is TBufferedDrawDlg) then
     3912      DpiScreen.Forms[i].Enabled := false;
    39153913
    39163914  if Server(sTurn, pTurn, 0, nil^) >= rExecuted then
    … …  
    41794177{$IFDEF LINUX}
    41804178// Can't do scrolling of DC under Linux, then fallback into BitBlt.
    4181 function ScrollDC(Canvas: TCanvas; dx: longint; dy: longint; const lprcScroll:TRect; const lprcClip:TRect; hrgnUpdate:HRGN; lprcUpdate: PRect):Boolean;
     4179function ScrollDC(Canvas: TDpiCanvas; dx: longint; dy: longint; const lprcScroll:TRect; const lprcClip:TRect; hrgnUpdate:HRGN; lprcUpdate: PRect):Boolean;
    41824180begin
    41834181  BitBltCanvas(Canvas, lprcScroll.Left + dx, lprcScroll.Top + dy, lprcScroll.Right - lprcScroll.Left, lprcScroll.Bottom - lprcScroll.Top,
    … …  
    50805078begin
    50815079  if idle and (me >= 0) and (GameMode <> cMovie) then
    5082     if (fsModal in Screen.ActiveForm.FormState) or
    5083       (Screen.ActiveForm is TBufferedDrawDlg) and
    5084       (TBufferedDrawDlg(Screen.ActiveForm).WindowMode <> wmPersistent) then
     5080    if (fsModal in DpiScreen.ActiveForm.FormState) or
     5081      (DpiScreen.ActiveForm is TBufferedDrawDlg) and
     5082      (TBufferedDrawDlg(DpiScreen.ActiveForm).WindowMode <> wmPersistent) then
    50855083    begin
    50865084      BlinkTime := BlinkOnTime + BlinkOffTime - 1;
    … …  
    51175115        if (dx <> 0) or (dy <> 0) then
    51185116        begin
    5119           if (Screen.ActiveForm <> MainScreen) and
    5120             (@Screen.ActiveForm.OnDeactivate <> nil) then
    5121             Screen.ActiveForm.OnDeactivate(nil);
     5117          if (DpiScreen.ActiveForm <> MainScreen) and
     5118            (@DpiScreen.ActiveForm.OnDeactivate <> nil) then
     5119            DpiScreen.ActiveForm.OnDeactivate(nil);
    51225120          Scroll(dx, dy);
    51235121        end
    … …  
    64586456    ((p = 0) or (1 shl p and G.RO[0].Alive <> 0)) then
    64596457  begin
    6460     for i := 0 to Screen.FormCount - 1 do
    6461       if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then
    6462         Screen.Forms[i].Close; // close windows
     6458    for i := 0 to DpiScreen.FormCount - 1 do
     6459      if DpiScreen.Forms[i].Visible and (DpiScreen.Forms[i] is TBufferedDrawDlg) then
     6460        DpiScreen.Forms[i].Close; // close windows
    64636461    ItsMeAgain(p);
    64646462    SumCities(TaxSum, ScienceSum);
    … …  
    80038001  Centre(CenterLoc);
    80048002  PaintAllMaps;
    8005   for i := 0 to Screen.FormCount - 1 do
    8006     if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then
    8007       TBufferedDrawDlg(Screen.Forms[i]).SmartUpdateContent(false);
     8003  for i := 0 to DpiScreen.FormCount - 1 do
     8004    if DpiScreen.Forms[i].Visible and (DpiScreen.Forms[i] is TBufferedDrawDlg) then
     8005      TBufferedDrawDlg(DpiScreen.Forms[i]).SmartUpdateContent(false);
    80088006end;
    80098007

  • branches/highdpi/LocalPlayer/UnitStat.pas

    r73 r178  
    55
    66uses
    7   Protocol, ClientTools, Term, ScreenTools, BaseWin,
     7  Protocol, ClientTools, Term, ScreenTools, BaseWin, UDpiControls,
    88  LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms,
    99  ButtonB, ButtonC;
    … …  
    4141    Kind: (dkOwnModel, dkOwnUnit, dkEnemyModel, dkEnemyUnit, dkEnemyCityDefense,
    4242      dkEnemyCity);
    43     Back, Template: TBitmap;
     43    Back, Template: TDpiBitmap;
    4444    procedure OffscreenPaint; override;
    4545  end;
    … …  
    7777  InitButtons();
    7878
    79   Back := TBitmap.Create;
     79  Back := TDpiBitmap.Create;
    8080  Back.PixelFormat := pf24bit;
    8181  Back.SetSize(5 * wCommon, hMax);
    8282  Back.Canvas.FillRect(0, 0, Back.Width,Back.Height);
    83   Template := TBitmap.Create;
     83  Template := TDpiBitmap.Create;
    8484  Template.PixelFormat := pf24bit;
    8585  LoadGraphicFile(Template, HomeDir + 'Graphics' + DirectorySeparator + 'Unit.png', gfNoGamma);
    … …  
    300300  end;
    301301
    302   procedure FeatureBar(dst: TBitmap; x, y: integer; const mi: TModelInfo;
     302  procedure FeatureBar(dst: TDpiBitmap; x, y: integer; const mi: TModelInfo;
    303303    const T: TTexture);
    304304  var
    … …  
    367367  end; { featurebar }
    368368
    369   procedure NumberBarS(dst: TBitmap; x, y: integer; Cap, s: string;
     369  procedure NumberBarS(dst: TDpiBitmap; x, y: integer; Cap, s: string;
    370370    const T: TTexture);
    371371  begin

  • branches/highdpi/LocalPlayer/Wonders.pas

    r170 r178  
    3838
    3939uses
    40   Term, ClientTools, Help, Tribes, PixelPointer;
     40  Term, ClientTools, Help, Tribes;
    4141
    4242{$R *.lfm}

  • branches/highdpi/Locale.lfm

    r167 r178  
    11object LocaleDlg: TLocaleDlg
    2   Left = 766
    3   Height = 448
     2  ClientHeight = 456
     3  ClientWidth = 483
    44  Top = 240
     5  Left = 754
    56  Width = 483
    6   BorderStyle = bsNone
     7  Height = 456
     8  Visible = False
    79  Caption = 'LocaleDlg'
    8   ClientHeight = 448
    9   ClientWidth = 483
     10  Enabled = True
     11  ShowHint = False
     12  Font.Color = clDefault
     13  Font.PixelsPerInch = 144
     14  Align = alNone
     15  Color = clDefault
     16  OnPaint = FormPaint
     17  HorzScrollBar.Visible = False
     18  VertScrollBar.Visible = False
    1019  DesignTimePPI = 144
    1120  FormStyle = fsStayOnTop
     21  BorderStyle = bsNone
     22  BorderIcons = []
     23  LCLVersion = '2.0.2.0'
     24  OnShow = FormShow
    1225  OnCreate = FormCreate
    1326  OnDestroy = FormDestroy
    14   OnPaint = FormPaint
    15   OnShow = FormShow
    16   LCLVersion = '2.0.2.0'
    17   object List: TListBox
     27  object List: TDpiListBox
    1828    Tag = 15360
     29    ClientHeight = 360
     30    ClientWidth = 424
     31    Top = 16
    1932    Left = 24
    20     Height = 336
    21     Top = 16
    2233    Width = 424
    23     Anchors = [akTop, akLeft, akRight, akBottom]
    24     BorderStyle = bsNone
    25     Color = clBlack
    26     ExtendedSelect = False
     34    Height = 360
     35    Visible = True
     36    Enabled = True
     37    ShowHint = False
    2738    Font.Color = 4176863
    28     Font.Height = -15
    2939    Font.Name = 'Times New Roman'
    3040    Font.Style = [fsBold]
    31     IntegralHeight = True
    32     ItemHeight = 0
    33     ParentFont = False
    34     ScrollWidth = 424
    35     TabOrder = 0
    36     TabStop = False
    37     TopIndex = -1
     41    Font.PixelsPerInch = 144
     42    Font.Height = -15
     43    Align = alNone
     44    Color = clBlack
    3845  end
    3946  object OKBtn: TButtonA
     47    ClientHeight = 25
     48    ClientWidth = 100
     49    Top = 400
    4050    Left = 272
     51    Width = 100
    4152    Height = 25
    42     Top = 400
    43     Width = 100
     53    Visible = True
     54    Enabled = True
     55    ShowHint = False
     56    Font.Color = clDefault
     57    Font.PixelsPerInch = 144
     58    Align = alNone
     59    Color = clDefault
     60    OnClick = OKBtnClick
    4461    Down = False
    4562    Permanent = False
    46     OnClick = OKBtnClick
    4763  end
    4864  object CancelBtn: TButtonA
     65    ClientHeight = 25
     66    ClientWidth = 100
     67    Top = 400
    4968    Left = 96
     69    Width = 100
    5070    Height = 25
    51     Top = 400
    52     Width = 100
     71    Visible = True
     72    Enabled = True
     73    ShowHint = False
     74    Font.Color = clDefault
     75    Font.PixelsPerInch = 144
     76    Align = alNone
     77    Color = clDefault
     78    OnClick = CancelBtnClick
    5379    Down = False
    5480    Permanent = False
    55     OnClick = CancelBtnClick
    56   end
    57   object ButtonFullscreen: TButtonC
    58     Left = 24
    59     Height = 18
    60     Top = 368
    61     Width = 18
    62     Down = False
    63     Permanent = False
    64     OnClick = ButtonFullscreenClick
    65     ButtonIndex = 0
    6681  end
    6782end

  • branches/highdpi/Locale.pas

    r167 r178  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
    9   ScreenTools, Messg, ButtonA, Registry, fgl, Directories, DrawDlg, ButtonC;
     9  ScreenTools, Messg, ButtonA, Registry, fgl, Directories, DrawDlg, UDpiControls;
    1010
    1111type
    … …  
    2727
    2828  TLocaleDlg = class(TDrawDlg)
    29     ButtonFullscreen: TButtonC;
    30     List: TListBox;
     29    List: TDpiListBox;
    3130    OKBtn: TButtonA;
    3231    CancelBtn: TButtonA;
    33     procedure ButtonFullscreenClick(Sender: TObject);
    3432    procedure CancelBtnClick(Sender: TObject);
    3533    procedure FormCreate(Sender: TObject);
    … …  
    103101  OkBtn.Graphic := GrExt[HGrSystem].Data;
    104102  CancelBtn.Graphic := GrExt[HGrSystem].Data;
    105 
    106   ButtonFullscreen.Graphic := GrExt[HGrSystem].Data;
    107   if FullScreen then ButtonFullscreen.ButtonIndex := 3
    108     else ButtonFullscreen.ButtonIndex := 2;
    109103end;
    110104
    … …  
    112106begin
    113107  ModalResult := mrOk;
    114 end;
    115 
    116 procedure TLocaleDlg.ButtonFullscreenClick(Sender: TObject);
    117 begin
    118   FullScreen := not FullScreen;
    119   ButtonFullscreen.ButtonIndex := ButtonFullscreen.ButtonIndex xor 1;
    120108end;
    121109
    … …  
    126114
    127115procedure TLocaleDlg.FormPaint(Sender: TObject);
    128 var
    129   S: string;
    130   W: Integer;
    131116begin
    132117  PaintBackground(self, 3, 3, ClientWidth - 6, ClientHeight - 6);
    … …  
    139124  BtnFrame(Canvas, OKBtn.BoundsRect, MainTexture);
    140125  BtnFrame(Canvas, CancelBtn.BoundsRect, MainTexture);
    141 
    142   RFrame(Canvas, ButtonFullscreen.Left - 1, ButtonFullscreen.Top - 1,
    143     ButtonFullscreen.Left + 12, ButtonFullscreen.Top + 12, MainTexture.clBevelShade,
    144     MainTexture.clBevelLight);
    145 
    146   s := Phrases.Lookup('SETTINGS', 0);
    147   LoweredTextOut(Canvas, -2, MainTexture, ButtonFullscreen.Left + 32,
    148     ButtonFullscreen.Top - 4, s);
    149126end;
    150127

  • branches/highdpi/Localization/cs/Language.txt

    r167 r178  
    942942Uspíšit\produkci
    943943Maximální\produkce
    944 
    945 #SETTINGS
    946 Celá obrazovka

  • branches/highdpi/Localization/de/Language.txt

    r167 r178  
    960960beschleunigte\Produktion
    961961maximale\Produktion
    962 
    963 #SETTINGS
    964 Full screen

  • branches/highdpi/Localization/it/Language.txt

    r167 r178  
    932932Favorisci\produzione
    933933Massimizza\produzione
    934 
    935 #SETTINGS
    936 Full screen

  • branches/highdpi/Localization/ru/Language.txt

    r167 r178  
    968968Максимум\Производства
    969969
    970 #SETTINGS
    971 Full screen

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

    r167 r178  
    960960Éú²ú×î´ó»¯
    961961
    962 #SETTINGS
    963 Full screen

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

    r167 r178  
    960960¥Í²£³Ì¤j¤Æ
    961961
    962 #SETTINGS
    963 Full screen

  • branches/highdpi/Log.pas

    r38 r178  
    66uses
    77  LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls, Forms,
    8   StdCtrls, Menus;
     8  StdCtrls, Menus, UDpiControls;
    99
    1010type
    … …  
    3333    procedure FormKeyUp(Sender: TObject; var Key: word; Shift: TShiftState);
    3434  public
    35     Host: TForm;
     35    Host: TDpiForm;
    3636    procedure Add(Level, Turn: Integer; Text: pchar);
    3737  private

  • branches/highdpi/Messg.pas

    r173 r178  
    4242
    4343implementation
    44 
    45 uses
    46   Sound;
    4744
    4845{$R *.lfm}

  • branches/highdpi/NoTerm.pas

    r144 r178  
    66uses
    77  ScreenTools, Protocol, Messg, LCLIntf, LCLType, dateutils, Platform,
    8   SysUtils, Classes, Graphics, Controls, Forms, ButtonB, DrawDlg;
     8  SysUtils, Classes, Graphics, Controls, Forms, ButtonB, DrawDlg, UDpiControls;
    99
    1010type
    … …  
    2525    G: TNewGameData;
    2626    Server: TServerCall;
    27     Shade, State: TBitmap;
     27    Shade, State: TDpiBitmap;
    2828    WinStat, ExtStat, AloneStat: array [0 .. nPl - 1] of integer;
    2929    DisallowShowActive: array [0 .. nPl - 1] of boolean;
    … …  
    147147        Server := TInitModuleData(Data).Server;
    148148        TInitModuleData(Data).Flags := aiThreaded;
    149         Shade := TBitmap.Create;
     149        Shade := TDpiBitmap.Create;
    150150        Shade.SetSize(64, 64);
    151151        for x := 0 to 63 do
    … …  
    155155            else
    156156              Shade.Canvas.Pixels[x, y] := $000000;
    157         State := TBitmap.Create;
     157        State := TDpiBitmap.Create;
    158158        State.SetSize(192, 20);
    159159        State.Canvas.Brush.Style := bsClear;
    … …  
    174174        begin
    175175          Invalidate;
    176           Update
     176          Update;
    177177        end
    178178        else

  • branches/highdpi/Packages/CevoComponents/Area.pas

    r165 r178  
    44
    55uses
    6   Classes, Graphics, Controls;
     6  Classes, Graphics, Controls, UDpiControls;
    77
    88type
    9   TArea = class(TGraphicControl)
     9  TArea = class(TDpiGraphicControl)
    1010    constructor Create(AOwner: TComponent); override;
    1111  protected
    … …  
    2020procedure Register;
    2121begin
    22   RegisterComponents('C-evo', [TArea]);
     22  RegisterComponents('Samples', [TArea]);
    2323end;
    2424
    … …  
    2626begin
    2727  inherited;
    28   Enabled := false;
    29   ShowHint := true;
     28  Enabled := False;
     29  ShowHint := True;
    3030end;
    3131

  • branches/highdpi/Packages/CevoComponents/BaseWin.pas

    r171 r178  
    55uses
    66  ScreenTools, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms,
    7   DrawDlg;
     7  DrawDlg, UDpiControls;
    88
    99type
    … …  
    3232  public
    3333    UsedOffscreenWidth, UsedOffscreenHeight: integer;
    34     Offscreen: TBitmap;
    35     OffscreenUser: TForm;
     34    Offscreen: TDpiBitmap;
     35    OffscreenUser: TDpiForm;
    3636    property WindowMode: integer read FWindowMode;
    3737  end;
    … …  
    7272  SideFrame = 9;
    7373
    74 procedure CreateOffscreen(var Offscreen: TBitmap);
     74procedure CreateOffscreen(var Offscreen: TDpiBitmap);
    7575procedure Register;
    7676
    … …  
    494494end;
    495495
    496 procedure CreateOffscreen(var Offscreen: TBitmap);
     496procedure CreateOffscreen(var Offscreen: TDpiBitmap);
    497497begin
    498498  if Offscreen <> nil then
    499499    exit;
    500   Offscreen := TBitmap.Create;
     500  Offscreen := TDpiBitmap.Create;
    501501  Offscreen.PixelFormat := pf24bit;
    502502  if Screen.Height - yUnused < 480 then

  • branches/highdpi/Packages/CevoComponents/ButtonA.pas

    r165 r178  
    55uses
    66  ButtonBase,
    7   Classes, Graphics, LCLIntf, LCLType;
     7  Classes, Graphics, LCLIntf, LCLType, UDpiControls;
    88
    99type
    … …  
    1313    FCaption: string;
    1414    procedure SetCaption(x: string);
    15     procedure SetFont(const x: TFont);
     15    procedure SetFont(const x: TDpiFont);
    1616  published
    1717    property Visible;
    … …  
    1919    property OnClick;
    2020  public
    21     property Font: TFont write SetFont;
     21    property Font: TDpiFont write SetFont;
    2222  protected
    2323    procedure Paint; override;
    … …  
    3030procedure Register;
    3131begin
    32   RegisterComponents('C-evo', [TButtonA]);
     32  RegisterComponents('Samples', [TButtonA]);
    3333end;
    3434
    … …  
    4343begin
    4444  with Canvas do
    45     if FGraphic <> nil then
    46     begin
    47       BitBlt(Canvas.Handle, 0, 0, 100, 25, Graphic.Canvas.Handle, 195,
     45    if FGraphic <> nil then begin
     46      DpiBitBlt(Canvas.Handle, 0, 0, 100, 25, Graphic.Canvas.Handle, 195,
    4847        243 + 26 * Byte(Down), SRCCOPY);
    4948      Canvas.Brush.Style := bsClear;
    50       Textout(50 - (TextWidth(FCaption) + 1) div 2, 12 - textheight(FCaption)
     49      TextOut(50 - (TextWidth(FCaption) + 1) div 2, 12 - TextHeight(FCaption)
    5150        div 2, FCaption);
    52     end
    53     else
    54     begin
     51    end else begin
    5552      Brush.Color := $0000FF;
    5653      FrameRect(Rect(0, 0, 100, 25))
    … …  
    6764end;
    6865
    69 procedure TButtonA.SetFont(const x: TFont);
     66procedure TButtonA.SetFont(const x: TDpiFont);
    7067begin
    7168  Canvas.Font.Assign(x);

  • branches/highdpi/Packages/CevoComponents/ButtonB.pas

    r165 r178  
    44
    55uses
    6   ButtonBase,
    7   Classes, Graphics, LCLIntf, LCLType;
     6  ButtonBase, Classes, Graphics, LCLIntf, LCLType, UDpiControls;
    87
    98type
    … …  
    1110    constructor Create(aOwner: TComponent); override;
    1211  private
    13     FMask: TBitmap;
     12    FMask: TDpiBitmap;
    1413    FIndex: integer;
    1514    procedure SetIndex(x: integer);
    1615  public
    17     property Mask: TBitmap read FMask write FMask;
     16    property Mask: TDpiBitmap read FMask write FMask;
    1817  published
    1918    property Visible;
    … …  
    3029procedure Register;
    3130begin
    32   RegisterComponents('C-evo', [TButtonB]);
     31  RegisterComponents('Samples', [TButtonB]);
    3332end;
    3433

  • branches/highdpi/Packages/CevoComponents/ButtonBase.pas

    r135 r178  
    44
    55uses
    6   Classes, Graphics, Controls;
     6  Classes, Graphics, Controls, UDpiControls;
    77
    88type
    9   TButtonBase = class(TGraphicControl)
     9  TButtonBase = class(TDpiGraphicControl)
    1010  protected
    1111    FDown, FPermanent: boolean;
    12     FGraphic: TBitmap;
     12    FGraphic: TDpiBitmap;
    1313    // FDownSound, FUpSound: string;
    1414    ClickProc: TNotifyEvent;
    … …  
    2626  public
    2727    constructor Create(aOwner: TComponent); override;
    28     property Graphic: TBitmap read FGraphic write FGraphic;
     28    property Graphic: TDpiBitmap read FGraphic write FGraphic;
    2929    // property DownSound: string read FDownSound write FDownSound;
    3030    // property UpSound: string read FUpSound write FUpSound;

  • branches/highdpi/Packages/CevoComponents/ButtonC.pas

    r165 r178  
    2727procedure Register;
    2828begin
    29   RegisterComponents('C-evo', [TButtonC]);
     29  RegisterComponents('Samples', [TButtonC]);
    3030end;
    3131

  • branches/highdpi/Packages/CevoComponents/ButtonN.pas

    r165 r178  
    44
    55uses
    6   Classes, Graphics, Controls, LCLIntf, LCLType;
     6  Classes, Graphics, Controls, LCLIntf, LCLType, UDpiControls;
    77
    88type
    … …  
    1111  private
    1212    FPossible, FLit: boolean;
    13     FGraphic, FMask, FBackGraphic: TBitmap;
     13    FGraphic, FMask, FBackGraphic: TDpiBitmap;
    1414    FIndex, BackIndex: integer;
    1515    FSmartHint: string;
    … …  
    2323    property Lit: boolean read FLit write SetLit;
    2424    property SmartHint: string read FSmartHint write SetSmartHint;
    25     property Graphic: TBitmap read FGraphic write FGraphic;
    26     property Mask: TBitmap read FMask write FMask;
    27     property BackGraphic: TBitmap read FBackGraphic write FBackGraphic;
     25    property Graphic: TDpiBitmap read FGraphic write FGraphic;
     26    property Mask: TDpiBitmap read FMask write FMask;
     27    property BackGraphic: TDpiBitmap read FBackGraphic write FBackGraphic;
    2828    property ButtonIndex: integer read FIndex write SetIndex;
    2929    property OnClick: TNotifyEvent read ChangeProc write ChangeProc;
    … …  
    4040procedure Register;
    4141begin
    42   RegisterComponents('C-evo', [TButtonN]);
     42  RegisterComponents('Samples', [TButtonN]);
    4343end;
    4444

  • branches/highdpi/Packages/CevoComponents/CevoComponents.lpk

    r170 r178  
    3535      </Other>
    3636    </CompilerOptions>
    37     <Description Value="C-evo components"/>
    38     <Version Major="1" Minor="2"/>
    39     <Files Count="14">
     37    <Files Count="13">
    4038      <Item1>
    4139        <Filename Value="Area.pas"/>
    … …  
    9593      <Item13>
    9694        <Filename Value="BaseWin.pas"/>
    97         <HasRegisterProc Value="True"/>
    9895        <UnitName Value="BaseWin"/>
    9996      </Item13>
    100       <Item14>
    101         <Filename Value="PixelPointer.pas"/>
    102         <UnitName Value="PixelPointer"/>
    103       </Item14>
    10497    </Files>
    105     <RequiredPkgs Count="2">
     98    <RequiredPkgs Count="3">
    10699      <Item1>
    107         <PackageName Value="LCL"/>
     100        <PackageName Value="DpiControls"/>
    108101      </Item1>
    109102      <Item2>
     103        <PackageName Value="LCL"/>
     104      </Item2>
     105      <Item3>
    110106        <PackageName Value="FCL"/>
    111       </Item2>
     107      </Item3>
    112108    </RequiredPkgs>
    113109    <UsageOptions>

  • branches/highdpi/Packages/CevoComponents/CevoComponents.pas

    r170 r178  
    1010uses
    1111  Area, ButtonA, ButtonB, ButtonC, ButtonN, EOTButton, ButtonBase, DrawDlg,
    12   Sound, BaseWin, PixelPointer, LazarusPackageIntf;
     12  Sound, BaseWin, LazarusPackageIntf;
    1313
    1414implementation
    … …  
    2323  RegisterUnit('EOTButton', @EOTButton.Register);
    2424  RegisterUnit('DrawDlg', @DrawDlg.Register);
    25   RegisterUnit('BaseWin', @BaseWin.Register);
    2625end;
    2726

  • branches/highdpi/Packages/CevoComponents/Directories.pas

    r169 r178  
    44
    55var
    6   HomeDir: string;
    7   DataDir: string;
     6  HomeDir, DataDir: string;
    87  LocaleCode: string = '';
    98  LocaleCodeAuto: string = '';
    … …  
    1110function LocalizedFilePath(const Path: string): string;
    1211procedure InitUnit;
    13 function GetSavedDir(Home: Boolean = False): string;
    14 function GetMapsDir(Home: Boolean = False): string;
    1512
    1613
    … …  
    7269  else
    7370  begin
    74     if not DirectoryExists(AppDataDir) then CreateDir(AppDataDir);
     71    if not DirectoryExists(AppDataDir) then
     72      CreateDir(AppDataDir);
    7573    DataDir := AppDataDir;
    7674  end;
    77   if not DirectoryExists(GetSavedDir) then CreateDir(GetSavedDir);
    78   if not DirectoryExists(GetMapsDir) then CreateDir(GetMapsDir);
     75  if not DirectoryExists(DataDir + 'Saved') then
     76    CreateDir(DataDir + 'Saved');
     77  if not DirectoryExists(DataDir + 'Maps') then
     78    CreateDir(DataDir + 'Maps');
    7979
    8080  // Copy appdata if not done yet
    81   if FindFirst(GetSavedDir(True) + DirectorySeparator + '*.cevo', $21, src) = 0 then
     81  if FindFirst(HomeDir + 'Saved' + DirectorySeparator + '*.cevo', $21, src) = 0 then
    8282    repeat
    83       if (FindFirst(GetSavedDir(True) + DirectorySeparator + src.Name, $21, dst) <> 0) or
     83      if (FindFirst(DataDir + 'Saved' + DirectorySeparator + src.Name, $21, dst) <> 0) or
    8484        (dst.Time < src.Time) then
    85         CopyFile(PChar(GetSavedDir(True) + DirectorySeparator + src.Name),
    86           PChar(GetSavedDir(True) + DirectorySeparator + src.Name), false);
     85        CopyFile(PChar(HomeDir + 'Saved' + DirectorySeparator + src.Name),
     86          PChar(DataDir + 'Saved' + DirectorySeparator + src.Name), false);
    8787      FindClose(dst);
    8888    until FindNext(src) <> 0;
    … …  
    9090
    9191  // Copy appdata if not done yet
    92   if FindFirst(GetMapsDir(True) + DirectorySeparator + '*.*', $21, src) = 0 then
     92  if FindFirst(HomeDir + 'Maps' + DirectorySeparator + '*.*', $21, src) = 0 then
    9393    repeat
    94       if (FindFirst(GetMapsDir(True) + DirectorySeparator + src.Name, $21, dst) <> 0) or
     94      if (FindFirst(DataDir + 'Maps' + DirectorySeparator + src.Name, $21, dst) <> 0) or
    9595        (dst.Time < src.Time) then
    96         CopyFile(PChar(GetMapsDir(True) + DirectorySeparator + src.Name),
    97           PChar(GetMapsDir(True) + DirectorySeparator + src.Name), false);
     96        CopyFile(PChar(HomeDir + 'Maps' + DirectorySeparator + src.Name),
     97          PChar(DataDir + 'Maps' + DirectorySeparator + src.Name), false);
    9898      FindClose(dst);
    9999    until FindNext(src) <> 0;
    … …  
    101101end;
    102102
    103 function GetSavedDir(Home: Boolean = False): string;
    104 begin
    105   if Home then Result := HomeDir + 'Saved'
    106     else Result := DataDir + 'Saved';
    107 end;
    108 
    109 function GetMapsDir(Home: Boolean = False): string;
    110 begin
    111   if Home then Result := HomeDir + 'Maps'
    112     else Result := DataDir + 'Maps';
    113 end;
    114 
    115103end.

  • branches/highdpi/Packages/CevoComponents/DrawDlg.pas

    r174 r178  
    77uses
    88  Classes, SysUtils, Forms, LCLIntf, LCLType, LMessages, Messages, Graphics,
    9   Controls, ButtonBase, ButtonA, ButtonB, Area, ScreenTools;
     9  Controls, ButtonBase, ButtonA, ButtonB, Area, ScreenTools, UDpiControls;
    1010
    1111type
    1212  { TDrawDlg }
    1313
    14   TDrawDlg = class(TForm)
     14  TDrawDlg = class(TDpiForm)
    1515  public
    1616    constructor Create(AOwner: TComponent); override;
    17     destructor Destroy; override;
    1817    procedure SmartInvalidate; virtual;
    19   private
    20     MoveFormPos: TPoint;
    21     MoveMousePos: TPoint;
    22     MoveActive: Boolean;
    23     procedure VisibleChangedHandler(Sender: TObject);
    2418  protected
    25     TitleHeight: Integer;
     19    TitleHeight: integer;
    2620    // defines area to grip the window for moving (from top)
    2721    procedure InitButtons;
    2822    procedure OnEraseBkgnd(var m: TMessage); message WM_ERASEBKGND;
    2923    procedure OnHitTest(var Msg: TMessage); message WM_NCHITTEST;
    30     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    31       override;
    32     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    33     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    34     procedure MouseLeave; override;
    3524  end;
    3625
    … …  
    6958  inherited;
    7059  TitleHeight := 0;
    71   MoveActive := False;
    72   AddHandlerOnVisibleChanged(VisibleChangedHandler);
    73 end;
    74 
    75 destructor TDrawDlg.Destroy;
    76 begin
    77   RemoveHandlerOnVisibleChanging(VisibleChangedHandler);
    78   inherited Destroy;
    7960end;
    8061
    … …  
    11798end;
    11899
    119 procedure TDrawDlg.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
    120   Y: Integer);
    121 var
    122   MousePosNew: TPoint;
    123   NewFormPos: TPoint;
    124 begin
    125   inherited;
    126   {$IFDEF LINUX}
    127   // HitTest is not supported under Linux GTK2 so use form inside move mechanizm
    128   NewFormPos := ScreenToClient(Mouse.CursorPos);
    129   if (NewFormPos.X >= 0) and (NewFormPos.X < Width) and
    130     (NewFormPos.Y >= 0) and (NewFormPos.Y < Height) then begin
    131     MoveMousePos := ClientToScreen(Point(X, Y));
    132     MoveFormPos := Point(Left, Top);
    133     MousePosNew := Mouse.CursorPos;
    134     // Activate move only if mouse position was not changed during inherited call
    135     if (MousePosNew.X = MoveMousePos.X) and (MousePosNew.Y = MoveMousePos.Y) then begin
    136       MoveActive := True;
    137     end;
    138   end else MoveActive := False;
    139   {$ENDIF}
    140 end;
    141 
    142 procedure TDrawDlg.MouseMove(Shift: TShiftState; X, Y: Integer);
    143 var
    144   MousePos: TPoint;
    145 begin
    146   inherited;
    147   if MoveActive then begin
    148     MousePos := ClientToScreen(Point(X, Y));
    149     SetBounds(MoveFormPos.X + MousePos.X - MoveMousePos.X,
    150       MoveFormPos.Y + MousePos.Y - MoveMousePos.Y,
    151       Width, Height);
    152   end;
    153 end;
    154 
    155 procedure TDrawDlg.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
    156   Y: Integer);
    157 begin
    158   MoveActive := False;
    159   inherited;
    160 end;
    161 
    162 procedure TDrawDlg.MouseLeave;
    163 begin
    164   MoveActive := False;
    165   inherited;
    166 end;
    167 
    168 procedure TDrawDlg.VisibleChangedHandler(Sender: TObject);
    169 begin
    170   MoveActive := False;
    171 end;
    172 
    173100procedure TDrawDlg.InitButtons;
    174101var
    … …  
    230157begin
    231158  if csDesigning in ComponentState then Exit;
    232   PaintBackground(self, 3 + Border, 3 + Border, ClientWidth - (6 + 2 * Border),
     159  PaintBackground(Self, 3 + Border, 3 + Border, ClientWidth - (6 + 2 * Border),
    233160    ClientHeight - (6 + 2 * Border));
    234161  for i := 0 to Border do

  • branches/highdpi/Packages/CevoComponents/EOTButton.pas

    r165 r178  
    44
    55uses
    6   ButtonBase, Classes, SysUtils, Graphics, LCLIntf, LCLType;
     6  ButtonBase, Classes, SysUtils, Graphics, LCLIntf, LCLType, UDpiControls;
    77
    88const
    … …  
    1919    destructor Destroy; override;
    2020    procedure SetButtonIndexFast(x: integer);
    21     procedure SetBack(ca: TCanvas; x, y: integer);
     21    procedure SetBack(ca: TDpiCanvas; x, y: integer);
    2222  private
    23     FTemplate: TBitmap;
     23    FTemplate: TDpiBitmap;
    2424    FIndex: integer;
    2525    procedure SetIndex(x: integer);
    2626  public
    27     property Template: TBitmap read FTemplate write FTemplate;
     27    property Template: TDpiBitmap read FTemplate write FTemplate;
    2828  published
    2929    property Visible;
    … …  
    3131    property OnClick;
    3232  protected
    33     Buffer, Back: TBitmap;
     33    Buffer, Back: TDpiBitmap;
    3434    procedure Paint; override;
    3535  end;
    … …  
    4141procedure Register;
    4242begin
    43   RegisterComponents('C-evo', [TEOTButton]);
     43  RegisterComponents('Samples', [TEOTButton]);
    4444end;
    4545
    46 procedure ImageOp_CBC(Dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w, h, Color0,
     46procedure ImageOp_CBC(Dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, w, h, Color0,
    4747  Color2: integer);
    4848// Src is template
    … …  
    9999begin
    100100  inherited;
    101   Buffer := TBitmap.Create;
     101  Buffer := TDpiBitmap.Create;
    102102  Buffer.PixelFormat := pf24bit;
    103103  Buffer.SetSize(48, 48);
    104104  Buffer.Canvas.FillRect(0, 0, Buffer.Width, Buffer.Height);
    105   Back := TBitmap.Create;
     105  Back := TDpiBitmap.Create;
    106106  Back.PixelFormat := pf24bit;
    107107  Back.SetSize(48, 48);
    … …  
    162162end;
    163163
    164 procedure TEOTButton.SetBack(ca: TCanvas; x, y: integer);
     164procedure TEOTButton.SetBack(ca: TDpiCanvas; x, y: integer);
    165165begin
    166166  BitBlt(Back.Canvas.Handle, 0, 0, 48, 48, ca.Handle, x, y, SRCCOPY);

  • branches/highdpi/Packages/CevoComponents/ScreenTools.pas

    r173 r178  
    88  {$ENDIF}
    99  StringTables, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls,
    10   Forms, Menus, GraphType;
     10  Forms, Menus, GraphType, UDpiControls;
    1111
    1212type
    1313  TTexture = record
    14     Image: TBitmap;
     14    Image: TDpiBitmap;
    1515    clBevelLight, clBevelShade, clTextLight, clTextShade, clLitText, clMark,
    1616    clPage, clCover: TColor;
    1717  end;
     18
     19  TColor32 = type cardinal;
     20  TColor32Component = (ccBlue, ccGreen, ccRed, ccAlpha);
     21  TPixel32 = packed record
     22    case integer of
     23      0: (B, G, R, A: byte);
     24      1: (ARGB: TColor32);
     25      2: (Planes: array[0..3] of byte);
     26      3: (Components: array[TColor32Component] of byte);
     27  end;
     28  PPixel32 = ^TPixel32;
     29
     30  { TPixelPointer }
     31
     32  TPixelPointer = record
     33    Base: PPixel32;
     34    Pixel: PPixel32;
     35    Line: PPixel32;
     36    RelLine: PPixel32;
     37    BytesPerPixel: integer;
     38    BytesPerLine: integer;
     39    procedure NextLine; inline; // Move pointer to start of new base line
     40    procedure NextPixel; inline; // Move pointer to next pixel
     41    procedure SetXY(X, Y: integer); inline; // Set pixel position relative to base
     42    procedure SetX(X: integer); inline; // Set horizontal pixel position relative to base
     43    procedure Init(Bitmap: TDpiRasterImage; BaseX: integer = 0; BaseY: integer = 0); inline;
     44  end;
     45  PPixelPointer = ^TPixelPointer;
    1846
    1947{$IFDEF WINDOWS}
    … …  
    2149{$ENDIF}
    2250procedure RestoreResolution;
     51function Play(Item: string; Index: integer = -1): boolean;
     52procedure PreparePlay(Item: string; Index: integer = -1);
    2353procedure EmptyMenu(MenuItems: TMenuItem; Keep: Integer = 0);
    2454function TurnToYear(Turn: integer): integer;
    2555function TurnToString(Turn: integer): string;
    2656function MovementToString(Movement: integer): string;
    27 procedure BtnFrame(ca: TCanvas; p: TRect; const T: TTexture);
    28 procedure EditFrame(ca: TCanvas; p: TRect; const T: TTexture);
     57procedure BtnFrame(ca: TDpiCanvas; p: TRect; const T: TTexture);
     58procedure EditFrame(ca: TDpiCanvas; p: TRect; const T: TTexture);
    2959function HexStringToColor(S: string): integer;
    30 function LoadGraphicFile(bmp: TBitmap; Path: string; Options: integer = 0): boolean;
     60function LoadGraphicFile(bmp: TDpiBitmap; Path: string; Options: integer = 0): boolean;
    3161function LoadGraphicSet(const Name: string): integer;
    32 procedure Dump(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
    33 procedure Sprite(Canvas: TCanvas; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
     62procedure Dump(dst: TDpiBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
     63procedure Sprite(Canvas: TDpiCanvas; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
    3464  overload;
    35 procedure Sprite(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
     65procedure Sprite(dst: TDpiBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
    3666  overload;
    37 procedure MakeBlue(dst: TBitmap; x, y, w, h: integer);
    38 procedure ImageOp_B(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w, h: integer);
    39 procedure ImageOp_BCC(dst, Src: TBitmap;
     67procedure MakeBlue(dst: TDpiBitmap; x, y, w, h: integer);
     68procedure ImageOp_B(dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, w, h: integer);
     69procedure ImageOp_BCC(dst, Src: TDpiBitmap;
    4070  xDst, yDst, xSrc, ySrc, w, h, Color1, Color2: integer);
    41 procedure ImageOp_CCC(bmp: TBitmap; x, y, w, h, Color0, Color1, Color2: integer);
    42 function BitBltCanvas(DestCanvas: TCanvas; X, Y, Width, Height: integer;
    43   SrcCanvas: TCanvas; XSrc, YSrc: integer; Rop: DWORD): boolean;
    44 procedure SLine(ca: TCanvas; x0, x1, y: integer; cl: TColor);
    45 procedure DLine(ca: TCanvas; x0, x1, y: integer; cl0, cl1: TColor);
    46 procedure Frame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
    47 procedure RFrame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
    48 procedure CFrame(ca: TCanvas; x0, y0, x1, y1, Corner: integer; cl: TColor);
    49 procedure FrameImage(ca: TCanvas; Src: TBitmap;
     71procedure ImageOp_CCC(bmp: TDpiBitmap; x, y, w, h, Color0, Color1, Color2: integer);
     72function BitBltCanvas(DestCanvas: TDpiCanvas; X, Y, Width, Height: integer;
     73  SrcCanvas: TDpiCanvas; XSrc, YSrc: integer; Rop: DWORD): boolean;
     74procedure SLine(ca: TDpiCanvas; x0, x1, y: integer; cl: TColor);
     75procedure DLine(ca: TDpiCanvas; x0, x1, y: integer; cl0, cl1: TColor);
     76procedure Frame(ca: TDpiCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
     77procedure RFrame(ca: TDpiCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
     78procedure CFrame(ca: TDpiCanvas; x0, y0, x1, y1, Corner: integer; cl: TColor);
     79procedure FrameImage(ca: TDpiCanvas; Src: TDpiBitmap;
    5080  x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = False);
    51 procedure GlowFrame(dst: TBitmap; x0, y0, Width, Height: integer; cl: TColor);
     81procedure GlowFrame(dst: TDpiBitmap; x0, y0, Width, Height: integer; cl: TColor);
    5282procedure InitOrnament;
    5383procedure InitCityMark(const T: TTexture);
    54 procedure Fill(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: integer);
    55 procedure FillLarge(ca: TCanvas; x0, y0, x1, y1, xm: integer);
    56 procedure FillSeamless(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: integer;
    57   const Texture: TBitmap);
    58 procedure FillRectSeamless(ca: TCanvas; x0, y0, x1, y1, xOffset, yOffset: integer;
    59   const Texture: TBitmap);
    60 procedure PaintBackground(Form: TForm; Left, Top, Width, Height: integer);
    61 procedure Corner(ca: TCanvas; x, y, Kind: integer; const T: TTexture);
    62 procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; x, y: integer; s: string);
    63 procedure LoweredTextOut(ca: TCanvas; cl: TColor; const T: TTexture;
     84procedure Fill(ca: TDpiCanvas; Left, Top, Width, Height, xOffset, yOffset: integer);
     85procedure FillLarge(ca: TDpiCanvas; x0, y0, x1, y1, xm: integer);
     86procedure FillSeamless(ca: TDpiCanvas; Left, Top, Width, Height, xOffset, yOffset: integer;
     87  const Texture: TDpiBitmap);
     88procedure FillRectSeamless(ca: TDpiCanvas; x0, y0, x1, y1, xOffset, yOffset: integer;
     89  const Texture: TDpiBitmap);
     90procedure PaintBackground(Form: TDpiForm; Left, Top, Width, Height: Integer);
     91procedure Corner(ca: TDpiCanvas; x, y, Kind: integer; const T: TTexture);
     92procedure BiColorTextOut(ca: TDpiCanvas; clMain, clBack: TColor; x, y: integer; s: string);
     93procedure LoweredTextOut(ca: TDpiCanvas; cl: TColor; const T: TTexture;
    6494  x, y: integer; s: string);
    65 function BiColorTextWidth(ca: TCanvas; s: string): integer;
    66 procedure RisedTextOut(ca: TCanvas; x, y: integer; s: string);
    67 procedure LightGradient(ca: TCanvas; x, y, Width, Color: integer);
    68 procedure DarkGradient(ca: TCanvas; x, y, Width, Kind: integer);
    69 procedure VLightGradient(ca: TCanvas; x, y, Height, Color: integer);
    70 procedure VDarkGradient(ca: TCanvas; x, y, Height, Kind: integer);
    71 procedure NumberBar(dst: TBitmap; x, y: integer; Cap: string; val: integer;
     95function BiColorTextWidth(ca: TDpiCanvas; s: string): integer;
     96procedure RisedTextOut(ca: TDpiCanvas; x, y: integer; s: string);
     97procedure LightGradient(ca: TDpiCanvas; x, y, Width, Color: integer);
     98procedure DarkGradient(ca: TDpiCanvas; x, y, Width, Kind: integer);
     99procedure VLightGradient(ca: TDpiCanvas; x, y, Height, Color: integer);
     100procedure VDarkGradient(ca: TDpiCanvas; x, y, Height, Kind: integer);
     101procedure NumberBar(dst: TDpiBitmap; x, y: integer; Cap: string; val: integer;
    72102  const T: TTexture);
    73 procedure CountBar(dst: TBitmap; x, y, w: integer; Kind: integer;
     103procedure CountBar(dst: TDpiBitmap; x, y, w: integer; Kind: integer;
    74104  Cap: string; val: integer; const T: TTexture);
    75 procedure PaintProgressBar(ca: TCanvas; Kind, x, y, pos, Growth, max: integer;
     105procedure PaintProgressBar(ca: TDpiCanvas; Kind, x, y, pos, Growth, max: integer;
    76106  const T: TTexture);
    77 procedure PaintRelativeProgressBar(ca: TCanvas;
     107procedure PaintRelativeProgressBar(ca: TDpiCanvas;
    78108  Kind, x, y, size, pos, Growth, max: integer; IndicateComplete: boolean;
    79109  const T: TTexture);
    80 procedure PaintLogo(ca: TCanvas; x, y, clLight, clShade: integer);
     110procedure PaintLogo(ca: TDpiCanvas; x, y, clLight, clShade: integer);
    81111function SetMainTextureByAge(Age: integer): boolean;
    82112procedure LoadPhrases;
    … …  
    118148  wOrna = 27;
    119149  hOrna = 26; // ornament
     150
     151  // sound modes
     152  smOff = 0;
     153  smOn = 1;
     154  smOnAlt = 2;
    120155
    121156  // color matrix
    … …  
    153188  TGrExtDescr = record { don't use dynamic strings here! }
    154189    Name: string[31];
    155     Data, Mask: TBitmap;
     190    Data, Mask: TDpiBitmap;
    156191    pixUsed: array [byte] of byte;
    157192  end;
    … …  
    166201
    167202var
    168   Phrases: TStringTable;
    169   Phrases2: TStringTable;
    170   nGrExt: Integer;
     203  Phrases, Phrases2, Sounds: TStringTable;
     204  nGrExt: integer;
    171205  GrExt: array [0 .. nGrExtmax - 1] of ^TGrExtDescr;
    172   HGrSystem, HGrSystem2, ClickFrameColor, MainTextureAge: Integer;
     206  HGrSystem, HGrSystem2, ClickFrameColor, SoundMode, MainTextureAge: integer;
    173207  MainTexture: TTexture;
    174   Templates, Colors, Paper, BigImp, LogoBuffer: TBitmap;
    175   FullScreen, GenerateNames, InitOrnamentDone, Phrases2FallenBackToEnglish: Boolean;
    176 
    177   UniFont: array [TFontType] of TFont;
     208  Templates, Colors, Paper, BigImp, LogoBuffer: TDpiBitmap;
     209  FullScreen, GenerateNames, InitOrnamentDone, Phrases2FallenBackToEnglish: boolean;
     210
     211  UniFont: array [TFontType] of TDpiFont;
    178212  AppRegistryKey: string = '\SOFTWARE\C-evo';
    179213
    … …  
    184218
    185219uses
    186   Directories, Sound, Registry, PixelPointer;
     220  Directories, Sound, Registry;
    187221
    188222var
    … …  
    221255  ResolutionChanged := False;
    222256  {$ENDIF}
     257end;
     258
     259function Play(Item: string; Index: integer = -1): boolean;
     260{$IFNDEF DEBUG}
     261var
     262  WavFileName: string;
     263{$ENDIF}
     264begin
     265  Result := False;
     266{$IFNDEF DEBUG}
     267  if (Sounds = nil) or (SoundMode = smOff) or (Item = '') then
     268  begin
     269    Result := True;
     270    Exit;
     271  end;
     272  WavFileName := Sounds.Lookup(Item, Index);
     273  Assert(WavFileName[1] <> '[');
     274  Result := (WavFileName <> '') and (WavFileName[1] <> '[') and (WavFileName <> '*');
     275  if Result then
     276    // SndPlaySound(pchar(HomeDir+'Sounds' +DirectorySeparator+WavFileName+'.wav'),SND_ASYNC)
     277    PlaySound(HomeDir + 'Sounds' + DirectorySeparator + WavFileName);
     278{$ENDIF}
     279end;
     280
     281procedure PreparePlay(Item: string; Index: Integer = -1);
     282{$IFNDEF DEBUG}
     283var
     284  WavFileName: string;
     285{$ENDIF}
     286begin
     287{$IFNDEF DEBUG}
     288  if (Sounds = nil) or (SoundMode = smOff) or (Item = '') then
     289    Exit;
     290  WavFileName := Sounds.Lookup(Item, Index);
     291  Assert(WavFileName[1] <> '[');
     292  if (WavFileName <> '') and (WavFileName[1] <> '[') and (WavFileName <> '*') then
     293    PrepareSound(HomeDir + 'Sounds' + DirectorySeparator + WavFileName);
     294{$ENDIF}
    223295end;
    224296
    … …  
    284356end;
    285357
    286 procedure BtnFrame(ca: TCanvas; p: TRect; const T: TTexture);
     358procedure BtnFrame(ca: TDpiCanvas; p: TRect; const T: TTexture);
    287359begin
    288360  RFrame(ca, p.Left - 1, p.Top - 1, p.Right, p.Bottom, T.clBevelShade,
    … …  
    290362end;
    291363
    292 procedure EditFrame(ca: TCanvas; p: TRect; const T: TTexture);
     364procedure EditFrame(ca: TDpiCanvas; p: TRect; const T: TTexture);
    293365begin
    294366  Frame(ca, p.Left - 1, p.Top - 1, p.Right, p.Bottom, $000000, $000000);
    … …  
    331403end;
    332404
    333 procedure ApplyGammaToBitmap(Bitmap: TBitmap);
     405procedure ApplyGammaToBitmap(Bitmap: TDpiBitmap);
    334406var
    335407  PixelPtr: TPixelPointer;
    … …  
    348420end;
    349421
    350 procedure CopyGray8BitTo24bitBitmap(Dst, Src: TRasterImage);
     422procedure CopyGray8BitTo24bitBitmap(Dst, Src: TDpiBitmap);
    351423var
    352424  SrcPtr, DstPtr: TPixelPointer;
    … …  
    369441end;
    370442
    371 function LoadGraphicFile(bmp: TBitmap; Path: string; Options: Integer): Boolean;
    372 var
    373   jtex: TJpegImage;
    374   Png: TPortableNetworkGraphic;
     443function LoadGraphicFile(bmp: TDpiBitmap; Path: string; Options: Integer): Boolean;
     444var
     445  jtex: TDpiJpegImage;
     446  Png: TDpiPortableNetworkGraphic;
    375447begin
    376448  Result := True;
    … …  
    378450    Path := Path + '.png';
    379451  if ExtractFileExt(Path) = '.jpg' then begin
    380     jtex := tjpegimage.Create;
     452    jtex := TDpiJpegImage.Create;
    381453    try
    382454      jtex.LoadFromFile(Path);
    … …  
    395467  else
    396468  if ExtractFileExt(Path) = '.png' then begin
    397     Png := TPortableNetworkGraphic.Create;
     469    Png := TDpiPortableNetworkGraphic.Create;
    398470    Png.PixelFormat := Bmp.PixelFormat;
    399471    try
    … …  
    414486      end
    415487      else
    416         Bmp.Canvas.draw(0, 0, Png);
     488        Bmp.Canvas.Draw(0, 0, Png);
    417489    end;
    418490    Png.Free;
    … …  
    446518  I, x, y, xmax, OriginalColor: Integer;
    447519  FileName: string;
    448   Source: TBitmap;
     520  Source: TDpiBitmap;
    449521  DataPixel, MaskPixel: TPixelPointer;
    450522begin
    … …  
    454526  Result := I;
    455527  if I = nGrExt then begin
    456     Source := TBitmap.Create;
     528    Source := TDpiBitmap.Create;
    457529    Source.PixelFormat := pf24bit;
    458530    FileName := HomeDir + 'Graphics' + DirectorySeparator + Name;
    … …  
    471543    GrExt[nGrExt].Data := Source;
    472544    GrExt[nGrExt].Data.PixelFormat := pf24bit;
    473     GrExt[nGrExt].Mask := TBitmap.Create;
     545    GrExt[nGrExt].Mask := TDpiBitmap.Create;
    474546    GrExt[nGrExt].Mask.PixelFormat := pf24bit;
    475547    GrExt[nGrExt].Mask.SetSize(Source.Width, Source.Height);
    … …  
    506578end;
    507579
    508 procedure Dump(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
     580procedure Dump(dst: TDpiBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
    509581begin
    510582  BitBlt(dst.Canvas.Handle, xDst, yDst, Width, Height,
    … …  
    512584end;
    513585
    514 procedure MakeBlue(dst: TBitmap; x, y, w, h: integer);
     586procedure MakeBlue(dst: TDpiBitmap; x, y, w, h: integer);
    515587var
    516588  XX, YY: integer;
    … …  
    531603end;
    532604
    533 procedure ImageOp_B(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w, h: Integer);
     605procedure ImageOp_B(dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, w, h: Integer);
    534606// Src is template
    535607// X channel = background amp (old Dst content), 128=original brightness
    … …  
    591663end;
    592664
    593 procedure ImageOp_BCC(dst, Src: TBitmap;
     665procedure ImageOp_BCC(dst, Src: TDpiBitmap;
    594666  xDst, yDst, xSrc, ySrc, w, h, Color1, Color2: integer);
    595667// Src is template
    … …  
    657729end;
    658730
    659 procedure ImageOp_CCC(bmp: TBitmap; x, y, w, h, Color0, Color1, Color2: Integer);
     731procedure ImageOp_CCC(bmp: TDpiBitmap; x, y, w, h, Color0, Color1, Color2: Integer);
    660732// Bmp is template
    661733// B channel = Color0 amp, 128=original brightness
    … …  
    690762end;
    691763
    692 procedure Sprite(Canvas: TCanvas; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
     764procedure Sprite(Canvas: TDpiCanvas; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
    693765begin
    694766  BitBlt(Canvas.Handle, xDst, yDst, Width, Height,
    … …  
    698770end;
    699771
    700 procedure Sprite(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
     772procedure Sprite(dst: TDpiBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
    701773begin
    702774  BitBlt(dst.Canvas.Handle, xDst, yDst, Width, Height,
    … …  
    706778end;
    707779
    708 function BitBltCanvas(DestCanvas: TCanvas; X, Y, Width, Height: integer;
    709   SrcCanvas: TCanvas; XSrc, YSrc: integer; Rop: DWORD): boolean;
     780function BitBltCanvas(DestCanvas: TDpiCanvas; X, Y, Width, Height: integer;
     781  SrcCanvas: TDpiCanvas; XSrc, YSrc: integer; Rop: DWORD): boolean;
    710782begin
    711783  Assert(Rop = SRCCOPY);
    … …  
    715787end;
    716788
    717 procedure SLine(ca: TCanvas; x0, x1, y: integer; cl: TColor);
     789procedure SLine(ca: TDpiCanvas; x0, x1, y: integer; cl: TColor);
    718790begin
    719791  with ca do begin
    … …  
    724796end;
    725797
    726 procedure DLine(ca: TCanvas; x0, x1, y: integer; cl0, cl1: TColor);
     798procedure DLine(ca: TDpiCanvas; x0, x1, y: integer; cl0, cl1: TColor);
    727799begin
    728800  with ca do begin
    … …  
    738810end;
    739811
    740 procedure Frame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
     812procedure Frame(ca: TDpiCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
    741813begin
    742814  with ca do begin
    … …  
    751823end;
    752824
    753 procedure RFrame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
     825procedure RFrame(ca: TDpiCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
    754826begin
    755827  with ca do begin
    … …  
    767839end;
    768840
    769 procedure CFrame(ca: TCanvas; x0, y0, x1, y1, Corner: integer; cl: TColor);
     841procedure CFrame(ca: TDpiCanvas; x0, y0, x1, y1, Corner: integer; cl: TColor);
    770842begin
    771843  with ca do begin
    … …  
    786858end;
    787859
    788 procedure FrameImage(ca: TCanvas; Src: TBitmap;
     860procedure FrameImage(ca: TDpiCanvas; Src: TDpiBitmap;
    789861  x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = False);
    790862begin
    … …  
    798870end;
    799871
    800 procedure GlowFrame(dst: TBitmap; x0, y0, Width, Height: Integer; cl: TColor);
     872procedure GlowFrame(dst: TDpiBitmap; x0, y0, Width, Height: Integer; cl: TColor);
    801873var
    802874  x, y, ch, r: Integer;
    … …  
    879951end;
    880952
    881 procedure Fill(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer);
     953procedure Fill(ca: TDpiCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer);
    882954begin
    883955  Assert((Left + xOffset >= 0) and (Left + xOffset + Width <= wMainTexture) and
    … …  
    887959end;
    888960
    889 procedure FillLarge(ca: TCanvas; x0, y0, x1, y1, xm: Integer);
     961procedure FillLarge(ca: TDpiCanvas; x0, y0, x1, y1, xm: Integer);
    890962
    891963  function Band(I: Integer): Integer;
    … …  
    922994end;
    923995
    924 procedure FillSeamless(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer;
    925   const Texture: TBitmap);
     996procedure FillSeamless(ca: TDpiCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer;
     997  const Texture: TDpiBitmap);
    926998var
    927999  x, y, x0cut, y0cut, x1cut, y1cut: Integer;
    … …  
    9571029end;
    9581030
    959 procedure FillRectSeamless(ca: TCanvas; x0, y0, x1, y1, xOffset, yOffset: Integer;
    960   const Texture: TBitmap);
     1031procedure FillRectSeamless(ca: TDpiCanvas; x0, y0, x1, y1, xOffset, yOffset: Integer;
     1032  const Texture: TDpiBitmap);
    9611033begin
    9621034  FillSeamless(ca, x0, y0, x1 - x0, y1 - y0, xOffset, yOffset, Texture);
    9631035end;
    9641036
    965 procedure PaintBackground(Form: TForm; Left, Top, Width, Height: Integer);
     1037procedure PaintBackground(Form: TDpiForm; Left, Top, Width, Height: Integer);
    9661038begin
    9671039  Fill(Form.Canvas, Left, Top, Width, Height, (wMainTexture - Form.ClientWidth) div
    … …  
    9691041end;
    9701042
    971 procedure Corner(ca: TCanvas; x, y, Kind: Integer; const T: TTexture);
     1043procedure Corner(ca: TDpiCanvas; x, y, Kind: Integer; const T: TTexture);
    9721044begin
    9731045  { BitBlt(ca.Handle,x,y,8,8,GrExt[T.HGr].Mask.Canvas.Handle,
    … …  
    9771049end;
    9781050
    979 procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; x, y: Integer; s: string);
     1051procedure BiColorTextOut(ca: TDpiCanvas; clMain, clBack: TColor; x, y: Integer; s: string);
    9801052
    9811053  procedure PaintIcon(x, y, Kind: Integer);
    … …  
    10381110end;
    10391111
    1040 function BiColorTextWidth(ca: TCanvas; s: string): Integer;
     1112function BiColorTextWidth(ca: TDpiCanvas; s: string): Integer;
    10411113var
    10421114  P: Integer;
    … …  
    10621134end;
    10631135
    1064 procedure LoweredTextOut(ca: TCanvas; cl: TColor; const T: TTexture;
     1136procedure LoweredTextOut(ca: TDpiCanvas; cl: TColor; const T: TTexture;
    10651137  x, y: Integer; s: string);
    10661138begin
    … …  
    10741146end;
    10751147
    1076 procedure RisedTextOut(ca: TCanvas; x, y: integer; s: string);
     1148procedure RisedTextOut(ca: TDpiCanvas; x, y: integer; s: string);
    10771149begin
    10781150  BiColorTextOut(ca, $FFFFFF, $000000, x, y, s);
    10791151end;
    10801152
    1081 procedure Gradient(ca: TCanvas; x, y, dx, dy, Width, Height, Color: Integer;
     1153procedure Gradient(ca: TDpiCanvas; x, y, dx, dy, Width, Height, Color: Integer;
    10821154  Brightness: array of integer);
    10831155var
    … …  
    11131185end;
    11141186
    1115 procedure LightGradient(ca: TCanvas; x, y, Width, Color: Integer);
     1187procedure LightGradient(ca: TDpiCanvas; x, y, Width, Color: Integer);
    11161188const
    11171189  Brightness: array [0 .. 15] of integer =
    … …  
    11211193end;
    11221194
    1123 procedure DarkGradient(ca: TCanvas; x, y, Width, Kind: Integer);
     1195procedure DarkGradient(ca: TDpiCanvas; x, y, Width, Kind: Integer);
    11241196const
    11251197  Brightness: array [0 .. 15] of integer =
    … …  
    11301202end;
    11311203
    1132 procedure VLightGradient(ca: TCanvas; x, y, Height, Color: Integer);
     1204procedure VLightGradient(ca: TDpiCanvas; x, y, Height, Color: Integer);
    11331205const
    11341206  Brightness: array [0 .. 15] of integer =
    … …  
    11381210end;
    11391211
    1140 procedure VDarkGradient(ca: TCanvas; x, y, Height, Kind: Integer);
     1212procedure VDarkGradient(ca: TDpiCanvas; x, y, Height, Kind: Integer);
    11411213const
    11421214  Brightness: array [0 .. 15] of integer =
    … …  
    11471219end;
    11481220
    1149 procedure NumberBar(dst: TBitmap; x, y: integer; Cap: string;
     1221procedure NumberBar(dst: TDpiBitmap; x, y: integer; Cap: string;
    11501222  val: Integer; const T: TTexture);
    11511223var
    … …  
    11631235end;
    11641236
    1165 procedure CountBar(dst: TBitmap; x, y, w: Integer; Kind: Integer;
     1237procedure CountBar(dst: TDpiBitmap; x, y, w: Integer; Kind: Integer;
    11661238  Cap: string; val: Integer; const T: TTexture);
    11671239var
    … …  
    12591331end;
    12601332
    1261 procedure PaintProgressBar(ca: TCanvas; Kind, x, y, pos, Growth, max: Integer;
     1333procedure PaintProgressBar(ca: TDpiCanvas; Kind, x, y, pos, Growth, max: Integer;
    12621334  const T: TTexture);
    12631335var
    … …  
    13121384
    13131385// pos and growth are relative to max, set size independent
    1314 procedure PaintRelativeProgressBar(ca: TCanvas;
     1386procedure PaintRelativeProgressBar(ca: TDpiCanvas;
    13151387  Kind, x, y, size, pos, Growth, max: Integer; IndicateComplete: Boolean;
    13161388  const T: TTexture);
    … …  
    13261398end;
    13271399
    1328 procedure PaintLogo(ca: TCanvas; x, y, clLight, clShade: Integer);
     1400procedure PaintLogo(ca: TDpiCanvas; x, y, clLight, clShade: Integer);
    13291401begin
    13301402  BitBltCanvas(LogoBuffer.Canvas, 0, 0, wLogo, hLogo, ca, x,
    … …  
    13571429end;
    13581430
     1431{ TPixelPointer }
     1432
     1433procedure TPixelPointer.NextLine; inline;
     1434begin
     1435  Line := Pointer(Line) + BytesPerLine;
     1436  Pixel := Line;
     1437end;
     1438
     1439procedure TPixelPointer.NextPixel; inline;
     1440begin
     1441  Pixel := Pointer(Pixel) + BytesPerPixel;
     1442end;
     1443
     1444procedure TPixelPointer.SetXY(X, Y: Integer); inline;
     1445begin
     1446  Line := Pointer(Base) + Y * BytesPerLine;
     1447  SetX(X);
     1448end;
     1449
     1450procedure TPixelPointer.SetX(X: Integer); inline;
     1451begin
     1452  Pixel := Pointer(Line) + X * BytesPerPixel;
     1453end;
     1454
     1455procedure TPixelPointer.Init(Bitmap: TDpiRasterImage; BaseX: Integer = 0;
     1456  BaseY: integer = 0); inline;
     1457begin
     1458  BytesPerLine := Bitmap.RawImage.Description.BytesPerLine;
     1459  BytesPerPixel := Bitmap.RawImage.Description.BitsPerPixel shr 3;
     1460  Base := PPixel32(Bitmap.RawImage.Data + BaseX * BytesPerPixel + BaseY * BytesPerLine);
     1461  SetXY(0, 0);
     1462end;
     1463
    13591464procedure LoadPhrases;
    13601465begin
    1361   if Phrases = nil then Phrases := TStringTable.Create;
    1362   if Phrases2 = nil then Phrases2 := TStringTable.Create;
     1466  if Phrases = nil then
     1467    Phrases := TStringTable.Create;
     1468  if Phrases2 = nil then
     1469    Phrases2 := TStringTable.Create;
    13631470  Phrases2FallenBackToEnglish := False;
    13641471  if FileExists(LocalizedFilePath('Language.txt')) then
    13651472  begin
    1366     Phrases.LoadFromFile(LocalizedFilePath('Language.txt'));
     1473    Phrases.loadfromfile(LocalizedFilePath('Language.txt'));
    13671474    if FileExists(LocalizedFilePath('Language2.txt')) then
    1368       Phrases2.LoadFromFile(LocalizedFilePath('Language2.txt'))
     1475      Phrases2.loadfromfile(LocalizedFilePath('Language2.txt'))
    13691476    else
    13701477    begin
    1371       Phrases2.LoadFromFile(HomeDir + 'Language2.txt');
     1478      Phrases2.loadfromfile(HomeDir + 'Language2.txt');
    13721479      Phrases2FallenBackToEnglish := True;
    13731480    end;
    … …  
    13751482  else
    13761483  begin
    1377     Phrases.LoadFromFile(HomeDir + 'Language.txt');
    1378     Phrases2.LoadFromFile(HomeDir + 'Language2.txt');
    1379   end;
    1380 
    1381   if Sounds = nil then Sounds := TStringTable.Create;
    1382   if not Sounds.LoadFromFile(HomeDir + 'Sounds' + DirectorySeparator + 'sound.txt') then
     1484    Phrases.loadfromfile(HomeDir + 'Language.txt');
     1485    Phrases2.loadfromfile(HomeDir + 'Language2.txt');
     1486  end;
     1487
     1488  if Sounds = nil then
     1489    Sounds := TStringTable.Create;
     1490  if not Sounds.loadfromfile(HomeDir + 'Sounds' + DirectorySeparator + 'sound.txt') then
    13831491  begin
    13841492    FreeAndNil(Sounds);
    … …  
    13961504begin
    13971505  for Section := Low(TFontType) to High(TFontType) do
    1398     UniFont[Section] := TFont.Create;
     1506    UniFont[Section] := TDpiFont.Create;
    13991507
    14001508  Section := ftNormal;
    … …  
    14071515        if s[1] = '#' then begin
    14081516          s := TrimRight(s);
    1409           if s = '#SMALL' then Section := ftSmall
    1410           else if s = '#TINY' then Section := ftTiny
    1411           else if s = '#CAPTION' then Section := ftCaption
    1412           else if s = '#BUTTON' then Section := ftButton
    1413           else Section := ftNormal;
     1517          if s = '#SMALL' then
     1518            Section := ftSmall
     1519          else if s = '#TINY' then
     1520            Section := ftTiny
     1521          else if s = '#CAPTION' then
     1522            Section := ftCaption
     1523          else if s = '#BUTTON' then
     1524            Section := ftButton
     1525          else
     1526            Section := ftNormal;
    14141527        end else begin
    14151528          p := Pos(',', s);
    14161529          if p > 0 then begin
    1417             UniFont[section].Name := Trim(Copy(s, 1, p - 1));
     1530            UniFont[Section].Name := Trim(Copy(s, 1, p - 1));
    14181531            Size := 0;
    14191532            for i := p + 1 to Length(s) do
    … …  
    14281541            // 0.8 constant is compensation for Lazarus as size of fonts against Delphi differs
    14291542            UniFont[section].Size :=
    1430               Round(size * Screen.PixelsPerInch / UniFont[section].PixelsPerInch * 0.8);
     1543              Round(Size * Screen.PixelsPerInch / UniFont[section].PixelsPerInch * 0.8);
    14311544          end;
    14321545        end;
    … …  
    14901603  LoadPhrases;
    14911604
    1492   LogoBuffer := TBitmap.Create;
     1605  LogoBuffer := TDpiBitmap.Create;
    14931606  LogoBuffer.PixelFormat := pf24bit;
    14941607  LogoBuffer.SetSize(wBBook, hBBook);
    … …  
    14991612  HGrSystem := LoadGraphicSet('System.png');
    15001613  HGrSystem2 := LoadGraphicSet('System2.png');
    1501   Templates := TBitmap.Create;
     1614  Templates := TDpiBitmap.Create;
    15021615  Templates.PixelFormat := pf24bit;
    15031616  LoadGraphicFile(Templates, HomeDir + 'Graphics' + DirectorySeparator +
    15041617    'Templates.png', gfNoGamma);
    1505   Colors := TBitmap.Create;
     1618  Colors := TDpiBitmap.Create;
    15061619  Colors.PixelFormat := pf24bit;
    15071620  LoadGraphicFile(Colors, HomeDir + 'Graphics' + DirectorySeparator + 'Colors.png');
    1508   Paper := TBitmap.Create;
     1621  Paper := TDpiBitmap.Create;
    15091622  Paper.PixelFormat := pf24bit;
    15101623  LoadGraphicFile(Paper, HomeDir + 'Graphics' + DirectorySeparator + 'Paper.jpg');
    1511   BigImp := TBitmap.Create;
     1624  BigImp := TDpiBitmap.Create;
    15121625  BigImp.PixelFormat := pf24bit;
    15131626  LoadGraphicFile(BigImp, HomeDir + 'Graphics' + DirectorySeparator + 'Icons.png');
    1514   MainTexture.Image := TBitmap.Create;
     1627  MainTexture.Image := TDpiBitmap.Create;
    15151628  MainTextureAge := -2;
    15161629  ClickFrameColor := GrExt[HGrSystem].Data.Canvas.Pixels[187, 175];
    … …  
    15301643      WriteString('Locale', LocaleCode);
    15311644      WriteInteger('Gamma', Gamma);
    1532       if FullScreen then WriteInteger('ScreenMode', 1)
    1533         else WriteInteger('ScreenMode', 0);
    15341645    finally
    15351646      Free;
    … …  
    15471658  FreeAndNil(Phrases);
    15481659  FreeAndNil(Phrases2);
     1660  if Sounds <> nil then
     1661    FreeAndNil(Sounds);
    15491662  FreeAndNil(LogoBuffer);
    15501663  FreeAndNil(BigImp);

  • branches/highdpi/Packages/CevoComponents/Sound.pas

    r174 r178  
    44
    55uses
    6   Messages, SysUtils, Classes, Graphics, Controls, Forms, fgl, FileUtil,
    7   StringTables, Directories
    8   {$IFDEF WINDOWS}, MMSystem, Windows{$ENDIF}
    9   {$IFDEF LINUX}, Process, AsyncProcess{$ENDIF};
     6  Messages, SysUtils, Classes, Graphics, Controls, Forms, fgl
     7  {$IFDEF WINDOWS}, MMSystem, Windows{$ENDIF};
    108
    119type
    12   TPlayStyle = (psAsync, psSync);
    13 
    1410  TSoundPlayer = class(TForm)
    1511  private
    … …  
    1915  end;
    2016
    21   { TSound }
     17function PrepareSound(FileName: string): integer;
     18procedure PlaySound(FileName: string);
    2219
     20implementation
     21
     22{$R *.lfm}
     23
     24type
    2325  TSound = class
    24   private
    25     PlayCommand: string;
    26     {$IFDEF LINUX}
    27     SoundPlayerAsyncProcess: TAsyncProcess;
    28     SoundPlayerSyncProcess: TProcess;
    29     {$ENDIF}
    30     function GetNonWindowsPlayCommand: string;
    3126  public
    32     FDeviceID: Word;
     27    FDeviceID: word;
    3328    FFileName: string;
    34     PlayStyle: TPlayStyle;
    3529    constructor Create(const FileName: string);
    3630    destructor Destroy; override;
    … …  
    4034  end;
    4135
    42 function PrepareSound(FileName: string): Integer;
    43 procedure PlaySound(FileName: string);
    44 function Play(Item: string; Index: Integer = -1): Boolean;
    45 procedure PreparePlay(Item: string; Index: Integer = -1);
    46 
    47 const
    48   // sound modes
    49   smOff = 0;
    50   smOn = 1;
    51   smOnAlt = 2;
    52 
    53 var
    54   Sounds: TStringTable;
    55   SoundMode: Integer;
    56   SoundPlayer: TSoundPlayer;
    57   SoundList: TFPGObjectList<TSound>;
    58   PlayingSound: TSound;
    59 
    60 
    61 implementation
    62 
    63 {$R *.lfm}
    64 
    65 resourcestring
    66   SUnableToPlay = 'PlayStyle=%s: Unable to play %s Message:%s';
    67   SPlayCommandNotWork = 'The play command %s does not work on your system';
    6836
    6937constructor TSound.Create(const FileName: string);
    … …  
    7341{$ENDIF}
    7442begin
    75   PlayStyle := psAsync;
    76   FFileName := FileName;
    7743  {$IFDEF WINDOWS}
    7844  FDeviceID := 0;
    79   if FileExists(FFileName) then begin
     45  FFileName := FileName;
     46  if FileExists(FFileName) then
     47  begin
    8048    OpenParm.dwCallback := 0;
    8149    OpenParm.lpstrDeviceType := 'WaveAudio';
    … …  
    8553    FDeviceID := OpenParm.wDeviceID;
    8654  end
    87   {$ENDIF}
    88   {$IFDEF LINUX}
    89   PlayCommand := GetNonWindowsPlayCommand;
    90   FDeviceID := 1;
    9155  {$ENDIF}
    9256end;
    … …  
    9862    mciSendCommand(FDeviceID, MCI_CLOSE, MCI_WAIT, 0);
    9963  {$ENDIF}
    100   {$IFDEF LINUX}
    101   FreeAndNil(SoundPlayerSyncProcess);
    102   FreeAndNil(SoundPlayerAsyncProcess);
    103   {$ENDIF}
    10464  inherited Destroy;
    10565end;
    106 
    107 function TSound.GetNonWindowsPlayCommand: string;
    108 begin
    109   Result := '';
    110   // Try play
    111   if (FindDefaultExecutablePath('play') <> '') then
    112     Result := 'play';
    113   // Try aplay
    114   if (result = '') then
    115     if (FindDefaultExecutablePath('aplay') <> '') then
    116       Result := 'aplay -q';
    117   // Try paplay
    118   if (Result = '') then
    119     if (FindDefaultExecutablePath('paplay') <> '') then
    120       Result := 'paplay';
    121   // Try mplayer
    122   if (Result = '') then
    123     if (FindDefaultExecutablePath('mplayer') <> '') then
    124       Result := 'mplayer -really-quiet';
    125   // Try CMus
    126   if (Result = '') then
    127     if (FindDefaultExecutablePath('CMus') <> '') then
    128       Result := 'CMus';
    129   // Try pacat
    130   if (Result = '') then
    131     if (FindDefaultExecutablePath('pacat') <> '') then
    132       Result := 'pacat -p';
    133   // Try ffplay
    134   if (Result = '') then
    135     if (FindDefaultExecutablePath('ffplay') <> '') then
    136       result := 'ffplay -autoexit -nodisp';
    137   // Try cvlc
    138   if (Result = '') then
    139     if (FindDefaultExecutablePath('cvlc') <> '') then
    140       result := 'cvlc -q --play-and-exit';
    141   // Try canberra-gtk-play
    142   if (Result = '') then
    143     if (FindDefaultExecutablePath('canberra-gtk-play') <> '') then
    144       Result := 'canberra-gtk-play -c never -f';
    145   // Try Macintosh command?
    146   if (Result = '') then
    147     if (FindDefaultExecutablePath('afplay') <> '') then
    148       Result := 'afplay';
    149 end;
    150 
    15166
    15267procedure TSound.Play(HWND: DWORD);
    … …  
    15469var
    15570  PlayParm: TMCI_Play_Parms;
    156 {$ENDIF}
    157 {$IFDEF LINUX}
    158 var
    159   L: TStringList;
    160   I: Integer;
    16171{$ENDIF}
    16272begin
    … …  
    16878  end
    16979  {$ENDIF}
    170   {$IFDEF LINUX}
    171   // How to play in Linux? Use generic Linux commands
    172   // Use asyncprocess to play sound as SND_ASYNC
    173   // proceed if we managed to find a valid command
    174   if PlayCommand <> '' then begin
    175     L := TStringList.Create;
    176     try
    177       L.Delimiter := ' ';
    178       L.DelimitedText := PlayCommand;
    179       if PlayStyle = psASync then begin
    180         if SoundPlayerAsyncProcess = nil then
    181           SoundPlayerAsyncProcess := TAsyncProcess.Create(nil);
    182         SoundPlayerAsyncProcess.CurrentDirectory := ExtractFileDir(FFilename);
    183         SoundPlayerAsyncProcess.Executable := FindDefaultExecutablePath(L[0]);
    184         SoundPlayerAsyncProcess.Parameters.Clear;
    185         for I := 1 to L.Count - 1 do
    186           SoundPlayerAsyncProcess.Parameters.Add(L[I]);
    187         SoundPlayerAsyncProcess.Parameters.Add(FFilename);
    188         try
    189           SoundPlayerAsyncProcess.Execute;
    190         except
    191           On E: Exception do
    192             E.CreateFmt(SUnableToPlay, ['paASync', FFilename, E.Message]);
    193         end;
    194         PlayingSound := nil;
    195       end else begin
    196         if SoundPlayerSyncProcess = nil then
    197           SoundPlayerSyncProcess := TProcess.Create(nil);
    198         SoundPlayerSyncProcess.CurrentDirectory := ExtractFileDir(FFilename);
    199         SoundPlayerSyncProcess.Executable := FindDefaultExecutablePath(L[0]);
    200         SoundPlayersyncProcess.Parameters.Clear;
    201         for I := 1 to L.Count - 1 do
    202           SoundPlayerSyncProcess.Parameters.Add(L[I]);
    203         SoundPlayerSyncProcess.Parameters.Add(FFilename);
    204         try
    205           SoundPlayerSyncProcess.Execute;
    206           SoundPlayersyncProcess.WaitOnExit;
    207         except
    208           On E: Exception do
    209             E.CreateFmt(SUnableToPlay, ['paSync', FFilename, E.Message]);
    210         end;
    211         PlayingSound := nil;
    212       end;
    213     finally
    214       L.Free;
    215     end;
    216   end
    217   else
    218     raise Exception.CreateFmt(SPlayCommandNotWork, [PlayCommand]);
    219   {$ENDIF}
    22080end;
    22181
    … …  
    22484  {$IFDEF WINDOWS}
    22585  mciSendCommand(FDeviceID, MCI_STOP, 0, 0);
    226   {$ENDIF}
    227   {$IFDEF LINUX}
    228   if SoundPlayerSyncProcess <> nil then SoundPlayerSyncProcess.Terminate(1);
    229   if SoundPlayerAsyncProcess <> nil then SoundPlayerAsyncProcess.Terminate(1);
    23086  {$ENDIF}
    23187end;
    … …  
    23793  {$ENDIF}
    23894end;
     95
     96
     97var
     98  SoundPlayer: TSoundPlayer;
     99  SoundList: TFPGObjectList<TSound>;
     100  PlayingSound: TSound;
    239101
    240102{$IFDEF WINDOWS}
    … …  
    249111{$ENDIF}
    250112
    251 function PrepareSound(FileName: string): Integer;
     113function PrepareSound(FileName: string): integer;
    252114begin
    253115  Result := 0;
    254   while (Result < SoundList.Count) and (SoundList[result].FFileName <> FileName) do
    255     Inc(Result);
    256   if Result = SoundList.Count then begin
    257     // First time this sound is played
     116  while (result < SoundList.Count) and (SoundList[result].FFileName <> FileName) do
     117    inc(result);
     118  if result = SoundList.Count then begin
     119    // first time this sound is played
    258120    SoundList.Add(TSound.Create(FileName));
    259121    Result := SoundList.Count - 1;
    … …  
    263125procedure PlaySound(FileName: string);
    264126begin
    265   if PlayingSound <> nil then Exit;
     127  if PlayingSound <> nil then
     128    exit;
    266129  if SoundPlayer = nil then
    267130    Application.CreateForm(TSoundPlayer, SoundPlayer);
    … …  
    271134  else
    272135    PlayingSound.Play(SoundPlayer.Handle);
    273 end;
    274 
    275 function Play(Item: string; Index: Integer = -1): Boolean;
    276 {$IFNDEF DEBUG}
    277 var
    278   WavFileName: string;
    279 {$ENDIF}
    280 begin
    281   Result := False;
    282 {$IFNDEF DEBUG}
    283   if (Sounds = nil) or (SoundMode = smOff) or (Item = '') then
    284   begin
    285     Result := True;
    286     Exit;
    287   end;
    288   WavFileName := Sounds.Lookup(Item, Index);
    289   Assert(WavFileName[1] <> '[');
    290   Result := (WavFileName <> '') and (WavFileName[1] <> '[') and (WavFileName <> '*');
    291   if Result then
    292     // SndPlaySound(pchar(HomeDir+'Sounds' +DirectorySeparator+WavFileName+'.wav'),SND_ASYNC)
    293     PlaySound(HomeDir + 'Sounds' + DirectorySeparator + WavFileName);
    294 {$ENDIF}
    295 end;
    296 
    297 procedure PreparePlay(Item: string; Index: Integer = -1);
    298 {$IFNDEF DEBUG}
    299 var
    300   WavFileName: string;
    301 {$ENDIF}
    302 begin
    303 {$IFNDEF DEBUG}
    304   if (Sounds = nil) or (SoundMode = smOff) or (Item = '') then
    305     Exit;
    306   WavFileName := Sounds.Lookup(Item, Index);
    307   Assert(WavFileName[1] <> '[');
    308   if (WavFileName <> '') and (WavFileName[1] <> '[') and (WavFileName <> '*') then
    309     PrepareSound(HomeDir + 'Sounds' + DirectorySeparator + WavFileName);
    310 {$ENDIF}
    311136end;
    312137
    … …  
    325150  end;
    326151  FreeAndNil(SoundList);
    327   if Sounds <> nil then
    328     FreeAndNil(Sounds);
    329152end;
    330153

  • branches/highdpi/Packages/CevoComponents/StringTables.pas

    r174 r178  
    1717    destructor Destroy; override;
    1818    function LoadFromFile(const FileName: String): boolean;
    19     function GetHandle(const Item: string): integer;
     19    function GetHandle(const Item: AnsiString): integer;
    2020    function LookupByHandle(Handle: integer; Index: integer = -1): string;
    2121    function Lookup(const Item: string; Index: integer = -1): string;
    … …  
    5555end;
    5656
    57 function TStringTable.GetHandle(const Item: string): integer;
     57function TStringTable.GetHandle(const Item: AnsiString): integer;
    5858var
    5959  I: Integer;

  • branches/highdpi/Start.lfm

    r169 r178  
    11object StartDlg: TStartDlg
    2   Left = 246
    3   Height = 326
    4   Top = 120
    5   Width = 556
    6   BorderIcons = []
    7   BorderStyle = bsNone
    8   Caption = 'C-evo'
    92  ClientHeight = 326
    103  ClientWidth = 556
     4  Top = 120
     5  Left = 246
     6  Width = 556
     7  Height = 326
     8  Visible = False
     9  Caption = 'C-evo'
     10  Enabled = True
     11  ShowHint = False
     12  Font.Color = clWindowText
     13  Font.Name = 'MS Sans Serif'
     14  Font.PixelsPerInch = 144
     15  Font.Height = -13
     16  Align = alNone
    1117  Color = clBtnFace
    12   DesignTimePPI = 144
    13   Font.Color = clWindowText
    14   Font.Height = -13
    15   Font.Name = 'MS Sans Serif'
    16   FormStyle = fsStayOnTop
    17   OnClose = FormClose
    18   OnCreate = FormCreate
    19   OnDestroy = FormDestroy
    20   OnHide = FormHide
    21   OnKeyDown = FormKeyDown
    2218  OnMouseDown = FormMouseDown
    2319  OnMouseMove = FormMouseMove
    2420  OnMouseUp = FormMouseUp
     21  OnKeyDown = FormKeyDown
    2522  OnPaint = FormPaint
     23  HorzScrollBar.Visible = False
     24  VertScrollBar.Visible = False
     25  DesignTimePPI = 144
     26  FormStyle = fsStayOnTop
     27  BorderStyle = bsNone
     28  BorderIcons = []
     29  LCLVersion = '2.0.2.0'
    2630  OnShow = FormShow
    27   LCLVersion = '2.0.2.0'
     31  OnHide = FormHide
     32  OnCreate = FormCreate
     33  OnDestroy = FormDestroy
     34  OnClose = FormClose
    2835  object StartBtn: TButtonA
    2936    Tag = 15104
     37    ClientHeight = 25
     38    ClientWidth = 100
     39    Top = 286
    3040    Left = 389
    31     Height = 25
    32     Top = 286
    3341    Width = 100
    34     Down = False
    35     Permanent = False
     42    Height = 25
     43    Visible = True
     44    Enabled = True
     45    ShowHint = False
     46    Font.Color = clDefault
     47    Font.PixelsPerInch = 144
     48    Align = alNone
     49    Color = clBtnFace
    3650    OnClick = StartBtnClick
     51    Down = False
     52    Permanent = False
    3753  end
    3854  object Down1Btn: TButtonC
    3955    Tag = 4096
     56    ClientHeight = 12
     57    ClientWidth = 12
     58    Top = 111
    4059    Left = 522
    41     Height = 12
    42     Top = 111
    43     Width = 12
    44     Down = False
    45     Permanent = False
     60    Width = 12
     61    Height = 12
     62    Visible = True
     63    Enabled = True
     64    ShowHint = True
     65    Font.Color = clDefault
     66    Font.PixelsPerInch = 144
     67    Align = alNone
     68    Color = clBtnFace
    4669    OnClick = Down1BtnClick
     70    Down = False
     71    Permanent = False
    4772    ButtonIndex = 0
    4873  end
    4974  object Up1Btn: TButtonC
    5075    Tag = 4096
     76    ClientHeight = 12
     77    ClientWidth = 12
     78    Top = 99
    5179    Left = 522
    52     Height = 12
    53     Top = 99
    54     Width = 12
    55     Down = False
    56     Permanent = False
     80    Width = 12
     81    Height = 12
     82    Visible = True
     83    Enabled = True
     84    ShowHint = True
     85    Font.Color = clDefault
     86    Font.PixelsPerInch = 144
     87    Align = alNone
     88    Color = clBtnFace
    5789    OnClick = Up1BtnClick
     90    Down = False
     91    Permanent = False
    5892    ButtonIndex = 1
    5993  end
    6094  object RenameBtn: TButtonB
    6195    Tag = 10240
     96    ClientHeight = 25
     97    ClientWidth = 25
     98    Top = 98
    6299    Left = 412
    63     Height = 25
    64     Top = 98
    65100    Width = 25
    66     Visible = False
    67     Down = False
    68     Permanent = False
     101    Height = 25
     102    Visible = False
     103    Enabled = True
     104    ShowHint = True
     105    Font.Color = clDefault
     106    Font.PixelsPerInch = 144
     107    Align = alNone
     108    Color = clBtnFace
    69109    OnClick = RenameBtnClick
     110    Down = False
     111    Permanent = False
    70112    ButtonIndex = 31
    71113  end
    72114  object DeleteBtn: TButtonB
    73115    Tag = 10240
     116    ClientHeight = 25
     117    ClientWidth = 25
     118    Top = 98
    74119    Left = 441
    75     Height = 25
    76     Top = 98
    77120    Width = 25
    78     Visible = False
    79     Down = False
    80     Permanent = False
     121    Height = 25
     122    Visible = False
     123    Enabled = True
     124    ShowHint = True
     125    Font.Color = clDefault
     126    Font.PixelsPerInch = 144
     127    Align = alNone
     128    Color = clBtnFace
    81129    OnClick = DeleteBtnClick
     130    Down = False
     131    Permanent = False
    82132    ButtonIndex = 21
    83133  end
    84134  object Down2Btn: TButtonC
    85135    Tag = 6912
     136    ClientHeight = 12
     137    ClientWidth = 12
     138    Top = 249
    86139    Left = 522
    87     Height = 12
    88     Top = 249
    89     Width = 12
    90     Visible = False
    91     Down = False
    92     Permanent = False
     140    Width = 12
     141    Height = 12
     142    Visible = False
     143    Enabled = True
     144    ShowHint = True
     145    Font.Color = clDefault
     146    Font.PixelsPerInch = 144
     147    Align = alNone
     148    Color = clBtnFace
    93149    OnClick = Down2BtnClick
     150    Down = False
     151    Permanent = False
    94152    ButtonIndex = 0
    95153  end
    96154  object Up2Btn: TButtonC
    97155    Tag = 6912
     156    ClientHeight = 12
     157    ClientWidth = 12
     158    Top = 237
    98159    Left = 522
    99     Height = 12
    100     Top = 237
    101     Width = 12
    102     Visible = False
    103     Down = False
    104     Permanent = False
     160    Width = 12
     161    Height = 12
     162    Visible = False
     163    Enabled = True
     164    ShowHint = True
     165    Font.Color = clDefault
     166    Font.PixelsPerInch = 144
     167    Align = alNone
     168    Color = clBtnFace
    105169    OnClick = Up2BtnClick
     170    Down = False
     171    Permanent = False
    106172    ButtonIndex = 1
    107173  end
    108174  object QuitBtn: TButtonB
    109175    Tag = 268435200
     176    ClientHeight = 25
     177    ClientWidth = 25
     178    Top = 7
    110179    Left = 530
    111     Height = 25
    112     Top = 7
    113180    Width = 25
    114     Down = False
    115     Permanent = False
     181    Height = 25
     182    Visible = True
     183    Enabled = True
     184    ShowHint = True
     185    Font.Color = clDefault
     186    Font.PixelsPerInch = 144
     187    Align = alNone
     188    Color = clBtnFace
    116189    OnClick = QuitBtnClick
     190    Down = False
     191    Permanent = False
    117192    ButtonIndex = 0
    118193  end
    119194  object CustomizeBtn: TButtonC
    120195    Tag = 768
     196    ClientHeight = 12
     197    ClientWidth = 12
     198    Top = 302
    121199    Left = 120
    122     Height = 12
    123     Top = 302
    124     Width = 12
    125     Down = False
    126     Permanent = False
     200    Width = 12
     201    Height = 12
     202    Visible = True
     203    Enabled = True
     204    ShowHint = True
     205    Font.Color = clDefault
     206    Font.PixelsPerInch = 144
     207    Align = alNone
     208    Color = clBtnFace
    127209    OnClick = CustomizeBtnClick
     210    Down = False
     211    Permanent = False
    128212    ButtonIndex = 0
    129213  end
    130214  object AutoDiffUpBtn: TButtonC
     215    ClientHeight = 12
     216    ClientWidth = 12
     217    Top = 237
    131218    Left = 280
    132     Height = 12
    133     Top = 237
    134     Width = 12
    135     Down = False
    136     Permanent = False
     219    Width = 12
     220    Height = 12
     221    Visible = True
     222    Enabled = True
     223    ShowHint = True
     224    Font.Color = clDefault
     225    Font.PixelsPerInch = 144
     226    Align = alNone
     227    Color = clBtnFace
    137228    OnClick = AutoDiffUpBtnClick
     229    Down = False
     230    Permanent = False
    138231    ButtonIndex = 1
    139232  end
    140233  object AutoDiffDownBtn: TButtonC
     234    ClientHeight = 12
     235    ClientWidth = 12
     236    Top = 249
    141237    Left = 280
    142     Height = 12
    143     Top = 249
    144     Width = 12
    145     Down = False
    146     Permanent = False
     238    Width = 12
     239    Height = 12
     240    Visible = True
     241    Enabled = True
     242    ShowHint = True
     243    Font.Color = clDefault
     244    Font.PixelsPerInch = 144
     245    Align = alNone
     246    Color = clBtnFace
    147247    OnClick = AutoDiffDownBtnClick
     248    Down = False
     249    Permanent = False
    148250    ButtonIndex = 0
    149251  end
    150252  object AutoEnemyUpBtn: TButtonC
     253    ClientHeight = 12
     254    ClientWidth = 12
     255    Top = 152
    151256    Left = 206
    152     Height = 12
    153     Top = 152
    154     Width = 12
    155     Down = False
    156     Permanent = False
     257    Width = 12
     258    Height = 12
     259    Visible = True
     260    Enabled = True
     261    ShowHint = True
     262    Font.Color = clDefault
     263    Font.PixelsPerInch = 144
     264    Align = alNone
     265    Color = clBtnFace
    157266    OnClick = AutoEnemyUpBtnClick
     267    Down = False
     268    Permanent = False
    158269    ButtonIndex = 1
    159270  end
    160271  object AutoEnemyDownBtn: TButtonC
     272    ClientHeight = 12
     273    ClientWidth = 12
     274    Top = 164
    161275    Left = 206
    162     Height = 12
    163     Top = 164
    164     Width = 12
    165     Down = False
    166     Permanent = False
     276    Width = 12
     277    Height = 12
     278    Visible = True
     279    Enabled = True
     280    ShowHint = True
     281    Font.Color = clDefault
     282    Font.PixelsPerInch = 144
     283    Align = alNone
     284    Color = clBtnFace
    167285    OnClick = AutoEnemyDownBtnClick
     286    Down = False
     287    Permanent = False
    168288    ButtonIndex = 0
    169289  end
    170290  object ReplayBtn: TButtonB
    171291    Tag = 2048
     292    ClientHeight = 25
     293    ClientWidth = 25
     294    Top = 286
    172295    Left = 352
    173     Height = 25
    174     Top = 286
    175296    Width = 25
    176     Down = False
    177     Permanent = False
     297    Height = 25
     298    Visible = True
     299    Enabled = True
     300    ShowHint = True
     301    Font.Color = clDefault
     302    Font.PixelsPerInch = 144
     303    Align = alNone
     304    Color = clBtnFace
    178305    OnClick = ReplayBtnClick
     306    Down = False
     307    Permanent = False
    179308    ButtonIndex = 19
    180309  end
    181   object List: TListBox
     310  object List: TDpiListBox
    182311    Tag = 15360
     312    ClientHeight = 238
     313    ClientWidth = 265
     314    Top = 64
    183315    Left = 45
     316    Width = 266
    184317    Height = 238
    185     Top = 64
    186     Width = 266
    187     BorderStyle = bsNone
    188     Color = clBlack
    189     ExtendedSelect = False
     318    Visible = False
     319    Enabled = True
     320    ShowHint = False
    190321    Font.Color = 4176863
    191     Font.Height = -15
    192322    Font.Name = 'Times New Roman'
    193323    Font.Style = [fsBold]
    194     IntegralHeight = True
    195     ItemHeight = 0
     324    Font.PixelsPerInch = 144
     325    Font.Height = -15
     326    Align = alNone
     327    Color = clBlack
    196328    OnClick = ListClick
    197     ParentFont = False
    198     ScrollWidth = 266
    199     TabOrder = 0
    200     TabStop = False
    201     TopIndex = -1
    202     Visible = False
    203329  end
    204330  object PopupMenu1: TPopupMenu

  • branches/highdpi/Start.pas

    r170 r178  
    77  GameServer, Messg, ButtonBase, ButtonA, ButtonC, ButtonB, Area, Math,
    88  LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls,
    9   Menus, Registry, DrawDlg, fgl, Protocol;
     9  Menus, Registry, DrawDlg, fgl, Protocol, UDpiControls;
    1010
    1111const
    … …  
    5656    Down1Btn: TButtonC;
    5757    Up1Btn: TButtonC;
    58     List: TListBox;
     58    List: TDpiListBox;
    5959    RenameBtn: TButtonB;
    6060    DeleteBtn: TButtonB;
    … …  
    7272    procedure FormShow(Sender: TObject);
    7373    procedure FormHide(Sender: TObject);
    74     procedure FormClose(Sender: TObject; var Action: TCloseAction);
    7574    procedure FormCreate(Sender: TObject);
    7675    procedure FormDestroy(Sender: TObject);
    7776    procedure BrainClick(Sender: TObject);
    78     procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    7977    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
    8078      Shift: TShiftState; x, y: integer);
    81     procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
    82       Shift: TShiftState; x, y: integer);
    83     procedure FormMouseMove(Sender: TObject; Shift: TShiftState; x, y: integer);
    8479    procedure Up1BtnClick(Sender: TObject);
    8580    procedure Down1BtnClick(Sender: TObject);
     81    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    8682    procedure ListClick(Sender: TObject);
    8783    procedure RenameBtnClick(Sender: TObject);
    … …  
    9288    procedure Down2BtnClick(Sender: TObject);
    9389    procedure QuitBtnClick(Sender: TObject);
     90    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    9491    procedure CustomizeBtnClick(Sender: TObject);
    9592    procedure AutoDiffUpBtnClick(Sender: TObject);
    9693    procedure AutoDiffDownBtnClick(Sender: TObject);
     94    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
     95      Shift: TShiftState; x, y: integer);
     96    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; x, y: integer);
    9797    procedure AutoEnemyUpBtnClick(Sender: TObject);
    9898    procedure AutoEnemyDownBtnClick(Sender: TObject);
    9999    procedure ReplayBtnClick(Sender: TObject);
    100100  public
    101     EmptyPicture: TBitmap;
     101    EmptyPicture: TDpiBitmap;
    102102    procedure UpdateFormerGames;
    103103    procedure UpdateMaps;
    … …  
    127127    MapFileName: string;
    128128    FormerGames, Maps: TStringList;
    129     LogoBuffer, Mini: TBitmap; { game world sample preview }
     129    LogoBuffer, Mini: TDpiBitmap; { game world sample preview }
    130130    MiniColors: array [0 .. 11, 0 .. 1] of TColor;
    131131    // BookDate: string;
    … …  
    155155
    156156uses
    157   Directories, Direct, ScreenTools, Inp, Back, Locale, PixelPointer;
     157  Directories, Direct, ScreenTools, Inp, Back, Locale;
    158158
    159159{$R *.lfm}
    … …  
    290290  PlayerSlots.Count := nPlOffered;
    291291  for i := 0 to PlayerSlots.Count - 1 do
    292   with PlayerSlots[i] do begin
     292  with TPlayerSlot(PlayerSlots[i]) do begin
    293293    DiffUpBtn := TButtonC.Create(self);
    294294    DiffUpBtn.Graphic := GrExt[HGrSystem].Data;
    … …  
    324324    CustomizeBtn.ButtonIndex := 2;
    325325
    326   Brains[0].Picture := TBitmap.Create;
     326  Brains[0].Picture := TDpiBitmap.Create;
    327327  Brains[0].Picture.SetSize(64, 64);
    328328  BitBlt(Brains[0].Picture.Canvas.Handle, 0, 0, 64, 64,
    329329    GrExt[HGrSystem2].Data.Canvas.Handle, 1, 111, SRCCOPY);
    330   Brains[1].Picture := TBitmap.Create;
     330  Brains[1].Picture := TDpiBitmap.Create;
    331331  Brains[1].Picture.SetSize(64, 64);
    332332  BitBlt(Brains[1].Picture.Canvas.Handle, 0, 0, 64, 64,
    333333    GrExt[HGrSystem2].Data.Canvas.Handle, 66, 111, SRCCOPY);
    334   Brains[2].Picture := TBitmap.Create;
     334  Brains[2].Picture := TDpiBitmap.Create;
    335335  Brains[2].Picture.SetSize(64, 64);
    336336  BitBlt(Brains[2].Picture.Canvas.Handle, 0, 0, 64, 64,
    337337    GrExt[HGrSystem2].Data.Canvas.Handle, 131, 111, SRCCOPY);
    338   Brains[3].Picture := TBitmap.Create;
     338  Brains[3].Picture := TDpiBitmap.Create;
    339339  Brains[3].Picture.SetSize(64, 64);
    340340  BitBlt(Brains[3].Picture.Canvas.Handle, 0, 0, 64, 64,
    … …  
    346346  with AIBrains[I] do
    347347  begin
    348     AIBrains[i].Picture := TBitmap.Create;
     348    AIBrains[i].Picture := TDpiBitmap.Create;
    349349    if not LoadGraphicFile(AIBrains[i].Picture, HomeDir + 'AI' + DirectorySeparator +
    350350      FileName + DirectorySeparator + FileName + '.png', gfNoError) then begin
    … …  
    363363  AIBrains.Free;
    364364
    365   EmptyPicture := TBitmap.Create;
     365  EmptyPicture := TDpiBitmap.Create;
    366366  EmptyPicture.PixelFormat := pf24bit;
    367367  EmptyPicture.SetSize(64, 64);
    368368  EmptyPicture.Canvas.FillRect(0, 0, EmptyPicture.Width, EmptyPicture.Height);
    369   LogoBuffer := TBitmap.Create;
     369  LogoBuffer := TDpiBitmap.Create;
    370370  LogoBuffer.PixelFormat := pf24bit;
    371371  LogoBuffer.SetSize(wBuffer, 56);
    372372  LogoBuffer.Canvas.FillRect(0, 0, LogoBuffer.Width, LogoBuffer.Height);
    373373
    374   Mini := TBitmap.Create;
     374  Mini := TDpiBitmap.Create;
    375375  for x := 0 to 11 do
    376376    for y := 0 to 1 do
    … …  
    926926      begin // load
    927927        FileName := List.Items[List.ItemIndex];
    928         if LoadGame(GetSavedDir + DirectorySeparator, FileName + CevoExt, LoadTurn, false)
     928        if LoadGame(DataDir + 'Saved' + DirectorySeparator, FileName + CevoExt, LoadTurn, false)
    929929        then
    930930          UnlistBackupFile(FileName)
    … …  
    10101010        end;
    10111011
    1012         StartNewGame(GetSavedDir + DirectorySeparator, FileName + CevoExt, MapFileName,
     1012        StartNewGame(DataDir + 'Saved' + DirectorySeparator, FileName + CevoExt, MapFileName,
    10131013          lxpre[WorldSize], lypre[WorldSize], StartLandMass, MaxTurn);
    10141014        UnlistBackupFile(FileName);
    … …  
    11451145    pgLoad:
    11461146      begin
    1147         AssignFile(LogFile, GetSavedDir + DirectorySeparator + List.Items[List.ItemIndex]
     1147        AssignFile(LogFile, DataDir + 'Saved' + DirectorySeparator + List.Items[List.ItemIndex]
    11481148          + CevoExt);
    11491149        try
    … …  
    11981198        if Page = pgEditMap then
    11991199          MapFileName := List.Items[List.ItemIndex] + CevoMapExt;
    1200         if LoadGraphicFile(Mini, GetMapsDir + DirectorySeparator + Copy(MapFileName, 1,
     1200        if LoadGraphicFile(Mini, DataDir + 'Maps' + DirectorySeparator + Copy(MapFileName, 1,
    12011201          Length(MapFileName) - 9) + '.png', gfNoError) then
    12021202        begin
    … …  
    12151215        end;
    12161216
    1217         AssignFile(MapFile, GetMapsDir + DirectorySeparator + MapFileName);
     1217        AssignFile(MapFile, DataDir + 'Maps' + DirectorySeparator + MapFileName);
    12181218        try
    12191219          Reset(MapFile, 4);
    … …  
    13951395begin
    13961396  FormerGames.Clear;
    1397   if FindFirst(GetSavedDir + DirectorySeparator + '*' + CevoExt, $21, F) = 0 then
     1397  if FindFirst(DataDir + 'Saved' + DirectorySeparator + '*' + CevoExt, $21, F) = 0 then
    13981398    repeat
    13991399      I := FormerGames.Count;
    … …  
    14151415begin
    14161416  Maps.Clear;
    1417   if FindFirst(GetMapsDir + DirectorySeparator + '*' + CevoMapExt, $21, f) = 0 then
     1417  if FindFirst(DataDir + 'Maps' + DirectorySeparator + '*' + CevoMapExt, $21, f) = 0 then
    14181418    repeat
    14191419      Maps.Add(Copy(f.Name, 1, Length(f.Name) - 9));
    … …  
    17901790        end;
    17911791      if Page = pgLoad then
    1792         AssignFile(f, GetSavedDir + DirectorySeparator + List.Items[List.ItemIndex] + CevoExt)
     1792        AssignFile(f, DataDir + 'Saved' + DirectorySeparator + List.Items[List.ItemIndex] + CevoExt)
    17931793      else
    1794         AssignFile(f, GetMapsDir + DirectorySeparator + List.Items[List.ItemIndex] +
     1794        AssignFile(f, DataDir + 'Maps'+ DirectorySeparator + List.Items[List.ItemIndex] +
    17951795          CevoMapExt);
    17961796      ok := true;
    17971797      try
    17981798        if Page = pgLoad then
    1799           Rename(f, GetSavedDir + DirectorySeparator + NewName + CevoExt)
     1799          Rename(f, DataDir + 'Saved'+ DirectorySeparator + NewName + CevoExt)
    18001800        else
    1801           Rename(f, GetMapsDir + DirectorySeparator + NewName + CevoMapExt);
     1801          Rename(f, DataDir + 'Maps'+ DirectorySeparator + NewName + CevoMapExt);
    18021802      except
    18031803        // Play('INVALID');
    … …  
    18061806      if Page <> pgLoad then
    18071807        try // rename map picture
    1808           AssignFile(f, GetMapsDir + DirectorySeparator + List.Items[List.ItemIndex]
     1808          AssignFile(f, DataDir + 'Maps'+ DirectorySeparator + List.Items[List.ItemIndex]
    18091809            + '.png');
    1810           Rename(f, GetMapsDir + DirectorySeparator + NewName + '.png');
     1810          Rename(f, DataDir + 'Maps'+ DirectorySeparator + NewName + '.png');
    18111811        except
    18121812        end;
    … …  
    18421842    begin
    18431843      if Page = pgLoad then
    1844         AssignFile(f, GetSavedDir + DirectorySeparator + List.Items[List.ItemIndex] + CevoExt)
     1844        AssignFile(f, DataDir + 'Saved' + DirectorySeparator + List.Items[List.ItemIndex] + CevoExt)
    18451845      else
    1846         AssignFile(f, GetMapsDir + DirectorySeparator + List.Items[List.ItemIndex] +
     1846        AssignFile(f, DataDir + 'Maps' + DirectorySeparator + List.Items[List.ItemIndex] +
    18471847          CevoMapExt);
    18481848      Erase(f);
    … …  
    20362036procedure TStartDlg.ReplayBtnClick(Sender: TObject);
    20372037begin
    2038   LoadGame(GetSavedDir + DirectorySeparator, List.Items[List.ItemIndex] + CevoExt,
     2038  LoadGame(DataDir + 'Saved' + DirectorySeparator, List.Items[List.ItemIndex] + CevoExt,
    20392039    LastTurn, True);
    20402040  SlotAvailable := -1;
Note: See TracChangeset for help on using the changeset viewer.