unit NonVCLForms;
interface
uses
Windows, Messages;
type
TPosition = (poNone, poCenter);
TWndStyle =
packed record
Left, Top, Width, Height: Integer;
Caption: PChar;
Color: Cardinal;
Position: TPosition;
end;
TWindow =
class
private
{ Private-Deklarationen }
type
TNotifyEvent =
procedure of object;
var
FHandle: HWND;
FOnCreate: TNotifyEvent;
WndClass: TWndClassEx;
procedure CenterWindow(wndParent, wndChild: HWND);
public
{ Public-Deklarationen }
constructor Create(WndStyle: TWndStyle);
function WndProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM;
lParam: LPARAM): LRESULT;
stdcall;
published
property Handle: HWND
read FHandle;
property OnCreate: TNotifyEvent
read FOnCreate
write FOnCreate;
end;
implementation
(* Private *)
(* Zentriert ein Fenster anhand seines Parents *)
procedure TWindow.CenterWindow(wndParent, wndChild: HWND);
var
PRec,
CRec: TRect;
begin
// Fensterkoordinaten ins TRect laden
GetClientRect(WndParent, PRec);
GetClientRect(WndChild, CRec);
// Parent muss größer sein als Child
if ((PRec.Right - PRec.Left) < (CRec.Right - CRec.Left))
or
((PRec.Bottom - PRec.Top) < (CRec.Bottom - CRec.Top))
then
begin
Exit;
end;
// Position setzen
SetWindowPos(WndChild, HWND_TOP, (PRec.Right - CRec.Right)
div 2,
(PRec.Bottom - CRec.Bottom)
div 2, 0, 0, SWP_NOSIZE
or SWP_NOACTIVATE);
end;
(* Public *)
constructor TWindow.Create(WndStyle: TWndStyle);
var
lgBr: TLogBrush;
hBr: HBRUSH;
begin
case WndStyle.Color
of
COLOR_WINDOW,
COLOR_APPWORKSPACE:
begin
lgBr.lbColor := GetSysColor(WndStyle.Color);
end;
else
lgBr.lbColor := WndStyle.Color;
end;
lgBr.lbStyle := BS_SOLID;
hBr := CreateBrushIndirect(lgBr);
WndClass.cbSize := SizeOf(WndClass);
WndClass.style := CS_OWNDC;
WndClass.lpfnWndProc := @TWindow.WndProc;
WndClass.hInstance := hInstance;
WndClass.hCursor := LoadCursor(0, IDC_ARROW);
WndClass.hbrBackground := hBr;
WndClass.lpszClassName := '
TWindow';
RegisterClassEx(WndClass);
With WndStyle
do
begin
FHandle := CreateWindow('
TWindow', Caption, WS_VISIBLE
or WS_SYSMENU,
Left, Top, Width, Height, 0, 0, hInstance,
nil);
if Position = poCenter
then
CenterWindow(FindWindow('
ProgMan',
nil),
Handle);
end;
end;
function TWindow.WndProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM;
lParam: LPARAM): LRESULT;
stdcall;
begin
case uMsg
of
WM_CREATE:
begin
if Assigned(OnCreate)
then
OnCreate;
Result := 0;
end;
else
Result := DefWindowProc(hwnd, uMsg, wParam, lParam);
end;
end;
end.