Changeset 193


Ignore:
Timestamp:
May 7, 2020, 7:05:57 PM (5 years ago)
Author:
chronos
Message:
  • Modified: Improved code in HighDPI branch.
Location:
branches/highdpi
Files:
22 edited

Legend:

Unmodified
Added
Removed

  • branches/highdpi/Back.pas

    r179 r193  
    6565begin
    6666  if Assigned(Img) then
    67     DpiBitBlt(Canvas.Handle, Screen.Width - Img.Width - (Screen.Width - 800) *
    68       3 div 8, (Screen.Height - 600) div 3, Img.Width, Img.Height,
     67    DpiBitBlt(Canvas.Handle, DpiScreen.Width - Img.Width - (DpiScreen.Width - 800) *
     68      3 div 8, (DpiScreen.Height - 600) div 3, Img.Width, Img.Height,
    6969      Img.Canvas.Handle, 0, 0, SRCCOPY);
    7070end;

  • branches/highdpi/Inp.pas

    r111 r193  
    77  ScreenTools, Messg,
    88  LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, DrawDlg,
    9   ButtonA, StdCtrls;
     9  ButtonA, StdCtrls, UDpiControls;
    1010
    1111type
    … …  
    8888  EInput.SelLength := Length(EInput.Text);
    8989  if Center then
    90     CenterToRect(Rect(0, 0, Screen.Width, Screen.Height));
     90    CenterToRect(Rect(0, 0, DpiScreen.Width, DpiScreen.Height));
    9191end;
    9292

  • branches/highdpi/Integrated.lpi

    r180 r193  
    1616      <ResourceType Value="res"/>
    1717      <UseXPManifest Value="True"/>
     18      <XPManifest>
     19        <DpiAware Value="True"/>
     20      </XPManifest>
    1821      <Icon Value="0"/>
    1922      <Resources Count="2">
    … …  
    133136        <ComponentName Value="DirectDlg"/>
    134137        <HasResources Value="True"/>
     138        <ResourceBaseClass Value="Form"/>
    135139      </Unit7>
    136140      <Unit8>

  • branches/highdpi/LocalPlayer/Battle.pas

    r179 r193  
    212212    OKBtn.Visible := true;
    213213    CancelBtn.Visible := true;
    214     Left := (Screen.Width - ClientWidth) div 2; // center on screen
    215     Top := (Screen.Height - ClientHeight) div 2;
     214    Left := (DpiScreen.Width - ClientWidth) div 2; // center on screen
     215    Top := (DpiScreen.Height - ClientHeight) div 2;
    216216  end
    217217  else

  • branches/highdpi/LocalPlayer/CityScreen.pas

    r179 r193  
    11061106  if WindowMode = wmModal then
    11071107  begin { center on screen }
    1108     Left := (Screen.Width - Width) div 2;
    1109     Top := (Screen.Height - Height) div 2;
     1108    Left := (DpiScreen.Width - Width) div 2;
     1109    Top := (DpiScreen.Height - Height) div 2;
    11101110  end;
    11111111

  • branches/highdpi/LocalPlayer/Diagram.pas

    r178 r193  
    293293  if WindowMode = wmModal then
    294294  begin { center on screen }
    295     Left := (Screen.Width - Width) div 2;
    296     Top := (Screen.Height - Height) div 2;
     295    Left := (DpiScreen.Width - Width) div 2;
     296    Top := (DpiScreen.Height - Height) div 2;
    297297  end;
    298298  OffscreenPaint;

  • branches/highdpi/LocalPlayer/Draft.pas

    r179 r193  
    488488  if WindowMode = wmModal then
    489489  begin { center on screen }
    490     Left := (Screen.Width - Template.Width) div 2;
    491     Top := (Screen.Height - (Template.Height - Cut)) div 2;
     490    Left := (DpiScreen.Width - Template.Width) div 2;
     491    Top := (DpiScreen.Height - (Template.Height - Cut)) div 2;
    492492  end;
    493493

  • branches/highdpi/LocalPlayer/Help.lfm

    r69 r193  
    11object HelpDlg: THelpDlg
    22  Left = 394
     3  Height = 718
    34  Top = 180
     5  Width = 840
    46  BorderIcons = []
    57  BorderStyle = bsNone
    6   ClientHeight = 479
    7   ClientWidth = 560
     8  ClientHeight = 718
     9  ClientWidth = 840
    810  Color = clBtnFace
    9   Font.Charset = DEFAULT_CHARSET
     11  DesignTimePPI = 144
    1012  Font.Color = clWindowText
    11   Font.Height = -13
     13  Font.Height = -20
    1214  Font.Name = 'MS Sans Serif'
    13   Font.Style = []
    1415  FormStyle = fsStayOnTop
    1516  OnClose = FormClose
    … …  
    1718  OnDestroy = FormDestroy
    1819  OnKeyDown = FormKeyDown
    19   OnMouseWheel = FormMouseWheel
    2020  OnMouseDown = PaintBox1MouseDown
    2121  OnMouseMove = PaintBox1MouseMove
     22  OnMouseWheel = FormMouseWheel
    2223  OnPaint = FormPaint
    23   PixelsPerInch = 96
     24  LCLVersion = '2.0.8.0'
    2425  object CloseBtn: TButtonB
    25     Left = 522
    26     Top = 6
    27     Width = 25
    28     Height = 25
     26    Left = 783
     27    Height = 38
     28    Top = 9
     29    Width = 38
    2930    Down = False
    3031    Permanent = False
    … …  
    3334  end
    3435  object BackBtn: TButtonB
    35     Left = 42
    36     Top = 6
    37     Width = 25
    38     Height = 25
     36    Left = 63
     37    Height = 38
     38    Top = 9
     39    Width = 38
    3940    Down = False
    4041    Permanent = False
    … …  
    4344  end
    4445  object TopBtn: TButtonB
    45     Left = 13
    46     Top = 6
    47     Width = 25
    48     Height = 25
     46    Left = 20
     47    Height = 38
     48    Top = 9
     49    Width = 38
    4950    Down = False
    5051    Permanent = False
    … …  
    5354  end
    5455  object SearchBtn: TButtonB
    55     Left = 493
    56     Top = 6
    57     Width = 25
    58     Height = 25
     56    Left = 740
     57    Height = 38
     58    Top = 9
     59    Width = 38
    5960    Down = False
    6061    Permanent = False

  • branches/highdpi/LocalPlayer/Help.pas

    r179 r193  
    367367  ImpPtr: array [-1 .. 1] of TPixelPointer;
    368368begin
     369  { TODO
    369370  // assume eiffel tower has free common heaven
    370371  for dy := 0 to nHeaven - 1 do
    … …  
    376377  xSrc := iix mod 7 * xSizeBig;
    377378  ySrc := (iix div 7 + 1) * ySizeBig;
    378   for y := 0 to ySizeBig * 2 - 1 do
     379  for y := 0 to ScaleToVcl(ySizeBig * 2) - 1 do
    379380    if ((y0 + y) >= 0) and ((y0 + y) < InnerHeight) then begin
    380       PaintPtr.Init(OffScreen, 0, y0 + y);
    381       CoalPtr.Init(Templates, 0, yCoal + y);
     381      PaintPtr.Init(OffScreen, 0, ScaleToVcl(y0 + y));
     382      CoalPtr.Init(Templates, 0, ScaleToVcl(yCoal + y));
    382383      for dy := -1 to 1 do
    383384        if ((Max(y + dy, 0) shr 1) >= 0) and ((Max(y + dy, 0) shr 1) < ySizeBig) then
    384           ImpPtr[dy].Init(BigImp, 0, ySrc + (Max(y + dy, 0) shr 1));
    385       for x := 0 to xSizeBig * 2 - 1 do begin
     385          ImpPtr[dy].Init(BigImp, 0, ScaleToVcl(ySrc + (Max(y + dy, 0) shr 1)));
     386      for x := 0 to ScaleToVcl(xSizeBig * 2) - 1 do begin
    386387        sum := 0;
    387388        for dx := -1 to 1 do begin
    … …  
    412413  Offscreen.EndUpdate;
    413414  BigImp.EndUpdate;
     415  }
    414416end;
    415417

  • branches/highdpi/LocalPlayer/MessgEx.pas

    r179 r193  
    177177    0:
    178178      begin
    179         Left := (Screen.Width - ClientWidth) div 2;
    180         Top := (Screen.Height - ClientHeight) div 2 - MapCenterUp;
     179        Left := (DpiScreen.Width - ClientWidth) div 2;
     180        Top := (DpiScreen.Height - ClientHeight) div 2 - MapCenterUp;
    181181      end;
    182182    1:
    183183      begin
    184         Left := (Screen.Width - ClientWidth) div 4;
    185         Top := (Screen.Height - ClientHeight) * 2 div 3 - MapCenterUp;
     184        Left := (DpiScreen.Width - ClientWidth) div 4;
     185        Top := (DpiScreen.Height - ClientHeight) * 2 div 3 - MapCenterUp;
    186186      end;
    187187    -1:
    188188      begin
    189         Left := (Screen.Width - ClientWidth) div 4;
    190         Top := (Screen.Height - ClientHeight) div 3 - MapCenterUp;
     189        Left := (DpiScreen.Width - ClientWidth) div 4;
     190        Top := (DpiScreen.Height - ClientHeight) div 3 - MapCenterUp;
    191191      end;
    192192  end;

  • branches/highdpi/LocalPlayer/Rates.pas

    r179 r193  
    4242procedure TRatesDlg.FormCreate(Sender: TObject);
    4343begin
    44   TitleHeight := Screen.Height;
     44  TitleHeight := DpiScreen.Height;
    4545  InitButtons();
    4646end;

  • branches/highdpi/LocalPlayer/Select.pas

    r179 r193  
    16091609  begin { center on screen }
    16101610    if Kind = kTribe then
    1611       Left := (Screen.Width - 800) * 3 div 8 + 130
     1611      Left := (DpiScreen.Width - 800) * 3 div 8 + 130
    16121612    else
    1613       Left := (Screen.Width - Width) div 2;
    1614     Top := (Screen.Height - Height) div 2;
     1613      Left := (DpiScreen.Width - Width) div 2;
     1614    Top := (DpiScreen.Height - Height) div 2;
    16151615    if Kind = kProject then
    16161616      Top := Top + 48;

  • branches/highdpi/LocalPlayer/TechTree.pas

    r179 r193  
    183183
    184184  // fit window to image, center image in window, center window to screen
    185   width := min(Screen.width - 40, Image.width + LeftBorder + RightBorder + 2 *
     185  width := min(DpiScreen.width - 40, Image.width + LeftBorder + RightBorder + 2 *
    186186    BlackBorder);
    187   height := min(Screen.height - 40, Image.height + TopBorder + BottomBorder + 2
     187  height := min(DpiScreen.height - 40, Image.height + TopBorder + BottomBorder + 2
    188188    * BlackBorder);
    189   Left := (Screen.width - width) div 2;
    190   Top := (Screen.height - height) div 2;
     189  Left := (DpiScreen.width - width) div 2;
     190  Top := (DpiScreen.height - height) div 2;
    191191  CloseBtn.Left := width - CloseBtn.width - BlackBorder - 8;
    192192  CloseBtn.Top := BlackBorder + 8;

  • branches/highdpi/LocalPlayer/Term.pas

    r179 r193  
    25032503          SetMainTextureByAge(-1);
    25042504        Tribes.Init;
    2505         HelpDlg.UserLeft := (Screen.width - HelpDlg.width) div 2;
    2506         HelpDlg.UserTop := (Screen.height - HelpDlg.height) div 2;
     2505        HelpDlg.UserLeft := (DpiScreen.width - HelpDlg.width) div 2;
     2506        HelpDlg.UserTop := (DpiScreen.height - HelpDlg.height) div 2;
    25072507        HelpDlg.Difficulty := 0;
    25082508        if Command = cStartCredits then
    … …  
    25662566        ListDlg.UserLeft := 8;
    25672567        ListDlg.UserTop := TopBarHeight + 8;
    2568         HelpDlg.UserLeft := Screen.width - HelpDlg.width - 8;
     2568        HelpDlg.UserLeft := DpiScreen.width - HelpDlg.width - 8;
    25692569        HelpDlg.UserTop := TopBarHeight + 8;
    25702570        UnitStatDlg.UserLeft := 397;
    25712571        UnitStatDlg.UserTop := TopBarHeight + 64;
    2572         DiaDlg.UserLeft := (Screen.width - DiaDlg.width) div 2;
    2573         DiaDlg.UserTop := (Screen.height - DiaDlg.height) div 2;
    2574         NatStatDlg.UserLeft := Screen.width - NatStatDlg.width - 8;
    2575         NatStatDlg.UserTop := Screen.height - PanelHeight -
     2572        DiaDlg.UserLeft := (DpiScreen.width - DiaDlg.width) div 2;
     2573        DiaDlg.UserTop := (DpiScreen.height - DiaDlg.height) div 2;
     2574        NatStatDlg.UserLeft := DpiScreen.width - NatStatDlg.width - 8;
     2575        NatStatDlg.UserTop := DpiScreen.height - PanelHeight -
    25762576          NatStatDlg.height - 8;
    25772577        if NatStatDlg.UserTop < 8 then
    … …  
    39083908      UnitStatDlg.Close;
    39093909  end;
    3910   for i := 0 to Screen.FormCount - 1 do
     3910  for i := 0 to DpiScreen.FormCount - 1 do
    39113911    if DpiScreen.Forms[i].Visible and (DpiScreen.Forms[i] is TBufferedDrawDlg) then
    39123912      DpiScreen.Forms[i].Enabled := false;
    … …  
    51025102        dx := 0;
    51035103        dy := 0;
    5104         if Mouse.CursorPos.y < Screen.height - PanelHeight then
     5104        if Mouse.CursorPos.y < DpiScreen.height - PanelHeight then
    51055105          if Mouse.CursorPos.x = 0 then
    51065106            dx := -speed // scroll left
    5107           else if Mouse.CursorPos.x = Screen.width - 1 then
     5107          else if Mouse.CursorPos.x = DpiScreen.width - 1 then
    51085108            dx := speed; // scroll right
    51095109        if Mouse.CursorPos.y = 0 then
    51105110          dy := -speed // scroll up
    5111         else if (Mouse.CursorPos.y = Screen.height - 1) and
     5111        else if (Mouse.CursorPos.y = DpiScreen.height - 1) and
    51125112          (Mouse.CursorPos.x >= TerrainBtn.Left + TerrainBtn.width) and
    51135113          (Mouse.CursorPos.x < xRightPanel + 10 - 8) then
    … …  
    54695469      if BattleDlg.Left < 0 then
    54705470        BattleDlg.Left := 0
    5471       else if BattleDlg.Left + BattleDlg.width > Screen.width then
    5472         BattleDlg.Left := Screen.width - BattleDlg.width;
     5471      else if BattleDlg.Left + BattleDlg.width > DpiScreen.width then
     5472        BattleDlg.Left := DpiScreen.width - BattleDlg.width;
    54735473      BattleDlg.Top := y - BattleDlg.height div 2;
    54745474      if BattleDlg.Top < 0 then
    54755475        BattleDlg.Top := 0
    5476       else if BattleDlg.Top + BattleDlg.height > Screen.height then
    5477         BattleDlg.Top := Screen.height - BattleDlg.height;
     5476      else if BattleDlg.Top + BattleDlg.height > DpiScreen.height then
     5477        BattleDlg.Top := DpiScreen.height - BattleDlg.height;
    54785478      BattleDlg.IsSuicideQuery := false;
    54795479      BattleDlg.Show;

  • branches/highdpi/LocalPlayer/UnitStat.pas

    r179 r193  
    7474  inherited;
    7575  AgePrepared := -2;
    76   TitleHeight := Screen.Height;
     76  TitleHeight := DpiScreen.Height;
    7777  InitButtons();
    7878
    … …  
    171171  else
    172172  begin
    173     Left := (Screen.Width - Width) div 2;
    174     Top := (Screen.Height - Height) div 2;
     173    Left := (DpiScreen.Width - Width) div 2;
     174    Top := (DpiScreen.Height - Height) div 2;
    175175  end;
    176176

  • branches/highdpi/Locale.lfm

    r178 r193  
    66  Width = 483
    77  Height = 456
    8   Visible = False
    98  Caption = 'LocaleDlg'
    109  Enabled = True

  • branches/highdpi/NoTerm.pas

    r179 r193  
    7373procedure TNoTermDlg.FormCreate(Sender: TObject);
    7474begin
    75   Left := Screen.Width - Width - 8;
     75  Left := DpiScreen.Width - Width - 8;
    7676  Top := 8;
    7777  Caption := Phrases.Lookup('AIT');

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

    r180 r193  
    500500  Offscreen := TDpiBitmap.Create;
    501501  Offscreen.PixelFormat := pf24bit;
    502   if Screen.Height - yUnused < 480 then
    503     Offscreen.SetSize(Screen.Width, 480)
     502  if DpiScreen.Height - yUnused < 480 then
     503    Offscreen.SetSize(DpiScreen.Width, 480)
    504504  else
    505     Offscreen.SetSize(Screen.Width, Screen.Height - yUnused);
     505    Offscreen.SetSize(DpiScreen.Width, DpiScreen.Height - yUnused);
    506506  Offscreen.Canvas.FillRect(0, 0, Offscreen.Width, OffScreen.Height);
    507507  Offscreen.Canvas.Brush.Style := bsClear;

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

    r180 r193  
    410410  Bitmap.BeginUpdate;
    411411  PixelPtr.Init(Bitmap);
    412   for Y := 0 to Bitmap.Height - 1 do begin
    413     for X := 0 to Bitmap.Width - 1 do begin
     412  for Y := 0 to ScaleToVcl(Bitmap.Height) - 1 do begin
     413    for X := 0 to ScaleToVcl(Bitmap.Width) - 1 do begin
    414414      PixelPtr.Pixel^ := ApplyGammaToPixel(PixelPtr.Pixel^);
    415415      PixelPtr.NextPixel;
    … …  
    428428  SrcPtr.Init(Src);
    429429  DstPtr.Init(Dst);
    430   for Y := 0 to Src.Height - 1 do begin
    431     for X := 0 to Src.Width - 1 do begin
     430  for Y := 0 to ScaleToVcl(Src.Height) - 1 do begin
     431    for X := 0 to ScaleToVcl(Src.Width) - 1 do begin
    432432      DstPtr.Pixel^.B := SrcPtr.Pixel^.B;
    433433      DstPtr.Pixel^.G := SrcPtr.Pixel^.B;
    … …  
    607607  PixelPtr: TPixelPointer;
    608608begin
     609  X := ScaleToVcl(X);
     610  Y := ScaleToVcl(Y);
     611  W := ScaleToVcl(W);
     612  H := ScaleToVcl(H);
    609613  Dst.BeginUpdate;
    610614  PixelPtr.Init(Dst, X, Y);
    … …  
    630634  PixelDst: TPixelPointer;
    631635begin
     636  xDst := ScaleToVcl(xDst);
     637  yDst := ScaleToVcl(yDst);
     638  xSrc := ScaleToVcl(xSrc);
     639  ySrc := ScaleToVcl(ySrc);
     640  w := ScaleToVcl(w);
     641  h := ScaleToVcl(h);
    632642  //Assert(Src.PixelFormat = pf8bit);
    633643  Assert(dst.PixelFormat = pf24bit);
    … …  
    642652    yDst := 0;
    643653  end;
    644   if xDst + w > dst.Width then
    645     w := dst.Width - xDst;
    646   if yDst + h > dst.Height then
    647     h := dst.Height - yDst;
     654  if xDst + w > ScaleToVcl(dst.Width) then
     655    w := ScaleToVcl(dst.Width) - xDst;
     656  if yDst + h > ScaleToVcl(dst.Height) then
     657    h := ScaleToVcl(dst.Height) - yDst;
    648658  if (w < 0) or (h < 0) then
    649659    exit;
    … …  
    691701  SrcPixel, DstPixel: TPixelPointer;
    692702begin
     703  xDst := ScaleToVcl(xDst);
     704  yDst := ScaleToVcl(yDst);
     705  xSrc := ScaleToVcl(xSrc);
     706  ySrc := ScaleToVcl(ySrc);
     707  w := ScaleToVcl(w);
     708  h := ScaleToVcl(h);
    693709  if xDst < 0 then begin
    694710    w := w + xDst;
    … …  
    701717    yDst := 0;
    702718  end;
    703   if xDst + w > dst.Width then
    704     w := dst.Width - xDst;
    705   if yDst + h > dst.Height then
    706     h := dst.Height - yDst;
     719  if xDst + w > ScaleToVcl(dst.Width) then
     720    w := ScaleToVcl(dst.Width) - xDst;
     721  if yDst + h > ScaleToVcl(dst.Height) then
     722    h := ScaleToVcl(dst.Height) - yDst;
    707723  if (w < 0) or (h < 0) then
    708724    exit;
    … …  
    756772  PixelPtr: TPixelPointer;
    757773begin
     774  X := ScaleToVcl(X);
     775  Y := ScaleToVcl(Y);
     776  W := ScaleToVcl(W);
     777  H := ScaleToVcl(H);
    758778  bmp.BeginUpdate;
    759779  assert(bmp.PixelFormat = pf24bit);
    … …  
    892912  x, y, ch, r: Integer;
    893913  DstPtr: TPixelPointer;
    894 begin
     914  DpiGlowRange: Integer;
     915begin
     916  DpiGlowRange := ScaleToVcl(GlowRange);
     917  X0 := ScaleToVcl(X0);
     918  Y0 := ScaleToVcl(Y0);
     919  Width := ScaleToVcl(Width);
     920  Height := ScaleToVcl(Height);
    895921  dst.BeginUpdate;
    896922  DstPtr.Init(dst, x0, y0);
    897   for y := -GlowRange + 1 to Height - 1 + GlowRange - 1 do begin
    898     for x := -GlowRange + 1 to Width - 1 + GlowRange - 1 do begin
     923  for y := -DpiGlowRange + 1 to Height - 1 + DpiGlowRange - 1 do begin
     924    for x := -DpiGlowRange + 1 to Width - 1 + DpiGlowRange - 1 do begin
    899925      DstPtr.SetXY(x, y);
    900926      if x < 0 then
    … …  
    924950          DstPtr.Pixel^.Planes[2 - ch] :=
    925951            (DstPtr.Pixel^.Planes[2 - ch] * (r - 1) + (cl shr (8 * ch) and $FF) *
    926             (GlowRange - r)) div (GlowRange - 1);
     952            (DpiGlowRange - r)) div (DpiGlowRange - 1);
    927953    end;
    928954  end;
    … …  
    15591585            // 0.8 constant is compensation for Lazarus as size of fonts against Delphi differs
    15601586            UniFont[section].Size :=
    1561               Round(Size * Screen.PixelsPerInch / UniFont[section].PixelsPerInch * 0.8);
     1587              Round(Size * Screen.PixelsPerInch / UniFont[section].PixelsPerInch);
    15621588          end;
    15631589        end;

  • branches/highdpi/Packages/DpiControls/UDpiControls.pas

    r179 r193  
    2828  public
    2929    property OnPaint;
     30    procedure Paint; override;
     31  end;
     32
     33  { TControlEx }
     34
     35  TControlEx = class(TControl)
     36  public
    3037    property OnMouseDown;
    3138    property OnMouseUp;
    3239    property OnMouseMove;
    33     procedure Paint; override;
    3440  end;
    3541
    … …  
    189195    property Parent: TDpiWinControl read FParent write SetParent;
    190196    property BoundsRect: TRect read GetBoundsRect write SetBoundsRect;
     197    property Visible: Boolean read GetVisible write SetVisible;
    191198  published
    192199    property ClientHeight: Integer read GetClientHeight write SetClientHeight;
    … …  
    197204    property Width: Integer read FWidth write SetWidth;
    198205    property Height: Integer read FHeight write SetHeight;
    199     property Visible: Boolean read GetVisible write SetVisible;
    200206    property Caption: string read GetCaption write SetCaption;
    201207    property Enabled: Boolean read GetEnabled write SetEnabled;
    … …  
    221227  TDpiGraphic = class(TPersistent)
    222228  protected
     229    FDpi: Integer;
    223230    function GetVclGraphic: TGraphic; virtual;
     231    function GetWidth: Integer; virtual; abstract;
     232    function GetHeight: Integer; virtual; abstract;
     233    procedure SetWidth(Value: Integer); virtual; abstract;
     234    procedure SetHeight(Value: Integer); virtual; abstract;
     235    procedure ScreenChanged; virtual;
     236    procedure SetDpi(AValue: Integer); virtual;
     237    function GetDpi: Integer; virtual;
    224238  public
    225     procedure LoadFromFile(const Filename: string);
     239    constructor Create;
     240    procedure LoadFromFile(const Filename: string); virtual;
     241    property Width: Integer read GetWidth write SetWidth;
     242    property Height: Integer read GetHeight write SetHeight;
     243    property Dpi: Integer read GetDpi write SetDpi;
    226244  end;
    227245
    … …  
    260278    procedure StretchDraw(const DestRect: TRect; SrcGraphic: TDpiGraphic); virtual;
    261279    procedure FrameRect(Rect: TRect);
    262     procedure Rectangle(X1, Y1, X2, Y2: Integer);
     280    procedure Rectangle(X1, Y1, X2, Y2: Integer); overload;
     281    procedure Rectangle(const ARect: TRect); overload;
    263282    function TextWidth(Text: string): Integer;
    264283    function TextHeight(Text: string): Integer;
    … …  
    291310    VclGraphicControl: TGraphicControl;
    292311    FCanvas: TDpiCanvas;
     312    function GetOnPaint: TNotifyEvent;
    293313    procedure SetCanvas(AValue: TDpiCanvas);
    294314    procedure PaintHandler(Sender: TObject);
     315    procedure SetOnPaint(AValue: TNotifyEvent);
    295316  protected
    296317    procedure Paint; virtual;
    … …  
    298319    function GetVclGraphicControl: TGraphicControl; virtual;
    299320    procedure UpdateVclControl; override;
    300     property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
     321    procedure UpdateVclControlPrivate; virtual;
     322    property OnPaint: TNotifyEvent read GetOnPaint write SetOnPaint;
    301323  public
    302324    constructor Create(TheOwner: TComponent); override;
    … …  
    481503    destructor Destroy; override;
    482504  published
     505    property Visible;
    483506  end;
    484507
    … …  
    523546    property ExtendedSelect: Boolean read GetExtendedSelect write SetExtendedSelect default true;
    524547    property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle default bsNone;
     548    property Visible;
    525549  end;
    526550
    … …  
    556580    property Kind: TScrollBarKind read GetKind write SetKind;
    557581    property OnChange: TNotifyEvent read GetOnChange write SetOnChange;
     582    property Visible;
    558583  end;
    559584
    … …  
    563588  private
    564589    FCanvas: TDpiCanvas;
     590    FWidth: Integer;
     591    FHeight: Integer;
    565592    function GetCanvas: TDpiCanvas;
    566     function GetHeight: Integer;
    567593    function GetPixelFormat: TPixelFormat;
    568594    function GetScanLine(Row: Integer): Pointer;
    569     function GetWidth: Integer;
    570     procedure SetHeight(AValue: Integer);
    571595    procedure SetPixelFormat(AValue: TPixelFormat);
    572     procedure SetWidth(AValue: Integer);
    573596  protected
     597    function GetHeight: Integer; override;
     598    function GetWidth: Integer; override;
    574599    function GetVclBitmap: TCustomBitmap; virtual;
    575600    function GetVclRasterImage: TRasterImage; override;
     601    procedure SetHeight(AValue: Integer); override;
     602    procedure SetWidth(AValue: Integer); override;
     603    procedure ScreenChanged; override;
    576604  public
    577605    VclBitmap: TBitmap;
    578606    procedure BeginUpdate;
    579607    procedure EndUpdate;
    580     procedure SetSize(Width, Height: Integer);
     608    procedure SetSize(AWidth, AHeight: Integer);
    581609    constructor Create;
    582610    destructor Destroy; override;
    … …  
    617645    property Stretch: Boolean read FStretch write SetStretch;
    618646    property Picture: TDpiPicture read FDpiPicture write SetPicture;
     647    property Visible;
    619648  end;
    620649
    … …  
    623652  TDpiPaintBox = class(TDpiGraphicControl)
    624653  private
    625     function GetOnPaint: TNotifyEvent;
    626     procedure SetOnPaint(AValue: TNotifyEvent);
     654    procedure UpdateVclControlPrivate; override;
    627655  public
    628656    VclPaintBox: TPaintBox;
    … …  
    631659    destructor Destroy; override;
    632660  published
     661    property OnPaint;
     662    property Visible;
    633663  end;
    634664
    … …  
    666696  public
    667697    VclJpeg: TJPEGImage;
     698    procedure LoadFromFile(const Filename: string); override;
    668699  end;
    669700
    … …  
    676707  public
    677708    VclPng: TPortableNetworkGraphic;
     709    procedure LoadFromFile(const Filename: string); override;
    678710  end;
    679711
    … …  
    709741
    710742procedure Register;
    711 function DpiBitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Rop: DWORD): Boolean;
     743function DpiBitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
     744function DpiBitBltCanvas(Dest: TDpiCanvas; X, Y, Width, Height: Integer; Src: TDpiCanvas; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
    712745function DpiCreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN;
    713746function ScaleToVcl(Value: Integer): Integer;
    … …  
    735768end;
    736769
     770function DpiBitBltCanvas(Dest: TDpiCanvas; X, Y, Width, Height: Integer;
     771  Src: TDpiCanvas; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
     772begin
     773  Result := DpiBitBlt(Dest.Handle, X, Y, Width, Height, Src.Handle, XSrc, YSrc, Rop);
     774end;
     775
    737776function DpiCreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN;
    738777begin
    … …  
    792831
    793832function DpiBitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc,
    794   YSrc: Integer; Rop: DWORD): Boolean;
     833  YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
    795834begin
    796835  Result := BitBlt(DestDC, ScaleToVcl(X), ScaleToVcl(Y), ScaleToVcl(Width),
    … …  
    9951034end;
    9961035
     1036procedure TDpiJpegImage.LoadFromFile(const Filename: string);
     1037var
     1038  Bitmap: TJPEGImage;
     1039begin
     1040  Bitmap := TJPEGImage.Create;
     1041  Bitmap.LoadFromFile(FileName);
     1042  Width := ScaleFromVcl(Bitmap.Width);
     1043  Height := ScaleFromVcl(Bitmap.Height);
     1044  if Self is TDpiBitmap then
     1045    TBitmap(GetVclGraphic).Canvas.StretchDraw(Bounds(0, 0, Bitmap.Width, Bitmap.Height), Bitmap)
     1046    else raise Exception.Create('Unsupported class ' + Self.ClassName);
     1047  Bitmap.Free;
     1048end;
     1049
    9971050{ TDpiPortableNetworkGraphic }
    9981051
    … …  
    10061059  if not Assigned(VclPng) then VclPng := TPortableNetworkGraphic.Create;
    10071060  Result := VclPng;
     1061end;
     1062
     1063procedure TDpiPortableNetworkGraphic.LoadFromFile(const Filename: string);
     1064var
     1065  Bitmap: TPortableNetworkGraphic;
     1066begin
     1067  Bitmap := TPortableNetworkGraphic.Create;
     1068  Bitmap.LoadFromFile(FileName);
     1069  Width := ScaleFromVcl(Bitmap.Width);
     1070  Height := ScaleFromVcl(Bitmap.Height);
     1071  if Self is TDpiBitmap then
     1072    TBitmap(GetVclGraphic).Canvas.StretchDraw(Bounds(0, 0, Bitmap.Width, Bitmap.Height), Bitmap)
     1073    else raise Exception.Create('Unsupported class ' + Self.ClassName);
     1074  Bitmap.Free;
    10081075end;
    10091076
    … …  
    11571224end;
    11581225
     1226procedure TDpiGraphic.ScreenChanged;
     1227begin
     1228end;
     1229
     1230procedure TDpiGraphic.SetDpi(AValue: Integer);
     1231begin
     1232  FDpi := AValue;
     1233  ScreenChanged;
     1234end;
     1235
     1236function TDpiGraphic.GetDpi: Integer;
     1237begin
     1238  Result := FDpi;
     1239end;
     1240
     1241constructor TDpiGraphic.Create;
     1242begin
     1243  Dpi := DpiScreen.Dpi;
     1244end;
     1245
    11591246procedure TDpiGraphic.LoadFromFile(const Filename: string);
    1160 begin
    1161   GetVclGraphic.LoadFromFile(FileName);
     1247var
     1248  Bitmap: TBitmap;
     1249begin
     1250  Bitmap := TBitmap.Create;
     1251  Bitmap.LoadFromFile(FileName);
     1252  Width := ScaleFromVcl(Bitmap.Width);
     1253  Height := ScaleFromVcl(Bitmap.Height);
     1254  if Self is TDpiBitmap then
     1255    TBitmap(GetVclGraphic).Canvas.StretchDraw(Bounds(0, 0, Bitmap.Width, Bitmap.Height), Bitmap)
     1256    else raise Exception.Create('Unsupported class ' + Self.ClassName);
     1257  Bitmap.Free;
    11621258end;
    11631259
    … …  
    11661262function TDpiBitmap.GetHeight: Integer;
    11671263begin
    1168   Result := ScaleFromVcl(GetVclBitmap.Height);
     1264  Result := FHeight;
    11691265end;
    11701266
    … …  
    11901286function TDpiBitmap.GetWidth: Integer;
    11911287begin
    1192   Result := ScaleFromVcl(GetVclBitmap.Width);
     1288  Result := FWidth;
    11931289end;
    11941290
    11951291procedure TDpiBitmap.SetHeight(AValue: Integer);
    11961292begin
     1293  FHeight := AValue;
    11971294  GetVclBitmap.Height := ScaleToVcl(AValue);
    11981295end;
    … …  
    12051302procedure TDpiBitmap.SetWidth(AValue: Integer);
    12061303begin
     1304  FWidth := AValue;
    12071305  GetVclBitmap.Width := ScaleToVcl(AValue);
     1306end;
     1307
     1308procedure TDpiBitmap.ScreenChanged;
     1309var
     1310  Bitmap: TBitmap;
     1311  NewWidth: Integer;
     1312  NewHeight: Integer;
     1313begin
     1314  NewWidth := ScaleToVcl(Width);
     1315  NewHeight := ScaleToVcl(Height);
     1316  if Assigned(VclBitmap) and ((NewWidth <> VclBitmap.Width) or (NewHeight <> VclBitmap.Height)) then begin
     1317    // Rescale bitmap to new size
     1318    Bitmap := TBitmap.Create;
     1319    Bitmap.SetSize(NewWidth, NewHeight);
     1320    Bitmap.PixelFormat := VclBitmap.PixelFormat;
     1321    Bitmap.Canvas.StretchDraw(Bounds(0, 0, NewWidth, NewHeight), VclBitmap);
     1322    VclBitmap.Free;
     1323    VclBitmap := Bitmap;
     1324    Canvas.VclCanvas := VclBitmap.Canvas;
     1325  end;
    12081326end;
    12091327
    … …  
    12271345end;
    12281346
    1229 procedure TDpiBitmap.SetSize(Width, Height: Integer);
    1230 begin
    1231   GetVclBitmap.SetSize(ScaleToVcl(Width), ScaleToVcl(Height));
     1347procedure TDpiBitmap.SetSize(AWidth, AHeight: Integer);
     1348begin
     1349  FWidth := AWidth;
     1350  FHeight := AHeight;
     1351  GetVclBitmap.SetSize(ScaleToVcl(AWidth), ScaleToVcl(AHeight));
    12321352end;
    12331353
    … …  
    13721492{ TDpiPaintBox }
    13731493
    1374 function TDpiPaintBox.GetOnPaint: TNotifyEvent;
    1375 begin
    1376   Result := VclPaintBox.OnPaint;
    1377 end;
    1378 
    1379 procedure TDpiPaintBox.SetOnPaint(AValue: TNotifyEvent);
    1380 begin
    1381   VclPaintBox.OnPaint := AValue;
     1494procedure TDpiPaintBox.UpdateVclControlPrivate;
     1495begin
     1496  VclPaintBox.OnPaint := @PaintHandler;
     1497  VclPaintBox.OnMouseDown := @MouseDownHandler;
     1498  VclPaintBox.OnMouseUp := @MouseUpHandler;
     1499  VclPaintBox.OnMouseMove := @MouseMoveHandler;
    13821500end;
    13831501
    … …  
    14161534end;
    14171535
    1418 
    14191536{ TDpiCanvas }
    14201537
    … …  
    14711588
    14721589procedure TDpiCanvas.SetPixel(X, Y: Integer; AValue: TColor);
    1473 begin
     1590var
     1591  BrushStyle: TBrushStyle;
     1592  BrushColor: TColor;
     1593begin
     1594 { BrushStyle := GetVclCanvas.Brush.Style;
     1595  BrushColor := GetVclCanvas.Brush.Color;
     1596  GetVclCanvas.Brush.Color := AValue;
     1597  GetVclCanvas.Brush.Style := bsClear;
     1598  GetVclCanvas.FillRect(ScaleToVcl(X), ScaleToVcl(Y), ScaleToVcl(X + 1) - 1, ScaleToVcl(Y + 1) - 1);
     1599  GetVclCanvas.Brush.Style := BrushStyle;
     1600  GetVclCanvas.Brush.Color := BrushColor;
     1601  }
    14741602  GetVclCanvas.Pixels[ScaleToVcl(X), ScaleToVcl(Y)] := AValue;
    14751603end;
    … …  
    14971625end;
    14981626
     1627procedure TDpiCanvas.Rectangle(const ARect: TRect);
     1628begin
     1629  Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
     1630end;
     1631
    14991632function TDpiCanvas.TextWidth(Text: string): Integer;
    15001633begin
    … …  
    15501683  Source: TRect);
    15511684begin
    1552   GetVclCanvas.CopyRect(Dest, SrcCanvas.VclCanvas, Source);
     1685  GetVclCanvas.CopyRect(Dest, SrcCanvas.VclCanvas, ScaleRectToVcl(Source));
    15531686end;
    15541687
    … …  
    15911724begin
    15921725  if not Assigned(VclGraphicControl) then begin
    1593     VclGraphicControl := TGraphicControlEx.Create(nil);
    1594     (VclGraphicControl as TGraphicControlEx).OnPaint := @PaintHandler;
     1726    VclGraphicControl := TGraphicControl.Create(nil);
    15951727  end;
    15961728  Result := VclGraphicControl;
    … …  
    16001732begin
    16011733  inherited;
    1602   (GetVclGraphicControl as TGraphicControlEx).OnMouseDown := @MouseDownHandler;
    1603   (GetVclGraphicControl as TGraphicControlEx).OnMouseUp := @MouseUpHandler;
    1604   (GetVclGraphicControl as TGraphicControlEx).OnMouseMove := @MouseMoveHandler;
     1734  UpdateVclControlPrivate;
     1735end;
     1736
     1737procedure TDpiGraphicControl.UpdateVclControlPrivate;
     1738begin
     1739  TGraphicControlEx(GetVclGraphicControl).OnPaint := @PaintHandler;
     1740  TControlEx(GetVclControl).OnMouseDown := @MouseDownHandler;
     1741  TControlEx(GetVclControl).OnMouseUp := @MouseUpHandler;
     1742  TControlEx(GetVclControl).OnMouseMove := @MouseMoveHandler;
     1743  // Some VCL component event are not accessible on TGraphicControl level.
     1744  // Delegate this responsibility up
     1745  {
     1746  GetVclGraphicControl.OnPaint := @PaintHandler;
     1747  GetVclControl.OnMouseDown := @MouseDownHandler;
     1748  GetVclControl.OnMouseUp := @MouseUpHandler;
     1749  GetVclControl.OnMouseMove := @MouseMoveHandler;
     1750  }
     1751//  raise Exception.Create('Missing inicialization of private fields for ' + ClassName);
     1752end;
     1753
     1754function TDpiGraphicControl.GetOnPaint: TNotifyEvent;
     1755begin
     1756  Result := FOnPaint;
     1757end;
     1758
     1759procedure TDpiGraphicControl.SetOnPaint(AValue: TNotifyEvent);
     1760begin
     1761  FOnPaint := AValue;
    16051762end;
    16061763
    … …  
    19062063  Forms := TDpiForms.Create;
    19072064  Forms.FreeObjects := False;
    1908   Dpi := 144;
     2065  Dpi := 150;
    19092066end;
    19102067
    … …  
    19142071  inherited Destroy;
    19152072end;
    1916 
    1917 { TDpiWinControl }
    1918 
    19192073
    19202074{ TDpiButton }
    … …  
    25132667begin
    25142668  if not Assigned(VclForm) then begin
    2515     VclForm := TFormEx.Create(nil);
     2669    VclForm := TFormEx.CreateNew(nil);
    25162670    (VclForm as TFormEx).OnMessage := @FormMessageHandler;
    25172671    //VclForm := TForm.Create(nil);

  • branches/highdpi/Start.lfm

    r179 r193  
    66  Width = 556
    77  Height = 326
    8   Visible = False
    98  Caption = 'C-evo'
    109  Enabled = True

  • branches/highdpi/Start.pas

    r179 r193  
    256256    end; // default AI not found, use any
    257257
    258   DirectDlg.Left := (Screen.Width - DirectDlg.Width) div 2;
    259   DirectDlg.Top := (Screen.Height - DirectDlg.Height) div 2;
     258  DirectDlg.Left := (DpiScreen.Width - DirectDlg.Width) div 2;
     259  DirectDlg.Top := (DpiScreen.Height - DirectDlg.Height) div 2;
    260260
    261261  if FullScreen then
    262262  begin
    263     Location := Point((Screen.Width - 800) * 3 div 8,
    264       Screen.Height - Height - (Screen.Height - 600) div 3);
     263    Location := Point((DpiScreen.Width - 800) * 3 div 8,
     264      DpiScreen.Height - Height - (DpiScreen.Height - 600) div 3);
    265265    Left := Location.X;
    266266    Top := Location.Y;
    … …  
    279279  else
    280280  begin
    281     Left := (Screen.Width - Width) div 2;
    282     Top := (Screen.Height - Height) div 2;
     281    Left := (DpiScreen.Width - Width) div 2;
     282    Top := (DpiScreen.Height - Height) div 2;
    283283  end;
    284284
    … …  
    611611          h := ClientHeight - ActionBottomBorder -
    612612            (yAction + SelectedAction * ActionPitch - 8);
    613         BitBltCanvas(LogoBuffer.Canvas, 0, 0, w, h, Canvas,
     613        //BitBltCanvas(LogoBuffer.Canvas, 0, 0, w, h, Canvas,
     614        //  ActionSideBorder + i * wBuffer, yAction + SelectedAction * ActionPitch
     615        //  - 8, SRCCOPY);
     616        BitBlt(LogoBuffer.Canvas.Handle, 0, 0, w, h, Canvas.Handle,
    614617          ActionSideBorder + i * wBuffer, yAction + SelectedAction * ActionPitch
    615618          - 8, SRCCOPY);
    … …  
    879882  EmptyPicture.BeginUpdate;
    880883  PicturePixel.Init(EmptyPicture);
    881   for y := 0 to 63 do begin
    882     for x := 0 to 64 - 1 do begin
     884  for y := 0 to ScaleToVcl(64) - 1 do begin
     885    for x := 0 to ScaleToVcl(64) - 1 do begin
    883886      PicturePixel.Pixel^.B := Max(PicturePixel.Pixel^.B - 28, 0);
    884887      PicturePixel.Pixel^.G := Max(PicturePixel.Pixel^.G - 28, 0);
    … …  
    10491052  Mini.BeginUpdate;
    10501053  MiniPixel.Init(Mini);
    1051   for y := 0 to MiniHeight - 1 do begin
    1052     for x := 0 to MiniWidth - 1 do begin
     1054  for y := 0 to ScaleToVcl(MiniHeight) - 1 do begin
     1055    for x := 0 to ScaleToVcl(MiniWidth) - 1 do begin
    10531056      for i := 0 to 1 do begin
    1054         xm := (x * 2 + i + y and 1) mod (MiniWidth * 2);
     1057        xm := (x * 2 + i + y and 1) mod (ScaleToVcl(MiniWidth) * 2);
    10551058        MiniPixel.SetX(xm);
    10561059        cm := MiniColors
Note: See TracChangeset for help on using the changeset viewer.