{ *********************************************************************** }
{                                                                         }
{ Delphi Visual Component Library                                         }
{                                                                         }
{ Copyright (c) 2003-2004 Borland Software Corporation                    }
{                                                                         }
{ *********************************************************************** }

unit Borland.Vcl.NetControlContainer platform experimental;

{$T-,H+,X+}

interface

uses
  Borland.Vcl.Windows, 
  Borland.Vcl.Messages, 
  Borland.Vcl.Classes, 
  Borland.Vcl.Controls, 
  System.Windows.Forms;

{ TNetControlContainer hosts a System.Windows.Forms.Control.
  This allows the WinForms control to appear as the child of a VCL windowdowed
  control. If you change the size, position, visibility, or enabled state of
  either the contained control or the TNetControlContainer, they are both
  updated to stay in sync (for example, if you move the contained control, it
  is the container that actually moves, not the contained control. There is no
  attempt to synchronize any other properties (such as font, color, etc). To
  change these, use the properties of the contained control. You can access the
  contained control using the Control property. }
  
type
  TMessageEvent = procedure (var Msg: TMessage; var Handled: Boolean) of object;

  TWndProcHook = class(TObject)
  private
    FHandle: HWND;
    FOldWndProc: IntPtr;
    FNewWndProc: TFNWndProc;
    FOnMessage : TMessageEvent;
    procedure DoMessage(var aMsg: TMessage; var aHandled: Boolean);
  protected
    procedure WndProc(var aMsg: TMessage);
  public
    constructor Create;
    destructor  Destroy; override;
    procedure Hook(aHandle: HWND);
    procedure Unhook;
    property OnMessage: TMessageEvent read FOnMessage write FOnMessage;
  end;
  
  TNetControlContainer = class(TWinControl)
  private
    FControl: System.Windows.Forms.Control;
    FWndProcArr: array of TWndProcHook;
    FSynchronizingSize: Boolean;
    FSynchronizingEnabled: Boolean;
    FSynchronizingVisible: Boolean;
    procedure UpdateControlParent;
  protected
    procedure MessageHandler(var Msg: TMessage; var Handled: Boolean);
    function GetControl: System.Windows.Forms.Control; virtual;
    procedure SetControl(AControl: System.Windows.Forms.Control); virtual;
    procedure Init; virtual;
    procedure HookWndProc(AControl: System.Windows.Forms.Control);
    procedure UnhookWndProc;
    procedure HookNetEvents(AControl: System.Windows.Forms.Control); virtual;
    procedure UnhookNetEvents(AControl: System.Windows.Forms.Control); virtual;
    procedure Resize; override;
    procedure ChangeScale(M, D: Integer); override;
    procedure CreateWnd; override;
    
    function GetControlText: string;
    procedure SetControlText (const Value: string);
    
    procedure WFCResize(Sender: System.Object; AArgs: System.EventArgs);
    procedure WFCEnabledChanged(Sender: System.Object; AArgs: System.EventArgs);
    procedure WFCVisibleChanged(Sender: System.Object; AArgs: System.EventArgs);
  public
    // constructor & destructor
    constructor Create(AOwner: TComponent); reintroduce; overload;
    constructor Create(AOwner: TComponent; AParent: TWinControl); reintroduce; overload;
    constructor Create(AOwnerAndParent: TWinControl); reintroduce; overload;
    destructor Destroy; override;
    
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    
    property Control: System.Windows.Forms.Control read GetControl write SetControl;
  published
    property ControlText: string read GetControlText write SetControlText;
    
    property Align;
    property Anchors;
    property DragKind;
    property DragCursor;
    property DragMode;
    property PopupMenu;
    property Visible;
    
    property OnAlignInsertBefore;
    property OnAlignPosition;
    property OnDockDrop;
    property OnDockOver;
    property OnEnter;
    property OnExit;
    property OnGetSiteInfo;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnUnDock;

    property OnCanResize;
    property OnClick;
    property OnConstrainedResize;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;

    property BevelEdges;
    property BevelInner;
    property BevelOuter;
    property BevelKind;
    property BevelWidth;
    property BorderWidth;
  end;

implementation

uses
  Borland.Vcl.SysUtils,
  Borland.Vcl.WinUtils,
  Borland.Vcl.Forms,
  System.Reflection,
  System.Runtime.Remoting;
  
{ TWndProcHook }

constructor TWndProcHook.Create;
begin
  inherited Create;
  FNewWndProc := MakeObjectInstance(Self.WndProc);
end;

destructor TWndProcHook.Destroy;
begin
  Self.Unhook;
  FreeObjectInstance(FNewWndProc);
  inherited Destroy;
end;

procedure TWndProcHook.Hook(aHandle: HWND);
begin
  FHandle := aHandle;
  FOldWndProc := IntPtr(GetWindowLong(FHandle, GWL_WNDPROC));
  SetWindowLong(FHandle, GWL_WNDPROC, Self.FNewWndProc);
end;

procedure TWndProcHook.Unhook;
begin
  if (FHandle <> 0) then
  begin
    SetWindowLong(FHandle, GWL_WNDPROC, Longint(FOldWndProc));
    FHandle := 0;
  end;  
end;

procedure TWndProcHook.DoMessage(var aMsg: TMessage; var aHandled: Boolean);
begin
  if Assigned(FOnMessage) then FOnMessage(aMsg, aHandled);
end;

procedure TWndProcHook.WndProc(var aMsg: TMessage);
var
  aHandled: Boolean;
begin
  aHandled := False;
  Self.DoMessage(aMsg, aHandled);
  if not aHandled then
    aMsg.Result := CallWindowProc(FOldWndProc, FHandle, aMsg.Msg, aMsg.WPARAM, aMsg.LPARAM);
end;
  
{ TNetControlContainer }

constructor TNetControlContainer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SetLength(FWndProcArr, 0);
  ControlStyle := ControlStyle + [csAcceptsControls];
  Self.Init;
end;

constructor TNetControlContainer.Create(AOwner: TComponent; AParent: TWinControl);
begin
  Self.Create(AOwner);
  Self.Parent := AParent;
end;

constructor TNetControlContainer.Create(AOwnerAndParent: TWinControl);
begin
  Self.Create(TComponent(AOwnerAndParent)); // <- typecast to prevent recursion
  Self.Parent := AOwnerAndParent;
end;

destructor TNetControlContainer.Destroy;
begin
  Self.Control := nil;
  inherited;
end;

procedure TNetControlContainer.Init;
begin
  // to override
end;

procedure TNetControlContainer.HookWndProc(AControl: System.Windows.Forms.Control);
var
  wph: TWndProcHook;
  len, i: Integer;
begin
  wph := TWndProcHook.Create;
  wph.OnMessage := Self.MessageHandler;
  wph.Hook(HWND(AControl.Handle));
  len := Length(FWndProcArr);
  SetLength(FWndProcArr, len + 1);
  FWndProcArr[len] := wph;
  if AControl.HasChildren then
    for i := 0 to AControl.Controls.Count - 1 do
      Self.HookWndProc(AControl.Controls[i]);
end;

procedure TNetControlContainer.UnhookWndProc;
var
  i: integer;
  wph: TWndProcHook;
begin
  for i := Length(FWndProcArr)-1 downto 0 do
  begin
    wph := FWndProcArr[i];
    wph.Unhook;
    wph.Free;
  end;
  SetLength(FWndProcArr, 0);
end;

procedure TNetControlContainer.HookNetEvents(AControl: System.Windows.Forms.Control);
begin
  AControl.add_LocationChanged(@WFCResize);
  AControl.add_SizeChanged(@WFCResize);
  AControl.add_EnabledChanged(@WFCEnabledChanged);
  AControl.add_VisibleChanged(@WFCVisibleChanged);
end;

procedure TNetControlContainer.UnhookNetEvents(AControl: System.Windows.Forms.Control);
begin
  AControl.remove_LocationChanged(@WFCResize);
  AControl.remove_SizeChanged(@WFCResize);
  AControl.remove_EnabledChanged(@WFCEnabledChanged);
  AControl.remove_VisibleChanged(@WFCVisibleChanged);
end;

procedure TNetControlContainer.UpdateControlParent;
begin
  if not FControl.IsHandleCreated then
    FControl.CreateControl;
  Borland.Vcl.Windows.SetParent(HWND(FControl.Handle), Handle);
  FControl.Invalidate;
end;

procedure TNetControlContainer.MessageHandler(var Msg: TMessage; var Handled: Boolean);
begin
  // handle control messages
  if csDestroying in ComponentState then
    Exit;
    
  if csDesigning in ComponentState then
  begin
    case Msg.Msg of
      WM_LBUTTONUP    : Handled := True;
      WM_LBUTTONDOWN  : Handled := True; 
      WM_LBUTTONDBLCLK: Handled := True;
      WM_RBUTTONDOWN  : Handled := True;
      WM_RBUTTONUP    : Handled := True;
      WM_KEYUP        : Handled := True;
      WM_KEYDOWN      : Handled := True;
    end;  
  end;  
  Self.Perform(Msg.Msg, Msg.WParam, Msg.LParam);
end;

function TNetControlContainer.GetControl: System.Windows.Forms.Control;
begin
  Result := FControl;
end;

procedure TNetControlContainer.SetControl(AControl: System.Windows.Forms.Control);
begin
  if FControl = AControl then Exit;
  if AControl <> nil then
  begin
    FControl := AControl;
    
    // set bounds very first time
    FSynchronizingSize := True;
    if (AControl.Width > 0) and (AControl.Height > 0) then
      Self.SetBounds(Self.Left, Self.Top, AControl.Width, AControl.Height);
    AControl.SetBounds(0, 0, AControl.Width, AControl.Height);
    FSynchronizingSize := False;
    SendMessage(Self.Handle, WM_SIZE, 0, 0); // force paint
    
    Enabled := AControl.Enabled;
    Visible := AControl.Visible;
    Self.HookWndProc(AControl);
    Self.HookNetEvents(AControl);
    UpdateControlParent;
  end else
  begin
    Self.UnhookNetEvents(FControl);
    Self.UnhookWndProc;
    FControl := AControl;
  end;
end;

procedure TNetControlContainer.CreateWnd;
begin
  inherited;
  if Assigned(FControl) then
    UpdateControlParent;
end;

procedure TNetControlContainer.ChangeScale(M, D: Integer);
begin
  if FControl = nil then
    inherited
  else if M <> D then
     FControl.Scale(M/D);
   // do we need to call the inherited? or does the resize come back from FControl?
end;

procedure TNetControlContainer.CMEnabledChanged(var Message: TMessage);
begin
  if (FControl <> nil) then
      if (not FSynchronizingEnabled) then
      begin
        FSynchronizingEnabled := True;
        try
          FControl.Enabled := Enabled;
        finally
          FSynchronizingEnabled := False;
        end;
      end;
  inherited;
end;

procedure TNetControlContainer.WFCEnabledChanged(Sender: System.Object; AArgs: System.EventArgs);
begin
  if (FControl <> nil) then
      if not FSynchronizingEnabled then
      begin
        FSynchronizingEnabled := True;
        try
          Enabled := FControl.Enabled;
        finally
          FSynchronizingEnabled := False;
        end;
      end;
end;

procedure TNetControlContainer.CMVisibleChanged(var Message: TMessage);
begin
  if (FControl <> nil) then
      if (not FSynchronizingVisible) then
      begin
        FSynchronizingVisible := True;
        try
          FControl.Visible := Visible;
        finally
          FSynchronizingVisible := False;
        end;
      end;
  inherited;
end;

procedure TNetControlContainer.WFCVisibleChanged(Sender: System.Object; AArgs: System.EventArgs);
begin
  if (FControl <> nil) then
      if not FSynchronizingVisible then
      begin
        FSynchronizingVisible := True;
        try
          Visible := FControl.Visible;
        finally
          FSynchronizingVisible := False;
        end;
      end;
end;

procedure TNetControlContainer.Resize;
begin
  inherited;
  if (FControl <> nil) then
      if not FSynchronizingSize then
      begin
        FSynchronizingSize := True;
        try
          FControl.SetBounds(0, 0, Width, Height);
        finally
          FSynchronizingSize := False;
        end;
      end;
end;

function TNetControlContainer.GetControlText: string;
begin
  Result := '';
  if FControl <> nil then
    Result := FControl.Text;
end;

procedure TNetControlContainer.SetControlText(const Value: string);
begin
  if FControl <> nil then
    FControl.Text := Value;
end;

procedure TNetControlContainer.WFCResize(Sender: System.Object; AArgs: System.EventArgs);
begin
  if (FControl <> nil) then
      if not FSynchronizingSize then
      begin
        FSynchronizingSize := True;
        try
          SetBounds(Left + FControl.Left, Top + FControl.Top, FControl.Width, FControl.Height);
          FControl.SetBounds(0, 0, Width, Height);
        finally
          FSynchronizingSize := False;
        end;
      end;
end;

procedure TNetControlContainer.WMPaint(var Message: TWMPaint);
var
  Msg: System.Windows.Forms.Message;
begin
  if (Message.DC <> 0) and (FControl <> nil) then
  begin
    Msg := System.Windows.Forms.Message.&Create(FControl.Handle,
      WM_PRINT, IntPtr(Integer(Message.DC)),
      IntPtr(Integer(PRF_NONCLIENT or PRF_CLIENT or PRF_CHILDREN)));
    FControl.WindowTarget.OnMessage(Msg);
  end
  else
    inherited;
end;

end.

