本例效果图:

program Project1;usesWindows,Messages;{供 WM_LBUTTONDOWN 消息调用的自定义过程}
procedure OnLButtonDown(h: HWND);
varBrushHandle: HBRUSH;Rect: TRect;
beginGetClientRect(h, Rect);                        {获取客户区矩形}BrushHandle := CreateSolidBrush(RGB(255,0,0)); {建立红色笔刷}FillRect(GetDC(h), Rect, BrushHandle);         {填充客户区}DeleteObject(BrushHandle);                     {删除笔刷}
end;{供 WM_LBUTTONUP 消息调用的自定义过程}
procedure OnLButtonUp(h: HWND);
varRect: TRect;
beginGetClientRect(h, Rect);         {获取客户区矩形}InvalidateRect(h, @Rect, True); {使客户区无效, 从而强制重绘}
end;{供 WM_MOUSEMOVE 消息调用的自定义过程}
procedure OnMouseMove(h: HWND; lParam: Integer);
varpt: TPoint;buf: array[0..255] of Char;
beginpt.X := LoWord(lParam); {lParam 中的低两位是 x 坐标}pt.Y := HiWord(lParam); {lParam 中的高两位是 y 坐标}wvsprintf(buf, '%d, %d', @pt); {格式化到缓冲区}SetWindowText(h, buf);         {显示在标题}
end;function WndProc(wnd: HWND; msg: UINT; wParam: Integer; lParam: Integer): Integer; stdcall;
beginResult := 0;case msg ofWM_LBUTTONDOWN: OnLButtonDown(wnd); {鼠标左键按下的消息}WM_LBUTTONUP  : OnLButtonUp(wnd);   {鼠标左键抬起的消息}WM_MOUSEMOVE  : OnMouseMove(wnd, lParam);   {鼠标移动的消息, 坐标位置在 lParam 中}WM_DESTROY    : PostQuitMessage(0);elseResult := DefWindowProc(wnd, msg, wParam, lParam);end;
end;function RegMyWndClass: Boolean;
varcls: TWndClass;
begincls.style         := CS_HREDRAW or CS_VREDRAW;cls.lpfnWndProc   := @WndProc;cls.cbClsExtra    := 0;cls.cbWndExtra    := 0;cls.hInstance     := HInstance;cls.hIcon         := 0;cls.hCursor       := LoadCursor(0, IDC_ARROW);cls.hbrBackground := HBRUSH(COLOR_WINDOW + 1);cls.lpszMenuName  := nil;cls.lpszClassName := 'MyWnd';Result := RegisterClass(cls) <> 0;
end;{程序入口}
consttit = 'New Form';ws = WS_OVERLAPPEDWINDOW;x = 100; y = 100; w = 300; h = 180;
varhWnd: THandle;Msg : TMsg;
beginRegMyWndClass;hWnd := CreateWindow('MyWnd', tit, ws, x, y, w, h, 0, 0, HInstance, nil);ShowWindow(hWnd, SW_SHOWNORMAL);UpdateWindow(hWnd);while(GetMessage(Msg, 0, 0, 0)) dobeginTranslateMessage(Msg);DispatchMessage(Msg);end;
end.