unit APIWindow;

interface

uses
  Windows,
  Messages,
  UtilFunc,
  UtilClass;

type
TCreateParamsEx = record
  dwExStyle: DWORD;
  lpClassName: PChar;
  lpWindowName: PChar;
  dwStyle: DWORD;
  X, Y, nWidth, nHeight: Integer;
  hWndParent: HWND;
  hMenu: HMENU;
  hInstance: HINST;
  lpParam: Pointer;
end;

//-------------- TAPIWindow -----------------------------------
TOnClassParams = procedure (var WC:TWndClass);
TOnWindowParams = procedure (var CP:TCreateParamsEx);

TAPIWindow = class(TObject)
private
  FHandle: HWND;
  FParent: HWND;
  FClassName: string;
  FColor: COLORREF;
  FOnClassParams: TOnClassParams;
  FOnWindowparams: TOnWindowParams;
  FOnCreate: TNotifyMessage;
  FOnDestroy: TNotifyMessage;
  FOnCommand: TNotifyMessage;
  procedure SetColor(value:COLORREF);
protected
  procedure APIClassParams(var WC:TWndClass); virtual;
  procedure APICreateParams(var CP:TCreateParamsEx); virtual;
public
  constructor Create(hParent:HWND;ClassName:string);virtual;
  destructor Destroy; override;
  procedure DefaultHandler(var Message);override;
  procedure DoCreate;virtual;
  property Handle: HWND read FHandle;
  property Parent: HWND read FParent;
  property Color: COLORREF read FColor write SetColor;
  property OnClassParams: TOnClassParams read FOnClassParams
                                         write FOnClassParams;
  property OnWindowParams: TOnWindowParams read FOnWindowParams
                                           write FOnWindowparams;
  property OnCreate: TNotifyMessage read FOnCreate write FOnCreate;
  property OnDestroy: TNotifyMessage read FOnDestroy write FOnDestroy;
  property OnCommand: TNotifyMessage read FOnCommand write FOnCommand;
end;

//-------------- TAPIWindow2 ----------------------------------
TAPIWindow2 = class(TAPIWindow)
private
  FTrapMessage: TIntegerList;
  FTrapHandler: TIntegerList;
  FNumHandler: integer;
public
  constructor Create(hParent:HWND;ClassName:string);override;
  destructor Destroy; override;
  procedure DefaultHandler(var Message); override;
  procedure Trap(Msg: UINT; Hndlr: TNotifyMessage);
  property NumHandler: integer read FNumHandler;
end;

//-------------- TAPIWindow3 ----------------------------------
TAPIWindow3 = class(TAPIWindow2)
private
  FCursor: HCURSOR;
  function GetWidth: integer;
  procedure SetWidth(value: integer);
  function GetHeight: integer;
  procedure SetHeight(value: integer);
  function GetVisible: Boolean;
  procedure SetVisible(value: Boolean);
  function GetEnable: Boolean;
  procedure SetEnable(value:Boolean);
public
  procedure DefaultHandler(var Message);override;
  property Width: integer read GetWidth write SetWidth;
  property Height: integer read GetHeight write SetHeight;
  property Visible: Boolean  read GetVisible write SetVisible;
  property Enable: Boolean read GetEnable write SetEnable;
  property Cursor: HCURSOR read FCursor write FCursor;
end;

//-------------- TSDIMainWindow ----------------------------------
TMaxMinRestore = (Max,Min,Restore);

TSDIMainWindow = class(TAPIWindow3)
private
  function GetXPos: integer;
  procedure SetXPos(value: integer);
  function GetYPos: integer;
  procedure SetYPos(value: integer);
  function GetTitle: string;
  procedure SetTitle(s: string);
  function GetIcon: HICON;
  procedure SetIcon(value: HICON);
  function GetClientWidth: integer;
  procedure SetClientWidth(value: integer);
  function GetClientHeight: integer;
  procedure SetClientHeight(value: integer);
  function GetState: TMaxMinRestore;
  procedure SetState(value: TMaxMinRestore);
public
  constructor Create(hParent:HWND;ClassName:string);override;
  procedure Center;
  procedure Close;
  property XPos: integer read GetXPos write SetXPos;
  property YPos: integer read GetYPos write SetYPos;
  property Title: string read GetTitle write SetTitle;
  property Icon: HICON read GetIcon write SetIcon;
  property ClientWidth: integer read GetClientWidth write SetClientWidth;
  property ClientHeight: integer read GetClientHeight write SetClientHeight;
  property State: TMaxMinRestore read GetState write SetState;
end;

//---------- TAPIPanel ----------------------------------------------
TEdgeStyle = (esNone,esRaised,esSunken);

TAPIPanel = class(TAPIWindow3)
private
  FOuterEdge: TEdgeStyle;
  FInnerEdge: TEdgeStyle;
  FEdgeWidth: integer;
  function GetDimension: TRect;
  procedure SetDimension(value: TRect);
  function GetXPos: integer;
  procedure SetXPos(value: integer);
  function GetYPos: integer;
  procedure SetYPos(value: integer);
  procedure SetOuterEdge(value: TEdgeStyle);
  procedure SetInnerEdge(value: TEdgeStyle);
  procedure SetEdgeWidth(value: integer);
protected
  procedure APIClassParams(var WC:TWndClass); override;
  procedure APICreateParams(var CP:TCreateParamsEx); override;
public
  procedure DefaultHandler(var Message); override;
  property Dimension : TRect read GetDimension write SetDimension;
  property XPos: integer read GetXPos write SetXPos;
  property YPos: integer read GetYPos write SetYPos;
  property OuterEdge: TEdgeStyle read FOuterEdge write SetOuterEdge;
  property InnerEdge: TEdgeStyle read FInnerEdge write SetInnerEdge;
  property EdgeWidth: integer read FEdgeWidth write SetEdgeWidth;
end;

function CreatePanel(hParent:HWND;x,y,cx,cy:integer):TAPIPanel;

implementation

{---------------------------------------------------------------------
             Custom Window Procedure
----------------------------------------------------------------------}
function CustomWndProc(hWindow: HWND; Msg: UINT; WParam: WPARAM;
                            LParam: LPARAM): LRESULT; stdcall;
var
  WPMsg: TMessage;
  Wnd: TAPIWindow;
  pCS: PCreateStruct;
begin

   Result := 0;

   if Msg = WM_NCCREATE then begin
     pCS := Pointer(LParam);
     SetProp(hWindow,'OBJECT',integer(pCS^.lpCreateParams));
     TAPIWindow(pCS^.lpCreateParams).FHandle := hWindow;
   end;

   WPMsg.Msg := Msg;
   WPMsg.WParam := WParam;
   WPMsg.LParam := LParam;
   WPMsg.Result := 0;

   Wnd := TAPIWindow(GetProp(hWindow,'OBJECT'));

   case Msg of

{------------------  WM_DESTROY  --------------------------------}

     WM_DESTROY: begin
       if Assigned(Wnd) then begin
         Wnd.Dispatch(WPMsg);
         Wnd.Free;
       end;
     end;

{---------  他のメッセージをオブジェクトに Dispatch する ----}
   else begin
       if Assigned(Wnd) then Wnd.Dispatch(WPMsg);
       if WPMsg.Result = 0 then
         Result := DefWindowProc( hWindow, Msg, wParam, lParam )
       else Result := WPMsg.Result;
     end;

   end; // case

end;

//-------------------- TAPIWindow ---------------------------
constructor TAPIWindow.Create(hParent:HWND;ClassName:string);
begin
  FParent := hParent;
  FClassName := ClassName;
  FColor := clrBtnFace;
end;

destructor TAPIWindow.Destroy;
begin
  RemoveProp(FHandle,'OBJECT');
  inherited Destroy;
end;

procedure TAPIWindow.APIClassParams(var WC:TWndClass);
begin
  WC.lpszClassName   := PChar(FClassName);
  WC.lpfnWndProc     := @CustomWndProc;
  WC.style           := CS_VREDRAW or CS_HREDRAW;
  WC.hInstance       := hInstance;
  WC.hIcon           := LoadIcon(0,IDI_APPLICATION);
  WC.hCursor         := LoadCursor(0,IDC_ARROW);
  WC.hbrBackground   := ( COLOR_WINDOW+1 );
  WC.lpszMenuName    := nil;
  WC.cbClsExtra      := 0;
  WC.cbWndExtra      := 0;
  If Assigned(FOnClassParams) then FOnClassParams(WC);
end;

procedure TAPIWindow.APICreateParams(var CP:TCreateParamsEx);
begin
  CP.dwExStyle           := 0;
  CP.lpClassName         := PChar(FClassName);
  CP.lpWindowName        := PChar(FClassName);
  CP.dwStyle             := WS_VISIBLE or WS_OVERLAPPEDWINDOW;
  CP.X                   := 200;
  CP.Y                   := 100;
  CP.nWidth              := 300;
  CP.nHeight             := 200;
  CP.hWndParent          := FParent;
  CP.hMenu               := 0;
  CP.hInstance           := hInstance;
  CP.lpParam             := self;
  If Assigned(FOnWindowParams) then FOnWindowParams(CP);
end;

procedure TAPIWindow.DefaultHandler(var Message);
var
  AMsg:TMessage;
begin

  AMsg := TMessage(Message);

  case AMsg.Msg of

    WM_CREATE: if Assigned(FOnCreate) then OnCreate(AMsg);

    WM_DESTROY: if Assigned(FOnDestroy) then OnDestroy(AMsg);

    WM_COMMAND: if Assigned(FOnCommand) then OnCommand(AMsg);

    WM_ERASEBKGND: AMsg.result := EraseBkGnd(FHandle,FColor,AMsg.WParam);
 
  end; // case

  TMessage(Message).result := AMsg.result;

end;

procedure TAPIWindow.DoCreate;
var
  WC: TWndClass;
  CP: TCreateParamsEx;
begin

  APIClassParams(WC);
  RegisterClass(WC);

  APICreateParams(CP);

  CreateWindowEx(CP.dwExStyle,
                 CP.lpClassName,
                 CP.lpWindowName,
                 CP.dwStyle,
                 CP.X,
                 CP.Y,
                 CP.nWidth,
                 CP.nHeight,
                 CP.hWndParent,
                 CP.hMenu,
                 CP.hInstance,
                 CP.lpParam);

  ShowWindow( FHandle, CmdShow );
  UpDateWindow(FHandle);
end;

procedure TAPIWindow.SetColor(value: COLORREF);
begin
  if  FColor = value then Exit;
  FColor := value;
  InvalidateRect(FHandle,nil,true);
end;

//-------------- TAPIWindow2 ----------------------------------
constructor TAPIWindow2.Create(hParent:HWND;ClassName:string);
begin
  inherited Create(hParent,ClassName);
  FTrapMessage := TIntegerList.Create($10,$10);
  FTrapHandler := TIntegerList.Create($10,$10);
end;

destructor TAPIWindow2.Destroy;
begin
  FTrapMessage.Free;
  FTrapHandler.Free;
  inherited Destroy;
end;

procedure TAPIWindow2.DefaultHandler(var Message);
var
  AMsg:TMessage;
  i: integer;
begin

  AMsg := TMessage(Message);

  case AMsg.Msg of

    WM_CREATE:if Assigned(FOnCreate) then OnCreate(AMsg);

    WM_COMMAND:if Assigned(FOnCreate) then OnCommand(AMsg);

    WM_DESTROY:if Assigned(FOnDestroy) then OnDestroy(AMsg);

    WM_ERASEBKGND:AMsg.result := EraseBkGnd(FHandle,FColor,AMsg.WParam);

  else if FNumHandler > 0 then begin
    i := FTrapMessage.Search(integer(AMsg.Msg));
    if i <> -1 then TNotifyMessage(FTrapHandler[i])(AMsg);
    end;

  end; // case

  TMessage(Message).result := AMsg.result;

end;

procedure TAPIWindow2.Trap(Msg: UINT; Hndlr: TNotifyMessage);
begin
  Inc(FNumHandler);
  FTrapMessage[FNumHandler-1] := integer(Msg);
  FTrapHandler[FNumHandler-1] := integer(@Hndlr);
end;

//-------------- TAPIWindow3 ----------------------------------
procedure TAPIWindow3.DefaultHandler(var Message);
var
  AMsg:TMessage;
  i: integer;
begin

  AMsg := TMessage(Message);

  case AMsg.Msg of

    WM_CREATE: if Assigned(FOnCreate) then OnCreate(AMsg);

    WM_DESTROY: if Assigned(FOnDestroy) then OnDestroy(AMsg);

    WM_COMMAND: if Assigned(FOnCommand) then OnCommand(AMsg);

    WM_ERASEBKGND: AMsg.result := EraseBkGnd(FHandle,FColor,AMsg.WParam);

    WM_SETCURSOR : if AMsg.LParamLo = HTCLIENT then begin
        SetCursor(FCursor);
        AMsg.Result := 1;
      end;

  else if FNumHandler > 0 then begin
    i := FTrapMessage.Search(integer(AMsg.Msg));
    if i <> -1 then TNotifyMessage(FTrapHandler[i])(AMsg);
    end;

  end; // case

  TMessage(Message).result := AMsg.result;

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

procedure TAPIWindow3.SetWidth(value: integer);
var
  r: TRect;
begin
  GetWindowRect(FHandle,r);
  ChangeWindowSize(FHandle,value,(r.Bottom-r.Top+1));
end;

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

procedure TAPIWindow3.SetHeight(value: integer);
var
  r: TRect;
begin
  GetWindowRect(FHandle,r);
  ChangeWindowSize(FHandle,(r.Right-r.Left+1),value);
end;

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

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

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

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

//-------------- TSDIMainWindow ----------------------------------
constructor TSDIMainWindow.Create(hParent:HWND;ClassName:string);
begin
  inherited Create(hParent,ClassName);
  FCursor := LoadCursor(0,IDC_ARROW);
end;

procedure TSDIMainWindow.Center;
begin
  CenterWindow(FHandle);
end;

procedure TSDIMainWindow.Close;
begin
  DestroyWindow(FHandle);
end;

function TSDIMainWindow.GetXPos: integer;
var
  r: TRect;
begin
  GetWindowRect(FHandle,r);
  result := r.Left;
end;

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

function TSDIMainWindow.GetYPos: integer;
var
  r: TRect;
begin
  GetWindowRect(FHandle,r);
  result := r.Top;
end;

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

function TSDIMainWindow.GetTitle: string;
var
  s: string;
  len: integer;
begin
  SetLength(s,100);
  len := GetWindowText(FHandle,PChar(s),100);
  SetLength(s,len);
  result := s;
end;

procedure TSDIMainWindow.SetTitle(s: string);
begin
  SetWindowText(FHandle, PChar(s));
end;

function TSDIMainWindow.GetIcon: HICON;
begin
  result := GetClassLong(FHandle,GCL_HICON);
end;

procedure TSDIMainWindow.SetIcon(value: HICON);
begin
  SetClassLong(FHandle,GCL_HICON,value);
end;

function TSDIMainWindow.GetClientWidth: integer;
var
  r: TRect;
begin
  GetClientRect(FHandle,r);
  result := r.Right+1;
end;

procedure TSDIMainWindow.SetClientWidth(value: integer);
begin
  ChangeWindowSize(FHandle,(value+Width-ClientWidth-1),Height);
end;

function TSDIMainWindow.GetClientHeight: integer;
var
  r: TRect;
begin
  GetClientRect(FHandle,r);
  result := r.Bottom+1;
end;

procedure TSDIMainWindow.SetClientHeight(value: integer);
begin
  ChangeWindowSize(FHandle,Width,(value+Height-ClientHeight));
end;

procedure TSDIMainWindow.SetState(value: TMaxMinRestore);
begin
  case value of
    Max: ShowWindow(FHandle,SW_SHOWMAXIMIZED);
    Min: ShowWindow(FHandle,SW_SHOWMINIMIZED);
    Restore: ShowWindow(FHandle,SW_RESTORE);
  end;
end;

function TSDIMainWindow.GetState: TMaxMinRestore;
begin
  if IsZoomed(FHandle) then
    result := Max
  else
    if IsIconic(FHandle) then
      result := Min
    else
      result := Restore;
end;

//--------------- TAPIPanel ----------------------------------------------
function PanelWndProc(hWindow: HWND; Msg: UINT; WParam: WPARAM;
                            LParam: LPARAM): LRESULT; stdcall;
var
  WPMsg: TMessage;
  Wnd: TAPIPanel;
  pCS: PCreateStruct;
begin
   Result := 0;
   
   if Msg = WM_CREATE then begin
     pCS := Pointer(LParam);
     SetProp(hWindow,'OBJECT',integer(pCS^.lpCreateParams));
     TAPIPanel(pCS^.lpCreateParams).FHandle := hWindow;
   end;

   Wnd := TAPIPanel(GetProp(hWindow,'OBJECT'));

   case Msg of

{------------------  WM_PAINT,WMERASEBKGND  ---------------------}

     WM_PAINT,WM_ERASEBKGND: begin
       WPMsg.Msg := Msg;
       WPMsg.WParam := WParam;
       WPMsg.LParam := LParam;
       WPMsg.Result := Result;
       if Assigned(Wnd) then begin
         Wnd.Dispatch(WPMsg);
         if WPMsg.result <> 0 then Result := WPMsg.result;
       end;
     end;

{------------------  WM_DESTROY  --------------------------------}

     WM_DESTROY: begin
       if Assigned(Wnd) then begin
         Wnd.Free;
       end;
     end;

   else Result := DefWindowProc( hWindow, Msg, wParam, lParam );

   end; //case

end;

procedure TAPIPanel.APIClassParams(var WC:TWndClass);
begin
  WC.lpszClassName   := 'APIPanel';
  WC.lpfnWndProc     := @PanelWndProc;
  WC.style           := CS_VREDRAW or CS_HREDRAW;
  WC.hInstance       := hInstance;
  WC.hIcon           := 0;
  WC.hCursor         := LoadCursor(0,IDC_ARROW);
  WC.hbrBackground   := ( COLOR_BTNFACE+1 );
  WC.lpszMenuName    := nil;
  WC.cbClsExtra      := 0;
  WC.cbWndExtra      := 0;

  FOuterEdge := esRaised;
  FInnerEdge := esNone;
  FEdgeWidth := 2;

  If Assigned(FOnClassParams) then FOnClassParams(WC);
end;

procedure TAPIPanel.APICreateParams(var CP:TCreateParamsEx);
begin
  CP.dwExStyle           := WS_EX_CONTROLPARENT;
  CP.lpClassName         := 'APIPanel';
  CP.lpWindowName        := 'APIPanel';
  CP.dwStyle             := WS_CHILD or WS_VISIBLE or WS_CLIPSIBLINGS;
  CP.X                   := 0;
  CP.Y                   := 0;
  CP.nWidth              := 0;
  CP.nHeight             := 0;
  CP.hWndParent          := FParent;
  CP.hMenu               := 0;
  CP.hInstance           := hInstance;
  CP.lpParam             := self;
  If Assigned(FOnWindowParams) then FOnWindowParams(CP);
end;

procedure TAPIPanel.DefaultHandler(var Message);
var
  AMsg:TMessage;
  r: TRect;
  DC: HDC;
  ps: TPaintStruct;
begin
  AMsg := TMessage(message);
  case AMsg.Msg of
    WM_PAINT:begin
      DC := BeginPaint(FHandle,ps);
        GetClientRect(FHandle,r);
        case FOuterEdge of
          esRaised:DrawEdge(DC,r,BDR_RAISEDOUTER or BDR_RAISEDINNER,
                 BF_RECT);
          esSunken:DrawEdge(DC,r,BDR_SUNKENOUTER or BDR_SUNKENINNER,
                 BF_RECT);
        end;
        InflateRect(r,-FEdgeWidth,-FEdgeWidth);
        case FInnerEdge of
          esRaised:DrawEdge(DC,r,BDR_RAISEDOUTER or BDR_RAISEDINNER,
                 BF_RECT);
          esSunken:DrawEdge(DC,r,BDR_SUNKENOUTER or BDR_SUNKENINNER,
                 BF_RECT);
        end;
      EndPaint(FHandle,ps);
    end;
    WM_ERASEBKGND:TMessage(message).Result := EraseBkgnd(FHandle,
                   FColor,AMsg.WParam);
  end; // case
end;

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

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

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

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

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

procedure TAPIPanel.SetYPos(value: integer);
begin
  ChangeWindowPos(FHandle,XPos,value);
end;
        
procedure TAPIPanel.SetOuterEdge(value: TEdgeStyle);
begin
  FOuterEdge := value;
  InvalidateRect(FHandle,nil,true);
end;

procedure TAPIPanel.SetInnerEdge(value: TEdgeStyle);
begin
  FInnerEdge := value;
  InvalidateRect(FHandle,nil,true);
end;

procedure TAPIPanel.SetEdgeWidth(value: integer);
begin
  FEdgeWidth := value;
  InvalidateRect(FHandle,nil,true);
end;

function CreatePanel(hParent:HWND;x,y,cx,cy:integer):TAPIPanel;
begin
  result := TAPIPanel.Create(hParent,'');
  result.DoCreate;
  result.Dimension := SetDim(x,y,cx,cy);
end;

end.