unit APIControl;

interface

uses
  Windows,
  Messages,
  UtilFunc,
  UTilClass;

type

TAPICreateParams = record
  Caption: string;
  Style: Longint;
  ExStyle: Longint;
  X, Y: Integer;
  Width, Height: Integer;
  WinClassName: array[0..63] of Char;
end;

//----------- TSelfSubClass -----------------------------------------
TSelfSubClass = class(TSubClass)
private
  FHandle: HWND;
  FID: HMenu;
protected
  procedure APICreateParams(var Params: TAPICreateParams); virtual; abstract;
  procedure Initialize; virtual; abstract;
public
  constructor Create(hParent: HWND); override;
  destructor Destroy; override;
  procedure DestroyObject;
  property Handle: HWND read FHandle;
  property ID: HMenu read FID;
end;

//----------- TAPIContol -------------------------------------------
TAPIControl = class(TSelfSubClass)
private
  function GetCaption: string;
  procedure SetCaption(value: string);
  function GetDimension: TRect;
  procedure SetDimension(value: TRect);
  function GetXPos: integer;
  procedure SetXPos(value: integer);
  function GetYPos: integer;
  procedure SetYPos(value: integer);
  function GetWidth: integer;
  procedure SetWidth(value: integer);
  function GetHeight: integer;
  procedure SetHeight(value: integer);
  function GetEnable: Boolean;
  procedure SetEnable(value:Boolean);
  function GetVisible: Boolean;
  procedure SetVisible(value: Boolean);
protected
  procedure Initialize; override;
public
  destructor Destroy; override;
  property Caption: string read GetCaption write SetCaption;
  property Dimension : TRect read GetDimension write SetDimension;
  property XPos: integer read GetXPos write SetXPos;
  property YPos: integer read GetYPos write SetYPos;
  property Width: integer read GetWidth write SetWidth;
  property Height: integer read GetHeight write SetHeight;
  property Enable: Boolean read GetEnable write SetEnable;
  property Visible: Boolean read GetVisible write SetVisible;
end;

//---------- TAPIButton ----------------------------------------------
TAPIButton = class(TAPIControl)
private
  FOnClick: TNotifyMessage;
protected
  procedure APICreateParams(var Params: TAPICreateParams); override;
public
  procedure DefaultHandler(var Message); override;
  property OnClick: TNotifyMessage read FOnClick write FOnClick;
end;

//
//---------- Create Functions ---------------------------------------
//
function CreateButton(hParent: HWND; x,y,cx,cy: integer;sCaption: string;
                      sOnClick:TNotifyMessage): TAPIButton;


implementation


var
  ID_CONT: integer = 400;

//----------- TSelfSubClass -----------------------------------------
function SelfSubClassProc(hWnd: HWND; Msg: UINT;
                       wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  PascalObject: TSelfSubClass;
  OriginalProc: TFNWndProc;
  SBMsg: TMessage;
begin
  OriginalProc := TFNWndProc(GetProp(hWnd,'WNDPROC'));
  result := CallWindowProc(OriginalProc,hWnd,Msg,wParam,lParam);
  PascalObject := TSelfSubClass(GetProp(hWnd,'OBJECT'));

  case Msg of

    WM_DESTROY: if Assigned(PascalObject) then PascalObject.Free;

  else
    if Assigned(PascalObject) then begin
      SBMsg.Msg := Msg;
      SBMsg.WParam := wParam;
      SBMsg.LParam := lParam;
      SBMsg.Result := 0;
      PascalObject.Dispatch(SBMsg);
      if SBMsg.Result <> 0 then result := SBMsg.Result;
    end;
  end; // case

end;

constructor TSelfSubClass.Create(hParent: HWnd);
var
  Params: TAPICreateParams;
  DefWndProc: TFNWndProc;
begin
  inherited Create(hParent);
  APICreateParams(Params);
  with Params do begin
    FHandle := CreateWindowEx(ExStyle,WinClassName,PChar(Caption),
                Style,X, Y, Width, Height,
                hParent,
                ID_CONT,
                hInstance,
                nil);
  end;

  if IsWindow(FHandle) then begin
    SetProp(FHandle,'OBJECT',Integer(self));
    DefWndProc := TFNWndProc(SetWindowLong(FHandle,
                            GWL_WNDPROC,Integer(@SelfSubClassProc)));
    SetProp(FHandle,'WNDPROC',integer(DefWndProc));
  end;

  FID := ID_CONT; Inc(ID_CONT);

  Initialize;
end;

destructor TSelfSubClass.Destroy;
begin
  SetWindowLong(FHandle,GWL_WNDPROC,GetProp(FHandle,'WNDPROC'));
  RemoveProp(FHandle,'OBJECT');
  RemoveProp(FHandle,'WNDPROC');
  inherited Destroy;
end;

procedure TSelfSubClass.DestroyObject;
begin
  DestroyWindow(FHandle);
end;

//----------- TAPIControl -----------------------------------------
destructor TAPIControl.Destroy;
begin
                        
  inherited Destroy;
end;

procedure TAPIControl.Initialize;
begin
  Dispatcher.TrapMessage(WM_COMMAND,self);
end;

function TAPIControl.GetCaption: string;
var
  s: string;
begin
  SetLength(s,50);
  SetString(result,PChar(s),GetWindowText(FHandle,PChar(s),50));
end;

procedure TAPIControl.SetCaption(value: string);
begin
  SetWindowText(FHandle, PChar(Value));
end;

function TAPIControl.GetDimension: TRect;
begin
  result := SetDim(XPos,YPos,Width,Height);
end;

procedure TAPIControl.SetDimension(value: TRect);
begin
  MoveWindow(FHandle,value.left, value.top,
                   value.right, value.bottom, true);
end;

function TAPIControl.GetXPos: integer;
var
  r: TRect;
  p: TPoint;
begin
  GetWindowRect(FHandle,r);
  p.x := r.Left; p.y := r.Top;
  ScreenToClient(Parent,p);
  result := p.x;
end;

procedure TAPIControl.SetXPos(value: integer);
begin
  ChangeWindowPos(FHandle,value,YPos);
end;

function TAPIControl.GetYPos: integer;
var
  r: TRect;
  p: TPoint;
begin
  GetWindowRect(FHandle,r);
  p.x := r.Left; p.y := r.Top;
  ScreenToClient(Parent,p);
  result := p.y;
end;

procedure TAPIControl.SetYPos(value: integer);
begin
  ChangeWindowPos(FHandle,XPos,value);
end;

function TAPIControl.GetWidth: integer;
var
  r: TRect;
begin
  GetWindowRect(FHandle,r);
  result := r.Right-r.Left;
end;

procedure TAPIControl.SetWidth(value: integer);
begin
  ChangeWindowSize(FHandle,value,Height);
end;

function TAPIControl.GetHeight: integer;
var
  r: TRect;
begin
  GetWindowRect(FHandle,r);
  result := r.Bottom-r.Top;
end;

procedure TAPIControl.SetHeight(value: integer);
begin
  ChangeWindowSize(FHandle,Width,value);
end;

function TAPIControl.GetEnable: Boolean;
begin
  result := Boolean(IsWindowEnabled(FHandle));
end;

procedure TAPIControl.SetEnable(value: Boolean);
begin
  EnableWindow(FHandle,value);
end;

function TAPIControl.GetVisible: Boolean;
begin
  result := Boolean(IsWindowVisible(FHandle));
end;

procedure TAPIControl.SetVisible(value:Boolean);
begin
  if value then
    ShowWindow(FHandle,SW_SHOWNORMAL)
  else
    ShowWindow(FHandle,SW_HIDE);
end;

//--------------- TAPIButton ----------------------------------------------
procedure TAPIButton.APICreateParams(var Params: TAPICreateParams);
begin
  with Params do begin
    Caption := 'APIButton';
    Style := WS_CHILD or WS_VISIBLE or WS_TABSTOP or
             WS_CLIPSIBLINGS or BS_PUSHBUTTON;
    ExStyle := 0;
    X := 0;
    Y := 0;
    Width := 0;
    Height := 0;
    WinClassName := 'BUTTON';
  end;
end;

procedure TAPIButton.DefaultHandler(var Message);
var
  AMsg:TMessage;
begin
  AMsg := TMessage(message);
  case AMsg.Msg of
    WM_COMMAND:
      if (AMsg.LParam = LongInt(FHandle)) and (AMsg.WParamHi = BN_CLICKED) then
         if Assigned(FOnClick) then begin
           AMsg.Msg := UINT(self); // Sender
           OnClick(AMsg);
         end;
  end; // case
end;

//
//---------- Create Functions ---------------------------------------
//
function CreateButton(hParent: HWND; x,y,cx,cy: integer;sCaption: string;
                      sOnClick:TNotifyMessage): TAPIButton;
begin
  result := TAPIButton.Create(hParent);
  with result do begin
    Dimension := SetDim(x,y,cx,cy);
    Caption := sCaption;
    OnClick := sOnClick;
  end;
end;

end.