program TestProg;
uses
Messages,
Windows;
const
CLASSNAME = '
WindowClass';
STYLEFLAGS = WS_SYSMENU;
STYLEFLAGSEDIT = ES_AUTOHSCROLL
or WS_BORDER
or WS_CHILD
or WS_VISIBLE;
var
WndClassInfo: TWndClass;
Msg: TMsg;
Mittelpunkt: TPoint = (
X: 200;
Y: 180);
Radius: Integer = 5;
function CreateControls(
Handle: HWND): Boolean;
var
ControlArray:
Array [0..1]
of HWND;
begin
Result := True;
ControlArray[0] := CreateWindow('
EDIT', '
5', STYLEFLAGSEDIT,
0, 0, 30, 20,
Handle, 1, hInstance,
nil);
if not IsWindow(ControlArray[0])
then
Result := False;
end;
function WndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM;
lParam: LPARAM): LRESULT;
stdcall;
var
ps: TPaintStruct;
WndDC: HDC;
Brush, BrushOld: HBRUSH;
Buffer:
Array [0..2]
of Char;
Code: Integer;
begin
case uMsg
of
WM_CLOSE:
begin
DestroyWindow(hWnd);
PostQuitMessage(0);
Result := 0;
end;
WM_COMMAND:
begin
if HiWord(wParam) = EN_CHANGE
then
begin
SendMessage(GetDlgItem(hWnd, 1), WM_GETTEXT, 3, Integer(@Buffer));
Val(Buffer, Radius, Code);
SendMessage(hWnd, WM_PAINT, 0, 0);
Result := 0;
end;
end;
WM_CREATE:
begin
if not CreateControls(hWnd)
then
SendMessage(hWnd, WM_CLOSE, 0, 0);
SendMessage(GetDlgItem(hWnd, 1), EM_LIMITTEXT, 2, 0);
ShowWindow(hWnd, SW_SHOW);
Result := 0;
end;
WM_PAINT:
begin
WndDC := BeginPaint(hWnd, ps);
Brush := CreateSolidBrush($00C8D0D4);
BrushOld := SelectObject(WndDC, Brush);
RectAngle(WndDC, -1, -1, 401, 361);
SelectObject(WndDC, BrushOld);
DeleteObject(Brush);
Ellipse(WndDC, Mittelpunkt.X - Radius, Mittelpunkt.Y - Radius,
Mittelpunkt.X + Radius, Mittelpunkt.Y + Radius);
EndPaint(WndDC, ps);
Result := 0;
end;
else
Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
end;
end;
begin
with WndClassInfo
do
begin
style := CS_VREDRAW
or CS_HREDRAW;
lpfnWndProc := @WndProc;
hInstance := hInstance;
hCursor := LoadCursor(0, IDC_ARROW);
hbrBackground := COLOR_APPWORKSPACE;
lpszClassName := CLASSNAME;
end;
RegisterClass(WndClassInfo);
CreateWindow(CLASSNAME, '
Test Prog', STYLEFLAGS,
440, 332, 400, 360, 0, 0, hInstance,
nil);
while GetMessage(Msg, 0, 0, 0)
do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end.