• 无边框窗体拖动大小


    今天有一个朋友问我怎样可以拖拽一个没有边框的窗体,使其改变大小。于是很快想到一个消息
    WM_NCHITTEST
    
    该消息用来描述,当关标移动或当按下或当释放了鼠标按扭的时候,就会发送一个WM_NCHITTEST消息给一个窗口若鼠标未被捕获,则这条消息发送给光标所在的窗口。否则,这条消息公布给捕获鼠标的窗口。
    参数
       xPos = LOWORD(Lparam);//LParam低位字的值。指出光标的X坐标。该坐标值是相对于屏幕左上角的坐标。
       yPos = HIWORD(LParam);//LParam高位字的值。指出光标的y坐标。
    
    返回值  DefWindowProc函数的返回值是下列值之一,以指示光标热点的位置:
        HTBORDER             光标热点在一个窗口的边界上,该窗口不具有可变大小的边界
        HBOTTOM                在一个窗口下面的水平边界上
        HBOTTOMLEFT      在一个窗口的边界的左下角
        HBOTTOMRIGHT   在边界右下脚
        HTCAPTION            在标题栏中
        HTCLIENT               在客户区
        HTERROR               在屏幕北京或窗口之间的分界线上(与HTNOWHERE类似,所不同的是DefWindowProc函数产生一个系统响铃以指示出错)
        HTGROWBOX         在尺寸框中(与HTSIZE相同)
        HTHSCROLL          在水平滚动栏
        HTLEFT                    在左边界
        HTMENU                  在菜单中
        HTNOWHERE         在屏幕或窗口之间的分界线上
        HTREDUCE             在一个最小化的按扭上
        HTRIGHT                  在窗口右边界
        HTSIZE                      在尺寸框中
        HTSYSMENU           在一个System菜单或在一个子窗口的Close按扭中
        HTTOP                       在上边界
        HTTOPLEFT             在左上角
        HTTOPRIGHT          在右上角
        HTTRANSPARENT 在当前被其他窗口覆盖的窗口中 
        HTVSCROLL            在垂直滚动栏中
        HTZOOM                   在最大化按扭上
    注释                  可使用MAKEPOINTS宏将lParam参数转换为一个Points结构
    参见                 DefWindowProc,GetCapture
    
       于是我们可知道要可拖动窗体主要就是要截获该消息,然后让消息的结果返回为HBOTTOM, HBOTTOMLEFT, HBOTTOMRIGHT,HTLEFT , HTTOP ,HTTOPLEFT  ,HTTOPRIGHT 等则可。于是写下如下代码:
    
    
    procedure TForm1.WMNchist(var Msg: TMessage);
    var
       MouseX,MouseY: integer;
    begin
      MouseX := LOWORD(Msg.LParam);
      MouseY := HIWORD(Msg.LParam);
      if(MouseX >= Left + Width - 2) and (MouseY >= Top + Height - 2) then
         Msg.Result := HTBOTTOMRIGHT
      else if (MouseX <= Left + 2) and (MouseY <= Top + 3) then
         Msg.Result := HTTOPLEFT
      else if (MouseX <= Left + 2) and (MouseY<= Top + Height - 2) then
         Msg.Result := HTBOTTOMLEFT
      else if MouseX >= Left + Width -2 then
         Msg.Result := HTRIGHT
      else if MouseY >= Top + Height - 2 then
         Msg.Result := HTBOTTOM
      else if Mousex <= Left + 2 then
         Msg.Result := HTLEFT
      else if MouseY <= Top + 2 then
         Msg.Result := HTTOP
      else Inherited;
    end;
    这样,这个窗体就可实现了无边框拖动改变大小了。
    于是我将程序发给了他!结果他说他那边运行没有效果,消息没有触发!原来他说,他在窗体上放了一个
    Panel为Client占据了窗体,于是自然就触发不了窗体的WM_NCHITTEST消息了。
    在看看,该消息的消息返回结果,发现有一个HTTRANSPARENT,该结果就表示透明掉当前的这个窗口
    这样,他就会将消息向下继续传递给他的Parent窗口。
    于是写下如下
    procedure TPanel.WMNchist(var Msg: TMessage);
    begin
       Inherited;
       Msg.Result := HTTRANSPARENT;
    end;
    
    这样消息就被传递到了Form窗体了。
    
    整体代码如下:
    
    
    
    DelphiCode:
    unit Unit1;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, ExtCtrls;
    
    type
      TPanel = Class(ExtCtrls.TPanel)
        procedure WMNchist(var Msg: TMessage);message WM_NCHITTEST;
      end;
      TForm1 = class(TForm)
        pnl1: TPanel;
      private
        { Private declarations }
      protected
         procedure WMNchist(var Msg: TMessage);message WM_NCHITTEST;
      public
        { Public declarations }
      end;
    
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.dfm}
    
    procedure TForm1.WMNchist(var Msg: TMessage);
    var
       MouseX,MouseY: integer;
    begin
      MouseX := LOWORD(Msg.LParam);
      MouseY := HIWORD(Msg.LParam);
      if(MouseX >= Left + Width - 2) and (MouseY >= Top + Height - 2) then
         Msg.Result := HTBOTTOMRIGHT
      else if (MouseX <= Left + 2) and (MouseY <= Top + 3) then
         Msg.Result := HTTOPLEFT
      else if (MouseX <= Left + 2) and (MouseY<= Top + Height - 2) then
         Msg.Result := HTBOTTOMLEFT
      else if MouseX >= Left + Width -2 then
         Msg.Result := HTRIGHT
      else if MouseY >= Top + Height - 2 then
         Msg.Result := HTBOTTOM
      else if Mousex <= Left + 2 then
         Msg.Result := HTLEFT
      else if MouseY <= Top + 2 then
         Msg.Result := HTTOP
      else Inherited;
    end;
    
    { TPanel }
    
    procedure TPanel.WMNchist(var Msg: TMessage);
    begin
       Inherited;
       Msg.Result := HTTRANSPARENT;
    end;
    
    end.
  • 相关阅读:
    tracteroute路由追踪
    搭建Weblogic服务器
    Logview_pro破解版
    Spring Boot 如何在类中应用配置文件
    使用Mybatis-Generator自动生成Dao、Model、Mapping相关文件(转)
    springboot 项目中控制台打印日志以及每天生成日志文件
    springboot输出日志到指定目录,简单粗暴,springboot输出mybatis日志
    spring boot 发布成包所需插件
    spring注解
    Multicast注册中心
  • 原文地址:https://www.cnblogs.com/blogpro/p/11453677.html
Copyright © 2020-2023  润新知