source: trunk/Packages/DpiControls/Dpi.Controls.pas

unit Dpi.Controls;

interface

uses
  Classes, SysUtils, Controls, Graphics, LCLType, Generics.Collections,
  Dpi.Graphics;

const
  CM_MOUSELEAVE = Controls.CM_MOUSELEAVE;

type
  TMouseButton = Controls.TMouseButton;
  TKeyEvent = Controls.TKeyEvent;
  TAlign = Controls.TAlign;
  TBorderStyle = Controls.TBorderStyle;

  { TControlEx }

  TControlEx = class(Controls.TControl)
  public
    property ParentColor;
    property OnMouseDown;
    property OnMouseUp;
    property OnMouseMove;
    property OnMouseWheel;
    property OnMouseLeave;
    property OnMouseEnter;
    property OnDblClick;
    property ParentFont;
  end;

  { TGraphicControlEx }

  TGraphicControlEx = class(Controls.TGraphicControl)
  public
    property OnPaint;
    procedure Paint; override;
  end;

  TWinControlEx = class(Controls.TWinControl)
  public
    property BorderStyle;
    property OnKeyDown;
  end;

  TWinControl = class;
  TControlBorderSpacing = class;

  { TSizeConstraints }

  TSizeConstraints = class(TPersistent)
  private
    FMaxHeight: TConstraintSize;
    FMaxWidth: TConstraintSize;
    FMinHeight: TConstraintSize;
    FMinWidth: TConstraintSize;
    procedure SetMaxHeight(AValue: TConstraintSize);
    procedure SetMaxWidth(AValue: TConstraintSize);
    procedure SetMinHeight(AValue: TConstraintSize);
    procedure SetMinWidth(AValue: TConstraintSize);
  published
    property MaxHeight: TConstraintSize read FMaxHeight write SetMaxHeight default 0;
    property MaxWidth: TConstraintSize read FMaxWidth write SetMaxWidth default 0;
    property MinHeight: TConstraintSize read FMinHeight write SetMinHeight default 0;
    property MinWidth: TConstraintSize read FMinWidth write SetMinWidth default 0;
  end;

  { TControl }

  TControl = class(TComponent)
  private
    FBorderSpacing: TControlBorderSpacing;
    FConstraints: TSizeConstraints;
    FFont: TFont;
    FHeight: Integer;
    FLeft: Integer;
    FOnChangeBounds: TNotifyEvent;
    FOnMouseUp: TMouseEvent;
    FOnMouseDown: TMouseEvent;
    FOnMouseMove: TMouseMoveEvent;
    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;
    FOnMouseWheel: TMouseWheelEvent;
    FOnResize: TNotifyEvent;
    FTop: Integer;
    FWidth: Integer;
    FParent: TWinControl;
    function GetAlign: TAlign;
    function GetAnchors: TAnchors;
    function GetAutoSize: Boolean;
    function GetBoundsRect: TRect;
    function GetClientHeight: Integer;
    function GetClientWidth: Integer;
    function GetColor: TColor;
    function GetCursor: TCursor;
    function GetEnabled: Boolean;
    function GetHint: string;
    function GetOnClick: TNotifyEvent;
    function GetOnDblClick: TNotifyEvent;
    function GetParentColor: Boolean;
    function GetParentFont: Boolean;
    function GetShowHint: Boolean;
    function GetVisible: Boolean;
    function GetWindowProc: TWndMethod;
    function IsAnchorsStored: Boolean;
    procedure SetAlign(AValue: TAlign);
    procedure SetAnchors(AValue: TAnchors);
    procedure SetAutoSize(AValue: Boolean);
    procedure SetBorderSpacing(AValue: TControlBorderSpacing);
    procedure SetBoundsRect(AValue: TRect);
    procedure SetClientHeight(AValue: Integer);
    procedure SetClientWidth(AValue: Integer);
    procedure SetColor(AValue: TColor);
    procedure SetCursor(AValue: TCursor);
    procedure SetEnabled(AValue: Boolean);
    procedure SetFont(AValue: TFont);
    procedure SetHint(AValue: string);
    procedure SetOnClick(AValue: TNotifyEvent);
    procedure SetOnDblClick(AValue: TNotifyEvent);
    procedure SetParentColor(AValue: Boolean);
    procedure SetParentFont(AValue: Boolean);
    procedure SetShowHint(AValue: Boolean);
    procedure NativeFormResize(Sender: TObject);
    procedure NativeChangeBounds(Sender: TObject);
    procedure DoFormResize;
    procedure DoChangeBounds;
    procedure MouseDownHandler(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); virtual;
    procedure MouseUpHandler(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); virtual;
    procedure MouseMoveHandler(Sender: TObject; Shift: TShiftState; X, Y: Integer); virtual;
    procedure MouseWheelHandler(Sender: TObject; Shift: TShiftState;
         WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); virtual;
    procedure MouseLeaveHandler(Sender: TObject); virtual;
    procedure MouseEnterHandler(Sender: TObject); virtual;
    procedure SetWindowProc(AValue: TWndMethod);
    function ColorIsStored: Boolean; virtual;
  protected
    procedure DoBorderSpacingChange(Sender: TObject; InnerSpaceChanged: Boolean); virtual;
    function GetText: TCaption; virtual;
    procedure SetText(AValue: TCaption); virtual;
    procedure UpdateBounds; virtual;
    procedure FontChanged(Sender: TObject); virtual;
    function GetCaption: string; virtual;
    procedure SetParent(AValue: TWinControl); virtual;
    procedure SetCaption(AValue: string); virtual;
    procedure SetHeight(AValue: Integer); virtual;
    procedure SetLeft(AValue: Integer); virtual;
    procedure SetTop(AValue: Integer); virtual;
    procedure SetVisible(AValue: Boolean); virtual;
    procedure SetWidth(AValue: Integer); virtual;
    function GetNativeControl: Controls.TControl; virtual;
    procedure UpdateNativeControl; virtual;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); virtual;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); virtual;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); virtual;
    procedure MouseLeave; virtual;
    procedure MouseEnter; virtual;
    property Text: TCaption read GetText write SetText;
    property ParentFont: Boolean read GetParentFont write SetParentFont default True;
    property ParentColor: Boolean read GetParentColor write SetParentColor default True;
  public
    function ScreenToClient(const APoint: TPoint): TPoint; virtual;
    function ClientToScreen(const APoint: TPoint): TPoint; virtual;
    procedure AddHandlerOnVisibleChanged(const OnVisibleChangedEvent: TNotifyEvent;
                                         AsFirst: boolean = false);
    procedure RemoveHandlerOnVisibleChanged(const OnVisibleChangedEvent: TNotifyEvent);
    procedure ScreenChanged; virtual;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); virtual;
    procedure Show;
    procedure Hide;
    procedure Invalidate;
    procedure Repaint;
    procedure Update;
    procedure Refresh;
    function IsParentOf(AControl: TControl): Boolean; virtual;
    function Scale96ToScreen(const ASize: Integer): Integer;
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    property Parent: TWinControl read FParent write SetParent;
    property BoundsRect: TRect read GetBoundsRect write SetBoundsRect;
    property Visible: Boolean read GetVisible write SetVisible;
    property Anchors: TAnchors read GetAnchors write SetAnchors stored IsAnchorsStored default [akLeft, akTop];
    property BorderSpacing: TControlBorderSpacing read FBorderSpacing write SetBorderSpacing;
    property WindowProc: TWndMethod read GetWindowProc write SetWindowProc;
  published
    property AutoSize: Boolean read GetAutoSize write SetAutoSize default False;
    property ClientHeight: Integer read GetClientHeight write SetClientHeight;
    property ClientWidth: Integer read GetClientWidth write SetClientWidth;
    property Hint: string read GetHint write SetHint;
    property Top: Integer read FTop write SetTop;
    property Left: Integer read FLeft write SetLeft;
    property Width: Integer read FWidth write SetWidth;
    property Height: Integer read FHeight write SetHeight;
    property Caption: string read GetCaption write SetCaption;
    property Enabled: Boolean read GetEnabled write SetEnabled;
    property ShowHint: Boolean read GetShowHint write SetShowHint;
    property Font: TFont read FFont write SetFont;
    property Align: TAlign read GetAlign write SetAlign;
    property Color: TColor read GetColor write SetColor stored ColorIsStored default {$ifdef UseCLDefault}clDefault{$else}clWindow{$endif};
    property Constraints: TSizeConstraints read FConstraints write FConstraints;
    property Cursor: TCursor read GetCursor write SetCursor default crDefault;
    property OnResize: TNotifyEvent read FOnResize write FOnResize;
    property OnChangeBounds: TNotifyEvent read FOnChangeBounds write FOnChangeBounds;
    property OnClick: TNotifyEvent read GetOnClick write SetOnClick;
    property OnDblClick: TNotifyEvent read GetOnDblClick write SetOnDblClick;
    property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
    property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
    property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
    property OnMouseWheel: TMouseWheelEvent read FOnMouseWheel write FOnMouseWheel;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
  end;

  TDpiControls = TObjectList<TControl>;

  { TWinControl }

  TWinControl = class(TControl)
  private
    FOnKeyDown: TKeyEvent;
    function GetBorderStyle: TBorderStyle;
    function GetHandle: HWND;
    function GetOnKeyDown: TKeyEvent;
    function GetOnKeyPress: TKeyPressEvent;
    function GetOnKeyUp: TKeyEvent;
    function GetTabOrder: TTabOrder;
    function GetTabStop: Boolean;
    procedure SetBorderStyle(AValue: TBorderStyle);
    procedure SetHandle(AValue: HWND);
    procedure SetOnKeyDown(AValue: TKeyEvent);
    procedure SetOnKeyPress(AValue: TKeyPressEvent);
    procedure SetOnKeyUp(AValue: TKeyEvent);
    procedure SetTabOrder(AValue: TTabOrder);
    procedure SetTabStop(AValue: Boolean);
    procedure KeyDownHandler(Sender: TObject; var Key: Word; Shift: TShiftState);
  protected
    procedure UpdateNativeControl; override;
    function GetNativeControl: Controls.TControl; override;
    function GetNativeWinControl: Controls.TWinControl; virtual;
    property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle default bsNone;
    procedure KeyDown(var Key: Word; Shift: TShiftState); virtual;
  public
    Controls: TDpiControls;
    function HandleAllocated: Boolean;
    procedure ScreenChanged; override;
    function ControlCount: Integer;
    procedure SetFocus; virtual;
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    property Handle: HWND read GetHandle write SetHandle;
  published
    property TabOrder: TTabOrder read GetTabOrder write SetTabOrder default -1;
    property TabStop: Boolean read GetTabStop write SetTabStop default False;
    property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown;
    property OnKeyPress: TKeyPressEvent read GetOnKeyPress write SetOnKeyPress;
    property OnKeyUp: TKeyEvent read GetOnKeyUp write SetOnKeyUp;
  end;

  { TControlBorderSpacing }

  TControlBorderSpacing = class(TPersistent)
  private
    FAround: TSpacingSize;
    FBottom: TSpacingSize;
    FLeft: TSpacingSize;
    FOnChange: TNotifyEvent;
    FRight: TSpacingSize;
    FTop: TSpacingSize;
    FControl: TControl;
    FDefault: PControlBorderSpacingDefault;
    function IsAroundStored: Boolean;
    function IsBottomStored: Boolean;
    function IsLeftStored: Boolean;
    function IsRightStored: Boolean;
    function IsTopStored: Boolean;
    procedure SetAround(AValue: TSpacingSize);
    procedure SetBottom(AValue: TSpacingSize);
    procedure SetLeft(AValue: TSpacingSize);
    procedure SetRight(AValue: TSpacingSize);
    procedure SetTop(AValue: TSpacingSize);
    procedure Change(InnerSpaceChanged: Boolean); virtual;
  public
    constructor Create(OwnerControl: TControl; ADefault: PControlBorderSpacingDefault = nil);
  published
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property Around: TSpacingSize read FAround write SetAround stored IsAroundStored;
    property Left: TSpacingSize read FLeft write SetLeft stored IsLeftStored;
    property Top: TSpacingSize read FTop write SetTop stored IsTopStored;
    property Right: TSpacingSize read FRight write SetRight stored IsRightStored;
    property Bottom: TSpacingSize read FBottom write SetBottom stored IsBottomStored;
  end;

  { TCustomControl }

  TCustomControl = class(TWinControl)
  private
    FCanvas: TCanvas;
    function GetCanvas: TCanvas;
    function GetOnPaint: TNotifyEvent;
    function GetPixelsPerInch: Integer;
    procedure SetOnPaint(AValue: TNotifyEvent);
    procedure SetPixelsPerInch(AValue: Integer);
  protected
    function GetNativeWinControl: Controls.TWinControl; override;
    function GetNativeCustomControl: Controls.TCustomControl; virtual;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    property Canvas: TCanvas read GetCanvas;
  published
    property PixelsPerInch: Integer read GetPixelsPerInch write SetPixelsPerInch stored False;
    property OnPaint: TNotifyEvent read GetOnPaint write SetOnPaint;
  end;

  { TGraphicControl }

  TGraphicControl = class(TControl)
  private
    FOnPaint: TNotifyEvent;
    NativeGraphicControl: Controls.TGraphicControl;
    FCanvas: TCanvas;
    function GetOnPaint: TNotifyEvent;
    procedure SetCanvas(AValue: TCanvas);
    procedure PaintHandler(Sender: TObject);
    procedure SetOnPaint(AValue: TNotifyEvent);
  protected
    procedure Paint; virtual;
    function GetNativeControl: Controls.TControl; override;
    function GetNativeGraphicControl: Controls.TGraphicControl; virtual;
    procedure UpdateNativeControl; override;
    property OnPaint: TNotifyEvent read GetOnPaint write SetOnPaint;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Canvas: TCanvas read FCanvas write SetCanvas;
  end;

  { TMouse }

  TMouse = class
  private
    function GetCursorPos: TPoint;
    procedure SetCursorPos(AValue: TPoint);
  public
    constructor Create;
    destructor Destroy; override;
    property CursorPos: TPoint read GetCursorPos write SetCursorPos;
  end;

  { TImageList }

  TImageList = class(TComponent)
  private
    NativeImageList: Controls.TImageList;
    function GetCount: Integer;
    function GetHeight: Integer;
    function GetWidth: Integer;
    procedure SetHeight(AValue: Integer);
    procedure SetWidth(AValue: Integer);
  public
    function GetNativeImageList: Controls.TImageList;
    procedure GetBitmap(Index: Integer; Image: TBitmap);
    procedure BeginUpdate;
    procedure EndUpdate;
    procedure Clear;
    function Add(Image, Mask: TBitmap): Integer;
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    property Width: Integer read GetWidth write SetWidth default 16;
    property Height: Integer read GetHeight write SetHeight default 16;
    property Count: Integer read GetCount;
  end;

var
  Mouse: TMouse;


implementation

uses
  Dpi.Common;

{ TCustomControl }

function TCustomControl.GetOnPaint: TNotifyEvent;
begin
  Result := GetNativeCustomControl.OnPaint;
end;

function TCustomControl.GetPixelsPerInch: Integer;
begin
  //Result := GetNativeCustomControl.Pix;
end;

function TCustomControl.GetCanvas: TCanvas;
begin
  Result := FCanvas;
end;

procedure TCustomControl.SetOnPaint(AValue: TNotifyEvent);
begin
  GetNativeCustomControl.OnPaint := AValue;
end;

procedure TCustomControl.SetPixelsPerInch(AValue: Integer);
begin
end;

function TCustomControl.GetNativeWinControl: Controls.TWinControl;
begin
  Result := GetNativeCustomControl;
end;

function TCustomControl.GetNativeCustomControl: Controls.TCustomControl;
begin
  Result := nil;
end;

constructor TCustomControl.Create(TheOwner: TComponent);
begin
  inherited;
  FCanvas := TCanvas.Create;
  FCanvas.NativeCanvas := GetNativeCustomControl.Canvas;
end;

destructor TCustomControl.Destroy;
begin
  FreeAndNil(FCanvas);
  inherited;
end;

{ TWinControl }

function TWinControl.GetBorderStyle: TBorderStyle;
begin
  {$objectChecks-}
  Result := TWinControlEx(GetNativeWinControl).BorderStyle;
  {$objectChecks+}
end;

function TWinControl.GetHandle: HWND;
begin
  Result := GetNativeWinControl.Handle;
end;

function TWinControl.GetOnKeyDown: TKeyEvent;
begin
  Result := GetNativeWinControl.OnKeyDown;
end;

function TWinControl.GetOnKeyPress: TKeyPressEvent;
begin
  Result := GetNativeWinControl.OnKeyPress;
end;

function TWinControl.GetOnKeyUp: TKeyEvent;
begin
  Result := GetNativeWinControl.OnKeyUp;
end;

function TWinControl.GetTabOrder: TTabOrder;
begin
  Result := GetNativeWinControl.TabOrder;
end;

function TWinControl.GetTabStop: Boolean;
begin
  Result := GetNativeWinControl.TabStop;
end;

procedure TWinControl.SetBorderStyle(AValue: TBorderStyle);
begin
  {$objectChecks-}
  TWinControlEx(GetNativeWinControl).BorderStyle := AValue;
  {$objectChecks+}
end;

procedure TWinControl.SetHandle(AValue: HWND);
begin
  GetNativeWinControl.Handle := AValue;
end;

procedure TWinControl.SetOnKeyDown(AValue: TKeyEvent);
begin
  GetNativeWinControl.OnKeyDown := AValue;
end;

procedure TWinControl.SetOnKeyPress(AValue: TKeyPressEvent);
begin
  GetNativeWinControl.OnKeyPress := AValue;
end;

procedure TWinControl.SetOnKeyUp(AValue: TKeyEvent);
begin
  GetNativeWinControl.OnKeyUp := AValue;
end;

procedure TWinControl.SetTabOrder(AValue: TTabOrder);
begin
  GetNativeWinControl.TabOrder := AValue;
end;

procedure TWinControl.SetTabStop(AValue: Boolean);
begin
  GetNativeWinControl.TabStop := AValue;
end;

procedure TWinControl.KeyDownHandler(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  KeyDown(Key, Shift);
  if Assigned(FOnKeyDown) then FOnKeyDown(Self, Key, Shift);
end;

procedure TWinControl.UpdateNativeControl;
begin
  inherited;
  GetNativeWinControl.OnKeyDown := KeyDownHandler;
end;

function TWinControl.GetNativeControl: Controls.TControl;
begin
  Result := GetNativeWinControl;
end;

function TWinControl.GetNativeWinControl: Controls.TWinControl;
begin
  Result := nil;
end;

procedure TWinControl.KeyDown(var Key: Word; Shift: TShiftState);
begin
end;

function TWinControl.HandleAllocated: Boolean;
begin
  Result := GetNativeWinControl.HandleAllocated;
end;

procedure TWinControl.ScreenChanged;
var
  I: Integer;
begin
  inherited;
  for I := 0 to Controls.Count - 1 do
    Controls[I].ScreenChanged;
end;

function TWinControl.ControlCount: Integer;
begin
  Result := Controls.Count;
end;

procedure TWinControl.SetFocus;
begin
  GetNativeWinControl.SetFocus;
end;

constructor TWinControl.Create(TheOwner: TComponent);
begin
  Controls := TDpiControls.Create;
  Controls.OwnsObjects := False;
  inherited;
end;

destructor TWinControl.Destroy;
begin
  FreeAndNil(Controls);
  inherited;
end;

{ TControl }

procedure TControl.SetTop(AValue: Integer);
begin
  if FTop = AValue then Exit;
  FTop := AValue;
  UpdateBounds;
end;

procedure TControl.SetVisible(AValue: Boolean);
begin
  GetNativeControl.Visible := AValue;
end;

procedure TControl.SetWidth(AValue: Integer);
begin
  if FWidth = AValue then Exit;
  FWidth := AValue;
  UpdateBounds;
end;

function TControl.GetNativeControl: Controls.TControl;
begin
  Result := nil;
end;

procedure TControl.UpdateNativeControl;
begin
  Font.NativeFont := GetNativeControl.Font;
  GetNativeControl.OnResize := NativeFormResize;
  GetNativeControl.OnChangeBounds := NativeChangeBounds;

  {$objectChecks-}
  TControlEx(GetNativeControl).OnMouseDown := MouseDownHandler;
  TControlEx(GetNativeControl).OnMouseUp := MouseUpHandler;
  TControlEx(GetNativeControl).OnMouseMove := MouseMoveHandler;
  TControlEx(GetNativeControl).OnMouseEnter := MouseEnterHandler;
  TControlEx(GetNativeControl).OnMouseLeave := MouseLeaveHandler;
  TControlEx(GetNativeControl).OnMouseWheel := MouseWheelHandler;
  {$objectChecks+}
end;

procedure TControl.MouseDownHandler(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  MouseDown(Button, Shift, ScaleFromNative(X), ScaleFromNative(Y));
  if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, ScaleFromNative(X), ScaleFromNative(Y));
end;

procedure TControl.MouseUpHandler(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  MouseUp(Button, Shift, ScaleFromNative(X), ScaleFromNative(Y));
  if Assigned(FOnMouseUp) then FOnMouseUp(Self, Button, Shift, ScaleFromNative(X), ScaleFromNative(Y));
end;

procedure TControl.MouseMoveHandler(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  MouseMove(Shift, ScaleFromNative(X), ScaleFromNative(Y));
  if Assigned(FOnMouseMove) then FOnMouseMove(Self, Shift, ScaleFromNative(X), ScaleFromNative(Y));
end;

procedure TControl.MouseWheelHandler(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  if Assigned(FOnMouseWheel) then FOnMouseWheel(Self, Shift, WheelDelta,
    ScalePointFromNative(MousePos), Handled);
end;

procedure TControl.MouseLeaveHandler(Sender: TObject);
begin
  MouseLeave;
  if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
end;

procedure TControl.MouseEnterHandler(Sender: TObject);
begin
  MouseEnter;
  if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
end;

procedure TControl.SetWindowProc(AValue: TWndMethod);
begin
  GetNativeControl.WindowProc := AValue;
end;

function TControl.ColorIsStored: Boolean;
begin
  Result := not ParentColor;
end;

procedure TControl.DoBorderSpacingChange(Sender: TObject;
  InnerSpaceChanged: Boolean);
begin
  GetNativeControl.BorderSpacing.Left := ScaleToNative(FBorderSpacing.Left);
  GetNativeControl.BorderSpacing.Right := ScaleToNative(FBorderSpacing.Right);
  GetNativeControl.BorderSpacing.Top := ScaleToNative(FBorderSpacing.Top);
  GetNativeControl.BorderSpacing.Bottom := ScaleToNative(FBorderSpacing.Bottom);
  GetNativeControl.BorderSpacing.Around := ScaleToNative(FBorderSpacing.Around);
end;

procedure TControl.SetText(AValue: TCaption);
begin

end;

procedure TControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
end;

procedure TControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
end;

procedure TControl.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
end;

procedure TControl.MouseLeave;
begin
end;

procedure TControl.MouseEnter;
begin
end;

function TControl.ScreenToClient(const APoint: TPoint): TPoint;
begin
  Result := ScalePointFromNative(GetNativeControl.ScreenToClient(ScalePointToNative(APoint)));
end;

function TControl.ClientToScreen(const APoint: TPoint): TPoint;
begin
  Result := ScalePointFromNative(GetNativeControl.ClientToScreen(ScalePointToNative(APoint)));
end;

procedure TControl.AddHandlerOnVisibleChanged(
  const OnVisibleChangedEvent: TNotifyEvent; AsFirst: boolean);
begin
  GetNativeControl.AddHandlerOnVisibleChanged(OnVisibleChangedEvent, AsFirst);
end;

procedure TControl.RemoveHandlerOnVisibleChanged(
  const OnVisibleChangedEvent: TNotifyEvent);
begin
  GetNativeControl.RemoveHandlerOnVisibleChanged(OnVisibleChangedEvent);
end;

procedure TControl.ScreenChanged;
begin
  UpdateBounds;
  Font.ScreenChanged;
end;

procedure TControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  FLeft := ALeft;
  FTop := ATop;
  FWidth := AWidth;
  FHeight := AHeight;
  UpdateBounds;
end;

procedure TControl.Show;
begin
  Visible := True;
end;

procedure TControl.Hide;
begin
  Visible := False;
end;

procedure TControl.Invalidate;
begin
  GetNativeControl.Invalidate;
end;

procedure TControl.Repaint;
begin
  GetNativeControl.Repaint;
end;

procedure TControl.Update;
begin
  GetNativeControl.Update;
end;

procedure TControl.Refresh;
begin
  GetNativeControl.Refresh;
end;

function TControl.IsParentOf(AControl: TControl): Boolean;
begin
  Result := False;
  while Assigned(AControl) do
  begin
    AControl := AControl.Parent;
    if Self = AControl then
      Exit(True);
  end;
end;

function TControl.Scale96ToScreen(const ASize: Integer): Integer;
begin
  Result := MulDiv(ASize, ScreenInfo.Dpi, 96);
end;

constructor TControl.Create(TheOwner: TComponent);
begin
  inherited;
  FFont := TFont.Create;
  FFont.OnChange := FontChanged;
  FConstraints := TSizeConstraints.Create;
  if Assigned(TheOwner) and (TheOwner is TWinControl) then
    Parent := TWinControl(TheOwner);
  FBorderSpacing := TControlBorderSpacing.Create(Self);
  GetNativeControl;
  UpdateNativeControl;
  ScreenChanged;
end;

destructor TControl.Destroy;
begin
  FreeAndNil(FBorderSpacing);
  FreeAndNil(FConstraints);
  FreeAndNil(FFont);
  inherited;
end;

procedure TControl.SetLeft(AValue: Integer);
begin
  if FLeft = AValue then Exit;
  FLeft := AValue;
  UpdateBounds;
end;

procedure TControl.SetCaption(AValue: string);
begin
  GetNativeControl.Caption := AValue;
end;

procedure TControl.SetParent(AValue: TWinControl);
begin
  if FParent = AValue then Exit;
  if Assigned(FParent) then begin
    FParent.Controls.Remove(Self);
    if Assigned(FParent) and (FParent is TWinControl) then
      GetNativeControl.Parent := nil;
  end;
  FParent := AValue;
  if Assigned(FParent) then begin
    FParent.Controls.Add(Self);
    if Assigned(FParent) and (FParent is TWinControl) then
      GetNativeControl.Parent := TWinControl(FParent).GetNativeWinControl;
  end;
end;

procedure TControl.SetFont(AValue: TFont);
begin
  if FFont = AValue then Exit;
  FFont := AValue;
end;

procedure TControl.SetHint(AValue: string);
begin
  GetNativeControl.Hint := AValue;
end;

function TControl.GetBoundsRect: TRect;
begin
  Result.Left := Left;
  Result.Top := Top;
  Result.Right := Left + Width;
  Result.Bottom := Top + Height;
end;

function TControl.GetAlign: TAlign;
begin
  Result := GetNativeControl.Align;
end;

function TControl.GetAnchors: TAnchors;
begin
  Result := GetNativeControl.Anchors;
end;

function TControl.GetAutoSize: Boolean;
begin
  Result := GetNativeControl.AutoSize;
end;

function TControl.GetClientHeight: Integer;
begin
  Result := ScaleFromNative(GetNativeControl.ClientHeight);
end;

function TControl.GetClientWidth: Integer;
begin
  Result := ScaleFromNative(GetNativeControl.ClientWidth);
end;

function TControl.GetColor: TColor;
begin
  Result := GetNativeControl.Color;
end;

function TControl.GetCursor: TCursor;
begin
  Result := GetNativeControl.Cursor;
end;

function TControl.GetEnabled: Boolean;
begin
  Result := GetNativeControl.Enabled;
end;

function TControl.GetHint: string;
begin
  Result := GetNativeControl.Hint;
end;

function TControl.GetOnClick: TNotifyEvent;
begin
  Result := GetNativeControl.OnClick;
end;

function TControl.GetOnDblClick: TNotifyEvent;
begin
  {$objectChecks-}
  Result := TControlEx(GetNativeControl).OnDblClick;
  {$objectChecks+}
end;

function TControl.GetParentColor: Boolean;
begin
  {$objectChecks-}
  Result := TControlEx(GetNativeControl).ParentColor;
  {$objectChecks+}
end;

function TControl.GetParentFont: Boolean;
begin
  {$objectChecks-}
  Result := TControlEx(GetNativeControl).ParentFont;
  {$objectChecks+}
end;

function TControl.GetShowHint: Boolean;
begin
  Result := GetNativeControl.ShowHint;
end;

function TControl.GetText: TCaption;
begin
  Result := '';
end;

function TControl.GetVisible: Boolean;
begin
  Result := GetNativeControl.Visible;
end;

function TControl.GetWindowProc: TWndMethod;
begin
  Result := GetNativeControl.WindowProc;
end;

function TControl.IsAnchorsStored: Boolean;
begin

end;

procedure TControl.SetAlign(AValue: TAlign);
begin
  GetNativeControl.Align := AValue;
end;

procedure TControl.SetAnchors(AValue: TAnchors);
begin
  GetNativeControl.Anchors := AValue;
end;

procedure TControl.SetAutoSize(AValue: Boolean);
begin
  GetNativeControl.AutoSize := AValue;
end;

procedure TControl.SetBorderSpacing(AValue: TControlBorderSpacing);
begin
  if FBorderSpacing = AValue then Exit;
  FBorderSpacing := AValue;
end;

procedure TControl.SetBoundsRect(AValue: TRect);
begin
  SetBounds(AValue.Left, AValue.Top, AValue.Right - AValue.Left, AValue.Bottom - AValue.Top);
end;

procedure TControl.SetClientHeight(AValue: Integer);
begin
  GetNativeControl.ClientHeight := ScaleToNative(AValue);
end;

procedure TControl.SetClientWidth(AValue: Integer);
begin
  GetNativeControl.ClientWidth := ScaleToNative(AValue);
end;

procedure TControl.SetColor(AValue: TColor);
begin
  GetNativeControl.Color := AValue;
end;

procedure TControl.SetCursor(AValue: TCursor);
begin
  GetNativeControl.Cursor := AValue;
end;

procedure TControl.SetEnabled(AValue: Boolean);
begin
  GetNativeControl.Enabled := AValue;
end;

procedure TControl.SetOnClick(AValue: TNotifyEvent);
begin
  GetNativeControl.OnClick := AValue;
end;

procedure TControl.SetOnDblClick(AValue: TNotifyEvent);
begin
  {$objectChecks-}
  TControlEx(GetNativeControl).OnDblClick := AValue;
  {$objectChecks+}
end;

procedure TControl.SetParentColor(AValue: Boolean);
begin
  {$objectChecks-}
  TControlEx(GetNativeControl).ParentColor := AValue;
  {$objectChecks+}
end;

procedure TControl.SetParentFont(AValue: Boolean);
begin
  {$objectChecks-}
  TControlEx(GetNativeControl).ParentFont := AValue;
  {$objectChecks+}
end;

procedure TControl.SetShowHint(AValue: Boolean);
begin
  GetNativeControl.ShowHint := AValue;
end;

procedure TControl.NativeFormResize(Sender: TObject);
var
  R: TRect;
begin
  R := ScaleRectFromNative(GetNativeControl.BoundsRect);
  FLeft := R.Left;
  FTop := R.Top;
  FWidth := R.Width;
  FHeight := R.Height;
  DoFormResize;
end;

procedure TControl.NativeChangeBounds(Sender: TObject);
var
  NewBounds: TRect;
begin
  NewBounds := ScaleRectFromNative(GetNativeControl.BoundsRect);
  if NewBounds <> BoundsRect then begin
    FLeft := NewBounds.Left;
    FTop := NewBounds.Top;
    FWidth := NewBounds.Width;
    FHeight := NewBounds.Height;
    DoChangeBounds;
  end;
end;

procedure TControl.DoFormResize;
begin
  if Assigned(FOnResize) then begin
    FOnResize(Self);
  end;
end;

procedure TControl.DoChangeBounds;
begin
  if Assigned(FOnChangeBounds) then FOnChangeBounds(Self);
end;

function TControl.GetCaption: string;
begin
  Result := GetNativeControl.Caption;
end;

procedure TControl.FontChanged(Sender: TObject);
begin
  GetNativeControl.Font.Size := ScaleToNative(Font.Size);
end;

procedure TControl.UpdateBounds;
begin
  GetNativeControl.BoundsRect := ScaleRectToNative(BoundsRect);
end;

procedure TControl.SetHeight(AValue: Integer);
begin
  if FHeight = AValue then Exit;
  FHeight := AValue;
  UpdateBounds;
end;

{ TControlBorderSpacing }

function TControlBorderSpacing.IsBottomStored: Boolean;
begin
  if FDefault = nil
  then Result := FBottom <> 0
  else Result := FBottom <> FDefault^.Bottom;
end;

function TControlBorderSpacing.IsAroundStored: Boolean;
begin
  if FDefault = nil
  then Result := FAround <> 0
  else Result := FAround <> FDefault^.Around;
end;

function TControlBorderSpacing.IsLeftStored: Boolean;
begin
  if FDefault = nil
  then Result := FLeft <> 0
  else Result := FLeft <> FDefault^.Left;
end;

function TControlBorderSpacing.IsRightStored: Boolean;
begin
  if FDefault = nil
  then Result := FRight <> 0
  else Result := FRight <> FDefault^.Right;
end;

function TControlBorderSpacing.IsTopStored: Boolean;
begin
  if FDefault = nil
  then Result := FTop <> 0
  else Result := FTop <> FDefault^.Top;
end;

procedure TControlBorderSpacing.SetAround(AValue: TSpacingSize);
begin
  if FAround = AValue then Exit;
  FAround := AValue;
  Change(False);
end;

procedure TControlBorderSpacing.SetBottom(AValue: TSpacingSize);
begin
  if FBottom = AValue then Exit;
  FBottom := AValue;
  Change(False);
end;

procedure TControlBorderSpacing.SetLeft(AValue: TSpacingSize);
begin
  if FLeft = AValue then Exit;
  FLeft := AValue;
  Change(False);
end;

procedure TControlBorderSpacing.SetRight(AValue: TSpacingSize);
begin
  if FRight = AValue then Exit;
  FRight := AValue;
  Change(False);
end;

procedure TControlBorderSpacing.SetTop(AValue: TSpacingSize);
begin
  if FTop = AValue then Exit;
  FTop := AValue;
  Change(False);
end;

procedure TControlBorderSpacing.Change(InnerSpaceChanged: Boolean);
begin
  if FControl <> nil then
    FControl.DoBorderSpacingChange(Self, InnerSpaceChanged);
  if Assigned(OnChange) then OnChange(Self);
end;

constructor TControlBorderSpacing.Create(OwnerControl: TControl;
  ADefault: PControlBorderSpacingDefault);
begin
  FControl := OwnerControl;
  FDefault := ADefault;
  if ADefault <> nil then
  begin
    FLeft := ADefault^.Left;
    FRight := ADefault^.Right;
    FTop := ADefault^.Top;
    FBottom := ADefault^.Bottom;
    FAround := ADefault^.Around;
  end;
  inherited Create;
end;

{ TSizeConstraints }

procedure TSizeConstraints.SetMaxHeight(AValue: TConstraintSize);
begin
  if FMaxHeight=AValue then Exit;
  FMaxHeight:=AValue;
end;

procedure TSizeConstraints.SetMaxWidth(AValue: TConstraintSize);
begin
  if FMaxWidth=AValue then Exit;
  FMaxWidth:=AValue;
end;

procedure TSizeConstraints.SetMinHeight(AValue: TConstraintSize);
begin
  if FMinHeight=AValue then Exit;
  FMinHeight:=AValue;
end;

procedure TSizeConstraints.SetMinWidth(AValue: TConstraintSize);
begin
  if FMinWidth=AValue then Exit;
  FMinWidth:=AValue;
end;

{ TGraphicControl }

procedure TGraphicControl.SetCanvas(AValue: TCanvas);
begin
  if FCanvas = AValue then Exit;
  FCanvas := AValue;
end;

procedure TGraphicControl.PaintHandler(Sender: TObject);
begin
  Paint;
  if Assigned(FOnPaint) then
    FOnPaint(Sender);
end;

procedure TGraphicControl.Paint;
begin
end;

function TGraphicControl.GetNativeControl: Controls.TControl;
begin
  Result := GetNativeGraphicControl;
end;

function TGraphicControl.GetNativeGraphicControl: Controls.TGraphicControl;
begin
  Result := NativeGraphicControl;
end;

procedure TGraphicControl.UpdateNativeControl;
begin
  inherited;
  {$objectChecks-}
  TGraphicControlEx(GetNativeGraphicControl).OnPaint := PaintHandler;
  {$objectChecks+}
end;

function TGraphicControl.GetOnPaint: TNotifyEvent;
begin
  Result := FOnPaint;
end;

procedure TGraphicControl.SetOnPaint(AValue: TNotifyEvent);
begin
  FOnPaint := AValue;
end;

constructor TGraphicControl.Create(TheOwner: TComponent);
begin
  NativeGraphicControl := Controls.TGraphicControl.Create(nil);
  inherited;
  FCanvas := TCanvas.Create;
  FCanvas.NativeCanvas := GetNativeGraphicControl.Canvas;
end;

destructor TGraphicControl.Destroy;
begin
  FreeAndNil(FCanvas);
  FreeAndNil(NativeGraphicControl);
  inherited;
end;

{ TGraphicControlEx }

procedure TGraphicControlEx.Paint;
begin
  inherited Paint;
end;

{ TMouse }

function TMouse.GetCursorPos: TPoint;
begin
  Result := ScalePointFromNative(Controls.Mouse.CursorPos);
end;

procedure TMouse.SetCursorPos(AValue: TPoint);
begin
  Controls.Mouse.CursorPos := ScalePointToNative(AValue);
end;

constructor TMouse.Create;
begin
end;

destructor TMouse.Destroy;
begin
  inherited;
end;

{ TImageList }

function TImageList.GetHeight: Integer;
begin

end;

function TImageList.GetCount: Integer;
begin

end;

function TImageList.GetWidth: Integer;
begin

end;

procedure TImageList.SetHeight(AValue: Integer);
begin

end;

procedure TImageList.SetWidth(AValue: Integer);
begin

end;

function TImageList.GetNativeImageList: Controls.TImageList;
begin
  if not Assigned(NativeImageList) then
    NativeImageList := Controls.TImageList.Create(nil);
  Result := NativeImageList;
end;

procedure TImageList.GetBitmap(Index: Integer; Image: TBitmap);
begin

end;

procedure TImageList.BeginUpdate;
begin

end;

procedure TImageList.EndUpdate;
begin

end;

procedure TImageList.Clear;
begin

end;

function TImageList.Add(Image, Mask: TBitmap): Integer;
begin

end;

constructor TImageList.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
end;

destructor TImageList.Destroy;
begin
  FreeAndNil(NativeImageList);
  inherited;
end;

initialization

Mouse := TMouse.Create;

finalization;

FreeAndNil(Mouse);

end.