Changeset 536 for DpiControls/UDpiControls.pas

Timestamp:

May 30, 2019, 11:58:04 PM (5 years ago)

Author:

chronos

Message:

• Modified: Improved DPI controls.

File:

• DpiControls/UDpiControls.pas (modified) (39 diffs)

DpiControls/UDpiControls.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, LCLProc, LResources, Forms, FormEditingIntf, ProjectIntf,
-  Controls, StdCtrls, fgl, Graphics, ComCtrls, ExtCtrls, LCLType;
+  Controls, StdCtrls, fgl, Graphics, ComCtrls, ExtCtrls, LCLType, GraphType,
+  Types;
 
 type
@@ -39 +40 @@
   protected
     procedure ScreenChanged;
+    function GetVclFont: TFont; virtual;
   public
     VclFont: TFont;
@@ -67 +69 @@
     FWidth: Integer;
     FParent: TDpiWinControl;
+    function GetAlign: TAlign;
     function GetBoundsRect: TRect;
     function GetClientHeight: Integer;
     function GetClientWidth: Integer;
     function GetEnabled: Boolean;
+    function GetHint: string;
     function GetOnClick: TNotifyEvent;
     function GetShowHint: Boolean;
     function GetVisible: Boolean;
+    procedure SetAlign(AValue: TAlign);
     procedure SetBoundsRect(AValue: TRect);
+    procedure SetClientHeight(AValue: Integer);
+    procedure SetClientWidth(AValue: Integer);
     procedure SetEnabled(AValue: Boolean);
     procedure SetFont(AValue: TDpiFont);
+    procedure SetHint(AValue: string);
     procedure SetOnChangeBounds(AValue: TNotifyEvent);
     procedure SetOnClick(AValue: TNotifyEvent);
@@ -110 +118 @@
     procedure Invalidate;
     procedure Repaint;
+    procedure Update;
     constructor Create(TheOwner: TComponent); override;
     destructor Destroy; override;
     property Parent: TDpiWinControl read FParent write SetParent;
     property BoundsRect: TRect read GetBoundsRect write SetBoundsRect;
-    property ClientWidth: Integer read GetClientWidth;
-    property ClientHeight: Integer read GetClientHeight;
+    property ClientWidth: Integer read GetClientWidth write SetClientWidth;
+    property ClientHeight: Integer read GetClientHeight write SetClientHeight;
   published
+    property Hint: string read GetHint write SetHint;
     property Top: Integer read FTop write SetTop;
     property Left: Integer read FLeft write SetLeft;
@@ -126 +136 @@
     property ShowHint: Boolean read GetShowHint write SetShowHint;
     property Font: TDpiFont read FFont write SetFont;
+    property Align: TAlign read GetAlign write SetAlign;
     property OnResize: TNotifyEvent read FOnResize write SetOnResize;
     property OnChangeBounds: TNotifyEvent read FOnChangeBounds write SetOnChangeBounds;
@@ -132 +143 @@
 
   TDpiControls = specialize TFPGObjectList<TDpiControl>;
+
+  { TDpiGraphic }
+
+  TDpiGraphic = class(TPersistent)
+  protected
+    function GetVclGraphic: TGraphic; virtual;
+  public
+    procedure LoadFromFile(const Filename: string);
+  end;
+
+  { TDpiRasterImage }
+
+  TDpiRasterImage = class(TDpiGraphic)
+  private
+    function GetRawImage: TRawImage;
+  protected
+    function GetVclGraphic: TGraphic; override;
+    function GetVclRasterImage: TRasterImage; virtual;
+  public
+    property RawImage: TRawImage read GetRawImage;
+  end;
 
   { TDpiCanvas }
@@ -149 +181 @@
     procedure SetPen(AValue: TPen);
     procedure SetPixel(X, Y: Integer; AValue: TColor);
+  protected
+    function GetVclCanvas: TCanvas; virtual;
   public
     VclCanvas: TCanvas;
     procedure FrameRect(Rect: TRect);
+    procedure Rectangle(X1, Y1, X2, Y2: Integer);
     function TextWidth(Text: string): Integer;
     function TextHeight(Text: string): Integer;
+    function TextExtent(Text: string): TSize;
     procedure TextOut(X, Y: Integer; Text: string);
+    procedure TextRect(ARect: TRect; X, Y: Integer; Text: string);
     procedure MoveTo(X, Y: Integer);
     procedure LineTo(X, Y: Integer);
     procedure FillRect(ARect: TRect);
     procedure FillRect(X1, Y1, X2, Y2: Integer);
+    procedure Draw(X, Y: Integer; Source: TDpiGraphic);
+    procedure CopyRect(Dest: TRect; SrcCanvas: TDpiCanvas; Source: TRect);
     constructor Create;
     destructor Destroy; override;
@@ -176 +215 @@
   private
     FCanvas: TDpiCanvas;
+    function GetOnPaint: TNotifyEvent;
     procedure SetCanvas(AValue: TDpiCanvas);
+    procedure SetOnPaint(AValue: TNotifyEvent);
   protected
     procedure Paint; virtual;
+    function GetVclControl: TControl; override;
+    function GetVclGraphicControl: TGraphicControl; virtual;
   public
     constructor Create(TheOwner: TComponent); override;
@@ -184 +227 @@
   published
     property Canvas: TDpiCanvas read FCanvas write SetCanvas;
+    property OnPaint: TNotifyEvent read GetOnPaint write SetOnPaint;
   end;
 
@@ -191 +235 @@
   private
     function GetHandle: HWND;
+    function GetOnKeyDown: TKeyEvent;
+    function GetOnKeyPress: TKeyPressEvent;
+    function GetOnKeyUp: TKeyEvent;
     procedure SetHandle(AValue: HWND);
+    procedure SetOnKeyDown(AValue: TKeyEvent);
+    procedure SetOnKeyPress(AValue: TKeyPressEvent);
+    procedure SetOnKeyUp(AValue: TKeyEvent);
   protected
+    function GetVclControl: TControl; override;
     function GetVclWinControl: TWinControl; virtual;
   public
@@ -202 +253 @@
     property Handle: HWND read GetHandle write SetHandle;
   published
+    property OnKeyDown: TKeyEvent read GetOnKeyDown write SetOnKeyDown;
+    property OnKeyPress: TKeyPressEvent read GetOnKeyPress write SetOnKeyPress;
+    property OnKeyUp: TKeyEvent read GetOnKeyUp write SetOnKeyUp;
+  end;
+
+  { TDpiCustomControl }
+
+  TDpiCustomControl = class(TDpiWinControl)
+  private
+    function GetOnPaint: TNotifyEvent;
+    procedure SetOnPaint(AValue: TNotifyEvent);
+  protected
+    function GetVclWinControl: TWinControl; override;
+    function GetVclCustomControl: TCustomControl; virtual;
+  published
+    property OnPaint: TNotifyEvent read GetOnPaint write SetOnPaint;
   end;
 
   { TDpiForm }
 
-  TDpiForm = class(TDpiWinControl)
+  TDpiForm = class(TDpiCustomControl)
   private
+    function GetBorderIcons: TBorderIcons;
     function GetBorderStyle: TBorderStyle;
     function GetCanvas: TDpiCanvas;
+    function GetFormState: TFormState;
+    function GetModalResult: TModalResult;
+    function GetOnClose: TCloseEvent;
     function GetOnCreate: TNotifyEvent;
+    function GetOnDeactivate: TNotifyEvent;
     function GetOnDestroy: TNotifyEvent;
     function GetOnHide: TNotifyEvent;
     function GetOnShow: TNotifyEvent;
+    procedure SetBorderIcons(AValue: TBorderIcons);
     procedure SetBorderStyle(AValue: TBorderStyle);
+    procedure SetModalResult(AValue: TModalResult);
+    procedure SetOnClose(AValue: TCloseEvent);
     procedure SetOnCreate(AValue: TNotifyEvent);
+    procedure SetOnDeactivate(AValue: TNotifyEvent);
     procedure SetOnDestroy(AValue: TNotifyEvent);
     procedure SetOnHide(AValue: TNotifyEvent);
@@ -221 +297 @@
     procedure DoOnCreate;
   protected
+    procedure CreateParams(var p: TCreateParams); virtual;
     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
-    function GetVclControl: TControl; override;
-    function GetVclWinControl: TWinControl; override;
+    function GetVclCustomControl: TCustomControl; override;
+    function GetVclForm: TForm; virtual;
   public
     VclForm: TForm;
     property Canvas: TDpiCanvas read GetCanvas;
+    property ModalResult: TModalResult read GetModalResult write SetModalResult;
+    function ShowModal: Integer; virtual;
+    procedure Close;
+    procedure BringToFront;
     constructor Create(TheOwner: TComponent); override;
     destructor Destroy; override;
   published
+    property FormState: TFormState read GetFormState;
     property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle;
+    property BorderIcons: TBorderIcons read GetBorderIcons write SetBorderIcons;
     property OnShow: TNotifyEvent read GetOnShow write SetOnShow;
     property OnHide: TNotifyEvent read GetOnHide write SetOnHide;
     property OnCreate: TNotifyEvent read GetOnCreate write SetOnCreate;
     property OnDestroy: TNotifyEvent read GetOnDestroy write SetOnDestroy;
+    property OnDeactivate: TNotifyEvent read GetOnDeactivate write SetOnDeactivate;
+    property OnClose: TCloseEvent read GetOnClose write SetOnClose;
   end;
 
@@ -262 +347 @@
   end;
 
+  { TDpiScrollBar }
+
+  TDpiScrollBar = class(TDpiControl)
+  private
+    function GetBorderSpacing: TControlBorderSpacing;
+    function GetKind: TScrollBarKind;
+    function GetMax: Integer;
+    function GetMin: Integer;
+    function GetOnChange: TNotifyEvent;
+    function GetPageSize: Integer;
+    function GetPosition: Integer;
+    procedure SetBorderSpacing(AValue: TControlBorderSpacing);
+    procedure SetKind(AValue: TScrollBarKind);
+    procedure SetMax(AValue: Integer);
+    procedure SetMin(AValue: Integer);
+    procedure SetOnChange(AValue: TNotifyEvent);
+    procedure SetPageSize(AValue: Integer);
+    procedure SetPosition(AValue: Integer);
+  protected
+    function GetVclControl: TControl; override;
+  public
+    VclScrollBar: TScrollBar;
+    destructor Destroy; override;
+  published
+    property PageSize: Integer read GetPageSize write SetPageSize;
+    property Min: Integer read GetMin write SetMin;
+    property Max: Integer read GetMax write SetMax;
+    property Position: Integer read GetPosition write SetPosition;
+    property BorderSpacing: TControlBorderSpacing read GetBorderSpacing write SetBorderSpacing;
+    property Kind: TScrollBarKind read GetKind write SetKind;
+    property OnChange: TNotifyEvent read GetOnChange write SetOnChange;
+  end;
+
   { TDpiBitmap }
 
-  TDpiBitmap = class
+  TDpiBitmap = class(TDpiRasterImage)
   private
     FCanvas: TDpiCanvas;
+    function GetCanvas: TDpiCanvas;
+    function GetHeight: Integer;
+    function GetPixelFormat: TPixelFormat;
+    function GetScanLine(Row: Integer): Pointer;
+    function GetWidth: Integer;
+    procedure SetHeight(AValue: Integer);
+    procedure SetPixelFormat(AValue: TPixelFormat);
+    procedure SetWidth(AValue: Integer);
+  protected
+    function GetVclBitmap: TCustomBitmap; virtual;
+    function GetVclRasterImage: TRasterImage; override;
+  public
+    VclBitmap: TBitmap;
+    procedure BeginUpdate;
+    procedure EndUpdate;
+    procedure SetSize(Width, Height: Integer);
+    constructor Create;
+    destructor Destroy; override;
+    property ScanLine[Row: Integer]: Pointer read GetScanLine;
   published
-    property Canvas: TDpiCanvas read FCanvas;
+    property PixelFormat: TPixelFormat read GetPixelFormat write SetPixelFormat;
+    property Height: Integer read GetHeight write SetHeight;
+    property Width: Integer read GetWidth write SetWidth;
+    property Canvas: TDpiCanvas read GetCanvas;
   end;
 
@@ -312 +452 @@
     destructor Destroy; override;
   published
-    property OnPaint: TNotifyEvent read GetOnPaint write SetOnPaint;
   end;
 
@@ -320 +459 @@
   private
     FDpi: Integer;
+    FActiveForm: TDpiForm;
+    function GetActiveForm: TDpiForm;
+    function GetFormCount: Integer;
     function GetHeight: Integer;
     function GetWidth: Integer;
@@ -328 +470 @@
     constructor Create;
     destructor Destroy; override;
+    property FormCount: Integer read GetFormCount;
+    property ActiveForm: TDpiForm read GetActiveForm;
   published
     property Dpi: Integer read FDpi write SetDpi;
@@ -334 +478 @@
   end;
 
+  { TDpiJpegImage }
+
+  TDpiJpegImage = class(TDpiBitmap)
+  protected
+    function GetVclBitmap: TCustomBitmap; override;
+    function GetVclJpeg: TJPEGImage; virtual;
+  public
+    VclJpeg: TJPEGImage;
+  end;
+
+  { TDpiPortableNetworkGraphic }
+
+  TDpiPortableNetworkGraphic = class(TDpiBitmap)
+  protected
+    function GetVclBitmap: TCustomBitmap; override;
+    function GetVclPng: TPortableNetworkGraphic; virtual;
+  public
+    VclPng: TPortableNetworkGraphic;
+  end;
+
 var
   DpiFormFileDesc: TDpiFormFileDesc;
@@ -379 +543 @@
   Result.Right := ScaleFromVcl(Value.Right);
   Result.Bottom := ScaleFromVcl(Value.Bottom);
+end;
+
+{ TDpiJpegImage }
+
+function TDpiJpegImage.GetVclBitmap: TCustomBitmap;
+begin
+  Result := GetVclJpeg;
+end;
+
+function TDpiJpegImage.GetVclJpeg: TJPEGImage;
+begin
+  if not Assigned(VclJpeg) then VclJpeg := TJPEGImage.Create;
+  Result := VclJpeg;
+end;
+
+{ TDpiPortableNetworkGraphic }
+
+function TDpiPortableNetworkGraphic.GetVclBitmap: TCustomBitmap;
+begin
+  Result := GetVclPng;
+end;
+
+function TDpiPortableNetworkGraphic.GetVclPng: TPortableNetworkGraphic;
+begin
+  if not Assigned(VclPng) then VclPng := TPortableNetworkGraphic.Create;
+  Result := VclPng;
+end;
+
+{ TDpiCustomControl }
+
+function TDpiCustomControl.GetOnPaint: TNotifyEvent;
+begin
+  Result := GetVclCustomControl.OnPaint;
+end;
+
+procedure TDpiCustomControl.SetOnPaint(AValue: TNotifyEvent);
+begin
+  GetVclCustomControl.OnPaint := AValue;
+end;
+
+function TDpiCustomControl.GetVclWinControl: TWinControl;
+begin
+  Result := GetVclCustomControl;
+end;
+
+function TDpiCustomControl.GetVclCustomControl: TCustomControl;
+begin
+  Result := nil;
+end;
+
+{ TDpiScrollBar }
+
+function TDpiScrollBar.GetBorderSpacing: TControlBorderSpacing;
+begin
+  Result := VclScrollBar.BorderSpacing;
+end;
+
+function TDpiScrollBar.GetKind: TScrollBarKind;
+begin
+  Result := VclScrollBar.Kind;
+end;
+
+function TDpiScrollBar.GetMax: Integer;
+begin
+  Result := VclScrollBar.Max;
+end;
+
+function TDpiScrollBar.GetMin: Integer;
+begin
+  Result := VclScrollBar.Min;
+end;
+
+function TDpiScrollBar.GetOnChange: TNotifyEvent;
+begin
+  Result := VclScrollBar.OnChange;
+end;
+
+function TDpiScrollBar.GetPageSize: Integer;
+begin
+  Result := VclScrollBar.PageSize;
+end;
+
+function TDpiScrollBar.GetPosition: Integer;
+begin
+  Result := VclScrollBar.Position;
+end;
+
+procedure TDpiScrollBar.SetBorderSpacing(AValue: TControlBorderSpacing);
+begin
+  VclScrollBar.BorderSpacing := AValue;
+end;
+
+procedure TDpiScrollBar.SetKind(AValue: TScrollBarKind);
+begin
+  VclScrollBar.Kind := AValue;
+end;
+
+procedure TDpiScrollBar.SetMax(AValue: Integer);
+begin
+  VclScrollBar.Max := AValue;
+end;
+
+procedure TDpiScrollBar.SetMin(AValue: Integer);
+begin
+  VclScrollBar.Min := Avalue;
+end;
+
+procedure TDpiScrollBar.SetOnChange(AValue: TNotifyEvent);
+begin
+  VclScrollBar.OnChange := AValue;
+end;
+
+procedure TDpiScrollBar.SetPageSize(AValue: Integer);
+begin
+  VclScrollBar.PageSize := AValue;
+end;
+
+procedure TDpiScrollBar.SetPosition(AValue: Integer);
+begin
+  VclScrollBar.Position := AValue;
+end;
+
+function TDpiScrollBar.GetVclControl: TControl;
+begin
+  if not Assigned(VclScrollBar) then VclScrollBar := TScrollBar.Create(nil);
+  Result := VclScrollBar;
+end;
+
+destructor TDpiScrollBar.Destroy;
+begin
+  FreeAndNil(VclScrollBar);
+  inherited Destroy;
+end;
+
+{ TDpiRasterImage }
+
+function TDpiRasterImage.GetRawImage: TRawImage;
+begin
+  Result := GetVclRasterImage.RawImage;
+end;
+
+function TDpiRasterImage.GetVclRasterImage: TRasterImage;
+begin
+  Result := GetVclRasterImage;
+end;
+
+function TDpiRasterImage.GetVclGraphic: TGraphic;
+begin
+  Result := GetVclRasterImage;
+end;
+
+{ TDpiGraphic }
+
+function TDpiGraphic.GetVclGraphic: TGraphic;
+begin
+  Result := nil;
+end;
+
+procedure TDpiGraphic.LoadFromFile(const Filename: string);
+begin
+  GetVclGraphic.LoadFromFile(FileName);
+end;
+
+{ TDpiBitmap }
+
+function TDpiBitmap.GetHeight: Integer;
+begin
+  Result := ScaleFromVcl(GetVclBitmap.Height);
+end;
+
+function TDpiBitmap.GetCanvas: TDpiCanvas;
+begin
+  if not Assigned(FCanvas) then FCanvas := TDpiCanvas.Create;
+  Result := FCanvas;
+end;
+
+function TDpiBitmap.GetPixelFormat: TPixelFormat;
+begin
+  Result := GetVclBitmap.PixelFormat;
+end;
+
+function TDpiBitmap.GetScanLine(Row: Integer): Pointer;
+begin
+  Result := GetVclBitmap.ScanLine[Row];
+end;
+
+function TDpiBitmap.GetWidth: Integer;
+begin
+  Result := ScaleFromVcl(GetVclBitmap.Width);
+end;
+
+procedure TDpiBitmap.SetHeight(AValue: Integer);
+begin
+  GetVclBitmap.Height := ScaleToVcl(AValue);
+end;
+
+procedure TDpiBitmap.SetPixelFormat(AValue: TPixelFormat);
+begin
+  GetVclBitmap.PixelFormat := AValue;
+end;
+
+procedure TDpiBitmap.SetWidth(AValue: Integer);
+begin
+  GetVclBitmap.Width := ScaleToVcl(AValue);
+end;
+
+function TDpiBitmap.GetVclBitmap: TCustomBitmap;
+begin
+  if not Assigned(VclBitmap) then begin
+    VclBitmap := TBitmap.Create;
+    Canvas.VclCanvas := VclBitmap.Canvas;
+  end;
+  Result := VclBitmap;
+end;
+
+procedure TDpiBitmap.BeginUpdate;
+begin
+  GetVclBitmap.BeginUpdate;
+end;
+
+procedure TDpiBitmap.EndUpdate;
+begin
+  GetVclBitmap.EndUpdate;
+end;
+
+procedure TDpiBitmap.SetSize(Width, Height: Integer);
+begin
+  GetVclBitmap.SetSize(ScaleToVcl(Width), ScaleToVcl(Height));
+end;
+
+constructor TDpiBitmap.Create;
+begin
+end;
+
+destructor TDpiBitmap.Destroy;
+begin
+  FreeAndNil(FCanvas);
+  FreeAndNil(VclBitmap);
+  inherited;
+end;
+
+function TDpiBitmap.GetVclRasterImage: TRasterImage;
+begin
+  Result := GetVclBitmap;
 end;
 
@@ -446 +854 @@
 function TDpiCanvas.GetBrush: TBrush;
 begin
-  Result := VclCanvas.Brush;
+  Result := GetVclCanvas.Brush;
 end;
 
 function TDpiCanvas.GetHandle: HDC;
 begin
-  Result := VclCanvas.Handle;
+  Result := GetVclCanvas.Handle;
 end;
 
 function TDpiCanvas.GetHeight: Integer;
 begin
-  Result := ScaleFromVcl(VclCanvas.Height);
+  Result := ScaleFromVcl(GetVclCanvas.Height);
 end;
 
 function TDpiCanvas.GetPen: TPen;
 begin
-  Result := VclCanvas.Pen;
+  Result := GetVclCanvas.Pen;
 end;
 
 function TDpiCanvas.GetPixel(X, Y: Integer): TColor;
 begin
-  Result := VclCanvas.Pixels[ScaleToVcl(X), ScaleToVcl(Y)];
+  Result := GetVclCanvas.Pixels[ScaleToVcl(X), ScaleToVcl(Y)];
 end;
 
 function TDpiCanvas.GetWidth: Integer;
 begin
-  Result := ScaleFromVcl(VclCanvas.Width);
+  Result := ScaleFromVcl(GetVclCanvas.Width);
 end;
 
 procedure TDpiCanvas.SetBrush(AValue: TBrush);
 begin
-  VclCanvas.Brush := AValue;
+  GetVclCanvas.Brush := AValue;
 end;
 
@@ -487 +895 @@
 procedure TDpiCanvas.SetHandle(AValue: HDC);
 begin
-  VclCanvas.Handle := AValue;
+  GetVclCanvas.Handle := AValue;
 end;
 
 procedure TDpiCanvas.SetPen(AValue: TPen);
 begin
-  VclCanvas.Pen := AValue;
+  GetVclCanvas.Pen := AValue;
 end;
 
 procedure TDpiCanvas.SetPixel(X, Y: Integer; AValue: TColor);
 begin
-  VclCanvas.Pixels[ScaleToVcl(X), ScaleToVcl(Y)] := AValue;
+  GetVclCanvas.Pixels[ScaleToVcl(X), ScaleToVcl(Y)] := AValue;
+end;
+
+function TDpiCanvas.GetVclCanvas: TCanvas;
+begin
+  if not Assigned(VclCanvas) then VclCanvas := TCanvas.Create;
+  Result := VclCanvas;
 end;
 
 procedure TDpiCanvas.FrameRect(Rect: TRect);
 begin
-  VclCanvas.FrameRect(ScaleRectToVcl(Rect));
+  GetVclCanvas.FrameRect(ScaleRectToVcl(Rect));
+end;
+
+procedure TDpiCanvas.Rectangle(X1, Y1, X2, Y2: Integer);
+begin
+  GetVclCanvas.Rectangle(ScaleToVcl(X1), ScaleToVcl(Y1), ScaleToVcl(X2), ScaleToVcl(Y2));
 end;
 
 function TDpiCanvas.TextWidth(Text: string): Integer;
 begin
-  Result := ScaleFromVcl(VclCanvas.TextWidth(Text));
+  Result := ScaleFromVcl(GetVclCanvas.TextWidth(Text));
 end;
 
 function TDpiCanvas.TextHeight(Text: string): Integer;
 begin
-  Result := ScaleFromVcl(VclCanvas.TextHeight(Text));
+  Result := ScaleFromVcl(GetVclCanvas.TextHeight(Text));
+end;
+
+function TDpiCanvas.TextExtent(Text: string): TSize;
+begin
+  Result := GetVclCanvas.TextExtent(Text);
 end;
 
 procedure TDpiCanvas.TextOut(X, Y: Integer; Text: string);
 begin
-  VclCanvas.TextOut(ScaleToVcl(X), ScaleToVcl(Y), Text);
+  GetVclCanvas.TextOut(ScaleToVcl(X), ScaleToVcl(Y), Text);
+end;
+
+procedure TDpiCanvas.TextRect(ARect: TRect; X, Y: Integer; Text: string);
+begin
+  GetVclCanvas.TextRect(ARect, X, Y, Text);
 end;
 
 procedure TDpiCanvas.MoveTo(X, Y: Integer);
 begin
-  VclCanvas.MoveTo(ScaleToVcl(X), ScaleToVcl(Y));
+  GetVclCanvas.MoveTo(ScaleToVcl(X), ScaleToVcl(Y));
 end;
 
 procedure TDpiCanvas.LineTo(X, Y: Integer);
 begin
-  VclCanvas.LineTo(ScaleToVcl(X), ScaleToVcl(Y));
+  GetVclCanvas.LineTo(ScaleToVcl(X), ScaleToVcl(Y));
 end;
 
 procedure TDpiCanvas.FillRect(ARect: TRect);
 begin
-  VclCanvas.FillRect(ScaleRectToVcl(ARect));
+  GetVclCanvas.FillRect(ScaleRectToVcl(ARect));
 end;
 
 procedure TDpiCanvas.FillRect(X1, Y1, X2, Y2: Integer);
 begin
-  VclCanvas.FillRect(ScaleToVcl(X1), ScaleToVcl(Y1), ScaleToVcl(X2), ScaleToVcl(Y2));
+  GetVclCanvas.FillRect(ScaleToVcl(X1), ScaleToVcl(Y1), ScaleToVcl(X2), ScaleToVcl(Y2));
+end;
+
+procedure TDpiCanvas.Draw(X, Y: Integer; Source: TDpiGraphic);
+begin
+  GetVclCanvas.Draw(ScaleToVcl(X), ScaleToVcl(Y), Source.GetVclGraphic);
+end;
+
+procedure TDpiCanvas.CopyRect(Dest: TRect; SrcCanvas: TDpiCanvas;
+  Source: TRect);
+begin
+  GetVclCanvas.CopyRect(Dest, SrcCanvas.VclCanvas, Source);
 end;
 
@@ -559 +999 @@
 end;
 
+function TDpiGraphicControl.GetOnPaint: TNotifyEvent;
+begin
+  Result := nil;
+end;
+
+procedure TDpiGraphicControl.SetOnPaint(AValue: TNotifyEvent);
+begin
+
+end;
+
 procedure TDpiGraphicControl.Paint;
 begin
+end;
+
+function TDpiGraphicControl.GetVclControl: TControl;
+begin
+  Result := GetVclGraphicControl;
+end;
+
+function TDpiGraphicControl.GetVclGraphicControl: TGraphicControl;
+begin
+  Result := nil;
 end;
 
@@ -619 +1079 @@
 procedure TDpiFont.SetStyle(AValue: TFontStyles);
 begin
-  VclFont.Style := AValue;
+  GetVclFont.Style := AValue;
 end;
 
@@ -625 +1085 @@
 begin
   DoChange;
+end;
+
+function TDpiFont.GetVclFont: TFont;
+begin
+  if not Assigned(VclFont) then VclFont := TFont.Create;
+  Result := VclFont;
 end;
 
@@ -635 +1101 @@
 procedure TDpiFont.SetPixelsPerInch(AValue: Integer);
 begin
-  VclFont.PixelsPerInch := PixelsPerInch;
+  GetVclFont.PixelsPerInch := PixelsPerInch;
 end;
 
 function TDpiFont.GetName: string;
 begin
-  Result := VclFont.Name;
+  Result := GetVclFont.Name;
 end;
 
 function TDpiFont.GetColor: TColor;
 begin
-  Result := VclFont.Color;
+  Result := GetVclFont.Color;
 end;
 
 function TDpiFont.GetPixelsPerInch: Integer;
 begin
-  Result := VclFont.PixelsPerInch;
+  Result := GetVclFont.PixelsPerInch;
 end;
 
 function TDpiFont.GetStyle: TFontStyles;
 begin
-  Result := VclFont.Style;
+  Result := GetVclFont.Style;
 end;
 
 procedure TDpiFont.SetColor(AValue: TColor);
 begin
-  VclFont.Color := AValue;
+  GetVclFont.Color := AValue;
 end;
 
 procedure TDpiFont.SetName(AValue: string);
 begin
-  VclFont.Name := AValue;
+  GetVclFont.Name := AValue;
 end;
 
@@ -680 +1146 @@
 procedure TDpiFont.Assign(Source: TDpiFont);
 begin
-  VclFont.Assign(Source.VclFont);
+  GetVclFont.Assign(Source.GetVclFont);
   Size := Source.Size;
   FOnChange := Source.FOnChange;
@@ -692 +1158 @@
 end;
 
+function TDpiWinControl.GetOnKeyDown: TKeyEvent;
+begin
+  Result := GetVclWinControl.OnKeyDown;
+end;
+
+function TDpiWinControl.GetOnKeyPress: TKeyPressEvent;
+begin
+  Result := GetVclWinControl.OnKeyPress;
+end;
+
+function TDpiWinControl.GetOnKeyUp: TKeyEvent;
+begin
+  Result := GetVclWinControl.OnKeyUp;
+end;
+
 procedure TDpiWinControl.SetHandle(AValue: HWND);
 begin
   GetVclWinControl.Handle := AValue;
+end;
+
+procedure TDpiWinControl.SetOnKeyDown(AValue: TKeyEvent);
+begin
+  GetVclWinControl.OnKeyDown := AValue;
+end;
+
+procedure TDpiWinControl.SetOnKeyPress(AValue: TKeyPressEvent);
+begin
+  GetVclWinControl.OnKeyPress := AValue;
+end;
+
+procedure TDpiWinControl.SetOnKeyUp(AValue: TKeyEvent);
+begin
+  GetVclWinControl.OnKeyUp := AValue;
+
+end;
+
+function TDpiWinControl.GetVclControl: TControl;
+begin
+  Result := GetVclWinControl;
 end;
 
@@ -746 +1248 @@
 begin
   Result := ScaleFromVcl(Screen.Height);
+end;
+
+function TDpiScreen.GetFormCount: Integer;
+begin
+  Result := Forms.Count;
+end;
+
+function TDpiScreen.GetActiveForm: TDpiForm;
+begin
+  Result := FActiveForm;
 end;
 
@@ -868 +1380 @@
 begin
   GetVclControl.Repaint;
+end;
+
+procedure TDpiControl.Update;
+begin
+  GetVclControl.Update;
 end;
 
@@ -922 +1439 @@
 end;
 
+procedure TDpiControl.SetHint(AValue: string);
+begin
+  GetVclControl.Hint := AValue;
+end;
+
 function TDpiControl.GetBoundsRect: TRect;
 begin
@@ -930 +1452 @@
 end;
 
+function TDpiControl.GetAlign: TAlign;
+begin
+  Result := GetVclControl.Align;
+end;
+
 function TDpiControl.GetClientHeight: Integer;
 begin
@@ -945 +1472 @@
 end;
 
+function TDpiControl.GetHint: string;
+begin
+  Result := GetVclControl.Hint;
+end;
+
 function TDpiControl.GetOnClick: TNotifyEvent;
 begin
@@ -960 +1492 @@
 end;
 
+procedure TDpiControl.SetAlign(AValue: TAlign);
+begin
+  GetVclControl.Align := AValue;
+end;
+
 procedure TDpiControl.SetBoundsRect(AValue: TRect);
 begin
   SetBounds(AValue.Left, AValue.Top, AValue.Right - AValue.Left, AValue.Bottom - AValue.Top);
+end;
+
+procedure TDpiControl.SetClientHeight(AValue: Integer);
+begin
+  GetVclControl.ClientHeight := ScaletoVcl(AValue);
+end;
+
+procedure TDpiControl.SetClientWidth(AValue: Integer);
+begin
+  GetVclControl.ClientWidth := ScaletoVcl(AValue);
 end;
 
@@ -1064 +1611 @@
 { TDpiForm }
 
+function TDpiForm.GetBorderIcons: TBorderIcons;
+begin
+  Result := VclForm.BorderIcons;
+end;
+
 function TDpiForm.GetBorderStyle: TBorderStyle;
 begin
@@ -1074 +1626 @@
 end;
 
+function TDpiForm.GetFormState: TFormState;
+begin
+  Result := VclForm.FormState;
+end;
+
+function TDpiForm.GetModalResult: TModalResult;
+begin
+  Result := VclForm.ModalResult;
+end;
+
+function TDpiForm.GetOnClose: TCloseEvent;
+begin
+  Result := VclForm.OnClose;
+end;
+
 function TDpiForm.GetOnCreate: TNotifyEvent;
 begin
@@ -1079 +1646 @@
 end;
 
+function TDpiForm.GetOnDeactivate: TNotifyEvent;
+begin
+  Result := VclForm.OnDeactivate;
+end;
+
 function TDpiForm.GetOnDestroy: TNotifyEvent;
 begin
@@ -1094 +1666 @@
 end;
 
+procedure TDpiForm.SetBorderIcons(AValue: TBorderIcons);
+begin
+  VclForm.BorderIcons := AValue;
+end;
+
 procedure TDpiForm.SetBorderStyle(AValue: TBorderStyle);
 begin
@@ -1099 +1676 @@
 end;
 
+procedure TDpiForm.SetModalResult(AValue: TModalResult);
+begin
+  VclForm.ModalResult := AValue;
+end;
+
+procedure TDpiForm.SetOnClose(AValue: TCloseEvent);
+begin
+  VclForm.OnClose := AValue;
+end;
+
 procedure TDpiForm.SetOnCreate(AValue: TNotifyEvent);
 begin
   VclForm.OnCreate := AValue;
+end;
+
+procedure TDpiForm.SetOnDeactivate(AValue: TNotifyEvent);
+begin
+  VclForm.OnDeactivate := AValue;
 end;
 
@@ -1123 +1715 @@
   if Assigned(VclForm.OnCreate) then
     VclForm.OnCreate(Self);
+end;
+
+procedure TDpiForm.CreateParams(var p: TCreateParams);
+begin
+  // TODO: VclForm.CreateParams(P);
 end;
 
@@ -1141 +1738 @@
 end;
 
-function TDpiForm.GetVclControl: TControl;
-begin
-  Result := GetVclWinControl;
-end;
-
-function TDpiForm.GetVclWinControl: TWinControl;
+function TDpiForm.GetVclCustomControl: TCustomControl;
+begin
+  Result := GetVclForm;
+end;
+
+function TDpiForm.GetVclForm: TForm;
 begin
   if not Assigned(VclForm) then VclForm := TForm.Create(nil);
   Result := VclForm;
+end;
+
+function TDpiForm.ShowModal: Integer;
+begin
+  Result := GetVclForm.ShowModal;
+end;
+
+procedure TDpiForm.Close;
+begin
+  GetVclForm.Close;
+end;
+
+procedure TDpiForm.BringToFront;
+begin
+  GetVclForm.BringToFront;
 end;