Delphi里实现无边框窗体支持4边4角拉伸改变尺寸的方法

5bug 2018-01-20 797人围观 ,发现0个评论 WM_NCHITTESTDelphi无边框窗体拉伸

在Delphi做UI界面的时候,经常要将窗体设置为无边框窗体,但设置为无边框窗体后,就不支持四边四角的拉伸来改变尺寸了,这里给大家分享下这个解决方法,希望大家在做自绘UI界面的时候能有帮助!

具体实现原理就是拦截WM_NCHITTEST消息,加入相关的实现逻辑,具体代码如下:

unit Unit8;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs;

type
  TForm8 = class(TForm)
  private
    { Private declarations }
    procedure DoWM_Nchist(var Msg: TMessage); message WM_NCHITTEST;
  public
    { Public declarations }
  end;

var
  Form8: TForm8;

implementation

{$R *.dfm}

procedure TForm8.DoWM_Nchist(var Msg: TMessage);
var
  p: TPoint;
begin
  DefaultHandler(Msg);
  p.X := ScreenToClient(Mouse.CursorPos).X;
  p.Y := ScreenToClient(Mouse.CursorPos).Y;
  if ((p.X < 6) and (p.Y < 6) or (p.X < 6) and (p.Y < 4)) then
    Msg.Result := HTTOPLEFT
  else if ((p.X > ClientWidth - 6) and (p.Y < 6) or (p.X > ClientWidth - 6) and (p.Y < 4)) then
    Msg.Result := HTTOPRIGHT
  else if ((p.X < 0) and (p.Y > ClientHeight - 6) or (p.X < 0 + 6) and (p.Y > ClientHeight - 6)) then
    Msg.Result := HTBOTTOMLEFT
  else if ((p.X > ClientWidth - 6) and (p.Y > ClientHeight - 6) or (p.X > ClientWidth - 6) and (p.Y > ClientHeight))
  then
    Msg.Result := HTBOTTOMRIGHT
  else if (p.X < 2) then
    Msg.Result := HTLEFT
  else if (p.X > ClientWidth - 6) then
    Msg.Result := HTRIGHT
  else if (p.Y < 4) then
    Msg.Result := HTTOP
  else if (p.Y > ClientHeight - 6) then
    Msg.Result := HTBOTTOM
end;

end.

大家可以自己弄个小Demo,来测试下啊!运行效果如下:

2.gif

不容错过
Powered By Z-BlogPHP