program FileLink;
uses
Windows, Messages, CommCtrl;
const
btnInstall = 5;
lblStatus = 3;
lblStatusLabel = 4;
var
hwndButton, hwndStatusLabel, hwndStatus : DWORD;
{$R FileLink.res}
function WndProc(hWnd: HWND; msg: UINT; wParam: wParam; lParam: LParam) : lresult;
stdcall;
var
font: HFONT;
begin
result := 0;
case msg
of
WM_CREATE :
begin
hwndButton := CreateWindowEx(0, '
BUTTON', '
Installieren',
WS_VISIBLE
or WS_CHILD, 8, 46, 99, 25, hWnd, btnInstall, hInstance,
nil);
hwndStatusLabel := CreateWindowEx(0, '
STATIC', '
Status', SS_CENTER
or WS_VISIBLE
or WS_CHILD, 8, 8, 99, 13, hWnd, lblStatusLabel, HInstance,
nil);
hwndStatus := CreateWindowEx(0, '
STATIC', '
Nicht installiert', SS_CENTER
or WS_VISIBLE
or WS_CHILD, 8, 27, 99, 13, hWnd, lblStatus, HInstance,
nil);
font := CreateFont(-12, 0, 0, 0, 0, 0, 0, 0, ANSI_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH, '
MS Sans Serif');
if font <> 0
then begin
SendMessage(hwndStatus, WM_SETFONT, Integer(font), Integer(true));
SendMessage(hwndStatusLabel, WM_SETFONT, Integer(font), Integer(true));
SendMessage(hwndButton, WM_SETFONT, Integer(font), Integer(true));
end;
end;
WM_CTLCOLORSTATIC:
begin
case GetDlgCtrlId(lParam)
of
lblStatus:
begin
SetTextColor(wParam,
RGB(0,200,0))
SetBkColor(wParam, GetSysColor(COLOR_3DFACE));
end;
else Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
end;
end;
WM_DESTROY : PostQuitMessage(0);
else result := DefWindowProc(hWnd, uMsg, wParam, lParam);
end;
end;
var
wc: TWndClassEx = (
cbSize : SizeOf(TWndClassEx);
Style : CS_HREDRAW
or CS_VREDRAW;
lpfnWndProc : @WndProc;
cbClsExtra : 0;
cbWndExtra : 0;
hbrBackground : COLOR_APPWORKSPACE;
lpszMenuName :
nil;
lpszClassName : ClassName;
hIconSm : 0;
);
icc : TInitCommonControlsEx = (
dwSize : sizeof(TInitCommonControlsEx);
dwICC : ICC_INTERNET_CLASSES;
);
msg: TMsg;
begin
wc.hInstance := hInstance;
wc.hIcon := LoadIcon(hInstance, MAKEINTRESOURCE(2));
wc.hCursor := LoadCursor(0, IDC_ARROW);
wc.hbrBackground := GetSysColorBrush(COLOR_3DFACE);
InitCommonControlsEx(icc);
RegisterClassEx(wc);
CreateWindowEx(WS_EX_TOOLWINDOW
or WS_EX_APPWINDOW, '
WndClass', '
FileLink', WS_CAPTION
or WS_VISIBLE
or WS_SYSMENU, CW_USEDEFAULT, CW_USEDEFAULT, 119, 103, 0, 0, hInstance,
nil);
while GetMessage(msg,0,0,0)
do begin
TranslateMessage(msg);
DispatchMessage(msg);
end;
ExitCode := msg.wParam;
end.