zoukankan      html  css  js  c++  java
  • Delphi7 API(5) 消息篇: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(0,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.
  • 相关阅读:
    django email用法
    django ImageField用法
    django集成微博内容
    python读写zip文件
    读写文件
    404渲染
    bzoj1297 / P4159 [SCOI2009]迷路
    bzoj1009 / P3193 [HNOI2008]GT考试
    poj2115 C Looooops(exgcd)
    bzoj1407 / P2421 [NOI2002]荒岛野人(exgcd)
  • 原文地址:https://www.cnblogs.com/delphi2014/p/4073189.html
Copyright © 2011-2022 走看看