Windows 编程[10] - WM_LBUTTONDOWN、WM_LBUTTONUP 和 WM_MOUSEMOVE 消息

本例效果图:

---

program Project1;



uses

  Windows,

  Messages;



{供 WM_LBUTTONDOWN 消息调用的自定义过程}

procedure OnLButtonDown(h: HWND);

var

  BrushHandle: HBRUSH;

  Rect: TRect;

begin

  GetClientRect(h, Rect);                        {获取客户区矩形}

  BrushHandle := CreateSolidBrush(RGB(255,0,0)); {建立红色笔刷}

  FillRect(GetDC(h), Rect, BrushHandle);         {填充客户区}

  DeleteObject(BrushHandle);                     {删除笔刷}

end;



{供 WM_LBUTTONUP 消息调用的自定义过程}

procedure OnLButtonUp(h: HWND);

var

  Rect: TRect;

begin

  GetClientRect(h, Rect);         {获取客户区矩形}

  InvalidateRect(h, @Rect, True); {使客户区无效, 从而强制重绘}

end;



{供 WM_MOUSEMOVE 消息调用的自定义过程}

procedure OnMouseMove(h: HWND; lParam: Integer);

var

  pt: TPoint;

  buf: array[0..255] of Char;

begin

  pt.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;

begin

  Result := 0;

  case msg of

    WM_LBUTTONDOWN: OnLButtonDown(wnd); {鼠标左键按下的消息}

    WM_LBUTTONUP  : OnLButtonUp(wnd);   {鼠标左键抬起的消息}

    WM_MOUSEMOVE  : OnMouseMove(wnd, lParam);   {鼠标移动的消息, 坐标位置在 lParam 中}

    WM_DESTROY    : PostQuitMessage(0);

  else

    Result := DefWindowProc(wnd, msg, wParam, lParam);

  end;

end;



function RegMyWndClass: Boolean;

var

  cls: TWndClass;

begin

  cls.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;



{程序入口}

const

  tit = 'New Form';

  ws = WS_OVERLAPPEDWINDOW;

  x = 100; y = 100; w = 300; h = 180;

var

  hWnd: THandle;

  Msg : TMsg;

begin

  RegMyWndClass;

  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)) do

  begin

    TranslateMessage(Msg);

    DispatchMessage(Msg);

  end;

end.