oops really add it this time

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

diff --git a/unitwindowobject.pas b/unitwindowobject.pas
new file mode 100644 (file)
index 0000000..6fa9c84
--- /dev/null
+++ b/unitwindowobject.pas
@@ -0,0 +1,128 @@
+{ Copyright (C) 2005 Bas Steendijk and Peter Green\r
+  For conditions of distribution and use, see copyright notice in zlib_license.txt\r
+  which is included in the package\r
+  ----------------------------------------------------------------------------- }\r
+\r
+unit unitwindowobject;\r
+\r
+interface\r
+\r
+uses\r
+  classes,\r
+  {$ifdef win32}\r
+    windows,messages,wmessages,\r
+  {$else}\r
+    lmessages,\r
+    {$macro on}\r
+    {$define windows := lmessages}\r
+  {$endif}\r
+  sysutils,\r
+  pgtypes;\r
+\r
+type\r
+  twindowobject=class(tobject)\r
+    hwndmain:hwnd;\r
+    onmsg:function(msg,wparam,lparam:taddrint):boolean of object;\r
+    exitloopflag:boolean;\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
+      function processmessage:boolean;\r
+    {$endif}\r
+    constructor create;\r
+    destructor destroy; override;\r
+  end;\r
+\r
+implementation\r
+\r
+//uses safewriteln;\r
+\r
+function WindowProc(ahWnd:HWND; auMsg:Integer; awParam:WPARAM; alParam:LPARAM):Integer; stdcall;\r
+var\r
+  i:taddrint;\r
+begin\r
+  ////swriteln('in unitwindowobject.windowproc');\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
+    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
+function twindowobject.settimer;\r
+begin\r
+  result := windows.settimer(hwndmain,id,timeout,nil);\r
+end;\r
+\r
+function twindowobject.killtimer;\r
+begin\r
+  result := windows.killtimer(hwndmain,id);\r
+end;\r
+\r
+constructor twindowobject.create;\r
+begin\r
+  inherited;\r
+  //swriteln('in twindowobject.create, about to call registerclass');\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
+  //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
+  setwindowlongptr(hwndmain,0,taddrint(self));\r
+  //swriteln('finished twindowobject.create , hwndmain='+inttohex(taddrint(hwndmain),16));\r
+end;\r
+\r
+destructor twindowobject.destroy;\r
+begin\r
+  if hWndMain <> hwnd(0) then DestroyWindow(hwndmain);\r
+  inherited;\r
+end;\r
+\r
+procedure twindowobject.postmessage;\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
+    Result := FALSE;\r
+    if PeekMessage(Msg, hwndmain, 0, 0, PM_REMOVE) then begin\r
+      Result := TRUE;\r
+      DispatchMessage(Msg);\r
+    end;\r
+  end;\r
+\r
+  procedure twindowobject.processmessages;\r
+  begin\r
+    while processmessage do;\r
+  end;\r
+{$endif}\r
+\r
+procedure twindowobject.messageloop;\r
+var\r
+  MsgRec : TMsg;\r
+begin\r
+  while GetMessage(MsgRec, hwnd(0), 0, 0) do begin\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
+end.\r