\r
uses\r
classes,\r
- {$ifdef win32}\r
+ {$ifdef mswindows}\r
windows,messages,wmessages,\r
{$else}\r
- lmessages,\r
+ lcoremessages,\r
{$macro on}\r
- {$define windows := lmessages}\r
+ {$define windows := lcoremessages}\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
+ 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
- {$ifdef win32}\r
- procedure processmessages;\r
+ {$ifdef mswindows}\r
+ procedure processmessages; virtual;\r
function processmessage:boolean;\r
- {$endif}\r
- constructor create;\r
+ {$endif} \r
+ constructor create; virtual;\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
-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
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
-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
+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
-function twindowobject.killtimer;\r
+function twindowobjectbase.killtimer;\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
- 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
- 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 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
-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
-procedure twindowobject.postmessage;\r
+procedure twindowobjectbase.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
+{$ifdef mswindows}\r
+function twindowobjectbase.ProcessMessage : Boolean;\r
+var\r
+ MsgRec : TMsg;\r
+begin\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
- DispatchMessage(Msg);\r
+ TranslateMessage(MsgRec);\r
+ DispatchMessage(MsgRec);\r
end;\r
- end;\r
+end;\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
-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
+ {$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
+\r
+{------------------------------------------------------------------------------}\r
+\r
+constructor twindowobject.create;\r
+begin\r
+ inherited;\r
+ initinvisible;\r
+end;\r
+\r
+{------------------------------------------------------------------------------}\r
+\r
+\r
end.\r
lcore.org gitweb / lcore.git / blobdiff