Ignore:
Timestamp:
Dec 1, 2023, 1:10:48 PM (12 months ago)
Author:
chronos
Message:
  • Modified: DpiControls unit split into multiple units according to their LCL names.
File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r466 r467  
    77  Generics.Collections, FormEditingIntf, ProjectIntf, Controls, StdCtrls, Graphics,
    88  ComCtrls, ExtCtrls, LCLType, GraphType, Types, CustApp, LMessages, LCLIntf,
    9   Menus, Math, PixelPointer2, Grids, Spin;
    10 
    11 const
    12   FixedDpi = 192;
     9  Menus, Math, PixelPointer2, Grids, Spin, Dpi.Forms, Dpi.Controls, Dpi.Graphics;
    1310
    1411type
    15   TMessageEvent = procedure (var TheMessage : TLMessage) of object;
    16 
    17   { TFormEx }
    18 
    19   TFormEx = class(TForm)
    20   private
    21     FOnMessage: TMessageEvent;
    22   protected
    23     procedure WndProc(var TheMessage : TLMessage); override;
    24     property OnMessage: TMessageEvent read FOnMessage write FOnMessage;
    25   end;
    26 
    27   { TGraphicControlEx }
    28 
    29   TGraphicControlEx = class(TGraphicControl)
    30   public
    31     property OnPaint;
    32     procedure Paint; override;
    33   end;
    34 
    35   { TControlEx }
    36 
    37   TControlEx = class(TControl)
    38   public
    39     property OnMouseDown;
    40     property OnMouseUp;
    41     property OnMouseMove;
    42     property OnMouseWheel;
    43     property OnMouseLeave;
    44     property OnMouseEnter;
    45     property OnDblClick;
    46     property ParentFont;
    47   end;
    48 
    49   TWinControlEx = class(TWinControl)
    50   public
    51     property BorderStyle;
    52     property OnKeyDown;
    53   end;
    5412
    5513  { TDpiFormFileDesc }
    … …  
    6321  end;
    6422
    65   { TDpiFont }
    66 
    67   TDpiFont = class(TPersistent)
    68   private
    69     FNativeFont: TFont;
    70     FNativeFontFree: Boolean;
    71     FOnChange: TNotifyEvent;
    72     FSize: Integer;
    73     FHeight: Integer;
    74     FPixelsPerInch: Integer;
    75     FColor: TColor;
    76     function GetCharSet: TFontCharSet;
    77     function GetColor: TColor;
    78     function GetHeight: Integer;
    79     function GetName: string;
    80     function GetPixelsPerInch: Integer;
    81     function GetSize: Integer;
    82     function GetStyle: TFontStyles;
    83     function IsNameStored: Boolean;
    84     procedure SetCharSet(AValue: TFontCharSet);
    85     procedure SetColor(AValue: TColor);
    86     procedure SetHeight(AValue: Integer);
    87     procedure SetName(AValue: string);
    88     procedure SetNativeFont(AValue: TFont);
    89     procedure SetPixelsPerInch(AValue: Integer);
    90     procedure SetSize(AValue: Integer);
    91     procedure DoChange;
    92     procedure SetStyle(AValue: TFontStyles);
    93     procedure UpdateFont;
    94   protected
    95     procedure ScreenChanged;
    96     function GetNativeFont: TFont; virtual;
    97   public
    98     property NativeFont: TFont read FNativeFont write SetNativeFont;
    99     constructor Create;
    100     destructor Destroy; override;
    101     procedure Assign(Source: TPersistent); override;
    102     procedure GetTextSize(Text: string; var w, h: Integer);
    103     function GetTextHeight(Text: string): Integer;
    104     function GetTextWidth(Text: string): Integer;
    105   published
    106     property CharSet: TFontCharSet read GetCharSet write SetCharSet default DEFAULT_CHARSET;
    107     property Color: TColor read GetColor write SetColor;
    108     property Name: string read GetName write SetName stored IsNameStored;
    109     property Style: TFontStyles read GetStyle write SetStyle default [];
    110     property Size: Integer read GetSize write SetSize stored false;
    111     property PixelsPerInch: Integer read GetPixelsPerInch write SetPixelsPerInch;
    112     property Height: Integer read GetHeight write SetHeight default 0;
    113     property OnChange: TNotifyEvent read FOnChange write FOnChange;
    114   end;
    115 
    116   { TDpiSizeConstraints }
    117 
    118   TDpiSizeConstraints = class(TPersistent)
    119   private
    120     FMaxHeight: TConstraintSize;
    121     FMaxWidth: TConstraintSize;
    122     FMinHeight: TConstraintSize;
    123     FMinWidth: TConstraintSize;
    124     procedure SetMaxHeight(AValue: TConstraintSize);
    125     procedure SetMaxWidth(AValue: TConstraintSize);
    126     procedure SetMinHeight(AValue: TConstraintSize);
    127     procedure SetMinWidth(AValue: TConstraintSize);
    128   published
    129     property MaxHeight: TConstraintSize read FMaxHeight write SetMaxHeight default 0;
    130     property MaxWidth: TConstraintSize read FMaxWidth write SetMaxWidth default 0;
    131     property MinHeight: TConstraintSize read FMinHeight write SetMinHeight default 0;
    132     property MinWidth: TConstraintSize read FMinWidth write SetMinWidth default 0;
    133   end;
    134 
    135 
    136   TDpiWinControl = class;
    137   TDpiControlBorderSpacing = class;
    138 
    139   { TDpiControl }
    140 
    141   TDpiControl = class(TComponent)
    142   private
    143     FBorderSpacing: TDpiControlBorderSpacing;
    144     FConstraints: TDpiSizeConstraints;
    145     FFont: TDpiFont;
    146     FHeight: Integer;
    147     FLeft: Integer;
    148     FOnChangeBounds: TNotifyEvent;
    149     FOnMouseUp: TMouseEvent;
    150     FOnMouseDown: TMouseEvent;
    151     FOnMouseMove: TMouseMoveEvent;
    152     FOnMouseEnter: TNotifyEvent;
    153     FOnMouseLeave: TNotifyEvent;
    154     FOnMouseWheel: TMouseWheelEvent;
    155     FOnResize: TNotifyEvent;
    156     FTop: Integer;
    157     FWidth: Integer;
    158     FParent: TDpiWinControl;
    159     function GetAlign: TAlign;
    160     function GetAnchors: TAnchors;
    161     function GetAutoSize: Boolean;
    162     function GetBoundsRect: TRect;
    163     function GetClientHeight: Integer;
    164     function GetClientWidth: Integer;
    165     function GetColor: TColor;
    166     function GetCursor: TCursor;
    167     function GetEnabled: Boolean;
    168     function GetHint: string;
    169     function GetOnClick: TNotifyEvent;
    170     function GetOnDblClick: TNotifyEvent;
    171     function GetParentFont: Boolean;
    172     function GetShowHint: Boolean;
    173     function GetVisible: Boolean;
    174     function GetWindowProc: TWndMethod;
    175     function IsAnchorsStored: Boolean;
    176     procedure SetAlign(AValue: TAlign);
    177     procedure SetAnchors(AValue: TAnchors);
    178     procedure SetAutoSize(AValue: Boolean);
    179     procedure SetBorderSpacing(AValue: TDpiControlBorderSpacing);
    180     procedure SetBoundsRect(AValue: TRect);
    181     procedure SetClientHeight(AValue: Integer);
    182     procedure SetClientWidth(AValue: Integer);
    183     procedure SetColor(AValue: TColor);
    184     procedure SetCursor(AValue: TCursor);
    185     procedure SetEnabled(AValue: Boolean);
    186     procedure SetFont(AValue: TDpiFont);
    187     procedure SetHint(AValue: string);
    188     procedure SetOnClick(AValue: TNotifyEvent);
    189     procedure SetOnDblClick(AValue: TNotifyEvent);
    190     procedure SetParentFont(AValue: Boolean);
    191     procedure SetShowHint(AValue: Boolean);
    192     procedure NativeFormResize(Sender: TObject);
    193     procedure NativeChangeBounds(Sender: TObject);
    194     procedure DoFormResize;
    195     procedure DoChangeBounds;
    196     procedure MouseDownHandler(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
    197       X, Y: Integer); virtual;
    198     procedure MouseUpHandler(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
    199       X, Y: Integer); virtual;
    200     procedure MouseMoveHandler(Sender: TObject; Shift: TShiftState; X, Y: Integer); virtual;
    201     procedure MouseWheelHandler(Sender: TObject; Shift: TShiftState;
    202          WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); virtual;
    203     procedure MouseLeaveHandler(Sender: TObject); virtual;
    204     procedure MouseEnterHandler(Sender: TObject); virtual;
    205     procedure SetWindowProc(AValue: TWndMethod);
    206   protected
    207     procedure DoBorderSpacingChange(Sender: TObject; InnerSpaceChanged: Boolean); virtual;
    208     function GetText: TCaption; virtual;
    209     procedure SetText(AValue: TCaption); virtual;
    210     procedure UpdateBounds; virtual;
    211     procedure FontChanged(Sender: TObject); virtual;
    212     function GetCaption: string; virtual;
    213     procedure SetParent(AValue: TDpiWinControl); virtual;
    214     procedure SetCaption(AValue: string); virtual;
    215     procedure SetHeight(AValue: Integer); virtual;
    216     procedure SetLeft(AValue: Integer); virtual;
    217     procedure SetTop(AValue: Integer); virtual;
    218     procedure SetVisible(AValue: Boolean); virtual;
    219     procedure SetWidth(AValue: Integer); virtual;
    220     function GetNativeControl: TControl; virtual;
    221     procedure UpdateNativeControl; virtual;
    222     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
    223       X, Y: Integer); virtual;
    224     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
    225       X, Y: Integer); virtual;
    226     procedure MouseMove(Shift: TShiftState; X, Y: Integer); virtual;
    227     procedure MouseLeave; virtual;
    228     procedure MouseEnter; virtual;
    229     property Text: TCaption read GetText write SetText;
    230     property ParentFont: Boolean read GetParentFont write SetParentFont default True;
    231   public
    232     function ScreenToClient(const APoint: TPoint): TPoint; virtual;
    233     function ClientToScreen(const APoint: TPoint): TPoint; virtual;
    234     procedure AddHandlerOnVisibleChanged(const OnVisibleChangedEvent: TNotifyEvent;
    235                                          AsFirst: boolean = false);
    236     procedure RemoveHandlerOnVisibleChanged(const OnVisibleChangedEvent: TNotifyEvent);
    237     procedure ScreenChanged; virtual;
    238     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); virtual;
    239     procedure Show;
    240     procedure Hide;
    241     procedure Invalidate;
    242     procedure Repaint;
    243     procedure Update;
    244     procedure Refresh;
    245     function IsParentOf(AControl: TDpiControl): boolean; virtual;
    246     function Scale96ToScreen(const ASize: Integer): Integer;
    247     constructor Create(TheOwner: TComponent); override;
    248     destructor Destroy; override;
    249     property Parent: TDpiWinControl read FParent write SetParent;
    250     property BoundsRect: TRect read GetBoundsRect write SetBoundsRect;
    251     property Visible: Boolean read GetVisible write SetVisible;
    252     property Anchors: TAnchors read GetAnchors write SetAnchors stored IsAnchorsStored default [akLeft, akTop];
    253     property BorderSpacing: TDpiControlBorderSpacing read FBorderSpacing write SetBorderSpacing;
    254     property WindowProc: TWndMethod read GetWindowProc write SetWindowProc;
    255   published
    256     property AutoSize: Boolean read GetAutoSize write SetAutoSize default False;
    257     property ClientHeight: Integer read GetClientHeight write SetClientHeight;
    258     property ClientWidth: Integer read GetClientWidth write SetClientWidth;
    259     property Hint: string read GetHint write SetHint;
    260     property Top: Integer read FTop write SetTop;
    261     property Left: Integer read FLeft write SetLeft;
    262     property Width: Integer read FWidth write SetWidth;
    263     property Height: Integer read FHeight write SetHeight;
    264     property Caption: string read GetCaption write SetCaption;
    265     property Enabled: Boolean read GetEnabled write SetEnabled;
    266     property ShowHint: Boolean read GetShowHint write SetShowHint;
    267     property Font: TDpiFont read FFont write SetFont;
    268     property Align: TAlign read GetAlign write SetAlign;
    269     property Color: TColor read GetColor write SetColor;
    270     property Constraints: TDpiSizeConstraints read FConstraints write FConstraints;
    271     property Cursor: TCursor read GetCursor write SetCursor default crDefault;
    272     property OnResize: TNotifyEvent read FOnResize write FOnResize;
    273     property OnChangeBounds: TNotifyEvent read FOnChangeBounds write FOnChangeBounds;
    274     property OnClick: TNotifyEvent read GetOnClick write SetOnClick;
    275     property OnDblClick: TNotifyEvent read GetOnDblClick write SetOnDblClick;
    276     property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
    277     property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
    278     property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
    279     property OnMouseWheel: TMouseWheelEvent read FOnMouseWheel write FOnMouseWheel;
    280   end;
    281 
    282   TDpiControls = TObjectList<TDpiControl>;
    283 
    284   { TDpiControlBorderSpacing }
    285 
    286   TDpiControlBorderSpacing = class(TPersistent)
    287   private
    288     FAround: TSpacingSize;
    289     FBottom: TSpacingSize;
    290     FLeft: TSpacingSize;
    291     FOnChange: TNotifyEvent;
    292     FRight: TSpacingSize;
    293     FTop: TSpacingSize;
    294     FControl: TDpiControl;
    295     FDefault: PControlBorderSpacingDefault;
    296     function IsAroundStored: Boolean;
    297     function IsBottomStored: Boolean;
    298     function IsLeftStored: Boolean;
    299     function IsRightStored: Boolean;
    300     function IsTopStored: Boolean;
    301     procedure SetAround(AValue: TSpacingSize);
    302     procedure SetBottom(AValue: TSpacingSize);
    303     procedure SetLeft(AValue: TSpacingSize);
    304     procedure SetRight(AValue: TSpacingSize);
    305     procedure SetTop(AValue: TSpacingSize);
    306     procedure Change(InnerSpaceChanged: Boolean); virtual;
    307   public
    308     constructor Create(OwnerControl: TDpiControl; ADefault: PControlBorderSpacingDefault = nil);
    309   published
    310     property OnChange: TNotifyEvent read FOnChange write FOnChange;
    311     property Around: TSpacingSize read FAround write SetAround stored IsAroundStored;
    312     property Left: TSpacingSize read FLeft write SetLeft stored IsLeftStored;
    313     property Top: TSpacingSize read FTop write SetTop stored IsTopStored;
    314     property Right: TSpacingSize read FRight write SetRight stored IsRightStored;
    315     property Bottom: TSpacingSize read FBottom write SetBottom stored IsBottomStored;
    316   end;
    317 
    318   { TDpiGraphic }
    319 
    320   TDpiGraphic = class(TPersistent)
    321   protected
    322     FDpi: Integer;
    323     function GetNativeGraphic: TGraphic; virtual;
    324     function GetWidth: Integer; virtual; abstract;
    325     function GetHeight: Integer; virtual; abstract;
    326     procedure SetWidth(Value: Integer); virtual; abstract;
    327     procedure SetHeight(Value: Integer); virtual; abstract;
    328     procedure ScreenChanged; virtual;
    329     procedure SetDpi(AValue: Integer); virtual;
    330     function GetDpi: Integer; virtual;
    331   public
    332     NativeGraphicClass: TGraphicClass;
    333     constructor Create; virtual;
    334     procedure LoadFromFile(const Filename: string); virtual;
    335     procedure SaveToFile(const Filename: string); virtual;
    336     property Width: Integer read GetWidth write SetWidth;
    337     property Height: Integer read GetHeight write SetHeight;
    338     property Dpi: Integer read GetDpi write SetDpi;
    339   end;
    340 
    341   { TDpiRasterImage }
    342 
    343   TDpiRasterImage = class(TDpiGraphic)
    344   private
    345     function GetRawImage: TRawImage;
    346   protected
    347     function GetNativeGraphic: TGraphic; override;
    348     function GetNativeRasterImage: TRasterImage; virtual;
    349   public
    350     procedure BeginUpdate(ACanvasOnly: Boolean = False);
    351     procedure EndUpdate(AStreamIsValid: Boolean = False);
    352     property RawImage: TRawImage read GetRawImage;
    353   end;
    354 
    355   { TDpiPen }
    356 
    357   TDpiPen = class
    358     FWidth: Integer;
    359     FNativePen: TPen;
    360     FNativePenFree: Boolean;
    361   private
    362     function GetColor: TColor;
    363     function GetStyle: TPenStyle;
    364     function GetWidth: Integer;
    365     procedure SetColor(AValue: TColor);
    366     procedure SetNativePen(AValue: TPen);
    367     procedure SetStyle(AValue: TPenStyle);
    368     procedure SetWidth(AValue: Integer);
    369   public
    370     constructor Create;
    371     destructor Destroy; override;
    372     function GetNativePen: TPen;
    373     procedure Assign(Source: TDpiPen);
    374     property NativePen: TPen read FNativePen write SetNativePen;
    375   published
    376     property Color: TColor read GetColor write SetColor default clBlack;
    377     property Style : TPenStyle read GetStyle write SetStyle default psSolid;
    378     property Width: Integer read GetWidth write SetWidth default 1;
    379   end;
    380 
    381   { TDpiBrush }
    382 
    383   TDpiBrush = class
    384   private
    385     FNativeBrush: TBrush;
    386     FNativeBrushFree: Boolean;
    387     function GetColor: TColor;
    388     function GetStyle: TBrushStyle;
    389     procedure SetColor(AValue: TColor);
    390     function GetNativeBrush: TBrush;
    391     procedure SetNativeBrush(AValue: TBrush);
    392     procedure SetStyle(AValue: TBrushStyle);
    393   public
    394     constructor Create;
    395     destructor Destroy; override;
    396     procedure Assign(Source: TDpiBrush);
    397     property NativeBrush: TBrush read FNativeBrush write SetNativeBrush;
    398   published
    399     property Color: TColor read GetColor write SetColor default clWhite;
    400     property Style: TBrushStyle read GetStyle write SetStyle default bsSolid;
    401   end;
    402 
    403   { TDpiCanvas }
    404 
    405   TDpiCanvas = class
    406   private
    407     FBrush: TDpiBrush;
    408     FBrushFree: Boolean;
    409     FPen: TDpiPen;
    410     FPenFree: Boolean;
    411     FFont: TDpiFont;
    412     FFontFree: Boolean;
    413     FNativeCanvas: TCanvas;
    414     FNativeCanvasFree: Boolean;
    415     function GetHandle: HDC;
    416     function GetPixel(X, Y: Integer): TColor;
    417     procedure SetBrush(AValue: TDpiBrush);
    418     procedure SetFont(AValue: TDpiFont);
    419     procedure SetHandle(AValue: HDC);
    420     procedure SetPen(AValue: TDpiPen);
    421     procedure SetPixel(X, Y: Integer; AValue: TColor);
    422     procedure SetNativeCanvas(AValue: TCanvas);
    423   protected
    424     procedure DoLine(X1, Y1, X2, Y2: Integer); virtual;
    425     procedure DoTextOut(X, Y: Integer; Text: string); virtual;
    426     procedure DoRectangle(const Bounds: TRect); virtual;
    427     procedure DoRectangleFill(const Bounds: TRect); virtual;
    428     procedure DoPolygon(const Points: array of TPoint); virtual;
    429     procedure CreateHandle; virtual;
    430     procedure DoEllipse(const Bounds: TRect); virtual;
    431     procedure DoMoveTo(X, Y: Integer); virtual;
    432     procedure DoLineTo(X, Y: Integer); virtual;
    433     procedure DoPolyline(const Points: array of TPoint); virtual;
    434     procedure DoPolyBezier(Points: PPoint; NumPts: Integer;
    435       Filled: Boolean = False; Continuous: Boolean = False); virtual;
    436     procedure SetHeight(AValue: Integer); virtual;
    437     procedure SetWidth(AValue: Integer); virtual;
    438     function GetWidth: Integer; virtual;
    439     function GetHeight: Integer; virtual;
    440     function GetNativeCanvas: TCanvas; virtual;
    441   public
    442     property NativeCanvas: TCanvas read FNativeCanvas write SetNativeCanvas;
    443     procedure RoundRect(const Rect: TRect; RX, RY: Integer); overload;
    444     procedure RoundRect(X1, Y1, X2, Y2: Integer; RX,RY: Integer); overload; virtual;
    445     procedure Polygon(const Points: array of TPoint; Winding: Boolean;
    446       StartIndex: Integer = 0; NumPts: Integer = -1); overload;
    447     procedure Polygon(Points: PPoint; NumPts: Integer; Winding: Boolean = False); virtual; overload;
    448     procedure Polygon(const Points: array of TPoint); overload;
    449     procedure PolyBezier(const Points: array of TPoint;
    450       Filled: Boolean = False; Continuous: boolean = True); overload;
    451     procedure PolyBezier(Points: PPoint; NumPts: Integer;
    452       Filled: Boolean = False; Continuous: Boolean = True); virtual; overload;
    453     procedure Polyline(const Points: array of TPoint); overload;
    454     procedure Polyline(Points: PPoint; NumPts: Integer); virtual; overload;
    455     procedure Ellipse(x1, y1, x2, y2: Integer); virtual; overload;
    456     procedure Ellipse(const ARect: TRect); virtual; overload;
    457     procedure StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic); virtual; overload;
    458     procedure StretchDraw(const DestRect: TRect; SrcGraphic: TDpiGraphic); virtual; overload;
    459     procedure Pie(EllipseX1, EllipseY1, EllipseX2, EllipseY2,
    460       StartX, StartY, EndX, EndY: Integer); virtual;
    461     procedure FrameRect(Rect: TRect);
    462     procedure Rectangle(X1, Y1, X2, Y2: Integer); overload;
    463     procedure Rectangle(const ARect: TRect); overload;
    464     function TextWidth(const Text: string): Integer;
    465     function TextHeight(const Text: string): Integer;
    466     function TextExtent(const Text: string): TSize; virtual;
    467     procedure TextOut(X, Y: Integer; const Text: string); virtual;
    468     procedure TextRect(ARect: TRect; X, Y: Integer; Text: string);
    469     procedure MoveTo(X, Y: Integer);
    470     procedure LineTo(X, Y: Integer);
    471     procedure Line(const p1, p2: TPoint);
    472     procedure FillRect(const ARect: TRect); virtual; overload;
    473     procedure FillRect(X1, Y1, X2, Y2: Integer); overload;
    474     procedure Draw(X, Y: Integer; Source: TDpiGraphic);
    475     procedure CopyRect(Dest: TRect; SrcCanvas: TDpiCanvas; Source: TRect);
    476     constructor Create;
    477     destructor Destroy; override;
    478     property Handle: HDC read GetHandle write SetHandle;
    479     property Pixels[X, Y: Integer]: TColor read GetPixel write SetPixel;
    480     property Width: Integer read GetWidth;
    481     property Height: Integer read GetHeight;
    482   published
    483     property Brush: TDpiBrush read FBrush write SetBrush;
    484     property Pen: TDpiPen read FPen write SetPen;
    485     property Font: TDpiFont read FFont write SetFont;
    486   end;
    487 
    488   { TDpiGraphicControl }
    489 
    490   TDpiGraphicControl = class(TDpiControl)
    491   private
    492     FOnPaint: TNotifyEvent;
    493     NativeGraphicControl: TGraphicControl;
    494     FCanvas: TDpiCanvas;
    495     function GetOnPaint: TNotifyEvent;
    496     procedure SetCanvas(AValue: TDpiCanvas);
    497     procedure PaintHandler(Sender: TObject);
    498     procedure SetOnPaint(AValue: TNotifyEvent);
    499   protected
    500     procedure Paint; virtual;
    501     function GetNativeControl: TControl; override;
    502     function GetNativeGraphicControl: TGraphicControl; virtual;
    503     procedure UpdateNativeControl; override;
    504     property OnPaint: TNotifyEvent read GetOnPaint write SetOnPaint;
    505   public
    506     constructor Create(TheOwner: TComponent); override;
    507     destructor Destroy; override;
    508   published
    509     property Canvas: TDpiCanvas read FCanvas write SetCanvas;
    510   end;
    511 
    512   { TDpiWinControl }
    513 
    514   TDpiWinControl = class(TDpiControl)
    515   private
    516     FOnKeyDown: TKeyEvent;
    517     function GetBorderStyle: TBorderStyle;
    518     function GetHandle: HWND;
    519     function GetOnKeyDown: TKeyEvent;
    520     function GetOnKeyPress: TKeyPressEvent;
    521     function GetOnKeyUp: TKeyEvent;
    522     function GetTabOrder: TTabOrder;
    523     function GetTabStop: Boolean;
    524     procedure SetBorderStyle(AValue: TBorderStyle);
    525     procedure SetHandle(AValue: HWND);
    526     procedure SetOnKeyDown(AValue: TKeyEvent);
    527     procedure SetOnKeyPress(AValue: TKeyPressEvent);
    528     procedure SetOnKeyUp(AValue: TKeyEvent);
    529     procedure SetTabOrder(AValue: TTabOrder);
    530     procedure SetTabStop(AValue: Boolean);
    531     procedure KeyDownHandler(Sender: TObject; var Key: Word; Shift: TShiftState);
    532   protected
    533     procedure UpdateNativeControl; override;
    534     function GetNativeControl: TControl; override;
    535     function GetNativeWinControl: TWinControl; virtual;
    536     property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle default bsNone;
    537     procedure KeyDown(var Key: Word; Shift: TShiftState); virtual;
    538   public
    539     Controls: TDpiControls;
    540     procedure ScreenChanged; override;
    541     function ControlCount: Integer;
    542     procedure SetFocus; virtual;
    543     constructor Create(TheOwner: TComponent); override;
    544     destructor Destroy; override;
    545     property Handle: HWND read GetHandle write SetHandle;
    546   published
    547     property TabOrder: TTabOrder read GetTabOrder write SetTabOrder default -1;
    548     property TabStop: Boolean read GetTabStop write SetTabStop default False;
    549     property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown;
    550     property OnKeyPress: TKeyPressEvent read GetOnKeyPress write SetOnKeyPress;
    551     property OnKeyUp: TKeyEvent read GetOnKeyUp write SetOnKeyUp;
    552   end;
    553 
    554   { TDpiCustomControl }
    555 
    556   TDpiCustomControl = class(TDpiWinControl)
    557   private
    558     FCanvas: TDpiCanvas;
    559     function GetCanvas: TDpiCanvas;
    560     function GetOnPaint: TNotifyEvent;
    561     function GetPixelsPerInch: Integer;
    562     procedure SetOnPaint(AValue: TNotifyEvent);
    563     procedure SetPixelsPerInch(AValue: Integer);
    564   protected
    565     function GetNativeWinControl: TWinControl; override;
    566     function GetNativeCustomControl: TCustomControl; virtual;
    567   public
    568     constructor Create(TheOwner: TComponent); override;
    569     destructor Destroy; override;
    570     property Canvas: TDpiCanvas read GetCanvas;
    571   published
    572     property PixelsPerInch: Integer read GetPixelsPerInch write SetPixelsPerInch stored False;
    573     property OnPaint: TNotifyEvent read GetOnPaint write SetOnPaint;
    574   end;
    575 
    576   { TDpiControlScrollBar }
    577 
    578   TDpiControlScrollBar = class(TPersistent)
    579   private
    580     function GetVisible: Boolean;
    581     procedure SetVisible(AValue: Boolean);
    582   published
    583     property Visible: Boolean read GetVisible write SetVisible;
    584   end;
    585 
    586   { TDpiScrollingWinControl }
    587 
    588   TDpiScrollingWinControl = class(TDpiCustomControl)
    589   private
    590     FHorzScrollBar: TDpiControlScrollBar;
    591     FVertScrollBar: TDpiControlScrollBar;
    592   protected
    593     function GetNativeCustomControl: TCustomControl; override;
    594     function GetNativeScrollingWinControl: TScrollingWinControl; virtual;
    595   public
    596     constructor Create(TheOwner: TComponent); override;
    597     destructor Destroy; override;
    598   published
    599     property HorzScrollBar: TDpiControlScrollBar read FHorzScrollBar write FHorzScrollBar;
    600     property VertScrollBar: TDpiControlScrollBar read FVertScrollBar write FVertScrollBar;
    601   end;
    602 
    603   { TDpiForm }
    604 
    605   TDpiForm = class(TDpiScrollingWinControl)
    606   private
    607     FOnActivate: TNotifyEvent;
    608     FOnClose: TCloseEvent;
    609     FOnCloseQuery: TCloseQueryEvent;
    610     FOnDeactivate: TNotifyEvent;
    611     function GetBorderIcons: TBorderIcons;
    612     function GetBorderStyle: TFormBorderStyle;
    613     function GetDesignTimePPI: Integer;
    614     function GetFormState: TFormState;
    615     function GetFormStyle: TFormStyle;
    616     function GetKeyPreview: Boolean;
    617     function GetLCLVersion: string;
    618     function GetModalResult: TModalResult;
    619     function GetOnCloseQuery: TCloseQueryEvent;
    620     function GetOnCreate: TNotifyEvent;
    621     function GetOnDeactivate: TNotifyEvent;
    622     function GetOnDestroy: TNotifyEvent;
    623     function GetOnHide: TNotifyEvent;
    624     function GetOnShow: TNotifyEvent;
    625     function GetPosition: TPosition;
    626     function GetRestoredHeight: Integer;
    627     function GetRestoredLeft: Integer;
    628     function GetRestoredTop: Integer;
    629     function GetRestoredWidth: Integer;
    630     function GetShowInTaskbar: TShowInTaskbar;
    631     function GetWindowState: TWindowState;
    632     procedure SetBorderIcons(AValue: TBorderIcons);
    633     procedure SetBorderStyle(AValue: TFormBorderStyle);
    634     procedure SetDesignTimePPI(AValue: Integer);
    635     procedure SetFormStyle(AValue: TFormStyle);
    636     procedure SetKeyPreview(AValue: Boolean);
    637     procedure SetLCLVersion(AValue: string);
    638     procedure SetModalResult(AValue: TModalResult);
    639     procedure SetOnCloseQuery(AValue: TCloseQueryEvent);
    640     procedure SetOnCreate(AValue: TNotifyEvent);
    641     procedure SetOnDeactivate(AValue: TNotifyEvent);
    642     procedure SetOnDestroy(AValue: TNotifyEvent);
    643     procedure SetOnHide(AValue: TNotifyEvent);
    644     procedure SetOnShow(AValue: TNotifyEvent);
    645     procedure DoOnCreate;
    646     procedure FormMessageHandler(var TheMessage: TLMessage);
    647     procedure SetPosition(AValue: TPosition);
    648     procedure SetShowInTaskBar(AValue: TShowInTaskbar);
    649     procedure SetWindowState(AValue: TWindowState);
    650     procedure ActivateHandler(Sender: TObject);
    651     procedure DeactivateHandler(Sender: TObject);
    652     procedure DoClose(var CloseAction: TCloseAction); virtual;
    653     procedure CloseHandler(Sender: TObject; var CloseAction: TCloseAction);
    654     procedure CloseQueryHandler(Sender : TObject; var CanClose : boolean);
    655   protected
    656     procedure CreateParams(var p: TCreateParams); virtual;
    657     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    658     function GetNativeScrollingWinControl: TScrollingWinControl; override;
    659     function GetNativeForm: TForm; virtual;
    660     procedure UpdateNativeControl; override;
    661   public
    662     NativeForm: TForm;
    663     procedure AfterConstruction; override;
    664     property ModalResult: TModalResult read GetModalResult write SetModalResult;
    665     function ShowModal: Integer; virtual;
    666     procedure SetFocus; override;
    667     procedure Close;
    668     function CloseQuery: boolean; virtual;
    669     procedure BringToFront;
    670     procedure Release;
    671     constructor Create(TheOwner: TComponent); override;
    672     constructor CreateNew(AOwner: TComponent; Num: Integer = 0); virtual;
    673     destructor Destroy; override;
    674   published
    675     property RestoredLeft: integer read GetRestoredLeft;
    676     property RestoredTop: integer read GetRestoredTop;
    677     property RestoredWidth: integer read GetRestoredWidth;
    678     property RestoredHeight: integer read GetRestoredHeight;
    679     property DesignTimePPI: Integer read GetDesignTimePPI write SetDesignTimePPI; // Not used
    680     property FormState: TFormState read GetFormState;
    681     property FormStyle: TFormStyle read GetFormStyle write SetFormStyle;
    682     property BorderStyle: TFormBorderStyle read GetBorderStyle write SetBorderStyle default bsSizeable;
    683     property BorderIcons: TBorderIcons read GetBorderIcons write SetBorderIcons;
    684     property LCLVersion: string read GetLCLVersion write SetLCLVersion;
    685     property KeyPreview: Boolean read GetKeyPreview write SetKeyPreview default False;
    686     property Position: TPosition read GetPosition write SetPosition default poDesigned;
    687     property WindowState: TWindowState read GetWindowState write SetWindowState default wsNormal;
    688     property OnShow: TNotifyEvent read GetOnShow write SetOnShow;
    689     property OnHide: TNotifyEvent read GetOnHide write SetOnHide;
    690     property OnCreate: TNotifyEvent read GetOnCreate write SetOnCreate;
    691     property OnDestroy: TNotifyEvent read GetOnDestroy write SetOnDestroy;
    692     property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
    693     property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate;
    694     property OnClose: TCloseEvent read FOnClose write FOnClose;
    695     property OnCloseQuery: TCloseQueryEvent read FOnCloseQuery write FOnCloseQuery;
    696     property ClientHeight;
    697     property ClientWidth;
    698     property OnMouseUp;
    699     property OnMouseDown;
    700     property OnMouseMove;
    701     property ShowInTaskBar: TShowInTaskbar read GetShowInTaskbar write SetShowInTaskBar
    702                                         default stDefault;
    703   end;
    704 
    705   TDpiForms = TObjectList<TDpiForm>;
    706 
    707   { TDpiEdit }
    708 
    709   TDpiEdit = class(TDpiWinControl)
    710   private
    711     function GetSelLength: Integer;
    712     function GetSelStart: Integer;
    713     procedure SetSelLength(AValue: Integer);
    714     procedure SetSelStart(AValue: Integer);
    715   protected
    716     function GetNativeWinControl: TWinControl; override;
    717     function GetNativeEdit: TEdit; virtual;
    718     function GetText: TCaption; override;
    719     procedure SetText(AValue: TCaption); override;
    720   public
    721     NativeEdit: TEdit;
    722     destructor Destroy; override;
    723     property SelLength: Integer read GetSelLength write SetSelLength;
    724     property SelStart: Integer read GetSelStart write SetSelStart;
    725   published
    726     property Text;
    727     property BorderStyle default bsSingle;
    728     property ParentFont;
    729   end;
    730 
    731   { TDpiButton }
    732 
    733   TDpiButton = class(TDpiControl)
    734   private
    735   protected
    736     function GetNativeControl: TControl; override;
    737   public
    738     NativeButton: TButton;
    739     destructor Destroy; override;
    740   published
    741     property Visible;
    742   end;
    743 
    744   { TDpiListBox }
    745 
    746   TDpiListBox = class(TDpiWinControl)
    747   private
    748     function GetBorderStyle: TBorderStyle;
    749     function GetCount: Integer;
    750     function GetExtendedSelect: Boolean;
    751     function GetIntegralHeight: Boolean;
    752     function GetItemHeight: Integer;
    753     function GetItemIndex: Integer;
    754     function GetItems: TStrings;
    755     function GetOnSelectionChange: TSelectionChangeEvent;
    756     function GetParentFont: Boolean;
    757     function GetScrollWidth: Integer;
    758     function GetTopIndex: Integer;
    759     procedure SetBorderStyle(AValue: TBorderStyle);
    760     procedure SetExtendedSelect(AValue: Boolean);
    761     procedure SetIntegralHeight(AValue: Boolean);
    762     procedure SetItemHeight(AValue: Integer);
    763     procedure SetItemIndex(AValue: Integer);
    764     procedure SetItems(AValue: TStrings);
    765     procedure SetOnSelectionChange(AValue: TSelectionChangeEvent);
    766     procedure SetParentFont(AValue: Boolean);
    767     procedure SetScrollWidth(AValue: Integer);
    768     procedure SetTopIndex(AValue: Integer);
    769   protected
    770     function GetNativeWinControl: TWinControl; override;
    771     function GetNativeListBox: TListBox; virtual;
    772   public
    773     NativeListBox: TListBox;
    774     destructor Destroy; override;
    775     property ItemIndex: Integer read GetItemIndex write SetItemIndex;
    776     property Items: TStrings read GetItems write SetItems;
    777     property Count: Integer read GetCount;
    778   published
    779     property TopIndex: Integer read GetTopIndex write SetTopIndex default 0;
    780     property ScrollWidth: Integer read GetScrollWidth write SetScrollWidth default 0;
    781     property ParentFont: Boolean read GetParentFont write SetParentFont default True;
    782     property ItemHeight: Integer read GetItemHeight write SetItemHeight;
    783     property IntegralHeight: Boolean read GetIntegralHeight write SetIntegralHeight default False;
    784     property ExtendedSelect: Boolean read GetExtendedSelect write SetExtendedSelect default true;
    785     property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle default bsNone;
    786     property Visible;
    787     property Anchors;
    788     property OnSelectionChange: TSelectionChangeEvent read GetOnSelectionChange
    789                                                       write SetOnSelectionChange;
    790   end;
    791 
    792   { TDpiScrollBar }
    793 
    794   TDpiScrollBar = class(TDpiControl)
    795   private
    796     function GetKind: TScrollBarKind;
    797     function GetMax: Integer;
    798     function GetMin: Integer;
    799     function GetOnChange: TNotifyEvent;
    800     function GetPageSize: Integer;
    801     function GetPosition: Integer;
    802     procedure SetKind(AValue: TScrollBarKind);
    803     procedure SetMax(AValue: Integer);
    804     procedure SetMin(AValue: Integer);
    805     procedure SetOnChange(AValue: TNotifyEvent);
    806     procedure SetPageSize(AValue: Integer);
    807     procedure SetPosition(AValue: Integer);
    808   protected
    809     function GetNativeControl: TControl; override;
    810   public
    811     NativeScrollBar: TScrollBar;
    812     constructor Create(TheOwner: TComponent); override;
    813     destructor Destroy; override;
    814   published
    815     property PageSize: Integer read GetPageSize write SetPageSize;
    816     property Min: Integer read GetMin write SetMin;
    817     property Max: Integer read GetMax write SetMax;
    818     property Position: Integer read GetPosition write SetPosition;
    819     property Kind: TScrollBarKind read GetKind write SetKind;
    820     property OnChange: TNotifyEvent read GetOnChange write SetOnChange;
    821     property Visible;
    822   end;
    823 
    824   { TDpiBitmap }
    825 
    826   TDpiBitmap = class(TDpiRasterImage)
    827   private
    828     FCanvas: TDpiCanvas;
    829     FWidth: Integer;
    830     FHeight: Integer;
    831     function GetCanvas: TDpiCanvas;
    832     function GetPixelFormat: TPixelFormat;
    833     function GetScanLine(Row: Integer): Pointer;
    834     function GetTransparent: Boolean;
    835     function GetTransparentColor: TColor;
    836     procedure SetPixelFormat(AValue: TPixelFormat);
    837     procedure SetTransparent(AValue: Boolean);
    838     procedure SetTransparentColor(AValue: TColor);
    839   protected
    840     function GetHeight: Integer; override;
    841     function GetWidth: Integer; override;
    842     function GetNativeBitmap: TCustomBitmap; virtual;
    843     function GetNativeRasterImage: TRasterImage; override;
    844     procedure SetHeight(AValue: Integer); override;
    845     procedure SetWidth(AValue: Integer); override;
    846     procedure ScreenChanged; override;
    847   public
    848     NativeBitmap: TBitmap;
    849     procedure BeginUpdate;
    850     procedure EndUpdate;
    851     procedure SetSize(AWidth, AHeight: Integer);
    852     constructor Create; override;
    853     destructor Destroy; override;
    854     procedure Assign(Source: TPersistent); override;
    855     property ScanLine[Row: Integer]: Pointer read GetScanLine;
    856   published
    857     property PixelFormat: TPixelFormat read GetPixelFormat write SetPixelFormat;
    858     property Height: Integer read GetHeight write SetHeight;
    859     property Width: Integer read GetWidth write SetWidth;
    860     property Canvas: TDpiCanvas read GetCanvas;
    861     property TransparentColor: TColor read GetTransparentColor
    862                                       write SetTransparentColor default clDefault;
    863     property Transparent: Boolean read GetTransparent write SetTransparent default False;
    864   end;
    865 
    866   { TDpiPicture }
    867 
    868   TDpiPicture = class(TPersistent)
    869   private
    870     FBitmap: TDpiBitmap;
    871     procedure SetBitmap(AValue: TDpiBitmap);
    872   published
    873     procedure LoadFromFile(FileName: string);
    874     property Bitmpa: TDpiBitmap read FBitmap write SetBitmap;
    875   end;
    876 
    877   { TDpiImage }
    878 
    879   TDpiImage = class(TDpiControl)
    880   private
    881     FDpiPicture: TDpiPicture;
    882     FStretch: Boolean;
    883     procedure SetPicture(AValue: TDpiPicture);
    884     procedure SetStretch(AValue: Boolean);
    885   protected
    886   public
    887     NativeImage: TImage;
    888     function GetNativeControl: TControl; override;
    889     destructor Destroy; override;
    890   published
    891     property Stretch: Boolean read FStretch write SetStretch;
    892     property Picture: TDpiPicture read FDpiPicture write SetPicture;
    893     property Visible;
    894   end;
    895 
    896   { TDpiPaintBox }
    897 
    898   TDpiPaintBox = class(TDpiGraphicControl)
    899   public
    900     NativePaintBox: TPaintBox;
    901     function GetNativeGraphicControl: TGraphicControl; override;
    902     constructor Create(TheOwner: TComponent); override;
    903     destructor Destroy; override;
    904   published
    905     property OnPaint;
    906     property Visible;
    907   end;
    908 
    909   TDpiCustomListView = class(TDpiWinControl)
    910 
    911   end;
    912 
    913   TDpiLVCustomDrawItemEvent = procedure(Sender: TDpiCustomListView; Item: TListItem;
    914     State: TCustomDrawState; var DefaultDraw: Boolean) of object;
    915 
    916   { TDpiListView }
    917 
    918   TDpiListView = class(TDpiCustomListView)
    919   private
    920     FOnCustomDrawItem: TDpiLVCustomDrawItemEvent;
    921     NativeListView: TListView;
    922     function GetCanvas: TCanvas;
    923     function GetColumns: TListColumns;
    924     function GetItems: TListItems;
    925     function GetOnChange: TLVChangeEvent;
    926     function GetOnColumnClick: TLVColumnClickEvent;
    927     function GetOnCustomDrawItem: TDpiLVCustomDrawItemEvent;
    928     function GetProperty(AIndex: Integer): Boolean;
    929     function GetViewStyle: TViewStyle;
    930     procedure SetColumns(AValue: TListColumns);
    931     procedure SetItems(AValue: TListItems);
    932     procedure SetOnChange(AValue: TLVChangeEvent);
    933     procedure SetOnColumnClick(AValue: TLVColumnClickEvent);
    934     procedure SetOnCustomDrawItem(AValue: TDpiLVCustomDrawItemEvent);
    935     procedure SetProperty(AIndex: Integer; AValue: Boolean);
    936     procedure SetViewStyle(AValue: TViewStyle);
    937     procedure DoCustomDrawItem(Sender: TCustomListView; Item: TListItem;
    938       State: TCustomDrawState; var DefaultDraw: Boolean);
    939   public
    940     function GetItemAt(x,y: integer): TListItem;
    941     function GetNativeListView: TListView;
    942     constructor Create(TheOwner: TComponent); override;
    943     destructor Destroy; override;
    944     property Columns: TListColumns read GetColumns write SetColumns;
    945     property Items: TListItems read GetItems write SetItems;
    946     property Canvas: TCanvas read GetCanvas;
    947     property Checkboxes: Boolean index Ord(lvpCheckboxes) read GetProperty write SetProperty default False;
    948   published
    949     property OnColumnClick: TLVColumnClickEvent read GetOnColumnClick
    950       write SetOnColumnClick;
    951     property OnCustomDrawItem: TDpiLVCustomDrawItemEvent read GetOnCustomDrawItem
    952       write SetOnCustomDrawItem;
    953     property ViewStyle: TViewStyle read GetViewStyle write SetViewStyle default vsList;
    954     property OnChange: TLVChangeEvent read GetOnChange write SetOnChange;
    955   end;
    956 
    957   { TDpiPanel }
    958 
    959   TDpiPanel = class(TDpiWinControl)
    960   private
    961     NativePanel: TPanel;
    962   public
    963     function GetNativePanel: TPanel;
    964     constructor Create(TheOwner: TComponent); override;
    965     destructor Destroy; override;
    966   end;
    967 
    968   { TDpiCustomDrawGrid }
    969 
    970   TDpiCustomDrawGrid = class(TDpiWinControl)
    971   private
    972     NativeCustomDrawGrid: TCustomDrawGrid;
    973     function GetEditor: TDpiWinControl;
    974     procedure SetEditor(AValue: TDpiWinControl);
    975   public
    976     function GetNativeCustomDrawGrid: TCustomDrawGrid;
    977     constructor Create(TheOwner: TComponent); override;
    978     destructor Destroy; override;
    979     property Editor: TDpiWinControl read GetEditor write SetEditor;
    980   end;
    981 
    982   { TDpiPageControl }
    983 
    984   TDpiPageControl = class(TDpiWinControl)
    985   private
    986     NativePageControl: TPageControl;
    987     function GetPageCount: Integer;
    988     function GetTabSheet(Index: Integer): TTabSheet;
    989   public
    990     function GetNativePageControl: TPageControl;
    991     constructor Create(TheOwner: TComponent); override;
    992     destructor Destroy; override;
    993     property PageCount: Integer read GetPageCount;
    994     property Pages[Index: Integer]: TTabSheet read GetTabSheet;
    995   end;
    996 
    997   { TDpiRadioButton }
    998 
    999   TDpiRadioButton = class(TDpiWinControl)
    1000   private
    1001     NativeRadioButton: TRadioButton;
    1002   public
    1003     function GetNativeRadioButton: TRadioButton;
    1004     constructor Create(TheOwner: TComponent); override;
    1005     destructor Destroy; override;
    1006   end;
    1007 
    1008   { TDpiSpinEdit }
    1009 
    1010   TDpiSpinEdit = class(TDpiWinControl)
    1011   private
    1012     NativeSpinEdit: TSpinEdit;
    1013   public
    1014     function GetNativeSpinEdit: TSpinEdit;
    1015     constructor Create(TheOwner: TComponent); override;
    1016     destructor Destroy; override;
    1017   end;
    1018 
    1019   { TDpiComboBox }
    1020 
    1021   TDpiComboBox = class(TDpiWinControl)
    1022   private
    1023     NativeComboBox: TComboBox;
    1024   public
    1025     function GetNativeComboBox: TComboBox;
    1026     constructor Create(TheOwner: TComponent); override;
    1027     destructor Destroy; override;
    1028   end;
    1029 
    1030   { TDpiCheckBox }
    1031 
    1032   TDpiCheckBox = class(TDpiWinControl)
    1033   private
    1034     NativeCheckBox: TCheckBox;
    1035   public
    1036     function GetNativeCheckBox: TCheckBox;
    1037     constructor Create(TheOwner: TComponent); override;
    1038     destructor Destroy; override;
    1039   end;
    1040 
    1041   { TDpiMemo }
    1042 
    1043   TDpiMemo = class(TDpiWinControl)
    1044   private
    1045     NativeMemo: TMemo;
    1046     function GetLines: TStrings;
    1047     function GetReadOnly: Boolean;
    1048     function GetScrollBars: TScrollStyle;
    1049     function GetWordWrap: Boolean;
    1050     procedure SetLines(AValue: TStrings);
    1051     procedure SetReadOnly(AValue: Boolean);
    1052     procedure SetScrollBars(AValue: TScrollStyle);
    1053     procedure SetWordWrap(AValue: Boolean);
    1054   protected
    1055     function GetNativeWinControl: TWinControl; override;
    1056     function GetNativeMemo: TMemo; virtual;
    1057   public
    1058     procedure Clear;
    1059     constructor Create(TheOwner: TComponent); override;
    1060     destructor Destroy; override;
    1061   published
    1062     property Lines: TStrings read GetLines write SetLines;
    1063     property WordWrap: Boolean read GetWordWrap write SetWordWrap default True;
    1064     property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    1065     property ScrollBars: TScrollStyle read GetScrollBars write SetScrollBars default ssNone;
    1066   end;
    1067 
    1068   { TDpiToolBar }
    1069 
    1070   TDpiToolBar = class(TDpiCustomControl)
    1071   private
    1072     NativeToolBar: TToolBar;
    1073     function ButtonHeightIsStored: Boolean;
    1074     function ButtonWidthIsStored: Boolean;
    1075     function GetButtonHeight: Integer;
    1076     function GetButtonWidth: Integer;
    1077     procedure SetButtonHeight(AValue: Integer);
    1078     procedure SetButtonWidth(AValue: Integer);
    1079   public
    1080     function GetNativeToolBar: TToolBar;
    1081     constructor Create(TheOwner: TComponent); override;
    1082     destructor Destroy; override;
    1083     property ButtonHeight: Integer read GetButtonHeight write SetButtonHeight stored ButtonHeightIsStored;
    1084     property ButtonWidth: Integer read GetButtonWidth write SetButtonWidth stored ButtonWidthIsStored;
    1085   end;
    1086 
    1087   { TDpiCoolBand }
    1088 
    1089   TDpiCoolBand = class(TDpiCustomControl)
    1090   private
    1091     NativeCoolBand: TCoolBand;
    1092     function GetMinHeight: Integer;
    1093     function GetMinWidth: Integer;
    1094     procedure SetMinHeight(AValue: Integer);
    1095     procedure SetMinWidth(AValue: Integer);
    1096   protected const
    1097     cDefMinHeight = 25;
    1098     cDefMinWidth = 100;
    1099   public
    1100     function GetNativeCoolBand: TCoolBand;
    1101     constructor Create(TheOwner: TComponent); override;
    1102     destructor Destroy; override;
    1103     property MinHeight: Integer read GetMinHeight write SetMinHeight default cDefMinHeight;
    1104     property MinWidth: Integer read GetMinWidth write SetMinWidth default cDefMinWidth;
    1105   end;
    1106 
    1107   { TDpiCoolBands }
    1108 
    1109   TDpiCoolBands = class(TCollection)
    1110   private
    1111     procedure SetItem(Index: Integer; AValue: TDpiCoolBand);
    1112     function GetItem(Index: Integer): TDpiCoolBand;
    1113   public
    1114     property Items[Index: Integer]: TDpiCoolBand read GetItem write SetItem; default;
    1115   end;
    1116 
    1117   { TDpiCoolBar }
    1118 
    1119   TDpiCoolBar = class(TDpiCustomControl)
    1120   private
    1121     NativeCoolBar: TCoolBar;
    1122     function GetBands: TDpiCoolBands;
    1123     function GetThemed: Boolean;
    1124     procedure SetBands(AValue: TDpiCoolBands);
    1125     procedure SetThemed(AValue: Boolean);
    1126   public
    1127     procedure BeginUpdate;
    1128     procedure EndUpdate;
    1129     function GetNativeCoolBar: TCoolBar;
    1130     constructor Create(TheOwner: TComponent); override;
    1131     destructor Destroy; override;
    1132     property Bands: TDpiCoolBands read GetBands write SetBands;
    1133     property Themed: Boolean read GetThemed write SetThemed default True;
    1134   end;
    1135 
    1136   { TDpiImageList }
    1137 
    1138   TDpiImageList = class(TComponent)
    1139   private
    1140     NativeImageList: TImageList;
    1141     function GetCount: Integer;
    1142     function GetHeight: Integer;
    1143     function GetWidth: Integer;
    1144     procedure SetHeight(AValue: Integer);
    1145     procedure SetWidth(AValue: Integer);
    1146   public
    1147     function GetNativeImageList: TImageList;
    1148     procedure GetBitmap(Index: Integer; Image: TDpiBitmap);
    1149     procedure BeginUpdate;
    1150     procedure EndUpdate;
    1151     procedure Clear;
    1152     function Add(Image, Mask: TDpiBitmap): Integer;
    1153     constructor Create(TheOwner: TComponent); override;
    1154     destructor Destroy; override;
    1155     property Width: Integer read GetWidth write SetWidth default 16;
    1156     property Height: Integer read GetHeight write SetHeight default 16;
    1157     property Count: Integer read GetCount;
    1158   end;
    1159 
    1160   { TDpiStringGrid }
    1161 
    1162   TDpiStringGrid = class(TDpiWinControl)
    1163   private
    1164     NativeStringGrid: TStringGrid;
    1165     function DefaultRowHeightIsStored: Boolean;
    1166     function GetCells(ACol, ARow: Integer): string;
    1167     function GetColCount: Integer;
    1168     function GetColumns: TGridColumns;
    1169     function GetDefRowHeight: Integer;
    1170     function GetEditor: TWinControl;
    1171     function GetFixedCols: Integer;
    1172     function GetFixedRows: Integer;
    1173     function GetOptions: TGridOptions;
    1174     function GetRowCount: Integer;
    1175     function GetScrollBars: TScrollStyle;
    1176     function GetSelection: TGridRect;
    1177     function IsColumnsStored: Boolean;
    1178     procedure SetCells(ACol, ARow: Integer; AValue: string);
    1179     procedure SetColCount(AValue: Integer);
    1180     procedure SetColumns(AValue: TGridColumns);
    1181     procedure SetDefRowHeight(AValue: Integer);
    1182     procedure SetEditor(AValue: TWinControl);
    1183     procedure SetFixedCols(AValue: Integer);
    1184     procedure SetFixedRows(AValue: Integer);
    1185     procedure SetOptions(AValue: TGridOptions);
    1186     procedure SetRowCount(AValue: Integer);
    1187     procedure SetScrollBars(AValue: TScrollStyle);
    1188     procedure SetSelection(AValue: TGridRect);
    1189   public
    1190     function GetNativeStringGrid: TStringGrid;
    1191     function CellRect(ACol, ARow: Integer): TRect;
    1192     constructor Create(TheOwner: TComponent); override;
    1193     destructor Destroy; override;
    1194     property Selection: TGridRect read GetSelection write SetSelection;
    1195     property Cells[ACol, ARow: Integer]: string read GetCells write SetCells;
    1196   published
    1197     property DefaultRowHeight: Integer read GetDefRowHeight write SetDefRowHeight stored DefaultRowHeightIsStored;
    1198     property ScrollBars: TScrollStyle read GetScrollBars write SetScrollBars default ssAutoBoth;
    1199     property FixedCols: Integer read GetFixedCols write SetFixedCols default 1;
    1200     property FixedRows: Integer read GetFixedRows write SetFixedRows default 1;
    1201     property RowCount: Integer read GetRowCount write SetRowCount default 5;
    1202     property ColCount: Integer read GetColCount write SetColCount default 5;
    1203     property Options: TGridOptions read GetOptions write SetOptions default DefaultGridOptions;
    1204     property Columns: TGridColumns read GetColumns write SetColumns stored IsColumnsStored;
    1205     property Editor: TWinControl read GetEditor write SetEditor;
    1206   end;
    1207 
    1208   { TDpiScreen }
    1209 
    1210   TDpiScreen = class
    1211   private
    1212     // TScreen
    1213     FDpi: Integer;
    1214     FActiveForm: TDpiForm;
    1215     FPrevActiveForms: TDpiForms;
    1216     FForms: TDpiForms;
    1217     procedure AddForm(AForm: TDpiForm);
    1218     function GetDesktopHeight: Integer;
    1219     function GetDesktopLeft: Integer;
    1220     function GetDesktopTop: Integer;
    1221     function GetDesktopWidth: Integer;
    1222     procedure RemoveForm(AForm: TDpiForm);
    1223     function GetActiveForm: TDpiForm;
    1224     function GetCursor: TCursor;
    1225     function GetCursors(Index: Integer): HCURSOR;
    1226     function GetFormCount: Integer;
    1227     function GetForms(Index: Integer): TDpiForm;
    1228     function GetHeight: Integer;
    1229     function GetWidth: Integer;
    1230     procedure SetCursor(AValue: TCursor);
    1231     procedure SetCursors(Index: Integer; AValue: HCURSOR);
    1232     procedure SetDpi(AValue: Integer);
    1233     procedure UpdateForms;
    1234   public
    1235     constructor Create;
    1236     destructor Destroy; override;
    1237     procedure UpdateScreen;
    1238     procedure UpdateActiveFormFromNativeScreen;
    1239     function DisableForms(SkipForm: TDpiForm; DisabledList: Classes.TList = nil): Classes.TList;
    1240     procedure EnableForms(var AFormList: Classes.TList);
    1241     property FormCount: Integer read GetFormCount;
    1242     property Forms[Index: Integer]: TDpiForm read GetForms;
    1243     property ActiveForm: TDpiForm read GetActiveForm;
    1244     property Cursor: TCursor read GetCursor write SetCursor;
    1245     property Cursors[Index: Integer]: HCURSOR read GetCursors write SetCursors;
    1246   published
    1247     property Dpi: Integer read FDpi write SetDpi;
    1248     property PixelsPerInch: Integer read FDpi;
    1249     property Width: Integer read GetWidth;
    1250     property Height: Integer read GetHeight;
    1251     property DesktopLeft: Integer read GetDesktopLeft;
    1252     property DesktopTop: Integer read GetDesktopTop;
    1253     property DesktopWidth: Integer read GetDesktopWidth;
    1254     property DesktopHeight: Integer read GetDesktopHeight;
    1255   end;
    1256 
    1257   { TDpiJpegImage }
    1258 
    1259   TDpiJpegImage = class(TDpiBitmap)
    1260   protected
    1261     function GetNativeBitmap: TCustomBitmap; override;
    1262     function GetNativeJpeg: TJPEGImage; virtual;
    1263   public
    1264     NativeJpeg: TJPEGImage;
    1265     constructor Create; override;
    1266     destructor Destroy; override;
    1267   end;
    1268 
    1269   { TDpiPortableNetworkGraphic }
    1270 
    1271   TDpiPortableNetworkGraphic = class(TDpiBitmap)
    1272   protected
    1273     function GetNativeBitmap: TCustomBitmap; override;
    1274     function GetNativePng: TPortableNetworkGraphic; virtual;
    1275   public
    1276     NativePng: TPortableNetworkGraphic;
    1277     constructor Create; override;
    1278     destructor Destroy; override;
    1279   end;
    1280 
    1281   { TDpiApplication }
    1282 
    1283   TDpiApplication = class(TComponent)
    1284   private
    1285     FMainForm: TDpiForm;
    1286     FCreatingForm: TDpiForm;
    1287     FOldExitProc: Pointer;
    1288     function GetActive: Boolean;
    1289     function GetExeName: string;
    1290     function GetShowMainForm: Boolean;
    1291     function GetTaskBarBehavior: TTaskBarBehavior;
    1292     function GetTitle: string;
    1293     procedure SetMainForm(AValue: TDpiForm);
    1294     function GetMainForm: TDpiForm;
    1295     procedure SetShowMainForm(AValue: Boolean);
    1296     procedure SetTaskBarBehavior(AValue: TTaskBarBehavior);
    1297     procedure SetTitle(AValue: string);
    1298   protected
    1299     function GetNativeApplication: TApplication; virtual;
    1300     procedure DoBeforeFinalization;
    1301   public
    1302     constructor Create(AOwner: TComponent); override;
    1303     destructor Destroy; override;
    1304     procedure Run;
    1305     procedure Initialize;
    1306     procedure Terminate;
    1307     procedure ProcessMessages;
    1308     procedure UpdateMainForm(AForm: TDpiForm);
    1309     procedure CreateForm(InstanceClass: TComponentClass; out Reference);
    1310     function MessageBox(Text, Caption: PChar; Flags: Longint = MB_OK): Integer;
    1311     property MainForm: TDpiForm read GetMainForm write SetMainForm;
    1312     property ShowMainForm: Boolean read GetShowMainForm write SetShowMainForm default True;
    1313     property Title: string read GetTitle write SetTitle;
    1314     property Active: Boolean read GetActive;
    1315     property ExeName: string read GetExeName;
    1316     property TaskBarBehavior: TTaskBarBehavior read GetTaskBarBehavior write SetTaskBarBehavior;
    1317   end;
    1318 
    1319   { TDpiMouse }
    1320 
    1321   // TMouse
    1322   TDpiMouse = class
    1323   private
    1324     function GetCursorPos: TPoint;
    1325     procedure SetCursorPos(AValue: TPoint);
    1326   public
    1327     constructor Create;
    1328     property CursorPos: TPoint read GetCursorPos write SetCursorPos;
    1329   end;
    1330 
    1331   { TDpiMenuItem }
    1332 
    1333   TDpiMenuItem = class(TComponent)
    1334   private
    1335     FItems: TList;
    1336     FParent: TDpiMenuItem;
    1337     FOnClick: TNotifyEvent;
    1338     function GetCaption: TTranslateString;
    1339     function GetChecked: Boolean;
    1340     function GetCount: Integer;
    1341     function GetEnabled: Boolean;
    1342     function GetGroupIndex: Byte;
    1343     function GetItem(Index: Integer): TDpiMenuItem;
    1344     function GetOnClick: TNotifyEvent;
    1345     function GetRadioItem: Boolean;
    1346     function GetShortCut: TShortCut;
    1347     function GetVisible: Boolean;
    1348     function IsCaptionStored: Boolean;
    1349     function IsCheckedStored: Boolean;
    1350     function IsEnabledStored: Boolean;
    1351     function IsShortCutStored: Boolean;
    1352     function IsVisibleStored: Boolean;
    1353     procedure SetCaption(AValue: TTranslateString);
    1354     procedure SetChecked(AValue: Boolean);
    1355     procedure SetEnabled(AValue: Boolean);
    1356     procedure SetGroupIndex(AValue: Byte);
    1357     procedure SetOnClick(AValue: TNotifyEvent);
    1358     procedure SetRadioItem(AValue: Boolean);
    1359     procedure SetShortCut(AValue: TShortCut);
    1360     procedure SetVisible(AValue: Boolean);
    1361     procedure OnClickHandler(Sender: TObject);
    1362   protected
    1363     function GetNativeMenuItem: TMenuItem; virtual;
    1364     procedure SetParentComponent(AValue: TComponent); override;
    1365   public
    1366     NativeMenuItem: TMenuItem;
    1367     constructor Create(AOwner: TComponent); override;
    1368     destructor Destroy; override;
    1369     procedure Delete(Index: Integer);
    1370     procedure Add(Item: TDpiMenuItem);
    1371     procedure Insert(Index: Integer; Item: TDpiMenuItem);
    1372     function IndexOf(Item: TDpiMenuItem): Integer;
    1373     procedure Remove(Item: TDpiMenuItem);
    1374     property Items[Index: Integer]: TDpiMenuItem read GetItem; default;
    1375     property Count: Integer read GetCount;
    1376     procedure Clear;
    1377     procedure Click; virtual;
    1378   published
    1379     property RadioItem: Boolean read GetRadioItem write SetRadioItem default False;
    1380     property ShortCut: TShortCut read GetShortCut write SetShortCut
    1381       stored IsShortCutStored default 0;
    1382     property Enabled: Boolean read GetEnabled write SetEnabled
    1383       stored IsEnabledStored default True;
    1384     property Visible: Boolean read GetVisible write SetVisible
    1385       stored IsVisibleStored default True;
    1386     property Checked: Boolean read GetChecked write SetChecked
    1387       stored IsCheckedStored default False;
    1388     property Caption: TTranslateString read GetCaption write SetCaption
    1389       stored IsCaptionStored;
    1390     property OnClick: TNotifyEvent read GetOnClick write SetOnClick;
    1391     property GroupIndex: Byte read GetGroupIndex write SetGroupIndex default 0;
    1392   end;
    1393 
    1394   TDpiMenu = class(TComponent)
    1395   private
    1396     FItems: TDpiMenuItem;
    1397   protected
    1398     function GetNativeMenu: TMenu; virtual;
    1399   public
    1400     property Items: TDpiMenuItem read FItems;
    1401     constructor Create(AOwner: TComponent); override;
    1402     destructor Destroy; override;
    1403   end;
    1404 
    1405   { TDpiPopupMenu }
    1406 
    1407   TDpiPopupMenu = class(TDpiMenu)
    1408   private
    1409     function GetAutoPopup: Boolean;
    1410     procedure SetAutoPopup(AValue: Boolean);
    1411   protected
    1412     function GetNativeMenu: TMenu; override;
    1413     function GetNativePopupMenu: TPopupMenu; virtual;
    1414   public
    1415     NativePopupMenu: TPopupMenu;
    1416     procedure PopUp;  overload;
    1417     procedure PopUp(X, Y: Integer); virtual; overload;
    1418     constructor Create(AOwner: TComponent); override;
    1419     destructor Destroy; override;
    1420   published
    1421     property AutoPopup: Boolean read GetAutoPopup write SetAutoPopup default True;
    1422   end;
    1423 
    142423var
    142524  DpiFormFileDesc: TDpiFormFileDesc;
    1426   DpiScreen: TDpiScreen;
    1427   DpiApplication: TDpiApplication;
    1428   DpiMouse: TDpiMouse;
    142925
    143026procedure Register;
    1431 function DpiBitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
    1432 function DpiBitBltCanvas(Dest: TDpiCanvas; X, Y, Width, Height: Integer; Src: TDpiCanvas; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
    1433 function DpiCreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN;
    1434 function DpiScrollDC(Canvas: TDpiCanvas; dx: Longint; dy: Longint; const lprcScroll: TRect;
    1435   const lprcClip:TRect; hrgnUpdate: Handle; lprcUpdate: PRect): Boolean;
    1436 function ScaleToNative(Value: Integer): Integer;
    1437 function ScaleToNativeDist(Base, Value: Integer): Integer;
    1438 function ScaleFromNative(Value: Integer): Integer;
    1439 function ScalePointToNative(Value: TPoint): TPoint;
    1440 function ScalePointFromNative(Value: TPoint): TPoint;
    1441 function ScaleSizeToNative(Value: TSize): TSize;
    1442 function ScaleSizeFromNative(Value: TSize): TSize;
    1443 function ScaleRectToNative(Value: TRect): TRect;
    1444 function ScaleRectFromNative(Value: TRect): TRect;
    1445 function ScaleFloatToNative(Value: Double): Double;
    1446 function ScaleFloatFromNative(Value: Double): Double;
    1447 procedure WriteLog(Text: string);
    1448 function DpiGetSystemMetrics(nIndex: Integer): Integer;
     27
    144928
    145029implementation
    145130
    145231uses
    1453   LCLStrConsts;
     32  LCLStrConsts, Dpi.Common;
    145433
    145534resourcestring
    145635  SDpiFormTitle = 'DpiForm form';
    145736  SDpiFormDescription = 'DPI aware form';
    1458   SNotImplemented = 'Not implemented';
    145937
    146038procedure Register;
    … …  
    146341  DpiFormFileDesc := TDpiFormFileDesc.Create;
    146442  RegisterProjectFileDescriptor(DpiFormFileDesc);
    1465   RegisterComponents('DpiControls', [TDpiButton, TDpiImage, TDpiPaintBox,
    1466     TDpiListBox, TDpiPopupMenu, TDpiEdit]);
    1467 end;
    1468 
    1469 function DpiBitBltCanvas(Dest: TDpiCanvas; X, Y, Width, Height: Integer;
    1470   Src: TDpiCanvas; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
    1471 begin
    1472   Result := DpiBitBlt(Dest.Handle, X, Y, Width, Height, Src.Handle, XSrc, YSrc, Rop);
    1473 end;
    1474 
    1475 function DpiCreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN;
    1476 begin
    1477   Result := CreateRectRgn(ScaleToNative(X1), ScaleToNative(Y1), ScaleToNative(X2),
    1478     ScaleToNative(Y2));
    1479 end;
    1480 
    1481 function DpiScrollDC(Canvas: TDpiCanvas; dx: Longint; dy: Longint;
    1482   const lprcScroll: TRect; const lprcClip: TRect; hrgnUpdate: Handle;
    1483   lprcUpdate: PRect): Boolean;
    1484 begin
    1485   {$IFDEF WINDOWS}
    1486   Result := Windows.ScrollDC(Canvas.Handle, ScaleToNative(dx), ScaleToNative(dy),
    1487     ScaleRectToNative(lprcScroll), ScaleRectToNative(lprcClip),
    1488     hrgnUpdate, lprcUpdate);
    1489   {$ENDIF}
    1490   {$IFDEF LINUX}
    1491   // Can't do scrolling of DC under Linux, then fallback into BitBlt.
    1492   Result := DpiBitBltCanvas(Canvas, lprcScroll.Left + dx, lprcScroll.Top + dy, lprcScroll.Right - lprcScroll.Left, lprcScroll.Bottom - lprcScroll.Top,
    1493     Canvas, lprcScroll.Left, lprcScroll.Top);
    1494   {$ENDIF}
    1495 end;
    1496 
    1497 function Ceil(const X: Single): Integer;
    1498 begin
    1499   if X > High(Integer) then
    1500     Result := High(Integer)
    1501   else if X < Low(Integer) then
    1502     Result := Low(Integer)
    1503   else begin
    1504     Result := Trunc(X);
    1505     if (Result <> X) then begin
    1506       if (Result > 0) then Inc(Result) else Dec(Result);
    1507     end;
    1508   end;
    1509 end;
    1510 
    1511 function ScaleToNative(Value: Integer): Integer;
    1512 begin
    1513   Result := Round(Value * DpiScreen.Dpi / 96);
    1514 end;
    1515 
    1516 function ScaleToNativeDist(Base, Value: Integer): Integer;
    1517 begin
    1518   Result := ScaleToNative(Base + Value) - ScaleToNative(Base);
    1519 end;
    1520 
    1521 function ScaleFromNative(Value: Integer): Integer;
    1522 begin
    1523   Result := Round(Value * 96 / DpiScreen.Dpi);
    1524 end;
    1525 
    1526 function ScalePointToNative(Value: TPoint): TPoint;
    1527 begin
    1528   Result.X := ScaleToNative(Value.X);
    1529   Result.Y := ScaleToNative(Value.Y);
    1530 end;
    1531 
    1532 function ScalePointFromNative(Value: TPoint): TPoint;
    1533 begin
    1534   Result.X := ScaleFromNative(Value.X);
    1535   Result.Y := ScaleFromNative(Value.Y);
    1536 end;
    1537 
    1538 function ScaleSizeToNative(Value: TSize): TSize;
    1539 begin
    1540   Result.Width := ScaleToNative(Value.Width);
    1541   Result.Height := ScaleToNative(Value.Height);
    1542 end;
    1543 
    1544 function ScaleSizeFromNative(Value: TSize): TSize;
    1545 begin
    1546   Result.Width := ScaleFromNative(Value.Width);
    1547   Result.Height := ScaleFromNative(Value.Height);
    1548 end;
    1549 
    1550 function ScaleRectToNative(Value: TRect): TRect;
    1551 begin
    1552   Result.Left := ScaleToNative(Value.Left);
    1553   Result.Top := ScaleToNative(Value.Top);
    1554   Result.Right := ScaleToNative(Value.Right);
    1555   Result.Bottom := ScaleToNative(Value.Bottom);
    1556 end;
    1557 
    1558 function ScaleRectFromNative(Value: TRect): TRect;
    1559 begin
    1560   Result.Left := ScaleFromNative(Value.Left);
    1561   Result.Top := ScaleFromNative(Value.Top);
    1562   Result.Right := ScaleFromNative(Value.Right);
    1563   Result.Bottom := ScaleFromNative(Value.Bottom);
    1564 end;
    1565 
    1566 function ScaleFloatToNative(Value: Double): Double;
    1567 begin
    1568   Result := Value * DpiScreen.Dpi / 96;
    1569 end;
    1570 
    1571 function ScaleFloatFromNative(Value: Double): Double;
    1572 begin
    1573   Result := Value * 96 / DpiScreen.Dpi;
    1574 end;
    1575 
    1576 procedure WriteLog(Text: string);
    1577 var
    1578   F: Text;
    1579 const
    1580   FileName = 'Log.txt';
    1581 begin
    1582   AssignFile(F, FileName);
    1583   if FileExists(FileName) then Append(F) else Rewrite(F);
    1584   WriteLn(F, Text);
    1585   CloseFile(F);
    1586 end;
    1587 
    1588 function DpiGetSystemMetrics(nIndex: Integer): Integer;
    1589 begin
    1590   Result := ScaleFromNative(GetSystemMetrics(nIndex));
    1591 end;
    1592 
    1593 function DpiBitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc,
    1594   YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
    1595 var
    1596   DstWidth, DstHeight: Integer;
    1597   SrcWidth, SrcHeight: Integer;
    1598 begin
    1599   {$IFDEF WINDOWS}
    1600   // LCLIntf.BitBlt is slower than direct Windows BitBlt
    1601   Result := Windows.BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
    1602     ScaleToNative(Width), ScaleToNative(Height), SrcDC,
    1603     ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
    1604   {$ELSE}
    1605 
    1606 
    1607   DstWidth := ScaleToNativeDist(X, Width);
    1608   DstHeight := ScaleToNativeDist(Y, Height);
    1609   SrcWidth := ScaleToNativeDist(XSrc, Width);
    1610   SrcHeight := ScaleToNativeDist(YSrc, Height);
    1611   if (DstWidth = SrcWidth) and (DstHeight = SrcHeight) then begin
    1612     Result := BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
    1613       DstWidth, DstHeight, SrcDC,
    1614       ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
    1615   end else begin
    1616     Result := BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
    1617       DstWidth, DstHeight, SrcDC,
    1618       ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
    1619 {    Result := StretchBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
    1620       DstWidth, DstHeight, SrcDC,
    1621       ScaleToNative(XSrc), ScaleToNative(YSrc),
    1622       SrcWidth, SrcHeight, Rop);
    1623 }  end;
    1624 
    1625 {  Result := BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
    1626     ScaleToNative(Width), ScaleToNative(Height), SrcDC,
    1627     ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
    1628  }
    1629   {$ENDIF}
    1630 end;
    1631 
    1632 { TDpiRadioButton }
    1633 
    1634 function TDpiRadioButton.GetNativeRadioButton: TRadioButton;
    1635 begin
    1636   if not Assigned(NativeRadioButton) then NativeRadioButton := TRadioButton.Create(nil);
    1637     Result := NativeRadioButton;
    1638 end;
    1639 
    1640 constructor TDpiRadioButton.Create(TheOwner: TComponent);
    1641 begin
    1642   inherited Create(TheOwner);
    1643 end;
    1644 
    1645 destructor TDpiRadioButton.Destroy;
    1646 begin
    1647   FreeAndNil(NativeRadioButton);
    1648   inherited;
    1649 end;
    1650 
    1651 { TDpiPageControl }
    1652 
    1653 function TDpiPageControl.GetPageCount: Integer;
    1654 begin
    1655   Result := GetNativePageControl.PageCount;
    1656 end;
    1657 
    1658 function TDpiPageControl.GetTabSheet(Index: Integer): TTabSheet;
    1659 begin
    1660   Result := GetNativePageControl.Pages[Index];
    1661 end;
    1662 
    1663 function TDpiPageControl.GetNativePageControl: TPageControl;
    1664 begin
    1665   if not Assigned(NativePageControl) then NativePageControl := TPageControl.Create(nil);
    1666     Result := NativePageControl;
    1667 end;
    1668 
    1669 constructor TDpiPageControl.Create(TheOwner: TComponent);
    1670 begin
    1671   inherited Create(TheOwner);
    1672 end;
    1673 
    1674 destructor TDpiPageControl.Destroy;
    1675 begin
    1676   FreeAndNil(NativePageControl);
    1677   inherited;
    1678 end;
    1679 
    1680 { TDpiCustomDrawGrid }
    1681 
    1682 function TDpiCustomDrawGrid.GetEditor: TDpiWinControl;
    1683 begin
    1684   //Result := GetNativeCustomDrawGrid.Editor;
    1685 end;
    1686 
    1687 procedure TDpiCustomDrawGrid.SetEditor(AValue: TDpiWinControl);
    1688 begin
    1689   //GetNativeCustomDrawGrid.Editor := AValue
    1690 end;
    1691 
    1692 function TDpiCustomDrawGrid.GetNativeCustomDrawGrid: TCustomDrawGrid;
    1693 begin
    1694   if not Assigned(NativeCustomDrawGrid) then NativeCustomDrawGrid := TCustomDrawGrid.Create(nil);
    1695     Result := NativeCustomDrawGrid;
    1696 end;
    1697 
    1698 constructor TDpiCustomDrawGrid.Create(TheOwner: TComponent);
    1699 begin
    1700   inherited Create(TheOwner);
    1701 end;
    1702 
    1703 destructor TDpiCustomDrawGrid.Destroy;
    1704 begin
    1705   FreeAndNil(NativeCustomDrawGrid);
    1706   inherited;
    1707 end;
    1708 
    1709 { TDpiCheckBox }
    1710 
    1711 function TDpiCheckBox.GetNativeCheckBox: TCheckBox;
    1712 begin
    1713   if not Assigned(NativeCheckBox) then NativeCheckBox := TCheckBox.Create(nil);
    1714     Result := NativeCheckBox;
    1715 end;
    1716 
    1717 constructor TDpiCheckBox.Create(TheOwner: TComponent);
    1718 begin
    1719   inherited Create(TheOwner);
    1720 end;
    1721 
    1722 destructor TDpiCheckBox.Destroy;
    1723 begin
    1724   FreeAndNil(NativeCheckBox);
    1725   inherited;
    1726 end;
    1727 
    1728 { TDpiComboBox }
    1729 
    1730 function TDpiComboBox.GetNativeComboBox: TComboBox;
    1731 begin
    1732   if not Assigned(NativeComboBox) then NativeComboBox := TComboBox.Create(nil);
    1733     Result := NativeComboBox;
    1734 end;
    1735 
    1736 constructor TDpiComboBox.Create(TheOwner: TComponent);
    1737 begin
    1738   inherited Create(TheOwner);
    1739 end;
    1740 
    1741 destructor TDpiComboBox.Destroy;
    1742 begin
    1743   FreeAndNil(NativeComboBox);
    1744   inherited;
    1745 end;
    1746 
    1747 { TDpiSpinEdit }
    1748 
    1749 function TDpiSpinEdit.GetNativeSpinEdit: TSpinEdit;
    1750 begin
    1751   if not Assigned(NativeSpinEdit) then NativeSpinEdit := TSpinEdit.Create(nil);
    1752     Result := NativeSpinEdit;
    1753 end;
    1754 
    1755 constructor TDpiSpinEdit.Create(TheOwner: TComponent);
    1756 begin
    1757   inherited Create(TheOwner);
    1758 end;
    1759 
    1760 destructor TDpiSpinEdit.Destroy;
    1761 begin
    1762   FreeAndNil(NativeSpinEdit);
    1763   inherited;
    1764 end;
    1765 
    1766 { TDpiMemo }
    1767 
    1768 function TDpiMemo.GetLines: TStrings;
    1769 begin
    1770   Result := GetNativeMemo.Lines;
    1771 end;
    1772 
    1773 function TDpiMemo.GetReadOnly: Boolean;
    1774 begin
    1775   Result := GetNativeMemo.ReadOnly;
    1776 end;
    1777 
    1778 function TDpiMemo.GetScrollBars: TScrollStyle;
    1779 begin
    1780   Result := GetNativeMemo.ScrollBars;
    1781 end;
    1782 
    1783 function TDpiMemo.GetWordWrap: Boolean;
    1784 begin
    1785   Result := GetNativeMemo.WordWrap;
    1786 end;
    1787 
    1788 procedure TDpiMemo.SetLines(AValue: TStrings);
    1789 begin
    1790   GetNativeMemo.Lines := AValue;
    1791 end;
    1792 
    1793 procedure TDpiMemo.SetReadOnly(AValue: Boolean);
    1794 begin
    1795   GetNativeMemo.ReadOnly := AValue;
    1796 end;
    1797 
    1798 procedure TDpiMemo.SetScrollBars(AValue: TScrollStyle);
    1799 begin
    1800   GetNativeMemo.ScrollBars := AValue;
    1801 end;
    1802 
    1803 procedure TDpiMemo.SetWordWrap(AValue: Boolean);
    1804 begin
    1805   GetNativeMemo.WordWrap := AValue;
    1806 end;
    1807 
    1808 function TDpiMemo.GetNativeWinControl: TWinControl;
    1809 begin
    1810   Result := GetNativeMemo;
    1811 end;
    1812 
    1813 procedure TDpiMemo.Clear;
    1814 begin
    1815   GetNativeMemo.Clear;
    1816 end;
    1817 
    1818 function TDpiMemo.GetNativeMemo: TMemo;
    1819 begin
    1820   if not Assigned(NativeMemo) then NativeMemo := TMemo.Create(nil);
    1821     Result := NativeMemo;
    1822 end;
    1823 
    1824 constructor TDpiMemo.Create(TheOwner: TComponent);
    1825 begin
    1826   inherited Create(TheOwner);
    1827 end;
    1828 
    1829 destructor TDpiMemo.Destroy;
    1830 begin
    1831   FreeAndNil(NativeMemo);
    1832   inherited;
    1833 end;
    1834 
    1835 { TDpiImageList }
    1836 
    1837 function TDpiImageList.GetHeight: Integer;
    1838 begin
    1839 
    1840 end;
    1841 
    1842 function TDpiImageList.GetCount: Integer;
    1843 begin
    1844 
    1845 end;
    1846 
    1847 function TDpiImageList.GetWidth: Integer;
    1848 begin
    1849 
    1850 end;
    1851 
    1852 procedure TDpiImageList.SetHeight(AValue: Integer);
    1853 begin
    1854 
    1855 end;
    1856 
    1857 procedure TDpiImageList.SetWidth(AValue: Integer);
    1858 begin
    1859 
    1860 end;
    1861 
    1862 function TDpiImageList.GetNativeImageList: TImageList;
    1863 begin
    1864   if not Assigned(NativeImageList) then NativeImageList := TImageList.Create(nil);
    1865     Result := NativeImageList;
    1866 end;
    1867 
    1868 procedure TDpiImageList.GetBitmap(Index: Integer; Image: TDpiBitmap);
    1869 begin
    1870 
    1871 end;
    1872 
    1873 procedure TDpiImageList.BeginUpdate;
    1874 begin
    1875 
    1876 end;
    1877 
    1878 procedure TDpiImageList.EndUpdate;
    1879 begin
    1880 
    1881 end;
    1882 
    1883 procedure TDpiImageList.Clear;
    1884 begin
    1885 
    1886 end;
    1887 
    1888 function TDpiImageList.Add(Image, Mask: TDpiBitmap): Integer;
    1889 begin
    1890 
    1891 end;
    1892 
    1893 constructor TDpiImageList.Create(TheOwner: TComponent);
    1894 begin
    1895   inherited Create(TheOwner);
    1896 end;
    1897 
    1898 destructor TDpiImageList.Destroy;
    1899 begin
    1900   FreeAndNil(NativeImageList);
    1901   inherited Destroy;
    1902 end;
    1903 
    1904 { TDpiCoolBands }
    1905 
    1906 procedure TDpiCoolBands.SetItem(Index: Integer; AValue: TDpiCoolBand);
    1907 begin
    1908 
    1909 end;
    1910 
    1911 function TDpiCoolBands.GetItem(Index: Integer): TDpiCoolBand;
    1912 begin
    1913 
    1914 end;
    1915 
    1916 { TDpiCoolBand }
    1917 
    1918 function TDpiCoolBand.GetMinWidth: Integer;
    1919 begin
    1920 
    1921 end;
    1922 
    1923 function TDpiCoolBand.GetMinHeight: Integer;
    1924 begin
    1925 
    1926 end;
    1927 
    1928 procedure TDpiCoolBand.SetMinHeight(AValue: Integer);
    1929 begin
    1930 
    1931 end;
    1932 
    1933 procedure TDpiCoolBand.SetMinWidth(AValue: Integer);
    1934 begin
    1935 
    1936 end;
    1937 
    1938 function TDpiCoolBand.GetNativeCoolBand: TCoolBand;
    1939 begin
    1940 
    1941 end;
    1942 
    1943 constructor TDpiCoolBand.Create(TheOwner: TComponent);
    1944 begin
    1945   inherited Create(TheOwner);
    1946 end;
    1947 
    1948 destructor TDpiCoolBand.Destroy;
    1949 begin
    1950   inherited Destroy;
    1951 end;
    1952 
    1953 { TDpiCoolBar }
    1954 
    1955 function TDpiCoolBar.GetBands: TDpiCoolBands;
    1956 begin
    1957 
    1958 end;
    1959 
    1960 function TDpiCoolBar.GetThemed: Boolean;
    1961 begin
    1962   Result := GetNativeCoolBar.Themed;
    1963 end;
    1964 
    1965 procedure TDpiCoolBar.SetBands(AValue: TDpiCoolBands);
    1966 begin
    1967 
    1968 end;
    1969 
    1970 procedure TDpiCoolBar.SetThemed(AValue: Boolean);
    1971 begin
    1972   GetNativeCoolBar.Themed := AValue
    1973 end;
    1974 
    1975 procedure TDpiCoolBar.BeginUpdate;
    1976 begin
    1977   GetNativeCoolBar.BeginUpdate;
    1978 end;
    1979 
    1980 procedure TDpiCoolBar.EndUpdate;
    1981 begin
    1982   GetNativeCoolBar.EndUpdate;
    1983 end;
    1984 
    1985 function TDpiCoolBar.GetNativeCoolBar: TCoolBar;
    1986 begin
    1987   if not Assigned(NativeCoolBar) then NativeCoolBar := TCoolBar.Create(nil);
    1988     Result := NativeCoolBar;
    1989 end;
    1990 
    1991 constructor TDpiCoolBar.Create(TheOwner: TComponent);
    1992 begin
    1993   inherited Create(TheOwner);
    1994 end;
    1995 
    1996 destructor TDpiCoolBar.Destroy;
    1997 begin
    1998   FreeAndNil(NativeCoolBar);
    1999   inherited Destroy;
    2000 end;
    2001 
    2002 { TDpiToolBar }
    2003 
    2004 function TDpiToolBar.ButtonHeightIsStored: Boolean;
    2005 begin
    2006 
    2007 end;
    2008 
    2009 function TDpiToolBar.ButtonWidthIsStored: Boolean;
    2010 begin
    2011 
    2012 end;
    2013 
    2014 function TDpiToolBar.GetButtonHeight: Integer;
    2015 begin
    2016   Result := ScaleFromNative(GetNativeToolBar.ButtonHeight);
    2017 end;
    2018 
    2019 function TDpiToolBar.GetButtonWidth: Integer;
    2020 begin
    2021   Result := ScaleFromNative(GetNativeToolBar.ButtonWidth);
    2022 end;
    2023 
    2024 procedure TDpiToolBar.SetButtonHeight(AValue: Integer);
    2025 begin
    2026   GetNativeToolBar.ButtonHeight := ScaleToNative(AValue);
    2027 end;
    2028 
    2029 procedure TDpiToolBar.SetButtonWidth(AValue: Integer);
    2030 begin
    2031   GetNativeToolBar.ButtonWidth := ScaleToNative(AValue);
    2032 end;
    2033 
    2034 function TDpiToolBar.GetNativeToolBar: TToolBar;
    2035 begin
    2036   if not Assigned(NativeToolBar) then NativeToolBar := TToolBar.Create(nil);
    2037     Result := NativeToolBar;
    2038 end;
    2039 
    2040 constructor TDpiToolBar.Create(TheOwner: TComponent);
    2041 begin
    2042   inherited Create(TheOwner);
    2043 end;
    2044 
    2045 destructor TDpiToolBar.Destroy;
    2046 begin
    2047   FreeAndNil(NativeToolBar);
    2048   inherited;
    2049 end;
    2050 
    2051 { TDpiPanel }
    2052 
    2053 function TDpiPanel.GetNativePanel: TPanel;
    2054 begin
    2055   if not Assigned(NativePanel) then NativePanel := TPanel.Create(nil);
    2056     Result := NativePanel;
    2057 end;
    2058 
    2059 constructor TDpiPanel.Create(TheOwner: TComponent);
    2060 begin
    2061   inherited Create(TheOwner);
    2062 end;
    2063 
    2064 destructor TDpiPanel.Destroy;
    2065 begin
    2066   FreeAndNil(NativePanel);
    2067   inherited;
    2068 end;
    2069 
    2070 { TDpiStringGrid }
    2071 
    2072 function TDpiStringGrid.DefaultRowHeightIsStored: Boolean;
    2073 begin
    2074   Result := GetDefRowHeight >= 0;
    2075 end;
    2076 
    2077 function TDpiStringGrid.GetCells(ACol, ARow: Integer): string;
    2078 begin
    2079   Result := GetNativeStringGrid.Cells[ACol, ARow];
    2080 end;
    2081 
    2082 function TDpiStringGrid.GetColCount: Integer;
    2083 begin
    2084   Result := GetNativeStringGrid.ColCount;
    2085 end;
    2086 
    2087 function TDpiStringGrid.GetColumns: TGridColumns;
    2088 begin
    2089   Result := GetNativeStringGrid.Columns;
    2090 end;
    2091 
    2092 function TDpiStringGrid.GetDefRowHeight: Integer;
    2093 begin
    2094   Result := GetNativeStringGrid.DefaultRowHeight;
    2095 end;
    2096 
    2097 function TDpiStringGrid.GetEditor: TWinControl;
    2098 begin
    2099   Result := GetNativeStringGrid.Editor;
    2100 end;
    2101 
    2102 function TDpiStringGrid.GetFixedCols: Integer;
    2103 begin
    2104   Result := GetNativeStringGrid.FixedCols;
    2105 end;
    2106 
    2107 function TDpiStringGrid.GetFixedRows: Integer;
    2108 begin
    2109   Result := GetNativeStringGrid.FixedRows;
    2110 end;
    2111 
    2112 function TDpiStringGrid.GetOptions: TGridOptions;
    2113 begin
    2114   Result := GetNativeStringGrid.Options;
    2115 end;
    2116 
    2117 function TDpiStringGrid.GetRowCount: Integer;
    2118 begin
    2119   Result := GetNativeStringGrid.RowCount;
    2120 end;
    2121 
    2122 function TDpiStringGrid.GetScrollBars: TScrollStyle;
    2123 begin
    2124   Result := GetNativeStringGrid.ScrollBars;
    2125 end;
    2126 
    2127 function TDpiStringGrid.GetSelection: TGridRect;
    2128 begin
    2129   Result := GetNativeStringGrid.Selection;
    2130 end;
    2131 
    2132 function TDpiStringGrid.IsColumnsStored: Boolean;
    2133 begin
    2134   Result := GetNativeStringGrid.Columns.Enabled;
    2135 end;
    2136 
    2137 procedure TDpiStringGrid.SetCells(ACol, ARow: Integer; AValue: string);
    2138 begin
    2139   GetNativeStringGrid.Cells[ACol, ARow] := AValue;
    2140 end;
    2141 
    2142 procedure TDpiStringGrid.SetColCount(AValue: Integer);
    2143 begin
    2144   GetNativeStringGrid.ColCount := AValue;
    2145 end;
    2146 
    2147 procedure TDpiStringGrid.SetColumns(AValue: TGridColumns);
    2148 begin
    2149   GetNativeStringGrid.Columns := AValue;
    2150 end;
    2151 
    2152 procedure TDpiStringGrid.SetDefRowHeight(AValue: Integer);
    2153 begin
    2154   GetNativeStringGrid.DefaultRowHeight := AValue;
    2155 end;
    2156 
    2157 procedure TDpiStringGrid.SetEditor(AValue: TWinControl);
    2158 begin
    2159   GetNativeStringGrid.Editor := AValue;
    2160 end;
    2161 
    2162 procedure TDpiStringGrid.SetFixedCols(AValue: Integer);
    2163 begin
    2164   GetNativeStringGrid.FixedCols := AValue;
    2165 end;
    2166 
    2167 procedure TDpiStringGrid.SetFixedRows(AValue: Integer);
    2168 begin
    2169   GetNativeStringGrid.FixedRows := AValue;
    2170 end;
    2171 
    2172 procedure TDpiStringGrid.SetOptions(AValue: TGridOptions);
    2173 begin
    2174   GetNativeStringGrid.Options := AValue;
    2175 end;
    2176 
    2177 procedure TDpiStringGrid.SetRowCount(AValue: Integer);
    2178 begin
    2179   GetNativeStringGrid.RowCount := AValue;
    2180 end;
    2181 
    2182 procedure TDpiStringGrid.SetScrollBars(AValue: TScrollStyle);
    2183 begin
    2184   GetNativeStringGrid.ScrollBars := AValue;
    2185 end;
    2186 
    2187 procedure TDpiStringGrid.SetSelection(AValue: TGridRect);
    2188 begin
    2189   GetNativeStringGrid.Selection := AValue;
    2190 end;
    2191 
    2192 function TDpiStringGrid.GetNativeStringGrid: TStringGrid;
    2193 begin
    2194   if not Assigned(NativeStringGrid) then NativeStringGrid := TStringGrid.Create(nil);
    2195     Result := NativeStringGrid;
    2196 end;
    2197 
    2198 function TDpiStringGrid.CellRect(ACol, ARow: Integer): TRect;
    2199 begin
    2200   Result := GetNativeStringGrid.CellRect(ACol, ARow);
    2201 end;
    2202 
    2203 constructor TDpiStringGrid.Create(TheOwner: TComponent);
    2204 begin
    2205   inherited Create(TheOwner);
    2206 end;
    2207 
    2208 destructor TDpiStringGrid.Destroy;
    2209 begin
    2210   FreeAndNil(NativeStringGrid);
    2211   inherited;
    2212 end;
    2213 
    2214 { TDpiListView }
    2215 
    2216 function TDpiListView.GetItems: TListItems;
    2217 begin
    2218   Result := GetNativeListView.Items;
    2219 end;
    2220 
    2221 function TDpiListView.GetOnChange: TLVChangeEvent;
    2222 begin
    2223   Result := GetNativeListView.OnChange;
    2224 end;
    2225 
    2226 function TDpiListView.GetOnColumnClick: TLVColumnClickEvent;
    2227 begin
    2228   Result := GetNativeListView.OnColumnClick;
    2229 end;
    2230 
    2231 function TDpiListView.GetOnCustomDrawItem: TDpiLVCustomDrawItemEvent;
    2232 begin
    2233   Result := FOnCustomDrawItem;
    2234 end;
    2235 
    2236 function TDpiListView.GetProperty(AIndex: Integer): Boolean;
    2237 begin
    2238   Result := GetNativeListView.Checkboxes;
    2239 end;
    2240 
    2241 function TDpiListView.GetViewStyle: TViewStyle;
    2242 begin
    2243   Result := GetNativeListView.ViewStyle;
    2244 end;
    2245 
    2246 function TDpiListView.GetColumns: TListColumns;
    2247 begin
    2248   Result := GetNativeListView.Columns;
    2249 end;
    2250 
    2251 function TDpiListView.GetCanvas: TCanvas;
    2252 begin
    2253   Result := GetNativeListView.Canvas;
    2254 end;
    2255 
    2256 procedure TDpiListView.SetColumns(AValue: TListColumns);
    2257 begin
    2258   GetNativeListView.Columns := AValue;
    2259 end;
    2260 
    2261 procedure TDpiListView.SetItems(AValue: TListItems);
    2262 begin
    2263   GetNativeListView.Items := AValue;
    2264 end;
    2265 
    2266 procedure TDpiListView.SetOnChange(AValue: TLVChangeEvent);
    2267 begin
    2268   GetNativeListView.OnChange := AValue;
    2269 end;
    2270 
    2271 procedure TDpiListView.SetOnColumnClick(AValue: TLVColumnClickEvent);
    2272 begin
    2273   GetNativeListView.OnColumnClick := AValue;
    2274 end;
    2275 
    2276 procedure TDpiListView.SetOnCustomDrawItem(AValue: TDpiLVCustomDrawItemEvent);
    2277 begin
    2278   FOnCustomDrawItem := AValue;
    2279 end;
    2280 
    2281 procedure TDpiListView.SetProperty(AIndex: Integer; AValue: Boolean);
    2282 begin
    2283   GetNativeListView.Checkboxes := AValue;
    2284 end;
    2285 
    2286 procedure TDpiListView.SetViewStyle(AValue: TViewStyle);
    2287 begin
    2288   GetNativeListView.ViewStyle := AValue;
    2289 end;
    2290 
    2291 procedure TDpiListView.DoCustomDrawItem(Sender: TCustomListView; Item: TListItem;
    2292   State: TCustomDrawState; var DefaultDraw: Boolean);
    2293 begin
    2294   if Assigned(FOnCustomDrawItem) then
    2295     FOnCustomDrawItem(Self, Item, State, DefaultDraw);
    2296 end;
    2297 
    2298 function TDpiListView.GetItemAt(x, y: integer): TListItem;
    2299 begin
    2300   Result := GetNativeListView.GetItemAt(X, Y);
    2301 end;
    2302 
    2303 function TDpiListView.GetNativeListView: TListView;
    2304 begin
    2305   if not Assigned(NativeListView) then begin
    2306     NativeListView := TListView.Create(nil);
    2307     NativeListView.OnCustomDrawItem := DoCustomDrawItem;
    2308   end;
    2309   Result := NativeListView;
    2310 end;
    2311 
    2312 constructor TDpiListView.Create(TheOwner: TComponent);
    2313 begin
    2314   inherited Create(TheOwner);
    2315 end;
    2316 
    2317 destructor TDpiListView.Destroy;
    2318 begin
    2319   FreeAndNil(NativeListView);
    2320   inherited;
    2321 end;
    2322 
    2323 { TDpiPen }
    2324 
    2325 function TDpiPen.GetColor: TColor;
    2326 begin
    2327   Result := GetNativePen.Color;
    2328 end;
    2329 
    2330 function TDpiPen.GetStyle: TPenStyle;
    2331 begin
    2332   Result := GetNativePen.Style;
    2333 end;
    2334 
    2335 function TDpiPen.GetWidth: Integer;
    2336 begin
    2337   Result := FWidth;
    2338 end;
    2339 
    2340 procedure TDpiPen.SetColor(AValue: TColor);
    2341 begin
    2342   GetNativePen.Color := AValue;
    2343 end;
    2344 
    2345 procedure TDpiPen.SetNativePen(AValue: TPen);
    2346 begin
    2347   if FNativePen = AValue then Exit;
    2348   if FNativePenFree then FreeAndNil(FNativePen);
    2349   FNativePenFree := False;
    2350   FNativePen := AValue;
    2351   SetWidth(FWidth);
    2352 end;
    2353 
    2354 procedure TDpiPen.SetStyle(AValue: TPenStyle);
    2355 begin
    2356   GetNativePen.Style := AValue;
    2357 end;
    2358 
    2359 procedure TDpiPen.SetWidth(AValue: Integer);
    2360 begin
    2361   GetNativePen.Width := ScaleToNative(AValue);
    2362   FWidth := AValue;
    2363 end;
    2364 
    2365 constructor TDpiPen.Create;
    2366 begin
    2367   FNativePen := TPen.Create;
    2368   FNativePenFree := True;
    2369   FWidth := 1;
    2370 end;
    2371 
    2372 destructor TDpiPen.Destroy;
    2373 begin
    2374   if FNativePenFree then
    2375     FreeAndNil(FNativePen);
    2376   inherited;
    2377 end;
    2378 
    2379 function TDpiPen.GetNativePen: TPen;
    2380 begin
    2381   Result := FNativePen;
    2382 end;
    2383 
    2384 procedure TDpiPen.Assign(Source: TDpiPen);
    2385 begin
    2386   FWidth := Source.FWidth;
    2387   GetNativePen.Assign(Source.GetNativePen);
    2388 end;
    2389 
    2390 { TDpiBrush }
    2391 
    2392 function TDpiBrush.GetColor: TColor;
    2393 begin
    2394   Result := GetNativeBrush.Color;
    2395 end;
    2396 
    2397 function TDpiBrush.GetStyle: TBrushStyle;
    2398 begin
    2399   Result := GetNativeBrush.Style;
    2400 end;
    2401 
    2402 procedure TDpiBrush.SetColor(AValue: TColor);
    2403 begin
    2404   GetNativeBrush.Color := AValue;
    2405 end;
    2406 
    2407 function TDpiBrush.GetNativeBrush: TBrush;
    2408 begin
    2409   Result := FNativeBrush;
    2410 end;
    2411 
    2412 procedure TDpiBrush.SetNativeBrush(AValue: TBrush);
    2413 begin
    2414   if FNativeBrush = AValue then Exit;
    2415   if FNativeBrushFree then FreeAndNil(FNativeBrush);
    2416   FNativeBrushFree := False;
    2417   FNativeBrush := AValue;
    2418 end;
    2419 
    2420 procedure TDpiBrush.SetStyle(AValue: TBrushStyle);
    2421 begin
    2422   GetNativeBrush.Style := AValue;
    2423 end;
    2424 
    2425 constructor TDpiBrush.Create;
    2426 begin
    2427   FNativeBrush := TBrush.Create;
    2428   FNativeBrushFree := True;
    2429 end;
    2430 
    2431 destructor TDpiBrush.Destroy;
    2432 begin
    2433   if FNativeBrushFree then FreeAndNil(FNativeBrush);
    2434   inherited;
    2435 end;
    2436 
    2437 procedure TDpiBrush.Assign(Source: TDpiBrush);
    2438 begin
    2439   GetNativeBrush.Assign(Source.GetNativeBrush);
    2440 end;
    2441 
    2442 { TDpiControlBorderSpacing }
    2443 
    2444 function TDpiControlBorderSpacing.IsBottomStored: Boolean;
    2445 begin
    2446   if FDefault = nil
    2447   then Result := FBottom <> 0
    2448   else Result := FBottom <> FDefault^.Bottom;
    2449 end;
    2450 
    2451 function TDpiControlBorderSpacing.IsAroundStored: Boolean;
    2452 begin
    2453   if FDefault = nil
    2454   then Result := FAround <> 0
    2455   else Result := FAround <> FDefault^.Around;
    2456 end;
    2457 
    2458 function TDpiControlBorderSpacing.IsLeftStored: Boolean;
    2459 begin
    2460   if FDefault = nil
    2461   then Result := FLeft <> 0
    2462   else Result := FLeft <> FDefault^.Left;
    2463 end;
    2464 
    2465 function TDpiControlBorderSpacing.IsRightStored: Boolean;
    2466 begin
    2467   if FDefault = nil
    2468   then Result := FRight <> 0
    2469   else Result := FRight <> FDefault^.Right;
    2470 end;
    2471 
    2472 function TDpiControlBorderSpacing.IsTopStored: Boolean;
    2473 begin
    2474   if FDefault = nil
    2475   then Result := FTop <> 0
    2476   else Result := FTop <> FDefault^.Top;
    2477 end;
    2478 
    2479 procedure TDpiControlBorderSpacing.SetAround(AValue: TSpacingSize);
    2480 begin
    2481   if FAround = AValue then Exit;
    2482   FAround := AValue;
    2483   Change(False);
    2484 end;
    2485 
    2486 procedure TDpiControlBorderSpacing.SetBottom(AValue: TSpacingSize);
    2487 begin
    2488   if FBottom = AValue then Exit;
    2489   FBottom := AValue;
    2490   Change(False);
    2491 end;
    2492 
    2493 procedure TDpiControlBorderSpacing.SetLeft(AValue: TSpacingSize);
    2494 begin
    2495   if FLeft = AValue then Exit;
    2496   FLeft := AValue;
    2497   Change(False);
    2498 end;
    2499 
    2500 procedure TDpiControlBorderSpacing.SetRight(AValue: TSpacingSize);
    2501 begin
    2502   if FRight = AValue then Exit;
    2503   FRight := AValue;
    2504   Change(False);
    2505 end;
    2506 
    2507 procedure TDpiControlBorderSpacing.SetTop(AValue: TSpacingSize);
    2508 begin
    2509   if FTop = AValue then Exit;
    2510   FTop := AValue;
    2511   Change(False);
    2512 end;
    2513 
    2514 procedure TDpiControlBorderSpacing.Change(InnerSpaceChanged: Boolean);
    2515 begin
    2516   if FControl <> nil then
    2517     FControl.DoBorderSpacingChange(Self, InnerSpaceChanged);
    2518   if Assigned(OnChange) then OnChange(Self);
    2519 end;
    2520 
    2521 constructor TDpiControlBorderSpacing.Create(OwnerControl: TDpiControl;
    2522   ADefault: PControlBorderSpacingDefault);
    2523 begin
    2524   FControl := OwnerControl;
    2525   FDefault := ADefault;
    2526   if ADefault <> nil then
    2527   begin
    2528     FLeft := ADefault^.Left;
    2529     FRight := ADefault^.Right;
    2530     FTop := ADefault^.Top;
    2531     FBottom := ADefault^.Bottom;
    2532     FAround := ADefault^.Around;
    2533   end;
    2534   inherited Create;
    2535 end;
    2536 
    2537 { TDpiEdit }
    2538 
    2539 function TDpiEdit.GetText: TCaption;
    2540 begin
    2541   Result := GetNativeEdit.Text;
    2542 end;
    2543 
    2544 procedure TDpiEdit.SetText(AValue: TCaption);
    2545 begin
    2546   GetNativeEdit.Text := AValue;
    2547 end;
    2548 
    2549 destructor TDpiEdit.Destroy;
    2550 begin
    2551   FreeAndNil(NativeEdit);
    2552   inherited;
    2553 end;
    2554 
    2555 function TDpiEdit.GetSelLength: Integer;
    2556 begin
    2557   Result := GetNativeEdit.SelLength;
    2558 end;
    2559 
    2560 function TDpiEdit.GetSelStart: Integer;
    2561 begin
    2562   Result := GetNativeEdit.SelStart;
    2563 end;
    2564 
    2565 procedure TDpiEdit.SetSelLength(AValue: Integer);
    2566 begin
    2567   GetNativeEdit.SelLength := AValue;
    2568 end;
    2569 
    2570 procedure TDpiEdit.SetSelStart(AValue: Integer);
    2571 begin
    2572   GetNativeEdit.SelStart := AValue;
    2573 end;
    2574 
    2575 function TDpiEdit.GetNativeWinControl: TWinControl;
    2576 begin
    2577   Result := GetNativeEdit;
    2578 end;
    2579 
    2580 function TDpiEdit.GetNativeEdit: TEdit;
    2581 begin
    2582   if not Assigned(NativeEdit) then NativeEdit := TEdit.Create(nil);
    2583   Result := NativeEdit;
    2584 end;
    2585 
    2586 { TDpiMenu }
    2587 
    2588 function TDpiMenu.GetNativeMenu: TMenu;
    2589 begin
    2590   Result := nil;
    2591 end;
    2592 
    2593 constructor TDpiMenu.Create(AOwner: TComponent);
    2594 begin
    2595   inherited;
    2596   FItems := TDpiMenuItem.Create(Self);
    2597 end;
    2598 
    2599 destructor TDpiMenu.Destroy;
    2600 begin
    2601   FreeAndNil(FItems);
    2602   inherited;
    2603 end;
    2604 
    2605 { TDpiMenuItem }
    2606 
    2607 function TDpiMenuItem.GetCaption: TTranslateString;
    2608 begin
    2609   Result := GetNativeMenuItem.Caption;
    2610 end;
    2611 
    2612 function TDpiMenuItem.GetChecked: Boolean;
    2613 begin
    2614   Result := GetNativeMenuItem.Checked;
    2615 end;
    2616 
    2617 function TDpiMenuItem.GetCount: Integer;
    2618 begin
    2619   Result := FItems.Count;
    2620 end;
    2621 
    2622 function TDpiMenuItem.GetEnabled: Boolean;
    2623 begin
    2624   Result := GetNativeMenuItem.Enabled;
    2625 end;
    2626 
    2627 function TDpiMenuItem.GetGroupIndex: Byte;
    2628 begin
    2629   Result := GetNativeMenuItem.GroupIndex;
    2630 end;
    2631 
    2632 function TDpiMenuItem.GetItem(Index: Integer): TDpiMenuItem;
    2633 begin
    2634   Result := TDpiMenuItem(FItems[Index]);
    2635 end;
    2636 
    2637 function TDpiMenuItem.GetOnClick: TNotifyEvent;
    2638 begin
    2639   Result := FOnClick;
    2640 end;
    2641 
    2642 function TDpiMenuItem.GetRadioItem: Boolean;
    2643 begin
    2644   Result := GetNativeMenuItem.RadioItem;
    2645 end;
    2646 
    2647 function TDpiMenuItem.GetShortCut: TShortCut;
    2648 begin
    2649   Result := GetNativeMenuItem.ShortCut;
    2650 end;
    2651 
    2652 function TDpiMenuItem.GetVisible: Boolean;
    2653 begin
    2654   Result := GetNativeMenuItem.Visible;
    2655 end;
    2656 
    2657 function TDpiMenuItem.IsCaptionStored: Boolean;
    2658 begin
    2659   Result := False;
    2660 end;
    2661 
    2662 function TDpiMenuItem.IsCheckedStored: Boolean;
    2663 begin
    2664   Result := False;
    2665 end;
    2666 
    2667 function TDpiMenuItem.IsEnabledStored: Boolean;
    2668 begin
    2669   Result := False;
    2670 end;
    2671 
    2672 function TDpiMenuItem.IsShortCutStored: Boolean;
    2673 begin
    2674   Result := False;
    2675 end;
    2676 
    2677 function TDpiMenuItem.IsVisibleStored: Boolean;
    2678 begin
    2679   Result := False;
    2680 end;
    2681 
    2682 procedure TDpiMenuItem.SetCaption(AValue: TTranslateString);
    2683 begin
    2684   GetNativeMenuItem.Caption := AValue;
    2685 end;
    2686 
    2687 procedure TDpiMenuItem.SetChecked(AValue: Boolean);
    2688 begin
    2689   GetNativeMenuItem.Checked := AValue;
    2690 end;
    2691 
    2692 procedure TDpiMenuItem.SetEnabled(AValue: Boolean);
    2693 begin
    2694   GetNativeMenuItem.Enabled := AValue;
    2695 end;
    2696 
    2697 procedure TDpiMenuItem.SetGroupIndex(AValue: Byte);
    2698 begin
    2699   GetNativeMenuItem.GroupIndex := AValue;
    2700 end;
    2701 
    2702 procedure TDpiMenuItem.SetOnClick(AValue: TNotifyEvent);
    2703 begin
    2704   FOnClick := AValue;
    2705 end;
    2706 
    2707 procedure TDpiMenuItem.SetRadioItem(AValue: Boolean);
    2708 begin
    2709   GetNativeMenuItem.RadioItem := AValue;
    2710 end;
    2711 
    2712 procedure TDpiMenuItem.SetShortCut(AValue: TShortCut);
    2713 begin
    2714   GetNativeMenuItem.ShortCut := AValue;
    2715 end;
    2716 
    2717 procedure TDpiMenuItem.SetVisible(AValue: Boolean);
    2718 begin
    2719   GetNativeMenuItem.Visible := AValue;
    2720 end;
    2721 
    2722 procedure TDpiMenuItem.OnClickHandler(Sender: TObject);
    2723 begin
    2724   if Assigned(FOnClick) then
    2725     FOnClick(Self);
    2726 end;
    2727 
    2728 procedure TDpiMenuItem.Delete(Index: Integer);
    2729 begin
    2730   FItems.Delete(Index);
    2731   GetNativeMenuItem.Delete(Index);
    2732 end;
    2733 
    2734 procedure TDpiMenuItem.Add(Item: TDpiMenuItem);
    2735 begin
    2736   Insert(GetCount, Item);
    2737 end;
    2738 
    2739 procedure TDpiMenuItem.Insert(Index: Integer; Item: TDpiMenuItem);
    2740 begin
    2741   FItems.Insert(Index, Item);
    2742   GetNativeMenuItem.Insert(Index, Item.GetNativeMenuItem);
    2743 end;
    2744 
    2745 function TDpiMenuItem.IndexOf(Item: TDpiMenuItem): Integer;
    2746 begin
    2747   if FItems = nil then
    2748     Result := -1
    2749   else
    2750     Result := FItems.IndexOf(Item);
    2751 end;
    2752 
    2753 procedure TDpiMenuItem.Remove(Item: TDpiMenuItem);
    2754 var
    2755   I: Integer;
    2756 begin
    2757   I := IndexOf(Item);
    2758   if I < 0 then
    2759     raise EMenuError.Create(SMenuNotFound);
    2760   Delete(I);
    2761 end;
    2762 
    2763 procedure TDpiMenuItem.Clear;
    2764 begin
    2765   GetNativeMenuItem.Clear;
    2766 end;
    2767 
    2768 procedure TDpiMenuItem.Click;
    2769 begin
    2770   GetNativeMenuItem.Click;
    2771 end;
    2772 
    2773 function TDpiMenuItem.GetNativeMenuItem: TMenuItem;
    2774 begin
    2775   if not Assigned(NativeMenuItem) then begin
    2776     NativeMenuItem := TMenuItem.Create(nil);
    2777     NativeMenuItem.Name := 'Native' + Name;
    2778     NativeMenuItem.OnClick := OnClickHandler;
    2779   end;
    2780   Result := NativeMenuItem;
    2781 end;
    2782 
    2783 procedure TDpiMenuItem.SetParentComponent(AValue: TComponent);
    2784 begin
    2785   if (FParent = AValue) then Exit;
    2786   if Assigned(FParent) then FParent.Remove(Self);
    2787   if Assigned(AValue) then
    2788   begin
    2789     if (AValue is TDpiMenu)
    2790       then TDpiMenu(AValue).Items.Add(Self)
    2791     else if (AValue is TDpiMenuItem)
    2792       then TDpiMenuItem(AValue).Add(Self)
    2793     else
    2794       raise Exception.Create('TDpiMenuItem.SetParentComponent: suggested parent not of type TDpiMenu or TDpiMenuItem');
    2795    end;
    2796 end;
    2797 
    2798 constructor TDpiMenuItem.Create(AOwner: TComponent);
    2799 begin
    2800   inherited;
    2801   FItems := TList.Create;
    2802 end;
    2803 
    2804 destructor TDpiMenuItem.Destroy;
    2805 begin
    2806   FreeAndNil(FItems);
    2807   // TODO: Release menu items
    2808   //FreeAndNil(NativeMenuItem);
    2809   inherited;
    2810 end;
    2811 
    2812 { TDpiPopupMenu }
    2813 
    2814 procedure TDpiPopupMenu.PopUp;
    2815 var
    2816   Pos: TPoint;
    2817 begin
    2818   Pos := DpiMouse.CursorPos;
    2819   Popup(Pos.X, Pos.Y);
    2820 end;
    2821 
    2822 procedure TDpiPopupMenu.PopUp(X, Y: Integer);
    2823 begin
    2824   GetNativePopupMenu.PopUp(ScaleToNative(X), ScaleToNative(Y));
    2825 end;
    2826 
    2827 constructor TDpiPopupMenu.Create(AOwner: TComponent);
    2828 begin
    2829   inherited;
    2830   GetNativePopupMenu;
    2831 end;
    2832 
    2833 function TDpiPopupMenu.GetAutoPopup: Boolean;
    2834 begin
    2835   Result := GetNativePopupMenu.AutoPopup;
    2836 end;
    2837 
    2838 procedure TDpiPopupMenu.SetAutoPopup(AValue: Boolean);
    2839 begin
    2840   GetNativePopupMenu.AutoPopup := AValue;
    2841 end;
    2842 
    2843 function TDpiPopupMenu.GetNativeMenu: TMenu;
    2844 begin
    2845   Result := GetNativePopupMenu;
    2846 end;
    2847 
    2848 function TDpiPopupMenu.GetNativePopupMenu: TPopupMenu;
    2849 begin
    2850   if not Assigned(NativePopupMenu) then begin
    2851     NativePopupMenu := TPopupMenu.Create(nil);
    2852     if Assigned(Items.NativeMenuItem) then Items.NativeMenuItem.Free;
    2853     Items.NativeMenuItem := NativePopupMenu.Items;
    2854   end;
    2855   Result := NativePopupMenu;
    2856 end;
    2857 
    2858 destructor TDpiPopupMenu.Destroy;
    2859 begin
    2860   if Assigned(NativePopupMenu) then FreeAndNil(NativePopupMenu);
    2861   inherited;
    2862 end;
    2863 
    2864 { TDpiMouse }
    2865 
    2866 function TDpiMouse.GetCursorPos: TPoint;
    2867 begin
    2868   Result := ScalePointFromNative(Mouse.CursorPos);
    2869 end;
    2870 
    2871 procedure TDpiMouse.SetCursorPos(AValue: TPoint);
    2872 begin
    2873   Mouse.CursorPos := ScalePointToNative(AValue);
    2874 end;
    2875 
    2876 constructor TDpiMouse.Create;
    2877 begin
    2878 
    2879 end;
    2880 
    2881 { TDpiSizeConstraints }
    2882 
    2883 procedure TDpiSizeConstraints.SetMaxHeight(AValue: TConstraintSize);
    2884 begin
    2885   if FMaxHeight=AValue then Exit;
    2886   FMaxHeight:=AValue;
    2887 end;
    2888 
    2889 procedure TDpiSizeConstraints.SetMaxWidth(AValue: TConstraintSize);
    2890 begin
    2891   if FMaxWidth=AValue then Exit;
    2892   FMaxWidth:=AValue;
    2893 end;
    2894 
    2895 procedure TDpiSizeConstraints.SetMinHeight(AValue: TConstraintSize);
    2896 begin
    2897   if FMinHeight=AValue then Exit;
    2898   FMinHeight:=AValue;
    2899 end;
    2900 
    2901 procedure TDpiSizeConstraints.SetMinWidth(AValue: TConstraintSize);
    2902 begin
    2903   if FMinWidth=AValue then Exit;
    2904   FMinWidth:=AValue;
    2905 end;
    2906 
    2907 { TDpiScrollingWinControl }
    2908 
    2909 function TDpiScrollingWinControl.GetNativeCustomControl: TCustomControl;
    2910 begin
    2911   Result := GetNativeScrollingWinControl;
    2912 end;
    2913 
    2914 function TDpiScrollingWinControl.GetNativeScrollingWinControl: TScrollingWinControl;
    2915 begin
    2916   Result := nil;
    2917 end;
    2918 
    2919 constructor TDpiScrollingWinControl.Create(TheOwner: TComponent);
    2920 begin
    2921   inherited;
    2922   FHorzScrollBar := TDpiControlScrollBar.Create;
    2923   FVertScrollBar := TDpiControlScrollBar.Create;
    2924 end;
    2925 
    2926 destructor TDpiScrollingWinControl.Destroy;
    2927 begin
    2928   FreeAndNil(FHorzScrollBar);
    2929   FreeAndNil(FVertScrollBar);
    2930   inherited;
    2931 end;
    2932 
    2933 { TDpiControlScrollBar }
    2934 
    2935 function TDpiControlScrollBar.GetVisible: Boolean;
    2936 begin
    2937 
    2938 end;
    2939 
    2940 procedure TDpiControlScrollBar.SetVisible(AValue: Boolean);
    2941 begin
    2942 
    2943 end;
    2944 
    2945 { TGraphicControlEx }
    2946 
    2947 procedure TGraphicControlEx.Paint;
    2948 begin
    2949   inherited Paint;
    2950 end;
    2951 
    2952 { TFormEx }
    2953 
    2954 procedure TFormEx.WndProc(var TheMessage: TLMessage);
    2955 begin
    2956   inherited WndProc(TheMessage);
    2957   if Assigned(FOnMessage) then
    2958     FOnMessage(TheMessage);
    2959 end;
    2960 
    2961 { TDpiApplication }
    2962 
    2963 procedure TDpiApplication.SetMainForm(AValue: TDpiForm);
    2964 begin
    2965   FMainForm := AValue;
    2966 end;
    2967 
    2968 function TDpiApplication.GetTitle: string;
    2969 begin
    2970   Result := GetNativeApplication.Title;
    2971 end;
    2972 
    2973 function TDpiApplication.GetShowMainForm: Boolean;
    2974 begin
    2975   Result := GetNativeApplication.ShowMainForm;
    2976 end;
    2977 
    2978 function TDpiApplication.GetTaskBarBehavior: TTaskBarBehavior;
    2979 begin
    2980   Result := GetNativeApplication.TaskBarBehavior;
    2981 end;
    2982 
    2983 function TDpiApplication.GetActive: Boolean;
    2984 begin
    2985   Result := GetNativeApplication.Active;
    2986 end;
    2987 
    2988 function TDpiApplication.GetExeName: string;
    2989 begin
    2990   Result := GetNativeApplication.ExeName;
    2991 end;
    2992 
    2993 function TDpiApplication.GetMainForm: TDpiForm;
    2994 begin
    2995   Result := FMainForm;
    2996 end;
    2997 
    2998 procedure TDpiApplication.SetShowMainForm(AValue: Boolean);
    2999 begin
    3000   GetNativeApplication.ShowMainForm := AValue;
    3001 end;
    3002 
    3003 procedure TDpiApplication.SetTaskBarBehavior(AValue: TTaskBarBehavior);
    3004 begin
    3005   GetNativeApplication.TaskBarBehavior := AValue;
    3006 end;
    3007 
    3008 procedure TDpiApplication.SetTitle(AValue: string);
    3009 begin
    3010   GetNativeApplication.Title := AValue;
    3011 end;
    3012 
    3013 function TDpiApplication.GetNativeApplication: TApplication;
    3014 begin
    3015   Result := Application;
    3016 end;
    3017 
    3018 procedure DpiBeforeFinalization;
    3019 // This is our ExitProc handler.
    3020 begin
    3021   DpiApplication.DoBeforeFinalization;
    3022 end;
    3023 
    3024 procedure TDpiApplication.DoBeforeFinalization;
    3025 var
    3026   I: Integer;
    3027 begin
    3028   if Self = nil then Exit;
    3029   for I := ComponentCount - 1 downto 0 do begin
    3030     if I < ComponentCount then
    3031       Components[I].Free;
    3032   end;
    3033 end;
    3034 
    3035 function DpiFindApplicationComponent(const ComponentName: string): TComponent;
    3036 // Note: this function is used by TReader to auto rename forms to unique names.
    3037 begin
    3038   Result := DpiApplication.FindComponent(ComponentName);
    3039 end;
    3040 
    3041 constructor TDpiApplication.Create(AOwner: TComponent);
    3042 begin
    3043   RegisterFindGlobalComponentProc(@DpiFindApplicationComponent);
    3044   FOldExitProc := ExitProc;
    3045   ExitProc := @DpiBeforeFinalization;
    3046   inherited;
    3047 end;
    3048 
    3049 destructor TDpiApplication.Destroy;
    3050 begin
    3051   UnregisterFindGlobalComponentProc(@DpiFindApplicationComponent);
    3052   ExitProc := FOldExitProc;
    3053   inherited;
    3054 end;
    3055 
    3056 procedure TDpiApplication.Run;
    3057 begin
    3058   if (FMainForm <> nil) and GetShowMainForm then FMainForm.Show;
    3059   GetNativeApplication.Run;
    3060 end;
    3061 
    3062 procedure TDpiApplication.Initialize;
    3063 begin
    3064   GetNativeApplication.Initialize;
    3065   DpiScreen.UpdateScreen;
    3066 end;
    3067 
    3068 procedure TDpiApplication.Terminate;
    3069 begin
    3070   Application.Terminate;
    3071 end;
    3072 
    3073 procedure TDpiApplication.ProcessMessages;
    3074 begin
    3075   GetNativeApplication.ProcessMessages;
    3076 end;
    3077 
    3078 procedure TDpiApplication.UpdateMainForm(AForm: TDpiForm);
    3079 begin
    3080   if (FMainForm = nil)
    3081   and (FCreatingForm = AForm)
    3082   //and (not (AppDestroying in FFlags))
    3083   and not (AForm.FormStyle in [fsMDIChild, fsSplash])
    3084   then
    3085     FMainForm := AForm;
    3086   GetNativeApplication.UpdateMainForm(AForm.GetNativeForm);
    3087 end;
    3088 
    3089 procedure TDpiApplication.CreateForm(InstanceClass: TComponentClass; out
    3090   Reference);
    3091 var
    3092   Instance: TComponent;
    3093   Ok: Boolean;
    3094   AForm: TDpiForm;
    3095 begin
    3096   // Allocate the instance, without calling the constructor
    3097   Instance := TComponent(InstanceClass.NewInstance);
    3098   // set the Reference before the constructor is called, so that
    3099   // events and constructors can refer to it
    3100   TComponent(Reference) := Instance;
    3101 
    3102   Ok := False;
    3103   try
    3104     if (FCreatingForm = nil) and (Instance is TDpiForm) then
    3105       FCreatingForm := TDpiForm(Instance);
    3106     Instance.Create(Self);
    3107     Ok := true;
    3108   finally
    3109     if not Ok then begin
    3110       TComponent(Reference) := nil;
    3111       if FCreatingForm = Instance then
    3112         FCreatingForm := nil;
    3113     end;
    3114   end;
    3115 
    3116   if (Instance is TDpiForm) then begin
    3117     AForm := TDpiForm(Instance);
    3118     UpdateMainForm(AForm);
    3119     if FMainForm = AForm then AForm.GetNativeForm.HandleNeeded;
    3120     if AForm.FormStyle = fsSplash then begin
    3121       // show the splash form and handle the paint message
    3122       AForm.Show;
    3123       AForm.Invalidate;
    3124       ProcessMessages;
    3125     end;
    3126   end;
    3127 end;
    3128 
    3129 function TDpiApplication.MessageBox(Text, Caption: PChar; Flags: Longint
    3130   ): Integer;
    3131 begin
    3132   Result := Application.MessageBox(Text, Caption, Flags);
    3133 end;
    3134 
    3135 { TDpiJpegImage }
    3136 
    3137 function TDpiJpegImage.GetNativeBitmap: TCustomBitmap;
    3138 begin
    3139   Result := GetNativeJpeg;
    3140 end;
    3141 
    3142 function TDpiJpegImage.GetNativeJpeg: TJPEGImage;
    3143 begin
    3144   Result := NativeJpeg;
    3145 end;
    3146 
    3147 constructor TDpiJpegImage.Create;
    3148 begin
    3149   NativeJpeg := TJPEGImage.Create;
    3150   inherited;
    3151   NativeGraphicClass := TJPEGImage;
    3152 end;
    3153 
    3154 destructor TDpiJpegImage.Destroy;
    3155 begin
    3156   FreeAndNil(NativeJpeg);
    3157   inherited Destroy;
    3158 end;
    3159 
    3160 { TDpiPortableNetworkGraphic }
    3161 
    3162 function TDpiPortableNetworkGraphic.GetNativeBitmap: TCustomBitmap;
    3163 begin
    3164   Result := GetNativePng;
    3165 end;
    3166 
    3167 function TDpiPortableNetworkGraphic.GetNativePng: TPortableNetworkGraphic;
    3168 begin
    3169   Result := NativePng;
    3170 end;
    3171 
    3172 constructor TDpiPortableNetworkGraphic.Create;
    3173 begin
    3174   NativePng := TPortableNetworkGraphic.Create;
    3175   inherited;
    3176   NativeGraphicClass := TPortableNetworkGraphic;
    3177 end;
    3178 
    3179 destructor TDpiPortableNetworkGraphic.Destroy;
    3180 begin
    3181   Canvas.NativeCanvas := nil;
    3182   FreeAndNil(NativePng);
    3183   inherited;
    3184 end;
    3185 
    3186 { TDpiCustomControl }
    3187 
    3188 function TDpiCustomControl.GetOnPaint: TNotifyEvent;
    3189 begin
    3190   Result := GetNativeCustomControl.OnPaint;
    3191 end;
    3192 
    3193 function TDpiCustomControl.GetPixelsPerInch: Integer;
    3194 begin
    3195   //Result := GetNativeCustomControl.Pix;
    3196 end;
    3197 
    3198 function TDpiCustomControl.GetCanvas: TDpiCanvas;
    3199 begin
    3200   Result := FCanvas;
    3201 end;
    3202 
    3203 procedure TDpiCustomControl.SetOnPaint(AValue: TNotifyEvent);
    3204 begin
    3205   GetNativeCustomControl.OnPaint := AValue;
    3206 end;
    3207 
    3208 procedure TDpiCustomControl.SetPixelsPerInch(AValue: Integer);
    3209 begin
    3210 
    3211 end;
    3212 
    3213 function TDpiCustomControl.GetNativeWinControl: TWinControl;
    3214 begin
    3215   Result := GetNativeCustomControl;
    3216 end;
    3217 
    3218 function TDpiCustomControl.GetNativeCustomControl: TCustomControl;
    3219 begin
    3220   Result := nil;
    3221 end;
    3222 
    3223 constructor TDpiCustomControl.Create(TheOwner: TComponent);
    3224 begin
    3225   inherited;
    3226   FCanvas := TDpiCanvas.Create;
    3227   FCanvas.NativeCanvas := GetNativeCustomControl.Canvas;
    3228 end;
    3229 
    3230 destructor TDpiCustomControl.Destroy;
    3231 begin
    3232   FreeAndNil(FCanvas);
    3233   inherited;
    3234 end;
    3235 
    3236 { TDpiScrollBar }
    3237 
    3238 function TDpiScrollBar.GetKind: TScrollBarKind;
    3239 begin
    3240   Result := NativeScrollBar.Kind;
    3241 end;
    3242 
    3243 function TDpiScrollBar.GetMax: Integer;
    3244 begin
    3245   Result := NativeScrollBar.Max;
    3246 end;
    3247 
    3248 function TDpiScrollBar.GetMin: Integer;
    3249 begin
    3250   Result := NativeScrollBar.Min;
    3251 end;
    3252 
    3253 function TDpiScrollBar.GetOnChange: TNotifyEvent;
    3254 begin
    3255   Result := NativeScrollBar.OnChange;
    3256 end;
    3257 
    3258 function TDpiScrollBar.GetPageSize: Integer;
    3259 begin
    3260   Result := NativeScrollBar.PageSize;
    3261 end;
    3262 
    3263 function TDpiScrollBar.GetPosition: Integer;
    3264 begin
    3265   Result := NativeScrollBar.Position;
    3266 end;
    3267 
    3268 procedure TDpiScrollBar.SetKind(AValue: TScrollBarKind);
    3269 begin
    3270   NativeScrollBar.Kind := AValue;
    3271 end;
    3272 
    3273 procedure TDpiScrollBar.SetMax(AValue: Integer);
    3274 begin
    3275   NativeScrollBar.Max := AValue;
    3276 end;
    3277 
    3278 procedure TDpiScrollBar.SetMin(AValue: Integer);
    3279 begin
    3280   NativeScrollBar.Min := Avalue;
    3281 end;
    3282 
    3283 procedure TDpiScrollBar.SetOnChange(AValue: TNotifyEvent);
    3284 begin
    3285   NativeScrollBar.OnChange := AValue;
    3286 end;
    3287 
    3288 procedure TDpiScrollBar.SetPageSize(AValue: Integer);
    3289 begin
    3290   NativeScrollBar.PageSize := AValue;
    3291 end;
    3292 
    3293 procedure TDpiScrollBar.SetPosition(AValue: Integer);
    3294 begin
    3295   NativeScrollBar.Position := AValue;
    3296 end;
    3297 
    3298 function TDpiScrollBar.GetNativeControl: TControl;
    3299 begin
    3300   if not Assigned(NativeScrollBar) then NativeScrollBar := TScrollBar.Create(nil);
    3301   Result := NativeScrollBar;
    3302 end;
    3303 
    3304 constructor TDpiScrollBar.Create(TheOwner: TComponent);
    3305 begin
    3306   inherited;
    3307 end;
    3308 
    3309 destructor TDpiScrollBar.Destroy;
    3310 begin
    3311   FreeAndNil(NativeScrollBar);
    3312   inherited;
    3313 end;
    3314 
    3315 { TDpiRasterImage }
    3316 
    3317 function TDpiRasterImage.GetRawImage: TRawImage;
    3318 begin
    3319   Result := GetNativeRasterImage.RawImage;
    3320 end;
    3321 
    3322 function TDpiRasterImage.GetNativeRasterImage: TRasterImage;
    3323 begin
    3324   Result := nil;
    3325 end;
    3326 
    3327 procedure TDpiRasterImage.BeginUpdate(ACanvasOnly: Boolean);
    3328 begin
    3329   GetNativeRasterImage.BeginUpdate(ACanvasOnly);
    3330 end;
    3331 
    3332 procedure TDpiRasterImage.EndUpdate(AStreamIsValid: Boolean);
    3333 begin
    3334   GetNativeRasterImage.EndUpdate(AStreamIsValid);
    3335 end;
    3336 
    3337 function TDpiRasterImage.GetNativeGraphic: TGraphic;
    3338 begin
    3339   Result := GetNativeRasterImage;
    3340 end;
    3341 
    3342 { TDpiGraphic }
    3343 
    3344 function TDpiGraphic.GetNativeGraphic: TGraphic;
    3345 begin
    3346   Result := nil;
    3347 end;
    3348 
    3349 procedure TDpiGraphic.ScreenChanged;
    3350 begin
    3351 end;
    3352 
    3353 procedure TDpiGraphic.SetDpi(AValue: Integer);
    3354 begin
    3355   FDpi := AValue;
    3356   ScreenChanged;
    3357 end;
    3358 
    3359 function TDpiGraphic.GetDpi: Integer;
    3360 begin
    3361   Result := FDpi;
    3362 end;
    3363 
    3364 constructor TDpiGraphic.Create;
    3365 begin
    3366   Dpi := DpiScreen.Dpi;
    3367 end;
    3368 
    3369 procedure StretchDrawBitmap(Src: TRasterImage; Dst: TBitmap);
    3370 var
    3371   SrcPtr: TPixelPointer;
    3372   DstPtr: TPixelPointer;
    3373   xx, yy: Integer;
    3374   SrcX, SrcY: Integer;
    3375   DstX, DstY: Integer;
    3376   DstWidth, DstHeight: Integer;
    3377 begin
    3378   Dst.BeginUpdate;
    3379   SrcPtr := PixelPointer(Src, 0, 0);
    3380   DstPtr := PixelPointer(Dst, 0, 0);
    3381   {for yy := 0 to Dst.Height - 1 do begin
    3382     for xx := 0 to Dst.Width - 1 do begin
    3383       SrcPtr.SetXY(Min(ScaleFromNative(xx), Src.Width - 1),
    3384         Min(ScaleFromNative(yy), Src.Height - 1));
    3385       DstPtr.Pixel^.B := SrcPtr.Pixel^.B;
    3386       DstPtr.Pixel^.G := SrcPtr.Pixel^.G;
    3387       DstPtr.Pixel^.R := SrcPtr.Pixel^.R;
    3388       DstPtr.NextPixel;
    3389     end;
    3390     DstPtr.NextLine;
    3391   end;
    3392   }
    3393   for SrcY := 0 to Src.Height - 1 do begin
    3394     DstHeight := ScaleToNative(SrcY + 1) - ScaleToNative(SrcY);
    3395     for DstY := 0 to DstHeight - 1 do begin
    3396       for SrcX := 0 to Src.Width - 1 do begin
    3397         DstWidth := ScaleToNative(SrcX + 1) - ScaleToNative(SrcX);
    3398         for DstX := 0 to DstWidth - 1 do begin
    3399           DstPtr.Pixel^.B := SrcPtr.Pixel^.B;
    3400           DstPtr.Pixel^.G := SrcPtr.Pixel^.G;
    3401           DstPtr.Pixel^.R := SrcPtr.Pixel^.R;
    3402           DstPtr.NextPixel;
    3403         end;
    3404         SrcPtr.NextPixel;
    3405       end;
    3406       DstPtr.NextLine;
    3407       SrcPtr.SetX(0);
    3408     end;
    3409     SrcPtr.NextLine;
    3410   end;
    3411   Dst.EndUpdate;
    3412 end;
    3413 
    3414 procedure TDpiGraphic.LoadFromFile(const Filename: string);
    3415 var
    3416   Bitmap: TGraphic;
    3417 begin
    3418   Bitmap := NativeGraphicClass.Create;
    3419   try
    3420     Bitmap.LoadFromFile(FileName);
    3421     Width := Bitmap.Width;
    3422     Height := Bitmap.Height;
    3423     if Self is TDpiBitmap then begin
    3424       StretchDrawBitmap(TRasterImage(Bitmap), TBitmap(GetNativeGraphic));
    3425       //TBitmap(GetNativeGraphic).Canvas.StretchDraw(Bounds(0, 0,
    3426       //TBitmap(GetNativeGraphic).Width, TBitmap(GetNativeGraphic).Height), Bitmap);
    3427     end else raise Exception.Create('Unsupported class ' + Self.ClassName);
    3428   finally
    3429     FreeAndNil(Bitmap);
    3430   end;
    3431 end;
    3432 
    3433 procedure TDpiGraphic.SaveToFile(const Filename: string);
    3434 var
    3435   Bitmap: TGraphic;
    3436 begin
    3437   Bitmap := NativeGraphicClass.Create;
    3438   try
    3439     Bitmap.Width := Width;
    3440     Bitmap.Height := Height;
    3441     if Self is TDpiBitmap then begin
    3442       if Bitmap is TRasterImage then
    3443         (Bitmap as TRasterImage).Canvas.StretchDraw(Bounds(0, 0, Bitmap.Width, Bitmap.Height), TBitmap(GetNativeGraphic))
    3444         else raise Exception.Create('Expected TRasterImage but got ' + Bitmap.ClassName);
    3445     end else raise Exception.Create('Unsupported class ' + Self.ClassName);
    3446     Bitmap.SaveToFile(FileName);
    3447   finally
    3448     FreeAndNil(Bitmap);
    3449   end;
    3450 end;
    3451 
    3452 { TDpiBitmap }
    3453 
    3454 function TDpiBitmap.GetHeight: Integer;
    3455 begin
    3456   Result := FHeight;
    3457 end;
    3458 
    3459 function TDpiBitmap.GetCanvas: TDpiCanvas;
    3460 begin
    3461   Result := FCanvas;
    3462 end;
    3463 
    3464 function TDpiBitmap.GetPixelFormat: TPixelFormat;
    3465 begin
    3466   Result := GetNativeBitmap.PixelFormat;
    3467 end;
    3468 
    3469 function TDpiBitmap.GetScanLine(Row: Integer): Pointer;
    3470 begin
    3471   Result := GetNativeBitmap.ScanLine[Row];
    3472 end;
    3473 
    3474 function TDpiBitmap.GetTransparent: Boolean;
    3475 begin
    3476   Result := GetNativeBitmap.Transparent;
    3477 end;
    3478 
    3479 function TDpiBitmap.GetTransparentColor: TColor;
    3480 begin
    3481   Result := GetNativeBitmap.TransparentColor;
    3482 end;
    3483 
    3484 function TDpiBitmap.GetWidth: Integer;
    3485 begin
    3486   Result := FWidth;
    3487 end;
    3488 
    3489 procedure TDpiBitmap.SetHeight(AValue: Integer);
    3490 begin
    3491   FHeight := AValue;
    3492   GetNativeBitmap.Height := ScaleToNative(AValue);
    3493 end;
    3494 
    3495 procedure TDpiBitmap.SetPixelFormat(AValue: TPixelFormat);
    3496 begin
    3497   GetNativeBitmap.PixelFormat := AValue;
    3498 end;
    3499 
    3500 procedure TDpiBitmap.SetTransparent(AValue: Boolean);
    3501 begin
    3502   GetNativeBitmap.Transparent := AValue;
    3503 end;
    3504 
    3505 procedure TDpiBitmap.SetTransparentColor(AValue: TColor);
    3506 begin
    3507   GetNativeBitmap.TransparentColor := AValue;
    3508 end;
    3509 
    3510 procedure TDpiBitmap.SetWidth(AValue: Integer);
    3511 begin
    3512   FWidth := AValue;
    3513   GetNativeBitmap.Width := ScaleToNative(AValue);
    3514 end;
    3515 
    3516 procedure TDpiBitmap.ScreenChanged;
    3517 var
    3518   Bitmap: TBitmap;
    3519   NewWidth: Integer;
    3520   NewHeight: Integer;
    3521 begin
    3522   NewWidth := ScaleToNative(Width);
    3523   NewHeight := ScaleToNative(Height);
    3524   if Assigned(NativeBitmap) and ((NewWidth <> NativeBitmap.Width) or (NewHeight <> NativeBitmap.Height)) then begin
    3525     // Rescale bitmap to new size
    3526     Bitmap := TBitmap.Create;
    3527     Bitmap.SetSize(NewWidth, NewHeight);
    3528     Bitmap.PixelFormat := NativeBitmap.PixelFormat;
    3529     Bitmap.Canvas.StretchDraw(Bounds(0, 0, NewWidth, NewHeight), NativeBitmap);
    3530     FreeAndNil(NativeBitmap);
    3531     NativeBitmap := Bitmap;
    3532     Canvas.NativeCanvas := NativeBitmap.Canvas;
    3533   end;
    3534 end;
    3535 
    3536 function TDpiBitmap.GetNativeBitmap: TCustomBitmap;
    3537 begin
    3538   Result := NativeBitmap;
    3539 end;
    3540 
    3541 procedure TDpiBitmap.BeginUpdate;
    3542 begin
    3543   GetNativeBitmap.BeginUpdate;
    3544 end;
    3545 
    3546 procedure TDpiBitmap.EndUpdate;
    3547 begin
    3548   GetNativeBitmap.EndUpdate;
    3549 end;
    3550 
    3551 procedure TDpiBitmap.SetSize(AWidth, AHeight: Integer);
    3552 begin
    3553   FWidth := AWidth;
    3554   FHeight := AHeight;
    3555   GetNativeBitmap.SetSize(ScaleToNative(AWidth), ScaleToNative(AHeight));
    3556 end;
    3557 
    3558 constructor TDpiBitmap.Create;
    3559 begin
    3560   inherited;
    3561   NativeGraphicClass := TBitmap;
    3562   NativeBitmap := TBitmap.Create;
    3563   FCanvas := TDpiCanvas.Create;
    3564   FCanvas.NativeCanvas := GetNativeBitmap.Canvas;
    3565 end;
    3566 
    3567 destructor TDpiBitmap.Destroy;
    3568 begin
    3569   FreeAndNil(FCanvas);
    3570   FreeAndNil(NativeBitmap);
    3571   inherited;
    3572 end;
    3573 
    3574 procedure TDpiBitmap.Assign(Source: TPersistent);
    3575 begin
    3576   if Source is TDpiBitmap then begin
    3577     GetNativeBitmap.Assign((Source as TDpiBitmap).GetNativeBitmap);
    3578   end else inherited;
    3579 end;
    3580 
    3581 function TDpiBitmap.GetNativeRasterImage: TRasterImage;
    3582 begin
    3583   Result := GetNativeBitmap;
    3584 end;
    3585 
    3586 { TDpiListBox }
    3587 
    3588 function TDpiListBox.GetBorderStyle: TBorderStyle;
    3589 begin
    3590   Result := GetNativeListBox.BorderStyle;
    3591 end;
    3592 
    3593 function TDpiListBox.GetCount: Integer;
    3594 begin
    3595   Result := GetNativeListBox.Count;
    3596 end;
    3597 
    3598 function TDpiListBox.GetExtendedSelect: Boolean;
    3599 begin
    3600   Result := GetNativeListBox.ExtendedSelect;
    3601 end;
    3602 
    3603 function TDpiListBox.GetIntegralHeight: Boolean;
    3604 begin
    3605   Result := GetNativeListBox.IntegralHeight;
    3606 end;
    3607 
    3608 function TDpiListBox.GetItemHeight: Integer;
    3609 begin
    3610   Result := GetNativeListBox.ItemHeight;
    3611 end;
    3612 
    3613 function TDpiListBox.GetItemIndex: Integer;
    3614 begin
    3615   Result := GetNativeListBox.ItemIndex;
    3616 end;
    3617 
    3618 function TDpiListBox.GetItems: TStrings;
    3619 begin
    3620   Result := GetNativeListBox.Items;
    3621 end;
    3622 
    3623 function TDpiListBox.GetOnSelectionChange: TSelectionChangeEvent;
    3624 begin
    3625   Result := GetNativeListBox.OnSelectionChange;
    3626 end;
    3627 
    3628 function TDpiListBox.GetParentFont: Boolean;
    3629 begin
    3630   Result := GetNativeListBox.ParentFont;
    3631 end;
    3632 
    3633 function TDpiListBox.GetScrollWidth: Integer;
    3634 begin
    3635   Result := GetNativeListBox.ScrollWidth;
    3636 end;
    3637 
    3638 function TDpiListBox.GetTopIndex: Integer;
    3639 begin
    3640   Result := GetNativeListBox.TopIndex;
    3641 end;
    3642 
    3643 procedure TDpiListBox.SetBorderStyle(AValue: TBorderStyle);
    3644 begin
    3645   GetNativeListBox.BorderStyle := AValue;
    3646 end;
    3647 
    3648 procedure TDpiListBox.SetExtendedSelect(AValue: Boolean);
    3649 begin
    3650   GetNativeListBox.ExtendedSelect := AValue;
    3651 end;
    3652 
    3653 procedure TDpiListBox.SetIntegralHeight(AValue: Boolean);
    3654 begin
    3655   GetNativeListBox.IntegralHeight := AValue;
    3656 end;
    3657 
    3658 procedure TDpiListBox.SetItemHeight(AValue: Integer);
    3659 begin
    3660   GetNativeListBox.ItemHeight := AValue;
    3661 end;
    3662 
    3663 procedure TDpiListBox.SetItemIndex(AValue: Integer);
    3664 begin
    3665   GetNativeListBox.ItemIndex := AValue;
    3666 end;
    3667 
    3668 procedure TDpiListBox.SetItems(AValue: TStrings);
    3669 begin
    3670   GetNativeListBox.Items := AValue;
    3671 end;
    3672 
    3673 procedure TDpiListBox.SetOnSelectionChange(AValue: TSelectionChangeEvent);
    3674 begin
    3675   GetNativeListBox.OnSelectionChange := AValue;
    3676 end;
    3677 
    3678 procedure TDpiListBox.SetParentFont(AValue: Boolean);
    3679 begin
    3680   GetNativeListBox.ParentFont := AValue;
    3681 end;
    3682 
    3683 procedure TDpiListBox.SetScrollWidth(AValue: Integer);
    3684 begin
    3685   GetNativeListBox.ScrollWidth := AValue;
    3686 end;
    3687 
    3688 procedure TDpiListBox.SetTopIndex(AValue: Integer);
    3689 begin
    3690   GetNativeListBox.TopIndex := AValue;
    3691 end;
    3692 
    3693 function TDpiListBox.GetNativeWinControl: TWinControl;
    3694 begin
    3695   Result := GetNativeListBox;
    3696 end;
    3697 
    3698 function TDpiListBox.GetNativeListBox: TListBox;
    3699 begin
    3700   if not Assigned(NativeListBox) then NativeListBox := TListBox.Create(nil);
    3701   Result := NativeListBox;
    3702 end;
    3703 
    3704 destructor TDpiListBox.Destroy;
    3705 begin
    3706   FreeAndNil(NativeListBox);
    3707   inherited Destroy;
    3708 end;
    3709 
    3710 { TDpiPaintBox }
    3711 
    3712 function TDpiPaintBox.GetNativeGraphicControl: TGraphicControl;
    3713 begin
    3714   if not Assigned(NativePaintBox) then NativePaintBox := TPaintBox.Create(nil);
    3715   Result := NativePaintBox;
    3716 end;
    3717 
    3718 constructor TDpiPaintBox.Create(TheOwner: TComponent);
    3719 begin
    3720   inherited;
    3721   Canvas := TDpiCanvas.Create;
    3722   Canvas.NativeCanvas := NativePaintBox.Canvas;
    3723   UpdateNativeControl;
    3724   ScreenChanged;
    3725 end;
    3726 
    3727 destructor TDpiPaintBox.Destroy;
    3728 begin
    3729   FreeAndNil(NativePaintBox);
    3730   inherited;
    3731 end;
    3732 
    3733 { TDpiPicture }
    3734 
    3735 procedure TDpiPicture.SetBitmap(AValue: TDpiBitmap);
    3736 begin
    3737   if FBitmap = AValue then Exit;
    3738   FBitmap := AValue;
    3739 end;
    3740 
    3741 procedure TDpiPicture.LoadFromFile(FileName: string);
    3742 begin
    3743 end;
    3744 
    3745 { TDpiCanvas }
    3746 
    3747 function TDpiCanvas.GetHandle: HDC;
    3748 begin
    3749   Result := GetNativeCanvas.Handle;
    3750 end;
    3751 
    3752 function TDpiCanvas.GetHeight: Integer;
    3753 begin
    3754   Result := ScaleFromNative(GetNativeCanvas.Height);
    3755 end;
    3756 
    3757 function TDpiCanvas.GetPixel(X, Y: Integer): TColor;
    3758 begin
    3759   Result := GetNativeCanvas.Pixels[ScaleToNative(X), ScaleToNative(Y)];
    3760 end;
    3761 
    3762 function TDpiCanvas.GetWidth: Integer;
    3763 begin
    3764   Result := ScaleFromNative(GetNativeCanvas.Width);
    3765 end;
    3766 
    3767 procedure TDpiCanvas.SetBrush(AValue: TDpiBrush);
    3768 begin
    3769   if FBrush = AValue then Exit;
    3770   if FBrushFree then FreeAndNil(FBrush);
    3771   FBrushFree := False;
    3772   FBrush := AValue;
    3773 end;
    3774 
    3775 procedure TDpiCanvas.SetFont(AValue: TDpiFont);
    3776 begin
    3777   if FFont = AValue then Exit;
    3778   if FFontFree then FreeAndNil(FFont);
    3779   FFontFree := False;
    3780   FFont := AValue;
    3781 end;
    3782 
    3783 procedure TDpiCanvas.SetHandle(AValue: HDC);
    3784 begin
    3785   GetNativeCanvas.Handle := AValue;
    3786 end;
    3787 
    3788 procedure TDpiCanvas.SetHeight(AValue: Integer);
    3789 begin
    3790   GetNativeCanvas.Height;
    3791 end;
    3792 
    3793 procedure TDpiCanvas.SetWidth(AValue: Integer);
    3794 begin
    3795 
    3796 end;
    3797 
    3798 procedure TDpiCanvas.SetPen(AValue: TDpiPen);
    3799 begin
    3800   if FPen = AValue then Exit;
    3801   if FPenFree then FreeAndNil(FPen);
    3802   FPenFree := False;
    3803   FPen := AValue;
    3804 end;
    3805 
    3806 procedure TDpiCanvas.SetPixel(X, Y: Integer; AValue: TColor);
    3807 var
    3808   BrushStyle: TBrushStyle;
    3809   BrushColor: TColor;
    3810 begin
    3811  { BrushStyle := GetNativeCanvas.Brush.Style;
    3812   BrushColor := GetNativeCanvas.Brush.Color;
    3813   GetNativeCanvas.Brush.Color := AValue;
    3814   GetNativeCanvas.Brush.Style := bsClear;
    3815   GetNativeCanvas.FillRect(ScaleToNative(X), ScaleToNative(Y), ScaleToNative(X + 1) - 1, ScaleToNative(Y + 1) - 1);
    3816   GetNativeCanvas.Brush.Style := BrushStyle;
    3817   GetNativeCanvas.Brush.Color := BrushColor;
    3818   }
    3819   GetNativeCanvas.Pixels[ScaleToNative(X), ScaleToNative(Y)] := AValue;
    3820 end;
    3821 
    3822 procedure TDpiCanvas.SetNativeCanvas(AValue: TCanvas);
    3823 begin
    3824   if FNativeCanvas = AValue then Exit;
    3825   if FNativeCanvasFree then FreeAndNil(FNativeCanvas);
    3826   FNativeCanvasFree := False;
    3827   FNativeCanvas := AValue;
    3828   if Assigned(FNativeCanvas) then begin
    3829     FFont.NativeFont := FNativeCanvas.Font;
    3830     FBrush.NativeBrush := FNativeCanvas.Brush;
    3831     FPen.NativePen := FNativeCanvas.Pen;
    3832   end;
    3833 end;
    3834 
    3835 procedure TDpiCanvas.DoLine(X1, Y1, X2, Y2: Integer);
    3836 begin
    3837   raise ENotImplemented.Create(SNotImplemented);
    3838 end;
    3839 
    3840 procedure TDpiCanvas.DoTextOut(X, Y: Integer; Text: string);
    3841 begin
    3842   raise ENotImplemented.Create(SNotImplemented);
    3843 end;
    3844 
    3845 procedure TDpiCanvas.DoRectangle(const Bounds: TRect);
    3846 begin
    3847   raise ENotImplemented.Create(SNotImplemented);
    3848 end;
    3849 
    3850 procedure TDpiCanvas.DoRectangleFill(const Bounds: TRect);
    3851 begin
    3852   raise ENotImplemented.Create(SNotImplemented);
    3853 end;
    3854 
    3855 procedure TDpiCanvas.DoPolygon(const Points: array of TPoint);
    3856 begin
    3857   raise ENotImplemented.Create(SNotImplemented);
    3858 end;
    3859 
    3860 procedure TDpiCanvas.CreateHandle;
    3861 begin
    3862   raise ENotImplemented.Create(SNotImplemented);
    3863 end;
    3864 
    3865 procedure TDpiCanvas.DoEllipse(const Bounds: TRect);
    3866 begin
    3867   raise ENotImplemented.Create(SNotImplemented);
    3868 end;
    3869 
    3870 procedure TDpiCanvas.DoMoveTo(X, Y: Integer);
    3871 begin
    3872   raise ENotImplemented.Create(SNotImplemented);
    3873 end;
    3874 
    3875 procedure TDpiCanvas.DoLineTo(X, Y: Integer);
    3876 begin
    3877   raise ENotImplemented.Create(SNotImplemented);
    3878 end;
    3879 
    3880 procedure TDpiCanvas.DoPolyline(const Points: array of TPoint);
    3881 begin
    3882   raise ENotImplemented.Create(SNotImplemented);
    3883 end;
    3884 
    3885 procedure TDpiCanvas.DoPolyBezier(Points: PPoint; NumPts: Integer;
    3886   Filled: Boolean; Continuous: Boolean);
    3887 begin
    3888   raise ENotImplemented.Create(SNotImplemented);
    3889 end;
    3890 
    3891 function TDpiCanvas.GetNativeCanvas: TCanvas;
    3892 begin
    3893   Result := NativeCanvas;
    3894 end;
    3895 
    3896 procedure TDpiCanvas.RoundRect(const Rect: TRect; RX, RY: Integer);
    3897 begin
    3898   GetNativeCanvas.RoundRect(Rect, RX, RY);
    3899 end;
    3900 
    3901 procedure TDpiCanvas.RoundRect(X1, Y1, X2, Y2: Integer; RX, RY: Integer);
    3902 begin
    3903   GetNativeCanvas.RoundRect(X1, Y1, X2, Y2, RX, RY);
    3904 end;
    3905 
    3906 procedure TDpiCanvas.Polygon(const Points: array of TPoint; Winding: Boolean;
    3907   StartIndex: Integer; NumPts: Integer);
    3908 begin
    3909   GetNativeCanvas.Polygon(Points, Winding, StartIndex, NumPts);
    3910 end;
    3911 
    3912 procedure TDpiCanvas.Polygon(Points: PPoint; NumPts: Integer; Winding: Boolean);
    3913 begin
    3914   GetNativeCanvas.Polygon(Points, NumPts, Winding);
    3915 end;
    3916 
    3917 procedure TDpiCanvas.Polygon(const Points: array of TPoint);
    3918 begin
    3919   GetNativeCanvas.Polygon(Points);
    3920 end;
    3921 
    3922 procedure TDpiCanvas.PolyBezier(const Points: array of TPoint; Filled: Boolean;
    3923   Continuous: boolean);
    3924 begin
    3925   GetNativeCanvas.Polyline(Points);
    3926 end;
    3927 
    3928 procedure TDpiCanvas.PolyBezier(Points: PPoint; NumPts: Integer;
    3929   Filled: Boolean; Continuous: Boolean);
    3930 begin
    3931   GetNativeCanvas.PolyBezier(Points, NumPts, Filled, Continuous);
    3932 end;
    3933 
    3934 procedure TDpiCanvas.Polyline(const Points: array of TPoint);
    3935 begin
    3936   GetNativeCanvas.Polyline(Points);
    3937 end;
    3938 
    3939 procedure TDpiCanvas.Polyline(Points: PPoint; NumPts: Integer);
    3940 begin
    3941   GetNativeCanvas.Polyline(Points, NumPts);
    3942 end;
    3943 
    3944 procedure TDpiCanvas.Ellipse(x1, y1, x2, y2: Integer);
    3945 begin
    3946   GetNativeCanvas.Ellipse(X1, Y1, X2, Y2);
    3947 end;
    3948 
    3949 procedure TDpiCanvas.Ellipse(const ARect: TRect);
    3950 begin
    3951   Ellipse(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
    3952 end;
    3953 
    3954 procedure TDpiCanvas.StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic);
    3955 begin
    3956   GetNativeCanvas.StretchDraw(DestRect, SrcGraphic);
    3957 end;
    3958 
    3959 procedure TDpiCanvas.Pie(EllipseX1, EllipseY1, EllipseX2, EllipseY2, StartX,
    3960   StartY, EndX, EndY: Integer);
    3961 begin
    3962   GetNativeCanvas.Pie(EllipseX1, EllipseY1, EllipseX2, EllipseY2, StartX, StartY,
    3963     EndX, EndY);
    3964 end;
    3965 
    3966 procedure TDpiCanvas.StretchDraw(const DestRect: TRect; SrcGraphic: TDpiGraphic
    3967   );
    3968 begin
    3969   GetNativeCanvas.StretchDraw(ScaleRectToNative(DestRect), SrcGraphic.GetNativeGraphic);
    3970 end;
    3971 
    3972 procedure TDpiCanvas.FrameRect(Rect: TRect);
    3973 begin
    3974   GetNativeCanvas.FrameRect(ScaleRectToNative(Rect));
    3975 end;
    3976 
    3977 procedure TDpiCanvas.Rectangle(X1, Y1, X2, Y2: Integer);
    3978 begin
    3979   GetNativeCanvas.Rectangle(ScaleToNative(X1), ScaleToNative(Y1), ScaleToNative(X2), ScaleToNative(Y2));
    3980 end;
    3981 
    3982 procedure TDpiCanvas.Rectangle(const ARect: TRect);
    3983 begin
    3984   Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
    3985 end;
    3986 
    3987 function TDpiCanvas.TextWidth(const Text: string): Integer;
    3988 begin
    3989   Result := ScaleFromNative(GetNativeCanvas.TextWidth(Text));
    3990 end;
    3991 
    3992 function TDpiCanvas.TextHeight(const Text: string): Integer;
    3993 begin
    3994   Result := ScaleFromNative(GetNativeCanvas.TextHeight(Text));
    3995 end;
    3996 
    3997 function TDpiCanvas.TextExtent(const Text: string): TSize;
    3998 begin
    3999   Result := ScaleSizeFromNative(GetNativeCanvas.TextExtent(Text));
    4000 end;
    4001 
    4002 procedure TDpiCanvas.TextOut(X, Y: Integer; const Text: string);
    4003 begin
    4004   GetNativeCanvas.TextOut(ScaleToNative(X), ScaleToNative(Y), Text);
    4005 end;
    4006 
    4007 procedure TDpiCanvas.TextRect(ARect: TRect; X, Y: Integer; Text: string);
    4008 begin
    4009   GetNativeCanvas.TextRect(ScaleRectToNative(ARect), ScaleToNative(X), ScaleToNative(Y), Text);
    4010 end;
    4011 
    4012 procedure TDpiCanvas.MoveTo(X, Y: Integer);
    4013 begin
    4014   GetNativeCanvas.MoveTo(ScaleToNative(X), ScaleToNative(Y));
    4015 end;
    4016 
    4017 procedure TDpiCanvas.LineTo(X, Y: Integer);
    4018 begin
    4019   GetNativeCanvas.LineTo(ScaleToNative(X), ScaleToNative(Y));
    4020 end;
    4021 
    4022 procedure TDpiCanvas.Line(const p1, p2: TPoint);
    4023 begin
    4024   GetNativeCanvas.Line(P1, P2);
    4025 end;
    4026 
    4027 procedure TDpiCanvas.FillRect(const ARect: TRect);
    4028 begin
    4029   GetNativeCanvas.FillRect(ScaleRectToNative(ARect));
    4030 end;
    4031 
    4032 procedure TDpiCanvas.FillRect(X1, Y1, X2, Y2: Integer);
    4033 begin
    4034   GetNativeCanvas.FillRect(ScaleToNative(X1), ScaleToNative(Y1), ScaleToNative(X2), ScaleToNative(Y2));
    4035 end;
    4036 
    4037 procedure TDpiCanvas.Draw(X, Y: Integer; Source: TDpiGraphic);
    4038 begin
    4039   GetNativeCanvas.Draw(ScaleToNative(X), ScaleToNative(Y), Source.GetNativeGraphic);
    4040 end;
    4041 
    4042 procedure TDpiCanvas.CopyRect(Dest: TRect; SrcCanvas: TDpiCanvas;
    4043   Source: TRect);
    4044 begin
    4045   GetNativeCanvas.CopyRect(Dest, SrcCanvas.NativeCanvas, ScaleRectToNative(Source));
    4046 end;
    4047 
    4048 constructor TDpiCanvas.Create;
    4049 begin
    4050   FNativeCanvas := nil;
    4051   FFont := TDpiFont.Create;
    4052   FFontFree := True;
    4053   FPen := TDpiPen.Create;
    4054   FPenFree := True;
    4055   FBrush := TDpiBrush.Create;
    4056   FBrushFree := True;
    4057 end;
    4058 
    4059 destructor TDpiCanvas.Destroy;
    4060 begin
    4061   if FFontFree then FreeAndNil(FFont);
    4062   if FBrushFree then FreeAndNil(FBrush);
    4063   if FPenFree then FreeAndNil(FPen);
    4064   if FNativeCanvasFree then FreeAndNil(FNativeCanvasFree);
    4065   inherited;
    4066 end;
    4067 
    4068 { TDpiGraphicControl }
    4069 
    4070 procedure TDpiGraphicControl.SetCanvas(AValue: TDpiCanvas);
    4071 begin
    4072   if FCanvas = AValue then Exit;
    4073   FCanvas := AValue;
    4074 end;
    4075 
    4076 procedure TDpiGraphicControl.PaintHandler(Sender: TObject);
    4077 begin
    4078   Paint;
    4079   if Assigned(FOnPaint) then
    4080     FOnPaint(Sender);
    4081 end;
    4082 
    4083 procedure TDpiGraphicControl.Paint;
    4084 begin
    4085 end;
    4086 
    4087 function TDpiGraphicControl.GetNativeControl: TControl;
    4088 begin
    4089   Result := GetNativeGraphicControl;
    4090 end;
    4091 
    4092 function TDpiGraphicControl.GetNativeGraphicControl: TGraphicControl;
    4093 begin
    4094   Result := NativeGraphicControl;
    4095 end;
    4096 
    4097 procedure TDpiGraphicControl.UpdateNativeControl;
    4098 begin
    4099   inherited;
    4100   TGraphicControlEx(GetNativeGraphicControl).OnPaint := PaintHandler;
    4101 end;
    4102 
    4103 function TDpiGraphicControl.GetOnPaint: TNotifyEvent;
    4104 begin
    4105   Result := FOnPaint;
    4106 end;
    4107 
    4108 procedure TDpiGraphicControl.SetOnPaint(AValue: TNotifyEvent);
    4109 begin
    4110   FOnPaint := AValue;
    4111 end;
    4112 
    4113 constructor TDpiGraphicControl.Create(TheOwner: TComponent);
    4114 begin
    4115   NativeGraphicControl := TGraphicControl.Create(nil);
    4116   inherited;
    4117   FCanvas := TDpiCanvas.Create;
    4118   FCanvas.NativeCanvas := GetNativeGraphicControl.Canvas;
    4119 end;
    4120 
    4121 destructor TDpiGraphicControl.Destroy;
    4122 begin
    4123   FreeAndNil(FCanvas);
    4124   FreeAndNil(NativeGraphicControl);
    4125   inherited;
    4126 end;
    4127 
    4128 
    4129 { TDpiImage }
    4130 
    4131 procedure TDpiImage.SetStretch(AValue: Boolean);
    4132 begin
    4133   if FStretch = AValue then Exit;
    4134   FStretch := AValue;
    4135   NativeImage.Stretch := AValue;
    4136 end;
    4137 
    4138 procedure TDpiImage.SetPicture(AValue: TDpiPicture);
    4139 begin
    4140   if FDpiPicture = AValue then Exit;
    4141   FDpiPicture := AValue;
    4142 end;
    4143 
    4144 function TDpiImage.GetNativeControl: TControl;
    4145 begin
    4146   if not Assigned(NativeImage) then NativeImage := TImage.Create(nil);
    4147   Result := NativeImage;
    4148 end;
    4149 
    4150 destructor TDpiImage.Destroy;
    4151 begin
    4152   FreeAndNil(NativeImage);
    4153   inherited Destroy;
    4154 end;
    4155 
    4156 { TDpiFont }
    4157 
    4158 procedure TDpiFont.SetSize(AValue: Integer);
    4159 begin
    4160   if FSize = AValue then Exit;
    4161   FSize := AValue;
    4162   FHeight := -MulDiv(FSize, FPixelsPerInch, 72);
    4163   UpdateFont;
    4164   DoChange;
    4165 end;
    4166 
    4167 procedure TDpiFont.DoChange;
    4168 begin
    4169   if Assigned(FOnChange) then FOnChange(Self);
    4170 end;
    4171 
    4172 procedure TDpiFont.SetStyle(AValue: TFontStyles);
    4173 begin
    4174   GetNativeFont.Style := AValue;
    4175 end;
    4176 
    4177 procedure TDpiFont.UpdateFont;
    4178 begin
    4179   if Assigned(GetNativeFont) then begin
    4180     GetNativeFont.PixelsPerInch := FPixelsPerInch;
    4181     GetNativeFont.Size := FSize;
    4182   end;
    4183 end;
    4184 
    4185 procedure TDpiFont.ScreenChanged;
    4186 begin
    4187   DoChange;
    4188 end;
    4189 
    4190 function TDpiFont.GetNativeFont: TFont;
    4191 begin
    4192   Result := NativeFont;
    4193 end;
    4194 
    4195 procedure TDpiFont.SetPixelsPerInch(AValue: Integer);
    4196 begin
    4197   FPixelsPerInch := PixelsPerInch;
    4198   FHeight := -MulDiv(FSize, FPixelsPerInch, 72);
    4199   UpdateFont;
    4200 end;
    4201 
    4202 function TDpiFont.GetName: string;
    4203 begin
    4204   Result := GetNativeFont.Name;
    4205 end;
    4206 
    4207 function TDpiFont.GetColor: TColor;
    4208 begin
    4209   Result := FColor;
    4210 end;
    4211 
    4212 function TDpiFont.GetCharSet: TFontCharSet;
    4213 begin
    4214   Result := GetNativeFont.CharSet;
    4215 end;
    4216 
    4217 function TDpiFont.GetHeight: Integer;
    4218 begin
    4219   Result := GetNativeFont.Height;
    4220 end;
    4221 
    4222 function TDpiFont.GetPixelsPerInch: Integer;
    4223 begin
    4224   Result := FPixelsPerInch;
    4225 end;
    4226 
    4227 function TDpiFont.GetSize: Integer;
    4228 begin
    4229   Result := FSize;
    4230 end;
    4231 
    4232 function TDpiFont.GetStyle: TFontStyles;
    4233 begin
    4234   Result := GetNativeFont.Style;
    4235 end;
    4236 
    4237 function TDpiFont.IsNameStored: Boolean;
    4238 begin
    4239   Result := GetNativeFont.Name <> 'default';
    4240 end;
    4241 
    4242 procedure TDpiFont.SetCharSet(AValue: TFontCharSet);
    4243 begin
    4244   GetNativeFont.CharSet := AValue;
    4245 end;
    4246 
    4247 procedure TDpiFont.SetColor(AValue: TColor);
    4248 begin
    4249   if FColor = AValue then Exit;
    4250   FColor := AValue;
    4251   GetNativeFont.Color := AValue;
    4252 end;
    4253 
    4254 procedure TDpiFont.SetHeight(AValue: Integer);
    4255 begin
    4256   FHeight := AValue;
    4257   FSize := MulDiv(-FHeight, 72, FPixelsPerInch);
    4258   UpdateFont;
    4259 end;
    4260 
    4261 procedure TDpiFont.SetName(AValue: string);
    4262 begin
    4263   GetNativeFont.Name := AValue;
    4264 end;
    4265 
    4266 procedure TDpiFont.SetNativeFont(AValue: TFont);
    4267 begin
    4268   if FNativeFont = AValue then Exit;
    4269   if FNativeFontFree then FreeAndNil(FNativeFont);
    4270   FNativeFontFree := False;
    4271   FNativeFont := AValue;
    4272 end;
    4273 
    4274 constructor TDpiFont.Create;
    4275 begin
    4276   FNativeFont := TFont.Create;
    4277   FNativeFontFree := True;
    4278   FPixelsPerInch := DpiScreen.PixelsPerInch;
    4279   Size := 8;
    4280   Color := clDefault;
    4281 end;
    4282 
    4283 destructor TDpiFont.Destroy;
    4284 begin
    4285   if FNativeFontFree then
    4286     FreeAndNil(FNativeFont);
    4287   inherited;
    4288 end;
    4289 
    4290 procedure TDpiFont.Assign(Source: TPersistent);
    4291 begin
    4292   if Source is TDpiFont then begin
    4293     GetNativeFont.Assign((Source as TDpiFont).GetNativeFont);
    4294     Size := (Source as TDpiFont).Size;
    4295     Height := (Source as TDpiFont).Height;
    4296     PixelsPerInch := (Source as TDpiFont).PixelsPerInch;
    4297     FOnChange := (Source as TDpiFont).FOnChange;
    4298     Color := (Source as TDpiFont).Color;
    4299   end;
    4300 end;
    4301 
    4302 procedure TDpiFont.GetTextSize(Text: string; var w, h: Integer);
    4303 begin
    4304   W := GetTextWidth(Text);
    4305   H := GetTextHeight(Text);
    4306 end;
    4307 
    4308 function TDpiFont.GetTextHeight(Text: string): Integer;
    4309 begin
    4310   Result := ScaleFromNative(GetNativeFont.GetTextHeight(Text));
    4311 end;
    4312 
    4313 function TDpiFont.GetTextWidth(Text: string): Integer;
    4314 begin
    4315   Result := ScaleFromNative(GetNativeFont.GetTextWidth(Text));
    4316 end;
    4317 
    4318 { TDpiWinControl }
    4319 
    4320 function TDpiWinControl.GetBorderStyle: TBorderStyle;
    4321 begin
    4322   Result := TWinControlEx(GetNativeWinControl).BorderStyle;
    4323 end;
    4324 
    4325 function TDpiWinControl.GetHandle: HWND;
    4326 begin
    4327   Result := GetNativeWinControl.Handle;
    4328 end;
    4329 
    4330 function TDpiWinControl.GetOnKeyDown: TKeyEvent;
    4331 begin
    4332   Result := GetNativeWinControl.OnKeyDown;
    4333 end;
    4334 
    4335 function TDpiWinControl.GetOnKeyPress: TKeyPressEvent;
    4336 begin
    4337   Result := GetNativeWinControl.OnKeyPress;
    4338 end;
    4339 
    4340 function TDpiWinControl.GetOnKeyUp: TKeyEvent;
    4341 begin
    4342   Result := GetNativeWinControl.OnKeyUp;
    4343 end;
    4344 
    4345 function TDpiWinControl.GetTabOrder: TTabOrder;
    4346 begin
    4347   Result := GetNativeWinControl.TabOrder;
    4348 end;
    4349 
    4350 function TDpiWinControl.GetTabStop: Boolean;
    4351 begin
    4352   Result := GetNativeWinControl.TabStop;
    4353 end;
    4354 
    4355 procedure TDpiWinControl.SetBorderStyle(AValue: TBorderStyle);
    4356 begin
    4357   TWinControlEx(GetNativeWinControl).BorderStyle := AValue;
    4358 end;
    4359 
    4360 procedure TDpiWinControl.SetHandle(AValue: HWND);
    4361 begin
    4362   GetNativeWinControl.Handle := AValue;
    4363 end;
    4364 
    4365 procedure TDpiWinControl.SetOnKeyDown(AValue: TKeyEvent);
    4366 begin
    4367   GetNativeWinControl.OnKeyDown := AValue;
    4368 end;
    4369 
    4370 procedure TDpiWinControl.SetOnKeyPress(AValue: TKeyPressEvent);
    4371 begin
    4372   GetNativeWinControl.OnKeyPress := AValue;
    4373 end;
    4374 
    4375 procedure TDpiWinControl.SetOnKeyUp(AValue: TKeyEvent);
    4376 begin
    4377   GetNativeWinControl.OnKeyUp := AValue;
    4378 end;
    4379 
    4380 procedure TDpiWinControl.SetTabOrder(AValue: TTabOrder);
    4381 begin
    4382   GetNativeWinControl.TabOrder := AValue;
    4383 end;
    4384 
    4385 procedure TDpiWinControl.SetTabStop(AValue: Boolean);
    4386 begin
    4387   GetNativeWinControl.TabStop := AValue;
    4388 end;
    4389 
    4390 procedure TDpiWinControl.KeyDownHandler(Sender: TObject; var Key: Word;
    4391   Shift: TShiftState);
    4392 begin
    4393   KeyDown(Key, Shift);
    4394   if Assigned(FOnKeyDown) then FOnKeyDown(Self, Key, Shift);
    4395 end;
    4396 
    4397 procedure TDpiWinControl.UpdateNativeControl;
    4398 begin
    4399   inherited;
    4400   GetNativeWinControl.OnKeyDown := KeyDownHandler;
    4401 end;
    4402 
    4403 function TDpiWinControl.GetNativeControl: TControl;
    4404 begin
    4405   Result := GetNativeWinControl;
    4406 end;
    4407 
    4408 function TDpiWinControl.GetNativeWinControl: TWinControl;
    4409 begin
    4410   Result := nil;
    4411 end;
    4412 
    4413 procedure TDpiWinControl.KeyDown(var Key: Word; Shift: TShiftState);
    4414 begin
    4415 end;
    4416 
    4417 procedure TDpiWinControl.ScreenChanged;
    4418 var
    4419   I: Integer;
    4420 begin
    4421   inherited;
    4422   for I := 0 to Controls.Count - 1 do
    4423     Controls[I].ScreenChanged;
    4424 end;
    4425 
    4426 function TDpiWinControl.ControlCount: Integer;
    4427 begin
    4428   Result := Controls.Count;
    4429 end;
    4430 
    4431 procedure TDpiWinControl.SetFocus;
    4432 begin
    4433   GetNativeWinControl.SetFocus;
    4434 end;
    4435 
    4436 constructor TDpiWinControl.Create(TheOwner: TComponent);
    4437 begin
    4438   Controls := TDpiControls.Create;
    4439   Controls.OwnsObjects := False;
    4440   inherited;
    4441 end;
    4442 
    4443 destructor TDpiWinControl.Destroy;
    4444 begin
    4445   FreeAndNil(Controls);
    4446   inherited;
    4447 end;
    4448 
    4449 { TDpiScreen }
    4450 
    4451 procedure TDpiScreen.SetDpi(AValue: Integer);
    4452 begin
    4453   if FDpi = AValue then Exit;
    4454   FDpi := AValue;
    4455   UpdateForms;
    4456 end;
    4457 
    4458 function TDpiScreen.GetWidth: Integer;
    4459 begin
    4460   Result := ScaleFromNative(Screen.Width);
    4461 end;
    4462 
    4463 procedure TDpiScreen.SetCursor(AValue: TCursor);
    4464 begin
    4465   Screen.Cursor := AValue;
    4466 end;
    4467 
    4468 procedure TDpiScreen.SetCursors(Index: Integer; AValue: HCURSOR);
    4469 begin
    4470   Screen.Cursors[Index] := AValue;
    4471 end;
    4472 
    4473 function TDpiScreen.GetHeight: Integer;
    4474 begin
    4475   Result := ScaleFromNative(Screen.Height);
    4476 end;
    4477 
    4478 function TDpiScreen.GetFormCount: Integer;
    4479 begin
    4480   Result := FForms.Count;
    4481 end;
    4482 
    4483 function TDpiScreen.GetForms(Index: Integer): TDpiForm;
    4484 begin
    4485   Result := FForms[Index];
    4486 end;
    4487 
    4488 procedure TDpiScreen.AddForm(AForm: TDpiForm);
    4489 begin
    4490   if AForm is TDpiForm then begin
    4491     FForms.Add(AForm);
    4492     //DpiApplication.UpdateVisible;
    4493   end;
    4494 end;
    4495 
    4496 function TDpiScreen.GetDesktopHeight: Integer;
    4497 begin
    4498   Result := ScaleFromNative(Screen.DesktopHeight);
    4499 end;
    4500 
    4501 function TDpiScreen.GetDesktopLeft: Integer;
    4502 begin
    4503   Result := ScaleFromNative(Screen.DesktopLeft);
    4504 end;
    4505 
    4506 function TDpiScreen.GetDesktopTop: Integer;
    4507 begin
    4508   Result := ScaleFromNative(Screen.DesktopTop);
    4509 end;
    4510 
    4511 function TDpiScreen.GetDesktopWidth: Integer;
    4512 begin
    4513   Result := ScaleFromNative(Screen.DesktopWidth);
    4514 end;
    4515 
    4516 procedure TDpiScreen.RemoveForm(AForm: TDpiForm);
    4517 begin
    4518   FForms.Remove(AForm);
    4519   FPrevActiveForms.Remove(AForm);
    4520   if AForm = FActiveForm then begin
    4521     FActiveForm := nil;
    4522   end;
    4523 end;
    4524 
    4525 function TDpiScreen.GetActiveForm: TDpiForm;
    4526 begin
    4527   Result := FActiveForm;
    4528 end;
    4529 
    4530 function TDpiScreen.GetCursor: TCursor;
    4531 begin
    4532   Result := Screen.Cursor;
    4533 end;
    4534 
    4535 function TDpiScreen.GetCursors(Index: Integer): HCURSOR;
    4536 begin
    4537   Result := Screen.Cursors[Index];
    4538 end;
    4539 
    4540 procedure TDpiScreen.UpdateForms;
    4541 var
    4542   I: Integer;
    4543 begin
    4544   for I := 0 to FForms.Count - 1 do
    4545     FForms[I].ScreenChanged;
    4546 end;
    4547 
    4548 function TDpiScreen.DisableForms(SkipForm: TDpiForm; DisabledList: Classes.TList
    4549   ): Classes.TList;
    4550 begin
    4551   Result := Screen.DisableForms(SkipForm.GetNativeForm, DisabledList);
    4552 end;
    4553 
    4554 procedure TDpiScreen.EnableForms(var AFormList: Classes.TList);
    4555 begin
    4556   Screen.EnableForms(AFormList);
    4557 end;
    4558 
    4559 constructor TDpiScreen.Create;
    4560 begin
    4561   FForms := TDpiForms.Create;
    4562   FForms.OwnsObjects := False;
    4563   FPrevActiveForms := TDpiForms.Create;
    4564   FPrevActiveForms.OwnsObjects := False;
    4565   // Screen.PixelsPerInch is not initialized at this point
    4566   Dpi := 96;
    4567 end;
    4568 
    4569 destructor TDpiScreen.Destroy;
    4570 begin
    4571   FreeAndNil(FForms);
    4572   FreeAndNil(FPrevActiveForms);
    4573   inherited;
    4574 end;
    4575 
    4576 procedure TDpiScreen.UpdateScreen;
    4577 begin
    4578   if FixedDpi = -1 then Dpi := Screen.PixelsPerInch
    4579     else Dpi := FixedDpi;
    4580 end;
    4581 
    4582 procedure TDpiScreen.UpdateActiveFormFromNativeScreen;
    4583 var
    4584   I: Integer;
    4585   F: TDpiForm;
    4586 begin
    4587   if Screen.ActiveForm = nil then FActiveForm := nil
    4588   else begin
    4589     for I := 0 to FormCount - 1 do begin
    4590       F := Forms[I];
    4591       if F.GetNativeForm = Screen.ActiveForm then begin
    4592         FActiveForm := F;
    4593         Break;
    4594       end;
    4595     end;
    4596   end;
    4597 end;
    4598 
    4599 { TDpiButton }
    4600 
    4601 function TDpiButton.GetNativeControl: TControl;
    4602 begin
    4603   if not Assigned(NativeButton) then NativeButton := TButton.Create(nil);
    4604   Result := NativeButton;
    4605 end;
    4606 
    4607 destructor TDpiButton.Destroy;
    4608 begin
    4609   FreeAndNil(NativeButton);
    4610   inherited;
    4611 end;
    4612 
    4613 { TDpiControl }
    4614 
    4615 procedure TDpiControl.SetTop(AValue: Integer);
    4616 begin
    4617   if FTop = AValue then Exit;
    4618   FTop := AValue;
    4619   UpdateBounds;
    4620 end;
    4621 
    4622 procedure TDpiControl.SetVisible(AValue: Boolean);
    4623 begin
    4624   GetNativeControl.Visible := AValue;
    4625 end;
    4626 
    4627 procedure TDpiControl.SetWidth(AValue: Integer);
    4628 begin
    4629   if FWidth = AValue then Exit;
    4630   FWidth := AValue;
    4631   UpdateBounds;
    4632 end;
    4633 
    4634 function TDpiControl.GetNativeControl: TControl;
    4635 begin
    4636   Result := nil;
    4637 end;
    4638 
    4639 procedure TDpiControl.UpdateNativeControl;
    4640 begin
    4641   Font.NativeFont := GetNativeControl.Font;
    4642   GetNativeControl.OnResize := NativeFormResize;
    4643   GetNativeControl.OnChangeBounds := NativeChangeBounds;
    4644   TControlEx(GetNativeControl).OnMouseDown := MouseDownHandler;
    4645   TControlEx(GetNativeControl).OnMouseUp := MouseUpHandler;
    4646   TControlEx(GetNativeControl).OnMouseMove := MouseMoveHandler;
    4647   TControlEx(GetNativeControl).OnMouseEnter := MouseEnterHandler;
    4648   TControlEx(GetNativeControl).OnMouseLeave := MouseLeaveHandler;
    4649   TControlEx(GetNativeControl).OnMouseWheel := MouseWheelHandler;
    4650 end;
    4651 
    4652 procedure TDpiControl.MouseDownHandler(Sender: TObject; Button: TMouseButton;
    4653   Shift: TShiftState; X, Y: Integer);
    4654 begin
    4655   MouseDown(Button, Shift, ScaleFromNative(X), ScaleFromNative(Y));
    4656   if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, ScaleFromNative(X), ScaleFromNative(Y));
    4657 end;
    4658 
    4659 procedure TDpiControl.MouseUpHandler(Sender: TObject; Button: TMouseButton;
    4660   Shift: TShiftState; X, Y: Integer);
    4661 begin
    4662   MouseUp(Button, Shift, ScaleFromNative(X), ScaleFromNative(Y));
    4663   if Assigned(FOnMouseUp) then FOnMouseUp(Self, Button, Shift, ScaleFromNative(X), ScaleFromNative(Y));
    4664 end;
    4665 
    4666 procedure TDpiControl.MouseMoveHandler(Sender: TObject; Shift: TShiftState; X,
    4667   Y: Integer);
    4668 begin
    4669   MouseMove(Shift, ScaleFromNative(X), ScaleFromNative(Y));
    4670   if Assigned(FOnMouseMove) then FOnMouseMove(Self, Shift, ScaleFromNative(X), ScaleFromNative(Y));
    4671 end;
    4672 
    4673 procedure TDpiControl.MouseWheelHandler(Sender: TObject; Shift: TShiftState;
    4674   WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    4675 begin
    4676   if Assigned(FOnMouseWheel) then FOnMouseWheel(Self, Shift, WheelDelta,
    4677     ScalePointFromNative(MousePos), Handled);
    4678 end;
    4679 
    4680 procedure TDpiControl.MouseLeaveHandler(Sender: TObject);
    4681 begin
    4682   MouseLeave;
    4683   if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
    4684 end;
    4685 
    4686 procedure TDpiControl.MouseEnterHandler(Sender: TObject);
    4687 begin
    4688   MouseEnter;
    4689   if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
    4690 end;
    4691 
    4692 procedure TDpiControl.SetWindowProc(AValue: TWndMethod);
    4693 begin
    4694   GetNativeControl.WindowProc := AValue;
    4695 end;
    4696 
    4697 procedure TDpiControl.DoBorderSpacingChange(Sender: TObject;
    4698   InnerSpaceChanged: Boolean);
    4699 begin
    4700   GetNativeControl.BorderSpacing.Left := ScaleToNative(FBorderSpacing.Left);
    4701   GetNativeControl.BorderSpacing.Right := ScaleToNative(FBorderSpacing.Right);
    4702   GetNativeControl.BorderSpacing.Top := ScaleToNative(FBorderSpacing.Top);
    4703   GetNativeControl.BorderSpacing.Bottom := ScaleToNative(FBorderSpacing.Bottom);
    4704   GetNativeControl.BorderSpacing.Around := ScaleToNative(FBorderSpacing.Around);
    4705 end;
    4706 
    4707 procedure TDpiControl.SetText(AValue: TCaption);
    4708 begin
    4709 
    4710 end;
    4711 
    4712 procedure TDpiControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
    4713   Y: Integer);
    4714 begin
    4715 end;
    4716 
    4717 procedure TDpiControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
    4718   Y: Integer);
    4719 begin
    4720 end;
    4721 
    4722 procedure TDpiControl.MouseMove(Shift: TShiftState; X, Y: Integer);
    4723 begin
    4724 end;
    4725 
    4726 procedure TDpiControl.MouseLeave;
    4727 begin
    4728 end;
    4729 
    4730 procedure TDpiControl.MouseEnter;
    4731 begin
    4732 end;
    4733 
    4734 function TDpiControl.ScreenToClient(const APoint: TPoint): TPoint;
    4735 begin
    4736   Result := ScalePointFromNative(GetNativeControl.ScreenToClient(ScalePointToNative(APoint)));
    4737 end;
    4738 
    4739 function TDpiControl.ClientToScreen(const APoint: TPoint): TPoint;
    4740 begin
    4741   Result := ScalePointFromNative(GetNativeControl.ClientToScreen(ScalePointToNative(APoint)));
    4742 end;
    4743 
    4744 procedure TDpiControl.AddHandlerOnVisibleChanged(
    4745   const OnVisibleChangedEvent: TNotifyEvent; AsFirst: boolean);
    4746 begin
    4747   GetNativeControl.AddHandlerOnVisibleChanged(OnVisibleChangedEvent, AsFirst);
    4748 end;
    4749 
    4750 procedure TDpiControl.RemoveHandlerOnVisibleChanged(
    4751   const OnVisibleChangedEvent: TNotifyEvent);
    4752 begin
    4753   GetNativeControl.RemoveHandlerOnVisibleChanged(OnVisibleChangedEvent);
    4754 end;
    4755 
    4756 procedure TDpiControl.ScreenChanged;
    4757 begin
    4758   UpdateBounds;
    4759   Font.ScreenChanged;
    4760 end;
    4761 
    4762 procedure TDpiControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
    4763 begin
    4764   FLeft := ALeft;
    4765   FTop := ATop;
    4766   FWidth := AWidth;
    4767   FHeight := AHeight;
    4768   UpdateBounds;
    4769 end;
    4770 
    4771 procedure TDpiControl.Show;
    4772 begin
    4773   Visible := True;
    4774 end;
    4775 
    4776 procedure TDpiControl.Hide;
    4777 begin
    4778   Visible := False;
    4779 end;
    4780 
    4781 procedure TDpiControl.Invalidate;
    4782 begin
    4783   GetNativeControl.Invalidate;
    4784 end;
    4785 
    4786 procedure TDpiControl.Repaint;
    4787 begin
    4788   GetNativeControl.Repaint;
    4789 end;
    4790 
    4791 procedure TDpiControl.Update;
    4792 begin
    4793   GetNativeControl.Update;
    4794 end;
    4795 
    4796 procedure TDpiControl.Refresh;
    4797 begin
    4798   GetNativeControl.Refresh;
    4799 end;
    4800 
    4801 function TDpiControl.IsParentOf(AControl: TDpiControl): boolean;
    4802 begin
    4803   Result := False;
    4804   while Assigned(AControl) do
    4805   begin
    4806     AControl := AControl.Parent;
    4807     if Self = AControl then
    4808       Exit(True);
    4809   end;
    4810 end;
    4811 
    4812 function TDpiControl.Scale96ToScreen(const ASize: Integer): Integer;
    4813 begin
    4814   Result := MulDiv(ASize, Screen.PixelsPerInch, 96);
    4815 end;
    4816 
    4817 constructor TDpiControl.Create(TheOwner: TComponent);
    4818 begin
    4819   inherited;
    4820   FFont := TDpiFont.Create;
    4821   FFont.OnChange := FontChanged;
    4822   FConstraints := TDpiSizeConstraints.Create;
    4823   if Assigned(TheOwner) and (TheOwner is TDpiWinControl) then
    4824     Parent := TDpiWinControl(TheOwner);
    4825   FBorderSpacing := TDpiControlBorderSpacing.Create(Self);
    4826   GetNativeControl;
    4827   UpdateNativeControl;
    4828   ScreenChanged;
    4829 end;
    4830 
    4831 destructor TDpiControl.Destroy;
    4832 begin
    4833   FreeAndNil(FBorderSpacing);
    4834   FreeAndNil(FConstraints);
    4835   FreeAndNil(FFont);
    4836   inherited;
    4837 end;
    4838 
    4839 procedure TDpiControl.SetLeft(AValue: Integer);
    4840 begin
    4841   if FLeft = AValue then Exit;
    4842   FLeft := AValue;
    4843   UpdateBounds;
    4844 end;
    4845 
    4846 procedure TDpiControl.SetCaption(AValue: string);
    4847 begin
    4848   GetNativeControl.Caption := AValue;
    4849 end;
    4850 
    4851 procedure TDpiControl.SetParent(AValue: TDpiWinControl);
    4852 begin
    4853   if FParent = AValue then Exit;
    4854   if Assigned(FParent) then begin
    4855     FParent.Controls.Remove(Self);
    4856     if Assigned(FParent) and (FParent is TDpiWinControl) then
    4857       GetNativeControl.Parent := nil;
    4858   end;
    4859   FParent := AValue;
    4860   if Assigned(FParent) then begin
    4861     FParent.Controls.Add(Self);
    4862     if Assigned(FParent) and (FParent is TDpiWinControl) then
    4863       GetNativeControl.Parent := TDpiWinControl(FParent).GetNativeWinControl;
    4864   end;
    4865 end;
    4866 
    4867 procedure TDpiControl.SetFont(AValue: TDpiFont);
    4868 begin
    4869   if FFont = AValue then Exit;
    4870   FFont := AValue;
    4871 end;
    4872 
    4873 procedure TDpiControl.SetHint(AValue: string);
    4874 begin
    4875   GetNativeControl.Hint := AValue;
    4876 end;
    4877 
    4878 function TDpiControl.GetBoundsRect: TRect;
    4879 begin
    4880   Result.Left := Left;
    4881   Result.Top := Top;
    4882   Result.Right := Left + Width;
    4883   Result.Bottom := Top + Height;
    4884 end;
    4885 
    4886 function TDpiControl.GetAlign: TAlign;
    4887 begin
    4888   Result := GetNativeControl.Align;
    4889 end;
    4890 
    4891 function TDpiControl.GetAnchors: TAnchors;
    4892 begin
    4893   Result := GetNativeControl.Anchors;
    4894 end;
    4895 
    4896 function TDpiControl.GetAutoSize: Boolean;
    4897 begin
    4898   Result := GetNativeControl.AutoSize;
    4899 end;
    4900 
    4901 function TDpiControl.GetClientHeight: Integer;
    4902 begin
    4903   Result := ScaleFromNative(GetNativeControl.ClientHeight);
    4904 end;
    4905 
    4906 function TDpiControl.GetClientWidth: Integer;
    4907 begin
    4908   Result := ScaleFromNative(GetNativeControl.ClientWidth);
    4909 end;
    4910 
    4911 function TDpiControl.GetColor: TColor;
    4912 begin
    4913   Result := GetNativeControl.Color;
    4914 end;
    4915 
    4916 function TDpiControl.GetCursor: TCursor;
    4917 begin
    4918   Result := GetNativeControl.Cursor;
    4919 end;
    4920 
    4921 function TDpiControl.GetEnabled: Boolean;
    4922 begin
    4923   Result := GetNativeControl.Enabled;
    4924 end;
    4925 
    4926 function TDpiControl.GetHint: string;
    4927 begin
    4928   Result := GetNativeControl.Hint;
    4929 end;
    4930 
    4931 function TDpiControl.GetOnClick: TNotifyEvent;
    4932 begin
    4933   Result := GetNativeControl.OnClick;
    4934 end;
    4935 
    4936 function TDpiControl.GetOnDblClick: TNotifyEvent;
    4937 begin
    4938   Result := TControlEx(GetNativeControl).OnDblClick;
    4939 end;
    4940 
    4941 function TDpiControl.GetParentFont: Boolean;
    4942 begin
    4943   Result := TControlEx(GetNativeControl).ParentFont;
    4944 end;
    4945 
    4946 function TDpiControl.GetShowHint: Boolean;
    4947 begin
    4948   Result := GetNativeControl.ShowHint;
    4949 end;
    4950 
    4951 function TDpiControl.GetText: TCaption;
    4952 begin
    4953   Result := '';
    4954 end;
    4955 
    4956 function TDpiControl.GetVisible: Boolean;
    4957 begin
    4958   Result := GetNativeControl.Visible;
    4959 end;
    4960 
    4961 function TDpiControl.GetWindowProc: TWndMethod;
    4962 begin
    4963   Result := GetNativeControl.WindowProc;
    4964 end;
    4965 
    4966 function TDpiControl.IsAnchorsStored: Boolean;
    4967 begin
    4968 
    4969 end;
    4970 
    4971 procedure TDpiControl.SetAlign(AValue: TAlign);
    4972 begin
    4973   GetNativeControl.Align := AValue;
    4974 end;
    4975 
    4976 procedure TDpiControl.SetAnchors(AValue: TAnchors);
    4977 begin
    4978   GetNativeControl.Anchors := AValue;
    4979 end;
    4980 
    4981 procedure TDpiControl.SetAutoSize(AValue: Boolean);
    4982 begin
    4983   GetNativeControl.AutoSize := AValue;
    4984 end;
    4985 
    4986 procedure TDpiControl.SetBorderSpacing(AValue: TDpiControlBorderSpacing);
    4987 begin
    4988   if FBorderSpacing = AValue then Exit;
    4989   FBorderSpacing := AValue;
    4990 end;
    4991 
    4992 procedure TDpiControl.SetBoundsRect(AValue: TRect);
    4993 begin
    4994   SetBounds(AValue.Left, AValue.Top, AValue.Right - AValue.Left, AValue.Bottom - AValue.Top);
    4995 end;
    4996 
    4997 procedure TDpiControl.SetClientHeight(AValue: Integer);
    4998 begin
    4999   GetNativeControl.ClientHeight := ScaleToNative(AValue);
    5000 end;
    5001 
    5002 procedure TDpiControl.SetClientWidth(AValue: Integer);
    5003 begin
    5004   GetNativeControl.ClientWidth := ScaleToNative(AValue);
    5005 end;
    5006 
    5007 procedure TDpiControl.SetColor(AValue: TColor);
    5008 begin
    5009   GetNativeControl.Color := AValue;
    5010 end;
    5011 
    5012 procedure TDpiControl.SetCursor(AValue: TCursor);
    5013 begin
    5014   GetNativeControl.Cursor := AValue;
    5015 end;
    5016 
    5017 procedure TDpiControl.SetEnabled(AValue: Boolean);
    5018 begin
    5019   GetNativeControl.Enabled := AValue;
    5020 end;
    5021 
    5022 procedure TDpiControl.SetOnClick(AValue: TNotifyEvent);
    5023 begin
    5024   GetNativeControl.OnClick := AValue;
    5025 end;
    5026 
    5027 procedure TDpiControl.SetOnDblClick(AValue: TNotifyEvent);
    5028 begin
    5029   TControlEx(GetNativeControl).OnDblClick := AValue;
    5030 end;
    5031 
    5032 procedure TDpiControl.SetParentFont(AValue: Boolean);
    5033 begin
    5034   TControlEx(GetNativeControl).ParentFont := AValue;
    5035 end;
    5036 
    5037 procedure TDpiControl.SetShowHint(AValue: Boolean);
    5038 begin
    5039   GetNativeControl.ShowHint := AValue;
    5040 end;
    5041 
    5042 procedure TDpiControl.NativeFormResize(Sender: TObject);
    5043 begin
    5044   BoundsRect := ScaleRectFromNative(GetNativeControl.BoundsRect);
    5045   DoFormResize;
    5046 end;
    5047 
    5048 procedure TDpiControl.NativeChangeBounds(Sender: TObject);
    5049 var
    5050   NewBounds: TRect;
    5051 begin
    5052   NewBounds := ScaleRectFromNative(GetNativeControl.BoundsRect);
    5053   if NewBounds <> BoundsRect then begin
    5054     FLeft := NewBounds.Left;
    5055     FTop := NewBounds.Top;
    5056     FWidth := NewBounds.Width;
    5057     FHeight := NewBounds.Height;
    5058     DoChangeBounds;
    5059   end;
    5060 end;
    5061 
    5062 procedure TDpiControl.DoFormResize;
    5063 begin
    5064   if Assigned(FOnResize) then begin
    5065     FOnResize(Self);
    5066   end;
    5067 end;
    5068 
    5069 procedure TDpiControl.DoChangeBounds;
    5070 begin
    5071   if Assigned(FOnChangeBounds) then FOnChangeBounds(Self);
    5072 end;
    5073 
    5074 function TDpiControl.GetCaption: string;
    5075 begin
    5076   Result := GetNativeControl.Caption;
    5077 end;
    5078 
    5079 procedure TDpiControl.FontChanged(Sender: TObject);
    5080 begin
    5081   GetNativeControl.Font.Size := ScaleToNative(Font.Size);
    5082 end;
    5083 
    5084 procedure TDpiControl.UpdateBounds;
    5085 var
    5086   R: TRect;
    5087 begin
    5088   GetNativeControl.BoundsRect := ScaleRectToNative(BoundsRect);
    5089   R := ScaleRectToNative(BoundsRect);
    5090   //WriteLog(Name + ' ' + IntToStr(R.Left) + ', ' + IntToStr(R.Top) + ', ' + IntToStr(R.Width) + ', ' + IntToStr(R.Height))
    5091 end;
    5092 
    5093 procedure TDpiControl.SetHeight(AValue: Integer);
    5094 begin
    5095   if FHeight = AValue then Exit;
    5096   FHeight := AValue;
    5097   UpdateBounds;
    509843end;
    509944
    … …  
    512469end;
    512570
    5126 { TDpiForm }
    5127 
    5128 function TDpiForm.GetBorderIcons: TBorderIcons;
    5129 begin
    5130   Result := GetNativeForm.BorderIcons;
    5131 end;
    5132 
    5133 function TDpiForm.GetBorderStyle: TFormBorderStyle;
    5134 begin
    5135   Result := GetNativeForm.BorderStyle;
    5136 end;
    5137 
    5138 function TDpiForm.GetDesignTimePPI: Integer;
    5139 begin
    5140   Result := GetNativeForm.DesignTimePPI;
    5141 end;
    5142 
    5143 function TDpiForm.GetFormState: TFormState;
    5144 begin
    5145   Result := GetNativeForm.FormState;
    5146 end;
    5147 
    5148 function TDpiForm.GetFormStyle: TFormStyle;
    5149 begin
    5150   Result := GetNativeForm.FormStyle;
    5151 end;
    5152 
    5153 function TDpiForm.GetKeyPreview: Boolean;
    5154 begin
    5155   Result := GetNativeForm.KeyPreview;
    5156 end;
    5157 
    5158 function TDpiForm.GetLCLVersion: string;
    5159 begin
    5160   Result := GetNativeForm.LCLVersion;
    5161 end;
    5162 
    5163 function TDpiForm.GetModalResult: TModalResult;
    5164 begin
    5165   Result := GetNativeForm.ModalResult;
    5166 end;
    5167 
    5168 function TDpiForm.GetOnCloseQuery: TCloseQueryEvent;
    5169 begin
    5170   Result := GetNativeForm.OnCloseQuery;
    5171 end;
    5172 
    5173 function TDpiForm.GetOnCreate: TNotifyEvent;
    5174 begin
    5175   Result := GetNativeForm.OnCreate;
    5176 end;
    5177 
    5178 function TDpiForm.GetOnDeactivate: TNotifyEvent;
    5179 begin
    5180   Result := GetNativeForm.OnDeactivate;
    5181 end;
    5182 
    5183 function TDpiForm.GetOnDestroy: TNotifyEvent;
    5184 begin
    5185   Result := GetNativeForm.OnDestroy;
    5186 end;
    5187 
    5188 function TDpiForm.GetOnHide: TNotifyEvent;
    5189 begin
    5190   Result := GetNativeForm.OnHide;
    5191 end;
    5192 
    5193 function TDpiForm.GetOnShow: TNotifyEvent;
    5194 begin
    5195   Result := GetNativeForm.OnShow;
    5196 end;
    5197 
    5198 function TDpiForm.GetPosition: TPosition;
    5199 begin
    5200   Result := GetNativeForm.Position;
    5201 end;
    5202 
    5203 function TDpiForm.GetRestoredHeight: Integer;
    5204 begin
    5205   Result := ScaleFromNative(GetNativeForm.RestoredHeight);
    5206 end;
    5207 
    5208 function TDpiForm.GetRestoredLeft: Integer;
    5209 begin
    5210   Result := ScaleFromNative(GetNativeForm.RestoredLeft);
    5211 end;
    5212 
    5213 function TDpiForm.GetRestoredTop: Integer;
    5214 begin
    5215   Result := ScaleFromNative(GetNativeForm.RestoredTop);
    5216 end;
    5217 
    5218 function TDpiForm.GetRestoredWidth: Integer;
    5219 begin
    5220   Result := ScaleFromNative(GetNativeForm.RestoredWidth);
    5221 end;
    5222 
    5223 function TDpiForm.GetShowInTaskbar: TShowInTaskbar;
    5224 begin
    5225   Result := GetNativeForm.ShowInTaskBar;
    5226 end;
    5227 
    5228 function TDpiForm.GetWindowState: TWindowState;
    5229 begin
    5230   Result := GetNativeForm.WindowState;
    5231 end;
    5232 
    5233 procedure TDpiForm.SetBorderIcons(AValue: TBorderIcons);
    5234 begin
    5235   GetNativeForm.BorderIcons := AValue;
    5236 end;
    5237 
    5238 procedure TDpiForm.SetBorderStyle(AValue: TFormBorderStyle);
    5239 begin
    5240   GetNativeForm.BorderStyle := AValue;
    5241 end;
    5242 
    5243 procedure TDpiForm.SetDesignTimePPI(AValue: Integer);
    5244 begin
    5245   GetNativeForm.DesignTimePPI := AValue;
    5246 end;
    5247 
    5248 procedure TDpiForm.SetFormStyle(AValue: TFormStyle);
    5249 begin
    5250   GetNativeForm.FormStyle := AValue;
    5251 end;
    5252 
    5253 procedure TDpiForm.SetKeyPreview(AValue: Boolean);
    5254 begin
    5255   GetNativeForm.KeyPreview := AValue;
    5256 end;
    5257 
    5258 procedure TDpiForm.SetLCLVersion(AValue: string);
    5259 begin
    5260   GetNativeForm.LCLVersion := AValue;
    5261 end;
    5262 
    5263 procedure TDpiForm.SetModalResult(AValue: TModalResult);
    5264 begin
    5265   GetNativeForm.ModalResult := AValue;
    5266 end;
    5267 
    5268 procedure TDpiForm.SetOnCloseQuery(AValue: TCloseQueryEvent);
    5269 begin
    5270   GetNativeForm.OnCloseQuery := AValue;
    5271 end;
    5272 
    5273 procedure TDpiForm.SetOnCreate(AValue: TNotifyEvent);
    5274 begin
    5275   GetNativeForm.OnCreate := AValue;
    5276 end;
    5277 
    5278 procedure TDpiForm.SetOnDeactivate(AValue: TNotifyEvent);
    5279 begin
    5280   GetNativeForm.OnDeactivate := AValue;
    5281 end;
    5282 
    5283 procedure TDpiForm.SetOnDestroy(AValue: TNotifyEvent);
    5284 begin
    5285   GetNativeForm.OnDestroy := AValue;
    5286 end;
    5287 
    5288 procedure TDpiForm.SetOnHide(AValue: TNotifyEvent);
    5289 begin
    5290   GetNativeForm.OnHide := AValue;
    5291 end;
    5292 
    5293 procedure TDpiForm.SetOnShow(AValue: TNotifyEvent);
    5294 begin
    5295   GetNativeForm.OnShow := AValue;
    5296 end;
    5297 
    5298 procedure TDpiForm.DoOnCreate;
    5299 begin
    5300   if Assigned(GetNativeForm.OnCreate) then
    5301     GetNativeForm.OnCreate(Self);
    5302 end;
    5303 
    5304 procedure TDpiForm.FormMessageHandler(var TheMessage: TLMessage);
    5305 begin
    5306   Dispatch(TheMessage);
    5307 end;
    5308 
    5309 procedure TDpiForm.SetPosition(AValue: TPosition);
    5310 begin
    5311   GetNativeForm.Position := AValue;
    5312 end;
    5313 
    5314 procedure TDpiForm.SetShowInTaskBar(AValue: TShowInTaskbar);
    5315 begin
    5316   GetNativeForm.ShowInTaskBar := AValue;
    5317 end;
    5318 
    5319 procedure TDpiForm.SetWindowState(AValue: TWindowState);
    5320 begin
    5321   GetNativeForm.WindowState := AValue;
    5322 end;
    5323 
    5324 procedure TDpiForm.ActivateHandler(Sender: TObject);
    5325 begin
    5326   if Assigned(DpiScreen.FActiveForm) then begin
    5327     if DpiScreen.FPrevActiveForms.IndexOf(DpiScreen.FActiveForm) <> - 1 then
    5328       DpiScreen.FPrevActiveForms.Remove(DpiScreen.FActiveForm);
    5329     DpiScreen.FPrevActiveForms.Add(DpiScreen.FActiveForm);
    5330   end;
    5331   DpiScreen.FActiveForm := Self;
    5332   if Assigned(FOnActivate) then FOnActivate(Sender);
    5333 end;
    5334 
    5335 procedure TDpiForm.DeactivateHandler(Sender: TObject);
    5336 begin
    5337   if DpiScreen.FPrevActiveForms.Count > 0 then begin
    5338     DpiScreen.FActiveForm := DpiScreen.FPrevActiveForms.Last;
    5339     DpiScreen.FPrevActiveForms.Delete(DpiScreen.FPrevActiveForms.Count - 1);
    5340   end else DpiScreen.FActiveForm := nil;
    5341   //DpiScreen.UpdateActiveFormFromNativeScreen;
    5342   if Assigned(FOnDeactivate) then FOnDeactivate(Sender);
    5343 end;
    5344 
    5345 procedure TDpiForm.DoClose(var CloseAction: TCloseAction);
    5346 begin
    5347   if Assigned(FOnClose) then FOnClose(Self, CloseAction);
    5348 end;
    5349 
    5350 procedure TDpiForm.CloseHandler(Sender: TObject; var CloseAction: TCloseAction);
    5351 begin
    5352   Close;
    5353 end;
    5354 
    5355 procedure TDpiForm.CloseQueryHandler(Sender : TObject; var CanClose : boolean);
    5356 begin
    5357   if Assigned(FOnCloseQuery) then FOnCloseQuery(Self, CanClose);
    5358 end;
    5359 
    5360 procedure TDpiForm.CreateParams(var p: TCreateParams);
    5361 begin
    5362   // TODO: NativeForm.CreateParams(P);
    5363 end;
    5364 
    5365 // This method is called by TWriter to retrieve the child components to write
    5366 procedure TDpiForm.GetChildren(Proc: TGetChildProc; Root: TComponent);
    5367 var
    5368   I: Integer;
    5369   OwnedComponent: TComponent;
    5370 begin
    5371   DebugLn(['TDpiForm.GetChildren ComponentCount=', ComponentCount]);
    5372   inherited GetChildren(Proc, Root);
    5373   if Root = Self then begin
    5374     for I := 0 to ComponentCount - 1 do begin
    5375       OwnedComponent := Components[I];
    5376       if not OwnedComponent.HasParent then Proc(OwnedComponent);
    5377     end;
    5378   end;
    5379 end;
    5380 
    5381 function TDpiForm.GetNativeScrollingWinControl: TScrollingWinControl;
    5382 begin
    5383   Result := GetNativeForm;
    5384 end;
    5385 
    5386 function TDpiForm.GetNativeForm: TForm;
    5387 begin
    5388   if not Assigned(NativeForm) then begin
    5389     NativeForm := TFormEx.CreateNew(nil);
    5390     (NativeForm as TFormEx).OnMessage := FormMessageHandler;
    5391     //NativeForm := TForm.Create(nil);
    5392   end;
    5393   Result := NativeForm;
    5394 end;
    5395 
    5396 procedure TDpiForm.UpdateNativeControl;
    5397 begin
    5398   inherited;
    5399   GetNativeForm.OnActivate := ActivateHandler;
    5400   GetNativeForm.OnDeactivate := DeactivateHandler;
    5401   GetNativeForm.OnClose := CloseHandler;
    5402   GetNativeForm.OnCloseQuery := CloseQueryHandler;
    5403   GetNativeForm.Name := Name + 'Native';
    5404 end;
    5405 
    5406 procedure TDpiForm.AfterConstruction;
    5407 begin
    5408   inherited;
    5409   DoOnCreate;
    5410 end;
    5411 
    5412 function TDpiForm.ShowModal: Integer;
    5413 begin
    5414   Result := GetNativeForm.ShowModal;
    5415 end;
    5416 
    5417 procedure TDpiForm.SetFocus;
    5418 begin
    5419   GetNativeForm.SetFocus;
    5420 end;
    5421 
    5422 procedure TDpiForm.Close;
    5423 var
    5424   CloseAction: TCloseAction;
    5425   IsMainForm: Boolean;
    5426 begin
    5427   if (fsModal in FormState) and (ModalResult = 0) then
    5428     ModalResult := mrCancel
    5429   else
    5430   begin
    5431     if CloseQuery then
    5432     begin
    5433       // IsMainForm flag set if we are closing MainForm or its parent
    5434       IsMainForm := (DpiApplication.MainForm = Self) or (Self.IsParentOf(DpiApplication.MainForm));
    5435       // Prepare default close action
    5436       if FormStyle = fsMDIChild then
    5437       begin
    5438         CloseAction := caNone;
    5439         // TODO: mdi logic
    5440       end
    5441       else
    5442       begin
    5443         if IsMainForm then
    5444           CloseAction := caFree
    5445         else
    5446           CloseAction := caHide;
    5447       end;
    5448       // call event handler and let user modify CloseAction
    5449       DoClose(CloseAction);
    5450       // execute action according to close action
    5451       case CloseAction of
    5452         caHide: Hide;
    5453         caMinimize: WindowState := wsMinimized;
    5454         caFree:
    5455           begin
    5456             // if form is MainForm, then terminate the application
    5457             // the owner of the MainForm is the application,
    5458             // so the Application will take care of free-ing the form
    5459             // and Release is not necessary
    5460             if IsMainForm then
    5461               DpiApplication.Terminate
    5462             else
    5463               Release;
    5464           end;
    5465       end;
    5466     end;
    5467   end;
    5468 end;
    5469 
    5470 function TDpiForm.CloseQuery: boolean;
    5471 begin
    5472   Result := True;
    5473   if Assigned(FOnCloseQuery) then
    5474     FOnCloseQuery(Self, Result);
    5475 end;
    5476 
    5477 procedure TDpiForm.BringToFront;
    5478 begin
    5479   GetNativeForm.BringToFront;
    5480 end;
    5481 
    5482 procedure TDpiForm.Release;
    5483 begin
    5484   Free;
    5485 end;
    5486 
    5487 // Init the component with an IDE resource
    5488 constructor TDpiForm.Create(TheOwner: TComponent);
    5489 begin
    5490   //inherited;
    5491   //DebugLn(['TDpiForm.Create ', DbgSName(TheOwner)]);
    5492   GlobalNameSpace.BeginWrite;
    5493   try
    5494     CreateNew(TheOwner, 1); // this calls BeginFormUpdate, which is ended in AfterConstruction
    5495     if (ClassType <> TDpiForm) and not (csDesigning in ComponentState) then begin
    5496       if not InitResourceComponent(Self, TDataModule) then begin
    5497         raise EResNotFound.Create('Resource missing for class ' + ClassName);
    5498       end;
    5499     end;
    5500   finally
    5501     GlobalNameSpace.EndWrite;
    5502   end;
    5503   ScreenChanged;
    5504   UpdateNativeControl;
    5505 end;
    5506 
    5507 constructor TDpiForm.CreateNew(AOwner: TComponent; Num: Integer);
    5508 begin
    5509   inherited Create(AOwner);
    5510   DpiScreen.AddForm(Self);
    5511 end;
    5512 
    5513 destructor TDpiForm.Destroy;
    5514 begin
    5515   // TODO: Can't destroy directly?
    5516   TFormEx(NativeForm).OnMessage := nil;
    5517   FreeAndNil(NativeForm);
    5518 
    5519   DpiScreen.RemoveForm(Self);
    5520   inherited;
    5521 end;
    5522 
    552371initialization
    552472
    5525 RegisterPropertyToSkip(TDpiForm, 'OldCreateOrder', 'Native compatibility property', '');
    5526 RegisterPropertyToSkip(TDpiForm, 'TextHeight', 'Native compatibility property', '');
    5527 RegisterPropertyToSkip(TDpiForm, 'Scaled', 'Native compatibility property', '');
    5528 RegisterPropertyToSkip(TDpiForm, 'TransparentColorValue', 'Native compatibility property', '');
    5529 DpiScreen := TDpiScreen.Create;
    5530 DpiApplication := TDpiApplication.Create(nil);
    5531 DpiMouse := TDpiMouse.Create;
    5532 RegisterClasses([TDpiButton, TDpiImage, TDpiPaintBox, TDpiListBox]);
    5533 
    5534 finalization
    5535 
    5536 FreeAndNil(DpiApplication);
    5537 FreeAndNil(DpiScreen);
    5538 FreeAndNil(DpiMouse);
    553973
    554074end.
Note: See TracChangeset for help on using the changeset viewer.