• 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.
    
  • 相关阅读:
    巡风安装配置 -windows
    Struts2-052 RCE CVE-2017-9805
    CVE-2017-12615和CVE-2017-12616
    Nmap使用指南
    理解HTTP协议
    缓慢拒绝服务攻击- slowloris.pl
    SSL&TLS渗透测试
    Nmap版本检测
    Protocol Buffer学习教程之编译器与类文件(三)
    64位Windows系统下32位应用程序连接MySql
  • 原文地址:https://www.cnblogs.com/del/p/1160968.html
Copyright © 2020-2023  润新知