Changeset 536


Ignore:
Timestamp:
May 30, 2019, 11:58:04 PM (6 years ago)
Author:
chronos
Message:
  • Modified: Improved DPI controls.
File:
1 edited

Legend:

Unmodified
Added
Removed
  • DpiControls/UDpiControls.pas

    r535 r536  
    77uses
    88  Classes, SysUtils, LCLProc, LResources, Forms, FormEditingIntf, ProjectIntf,
    9   Controls, StdCtrls, fgl, Graphics, ComCtrls, ExtCtrls, LCLType;
     9  Controls, StdCtrls, fgl, Graphics, ComCtrls, ExtCtrls, LCLType, GraphType,
     10  Types;
    1011
    1112type
     
    3940  protected
    4041    procedure ScreenChanged;
     42    function GetVclFont: TFont; virtual;
    4143  public
    4244    VclFont: TFont;
     
    6769    FWidth: Integer;
    6870    FParent: TDpiWinControl;
     71    function GetAlign: TAlign;
    6972    function GetBoundsRect: TRect;
    7073    function GetClientHeight: Integer;
    7174    function GetClientWidth: Integer;
    7275    function GetEnabled: Boolean;
     76    function GetHint: string;
    7377    function GetOnClick: TNotifyEvent;
    7478    function GetShowHint: Boolean;
    7579    function GetVisible: Boolean;
     80    procedure SetAlign(AValue: TAlign);
    7681    procedure SetBoundsRect(AValue: TRect);
     82    procedure SetClientHeight(AValue: Integer);
     83    procedure SetClientWidth(AValue: Integer);
    7784    procedure SetEnabled(AValue: Boolean);
    7885    procedure SetFont(AValue: TDpiFont);
     86    procedure SetHint(AValue: string);
    7987    procedure SetOnChangeBounds(AValue: TNotifyEvent);
    8088    procedure SetOnClick(AValue: TNotifyEvent);
     
    110118    procedure Invalidate;
    111119    procedure Repaint;
     120    procedure Update;
    112121    constructor Create(TheOwner: TComponent); override;
    113122    destructor Destroy; override;
    114123    property Parent: TDpiWinControl read FParent write SetParent;
    115124    property BoundsRect: TRect read GetBoundsRect write SetBoundsRect;
    116     property ClientWidth: Integer read GetClientWidth;
    117     property ClientHeight: Integer read GetClientHeight;
     125    property ClientWidth: Integer read GetClientWidth write SetClientWidth;
     126    property ClientHeight: Integer read GetClientHeight write SetClientHeight;
    118127  published
     128    property Hint: string read GetHint write SetHint;
    119129    property Top: Integer read FTop write SetTop;
    120130    property Left: Integer read FLeft write SetLeft;
     
    126136    property ShowHint: Boolean read GetShowHint write SetShowHint;
    127137    property Font: TDpiFont read FFont write SetFont;
     138    property Align: TAlign read GetAlign write SetAlign;
    128139    property OnResize: TNotifyEvent read FOnResize write SetOnResize;
    129140    property OnChangeBounds: TNotifyEvent read FOnChangeBounds write SetOnChangeBounds;
     
    132143
    133144  TDpiControls = specialize TFPGObjectList<TDpiControl>;
     145
     146  { TDpiGraphic }
     147
     148  TDpiGraphic = class(TPersistent)
     149  protected
     150    function GetVclGraphic: TGraphic; virtual;
     151  public
     152    procedure LoadFromFile(const Filename: string);
     153  end;
     154
     155  { TDpiRasterImage }
     156
     157  TDpiRasterImage = class(TDpiGraphic)
     158  private
     159    function GetRawImage: TRawImage;
     160  protected
     161    function GetVclGraphic: TGraphic; override;
     162    function GetVclRasterImage: TRasterImage; virtual;
     163  public
     164    property RawImage: TRawImage read GetRawImage;
     165  end;
    134166
    135167  { TDpiCanvas }
     
    149181    procedure SetPen(AValue: TPen);
    150182    procedure SetPixel(X, Y: Integer; AValue: TColor);
     183  protected
     184    function GetVclCanvas: TCanvas; virtual;
    151185  public
    152186    VclCanvas: TCanvas;
    153187    procedure FrameRect(Rect: TRect);
     188    procedure Rectangle(X1, Y1, X2, Y2: Integer);
    154189    function TextWidth(Text: string): Integer;
    155190    function TextHeight(Text: string): Integer;
     191    function TextExtent(Text: string): TSize;
    156192    procedure TextOut(X, Y: Integer; Text: string);
     193    procedure TextRect(ARect: TRect; X, Y: Integer; Text: string);
    157194    procedure MoveTo(X, Y: Integer);
    158195    procedure LineTo(X, Y: Integer);
    159196    procedure FillRect(ARect: TRect);
    160197    procedure FillRect(X1, Y1, X2, Y2: Integer);
     198    procedure Draw(X, Y: Integer; Source: TDpiGraphic);
     199    procedure CopyRect(Dest: TRect; SrcCanvas: TDpiCanvas; Source: TRect);
    161200    constructor Create;
    162201    destructor Destroy; override;
     
    176215  private
    177216    FCanvas: TDpiCanvas;
     217    function GetOnPaint: TNotifyEvent;
    178218    procedure SetCanvas(AValue: TDpiCanvas);
     219    procedure SetOnPaint(AValue: TNotifyEvent);
    179220  protected
    180221    procedure Paint; virtual;
     222    function GetVclControl: TControl; override;
     223    function GetVclGraphicControl: TGraphicControl; virtual;
    181224  public
    182225    constructor Create(TheOwner: TComponent); override;
     
    184227  published
    185228    property Canvas: TDpiCanvas read FCanvas write SetCanvas;
     229    property OnPaint: TNotifyEvent read GetOnPaint write SetOnPaint;
    186230  end;
    187231
     
    191235  private
    192236    function GetHandle: HWND;
     237    function GetOnKeyDown: TKeyEvent;
     238    function GetOnKeyPress: TKeyPressEvent;
     239    function GetOnKeyUp: TKeyEvent;
    193240    procedure SetHandle(AValue: HWND);
     241    procedure SetOnKeyDown(AValue: TKeyEvent);
     242    procedure SetOnKeyPress(AValue: TKeyPressEvent);
     243    procedure SetOnKeyUp(AValue: TKeyEvent);
    194244  protected
     245    function GetVclControl: TControl; override;
    195246    function GetVclWinControl: TWinControl; virtual;
    196247  public
     
    202253    property Handle: HWND read GetHandle write SetHandle;
    203254  published
     255    property OnKeyDown: TKeyEvent read GetOnKeyDown write SetOnKeyDown;
     256    property OnKeyPress: TKeyPressEvent read GetOnKeyPress write SetOnKeyPress;
     257    property OnKeyUp: TKeyEvent read GetOnKeyUp write SetOnKeyUp;
     258  end;
     259
     260  { TDpiCustomControl }
     261
     262  TDpiCustomControl = class(TDpiWinControl)
     263  private
     264    function GetOnPaint: TNotifyEvent;
     265    procedure SetOnPaint(AValue: TNotifyEvent);
     266  protected
     267    function GetVclWinControl: TWinControl; override;
     268    function GetVclCustomControl: TCustomControl; virtual;
     269  published
     270    property OnPaint: TNotifyEvent read GetOnPaint write SetOnPaint;
    204271  end;
    205272
    206273  { TDpiForm }
    207274
    208   TDpiForm = class(TDpiWinControl)
     275  TDpiForm = class(TDpiCustomControl)
    209276  private
     277    function GetBorderIcons: TBorderIcons;
    210278    function GetBorderStyle: TBorderStyle;
    211279    function GetCanvas: TDpiCanvas;
     280    function GetFormState: TFormState;
     281    function GetModalResult: TModalResult;
     282    function GetOnClose: TCloseEvent;
    212283    function GetOnCreate: TNotifyEvent;
     284    function GetOnDeactivate: TNotifyEvent;
    213285    function GetOnDestroy: TNotifyEvent;
    214286    function GetOnHide: TNotifyEvent;
    215287    function GetOnShow: TNotifyEvent;
     288    procedure SetBorderIcons(AValue: TBorderIcons);
    216289    procedure SetBorderStyle(AValue: TBorderStyle);
     290    procedure SetModalResult(AValue: TModalResult);
     291    procedure SetOnClose(AValue: TCloseEvent);
    217292    procedure SetOnCreate(AValue: TNotifyEvent);
     293    procedure SetOnDeactivate(AValue: TNotifyEvent);
    218294    procedure SetOnDestroy(AValue: TNotifyEvent);
    219295    procedure SetOnHide(AValue: TNotifyEvent);
     
    221297    procedure DoOnCreate;
    222298  protected
     299    procedure CreateParams(var p: TCreateParams); virtual;
    223300    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    224     function GetVclControl: TControl; override;
    225     function GetVclWinControl: TWinControl; override;
     301    function GetVclCustomControl: TCustomControl; override;
     302    function GetVclForm: TForm; virtual;
    226303  public
    227304    VclForm: TForm;
    228305    property Canvas: TDpiCanvas read GetCanvas;
     306    property ModalResult: TModalResult read GetModalResult write SetModalResult;
     307    function ShowModal: Integer; virtual;
     308    procedure Close;
     309    procedure BringToFront;
    229310    constructor Create(TheOwner: TComponent); override;
    230311    destructor Destroy; override;
    231312  published
     313    property FormState: TFormState read GetFormState;
    232314    property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle;
     315    property BorderIcons: TBorderIcons read GetBorderIcons write SetBorderIcons;
    233316    property OnShow: TNotifyEvent read GetOnShow write SetOnShow;
    234317    property OnHide: TNotifyEvent read GetOnHide write SetOnHide;
    235318    property OnCreate: TNotifyEvent read GetOnCreate write SetOnCreate;
    236319    property OnDestroy: TNotifyEvent read GetOnDestroy write SetOnDestroy;
     320    property OnDeactivate: TNotifyEvent read GetOnDeactivate write SetOnDeactivate;
     321    property OnClose: TCloseEvent read GetOnClose write SetOnClose;
    237322  end;
    238323
     
    262347  end;
    263348
     349  { TDpiScrollBar }
     350
     351  TDpiScrollBar = class(TDpiControl)
     352  private
     353    function GetBorderSpacing: TControlBorderSpacing;
     354    function GetKind: TScrollBarKind;
     355    function GetMax: Integer;
     356    function GetMin: Integer;
     357    function GetOnChange: TNotifyEvent;
     358    function GetPageSize: Integer;
     359    function GetPosition: Integer;
     360    procedure SetBorderSpacing(AValue: TControlBorderSpacing);
     361    procedure SetKind(AValue: TScrollBarKind);
     362    procedure SetMax(AValue: Integer);
     363    procedure SetMin(AValue: Integer);
     364    procedure SetOnChange(AValue: TNotifyEvent);
     365    procedure SetPageSize(AValue: Integer);
     366    procedure SetPosition(AValue: Integer);
     367  protected
     368    function GetVclControl: TControl; override;
     369  public
     370    VclScrollBar: TScrollBar;
     371    destructor Destroy; override;
     372  published
     373    property PageSize: Integer read GetPageSize write SetPageSize;
     374    property Min: Integer read GetMin write SetMin;
     375    property Max: Integer read GetMax write SetMax;
     376    property Position: Integer read GetPosition write SetPosition;
     377    property BorderSpacing: TControlBorderSpacing read GetBorderSpacing write SetBorderSpacing;
     378    property Kind: TScrollBarKind read GetKind write SetKind;
     379    property OnChange: TNotifyEvent read GetOnChange write SetOnChange;
     380  end;
     381
    264382  { TDpiBitmap }
    265383
    266   TDpiBitmap = class
     384  TDpiBitmap = class(TDpiRasterImage)
    267385  private
    268386    FCanvas: TDpiCanvas;
     387    function GetCanvas: TDpiCanvas;
     388    function GetHeight: Integer;
     389    function GetPixelFormat: TPixelFormat;
     390    function GetScanLine(Row: Integer): Pointer;
     391    function GetWidth: Integer;
     392    procedure SetHeight(AValue: Integer);
     393    procedure SetPixelFormat(AValue: TPixelFormat);
     394    procedure SetWidth(AValue: Integer);
     395  protected
     396    function GetVclBitmap: TCustomBitmap; virtual;
     397    function GetVclRasterImage: TRasterImage; override;
     398  public
     399    VclBitmap: TBitmap;
     400    procedure BeginUpdate;
     401    procedure EndUpdate;
     402    procedure SetSize(Width, Height: Integer);
     403    constructor Create;
     404    destructor Destroy; override;
     405    property ScanLine[Row: Integer]: Pointer read GetScanLine;
    269406  published
    270     property Canvas: TDpiCanvas read FCanvas;
     407    property PixelFormat: TPixelFormat read GetPixelFormat write SetPixelFormat;
     408    property Height: Integer read GetHeight write SetHeight;
     409    property Width: Integer read GetWidth write SetWidth;
     410    property Canvas: TDpiCanvas read GetCanvas;
    271411  end;
    272412
     
    312452    destructor Destroy; override;
    313453  published
    314     property OnPaint: TNotifyEvent read GetOnPaint write SetOnPaint;
    315454  end;
    316455
     
    320459  private
    321460    FDpi: Integer;
     461    FActiveForm: TDpiForm;
     462    function GetActiveForm: TDpiForm;
     463    function GetFormCount: Integer;
    322464    function GetHeight: Integer;
    323465    function GetWidth: Integer;
     
    328470    constructor Create;
    329471    destructor Destroy; override;
     472    property FormCount: Integer read GetFormCount;
     473    property ActiveForm: TDpiForm read GetActiveForm;
    330474  published
    331475    property Dpi: Integer read FDpi write SetDpi;
     
    334478  end;
    335479
     480  { TDpiJpegImage }
     481
     482  TDpiJpegImage = class(TDpiBitmap)
     483  protected
     484    function GetVclBitmap: TCustomBitmap; override;
     485    function GetVclJpeg: TJPEGImage; virtual;
     486  public
     487    VclJpeg: TJPEGImage;
     488  end;
     489
     490  { TDpiPortableNetworkGraphic }
     491
     492  TDpiPortableNetworkGraphic = class(TDpiBitmap)
     493  protected
     494    function GetVclBitmap: TCustomBitmap; override;
     495    function GetVclPng: TPortableNetworkGraphic; virtual;
     496  public
     497    VclPng: TPortableNetworkGraphic;
     498  end;
     499
    336500var
    337501  DpiFormFileDesc: TDpiFormFileDesc;
     
    379543  Result.Right := ScaleFromVcl(Value.Right);
    380544  Result.Bottom := ScaleFromVcl(Value.Bottom);
     545end;
     546
     547{ TDpiJpegImage }
     548
     549function TDpiJpegImage.GetVclBitmap: TCustomBitmap;
     550begin
     551  Result := GetVclJpeg;
     552end;
     553
     554function TDpiJpegImage.GetVclJpeg: TJPEGImage;
     555begin
     556  if not Assigned(VclJpeg) then VclJpeg := TJPEGImage.Create;
     557  Result := VclJpeg;
     558end;
     559
     560{ TDpiPortableNetworkGraphic }
     561
     562function TDpiPortableNetworkGraphic.GetVclBitmap: TCustomBitmap;
     563begin
     564  Result := GetVclPng;
     565end;
     566
     567function TDpiPortableNetworkGraphic.GetVclPng: TPortableNetworkGraphic;
     568begin
     569  if not Assigned(VclPng) then VclPng := TPortableNetworkGraphic.Create;
     570  Result := VclPng;
     571end;
     572
     573{ TDpiCustomControl }
     574
     575function TDpiCustomControl.GetOnPaint: TNotifyEvent;
     576begin
     577  Result := GetVclCustomControl.OnPaint;
     578end;
     579
     580procedure TDpiCustomControl.SetOnPaint(AValue: TNotifyEvent);
     581begin
     582  GetVclCustomControl.OnPaint := AValue;
     583end;
     584
     585function TDpiCustomControl.GetVclWinControl: TWinControl;
     586begin
     587  Result := GetVclCustomControl;
     588end;
     589
     590function TDpiCustomControl.GetVclCustomControl: TCustomControl;
     591begin
     592  Result := nil;
     593end;
     594
     595{ TDpiScrollBar }
     596
     597function TDpiScrollBar.GetBorderSpacing: TControlBorderSpacing;
     598begin
     599  Result := VclScrollBar.BorderSpacing;
     600end;
     601
     602function TDpiScrollBar.GetKind: TScrollBarKind;
     603begin
     604  Result := VclScrollBar.Kind;
     605end;
     606
     607function TDpiScrollBar.GetMax: Integer;
     608begin
     609  Result := VclScrollBar.Max;
     610end;
     611
     612function TDpiScrollBar.GetMin: Integer;
     613begin
     614  Result := VclScrollBar.Min;
     615end;
     616
     617function TDpiScrollBar.GetOnChange: TNotifyEvent;
     618begin
     619  Result := VclScrollBar.OnChange;
     620end;
     621
     622function TDpiScrollBar.GetPageSize: Integer;
     623begin
     624  Result := VclScrollBar.PageSize;
     625end;
     626
     627function TDpiScrollBar.GetPosition: Integer;
     628begin
     629  Result := VclScrollBar.Position;
     630end;
     631
     632procedure TDpiScrollBar.SetBorderSpacing(AValue: TControlBorderSpacing);
     633begin
     634  VclScrollBar.BorderSpacing := AValue;
     635end;
     636
     637procedure TDpiScrollBar.SetKind(AValue: TScrollBarKind);
     638begin
     639  VclScrollBar.Kind := AValue;
     640end;
     641
     642procedure TDpiScrollBar.SetMax(AValue: Integer);
     643begin
     644  VclScrollBar.Max := AValue;
     645end;
     646
     647procedure TDpiScrollBar.SetMin(AValue: Integer);
     648begin
     649  VclScrollBar.Min := Avalue;
     650end;
     651
     652procedure TDpiScrollBar.SetOnChange(AValue: TNotifyEvent);
     653begin
     654  VclScrollBar.OnChange := AValue;
     655end;
     656
     657procedure TDpiScrollBar.SetPageSize(AValue: Integer);
     658begin
     659  VclScrollBar.PageSize := AValue;
     660end;
     661
     662procedure TDpiScrollBar.SetPosition(AValue: Integer);
     663begin
     664  VclScrollBar.Position := AValue;
     665end;
     666
     667function TDpiScrollBar.GetVclControl: TControl;
     668begin
     669  if not Assigned(VclScrollBar) then VclScrollBar := TScrollBar.Create(nil);
     670  Result := VclScrollBar;
     671end;
     672
     673destructor TDpiScrollBar.Destroy;
     674begin
     675  FreeAndNil(VclScrollBar);
     676  inherited Destroy;
     677end;
     678
     679{ TDpiRasterImage }
     680
     681function TDpiRasterImage.GetRawImage: TRawImage;
     682begin
     683  Result := GetVclRasterImage.RawImage;
     684end;
     685
     686function TDpiRasterImage.GetVclRasterImage: TRasterImage;
     687begin
     688  Result := GetVclRasterImage;
     689end;
     690
     691function TDpiRasterImage.GetVclGraphic: TGraphic;
     692begin
     693  Result := GetVclRasterImage;
     694end;
     695
     696{ TDpiGraphic }
     697
     698function TDpiGraphic.GetVclGraphic: TGraphic;
     699begin
     700  Result := nil;
     701end;
     702
     703procedure TDpiGraphic.LoadFromFile(const Filename: string);
     704begin
     705  GetVclGraphic.LoadFromFile(FileName);
     706end;
     707
     708{ TDpiBitmap }
     709
     710function TDpiBitmap.GetHeight: Integer;
     711begin
     712  Result := ScaleFromVcl(GetVclBitmap.Height);
     713end;
     714
     715function TDpiBitmap.GetCanvas: TDpiCanvas;
     716begin
     717  if not Assigned(FCanvas) then FCanvas := TDpiCanvas.Create;
     718  Result := FCanvas;
     719end;
     720
     721function TDpiBitmap.GetPixelFormat: TPixelFormat;
     722begin
     723  Result := GetVclBitmap.PixelFormat;
     724end;
     725
     726function TDpiBitmap.GetScanLine(Row: Integer): Pointer;
     727begin
     728  Result := GetVclBitmap.ScanLine[Row];
     729end;
     730
     731function TDpiBitmap.GetWidth: Integer;
     732begin
     733  Result := ScaleFromVcl(GetVclBitmap.Width);
     734end;
     735
     736procedure TDpiBitmap.SetHeight(AValue: Integer);
     737begin
     738  GetVclBitmap.Height := ScaleToVcl(AValue);
     739end;
     740
     741procedure TDpiBitmap.SetPixelFormat(AValue: TPixelFormat);
     742begin
     743  GetVclBitmap.PixelFormat := AValue;
     744end;
     745
     746procedure TDpiBitmap.SetWidth(AValue: Integer);
     747begin
     748  GetVclBitmap.Width := ScaleToVcl(AValue);
     749end;
     750
     751function TDpiBitmap.GetVclBitmap: TCustomBitmap;
     752begin
     753  if not Assigned(VclBitmap) then begin
     754    VclBitmap := TBitmap.Create;
     755    Canvas.VclCanvas := VclBitmap.Canvas;
     756  end;
     757  Result := VclBitmap;
     758end;
     759
     760procedure TDpiBitmap.BeginUpdate;
     761begin
     762  GetVclBitmap.BeginUpdate;
     763end;
     764
     765procedure TDpiBitmap.EndUpdate;
     766begin
     767  GetVclBitmap.EndUpdate;
     768end;
     769
     770procedure TDpiBitmap.SetSize(Width, Height: Integer);
     771begin
     772  GetVclBitmap.SetSize(ScaleToVcl(Width), ScaleToVcl(Height));
     773end;
     774
     775constructor TDpiBitmap.Create;
     776begin
     777end;
     778
     779destructor TDpiBitmap.Destroy;
     780begin
     781  FreeAndNil(FCanvas);
     782  FreeAndNil(VclBitmap);
     783  inherited;
     784end;
     785
     786function TDpiBitmap.GetVclRasterImage: TRasterImage;
     787begin
     788  Result := GetVclBitmap;
    381789end;
    382790
     
    446854function TDpiCanvas.GetBrush: TBrush;
    447855begin
    448   Result := VclCanvas.Brush;
     856  Result := GetVclCanvas.Brush;
    449857end;
    450858
    451859function TDpiCanvas.GetHandle: HDC;
    452860begin
    453   Result := VclCanvas.Handle;
     861  Result := GetVclCanvas.Handle;
    454862end;
    455863
    456864function TDpiCanvas.GetHeight: Integer;
    457865begin
    458   Result := ScaleFromVcl(VclCanvas.Height);
     866  Result := ScaleFromVcl(GetVclCanvas.Height);
    459867end;
    460868
    461869function TDpiCanvas.GetPen: TPen;
    462870begin
    463   Result := VclCanvas.Pen;
     871  Result := GetVclCanvas.Pen;
    464872end;
    465873
    466874function TDpiCanvas.GetPixel(X, Y: Integer): TColor;
    467875begin
    468   Result := VclCanvas.Pixels[ScaleToVcl(X), ScaleToVcl(Y)];
     876  Result := GetVclCanvas.Pixels[ScaleToVcl(X), ScaleToVcl(Y)];
    469877end;
    470878
    471879function TDpiCanvas.GetWidth: Integer;
    472880begin
    473   Result := ScaleFromVcl(VclCanvas.Width);
     881  Result := ScaleFromVcl(GetVclCanvas.Width);
    474882end;
    475883
    476884procedure TDpiCanvas.SetBrush(AValue: TBrush);
    477885begin
    478   VclCanvas.Brush := AValue;
     886  GetVclCanvas.Brush := AValue;
    479887end;
    480888
     
    487895procedure TDpiCanvas.SetHandle(AValue: HDC);
    488896begin
    489   VclCanvas.Handle := AValue;
     897  GetVclCanvas.Handle := AValue;
    490898end;
    491899
    492900procedure TDpiCanvas.SetPen(AValue: TPen);
    493901begin
    494   VclCanvas.Pen := AValue;
     902  GetVclCanvas.Pen := AValue;
    495903end;
    496904
    497905procedure TDpiCanvas.SetPixel(X, Y: Integer; AValue: TColor);
    498906begin
    499   VclCanvas.Pixels[ScaleToVcl(X), ScaleToVcl(Y)] := AValue;
     907  GetVclCanvas.Pixels[ScaleToVcl(X), ScaleToVcl(Y)] := AValue;
     908end;
     909
     910function TDpiCanvas.GetVclCanvas: TCanvas;
     911begin
     912  if not Assigned(VclCanvas) then VclCanvas := TCanvas.Create;
     913  Result := VclCanvas;
    500914end;
    501915
    502916procedure TDpiCanvas.FrameRect(Rect: TRect);
    503917begin
    504   VclCanvas.FrameRect(ScaleRectToVcl(Rect));
     918  GetVclCanvas.FrameRect(ScaleRectToVcl(Rect));
     919end;
     920
     921procedure TDpiCanvas.Rectangle(X1, Y1, X2, Y2: Integer);
     922begin
     923  GetVclCanvas.Rectangle(ScaleToVcl(X1), ScaleToVcl(Y1), ScaleToVcl(X2), ScaleToVcl(Y2));
    505924end;
    506925
    507926function TDpiCanvas.TextWidth(Text: string): Integer;
    508927begin
    509   Result := ScaleFromVcl(VclCanvas.TextWidth(Text));
     928  Result := ScaleFromVcl(GetVclCanvas.TextWidth(Text));
    510929end;
    511930
    512931function TDpiCanvas.TextHeight(Text: string): Integer;
    513932begin
    514   Result := ScaleFromVcl(VclCanvas.TextHeight(Text));
     933  Result := ScaleFromVcl(GetVclCanvas.TextHeight(Text));
     934end;
     935
     936function TDpiCanvas.TextExtent(Text: string): TSize;
     937begin
     938  Result := GetVclCanvas.TextExtent(Text);
    515939end;
    516940
    517941procedure TDpiCanvas.TextOut(X, Y: Integer; Text: string);
    518942begin
    519   VclCanvas.TextOut(ScaleToVcl(X), ScaleToVcl(Y), Text);
     943  GetVclCanvas.TextOut(ScaleToVcl(X), ScaleToVcl(Y), Text);
     944end;
     945
     946procedure TDpiCanvas.TextRect(ARect: TRect; X, Y: Integer; Text: string);
     947begin
     948  GetVclCanvas.TextRect(ARect, X, Y, Text);
    520949end;
    521950
    522951procedure TDpiCanvas.MoveTo(X, Y: Integer);
    523952begin
    524   VclCanvas.MoveTo(ScaleToVcl(X), ScaleToVcl(Y));
     953  GetVclCanvas.MoveTo(ScaleToVcl(X), ScaleToVcl(Y));
    525954end;
    526955
    527956procedure TDpiCanvas.LineTo(X, Y: Integer);
    528957begin
    529   VclCanvas.LineTo(ScaleToVcl(X), ScaleToVcl(Y));
     958  GetVclCanvas.LineTo(ScaleToVcl(X), ScaleToVcl(Y));
    530959end;
    531960
    532961procedure TDpiCanvas.FillRect(ARect: TRect);
    533962begin
    534   VclCanvas.FillRect(ScaleRectToVcl(ARect));
     963  GetVclCanvas.FillRect(ScaleRectToVcl(ARect));
    535964end;
    536965
    537966procedure TDpiCanvas.FillRect(X1, Y1, X2, Y2: Integer);
    538967begin
    539   VclCanvas.FillRect(ScaleToVcl(X1), ScaleToVcl(Y1), ScaleToVcl(X2), ScaleToVcl(Y2));
     968  GetVclCanvas.FillRect(ScaleToVcl(X1), ScaleToVcl(Y1), ScaleToVcl(X2), ScaleToVcl(Y2));
     969end;
     970
     971procedure TDpiCanvas.Draw(X, Y: Integer; Source: TDpiGraphic);
     972begin
     973  GetVclCanvas.Draw(ScaleToVcl(X), ScaleToVcl(Y), Source.GetVclGraphic);
     974end;
     975
     976procedure TDpiCanvas.CopyRect(Dest: TRect; SrcCanvas: TDpiCanvas;
     977  Source: TRect);
     978begin
     979  GetVclCanvas.CopyRect(Dest, SrcCanvas.VclCanvas, Source);
    540980end;
    541981
     
    559999end;
    5601000
     1001function TDpiGraphicControl.GetOnPaint: TNotifyEvent;
     1002begin
     1003  Result := nil;
     1004end;
     1005
     1006procedure TDpiGraphicControl.SetOnPaint(AValue: TNotifyEvent);
     1007begin
     1008
     1009end;
     1010
    5611011procedure TDpiGraphicControl.Paint;
    5621012begin
     1013end;
     1014
     1015function TDpiGraphicControl.GetVclControl: TControl;
     1016begin
     1017  Result := GetVclGraphicControl;
     1018end;
     1019
     1020function TDpiGraphicControl.GetVclGraphicControl: TGraphicControl;
     1021begin
     1022  Result := nil;
    5631023end;
    5641024
     
    6191079procedure TDpiFont.SetStyle(AValue: TFontStyles);
    6201080begin
    621   VclFont.Style := AValue;
     1081  GetVclFont.Style := AValue;
    6221082end;
    6231083
     
    6251085begin
    6261086  DoChange;
     1087end;
     1088
     1089function TDpiFont.GetVclFont: TFont;
     1090begin
     1091  if not Assigned(VclFont) then VclFont := TFont.Create;
     1092  Result := VclFont;
    6271093end;
    6281094
     
    6351101procedure TDpiFont.SetPixelsPerInch(AValue: Integer);
    6361102begin
    637   VclFont.PixelsPerInch := PixelsPerInch;
     1103  GetVclFont.PixelsPerInch := PixelsPerInch;
    6381104end;
    6391105
    6401106function TDpiFont.GetName: string;
    6411107begin
    642   Result := VclFont.Name;
     1108  Result := GetVclFont.Name;
    6431109end;
    6441110
    6451111function TDpiFont.GetColor: TColor;
    6461112begin
    647   Result := VclFont.Color;
     1113  Result := GetVclFont.Color;
    6481114end;
    6491115
    6501116function TDpiFont.GetPixelsPerInch: Integer;
    6511117begin
    652   Result := VclFont.PixelsPerInch;
     1118  Result := GetVclFont.PixelsPerInch;
    6531119end;
    6541120
    6551121function TDpiFont.GetStyle: TFontStyles;
    6561122begin
    657   Result := VclFont.Style;
     1123  Result := GetVclFont.Style;
    6581124end;
    6591125
    6601126procedure TDpiFont.SetColor(AValue: TColor);
    6611127begin
    662   VclFont.Color := AValue;
     1128  GetVclFont.Color := AValue;
    6631129end;
    6641130
    6651131procedure TDpiFont.SetName(AValue: string);
    6661132begin
    667   VclFont.Name := AValue;
     1133  GetVclFont.Name := AValue;
    6681134end;
    6691135
     
    6801146procedure TDpiFont.Assign(Source: TDpiFont);
    6811147begin
    682   VclFont.Assign(Source.VclFont);
     1148  GetVclFont.Assign(Source.GetVclFont);
    6831149  Size := Source.Size;
    6841150  FOnChange := Source.FOnChange;
     
    6921158end;
    6931159
     1160function TDpiWinControl.GetOnKeyDown: TKeyEvent;
     1161begin
     1162  Result := GetVclWinControl.OnKeyDown;
     1163end;
     1164
     1165function TDpiWinControl.GetOnKeyPress: TKeyPressEvent;
     1166begin
     1167  Result := GetVclWinControl.OnKeyPress;
     1168end;
     1169
     1170function TDpiWinControl.GetOnKeyUp: TKeyEvent;
     1171begin
     1172  Result := GetVclWinControl.OnKeyUp;
     1173end;
     1174
    6941175procedure TDpiWinControl.SetHandle(AValue: HWND);
    6951176begin
    6961177  GetVclWinControl.Handle := AValue;
     1178end;
     1179
     1180procedure TDpiWinControl.SetOnKeyDown(AValue: TKeyEvent);
     1181begin
     1182  GetVclWinControl.OnKeyDown := AValue;
     1183end;
     1184
     1185procedure TDpiWinControl.SetOnKeyPress(AValue: TKeyPressEvent);
     1186begin
     1187  GetVclWinControl.OnKeyPress := AValue;
     1188end;
     1189
     1190procedure TDpiWinControl.SetOnKeyUp(AValue: TKeyEvent);
     1191begin
     1192  GetVclWinControl.OnKeyUp := AValue;
     1193
     1194end;
     1195
     1196function TDpiWinControl.GetVclControl: TControl;
     1197begin
     1198  Result := GetVclWinControl;
    6971199end;
    6981200
     
    7461248begin
    7471249  Result := ScaleFromVcl(Screen.Height);
     1250end;
     1251
     1252function TDpiScreen.GetFormCount: Integer;
     1253begin
     1254  Result := Forms.Count;
     1255end;
     1256
     1257function TDpiScreen.GetActiveForm: TDpiForm;
     1258begin
     1259  Result := FActiveForm;
    7481260end;
    7491261
     
    8681380begin
    8691381  GetVclControl.Repaint;
     1382end;
     1383
     1384procedure TDpiControl.Update;
     1385begin
     1386  GetVclControl.Update;
    8701387end;
    8711388
     
    9221439end;
    9231440
     1441procedure TDpiControl.SetHint(AValue: string);
     1442begin
     1443  GetVclControl.Hint := AValue;
     1444end;
     1445
    9241446function TDpiControl.GetBoundsRect: TRect;
    9251447begin
     
    9301452end;
    9311453
     1454function TDpiControl.GetAlign: TAlign;
     1455begin
     1456  Result := GetVclControl.Align;
     1457end;
     1458
    9321459function TDpiControl.GetClientHeight: Integer;
    9331460begin
     
    9451472end;
    9461473
     1474function TDpiControl.GetHint: string;
     1475begin
     1476  Result := GetVclControl.Hint;
     1477end;
     1478
    9471479function TDpiControl.GetOnClick: TNotifyEvent;
    9481480begin
     
    9601492end;
    9611493
     1494procedure TDpiControl.SetAlign(AValue: TAlign);
     1495begin
     1496  GetVclControl.Align := AValue;
     1497end;
     1498
    9621499procedure TDpiControl.SetBoundsRect(AValue: TRect);
    9631500begin
    9641501  SetBounds(AValue.Left, AValue.Top, AValue.Right - AValue.Left, AValue.Bottom - AValue.Top);
     1502end;
     1503
     1504procedure TDpiControl.SetClientHeight(AValue: Integer);
     1505begin
     1506  GetVclControl.ClientHeight := ScaletoVcl(AValue);
     1507end;
     1508
     1509procedure TDpiControl.SetClientWidth(AValue: Integer);
     1510begin
     1511  GetVclControl.ClientWidth := ScaletoVcl(AValue);
    9651512end;
    9661513
     
    10641611{ TDpiForm }
    10651612
     1613function TDpiForm.GetBorderIcons: TBorderIcons;
     1614begin
     1615  Result := VclForm.BorderIcons;
     1616end;
     1617
    10661618function TDpiForm.GetBorderStyle: TBorderStyle;
    10671619begin
     
    10741626end;
    10751627
     1628function TDpiForm.GetFormState: TFormState;
     1629begin
     1630  Result := VclForm.FormState;
     1631end;
     1632
     1633function TDpiForm.GetModalResult: TModalResult;
     1634begin
     1635  Result := VclForm.ModalResult;
     1636end;
     1637
     1638function TDpiForm.GetOnClose: TCloseEvent;
     1639begin
     1640  Result := VclForm.OnClose;
     1641end;
     1642
    10761643function TDpiForm.GetOnCreate: TNotifyEvent;
    10771644begin
     
    10791646end;
    10801647
     1648function TDpiForm.GetOnDeactivate: TNotifyEvent;
     1649begin
     1650  Result := VclForm.OnDeactivate;
     1651end;
     1652
    10811653function TDpiForm.GetOnDestroy: TNotifyEvent;
    10821654begin
     
    10941666end;
    10951667
     1668procedure TDpiForm.SetBorderIcons(AValue: TBorderIcons);
     1669begin
     1670  VclForm.BorderIcons := AValue;
     1671end;
     1672
    10961673procedure TDpiForm.SetBorderStyle(AValue: TBorderStyle);
    10971674begin
     
    10991676end;
    11001677
     1678procedure TDpiForm.SetModalResult(AValue: TModalResult);
     1679begin
     1680  VclForm.ModalResult := AValue;
     1681end;
     1682
     1683procedure TDpiForm.SetOnClose(AValue: TCloseEvent);
     1684begin
     1685  VclForm.OnClose := AValue;
     1686end;
     1687
    11011688procedure TDpiForm.SetOnCreate(AValue: TNotifyEvent);
    11021689begin
    11031690  VclForm.OnCreate := AValue;
     1691end;
     1692
     1693procedure TDpiForm.SetOnDeactivate(AValue: TNotifyEvent);
     1694begin
     1695  VclForm.OnDeactivate := AValue;
    11041696end;
    11051697
     
    11231715  if Assigned(VclForm.OnCreate) then
    11241716    VclForm.OnCreate(Self);
     1717end;
     1718
     1719procedure TDpiForm.CreateParams(var p: TCreateParams);
     1720begin
     1721  // TODO: VclForm.CreateParams(P);
    11251722end;
    11261723
     
    11411738end;
    11421739
    1143 function TDpiForm.GetVclControl: TControl;
    1144 begin
    1145   Result := GetVclWinControl;
    1146 end;
    1147 
    1148 function TDpiForm.GetVclWinControl: TWinControl;
     1740function TDpiForm.GetVclCustomControl: TCustomControl;
     1741begin
     1742  Result := GetVclForm;
     1743end;
     1744
     1745function TDpiForm.GetVclForm: TForm;
    11491746begin
    11501747  if not Assigned(VclForm) then VclForm := TForm.Create(nil);
    11511748  Result := VclForm;
     1749end;
     1750
     1751function TDpiForm.ShowModal: Integer;
     1752begin
     1753  Result := GetVclForm.ShowModal;
     1754end;
     1755
     1756procedure TDpiForm.Close;
     1757begin
     1758  GetVclForm.Close;
     1759end;
     1760
     1761procedure TDpiForm.BringToFront;
     1762begin
     1763  GetVclForm.BringToFront;
    11521764end;
    11531765
Note: See TracChangeset for help on using the changeset viewer.