[JEDI.NET-commits] dev/ahuser/WinFormsVCL Jedi.WinForms.VCL.Buttons.pas,NONE,1.1 Jedi.WinForms.VCL.Controls.pas,NONE,1.1 Jedi.WinForms.VCL.Forms.pas,NONE,1.1 Jedi.WinForms.VCL.Graphics.pas,NONE,1.1 Jedi.WinForms.VCL.ImgList.pas,NONE,1.1 Jedi.WinForms.VCL.Menus.pas,NONE,1.1

[Andreas H. <ah...@us...>]

Update of /cvsroot/jedidotnet/dev/ahuser/WinFormsVCL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv21311/ahuser/WinFormsVCL

Added Files:
	Jedi.WinForms.VCL.Buttons.pas Jedi.WinForms.VCL.Controls.pas 
	Jedi.WinForms.VCL.Forms.pas Jedi.WinForms.VCL.Graphics.pas 
	Jedi.WinForms.VCL.ImgList.pas Jedi.WinForms.VCL.Menus.pas 
Log Message:
Jedi.WinForms.VCL units

--- NEW FILE: Jedi.WinForms.VCL.ImgList.pas ---
{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: Jedi.WinForms.VCL.ImgList.pas, released on 2004-12-26.

The Initial Developer of the Original Code is Andreas Hausladen <Andreas dott Hausladen att gmx dott de>
Portions created by Andreas Hausladen are Copyright (C) 2004 Andreas Hausladen.
All Rights Reserved.

Contributor(s):

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: Jedi.WinForms.VCL.ImgList.pas,v 1.1 2004/12/26 15:58:41 ahuser Exp $

unit Jedi.WinForms.VCL.ImgList;

interface

uses
  System.Collections, System.Drawing, System.Drawing.Imaging, System.Windows.Forms,
  Borland.Vcl.Classes, Jedi.WinForms.VCL.Graphics;

type
  TImageIndex = Integer;
  TCustomImageList = class;

  TChangeLink = class(TObject)
  private
    FSender: TCustomImageList;
    FOnChange: TNotifyEvent;
  public
    procedure Change; dynamic;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property Sender: TCustomImageList read FSender write FSender;
  end;

  TCustomImageList = class(TComponent)
  private
    FImageList: System.Windows.Forms.ImageList;
    FChangeLinks: ArrayList;
    FOnChange: TNotifyEvent;
    FBkColor: TColor;
  protected
    procedure Changed; virtual;
  public
    function get_Count: Integer;
    procedure set_Height(const Value: Integer);
    procedure set_Width(const Value: Integer);

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure set_ImageList(const Value: System.Windows.Forms.ImageList);

    procedure RegisterChanges(ChangeLink: TChangeLink);
    procedure UnregisterChanges(ChangeLink: TChangeLink);

    procedure Draw(Canvas: TCanvas; X, Y, Index: Integer; Enabled: Boolean = True); overload;

    property Count: Integer read get_Count;
  published
    function get_Height: Integer;
    function get_Width: Integer;
    procedure set_BkColor(const Value: TColor);
    property ImageList: System.Windows.Forms.ImageList read FImageList write set_ImageList;
    property Height: Integer read get_Height write set_Height;
    property Width: Integer read get_Width write set_Width;
    property BkColor: TColor read FBkColor write set_BkColor;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  TImageList = class(TCustomImageList)
  end;

implementation

uses
  System.ComponentModel;

{ TChangeLink }

procedure TChangeLink.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Sender);
end;

{ TCustomImageList }

constructor TCustomImageList.Create(AOwner: TComponent);
begin
  inherited Create;
  FChangeLinks := ArrayList.Create;
  FImageList := System.Windows.Forms.ImageList.Create;
  FImageList.ImageSize.Width := 16;
  FImageList.ImageSize.Height := 16;
end;

destructor TCustomImageList.Destroy;
begin
  FImageList.Free;
  inherited Destroy;
end;

procedure TCustomImageList.Changed;
var
  i: Integer;
begin
  for i := FChangeLinks.Count - 1 downto 0 do
    TChangeLink(FChangeLinks[i]).Change;
end;

procedure TCustomImageList.RegisterChanges(ChangeLink: TChangeLink);
begin
  if (ChangeLink <> nil) and not FChangeLinks.Contains(ChangeLink) then
  begin
    FChangeLinks.Add(ChangeLink);
    ChangeLink.Sender := Self;
  end;
end;

procedure TCustomImageList.UnregisterChanges(ChangeLink: TChangeLink);
begin
  if (ChangeLink <> nil) and FChangeLinks.Contains(ChangeLink) then
  begin
    ChangeLink.Sender := nil;
    FChangeLinks.Remove(ChangeLink);
  end;
end;

procedure TCustomImageList.set_ImageList(const Value: System.Windows.Forms.ImageList);
var
  i: Integer;
begin
  if Value <> FImageList then
  begin
    FImageList.Images.Clear;
    if Value <> nil then
    begin
      FImageList.ImageSize := Value.ImageSize;
      FImageList.ColorDepth := Value.ColorDepth;
      FImageList.TransparentColor := Value.TransparentColor;
      FImageList.ImageStream := Value.ImageStream;
      for i := 0 to Value.Images.Count - 1 do
        FImageList.Images.Add(Value.Images.Item[i], Value.TransparentColor);
      Changed;
    end;
  end;
end;

procedure TCustomImageList.Draw(Canvas: TCanvas; X, Y, Index: Integer; Enabled: Boolean);
begin
  if Enabled then
    ImageList.Draw(Canvas.Handle, X, Y, Index)
  else
    ControlPaint.DrawImageDisabled(Canvas.Handle, ImageList.Images[Index], X, Y, ToNETColor(BkColor));
end;

function TCustomImageList.get_Count: Integer;
begin
  Result := ImageList.Images.Count;
end;

procedure TCustomImageList.set_Height(const Value: Integer);
begin
  ImageList.ImageSize.Height := Value;
end;

procedure TCustomImageList.set_Width(const Value: Integer);
begin
  ImageList.ImageSize.Width := Value;
end;

function TCustomImageList.get_Height: Integer;
begin
  Result := FImageList.ImageSize.Height;
end;

function TCustomImageList.get_Width: Integer;
begin
  Result := FImageList.ImageSize.Width;
end;

procedure TCustomImageList.set_BkColor(const Value: TColor);
begin
  FBkColor := Value;
end;

end.

--- NEW FILE: Jedi.WinForms.VCL.Buttons.pas ---
{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: Jedi.WinForms.VCL.Buttons.pas, released on 2004-12-26.

The Initial Developer of the Original Code is Andreas Hausladen <Andreas dott Hausladen att gmx dott de>
Portions created by Andreas Hausladen are Copyright (C) 2004 Andreas Hausladen.
All Rights Reserved.

Contributor(s):

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: Jedi.WinForms.VCL.Buttons.pas,v 1.1 2004/12/26 15:58:41 ahuser Exp $

unit Jedi.WinForms.VCL.Buttons;

interface

uses
  System.Drawing, System.Windows.Forms,
  Borland.Vcl.Classes, Borland.Vcl.Messages,
  Jedi.WinForms.VCL.Controls, Jedi.WinForms.VCL.Graphics;

type
  { Quick & Dirty, simply uses a WinForms Button which has too many features
    for a TSpeedButton like "Focus". }

  TEventHelperSpeedButton = class(System.Windows.Forms.Button)
  strict protected
    procedure OnClick(e: EventArgs); override;
  public
    procedure Click; virtual;
  end;

  TSpeedButton = class(TEventHelperSpeedButton) // TGraphicControl
  private
    FGlyph: TBitmap;
    FOnClick: TNotifyEvent;
    procedure SetGlyph(const Value: TBitmap);
    function GetFlat: Boolean;
    procedure SetFlat(const Value: Boolean);
    function GetCaption: TCaption;
    procedure SetCaption(const Value: TCaption);
  strict protected
    procedure OnInvalidated(e: InvalidateEventArgs); override;
  protected
    procedure Paint;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Click; override;
  published
    property Caption: TCaption read GetCaption write SetCaption;
    property Flat: Boolean read GetFlat write SetFlat;
    property Glyph: TBitmap read FGlyph write SetGlyph;

    property OnClick: TNotifyEvent read FOnClick write FOnClick;
  end;

implementation

{ TSpeedButton }

procedure TSpeedButton.Click;
begin
  inherited Click;
  if Assigned(FOnClick) then
    FOnClick(Self);
end;

constructor TSpeedButton.Create(AOwner: TComponent);
begin
  inherited Create;
  FGlyph := TBitmap.Create;
  TabStop := False;
  //FOwner := AOwner;
end;

destructor TSpeedButton.Destroy;
begin
  FGlyph.Free;
  inherited Destroy;
end;

function TSpeedButton.GetCaption: TCaption;
begin
  Result := Text;
end;

function TSpeedButton.GetFlat: Boolean;
begin
  Result := FlatStyle = System.Windows.Forms.FlatStyle.Flat;
end;

procedure TSpeedButton.Paint;
begin
  Refresh;
end;

procedure TSpeedButton.OnInvalidated(e: InvalidateEventArgs);
begin
  inherited OnInvalidated(e);
  if Parent <> nil then
  begin
    // Optimization with e.InvalidRect does not work here because the rectangle
    // is limited to this control and does not apply to the parent control which
    // seems to do not get any Paint event for the invalidated area at all.
    // (WinForms Bug?)
    Parent.Invalidate;
  end;
end;

procedure TSpeedButton.SetCaption(const Value: TCaption);
begin
  Text := Value;
end;

procedure TSpeedButton.SetFlat(const Value: Boolean);
begin
  if Value then
    FlatStyle := System.Windows.Forms.FlatStyle.Flat
  else
    FlatStyle := System.Windows.Forms.FlatStyle.Standard;
end;

procedure TSpeedButton.SetGlyph(const Value: TBitmap);
begin
  if Value <> FGlyph then
    FGlyph.Assign(Value);
  if FGlyph.Empty then
    Image := nil
  else
    Image := FGlyph.Handle;
end;

{ TEventHelperSpeedButton }

procedure TEventHelperSpeedButton.Click;
begin
end;

procedure TEventHelperSpeedButton.OnClick(e: EventArgs);
begin
  Click;
  inherited OnClick(e);
end;

end.

--- NEW FILE: Jedi.WinForms.VCL.Graphics.pas ---
{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: Jedi.WinForms.VCL.Graphics.pas, released on 2004-12-26.

The Initial Developer of the Original Code is Andreas Hausladen <Andreas dott Hausladen att gmx dott de>
Portions created by Andreas Hausladen are Copyright (C) 2004 Andreas Hausladen.
All Rights Reserved.

Contributor(s):

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
[...1604 lines suppressed...]
    FHeight := -(Value * 96) / PixelsPerInch;
end;

procedure TFont.SetStyle(Value: TFontStyles);
begin
  if Value <> FStyle then
  begin
    FStyle := Value;
    Changed;
  end;
end;

function TFont.GetBrush: System.Drawing.Brush;
begin
  if not Assigned(FBrush) then
    FBrush := SolidBrush.Create(ToNETColor(Color));
  Result := FBrush;
end;

end.

--- NEW FILE: Jedi.WinForms.VCL.Forms.pas ---
{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: Jedi.WinForms.VCL.Forms.pas, released on 2004-12-26.

The Initial Developer of the Original Code is Andreas Hausladen <Andreas dott Hausladen att gmx dott de>
Portions created by Andreas Hausladen are Copyright (C) 2004 Andreas Hausladen.
All Rights Reserved.

Contributor(s):

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: Jedi.WinForms.VCL.Forms.pas,v 1.1 2004/12/26 15:58:41 ahuser Exp $

unit Jedi.WinForms.VCL.Forms;

interface

uses
  System.Windows.Forms;

type
  TApplication = class(TObject)
  private
    FShowHint: Boolean;
    procedure SetShowHint(const Value: Boolean);
  public
    procedure CancelHint;
    property ShowHint: Boolean read FShowHint write SetShowHint;
  end;


function Application: TApplication; 

implementation

uses
  Jedi.WinForms.VCL.Controls;

var
  FApplication: TApplication;

function Application: TApplication;
begin
  if not Assigned(FApplication) then
    FApplication := TApplication.Create;
  Result := FApplication;
end;

{ TApplication }

procedure TApplication.CancelHint;
begin
  TWinControl.ControlToolTip.Active := False;
  TWinControl.ControlToolTip.Active := ShowHint;
end;

procedure TApplication.SetShowHint(const Value: Boolean);
begin
  if Value <> FShowHint then
  begin
    FShowHint := Value;
    CancelHint;
  end;
end;

end.

--- NEW FILE: Jedi.WinForms.VCL.Menus.pas ---
{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: Jedi.WinForms.VCL.Menus.pas, released on 2004-12-26.

The Initial Developer of the Original Code is Andreas Hausladen <Andreas dott Hausladen att gmx dott de>
Portions created by Andreas Hausladen are Copyright (C) 2004 Andreas Hausladen.
All Rights Reserved.

Contributor(s):

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: Jedi.WinForms.VCL.Menus.pas,v 1.1 2004/12/26 15:58:41 ahuser Exp $

unit Jedi.WinForms.VCL.Menus;

interface

uses
  System.Drawing, System.Windows.Forms, Borland.Vcl.Classes;

type
  TPopupMenu = System.Windows.Forms.ContextMenu;

  TPopupMenuHelper = class helper for TPopupMenu
  public
    procedure Popup(X, Y: Integer);
  end;

implementation

{ TPopupMenuHelper }

procedure TPopupMenuHelper.Popup(X, Y: Integer);
begin
  if Form.ActiveForm <> nil then
    Show(Form.ActiveForm, Point.Create(X, Y));
end;

end.

--- NEW FILE: Jedi.WinForms.VCL.Controls.pas ---
{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: Jedi.WinForms.VCL.Controls.pas, released on 2004-12-26.

The Initial Developer of the Original Code is Andreas Hausladen <Andreas dott Hausladen att gmx dott de>
Portions created by Andreas Hausladen are Copyright (C) 2004 Andreas Hausladen.
All Rights Reserved.

Contributor(s):

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: Jedi.WinForms.VCL.Controls.pas,v 1.1 2004/12/26 15:58:41 ahuser Exp $

unit Jedi.WinForms.VCL.Controls;

interface

uses
  System.Drawing, System.Collections, System.ComponentModel,
  System.Windows.Forms, System.Windows.Forms.Design,
  Borland.Vcl.Messages, Borland.Vcl.Classes, Borland.Vcl.Types,
  Jedi.WinForms.VCL.Graphics, Jedi.WinForms.VCL.Menus;

const
  CM_BASE                   = $B000;

  CM_MOUSEENTER             = CM_BASE + 19;
  CM_MOUSELEAVE             = CM_BASE + 20;

type
  TCaption = string;

  TMouseButton = (mbLeft, mbMiddle, mbRight);
  TDragState = (dsDragEnter, dsDragLeave, dsDragMove);

  TControlStyle = set of (csAcceptsControls, csCaptureMouse,
    csDesignInteractive, csClickEvents, csFramed, csSetCaption, csOpaque,
    csDoubleClicks, csFixedWidth, csFixedHeight, csNoDesignVisible,
    csReplicatable, csNoStdEvents, csDisplayDragImage, csReflector,
    csActionClient, csMenuEvents, csNeedsBorderPaint, csParentBackground);

  TDragObject = class(DragEventArgs)
  end;

  TMouseEvent = procedure(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer) of object;
  TMouseMoveEvent = procedure(Sender: TObject; Shift: TShiftState; X, Y: Integer) of object;
  TDragOverEvent = procedure(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean) of object;
  TDragDropEvent = procedure(Sender, Source: TObject; X, Y: Integer) of object;
  TStartDragEvent = procedure(Sender: TObject; var DragObject: TDragObject) of object;
  TEndDragEvent = procedure(Sender, Target: TObject; X, Y: Integer) of object;

  TEventHelperControl = class(System.Windows.Forms.Control)
  strict protected
    procedure OnDragEnter(drgevent: DragEventArgs); override;
    procedure OnDragLeave(e: EventArgs); override;
    procedure OnDragDrop(drgevent: DragEventArgs); override;
    procedure OnDragOver(drgevent: DragEventArgs); override;
    procedure OnDoubleClick(e: EventArgs); override;
    procedure OnPaintBackground(pevent: PaintEventArgs); override;
    procedure OnResize(e: EventArgs); override;
    procedure OnClick(e: EventArgs); override;
    procedure OnMouseLeave(e: EventArgs); override;
    procedure OnMouseEnter(e: EventArgs); override;
    procedure OnMouseMove(e: MouseEventArgs); override;
    procedure OnMouseUp(e: MouseEventArgs); override;
    procedure OnMouseDown(e: MouseEventArgs); override;
  protected
    procedure Click; virtual;
    procedure DblClick; virtual;
    procedure Resize; virtual;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); virtual;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); virtual;
    procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); virtual;
    procedure DragDrop(Source: TObject; X, Y: Integer); virtual;
    procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); virtual;
    procedure WndProc(var Message: TMessage); virtual;
  public
    function Perform(Msg: Cardinal; WParam, LParam: Integer): Integer; 
  end;

  TAlign = (alNone, alTop, alBottom, alLeft, alRight, alClient, alCustom);

  TWinControl = class(TEventHelperControl)
  strict private
    FOwner: TComponent;
    FOnClick: TNotifyEvent;
    FOnDblClick: TNotifyEvent;
    FOnResize: TNotifyEvent;
    FOnMouseDown: TMouseEvent;
    FOnMouseUp: TMouseEvent;
    FOnMouseMove: TMouseMoveEvent;
    FOnContextPopup: TNotifyEvent;
    FOnDragDrop: TDragDropEvent;
    FOnDragOver: TDragOverEvent;
    FOnStartDrag: TStartDragEvent;
    FOnEndDrag: TEndDragEvent;
  private
    FPopupMenu: TPopupMenu;
    FShowHint: Boolean;
    FHint: string;
    FControlStyle: TControlStyle;
    procedure SetAlign(const Value: TAlign);
    function GetAlign: TAlign;
    procedure SetPopupMenu(const Value: TPopupMenu);
    procedure SetShowHint(const Value: Boolean);
    procedure SetHint(const Value: string);
    procedure SetControlStyle(const Value: TControlStyle);
    function GetClientHeight: Integer;
    function GetClientWidth: Integer;
    procedure SetClientHeight(const Value: Integer);
    procedure SetClientWidth(const Value: Integer);
  protected
    function GetCaption: string;
    procedure SetCaption(const Value: string);
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;

    procedure Click; override;
    procedure DblClick; override;
    procedure Resize; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
    procedure DragDrop(Source: TObject; X, Y: Integer); override;
    procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); override;

    property ControlStyle: TControlStyle read FControlStyle write SetControlStyle;
    property Caption: string read GetCaption write SetCaption;
  public
    function GetClientRect: TRect;
    class var
      ControlToolTip: ToolTip;

    class constructor Create;
    constructor Create(AOwner: TComponent); overload; virtual;
    constructor Create; overload; 

    function ClientToScreen(const Pt: TPoint): TPoint;
    function ScreenToClient(const Pt: TPoint): TPoint;

    // Events
    property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
    property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
    property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
    property OnContextPopup: TNotifyEvent read FOnContextPopup write FOnContextPopup;
    property OnResize: TNotifyEvent read FOnResize write FOnResize;

    property OnDragDrop: TDragDropEvent read FOnDragDrop write FOnDragDrop;
    property OnDragOver: TDragOverEvent read FOnDragOver write FOnDragOver;
    property OnStartDrag: TStartDragEvent read FOnStartDrag write FOnStartDrag;
    property OnEndDrag: TEndDragEvent read FOnEndDrag write FOnEndDrag;

    property Align: TAlign read GetAlign write SetAlign default alNone;
    property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu; {TODO: PopupMenu}
    property ShowHint: Boolean read FShowHint write SetShowHint;
    property Hint: string read FHint write SetHint;
    property ClientWidth: Integer read GetClientWidth write SetClientWidth;
    property ClientHeight: Integer read GetClientHeight write SetClientHeight;
    property ClientRect: TRect read GetClientRect;

    property Owner: TComponent read FOwner;
  end;

  TControlCanvas = class(TCanvas)
  private
    FControl: TWinControl;
  protected
    procedure CreateHandle; override;
  public
    procedure SetControl(const Value: TWinControl);
    property Control: TWinControl read FControl write SetControl;
  end;

  TCustomControl = class(TWinControl)
  private
    FCanvas: TCanvas;
  strict protected
    procedure OnPaint(e: PaintEventArgs); override;
  protected
    procedure Paint; virtual;
    property Canvas: TCanvas read FCanvas;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TGraphicControl = class(TCustomControl)
  strict protected
    procedure OnInvalidated(e: InvalidateEventArgs); override;
  end;

function ButtonsToMouseButton(Buttons: System.Windows.Forms.MouseButtons): TMouseButton;
function GetShiftState(Buttons: System.Windows.Forms.MouseButtons): TShiftState;

implementation

{$AUTOBOX ON}

function ButtonsToMouseButton(Buttons: System.Windows.Forms.MouseButtons): TMouseButton;
begin
  Result := mbLeft;
  if Buttons = System.Windows.Forms.MouseButtons.Left then
    Result := mbLeft;
  if Buttons = System.Windows.Forms.MouseButtons.Middle then
    Result := mbMiddle;
  if Buttons = System.Windows.Forms.MouseButtons.Right then
    Result := mbRight;
end;

function GetShiftState(Buttons: System.Windows.Forms.MouseButtons): TShiftState;
begin
  Result := [];

  case Buttons of
    System.Windows.Forms.MouseButtons.Left:
      Include(Result, ssLeft);
    System.Windows.Forms.MouseButtons.Middle:
      Include(Result, ssMiddle);
    System.Windows.Forms.MouseButtons.Right:
      Include(Result, ssRight);
  end;
  {TODO: Shift keys}
end;

{ TEventHelperControl }

procedure TEventHelperControl.Click;
begin
end;

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

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

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

procedure TEventHelperControl.OnClick(e: EventArgs);
begin
  Click;
  inherited OnClick(e);
end;

procedure TEventHelperControl.OnPaintBackground(pevent: PaintEventArgs);
begin
  if Perform(WM_ERASEBKGND, 0, 0) = 0 then
    inherited OnPaintBackground(pevent);
end;

procedure TEventHelperControl.OnMouseDown(e: MouseEventArgs);
begin
  MouseDown(ButtonsToMouseButton(e.Button), GetShiftState(e.Button), e.X, e.Y);
  inherited OnMouseDown(e);
end;

procedure TEventHelperControl.OnMouseEnter(e: EventArgs);
begin
  Perform(CM_MOUSEENTER, 0, 0);
  inherited OnMouseEnter(e);
end;

procedure TEventHelperControl.OnMouseLeave(e: EventArgs);
begin
  Perform(CM_MOUSELEAVE, 0, 0);
  inherited OnMouseLeave(e);
end;

procedure TEventHelperControl.OnMouseMove(e: MouseEventArgs);
begin
  MouseMove(GetShiftState(e.Button), e.X, e.Y);
  inherited OnMouseMove(e);
end;

procedure TEventHelperControl.OnMouseUp(e: MouseEventArgs);
begin
  MouseUp(ButtonsToMouseButton(e.Button), GetShiftState(e.Button), e.X, e.Y);
  inherited OnMouseUp(e);
end;

procedure TEventHelperControl.OnResize(e: EventArgs);
begin
  Resize;
  inherited OnResize(e);
end;

procedure TEventHelperControl.Resize;
begin
end;

procedure TEventHelperControl.OnDoubleClick(e: EventArgs);
begin
  DblClick;
  inherited OnDoubleClick(e);
end;

procedure TEventHelperControl.DblClick;
begin
end;

procedure TEventHelperControl.OnDragDrop(drgevent: DragEventArgs);
begin
  DragDrop(drgevent, drgevent.X, drgevent.Y);
  inherited OnDragDrop(drgevent);
end;

procedure TEventHelperControl.OnDragOver(drgevent: DragEventArgs);
var
  Allowed: Boolean;
begin
  Allowed := False;
  DragOver(drgevent, drgevent.X, drgevent.Y, dsDragMove, Allowed);
  if Allowed then
    drgevent.Effect := DragDropEffects.All
  else
    drgevent.Effect := DragDropEffects.None;
  inherited OnDragOver(drgevent);
end;

procedure TEventHelperControl.OnDragEnter(drgevent: DragEventArgs);
var
  Allowed: Boolean;
begin
  Allowed := False;
  DragOver(drgevent, drgevent.X, drgevent.Y, dsDragEnter, Allowed);
  if Allowed then
    drgevent.Effect := DragDropEffects.All
  else
    drgevent.Effect := DragDropEffects.None;
  inherited OnDragEnter(drgevent);
end;

procedure TEventHelperControl.OnDragLeave(e: EventArgs);
begin
  inherited OnDragLeave(e);
end;

procedure TEventHelperControl.DragDrop(Source: TObject; X, Y: Integer);
begin
end;

procedure TEventHelperControl.DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
end;

function TEventHelperControl.Perform(Msg: Cardinal; WParam, LParam: Integer): Integer;
var
  Message: TMessage;
begin
  Message := TMessage.Create(Msg, WParam, LParam);
  WndProc(Message);
  Result := Message.Result;
end;

procedure TEventHelperControl.WndProc(var Message: TMessage);
begin
  Dispatch(Message);
end;

{ TWinControl }

class constructor TWinControl.Create;
begin
  ControlToolTip := ToolTip.Create;
end;

constructor TWinControl.Create;
begin
  Create(nil);
end;

constructor TWinControl.Create(AOwner: TComponent);
begin
  inherited Create;
  FOwner := AOwner;
end;

procedure TWinControl.Click;
begin
  if Assigned(FOnClick) then
    FOnClick(Self);
end;

procedure TWinControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(FOnMouseDown) then
    FOnMouseDown(Self, Button, Shift, X, Y);
end;

procedure TWinControl.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(FOnMouseMove) then
    FOnMouseMove(Self, Shift, X, Y);
end;

procedure TWinControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(FOnMouseUp) then
    FOnMouseUp(Self, Button, Shift, X, Y);
end;

procedure TWinControl.Resize;
begin
  if Assigned(FOnResize) then
    FOnResize(Self);
end;

procedure TWinControl.DragDrop(Source: TObject; X, Y: Integer);
begin
  if Assigned(FOnDragDrop) then
    FOnDragDrop(Self, Source, X, Y);
end;

procedure TWinControl.DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
  if Assigned(FOnDragOver) then
    FOnDragOver(Self, Source, X, Y, State, Accept);
end;

procedure TWinControl.SetAlign(const Value: TAlign);
begin
  case Value of
    alTop:
      Dock := DockStyle.Top;
    alBottom:
      Dock := DockStyle.Bottom;
    alLeft:
      Dock := DockStyle.Left;
    alRight:
      Dock := DockStyle.Right;
    alClient:
      Dock := DockStyle.Fill;
  else
    Dock := DockStyle.None;
  end;
end;

function TWinControl.GetAlign: TAlign;
begin
  case Dock of
    DockStyle.None:
      Result := alNone;
    DockStyle.Top:
      Result := alTop;
    DockStyle.Bottom:
      Result := alBottom;
    DockStyle.Left:
      Result := alLeft;
    DockStyle.Right:
      Result := alRight;
    DockStyle.Fill:
      Result := alClient;
  else
    Result := alCustom;
  end;
end;

procedure TWinControl.SetPopupMenu(const Value: TPopupMenu);
begin
  if Value <> FPopupMenu then
  begin
    if Assigned(FPopupMenu) then
      FPopupMenu.RemoveFreeNotification(Self);
    ContextMenu := Value;
    if Assigned(FPopupMenu) then
      FPopupMenu.FreeNotification(Self);
  end;
end;

procedure TWinControl.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if AComponent = FPopupMenu then
      PopupMenu := nil;
  end;
end;

procedure TWinControl.SetShowHint(const Value: Boolean);
begin
  if Value <> FShowHint then
  begin
    if FShowHint then
      ControlToolTip.SetToolTip(Self, nil);
    ControlToolTip.Active := True;
    FShowHint := Value;
    if FShowHint then
      ControlToolTip.SetToolTip(Self, Hint);
  end;
end;

procedure TWinControl.SetHint(const Value: string);
begin
  if Value <> FHint then
  begin
    FHint := Value;
    if ShowHint then
    begin
      ControlToolTip.SetToolTip(Self, FHint);
      ControlToolTip.Active := True;
    end;
  end;
end;

procedure TWinControl.DblClick;
begin
  if Assigned(FOnDblClick) then
    FOnDblClick(Self);
end;

procedure TWinControl.SetControlStyle(const Value: TControlStyle);
begin
  if Value <> FControlStyle then
  begin
    FControlStyle := Value;
    SetStyle(ControlStyles.Opaque, csOpaque in FControlStyle);
    SetStyle(ControlStyles.FixedWidth, csFixedWidth in FControlStyle);
    SetStyle(ControlStyles.FixedHeight, csFixedHeight in FControlStyle);
    SetStyle(ControlStyles.ContainerControl, csAcceptsControls in FControlStyle);
    SetStyle(ControlStyles.StandardDoubleClick, csDoubleClicks in FControlStyle);
    SetStyle(ControlStyles.StandardClick, csClickEvents in FControlStyle);
  end;
end;

function TWinControl.ClientToScreen(const Pt: TPoint): TPoint;
var
  P: System.Windows.Forms.Control;
begin
  Result := Pt;
  P := Parent;
  while P <> nil do
  begin
    Inc(Result.X, P.Left);
    Inc(Result.Y, P.Top);
    P := P.Parent;
  end;
end;

function TWinControl.ScreenToClient(const Pt: TPoint): TPoint;
var
  P: System.Windows.Forms.Control;
begin
  Result := Pt;
  P := Parent;
  while P <> nil do
  begin
    Dec(Result.X, P.Left);
    Dec(Result.Y, P.Top);
    P := P.Parent;
  end;
end;

function TWinControl.GetClientHeight: Integer;
begin
  Result := Height;
end;

function TWinControl.GetClientWidth: Integer;
begin
  Result := Width;
end;

procedure TWinControl.SetClientHeight(const Value: Integer);
begin
  Height := Value;
end;

procedure TWinControl.SetClientWidth(const Value: Integer);
begin
  Width := Value;
end;

function TWinControl.GetClientRect: TRect;
begin
  Result := Rect(0, 0, ClientWidth, ClientHeight);
end;

function TWinControl.GetCaption: string;
begin
  Result := Text;
end;

procedure TWinControl.SetCaption(const Value: string);
begin
  Text := Value;
end;

{ TCustomControl }

procedure TCustomControl.OnPaint(e: PaintEventArgs);
begin
  Canvas.Handle := e.Graphics;
  try
    Paint;
  finally
    Canvas.Handle := nil;
  end;
end;

procedure TCustomControl.Paint;
begin
end;

constructor TCustomControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control := Self;
end;

{ TControlCanvas }

procedure TControlCanvas.CreateHandle;
begin
  Handle := Control.CreateGraphics;
end;

procedure TControlCanvas.SetControl(const Value: TWinControl);
begin
  Handle := nil;
  FControl := Value;
  if Value <> nil then
    AssignedObject := Value.Handle;
end;

{ TGraphicControl }

procedure TGraphicControl.OnInvalidated(e: InvalidateEventArgs);
begin
  inherited OnInvalidated(e);
  if Parent <> nil then
  begin
    // Optimization with e.InvalidRect does not work here because the rectangle
    // is limited to this control and does not apply to the parent control which
    // seems to do not get any Paint event for the invalidated area at all.
    // (WinForms Bug?)
    Parent.Invalidate;
  end;
end;

end.