Ignore:
Timestamp:
May 21, 2020, 8:17:38 PM (5 years ago)
Author:
chronos
Message:
  • Modified: Update from trunk rev 245.
  • Modified: Vcl prefix/suffix changed to Native.
Location:
branches/highdpi/LocalPlayer
Files:
23 edited

Legend:

Unmodified
Added
Removed

  • branches/highdpi/LocalPlayer/CityScreen.lfm

    r210 r246  
    2121  OnShow = FormShow
    2222  PixelsPerInch = 96
     23  Scaled = False
    2324  object CloseBtn: TButtonA
    2425    Left = 335

  • branches/highdpi/LocalPlayer/CityScreen.pas

    r210 r246  
    435435    end;
    436436  end;
    437 
    438   procedure MakeRed(X, Y, W, H: Integer);
    439   var
    440     XX, YY: Integer;
    441     Gray: Integer;
    442     PixelPtr: TPixelPointer;
    443   begin
    444     X := ScaleToVcl(X);
    445     Y := ScaleToVcl(Y);
    446     W := ScaleToVcl(W);
    447     H := ScaleToVcl(H);
    448     Offscreen.BeginUpdate;
    449     PixelPtr := PixelPointer(Offscreen, X, Y);
    450     for YY := 0 to H - 1 do begin
    451       for XX := 0 to W - 1 do begin
    452         Gray := (Integer(PixelPtr.Pixel^.B) + Integer(PixelPtr.Pixel^.G) +
    453         Integer(PixelPtr.Pixel^.R)) * 85 shr 8;
    454         PixelPtr.Pixel^.B := 0;
    455         PixelPtr.Pixel^.G := 0;
    456         PixelPtr.Pixel^.R := Gray; // 255-(255-gray) div 2;
    457         PixelPtr.NextPixel;
    458       end;
    459       PixelPtr.NextLine;
    460     end;
    461     Offscreen.EndUpdate;
    462   end;
    463 
    464437var
    465438  line, MessageCount: integer;
    … …  
    565538  if not IsCityAlive then
    566539  begin
    567     MakeRed(18, 280, 298, 40);
     540    MakeRed(Offscreen, 18, 280, 298, 40);
    568541    if cGov = gAnarchy then
    569542      s := Phrases.Lookup('GOVERNMENT', gAnarchy)
    … …  
    701674    else
    702675    begin
    703       MakeRed(xHapp + dxBar - 6, yHapp + 2 * dyBar, wBar + 10, 38);
     676      MakeRed(Offscreen, xHapp + dxBar - 6, yHapp + 2 * dyBar, wBar + 10, 38);
    704677      CountBar(offscreen, xHapp + dxBar, yHapp + 2 * dyBar, wBar, 18,
    705678        Phrases.Lookup('LACK'), -Report.HappinessBalance, RedTex);
    … …  
    726699    else
    727700    begin
    728       MakeRed(xFood + dxBar - 6, yFood + 2 * dyBar, wBar + 10, 38);
     701      MakeRed(Offscreen, xFood + dxBar - 6, yFood + 2 * dyBar, wBar + 10, 38);
    729702      CountBar(offscreen, xFood + dxBar, yFood + 2 * dyBar, wBar, 1,
    730703        Phrases.Lookup('LACK'), -Report.FoodSurplus, RedTex);
    … …  
    759732    else
    760733    begin
    761       MakeRed(xProd + dxBar - 6, yProd + dyBar + 17, wBar + 10, 38);
     734      MakeRed(Offscreen, xProd + dxBar - 6, yProd + dyBar + 17, wBar + 10, 38);
    762735      CountBar(offscreen, xProd + dxBar, yProd + dyBar + 16, wBar, 3,
    763736        Phrases.Lookup('LACK'), -Report.Production, RedTex);
    … …  
    16841657  end
    16851658  else
     1659  if OpenSoundEvent >= 0 then
    16861660    Play(CityEventSoundItem[OpenSoundEvent]);
    16871661  OpenSoundEvent := -2;

  • branches/highdpi/LocalPlayer/Diagram.lfm

    r244 r246  
    1818  OnShow = FormShow
    1919  PixelsPerInch = 96
     20  Scaled = False
    2021  object CloseBtn: TButtonB
    2122    Left = 380

  • branches/highdpi/LocalPlayer/Draft.lfm

    r210 r246  
    1919  OnShow = FormShow
    2020  LCLVersion = '1.6.0.4'
     21  PixelsPerInch = 96
     22  Scaled = False
    2123  object OKBtn: TButtonA
    2224    Left = 196

  • branches/highdpi/LocalPlayer/Help.lfm

    r210 r246  
    2222  OnPaint = FormPaint
    2323  PixelsPerInch = 96
     24  Scaled = False
    2425  object CloseBtn: TButtonB
    2526    Left = 522

  • branches/highdpi/LocalPlayer/Help.pas

    r213 r246  
    443443  MaxSum = 9 * 9 * 255 * 75 div 100;
    444444var
    445   x, y, dx, dy, xSrc, ySrc, Sum, xx: integer;
     445  x, y, dx, dy, xSrc, ySrc, sum, xx: integer;
    446446  Heaven: array [0..nHeaven] of integer;
    447   PaintPtr: TPixelPointer;
    448   CoalPtr: TPixelPointer;
     447  PaintPtr, CoalPtr: TPixelPointer;
    449448  ImpPtr: array [-1..1] of TPixelPointer;
    450449begin
    … …  
    458457  xSrc := iix mod 7 * xSizeBig;
    459458  ySrc := (iix div 7 + 1) * ySizeBig;
    460   for y := 0 to ScaleToVcl(ySizeBig * 2) - 1 do
    461     if ((ScaleToVcl(y0) + y) >= 0) and ((ScaleToVcl(y0) + y) < ScaleToVcl(InnerHeight)) then begin
    462       PaintPtr := PixelPointer(OffScreen, 0, ScaleToVcl(y0) + y);
    463       CoalPtr := PixelPointer(Templates, 0, ScaleToVcl(yCoal) + y);
     459  for y := 0 to ScaleToNative(ySizeBig) * 2 - 1 do
     460    if ((ScaleToNative(y0) + y) >= 0) and ((ScaleToNative(y0) + y) < ScaleToNative(InnerHeight)) then begin
     461      PaintPtr := PixelPointer(OffScreen, 0, ScaleToNative(y0) + y);
     462      CoalPtr := PixelPointer(Templates, 0, ScaleToNative(yCoal) + y);
    464463      for dy := -1 to 1 do
    465         if ((Max(y + ScaleToVcl(dy), 0) shr 1) >= 0) and ((Max(y + ScaleToVcl(dy), 0) shr 1) < ScaleToVcl(ySizeBig)) then
    466           ImpPtr[dy] := PixelPointer(BigImp, 0, ScaleToVcl(ySrc) + (Max(y + ScaleToVcl(dy), 0) shr 1));
    467       for x := 0 to ScaleToVcl(xSizeBig * 2) - 1 do begin
    468         Sum := 0;
     464        if ((Max(y + ScaleToNative(dy), 0) shr 1) >= 0) and ((Max(y + ScaleToNative(dy), 0) shr 1) < ScaleToNative(ySizeBig)) then
     465          ImpPtr[dy] := PixelPointer(BigImp, 0, ScaleToNative(ySrc) + (Max(y + ScaleToNative(dy), 0) shr 1));
     466      for x := 0 to ScaleToNative(xSizeBig) * 2 - 1 do begin
     467        sum := 0;
    469468        for dx := -1 to 1 do begin
    470           xx := ScaleToVcl(xSrc) + Max((x + ScaleToVcl(dx)), 0) shr 1;
     469          xx := ScaleToNative(xSrc) + Max((x + ScaleToNative(dx)), 0) shr 1;
    471470          for dy := -1 to 1 do begin
    472471            ImpPtr[dy].SetX(xx);
    473             if ((y + ScaleToVcl(dy)) shr 1 < 0) or ((y + ScaleToVcl(dy)) shr 1 >= ScaleToVcl(ySizeBig)) or
    474               ((x + ScaleToVcl(dx)) shr 1 < 0) or ((x + ScaleToVcl(dx)) shr 1 >= ScaleToVcl(xSizeBig)) or
    475               ((y + ScaleToVcl(dy)) shr 1 < ScaleToVcl(nHeaven)) and
     472            if ((y + ScaleToNative(dy)) shr 1 < 0) or ((y + ScaleToNative(dy)) shr 1 >= ScaleToNative(ySizeBig)) or
     473              ((x + ScaleToNative(dx)) shr 1 < 0) or ((x + ScaleToNative(dx)) shr 1 >= ScaleToNative(xSizeBig)) or
     474              ((y + ScaleToNative(dy)) shr 1 < ScaleToNative(nHeaven)) and
    476475              (ImpPtr[dy].Pixel^.B shl 16 + ImpPtr[dy].Pixel^.G shl 8 +
    477               ImpPtr[dy].Pixel^.R = Heaven[(ScaleFromVcl(y) + dy) shr 1]) then
    478               Sum := Sum + 9 * 255
     476              ImpPtr[dy].Pixel^.R = Heaven[(ScaleFromNative(y) + dy) shr 1]) then
     477              sum := sum + 9 * 255
    479478            else
    480               Sum := Sum + ImpPtr[dy].Pixel^.B + 5 * ImpPtr[dy].Pixel^.G + 3 *
     479              sum := sum + ImpPtr[dy].Pixel^.B + 5 * ImpPtr[dy].Pixel^.G + 3 *
    481480                ImpPtr[dy].Pixel^.R;
    482481          end;
    483482        end;
    484         if Sum < MaxSum then begin // no saturation
    485           CoalPtr.SetX(ScaleToVcl(xCoal) + x);
    486           Sum := 1 shl 22 - (MaxSum - Sum) * (256 - CoalPtr.Pixel^.B * 2);
     483        if sum < MaxSum then begin // no saturation
     484          CoalPtr.SetX(ScaleToNative(xCoal) + x);
     485          sum := 1 shl 22 - (MaxSum - sum) * (256 - CoalPtr.Pixel^.B * 2);
    487486          PaintPtr.SetX(x0 + x);
    488           PaintPtr.Pixel^.B := PaintPtr.Pixel^.B * Sum shr 22;
    489           PaintPtr.Pixel^.G := PaintPtr.Pixel^.G * Sum shr 22;
    490           PaintPtr.Pixel^.R := PaintPtr.Pixel^.R * Sum shr 22;
     487          PaintPtr.Pixel^.B := PaintPtr.Pixel^.B * sum shr 22;
     488          PaintPtr.Pixel^.G := PaintPtr.Pixel^.G * sum shr 22;
     489          PaintPtr.Pixel^.R := PaintPtr.Pixel^.R * sum shr 22;
    491490        end;
    492491      end;

  • branches/highdpi/LocalPlayer/IsoEngine.pas

    r212 r246  
    10151015            1 + 8 * (xxt * 2 + 1), 1 + yyt + 16 * (yyt * 3 + 1));
    10161016          Borders.BeginUpdate;
    1017           PixelPtr := PixelPointer(Borders, ScaleToVcl(0), ScaleToVcl(p1 * (yyt * 2)));
    1018           for dy := 0 to ScaleToVcl(yyt * 2) - 1 do begin
    1019             for dx := 0 to ScaleToVcl(xxt * 2) - 1 do begin
     1017          PixelPtr := PixelPointer(Borders, ScaleToNative(0), ScaleToNative(p1 * (yyt * 2)));
     1018          for dy := 0 to ScaleToNative(yyt * 2) - 1 do begin
     1019            for dx := 0 to ScaleToNative(xxt * 2) - 1 do begin
    10201020              if PixelPtr.Pixel^.B = 99 then begin
    10211021                PixelPtr.Pixel^.B := Tribe[p1].Color shr 16 and $FF;
    … …  
    13391339begin
    13401340  FOutput.BeginUpdate;
    1341   Line := PixelPointer(FOutput, ScaleToVcl(x0), ScaleToVcl(y0));
    1342   for y := 0 to ScaleToVcl(Height) - 1 do begin
    1343     y_n := (ScaleFromVcl(y) + y0 - ym) / yyt;
    1344     if Abs(y_n) < rShade then begin
     1341  Line := PixelPointer(FOutput, ScaleToNative(x0), ScaleToNative(y0));
     1342  for y := 0 to ScaleToNative(Height) - 1 do begin
     1343    y_n := (ScaleFromNative(y) + y0 - ym) / yyt;
     1344    if abs(y_n) < rShade then begin
    13451345      // Darken left and right parts of elipsis
    1346       w_n := Sqrt(Sqr(rShade) - Sqr(y_n));
    1347       wBright := Trunc(w_n * xxt + 0.5);
     1346      w_n := sqrt(sqr(rShade) - sqr(y_n));
     1347      wBright := trunc(w_n * xxt + 0.5);
    13481348      Line.SetX(0);
    1349       MakeDark(@Line, ScaleToVcl(xm - wBright));
    1350       Line.SetX(ScaleToVcl(xm + wBright));
    1351       MakeDark(@Line, ScaleToVcl(Width - xm - wBright));
     1349      MakeDark(@Line, ScaleToNative(xm - wBright));
     1350      Line.SetX(ScaleToNative(xm + wBright));
     1351      MakeDark(@Line, ScaleToNative(Width - xm - wBright));
    13521352    end else begin
    13531353      // Darken entire line
    13541354      Line.SetX(0);
    1355       MakeDark(@Line, ScaleToVcl(Width));
     1355      MakeDark(@Line, ScaleToNative(Width));
    13561356    end;
    13571357    Line.NextLine;

  • branches/highdpi/LocalPlayer/MessgEx.lfm

    r210 r246  
    2020  OnShow = FormShow
    2121  PixelsPerInch = 96
     22  Scaled = False
    2223  object Button1: TButtonA
    2324    Left = 43

  • branches/highdpi/LocalPlayer/MessgEx.pas

    r216 r246  
    212212        Sleep(1);
    213213        Ticks := NowPrecise;
    214       until MovieCancelled or (MillisecondOf(Ticks - Ticks0) >= 1500);
     214      until MovieCancelled or (Round((Ticks - Ticks0) / OneMillisecond) >= 1500);
    215215      Hide;
    216216    end;
    … …  
    237237  Screwed: array [0 .. wScrewed - 1, 0 .. hScrewed - 1, 0 .. 3] of single;
    238238  SrcPtr: TPixelPointer;
    239 begin
     239  Width: Integer;
     240  Height: Integer;
     241begin
     242  Width := 56;
     243  Height := 40;
    240244  if IconIndex >= 0 then begin
    241245    xIcon := IconIndex mod 7 * xSizeBig;
    242246    yIcon := (IconIndex + SystemIconLines * 7) div 7 * ySizeBig;
    243247    // prepare screwed icon
    244     fillchar(Screwed, sizeof(Screwed), 0);
     248    FillChar(Screwed, sizeof(Screwed), 0);
    245249    BigImp.BeginUpdate;
    246     for iy := 0 to 39 do begin
    247       for ix := 0 to 55 do begin
    248         SrcPtr := PixelPointer(BigImp, ix + xIcon, iy + yIcon);
    249         xR := ix * (37 + iy * 5 / 40) / 56;
     250    SrcPtr := PixelPointer(BigImp, ScaleToNative(xIcon), ScaleToNative(yIcon));
     251    for iy := 0 to ScaleToNative(Height) - 1 do begin
     252      for ix := 0 to ScaleToNative(Width) - 1 do begin
     253        xR := ScaleFromNative(ix) * (37 + ScaleFromNative(iy) * 5 / Height) / Width;
    250254        xDst := Trunc(xR);
    251255        xR := Frac(xR);
    252         x1 := (120 - ix) * (120 - ix) - 10000;
    253         yR := iy * 18 / 40 + x1 * x1 / 4000000;
     256        x1 := (120 - ScaleFromNative(ix)) * (120 - ScaleFromNative(ix)) - 10000;
     257        yR := ScaleFromNative(iy) * 18 / Height + x1 * x1 / 4000000;
    254258        yDst := Trunc(yR);
    255259        yR := Frac(yR);
    … …  
    272276            Screwed[xDst + dx, yDst + dy, 3] := Screwed[xDst + dx, yDst + dy,
    273277              3] + share;
    274           end;
    275       end;
     278        end;
     279        SrcPtr.NextPixel;
     280      end;
     281      SrcPtr.NextLine;
    276282    end;
    277283    BigImp.EndUpdate;
    … …  
    373379      begin
    374380        p1 := MyRO.Wonder[IconIndex].EffectiveOwner;
     381        // TODO: Explicitly clear background to black but in fact BitBlt SRCCOPY should do it
     382        Buffer.Canvas.FillRect(0, 0, 1, 1);
    375383        DpiBitCanvas(Buffer.Canvas, 0, 0, xSizeBig + 2 * GlowRange,
    376384          ySizeBig + 2 * GlowRange, Canvas,

  • branches/highdpi/LocalPlayer/NatStat.lfm

    r244 r246  
    1717  OnShow = FormShow
    1818  PixelsPerInch = 96
     19  Scaled = False
    1920  object ToggleBtn: TButtonB
    2021    Left = 6

  • branches/highdpi/LocalPlayer/Select.lfm

    r244 r246  
    2323  OnShow = FormShow
    2424  PixelsPerInch = 96
     25  Scaled = False
    2526  object CloseBtn: TButtonB
    2627    Left = 343

  • branches/highdpi/LocalPlayer/Select.pas

    r244 r246  
    578578                    295 + (AdvIcon[lix] - 84) div 8 * 21);
    579579                j := AdvValue[lix] div 1000;
    580                 DpiBitCanvas(Canvas, (8 + 16 - 4), y0 + 2, 14, 14,
     580                DpiBitCanvas(offscreen.Canvas, (8 + 16 - 4), y0 + 2, 14, 14,
    581581                  GrExt[HGrSystem].Mask.Canvas, 127 + j * 15,
    582582                  85, SRCAND);
    … …  
    754754        end;
    755755      end;
     756
    756757    for i := -1 to DispLines do
    757758      if (i + sb.Position >= 0) and (i + sb.Position < Lines[Layer]) then

  • branches/highdpi/LocalPlayer/TechTree.pas

    r210 r246  
    99
    1010type
     11
     12  { TTechTreeDlg }
     13
    1114  TTechTreeDlg = class(TDrawDlg)
    1215    CloseBtn: TButtonB;
    1316    procedure FormCreate(Sender: TObject);
     17    procedure FormDestroy(Sender: TObject);
    1418    procedure FormPaint(Sender: TObject);
    1519    procedure FormShow(Sender: TObject);
    … …  
    2428    xOffset, yOffset, xDown, yDown: Integer;
    2529    Image: TDpiBitmap;
    26     dragging: boolean;
     30    Dragging: Boolean;
    2731  end;
    2832
    … …  
    7276  InitButtons;
    7377  Image := nil;
     78end;
     79
     80procedure TTechTreeDlg.FormDestroy(Sender: TObject);
     81begin
     82  FreeAndNil(Image);
    7483end;
    7584
    … …  
    121130  X, Y, ad: Integer;
    122131  s: string;
     132  NewWidth: Integer;
     133  NewHeight: Integer;
    123134const
    124135  TransparentColor = $7F007F;
    … …  
    164175
    165176  // fit window to image, center image in window, center window to screen
    166   width := min(DpiScreen.width - 40, Image.width + LeftBorder + RightBorder + 2 *
    167     BlackBorder);
    168   height := min(DpiScreen.height - 40, Image.height + TopBorder + BottomBorder + 2
    169     * BlackBorder);
    170   Left := (DpiScreen.width - width) div 2;
    171   Top := (DpiScreen.height - height) div 2;
     177  NewWidth := Min(DpiScreen.Width - 40, Image.Width + LeftBorder + RightBorder + 2 * BlackBorder);
     178  NewHeight := Min(DpiScreen.Height - 40, Image.Height + TopBorder + BottomBorder + 2 * BlackBorder);
     179  BoundsRect := Bounds((DpiScreen.Width - NewWidth) div 2,
     180    (DpiScreen.Height - NewHeight) div 2,
     181    NewWidth, NewHeight);
    172182  CloseBtn.Left := width - CloseBtn.width - BlackBorder - 8;
    173183  CloseBtn.Top := BlackBorder + 8;
    174   xOffset := (ClientWidth - Image.width + LeftBorder - RightBorder) div 2 -
     184  xOffset := (ClientWidth - Image.Width + LeftBorder - RightBorder) div 2 -
    175185    BlackBorder;
    176   yOffset := ClientHeight - 2 * BlackBorder - Image.height - BottomBorder;
     186  yOffset := ClientHeight - 2 * BlackBorder - Image.Height - BottomBorder;
    177187end;
    178188

  • branches/highdpi/LocalPlayer/Term.lfm

    r244 r246  
    11object MainScreen: TMainScreen
    22  Left = 231
    3   Height = 600
     3  Height = 480
    44  Top = 190
    5   Width = 1000
     5  Width = 800
    66  HorzScrollBar.Visible = False
    77  VertScrollBar.Visible = False
    88  Caption = 'C-evo'
    9   ClientHeight = 600
    10   ClientWidth = 1000
     9  ClientHeight = 480
     10  ClientWidth = 800
    1111  Color = clBtnFace
    12   Constraints.MinHeight = 600
    13   Constraints.MinWidth = 1000
    14   DesignTimePPI = 120
     12  Constraints.MinHeight = 480
     13  Constraints.MinWidth = 800
    1514  Font.Color = clWindowText
    16   Font.Height = -16
     15  Font.Height = -13
    1716  Font.Name = 'MS Sans Serif'
    1817  KeyPreview = True
    … …  
    3130  OnShow = FormShow
    3231  Position = poDefault
    33   LCLVersion = '2.0.6.0'
     32  PixelsPerInch = 96
     33  Scaled = False
     34  LCLVersion = '1.6.0.4'
    3435  WindowState = wsMaximized
    3536  object UnitBtn: TButtonB
    3637    Tag = 14
    37     Left = 260
    38     Height = 31
    39     Top = 480
    40     Width = 31
     38    Left = 208
     39    Height = 25
     40    Top = 384
     41    Width = 25
    4142    Visible = False
    4243    Down = False
    … …  
    4748  object MapBtn0: TButtonC
    4849    Tag = 51
    49     Left = 20
    50     Height = 15
    51     Top = 380
    52     Width = 15
     50    Left = 16
     51    Height = 12
     52    Top = 304
     53    Width = 12
    5354    Visible = False
    5455    Down = False
    … …  
    5960  object MapBtn1: TButtonC
    6061    Tag = 291
    61     Left = 20
    62     Height = 15
    63     Top = 400
    64     Width = 15
     62    Left = 16
     63    Height = 12
     64    Top = 320
     65    Width = 12
    6566    Visible = False
    6667    Down = False
    … …  
    7172  object MapBtn4: TButtonC
    7273    Tag = 1028
    73     Left = 20
    74     Height = 15
    75     Top = 460
    76     Width = 15
     74    Left = 16
     75    Height = 12
     76    Top = 368
     77    Width = 12
    7778    Visible = False
    7879    Down = False
    … …  
    8384  object MapBtn5: TButtonC
    8485    Tag = 1328
    85     Left = 20
    86     Height = 15
    87     Top = 480
    88     Width = 15
     86    Left = 16
     87    Height = 12
     88    Top = 384
     89    Width = 12
    8990    Visible = False
    9091    Down = False
    … …  
    9596  object MapBtn6: TButtonC
    9697    Tag = 1541
    97     Left = 20
    98     Height = 15
    99     Top = 500
    100     Width = 15
     98    Left = 16
     99    Height = 12
     100    Top = 400
     101    Width = 12
    101102    Visible = False
    102103    Down = False
    … …  
    107108  object TerrainBtn: TButtonB
    108109    Tag = 28
    109     Left = 300
    110     Height = 31
    111     Top = 480
    112     Width = 31
     110    Left = 240
     111    Height = 25
     112    Top = 384
     113    Width = 25
    113114    Visible = False
    114115    Down = False
    … …  
    119120  object UnitInfoBtn: TButtonB
    120121    Tag = 15
    121     Left = 220
    122     Height = 31
    123     Top = 480
    124     Width = 31
     122    Left = 176
     123    Height = 25
     124    Top = 384
     125    Width = 25
    125126    Visible = False
    126127    Down = False
    … …  
    130131  end
    131132  object EOT: TEOTButton
    132     Left = 890
    133     Height = 60
    134     Top = 460
    135     Width = 60
     133    Left = 712
     134    Height = 48
     135    Top = 368
     136    Width = 48
    136137    Visible = False
    137138    Down = False
    … …  
    142143  object MenuArea: TArea
    143144    Left = 2
    144     Height = 45
     145    Height = 36
    145146    Top = 1
    146     Width = 45
     147    Width = 36
    147148  end
    148149  object TreasuryArea: TArea
    149     Left = 260
    150     Height = 45
     150    Left = 208
     151    Height = 36
    151152    Top = 1
    152     Width = 205
     153    Width = 164
    153154  end
    154155  object ResearchArea: TArea
    155     Left = 480
    156     Height = 45
     156    Left = 384
     157    Height = 36
    157158    Top = 1
    158     Width = 300
     159    Width = 240
    159160  end
    160161  object ManagementArea: TArea
    161     Left = 880
    162     Height = 50
    163     Top = 390
    164     Width = 70
     162    Left = 704
     163    Height = 40
     164    Top = 312
     165    Width = 56
    165166  end
    166167  object MovieSpeed1Btn: TButtonB
    167168    Tag = 256
    168     Left = 480
    169     Height = 31
    170     Top = 480
    171     Width = 31
     169    Left = 384
     170    Height = 25
     171    Top = 384
     172    Width = 25
    172173    Visible = False
    173174    Down = False
    … …  
    178179  object MovieSpeed2Btn: TButtonB
    179180    Tag = 512
    180     Left = 520
    181     Height = 31
    182     Top = 480
    183     Width = 31
     181    Left = 416
     182    Height = 25
     183    Top = 384
     184    Width = 25
    184185    Visible = False
    185186    Down = False
    … …  
    190191  object MovieSpeed3Btn: TButtonB
    191192    Tag = 768
    192     Left = 560
    193     Height = 31
    194     Top = 480
    195     Width = 31
     193    Left = 448
     194    Height = 25
     195    Top = 384
     196    Width = 25
    196197    Visible = False
    197198    Down = False
    … …  
    202203  object MovieSpeed4Btn: TButtonB
    203204    Tag = 1024
    204     Left = 600
    205     Height = 31
    206     Top = 480
    207     Width = 31
     205    Left = 480
     206    Height = 25
     207    Top = 384
     208    Width = 25
    208209    Visible = False
    209210    Down = False
    … …  
    216217    Interval = 50
    217218    OnTimer = Timer1Timer
    218     left = 10
    219     top = 60
     219    left = 8
     220    top = 48
    220221  end
    221222  object GamePopup: TDpiPopupMenu
    222223    AutoPopup = False
    223     left = 50
    224     top = 60
     224    left = 40
     225    top = 48
    225226    object mHelp: TDpiMenuItem
    226227      Tag = 7
    … …  
    458459          RadioItem = True
    459460          OnClick = mBigTilesClick
    460         end
     461        end             
    461462      end
    462463      object mSound: TDpiMenuItem
    … …  
    586587  object UnitPopup: TDpiPopupMenu
    587588    AutoPopup = False
    588     left = 130
    589     top = 60
     589    left = 104
     590    top = 48
    590591    object mdisband: TDpiMenuItem
    591592      Tag = 72
    … …  
    669670  object StatPopup: TDpiPopupMenu
    670671    AutoPopup = False
    671     left = 90
    672     top = 60
     672    left = 72
     673    top = 48
    673674    object mUnitStat: TDpiMenuItem
    674675      Tag = 9
    … …  
    725726  end
    726727  object EditPopup: TDpiPopupMenu
    727     left = 210
    728     top = 60
     728    left = 168
     729    top = 48
    729730    object mCreateUnit: TDpiMenuItem
    730731      Tag = 47
    … …  
    732733  end
    733734  object TerrainPopup: TDpiPopupMenu
    734     left = 170
    735     top = 60
     735    left = 136
     736    top = 48
    736737    object mtrans: TDpiMenuItem
    737738      Tag = 273

  • branches/highdpi/LocalPlayer/Term.pas

    r244 r246  
    287287    Offscreen: TDpiBitmap;
    288288    OffscreenUser: TDpiForm;
    289     procedure CreateParams(var p: TCreateParams); override;
    290289    procedure Client(Command, NewPlayer: integer; var Data);
    291290    procedure SetAIName(p: integer; Name: string);
    … …  
    532531  SmallScreen, GameOK, MapValid, skipped, idle: boolean;
    533532
    534   SaveOption: array [0..nSaveOption - 1] of integer;
    535   MiniColors: array [0..fTerrain, 0..1] of TColor;
     533  SaveOption: array [0 .. nSaveOption - 1] of integer;
     534  MiniColors: array [0 .. 11, 0 .. 1] of TColor;
    536535  MainMap: TIsoMap;
    537536  CurrentMoveInfo: record AfterMovePaintRadius, AfterAttackExpeller: integer;
    … …  
    555554  Sharpen = 80;
    556555type
    557   TBuffer = array [0 .. 99999, 0 .. 2] of integer;
     556  TBuffer = array [0 .. 99999, 0 .. 2] of Integer;
    558557var
    559   sum, Cnt, dx, dy, nx, ny, ix, iy, ir, x, y, c, ch, xdivider,
    560     ydivider: integer;
    561   resampled: ^TBuffer;
     558  Sum, Cnt, dx, dy, nx, ny, ix, iy, ir, x, y, c, ch: Integer;
     559  xdivider, ydivider: Integer;
     560  Resampled: ^TBuffer;
    562561  PixelPtr: TPixelPointer;
    563562begin
    564   nx := BigImp.width div xSizeBig * xSizeSmall;
    565   ny := BigImp.height div ySizeBig * ySizeSmall;
     563  nx := BigImp.Width div xSizeBig * xSizeSmall;
     564  ny := BigImp.Height div ySizeBig * ySizeSmall;
    566565
    567566  // resample icons
    568   GetMem(resampled, nx * ny * 12);
    569   FillChar(resampled^, nx * ny * 12, 0);
     567  GetMem(Resampled, nx * ny * 12);
     568  FillChar(Resampled^, nx * ny * 12, 0);
    570569  BigImp.BeginUpdate;
    571   for ix := 0 to BigImp.width div xSizeBig - 1 do
    572     for iy := 0 to BigImp.height div ySizeBig - 1 do
    573       for y := 0 to ySizeBig - 2 * cut - 1 do
    574       begin
    575         ydivider := (y * ySizeSmall div (ySizeBig - 2 * cut) + 1) *
    576           (ySizeBig - 2 * cut) - y * ySizeSmall;
     570  for ix := 0 to BigImp.Width div xSizeBig - 1 do
     571    for iy := 0 to BigImp.Height div ySizeBig - 1 do begin
     572      PixelPtr := PixelPointer(BigImp, ScaleToNative(ix * xSizeBig),
     573        ScaleToNative(cut + iy * ySizeBig));
     574      for y := 0 to ScaleToNative(ySizeBig - 2 * cut) - 1 do begin
     575        ydivider := (ScaleFromNative(y) * ySizeSmall div (ySizeBig - 2 * cut) + 1) *
     576          (ySizeBig - 2 * cut) - ScaleFromNative(y) * ySizeSmall;
    577577        if ydivider > ySizeSmall then
    578578          ydivider := ySizeSmall;
    579         PixelPtr := PixelPointer(BigImp, 0, cut + iy * ySizeBig + y);
    580         for x := 0 to xSizeBig - 1 do
    581         begin
    582           ir := ix * xSizeSmall + iy * nx * ySizeSmall + x *
    583             xSizeSmall div xSizeBig + y *
     579        for x := 0 to ScaleToNative(xSizeBig) - 1 do begin
     580          ir := ix * xSizeSmall + iy * nx * ySizeSmall + ScaleFromNative(x) *
     581            xSizeSmall div xSizeBig + ScaleFromNative(y) *
    584582            ySizeSmall div (ySizeBig - 2 * cut) * nx;
    585           xdivider := (x * xSizeSmall div xSizeBig + 1) * xSizeBig - x *
    586             xSizeSmall;
     583          xdivider := (ScaleFromNative(x) * xSizeSmall div xSizeBig + 1) *
     584            xSizeBig - ScaleFromNative(x) * xSizeSmall;
    587585          if xdivider > xSizeSmall then
    588586            xdivider := xSizeSmall;
    589           for ch := 0 to 2 do
    590           begin
    591             PixelPtr.SetX(ix * xSizeBig + x);
     587          for ch := 0 to 2 do begin
    592588            c := PixelPtr.Pixel^.Planes[ch];
    593             inc(resampled[ir, ch], c * xdivider * ydivider);
     589            Inc(Resampled[ir, ch], c * xdivider * ydivider);
    594590            if xdivider < xSizeSmall then
    595               inc(resampled[ir + 1, ch], c * (xSizeSmall - xdivider) *
     591              Inc(Resampled[ir + 1, ch], c * (xSizeSmall - xdivider) *
    596592                ydivider);
    597593            if ydivider < ySizeSmall then
    598               inc(resampled[ir + nx, ch],
     594              Inc(Resampled[ir + nx, ch],
    599595                c * xdivider * (ySizeSmall - ydivider));
    600596            if (xdivider < xSizeSmall) and (ydivider < ySizeSmall) then
    601               inc(resampled[ir + nx + 1, ch], c * (xSizeSmall - xdivider) *
     597              Inc(Resampled[ir + nx + 1, ch], c * (xSizeSmall - xdivider) *
    602598                (ySizeSmall - ydivider));
    603599          end;
     600          PixelPtr.NextPixel;
    604601        end;
     602        PixelPtr.NextLine;
    605603      end;
     604    end;
    606605  BigImp.EndUpdate;
    607606
    608   // sharpen resampled icons
     607  // Sharpen Resampled icons
    609608  SmallImp.SetSize(nx, ny);
    610609  SmallImp.BeginUpdate;
    611   for y := 0 to ny - 1 do begin
    612     PixelPtr := PixelPointer(SmallImp, 0, y);
    613     for x := 0 to nx - 1 do
     610  PixelPtr := PixelPointer(SmallImp);
     611  for y := 0 to ScaleToNative(ny) - 1 do begin
     612    for x := 0 to ScaleToNative(nx) - 1 do begin
    614613      for ch := 0 to 2 do begin
    615         sum := 0;
     614        Sum := 0;
    616615        Cnt := 0;
    617616        for dy := -1 to 1 do
    618           if ((dy >= 0) or (y mod ySizeSmall > 0)) and
    619             ((dy <= 0) or (y mod ySizeSmall < ySizeSmall - 1)) then
     617          if ((dy >= 0) or (ScaleFromNative(y) mod ySizeSmall > 0)) and
     618            ((dy <= 0) or (ScaleFromNative(y) mod ySizeSmall < ySizeSmall - 1)) then
    620619            for dx := -1 to 1 do
    621               if ((dx >= 0) or (x mod xSizeSmall > 0)) and
    622                 ((dx <= 0) or (x mod xSizeSmall < xSizeSmall - 1)) then
     620              if ((dx >= 0) or (ScaleFromNative(x) mod xSizeSmall > 0)) and
     621                ((dx <= 0) or (ScaleFromNative(x) mod xSizeSmall < xSizeSmall - 1)) then
    623622              begin
    624                 inc(sum, resampled[x + dx + nx * (y + dy), ch]);
    625                 inc(Cnt);
     623                Inc(Sum, Resampled[ScaleFromNative(x) + dx + nx * (ScaleFromNative(y) + dy), ch]);
     624                Inc(Cnt);
    626625              end;
    627         sum := ((Cnt * Sharpen + 800) * resampled[x + nx * y, ch] - sum *
     626        Sum := ((Cnt * Sharpen + 800) * Resampled[ScaleFromNative(x) + nx * ScaleFromNative(y), ch] - Sum *
    628627          Sharpen) div (800 * xSizeBig * (ySizeBig - 2 * cut));
    629         if sum < 0 then sum := 0;
    630         if sum > 255 then sum := 255;
    631         PixelPtr.SetX(x);
    632         PixelPtr.Pixel^.Planes[ch] := sum;
     628        if Sum < 0 then Sum := 0;
     629        if Sum > 255 then Sum := 255;
     630        PixelPtr.Pixel^.Planes[ch] := Sum;
    633631      end;
     632      PixelPtr.NextPixel;
     633    end;
     634    PixelPtr.NextLine;
    634635  end;
    635636  SmallImp.EndUpdate;
    636   FreeMem(resampled);
     637  FreeMem(Resampled);
    637638end;
    638639
    … …  
    33993400{ *** main part *** }
    34003401
    3401 procedure TMainScreen.CreateParams(var p: TCreateParams);
    3402 begin
    3403   inherited;
    3404   if FullScreen then begin
    3405     p.Style := $87000000;
    3406     BorderStyle := bsNone;
    3407     BorderIcons := [];
    3408   end;
    3409 end;
    3410 
    34113402procedure TMainScreen.FormCreate(Sender: TObject);
    34123403var
    … …  
    40774068  MiniPixel := PixelPointer(Mini);
    40784069  PrevMiniPixel := PixelPointer(Mini);
    4079   for y := 0 to ScaleToVcl(G.ly) - 1 do
    4080   begin
    4081     for x := 0 to ScaleToVcl(G.lx) - 1 do
    4082       if MyMap[ScaleFromVcl(x) + G.lx * ScaleFromVcl(y)] and fTerrain <> fUNKNOWN then
    4083       begin
    4084         Loc := ScaleFromVcl(x) + G.lx * ScaleFromVcl(y);
     4070  for y := 0 to ScaleToNative(G.ly) - 1 do
     4071  begin
     4072    for x := 0 to ScaleToNative(G.lx) - 1 do
     4073      if MyMap[ScaleFromNative(x) + G.lx * ScaleFromNative(y)] and fTerrain <> fUNKNOWN then
     4074      begin
     4075        Loc := ScaleFromNative(x) + G.lx * ScaleFromNative(y);
    40854076        for i := 0 to 1 do
    40864077        begin
    4087           xm := ((x - ScaleToVcl(xwMini)) * 2 + i + y and 1 - ScaleToVcl(hw) +
    4088             ScaleToVcl(G.lx) * 5) mod (ScaleToVcl(G.lx) * 2);
     4078          xm := ((x - ScaleToNative(xwMini)) * 2 + i + y and 1 - ScaleToNative(hw) +
     4079            ScaleToNative(G.lx) * 5) mod (ScaleToNative(G.lx) * 2);
    40894080          MiniPixel.SetXY(xm, y);
    40904081          cm := MiniColors[MyMap[Loc] and fTerrain, i];
    … …  
    60926083      NoMap.PaintUnit(xMoving - xMin, yMoving - yMin, UnitInfo, 0);
    60936084      PaintBufferToScreen(xMin, yMin, xRange, yRange);
     6085      {$IFDEF LINUX}
     6086      // TODO: Force animation under linux
     6087      DpiApplication.ProcessMessages;
     6088      {$ENDIF}
    60946089
    60956090      SliceCount := 0;
    … …  
    60976092      repeat
    60986093        if (SliceCount = 0) or
    6099           (MillisecondOf(Ticks - Ticks0) * 12 * (SliceCount + 1) div SliceCount
     6094          (Round(((Ticks - Ticks0) * 12) / OneMillisecond) * (SliceCount + 1) div SliceCount
    61006095          < MoveTime) then
    61016096        begin
    61026097          if not idle or (GameMode = cMovie) then
    61036098            DpiApplication.ProcessMessages;
    6104           {$IFDEF LINUX}
    6105           // TODO: Force animation under linux
    6106           DpiApplication.ProcessMessages;
    6107           {$ENDIF}
    61086099          Sleep(1);
    61096100          inc(SliceCount)
    61106101        end;
    61116102        Ticks := NowPrecise;
    6112       until (Ticks - Ticks0) / OneMillisecond * 12 >= MoveTime;
     6103      until (((Ticks - Ticks0) * 12) / OneMillisecond) >= MoveTime;
    61136104      Ticks0 := Ticks
    61146105    end;
    … …  
    65516542          time1 := NowPrecise;
    65526543          SimpleMessage(Format('Map repaint time: %.3f ms',
    6553             [MillisecondOf(time1 - time0)]));
     6544            [(time1 - time0) / OneMillisecond]));
    65546545        end
    65556546    end
    … …  
    76287619        InitPopup(GamePopup);
    76297620        if FullScreen then
    7630           // GamePopup.FItems.Count
    76317621          GamePopup.Popup(Left, Top + TopBarHeight - 1)
    76327622        else
    … …  
    78077797procedure TMainScreen.FormShow(Sender: TObject);
    78087798begin
    7809   Timer1.Enabled := true;
    7810   Left := 0;
    7811   Top := 0;
     7799  if FullScreen then begin
     7800    WindowState := wsFullScreen;
     7801    BorderStyle := bsNone;
     7802    BorderIcons := [];
     7803  end else begin
     7804    WindowState := wsMaximized;
     7805    BorderStyle := bsSizeable;
     7806    BorderIcons := [biSystemMenu, biMinimize, biMaximize];
     7807  end;
     7808  Timer1.Enabled := True;
    78127809end;
    78137810

  • branches/highdpi/LocalPlayer/Wonders.lfm

    r210 r246  
    1717  OnShow = FormShow
    1818  PixelsPerInch = 96
     19  Scaled = False
    1920  object CloseBtn: TButtonB
    2021    Left = 442

  • branches/highdpi/LocalPlayer/Wonders.pas

    r210 r246  
    8787procedure TWondersDlg.PaintBackgroundShape;
    8888const
    89   darken = 24;
     89  Darken = 24;
    9090  // space=pi/120;
    9191  amax0 = 15734; // 1 shl 16*tan(pi/12-space);
    … …  
    103103  C: Integer;
    104104  Ch: Integer;
    105   Line: array [0..1] of TPixelPointer;
     105  Line: array [0..3] of TPixelPointer;
    106106  Width: Integer;
    107107  Height: Integer;
    108   CenterNative: TPoint;
    109 begin
    110   Width := ScaleToVcl(180);
    111   Height := ScaleToVcl(128);
    112   CenterNative := ScalePointtoVcl(Center);
     108begin
     109  Width := ScaleToNative(180);
     110  Height := ScaleToNative(128);
    113111  Offscreen.BeginUpdate;
    114   Line[0] := PixelPointer(Offscreen);
    115   Line[1] := PixelPointer(Offscreen);
     112  Line[0] := PixelPointer(Offscreen, ScaleToNative(Center.X), ScaleToNative(Center.Y));
     113  Line[1] := PixelPointer(Offscreen, ScaleToNative(Center.X), ScaleToNative(Center.Y) - 1);
     114  Line[2] := PixelPointer(Offscreen, ScaleToNative(Center.X) - 1, ScaleToNative(Center.Y));
     115  Line[3] := PixelPointer(Offscreen, ScaleToNative(Center.X) - 1, ScaleToNative(Center.Y) - 1);
    116116  for Y := 0 to Height - 1 do begin
    117117    for X := 0 to Width - 1 do begin
    118118      r := X * X * ((Height div 4) * (Height div 4)) + Y * Y * ((Width div 4) * (Width div 4));
    119119      ax := ((1 shl 16 div (Height div 4)) * (Width div 4)) * Y;
    120       if (r < ScaleToVcl(8) * Height * Width * Width) and
     120      if (r < ScaleToNative(8) * Height * Width * Width) and
    121121        ((r >= (Height div 4) * (Height div 2) * (Width div 2) * (Width div 2)) and (ax < amax2 * X) and
    122122        ((ax < amax0 * X) or (ax > amin2 * X)) or (ax > amin1 * X) and
    123         ((ax < amax1 * X) or (ax > amin3 * X))) then
    124         for i := 0 to 1 do
    125           for ch := 0 to 2 do begin
    126             Line[0].SetXY(CenterNative.X + X, CenterNative.Y + Y);
    127             Line[1].SetXY(CenterNative.X + X, CenterNative.Y - 1 - Y);
    128             c := Line[i].Pixel^.Planes[ch] - darken;
    129             if c < 0 then Line[i].Pixel^.Planes[ch] := 0
    130               else Line[i].Pixel^.Planes[ch] := c;
    131             Line[0].SetXY(CenterNative.X - 1 - X, CenterNative.Y + Y);
    132             Line[1].SetXY(CenterNative.X - 1 - X, CenterNative.Y - 1 - Y);
    133             c := Line[i].Pixel^.Planes[ch] - darken;
    134             if c < 0 then Line[i].Pixel^.Planes[ch] := 0
    135               else Line[i].Pixel^.Planes[ch] := c;
    136           end;
    137     end;
     123        ((ax < amax1 * X) or (ax > amin3 * X))) then begin
     124        for ch := 0 to 2 do begin
     125          c := Line[0].Pixel^.Planes[ch] - Darken;
     126          if c < 0 then Line[0].Pixel^.Planes[ch] := 0
     127            else Line[0].Pixel^.Planes[ch] := c;
     128          c := Line[1].Pixel^.Planes[ch] - Darken;
     129          if c < 0 then Line[1].Pixel^.Planes[ch] := 0
     130            else Line[1].Pixel^.Planes[ch] := c;
     131          c := Line[2].Pixel^.Planes[ch] - Darken;
     132          if c < 0 then Line[2].Pixel^.Planes[ch] := 0
     133            else Line[2].Pixel^.Planes[ch] := c;
     134          c := Line[3].Pixel^.Planes[ch] - Darken;
     135          if c < 0 then Line[3].Pixel^.Planes[ch] := 0
     136            else Line[3].Pixel^.Planes[ch] := c;
     137        end;
     138      end;
     139      Line[0].NextPixel;
     140      Line[1].NextPixel;
     141      Line[2].PreviousPixel;
     142      Line[3].PreviousPixel;
     143    end;
     144    Line[0].NextLine;
     145    Line[1].PreviousLine;
     146    Line[2].NextLine;
     147    Line[3].PreviousLine;
    138148  end;
    139149  Offscreen.EndUpdate;
    … …  
    150160  x0Src := (i mod 7) * xSizeBig;
    151161  y0Src := (i div 7 + SystemIconLines) * ySizeBig;
    152 
    153   Src := PixelPointer(BigImp, ScaleToVcl(x0Src), ScaleToVcl(y0Src));
    154   Dst := PixelPointer(Offscreen, ScaleToVcl(x0Dst), ScaleToVcl(y0Dst));
    155   for Y := 0 to ScaleToVcl(ySizeBig) - 1 do begin
    156     for X := 0 to ScaleToVcl(xSizeBig) - 1 do begin
     162  Src := PixelPointer(BigImp, ScaleToNative(x0Src), ScaleToNative(y0Src));
     163  Dst := PixelPointer(Offscreen, ScaleToNative(x0Dst), ScaleToNative(y0Dst));
     164  for Y := 0 to ScaleToNative(ySizeBig) - 1 do begin
     165    for X := 0 to ScaleToNative(xSizeBig) - 1 do begin
    157166      Darken := ((255 - Src.Pixel^.B) * 3 + (255 - Src.Pixel^.G) *
    158167        15 + (255 - Src.Pixel^.R) * 9) div 128;
Note: See TracChangeset for help on using the changeset viewer.