Ignore:
Timestamp:
Nov 30, 2023, 10:16:14 PM (12 months ago)
Author:
chronos
Message:
  • Modified: Updated high dpi branch from trunk.
  • Modified: Use generics.collections instead of fgl.
  • Modified: Compile with Delphi syntax.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/highdpi/LocalPlayer/CityType.pas

    r361 r465  
    55
    66uses
    7   UDpiControls, Protocol, ClientTools, Term, ScreenTools, BaseWin, LCLIntf, LCLType,
    8   SysUtils, Classes, Graphics, Controls, Forms,
    9   ButtonB, ExtCtrls;
     7  UDpiControls, Protocol, ClientTools, ScreenTools, BaseWin, LCLIntf, LCLType,
     8  SysUtils, Classes, Graphics, Controls, Forms, ButtonB, ExtCtrls;
    109
    1110type
    … …  
    1817    procedure FormShow(Sender: TObject);
    1918    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
    20       Shift: TShiftState; x, y: integer);
     19      Shift: TShiftState; X, Y: Integer);
    2120    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
    22       Shift: TShiftState; x, y: integer);
     21      Shift: TShiftState; X, Y: Integer);
    2322    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    2423    procedure DeleteBtnClick(Sender: TObject);
    2524  public
    26     procedure ShowNewContent(NewMode: integer);
     25    procedure ShowNewContent(NewMode: TWindowMode);
    2726  protected
    2827    procedure OffscreenPaint; override;
    2928  private
    30     nPool, dragiix, ctype: integer;
    31     Pooliix: array [0 .. nImp - 1] of integer;
     29    nPool, dragiix, ctype: Integer;
     30    Pooliix: array [0 .. nImp - 1] of Integer;
    3231    listed: Set of 0 .. nImp;
    33     Changed: boolean;
    34     procedure LoadType(NewType: integer);
     32    Changed: Boolean;
     33    procedure LoadType(NewType: Integer);
    3534    procedure SaveType;
    3635  end;
    3736
    38 var
    39   CityTypeDlg: TCityTypeDlg;
    4037
    4138implementation
    4239
    43 uses Help;
     40uses
     41  Help, Term;
    4442
    4543{$R *.lfm}
    … …  
    8280procedure TCityTypeDlg.OffscreenPaint;
    8381var
    84   i, iix: integer;
    85   s: string;
     82  I, iix: Integer;
     83  S: string;
    8684begin
    8785  inherited;
    88   offscreen.Canvas.Font.Assign(UniFont[ftSmall]);
     86  Offscreen.Canvas.Font.Assign(UniFont[ftSmall]);
    8987  FillOffscreen(xList - 7, yList, 42 * nListCol + 14, 32 * nListRow);
    9088  FillOffscreen(xPool - 7, yPool, 42 * nPoolCol + 14, 32 * nPoolRow);
    … …  
    9290    yPool - yList - 32 * nListRow);
    9391
    94   Frame(offscreen.Canvas, 0, yList + 32 * nListRow, InnerWidth - 255,
     92  Frame(Offscreen.Canvas, 0, yList + 32 * nListRow, InnerWidth - 255,
    9593    yPool - 23, MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
    96   Frame(offscreen.Canvas, InnerWidth - 254, yList + 32 * nListRow,
     94  Frame(Offscreen.Canvas, InnerWidth - 254, yList + 32 * nListRow,
    9795    InnerWidth - 89, yPool - 23, MainTexture.ColorBevelLight,
    9896    MainTexture.ColorBevelShade);
    99   Frame(offscreen.Canvas, InnerWidth - 88, yList + 32 * nListRow,
     97  Frame(Offscreen.Canvas, InnerWidth - 88, yList + 32 * nListRow,
    10098    InnerWidth - 1, yPool - 23, MainTexture.ColorBevelLight,
    10199    MainTexture.ColorBevelShade);
    102   Frame(offscreen.Canvas, 0, yPool - 22, InnerWidth - 1, yPool - 1,
     100  Frame(Offscreen.Canvas, 0, yPool - 22, InnerWidth - 1, yPool - 1,
    103101    MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
    104   for i := 0 to nCityType - 1 do
    105   begin
    106     RFrame(offscreen.Canvas, xSwitch + i * 42, ySwitch, xSwitch + 39 + i * 42,
     102  for I := 0 to nCityType - 1 do
     103  begin
     104    RFrame(Offscreen.Canvas, xSwitch + I * 42, ySwitch, xSwitch + 39 + I * 42,
    107105      ySwitch + 23, MainTexture.ColorBevelShade, MainTexture.ColorBevelLight);
    108     if i = ctype then
    109       Frame(offscreen.Canvas, xSwitch + 1 + i * 42, ySwitch + 1,
    110         xSwitch + 38 + i * 42, ySwitch + 22, MainTexture.ColorBevelShade,
     106    if I = ctype then
     107      Frame(Offscreen.Canvas, xSwitch + 1 + I * 42, ySwitch + 1,
     108        xSwitch + 38 + I * 42, ySwitch + 22, MainTexture.ColorBevelShade,
    111109        MainTexture.ColorBevelLight)
    112110    else
    113       Frame(offscreen.Canvas, xSwitch + 1 + i * 42, ySwitch + 1,
    114         xSwitch + 38 + i * 42, ySwitch + 22, MainTexture.ColorBevelLight,
     111      Frame(Offscreen.Canvas, xSwitch + 1 + I * 42, ySwitch + 1,
     112        xSwitch + 38 + I * 42, ySwitch + 22, MainTexture.ColorBevelLight,
    115113        MainTexture.ColorBevelShade);
    116     DpiBitCanvas(offscreen.Canvas, xSwitch + 2 + i * 42, ySwitch + 2,
    117       xSizeSmall, ySizeSmall, SmallImp.Canvas, (i + 3) * xSizeSmall, 0);
    118   end;
    119   RisedTextOut(offscreen.Canvas, 8, yList + 32 * nListRow + 2,
     114    DpiBitBltCanvas(Offscreen.Canvas, xSwitch + 2 + I * 42, ySwitch + 2,
     115      xSizeSmall, ySizeSmall, SmallImp.Canvas, (I + 3) * xSizeSmall, 0);
     116  end;
     117  RisedTextOut(Offscreen.Canvas, 8, yList + 32 * nListRow + 2,
    120118    Phrases.Lookup('BUILDORDER'));
    121   RisedTextOut(offscreen.Canvas, 8, ySwitch + 26,
     119  RisedTextOut(Offscreen.Canvas, 8, ySwitch + 26,
    122120    Phrases.Lookup('CITYTYPE', ctype));
    123   s := Phrases.Lookup('BUILDREST');
    124   RisedTextOut(offscreen.Canvas,
    125     (InnerWidth - BiColorTextWidth(offscreen.Canvas, s)) div 2,
    126     yList + 72 + 32 * nListRow, s);
    127 
    128   with offscreen.Canvas do
    129   begin
    130     for i := 1 to nListRow - 1 do
    131       DLine(offscreen.Canvas, xList - 5, xList + 4 + 42 * nListCol,
    132         yList - 1 + 32 * i, MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
    133     for i := 0 to nListCol * nListRow - 1 do
    134     begin
    135       s := IntToStr(i + 1);
     121  S := Phrases.Lookup('BUILDREST');
     122  RisedTextOut(Offscreen.Canvas,
     123    (InnerWidth - BiColorTextWidth(Offscreen.Canvas, S)) div 2,
     124    yList + 72 + 32 * nListRow, S);
     125
     126  with Offscreen.Canvas do
     127  begin
     128    for I := 1 to nListRow - 1 do
     129      DLine(Offscreen.Canvas, xList - 5, xList + 4 + 42 * nListCol,
     130        yList - 1 + 32 * I, MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
     131    for I := 0 to nListCol * nListRow - 1 do
     132    begin
     133      S := IntToStr(I + 1);
    136134      Font.Color := MainTexture.ColorTextLight;
    137       Textout(xList + 20 + i mod nListCol * 42 - TextWidth(s) div 2,
    138         yList + 15 + i div nListCol * 32 - TextHeight(s) div 2, s);
    139     end;
    140   end;
    141 
    142   i := 0;
    143   while MyData.ImpOrder[ctype, i] >= 0 do
    144   begin
    145     RFrame(offscreen.Canvas, xList + 20 - xSizeSmall div 2 + i mod nListCol *
    146       42, yList + 15 - ySizeSmall div 2 + i div nListCol * 32,
    147       xList + 21 + xSizeSmall div 2 + i mod nListCol * 42,
    148       yList + 16 + ySizeSmall div 2 + i div nListCol * 32,
     135      Textout(xList + 20 + I mod nListCol * 42 - TextWidth(S) div 2,
     136        yList + 15 + I div nListCol * 32 - TextHeight(S) div 2, S);
     137    end;
     138  end;
     139
     140  I := 0;
     141  while MyData.ImpOrder[ctype, I] >= 0 do
     142  begin
     143    RFrame(Offscreen.Canvas, xList + 20 - xSizeSmall div 2 + I mod nListCol *
     144      42, yList + 15 - ySizeSmall div 2 + I div nListCol * 32,
     145      xList + 21 + xSizeSmall div 2 + I mod nListCol * 42,
     146      yList + 16 + ySizeSmall div 2 + I div nListCol * 32,
    149147      MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
    150     DpiBitCanvas(offscreen.Canvas, xList + 21 - xSizeSmall div 2 +
    151       i mod nListCol * 42, yList + 16 - ySizeSmall div 2 + i div nListCol * 32,
     148    DpiBitBltCanvas(Offscreen.Canvas, xList + 21 - xSizeSmall div 2 +
     149      I mod nListCol * 42, yList + 16 - ySizeSmall div 2 + I div nListCol * 32,
    152150      xSizeSmall, ySizeSmall, SmallImp.Canvas,
    153       MyData.ImpOrder[ctype, i] mod 7 * xSizeSmall,
    154       (MyData.ImpOrder[ctype, i] + SystemIconLines * 7) div 7 *
     151      MyData.ImpOrder[ctype, I] mod 7 * xSizeSmall,
     152      (MyData.ImpOrder[ctype, I] + SystemIconLines * 7) div 7 *
    155153      ySizeSmall);
    156     inc(i);
     154    Inc(I);
    157155  end;
    158156
    … …  
    165163    begin
    166164      Pooliix[nPool] := iix;
    167       RFrame(offscreen.Canvas, xPool + 20 - xSizeSmall div 2 +
     165      RFrame(Offscreen.Canvas, xPool + 20 - xSizeSmall div 2 +
    168166        nPool mod nPoolCol * 42, yPool + 15 - ySizeSmall div 2 +
    169167        nPool div nPoolCol * 32, xPool + 21 + xSizeSmall div 2 +
    … …  
    171169        nPool div nPoolCol * 32, MainTexture.ColorBevelLight,
    172170        MainTexture.ColorBevelShade);
    173       DpiBitCanvas(offscreen.Canvas, xPool + 21 - xSizeSmall div 2 +
     171      DpiBitBltCanvas(Offscreen.Canvas, xPool + 21 - xSizeSmall div 2 +
    174172        nPool mod nPoolCol * 42, yPool + 16 - ySizeSmall div 2 +
    175173        nPool div nPoolCol * 32, xSizeSmall, ySizeSmall, SmallImp.Canvas,
    176174        iix mod 7 * xSizeSmall, (iix + SystemIconLines * 7) div 7 *
    177175        ySizeSmall);
    178       inc(nPool);
     176      Inc(nPool);
    179177    end;
    180178  DeleteBtn.Visible := MyData.ImpOrder[ctype, 0] >= 0;
    … …  
    182180  if dragiix >= 0 then
    183181  begin
    184     ImpImage(offscreen.Canvas, xView + 9, yView + 5, dragiix);
    185     s := Phrases.Lookup('IMPROVEMENTS', dragiix);
    186     RisedTextOut(offscreen.Canvas,
    187       xView + 36 - BiColorTextWidth(offscreen.Canvas, s) div 2,
    188       ySwitch + 26, s);
     182    ImpImage(Offscreen.Canvas, xView + 9, yView + 5, dragiix);
     183    S := Phrases.Lookup('IMPROVEMENTS', dragiix);
     184    RisedTextOut(Offscreen.Canvas,
     185      xView + 36 - BiColorTextWidth(Offscreen.Canvas, S) div 2,
     186      ySwitch + 26, S);
    189187  end;
    190188  MarkUsedOffscreen(InnerWidth, InnerHeight);
    191 end; { MainPaint }
    192 
    193 procedure TCityTypeDlg.LoadType(NewType: integer);
    194 var
    195   i: integer;
     189end;
     190
     191procedure TCityTypeDlg.LoadType(NewType: Integer);
     192var
     193  I: Integer;
    196194begin
    197195  ctype := NewType;
    198196  listed := [];
    199   i := 0;
    200   while MyData.ImpOrder[ctype, i] >= 0 do
    201   begin
    202     include(listed, MyData.ImpOrder[ctype, i]);
    203     inc(i);
    204   end;
    205   Changed := false;
     197  I := 0;
     198  while MyData.ImpOrder[ctype, I] >= 0 do
     199  begin
     200    Include(listed, MyData.ImpOrder[ctype, I]);
     201    Inc(I);
     202  end;
     203  Changed := False;
    206204end;
    207205
    208206procedure TCityTypeDlg.SaveType;
    209207var
    210   cix: integer;
     208  cix: Integer;
    211209begin
    212210  if Changed then
    … …  
    215213      if (MyCity[cix].Loc >= 0) and (MyCity[cix].Status and 7 = ctype + 1) then
    216214        AutoBuild(cix, MyData.ImpOrder[ctype]);
    217     Changed := false;
     215    Changed := False;
    218216  end;
    219217end;
    … …  
    226224end;
    227225
    228 procedure TCityTypeDlg.ShowNewContent(NewMode: integer);
     226procedure TCityTypeDlg.ShowNewContent(NewMode: TWindowMode);
    229227begin
    230228  inherited ShowNewContent(NewMode);
    … …  
    232230
    233231procedure TCityTypeDlg.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
    234   Shift: TShiftState; x, y: integer);
    235 var
    236   i: integer;
    237 begin
    238   x := x - SideFrame;
    239   y := y - WideFrame;
    240   i := (x - xList) div 42 + (y - yList) div 32 * nListCol;
    241   if (i < nImp) and (MyData.ImpOrder[ctype, i] >= 0) and
    242     (x > xList + 2 + i mod nListCol * 42) and
    243     (y > yList + 5 + i div nListCol * 32) and
    244     (x < xList + 3 + 36 + i mod nListCol * 42) and
    245     (y < yList + 6 + 20 + i div nListCol * 32) then
     232  Shift: TShiftState; X, Y: Integer);
     233var
     234  I: Integer;
     235begin
     236  X := X - SideFrame;
     237  Y := Y - WideFrame;
     238  I := (X - xList) div 42 + (Y - yList) div 32 * nListCol;
     239  if (I < nImp) and (MyData.ImpOrder[ctype, I] >= 0) and
     240    (X > xList + 2 + I mod nListCol * 42) and
     241    (Y > yList + 5 + I div nListCol * 32) and
     242    (X < xList + 3 + 36 + I mod nListCol * 42) and
     243    (Y < yList + 6 + 20 + I div nListCol * 32) then
    246244  begin
    247245    if ssShift in Shift then
    248       HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkImp,
    249         MyData.ImpOrder[ctype, i])
     246      MainScreen.HelpDlg.ShowNewContent(WindowModeMakePersistent(FWindowMode), hkImp,
     247        MyData.ImpOrder[ctype, I])
    250248    else
    251249    begin
    252       dragiix := MyData.ImpOrder[ctype, i];
     250      dragiix := MyData.ImpOrder[ctype, I];
    253251      DpiScreen.Cursor := crImpDrag;
    254252      SmartUpdateContent;
    255253    end;
    256     exit;
    257   end;
    258   i := (x - xPool) div 42 + (y - yPool) div 32 * nPoolCol;
    259   if (i < nPool) and (x > xPool + 2 + i mod nPoolCol * 42) and
    260     (y > yPool + 5 + i div nPoolCol * 32) and
    261     (x < xPool + 3 + 36 + i mod nPoolCol * 42) and
    262     (y < yPool + 6 + 20 + i div nPoolCol * 32) then
     254    Exit;
     255  end;
     256  I := (X - xPool) div 42 + (Y - yPool) div 32 * nPoolCol;
     257  if (I < nPool) and (X > xPool + 2 + I mod nPoolCol * 42) and
     258    (Y > yPool + 5 + I div nPoolCol * 32) and
     259    (X < xPool + 3 + 36 + I mod nPoolCol * 42) and
     260    (Y < yPool + 6 + 20 + I div nPoolCol * 32) then
    263261  begin
    264262    if ssShift in Shift then
    265       HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkImp, Pooliix[i])
     263      MainScreen.HelpDlg.ShowNewContent(WindowModeMakePersistent(FWindowMode), hkImp, Pooliix[I])
    266264    else
    267265    begin
    268       dragiix := Pooliix[i];
     266      dragiix := Pooliix[I];
    269267      DpiScreen.Cursor := crImpDrag;
    270268      SmartUpdateContent;
    271269    end;
    272     exit;
    273   end;
    274   i := (x - xSwitch) div 42;
    275   if (i < nCityType) and (x > xSwitch + 2 + i * 42) and
    276     (x < xSwitch + 3 + 36 + i * 42) and (y >= ySwitch + 2) and (y < ySwitch + 22)
     270    Exit;
     271  end;
     272  I := (X - xSwitch) div 42;
     273  if (I < nCityType) and (X > xSwitch + 2 + I * 42) and
     274    (X < xSwitch + 3 + 36 + I * 42) and (Y >= ySwitch + 2) and (Y < ySwitch + 22)
    277275  then
    278276  begin
    279277    SaveType;
    280     LoadType(i);
     278    LoadType(I);
    281279    SmartUpdateContent;
    282280  end;
    … …  
    284282
    285283procedure TCityTypeDlg.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
    286   Shift: TShiftState; x, y: integer);
    287 
    288   procedure UnList(iix: integer);
     284  Shift: TShiftState; X, Y: Integer);
     285
     286  procedure UnList(iix: Integer);
    289287  var
    290     i: integer;
    291   begin
    292     i := 0;
    293     while (MyData.ImpOrder[ctype, i] >= 0) and
    294       (MyData.ImpOrder[ctype, i] <> iix) do
    295       inc(i);
    296     assert(MyData.ImpOrder[ctype, i] = iix);
    297     move(MyData.ImpOrder[ctype, i + 1], MyData.ImpOrder[ctype, i], nImp - i);
     288    I: Integer;
     289  begin
     290    I := 0;
     291    while (MyData.ImpOrder[ctype, I] >= 0) and
     292      (MyData.ImpOrder[ctype, I] <> iix) do
     293      Inc(I);
     294    Assert(MyData.ImpOrder[ctype, I] = iix);
     295    Move(MyData.ImpOrder[ctype, I + 1], MyData.ImpOrder[ctype, I], nImp - I);
    298296    Exclude(listed, iix);
    299297  end;
    300298
    301299var
    302   i: integer;
    303 begin
    304   x := x - SideFrame;
    305   y := y - WideFrame;
     300  I: Integer;
     301begin
     302  X := X - SideFrame;
     303  Y := Y - WideFrame;
    306304  if dragiix >= 0 then
    307305  begin
    308     if (x >= xList) and (x < xList + nListCol * 42) and (y >= yList) and
    309       (y < yList + nListRow * 32) then
     306    if (X >= xList) and (X < xList + nListCol * 42) and (Y >= yList) and
     307      (Y < yList + nListRow * 32) then
    310308    begin
    311309      if dragiix in listed then
    312310        UnList(dragiix);
    313       i := (x - xList) div 42 + (y - yList) div 32 * nListCol;
    314       while (i > 0) and (MyData.ImpOrder[ctype, i - 1] < 0) do
    315         dec(i);
    316       move(MyData.ImpOrder[ctype, i], MyData.ImpOrder[ctype, i + 1],
    317         nImp - i - 1);
    318       MyData.ImpOrder[ctype, i] := dragiix;
    319       include(listed, dragiix);
    320       Changed := true;
     311      I := (X - xList) div 42 + (Y - yList) div 32 * nListCol;
     312      while (I > 0) and (MyData.ImpOrder[ctype, I - 1] < 0) do
     313        Dec(I);
     314      Move(MyData.ImpOrder[ctype, I], MyData.ImpOrder[ctype, I + 1],
     315        nImp - I - 1);
     316      MyData.ImpOrder[ctype, I] := dragiix;
     317      Include(listed, dragiix);
     318      Changed := True;
    321319    end
    322     else if (dragiix in listed) and (x >= xPool) and (x < xPool + nPoolCol * 42)
    323       and (y >= yPool) and (y < yPool + nPoolRow * 32) then
     320    else if (dragiix in listed) and (X >= xPool) and (X < xPool + nPoolCol * 42)
     321      and (Y >= yPool) and (Y < yPool + nPoolRow * 32) then
    324322    begin
    325323      UnList(dragiix);
    326       Changed := true;
     324      Changed := True;
    327325    end;
    328326    dragiix := -1;
    … …  
    340338procedure TCityTypeDlg.DeleteBtnClick(Sender: TObject);
    341339begin
    342   fillchar(MyData.ImpOrder[ctype], sizeof(MyData.ImpOrder[ctype]), Byte(-1));
     340  FillChar(MyData.ImpOrder[ctype], SizeOf(MyData.ImpOrder[ctype]), Byte(-1));
    343341  listed := [];
    344   Changed := true;
     342  Changed := True;
    345343  SmartUpdateContent;
    346344end;
Note: See TracChangeset for help on using the changeset viewer.