function WndProc(hWnd, uMsg, wParam, lParam: DWORD): LRESULT;
stdcall;
var
ps : TPaintStruct;
dc : HDC;
hMemoryDC : HDC;
hOldBmp : DWORD;
bitmap : TBitmap;
DlgHeight : Integer;
DlgWidth : Integer;
DlgRect : TRect;
DesktopRect : TRect;
begin
Result := 0;
case uMsg
of
WM_DESTROY:
begin
if hBitMap <> 0
then
DeleteObject(hBitMap);
PostQuitMessage(0);
end;
WM_CREATE:
begin
GetWindowRect(hWnd, DlgRect);
GetWindowRect(GetDesktopWindow, DesktopRect);
DlgWidth := DlgRect.right - DlgRect.left;
DlgHeight := DlgRect.bottom - DlgRect.top;
MoveWindow(hWnd, (DesktopRect.right - DlgWidth)
div 2,
(DesktopRect.bottom - DlgHeight)
div 2, DlgWidth, DlgHeight, False);
hBitMap := LoadBitmap(HInstance, BitmapName);
end;
WM_PAINT:
begin
dc := BeginPaint(hWnd, ps);
hMemoryDC := CreateCompatibleDC(
dc);
hOldBmp := SelectObject(hMemoryDC, hBitMap);
GetObject(hBitMap, SizeOf(TBitmap), @bitmap);
StretchBlt(
dc, 0, 0, WndWidth, WndHeight, hMemoryDC, 0, 0, bitmap.bmWidth,
bitmap.bmHeight, SRCCOPY);
SelectObject(hMemoryDC, hOldBmp);
DeleteDC(hMemoryDC);
EndPaint(hWnd, ps);
end;
WM_CLOSE:
DestroyWindow(hWnd);
WM_LBUTTONDOWN:
DestroyWindow(hWnd);
else
Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
end;
end;
procedure ShowBitMap;
var
wc : TWndClassEx;
msg : TMsg;
begin
wc.cbSize := SizeOf(TWndClassEx);
wc.style := CS_HREDRAW
or CS_VREDRAW;
wc.lpfnWndProc := @WndProc;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
wc.hInstance := HInstance;
wc.hbrBackground := COLOR_WINDOW + 1;
wc.lpszMenuName :=
nil;
wc.lpszClassName := ClassName;
wc.hIcon := LoadIcon(0, IDI_APPLICATION);
wc.hCursor := LoadCursor(0, IDC_ARROW);
wc.hIconSm := 0;
RegisterClassEx(wc);
wnd := CreateWindowEx(WS_EX_TOOLWINDOW, ClassName, 0, WS_POPUP, Integer(CW_USEDEFAULT),
Integer(CW_USEDEFAULT), WndWidth, WndHeight, 0, 0, HInstance,
nil);
ShowWindow(wnd, SW_SHOWNORMAL);
while True
do
begin
if not GetMessage(msg, 0, 0, 0)
then
Break;
TranslateMessage(msg);
DispatchMessage(msg);
end;
ExitCode := msg.wParam;
end;