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/Diagram.pas

    r361 r465  
    99
    1010type
     11  TDiagramKind = (dkChart, dkShip);
     12
    1113  TDiaDlg = class(TFramedDlg)
    1214    CloseBtn: TButtonB;
    … …  
    1921    procedure ToggleBtnClick(Sender: TObject);
    2022    procedure PlayerClick(Sender: TObject);
    21     procedure FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
    22 
     23    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    2324  public
    2425    procedure OffscreenPaint; override;
    25     procedure ShowNewContent_Charts(NewMode: integer);
    26     procedure ShowNewContent_Ship(NewMode: integer; p: integer = -1);
    27 
     26    procedure ShowNewContent_Charts(NewMode: TWindowMode);
     27    procedure ShowNewContent_Ship(NewMode: TWindowMode; P: Integer = -1);
    2828  private
    29     Kind: (dkChart, dkShip);
    30     Player, Mode: integer;
    31   end;
    32 
    33 var
    34   DiaDlg: TDiaDlg;
    35 
    36 procedure PaintColonyShip(canvas: TDpiCanvas; Player, Left, Width, Top: integer);
     29    Kind: TDiagramKind;
     30    Player: Integer;
     31    Mode: Integer;
     32  end;
     33
     34procedure PaintColonyShip(Canvas: TDpiCanvas; Player, Left, Width, Top: Integer);
     35
    3736
    3837implementation
    … …  
    4544const
    4645  Border = 24;
    47   RoundPixels: array [0 .. nStat - 1] of integer = (0, 0, 0, 5, 5, 5);
     46  RoundPixels: array [0 .. nStat - 1] of Integer = (0, 0, 0, 5, 5, 5);
    4847
    4948  yArea = 48;
    50   xComp: array [0 .. 5] of integer = (-60, -28, 4, 4, 36, 68);
    51   yComp: array [0 .. 5] of integer = (-40, -40, -79, -1, -40, -40);
    52   xPow: array [0 .. 3] of integer = (-116, -116, -116, -116);
    53   yPow: array [0 .. 3] of integer = (-28, 0, -44, 16);
    54   xHab: array [0 .. 1] of integer = (23, 23);
    55   yHab: array [0 .. 1] of integer = (-81, 1);
    56 
    57 procedure PaintColonyShip(canvas: TDpiCanvas; Player, Left, Width, Top: integer);
     49  xComp: array [0 .. 5] of Integer = (-60, -28, 4, 4, 36, 68);
     50  yComp: array [0 .. 5] of Integer = (-40, -40, -79, -1, -40, -40);
     51  xPow: array [0 .. 3] of Integer = (-116, -116, -116, -116);
     52  yPow: array [0 .. 3] of Integer = (-28, 0, -44, 16);
     53  xHab: array [0 .. 1] of Integer = (23, 23);
     54  yHab: array [0 .. 1] of Integer = (-81, 1);
     55
     56procedure PaintColonyShip(Canvas: TDpiCanvas; Player, Left, Width, Top: Integer);
    5857var
    59   i, x, r, nComp, nPow, nHab: integer;
     58  I, X, R, nComp, nPow, nHab: Integer;
    6059begin
    6160  Canvas.Brush.Color := $000000;
    6261  Canvas.FillRect(Rect(Left, Top, Left + Width, Top + 200));
    6362  Canvas.Brush.Style := bsClear;
    64     ScreenTools.Frame(canvas, Left - 1, Top - 1, Left + Width, Top + 200,
     63    ScreenTools.Frame(Canvas, Left - 1, Top - 1, Left + Width, Top + 200,
    6564      MainTexture.ColorBevelShade, MainTexture.ColorBevelLight);
    66     RFrame(canvas, Left - 2, Top - 2, Left + Width + 1, Top + 200 + 1,
     65    RFrame(Canvas, Left - 2, Top - 2, Left + Width + 1, Top + 200 + 1,
    6766      MainTexture.ColorBevelShade, MainTexture.ColorBevelLight);
    6867
    6968    // stars
    7069    DelphiRandSeed := Player * 11111;
    71     for i := 1 to Width - 16 do
     70    for I := 1 to Width - 16 do
    7271    begin
    73       x := DelphiRandom((Width - 16) * 200);
    74       r := DelphiRandom(13) + 28;
    75       Canvas.Pixels[x div 200 + 8, x mod 200 + Top] :=
    76         (r * r * r * r div 10001) * $10101;
     72      X := DelphiRandom((Width - 16) * 200);
     73      R := DelphiRandom(13) + 28;
     74      Canvas.Pixels[X div 200 + 8, X mod 200 + Top] :=
     75        (R * R * R * R div 10001) * $10101;
    7776    end;
    7877
    … …  
    8685    if nHab > 2 then
    8786      nHab := 2;
    88     for i := 0 to nHab - 1 do
    89       Sprite(canvas, HGrSystem2, Left + Width div 2 + xHab[i],
    90         Top + 100 + yHab[i], 80, 80, 34, 1);
    91     for i := 0 to nComp - 1 do
    92       Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[i],
    93         Top + 100 + yComp[i], 32, 80, 1, 1);
     87    for I := 0 to nHab - 1 do
     88      Sprite(Canvas, HGrSystem2, Left + Width div 2 + xHab[I],
     89        Top + 100 + yHab[I], 80, 80, 34, 1);
     90    for I := 0 to nComp - 1 do
     91      Sprite(Canvas, HGrSystem2, Left + Width div 2 + xComp[I],
     92        Top + 100 + yComp[I], 32, 80, 1, 1);
    9493    if nComp > 0 then
    95       for i := 3 downto nPow do
    96         Sprite(canvas, HGrSystem2, Left + Width div 2 + xPow[i] + 40,
    97           Top + 100 + yPow[i], 16, 27, 1, 82);
    98     for i := nPow - 1 downto 0 do
    99       Sprite(canvas, HGrSystem2, Left + Width div 2 + xPow[i],
    100         Top + 100 + yPow[i], 56, 28, 58, 82);
     94      for I := 3 downto nPow do
     95        Sprite(Canvas, HGrSystem2, Left + Width div 2 + xPow[I] + 40,
     96          Top + 100 + yPow[I], 16, 27, 1, 82);
     97    for I := nPow - 1 downto 0 do
     98      Sprite(Canvas, HGrSystem2, Left + Width div 2 + xPow[I],
     99        Top + 100 + yPow[I], 56, 28, 58, 82);
    101100    if (nComp < 3) and (nHab >= 1) then
    102       Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[2] + 32 - 16,
     101      Sprite(Canvas, HGrSystem2, Left + Width div 2 + xComp[2] + 32 - 16,
    103102        Top + 100 + 7 + yComp[2], 16, 27, 1, 82);
    104103    if (nComp >= 3) and (nHab < 1) then
    105       Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[2] + 32,
     104      Sprite(Canvas, HGrSystem2, Left + Width div 2 + xComp[2] + 32,
    106105        Top + 100 + 7 + yComp[2], 16, 27, 18, 82);
    107106    if (nComp < 4) and (nHab >= 2) then
    108       Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[3] + 32 - 16,
     107      Sprite(Canvas, HGrSystem2, Left + Width div 2 + xComp[3] + 32 - 16,
    109108        Top + 100 + 46 + yComp[3], 16, 27, 1, 82);
    110109    if (nComp >= 4) and (nHab < 2) then
    111       Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[3] + 32,
     110      Sprite(Canvas, HGrSystem2, Left + Width div 2 + xComp[3] + 32,
    112111        Top + 100 + 46 + yComp[3], 16, 27, 18, 82);
    113112    if (nComp <> 6) and (nComp <> 2) and not((nComp = 0) and (nPow < 1)) then
    114       Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[nComp],
     113      Sprite(Canvas, HGrSystem2, Left + Width div 2 + xComp[nComp],
    115114        Top + 100 + 7 + yComp[nComp], 16, 27, 18, 82);
    116115    if (nComp <> 6) and (nComp <> 3) and not((nComp = 0) and (nPow < 2)) then
    117       Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[nComp],
     116      Sprite(Canvas, HGrSystem2, Left + Width div 2 + xComp[nComp],
    118117        Top + 100 + 46 + yComp[nComp], 16, 27, 18, 82);
    119118    if nComp = 2 then
    120       Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[3],
     119      Sprite(Canvas, HGrSystem2, Left + Width div 2 + xComp[3],
    121120        Top + 100 + 7 + yComp[3], 16, 27, 18, 82);
    122121    if nComp = 3 then
    123       Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[4],
     122      Sprite(Canvas, HGrSystem2, Left + Width div 2 + xComp[4],
    124123        Top + 100 + 7 + yComp[4], 16, 27, 18, 82);
    125124end;
    … …  
    142141procedure TDiaDlg.OffscreenPaint;
    143142var
    144   p, T, max, x, y, y0, Stop, r, RoundRange, LineStep: integer;
    145   s: string;
     143  P, T, Max, X, Y, y0, Stop, R, RoundRange, LineStep: Integer;
     144  S: string;
    146145  List: ^TChart;
    147146
    148   function Round(T: integer): integer;
     147  function Round(T: Integer): Integer;
    149148  var
    150     n, i: integer;
     149    N, I: Integer;
    151150  begin
    152151    if T < RoundRange then
    153       n := T
     152      N := T
    154153    else
    155       n := RoundRange;
    156     result := 0;
    157     for i := T - n to T do
    158       inc(result, List[i]);
    159     result := result div (n + 1);
    160   end;
    161 
    162   procedure ShareBar(x, y: integer; Cap: string; val0, val1: integer);
    163   begin
    164     LoweredTextOut(offscreen.canvas, -1, MainTexture, x - 2, y, Cap);
    165     DLine(offscreen.canvas, x - 2, x + 169, y + 16, MainTexture.ColorTextShade,
     154      N := RoundRange;
     155    Result := 0;
     156    for I := T - N to T do
     157      Inc(Result, List[I]);
     158    Result := Result div (N + 1);
     159  end;
     160
     161  procedure ShareBar(X, Y: Integer; Cap: string; val0, val1: Integer);
     162  begin
     163    LoweredTextOut(Offscreen.Canvas, -1, MainTexture, X - 2, Y, Cap);
     164    DLine(Offscreen.Canvas, X - 2, X + 169, Y + 16, MainTexture.ColorTextShade,
    166165      MainTexture.ColorTextLight);
    167166    if val0 > 0 then
    168       s := Format(Phrases.Lookup('SHARE'), [val0, val1])
     167      S := Format(Phrases.Lookup('SHARE'), [val0, val1])
    169168    else
    170       s := '0';
    171     RisedTextOut(offscreen.canvas,
    172       x + 170 - BiColorTextWidth(offscreen.canvas, s), y, s);
     169      S := '0';
     170    RisedTextOut(Offscreen.Canvas,
     171      X + 170 - BiColorTextWidth(Offscreen.Canvas, S), Y, S);
    173172  end;
    174173
    … …  
    176175  inherited;
    177176  if Kind = dkChart then
    178     with offscreen.canvas do
     177    with Offscreen.Canvas do
    179178    begin
    180179      Font.Assign(UniFont[ftTiny]);
    … …  
    186185      GetMem(List, 4 * (MyRO.Turn + 2));
    187186      if Mode = stExplore then
    188         max := G.lx * G.ly
     187        Max := G.lx * G.ly
    189188      else
    190189      begin
    191         max := -1;
    192         for p := 0 to nPl - 1 do
    193           if (G.Difficulty[p] > 0) and
    194             (Server(sGetChart + Mode shl 4, me, p, List^) >= rExecuted) then
     190        Max := -1;
     191        for P := 0 to nPl - 1 do
     192          if (G.Difficulty[P] > 0) and
     193            (Server(sGetChart + Mode shl 4, Me, P, List^) >= rExecuted) then
    195194            for T := 0 to MyRO.Turn - 1 do
    196195            begin
    197               r := Round(T);
    198               if r > max then
    199                 max := r;
     196              R := Round(T);
     197              if R > Max then
     198                Max := R;
    200199            end;
    201200      end;
    … …  
    215214      for T := 0 to (MyRO.Turn - 1) div LineStep do
    216215      begin
    217         x := Border + (InnerWidth - 2 * Border) * T *
     216        X := Border + (InnerWidth - 2 * Border) * T *
    218217          LineStep div (MyRO.Turn - 1);
    219         MoveTo(x, Border);
    220         LineTo(x, InnerHeight - Border);
    221         s := IntToStr(abs(TurnToYear(T * LineStep)));
    222         Textout(x - TextWidth(s) div 2, Border - 16, s);
     218        MoveTo(X, Border);
     219        LineTo(X, InnerHeight - Border);
     220        S := IntToStr(abs(TurnToYear(T * LineStep)));
     221        Textout(X - TextWidth(S) div 2, Border - 16, S);
    223222      end;
    224223
    225224      y0 := 0;
    226       if max > 0 then
     225      if Max > 0 then
    227226      begin
    228         for p := 0 to nPl - 1 do
    229           if (G.Difficulty[p] > 0) and
    230             (Server(sGetChart + Mode shl 4, me, p, List^) >= rExecuted) then
     227        for P := 0 to nPl - 1 do
     228          if (G.Difficulty[P] > 0) and
     229            (Server(sGetChart + Mode shl 4, Me, P, List^) >= rExecuted) then
    231230          begin
    232             Pen.Color := Tribe[p].Color;
     231            Pen.Color := Tribe[P].Color;
    233232            Stop := MyRO.Turn - 1;
    234233            while (Stop > 0) and (List[Stop] = 0) do
    235               dec(Stop);
     234              Dec(Stop);
    236235            for T := 0 to Stop do
    237236            begin
    238               r := Round(T);
    239               x := Border + (InnerWidth - 2 * Border) * T div (MyRO.Turn - 1);
    240               y := InnerHeight - Border - (InnerHeight - 2 * Border) *
    241                 r div max;
     237              R := Round(T);
     238              X := Border + (InnerWidth - 2 * Border) * T div (MyRO.Turn - 1);
     239              Y := InnerHeight - Border - (InnerHeight - 2 * Border) *
     240                R div Max;
    242241              if T = 0 then
    243                 MoveTo(x, y)
     242                MoveTo(X, Y)
    244243                // else if Mode=stTerritory then
    245244                // begin LineTo(x,y0); LineTo(x,y) end
    246245              else if RoundPixels[Mode] = 0 then
    247246              begin
    248                 if (y <> y0) or (T = Stop) then
    249                   LineTo(x, y)
     247                if (Y <> y0) or (T = Stop) then
     248                  LineTo(X, Y)
    250249              end
    251250              else
    252                 LineTo(x, y);
    253               y0 := y;
     251                LineTo(X, Y);
     252              y0 := Y;
    254253            end;
    255254          end;
    … …  
    258257    end
    259258  else
    260     with offscreen.canvas do
     259    with Offscreen.Canvas do
    261260    begin
    262261      Font.Assign(UniFont[ftSmall]);
    263262      FillOffscreen(0, 0, InnerWidth, InnerHeight);
    264263
    265       PaintColonyShip(offscreen.canvas, Player, 8, InnerWidth - 16, yArea);
     264      PaintColonyShip(Offscreen.Canvas, Player, 8, InnerWidth - 16, yArea);
    266265
    267266      ShareBar(InnerWidth div 2 - 85, InnerHeight - 62,
    … …  
    273272    end;
    274273  MarkUsedOffscreen(InnerWidth, InnerHeight);
    275 end; // OffscreenPaint
     274end;
    276275
    277276procedure TDiaDlg.FormPaint(Sender: TObject);
    278277var
    279   s: string;
     278  S: string;
    280279begin
    281280  inherited;
    282   canvas.Font.Assign(UniFont[ftNormal]);
     281  Canvas.Font.Assign(UniFont[ftNormal]);
    283282  if Kind = dkChart then
    284     s := Phrases.Lookup('DIAGRAM', Mode)
    285   else
    286     s := Tribe[Player].TPhrase('SHORTNAME');
    287   LoweredTextOut(canvas, -1, MainTexture,
    288     (ClientWidth - BiColorTextWidth(canvas, s)) div 2, 31, s);
     283    S := Phrases.Lookup('DIAGRAM', Mode)
     284  else
     285    S := Tribe[Player].TPhrase('SHORTNAME');
     286  LoweredTextOut(Canvas, -1, MainTexture,
     287    (ClientWidth - BiColorTextWidth(Canvas, S)) div 2, 31, S);
    289288end;
    290289
    … …  
    299298end;
    300299
    301 procedure TDiaDlg.ShowNewContent_Charts(NewMode: integer);
     300procedure TDiaDlg.ShowNewContent_Charts(NewMode: TWindowMode);
    302301begin
    303302  Kind := dkChart;
    … …  
    309308end;
    310309
    311 procedure TDiaDlg.ShowNewContent_Ship(NewMode, p: integer);
     310procedure TDiaDlg.ShowNewContent_Ship(NewMode: TWindowMode; P: Integer);
    312311begin
    313312  Kind := dkShip;
    314   if p < 0 then
    315   begin
    316     Player := me;
     313  if P < 0 then
     314  begin
     315    Player := Me;
    317316    while MyRO.Ship[Player].Parts[spComp] + MyRO.Ship[Player].Parts[spPow] +
    318317      MyRO.Ship[Player].Parts[spHab] = 0 do
    … …  
    320319  end
    321320  else
    322     Player := p;
     321    Player := P;
    323322  ToggleBtn.ButtonIndex := 28;
    324323  ToggleBtn.Hint := Phrases.Lookup('BTN_SELECT');
    … …  
    329328procedure TDiaDlg.ToggleBtnClick(Sender: TObject);
    330329var
    331   p1: integer;
    332   m: TDpiMenuItem;
     330  p1: Integer;
     331  M: TDpiMenuItem;
    333332begin
    334333  if Kind = dkChart then
    … …  
    345344        MyRO.Ship[p1].Parts[spHab] > 0 then
    346345      begin
    347         m := TDpiMenuItem.Create(Popup);
    348         m.RadioItem := true;
    349         m.Caption := Tribe[p1].TPhrase('SHORTNAME');
    350         m.Tag := p1;
    351         m.OnClick := PlayerClick;
     346        M := TDpiMenuItem.Create(Popup);
     347        M.RadioItem := True;
     348        M.Caption := Tribe[p1].TPhrase('SHORTNAME');
     349        M.Tag := p1;
     350        M.OnClick := PlayerClick;
    352351        if p1 = Player then
    353           m.Checked := true;
    354         Popup.Items.Add(m);
     352          M.Checked := True;
     353        Popup.Items.Add(M);
    355354      end;
    356355    Popup.Popup(Left + ToggleBtn.Left, Top + ToggleBtn.Top + ToggleBtn.Height);
    … …  
    363362end;
    364363
    365 procedure TDiaDlg.FormKeyDown(Sender: TObject; var Key: word;
     364procedure TDiaDlg.FormKeyDown(Sender: TObject; var Key: Word;
    366365  Shift: TShiftState);
    367366begin
Note: See TracChangeset for help on using the changeset viewer.