From: beware <beware@bircd.org>
Date: Sat, 18 Aug 2012 10:46:34 +0000 (+0000)
Subject: this version of unitwindowobject allows for creating a descendant with different... 
X-Git-Url: http://www.lcore.org/git/lcore.git/commitdiff_plain/87fed35010bb66b6183b06b01adb356dbefeefe6

this version of unitwindowobject allows for creating a descendant with different parameters

git-svn-id: file:///svnroot/lcore/trunk@121 b1de8a11-f9be-4011-bde0-cc7ace90066a
---

diff --git a/unitwindowobject.pas b/unitwindowobject.pas
index 6fa9c84..cc7f1e1 100644
--- a/unitwindowobject.pas
+++ b/unitwindowobject.pas
@@ -20,27 +20,49 @@ uses
   pgtypes;
 
 type
-  twindowobject=class(tobject)
+  twindowobjectbase=class(tobject)
     hwndmain:hwnd;
     onmsg:function(msg,wparam,lparam:taddrint):boolean of object;
     exitloopflag:boolean;
+    exstyle,style:integer;
+    docreatewindow:boolean;
+    function windowprocaddr:pointer; virtual;
+    procedure init_window(dwexstyle,dwstyle:cardinal);
+    procedure init; virtual;
+    procedure initinvisible;
     function settimer(id,timeout:taddrint):integer;
     function killtimer(id:taddrint):boolean;
     procedure postmessage(msg,wparam,lparam:taddrint);
     procedure messageloop;
     {$ifdef win32}
-      procedure processmessages;
+      procedure processmessages; virtual;
       function processmessage:boolean;
-    {$endif}
-    constructor create;
+    {$endif}  
+    constructor create; virtual;
     destructor destroy; override;
   end;
 
+  {this type exists for compatibility with the original one in bewarehttpd,
+  therefore it inits on create}
+  twindowobject=class(twindowobjectbase)
+    constructor create; override;
+  end;
+
+function WindowProc_windowobjectbase(ahWnd:HWND; auMsg:Integer; awParam:WPARAM; alParam:LPARAM):Integer; stdcall;
+
+var
+  twindowobject_Class : TWndClass = (style:0; lpfnWndProc:nil;
+  cbClsExtra:0; cbWndExtra:sizeof(pointer); hInstance:thinstance(0); hIcon:hicon(0); hCursor:hcursor(0);
+  hbrBackground:hbrush(0);lpszMenuName:nil; lpszClassName:'twindowobject_class');
+
+
 implementation
 
 //uses safewriteln;
 
-function WindowProc(ahWnd:HWND; auMsg:Integer; awParam:WPARAM; alParam:LPARAM):Integer; stdcall;
+{------------------------------------------------------------------------------}
+
+function WindowProc_windowobjectbase(ahWnd:HWND; auMsg:Integer; awParam:WPARAM; alParam:LPARAM):Integer; stdcall;
 var
   i:taddrint;
 begin
@@ -48,36 +70,52 @@ begin
   Result := 0;  // This means we handled the message
   if ahwnd <> hwnd(0) then i := getwindowlongptr(ahwnd,0) else i := 0;
   if i <> 0 then begin
-    if assigned(twindowobject(i).onmsg) then begin
-      if not twindowobject(i).onmsg(aumsg,awparam,alparam) then i := 0;
+    if assigned(twindowobjectbase(i).onmsg) then begin
+      if not twindowobjectbase(i).onmsg(aumsg,awparam,alparam) then i := 0;
     end else i := 0
   end;
   if i = 0 then Result := DefWindowProc(ahWnd, auMsg, awParam, alParam)
 end;
 
-var
-  twindowobject_Class : TWndClass = (style:0; lpfnWndProc:@WindowProc;
-  cbClsExtra:0; cbWndExtra:sizeof(pointer); hInstance:thinstance(0); hIcon:hicon(0); hCursor:hcursor(0);
-  hbrBackground:hbrush(0);lpszMenuName:nil; lpszClassName:'twindowobject_class');
 
-function twindowobject.settimer;
+function twindowobjectbase.windowprocaddr;
+begin
+  result := @WindowProc_windowobjectbase;
+end;
+
+procedure twindowobjectbase.initinvisible;
+begin
+  init_window(WS_EX_TOOLWINDOW,WS_POPUP);
+end;
+
+procedure twindowobjectbase.init;
+begin
+  //
+end;
+
+function twindowobjectbase.settimer;
 begin
   result := windows.settimer(hwndmain,id,timeout,nil);
 end;
 
-function twindowobject.killtimer;
+function twindowobjectbase.killtimer;
 begin
   result := windows.killtimer(hwndmain,id);
 end;
 
-constructor twindowobject.create;
+
+
+procedure twindowobjectbase.init_window;
 begin
-  inherited;
-  //swriteln('in twindowobject.create, about to call registerclass');
+    //swriteln('in twindowobject.create, about to call registerclass');
+  twindowobject_Class.lpfnWndProc := windowprocaddr;
   Windows.RegisterClass(twindowobject_Class);
   //swriteln('about to call createwindowex');
-  hWndMain := CreateWindowEx(WS_EX_TOOLWINDOW, twindowobject_Class.lpszClassName,
-    '', WS_POPUP, 0, 0,0, 0, hwnd(0), 0, HInstance, nil);
+
+  style := dwstyle;
+  exstyle := dwexstyle;
+  hWndMain := CreateWindowEx(dwexstyle, twindowobject_Class.lpszClassName,
+    '', dwstyle, CW_USEDEFAULT, CW_USEDEFAULT,100, 100, hwnd(0), 0, HInstance, nil);
   //swriteln('about to check result of createwindowex');
   if hWndMain = hwnd(0) then raise exception.create('CreateWindowEx failed');
   //swriteln('about to store reference to self in extra windo memory');
@@ -85,44 +123,63 @@ begin
   //swriteln('finished twindowobject.create , hwndmain='+inttohex(taddrint(hwndmain),16));
 end;
 
-destructor twindowobject.destroy;
+
+constructor twindowobjectbase.create;
+begin
+  inherited;
+
+end;
+
+destructor twindowobjectbase.destroy;
 begin
   if hWndMain <> hwnd(0) then DestroyWindow(hwndmain);
   inherited;
 end;
 
-procedure twindowobject.postmessage;
+procedure twindowobjectbase.postmessage;
 begin
   windows.postmessage(hwndmain,msg,wparam,lparam);
 end;
 
-{$ifdef win32}
-  function twindowobject.ProcessMessage : Boolean;
-  var
-    Msg : TMsg;
-  begin
+function twindowobjectbase.ProcessMessage : Boolean;
+var
+    MsgRec : TMsg;
+begin
     Result := FALSE;
-    if PeekMessage(Msg, hwndmain, 0, 0, PM_REMOVE) then begin
+    if PeekMessage(MsgRec, 0, 0, 0, PM_REMOVE) then begin
       Result := TRUE;
-      DispatchMessage(Msg);
+      TranslateMessage(MsgRec);
+      DispatchMessage(MsgRec);
     end;
-  end;
+end;
 
-  procedure twindowobject.processmessages;
-  begin
-    while processmessage do;
-  end;
-{$endif}
+procedure twindowobjectbase.processmessages;
+begin
+  while processmessage do;
+end;
 
-procedure twindowobject.messageloop;
+procedure twindowobjectbase.messageloop;
 var
   MsgRec : TMsg;
 begin
   while GetMessage(MsgRec, hwnd(0), 0, 0) do begin
+    TranslateMessage(MsgRec);
     DispatchMessage(MsgRec);
     if exitloopflag then exit;
     {if not peekmessage(msgrec,0,0,0,PM_NOREMOVE) then onidle}
   end;
 end;
 
+
+{------------------------------------------------------------------------------}
+
+constructor twindowobject.create;
+begin
+  inherited;
+  initinvisible;
+end;
+
+{------------------------------------------------------------------------------}
+
+
 end.