move ipv6 connectivity check from dnscore init to a reusable function in lcorelocalips

[lcore.git] / unitwindowobject.pas

diff --git a/unitwindowobject.pas b/unitwindowobject.pas
index 6fa9c84adec7653193b5dc059418003901ddc253..ec5d955fa3b0a3b1315ed59c686b2efa951c1d96 100644 (file)
--- a/unitwindowobject.pas
+++ b/unitwindowobject.pas
@@ -9,38 +9,60 @@ interface
 \r
 uses\r
   classes,\r
 \r
 uses\r
   classes,\r

-  {$ifdef win32}\r
+  {$ifdef mswindows}\r

     windows,messages,wmessages,\r
   {$else}\r
     windows,messages,wmessages,\r
   {$else}\r

-    lmessages,\r
+    lcoremessages,\r

     {$macro on}\r
     {$macro on}\r

-    {$define windows := lmessages}\r
+    {$define windows := lcoremessages}\r

   {$endif}\r
   sysutils,\r
   pgtypes;\r
 \r
 type\r
   {$endif}\r
   sysutils,\r
   pgtypes;\r
 \r
 type\r

-  twindowobject=class(tobject)\r
+  twindowobjectbase=class(tobject)\r

     hwndmain:hwnd;\r
     onmsg:function(msg,wparam,lparam:taddrint):boolean of object;\r
     exitloopflag:boolean;\r
     hwndmain:hwnd;\r
     onmsg:function(msg,wparam,lparam:taddrint):boolean of object;\r
     exitloopflag:boolean;\r

+    exstyle,style:integer;\r
+    docreatewindow:boolean;\r
+    function windowprocaddr:pointer; virtual;\r
+    procedure init_window(dwexstyle,dwstyle:cardinal);\r
+    procedure init; virtual;\r
+    procedure initinvisible;\r

     function settimer(id,timeout:taddrint):integer;\r
     function killtimer(id:taddrint):boolean;\r
     procedure postmessage(msg,wparam,lparam:taddrint);\r
     procedure messageloop;\r
     function settimer(id,timeout:taddrint):integer;\r
     function killtimer(id:taddrint):boolean;\r
     procedure postmessage(msg,wparam,lparam:taddrint);\r
     procedure messageloop;\r

-    {$ifdef win32}\r
-      procedure processmessages;\r
+    {$ifdef mswindows}\r
+      procedure processmessages; virtual;\r

       function processmessage:boolean;\r
       function processmessage:boolean;\r

-    {$endif}\r
-    constructor create;\r
+    {$endif}  \r
+    constructor create; virtual;\r

     destructor destroy; override;\r
   end;\r
 \r
     destructor destroy; override;\r
   end;\r
 \r

+  {this type exists for compatibility with the original one in bewarehttpd,\r
+  therefore it inits on create}\r
+  twindowobject=class(twindowobjectbase)\r
+    constructor create; override;\r
+  end;\r
+\r
+function WindowProc_windowobjectbase(ahWnd:HWND; auMsg:Integer; awParam:WPARAM; alParam:LPARAM):Integer; stdcall;\r
+\r
+var\r
+  twindowobject_Class : TWndClass = (style:0; lpfnWndProc:nil;\r
+  cbClsExtra:0; cbWndExtra:sizeof(pointer); hInstance:thinstance(0); hIcon:hicon(0); hCursor:hcursor(0);\r
+  hbrBackground:hbrush(0);lpszMenuName:nil; lpszClassName:'twindowobject_class');\r
+\r
+\r

 implementation\r
 \r
 //uses safewriteln;\r
 \r
 implementation\r
 \r
 //uses safewriteln;\r
 \r

-function WindowProc(ahWnd:HWND; auMsg:Integer; awParam:WPARAM; alParam:LPARAM):Integer; stdcall;\r
+{------------------------------------------------------------------------------}\r
+\r
+function WindowProc_windowobjectbase(ahWnd:HWND; auMsg:Integer; awParam:WPARAM; alParam:LPARAM):Integer; stdcall;\r

 var\r
   i:taddrint;\r
 begin\r
 var\r
   i:taddrint;\r
 begin\r


@@ -48,81 +70,120 @@ begin
   Result := 0;  // This means we handled the message\r
   if ahwnd <> hwnd(0) then i := getwindowlongptr(ahwnd,0) else i := 0;\r
   if i <> 0 then begin\r
   Result := 0;  // This means we handled the message\r
   if ahwnd <> hwnd(0) then i := getwindowlongptr(ahwnd,0) else i := 0;\r
   if i <> 0 then begin\r

-    if assigned(twindowobject(i).onmsg) then begin\r
-      if not twindowobject(i).onmsg(aumsg,awparam,alparam) then i := 0;\r
+    if assigned(twindowobjectbase(i).onmsg) then begin\r
+      if not twindowobjectbase(i).onmsg(aumsg,awparam,alparam) then i := 0;\r

     end else i := 0\r
   end;\r
   if i = 0 then Result := DefWindowProc(ahWnd, auMsg, awParam, alParam)\r
 end;\r
 \r
     end else i := 0\r
   end;\r
   if i = 0 then Result := DefWindowProc(ahWnd, auMsg, awParam, alParam)\r
 end;\r
 \r

-var\r
-  twindowobject_Class : TWndClass = (style:0; lpfnWndProc:@WindowProc;\r
-  cbClsExtra:0; cbWndExtra:sizeof(pointer); hInstance:thinstance(0); hIcon:hicon(0); hCursor:hcursor(0);\r
-  hbrBackground:hbrush(0);lpszMenuName:nil; lpszClassName:'twindowobject_class');\r

 \r
 \r

-function twindowobject.settimer;\r
+function twindowobjectbase.windowprocaddr;\r
+begin\r
+  result := @WindowProc_windowobjectbase;\r
+end;\r
+\r
+procedure twindowobjectbase.initinvisible;\r
+begin\r
+  init_window(WS_EX_TOOLWINDOW,WS_POPUP);\r
+end;\r
+\r
+procedure twindowobjectbase.init;\r
+begin\r
+  //\r
+end;\r
+\r
+function twindowobjectbase.settimer;\r

 begin\r
   result := windows.settimer(hwndmain,id,timeout,nil);\r
 end;\r
 \r
 begin\r
   result := windows.settimer(hwndmain,id,timeout,nil);\r
 end;\r
 \r

-function twindowobject.killtimer;\r
+function twindowobjectbase.killtimer;\r

 begin\r
   result := windows.killtimer(hwndmain,id);\r
 end;\r
 \r
 begin\r
   result := windows.killtimer(hwndmain,id);\r
 end;\r
 \r

-constructor twindowobject.create;\r
+\r
+\r
+procedure twindowobjectbase.init_window;\r

 begin\r
 begin\r

-  inherited;\r
-  //swriteln('in twindowobject.create, about to call registerclass');\r
+    //swriteln('in twindowobject.create, about to call registerclass');\r
+  twindowobject_Class.lpfnWndProc := windowprocaddr;\r

   Windows.RegisterClass(twindowobject_Class);\r
   //swriteln('about to call createwindowex');\r
   Windows.RegisterClass(twindowobject_Class);\r
   //swriteln('about to call createwindowex');\r

-  hWndMain := CreateWindowEx(WS_EX_TOOLWINDOW, twindowobject_Class.lpszClassName,\r
-    '', WS_POPUP, 0, 0,0, 0, hwnd(0), 0, HInstance, nil);\r
+\r
+  style := dwstyle;\r
+  exstyle := dwexstyle;\r
+  hWndMain := CreateWindowEx(dwexstyle, twindowobject_Class.lpszClassName,\r
+    '', dwstyle, CW_USEDEFAULT, CW_USEDEFAULT,100, 100, hwnd(0), 0, HInstance, nil);\r

   //swriteln('about to check result of createwindowex');\r
   if hWndMain = hwnd(0) then raise exception.create('CreateWindowEx failed');\r
   //swriteln('about to check result of createwindowex');\r
   if hWndMain = hwnd(0) then raise exception.create('CreateWindowEx failed');\r

-  //swriteln('about to store reference to self in extra windo memory');\r
+  //swriteln('about to store reference to self in extra window memory');\r

   setwindowlongptr(hwndmain,0,taddrint(self));\r
   //swriteln('finished twindowobject.create , hwndmain='+inttohex(taddrint(hwndmain),16));\r
 end;\r
 \r
   setwindowlongptr(hwndmain,0,taddrint(self));\r
   //swriteln('finished twindowobject.create , hwndmain='+inttohex(taddrint(hwndmain),16));\r
 end;\r
 \r

-destructor twindowobject.destroy;\r
+\r
+constructor twindowobjectbase.create;\r
+begin\r
+  inherited;\r
+\r
+end;\r
+\r
+destructor twindowobjectbase.destroy;\r

 begin\r
   if hWndMain <> hwnd(0) then DestroyWindow(hwndmain);\r
   inherited;\r
 end;\r
 \r
 begin\r
   if hWndMain <> hwnd(0) then DestroyWindow(hwndmain);\r
   inherited;\r
 end;\r
 \r

-procedure twindowobject.postmessage;\r
+procedure twindowobjectbase.postmessage;\r

 begin\r
   windows.postmessage(hwndmain,msg,wparam,lparam);\r
 end;\r
 \r
 begin\r
   windows.postmessage(hwndmain,msg,wparam,lparam);\r
 end;\r
 \r

-{$ifdef win32}\r
-  function twindowobject.ProcessMessage : Boolean;\r
-  var\r
-    Msg : TMsg;\r
-  begin\r
+{$ifdef mswindows}\r
+function twindowobjectbase.ProcessMessage : Boolean;\r
+var\r
+    MsgRec : TMsg;\r
+begin\r

     Result := FALSE;\r
     Result := FALSE;\r

-    if PeekMessage(Msg, hwndmain, 0, 0, PM_REMOVE) then begin\r
+    if PeekMessage(MsgRec, 0, 0, 0, PM_REMOVE) then begin\r

       Result := TRUE;\r
       Result := TRUE;\r

-      DispatchMessage(Msg);\r
+      TranslateMessage(MsgRec);\r
+      DispatchMessage(MsgRec);\r

     end;\r
     end;\r

-  end;\r
+end;\r

 \r
 \r

-  procedure twindowobject.processmessages;\r
-  begin\r
-    while processmessage do;\r
-  end;\r
+procedure twindowobjectbase.processmessages;\r
+begin\r
+  while processmessage do;\r
+end;\r

 {$endif}\r
 \r
 {$endif}\r
 \r

-procedure twindowobject.messageloop;\r
+procedure twindowobjectbase.messageloop;\r

 var\r
   MsgRec : TMsg;\r
 begin\r
   while GetMessage(MsgRec, hwnd(0), 0, 0) do begin\r
 var\r
   MsgRec : TMsg;\r
 begin\r
   while GetMessage(MsgRec, hwnd(0), 0, 0) do begin\r

+    {$ifdef mswindows}\r
+    TranslateMessage(MsgRec);\r
+    {$endif}\r

     DispatchMessage(MsgRec);\r
     if exitloopflag then exit;\r
     {if not peekmessage(msgrec,0,0,0,PM_NOREMOVE) then onidle}\r
   end;\r
 end;\r
 \r
     DispatchMessage(MsgRec);\r
     if exitloopflag then exit;\r
     {if not peekmessage(msgrec,0,0,0,PM_NOREMOVE) then onidle}\r
   end;\r
 end;\r
 \r

+\r
+{------------------------------------------------------------------------------}\r
+\r
+constructor twindowobject.create;\r
+begin\r
+  inherited;\r
+  initinvisible;\r
+end;\r
+\r
+{------------------------------------------------------------------------------}\r
+\r
+\r

 end.\r
 end.\r