在 Delphi 中以无边框形式/窗口平滑调整大小

Question

我正在尝试调整无边框表单的大小，但是当我使用右侧/底部增加大小时，边框和旧客户区域之间存在间隙，该间隙取决于移动鼠标的速度。

当您从左边框甚至从左下角调整大小时，效果会更加明显，到处都很可怕（我尝试使用其他商业应用程序，它也会发生）。当我更改为相当大的边框时，也会发生这种效果，但它并不像删除表单边框时那么糟糕。

表单布局由一个顶部面板组成，该面板执行标题栏功能（带有一些tImages和按钮），而其他一些面板则显示其他内容信息（如备忘录、其他控件等）

有一个我的代码片段，其中我捕获鼠标按钮并向窗口发送消息，但我也尝试手动执行此操作，得到类似的结果

激活顶部面板的双缓冲区避免闪烁，但调整面板大小与调整表单大小不同步，从而出现间隙或部分面板消失

 procedure TOutputForm.ApplicationEvents1Message( var Msg: tagMSG;
  var Handled: Boolean );
const
  BorderBuffer = 5;
var
  X, Y: Integer;
  ClientPoint: TPoint;
  direction: integer;
begin
  Handled := false;
  case Msg.message of
    WM_LBUTTONDOWN:
      begin
        if fResizable then
        begin
          if fSides = [sTop] then
            direction := 3
          else if fSides = [sLeft] then
            direction := 1
          else if fSides = [sBottom] then
            direction := 6
          else if fSides = [sRight] then
            direction := 2
          else if fSides = [sRight, sTop] then
            direction := 5
          else if fSides = [sLeft, sTop] then
            direction := 4
          else if fSides = [sLeft, sBottom] then
            direction := 7
          else if fSides = [sRight, sBottom] then
            direction := 8;
          ReleaseCapture;
          SendMessage( Handle, WM_SYSCOMMAND, ( 61440 + direction ), 0 );
          Handled := true;
        end;
      end;
    WM_MOUSEMOVE:
      begin
        // Checks the borders and sets fResizable to true if it's in a "border" 
        // ...
      end; // mousemove
  end; // case
end;

如何避免该区域和/或强制重新绘制窗口？我正在使用 Delphi，但通用解决方案（或其他语言）或什至前进的方向对我来说都很好

提前谢谢

Answer 1

上次我尝试手动创建一个通过 WM_SYSCOMMAND 和鼠标拖动调整大小的顶级窗口，无论是否涉及任何嵌套面板，我发现问题不仅限于闪烁。

即使使用没有可调整大小边框的裸 TForm，添加我自己的可调整大小边框并直接处理鼠标按下、鼠标移动和鼠标向上消息也被证明太有问题。我放弃了您在此处展示的代码方法，而是找到了两种可行的方法：

1. 使用一种由我接管非客户区域绘制的方法。这就是 Google Chrome 和许多其他完全自定义窗口所做的事情。您仍然有一个非客户区域，由您来绘制它并处理非客户区域和边框绘制。换句话说，它并不是真正的无边界，但如果你愿意的话，它可以都是单一颜色。阅读此有关 WM_NCPAINT 消息的帮助 ，开始吧。

2. 使用仍能被识别的无边框可调整大小窗口（即使没有其非客户区域作为可调整大小窗口。想想便利贴小程序。这里是我不久前问过的一个问题，位于我的问题是一个完全有效的演示，它提供了一种平滑无闪烁的方式来获得无边框可调整大小的窗口。答案的基础技术由 David H 提供。

Answer 2

好吧，Warren P 已经非常令人信服地为您指出了另一个方向，但我会尽力回答您的问题。或者不是真的。

您的编辑现在使问题变得非常清楚：

当您从左边框甚至左下角调整大小时，效果会更加明显，到处都很可怕（我尝试使用其他商业应用程序，它也会发生）。当我更改为相当大的边框时也会发生这种效果，但它并不像删除边框时那么糟糕。

不仅是其他商业应用程序，而且每个操作系统窗口都会出现这种效果。拉伸资源管理器窗口的顶部还会“隐藏”和“展开”状态栏或底部面板。我很确定它无法被击败。

对于无边界的形式来说，这可能看起来更糟糕，但我认为这只是光学欺骗。

如果我必须猜测解释这种效果，那么我会说在调整大小操作期间，顶部和左侧的更新优先于宽度和高度的更新，这导致两者更新的次数不相等。可能和显卡有关。或者也许，……我到底在说什么？这对我来说是遥不可及的事情。

尽管如此，我仍然无法复制它来调整表单右侧和/或底部的大小。如果控件的数量或其对齐和锚点属性（的组合）是一个问题，那么您可以考虑暂时禁用所有对齐，但我几乎可以肯定您也不希望这样做。下面是我的测试代码，从问题中复制过来，稍加修改，当然还添加了 Sertac 的常量：

function TForm1.ResizableAt(X, Y: Integer): Boolean;
const
  BorderBuffer = 5;
var
  R: TRect;
  C: TCursor;
begin
  SetRect(R, 0, 0, Width, Height);
  InflateRect(R, -BorderBuffer, -BorderBuffer);
  Result := not PtInRect(R, Point(X, Y));
  if Result then
  begin
    FSides := [];
    if X < R.Left then
      Include(FSides, sLeft)
    else if X > R.Right then
      Include(FSides, sRight);
    if Y < R.Top then
      Include(FSides, sTop)
    else if Y > R.Bottom then
      Include(FSides, sBottom);
  end;
end;

function TForm1.SidesToCursor: TCursor;
begin
  if (FSides = [sleft, sTop]) or (FSides = [sRight, sBottom]) then
    Result := crSizeNWSE
  else if (FSides = [sRight, sTop]) or (FSides = [sLeft, sBottom]) then
    Result := crSizeNESW
  else if (sLeft in FSides) or (sRight in FSides) then
    Result := crSizeWE
  else if (sTop in FSides) or (sBottom in FSides) then
    Result := crSizeNS
  else
    Result := crNone;
end;

procedure TForm1.ApplicationEventsMessage(var Msg: tagMSG;
  var Handled: Boolean);
var
  CommandType: WPARAM;
begin
  case Msg.message of
    WM_LBUTTONDOWN:
      if FResizable then
      begin
        CommandType := SC_SIZE;
        if sLeft in FSides then
          Inc(CommandType, WMSZ_LEFT)
        else if sRight in FSides then
          Inc(CommandType, WMSZ_RIGHT);
        if sTop in FSides then
          Inc(CommandType, WMSZ_TOP)
        else if sBottom in FSides then
          Inc(CommandType, WMSZ_BOTTOM);
        ReleaseCapture;
        DisableAlign;
        PostMessage(Handle, WM_SYSCOMMAND, CommandType, 0);
        Handled := True;
      end;
    WM_MOUSEMOVE:
      with ScreenToClient(Msg.pt) do
      begin
        FResizable := ResizableAt(X, Y);
        if FResizable then
          Screen.Cursor := SidesToCursor
        else
          Screen.Cursor := Cursor;
        if AlignDisabled then
          EnableAlign;
      end;
  end;
end;

关于顶部对齐面板：尝试设置 Align = alCustom 和 Anchors = [akLeft, akTop, akRight]，尽管增强可能取决于面板的颜色与表单的颜色不同，或者可能取决于我被光学欺骗。 ;)

Answer 3

您是否尝试过将表单设置为DoubleBuffered := True？

Answer 4

我知道这个线程相当古老，但人们仍然在努力解决这个问题。

不过，答案很简单。问题是，尝试调整大小会让您想要使用正在调整大小的表单作为参考。 不要这样做。

使用另一种形式。

这是可以为您提供帮助的 TForm 的完整源代码。确保此表单具有 BorderStyle = bsNone。您可能还想确保它不可见。

unit UResize;
{
  Copyright 2014 Michael Thomas Greer
  Distributed under the Boost Software License, Version 1.0
  (See accompanying file LICENSE.txt or copy
   at http://www.boost.org/LICENSE_1_0.txt )
}

//////////////////////////////////////////////////////////////////////////////
interface
//////////////////////////////////////////////////////////////////////////////

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

const
  ResizeMaskLeft   = $1;
  ResizeMaskTop    = $2;
  ResizeMaskWidth  = $4;
  ResizeMaskHeight = $8;

type
  TResizeForm = class( TForm )
    procedure FormMouseMove( Sender: TObject;      Shift: TShiftState; X, Y: Integer );
    procedure FormMouseUp(   Sender: TObject;
                             Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
  private
    anchor_g: TRect;
    anchor_c: TPoint;
    form_ref: TForm;
    resize_m: cardinal;

  public
    procedure SetMouseDown( AForm: TForm; ResizeMask: cardinal );
  end;

var
  ResizeForm: TResizeForm;


//////////////////////////////////////////////////////////////////////////////
implementation
//////////////////////////////////////////////////////////////////////////////

{$R *.DFM}

//----------------------------------------------------------------------------
procedure TResizeForm.SetMouseDown( AForm: TForm; ResizeMask: cardinal );
  begin
  anchor_g.Left   := AForm.Left;
  anchor_g.Top    := AForm.Top;
  anchor_g.Right  := AForm.Width;
  anchor_g.Bottom := AForm.Height;
  anchor_c        := Mouse.CursorPos;
  form_ref        := AForm;
  resize_m        := ResizeMask;
  SetCapture( Handle )
  end;

//----------------------------------------------------------------------------
procedure TResizeForm.FormMouseMove(
  Sender: TObject;
  Shift:  TShiftState;
  X, Y:   Integer
  );
  var
    p: TPoint;
    r: TRect;
  begin
  if Assigned( form_ref ) and (ssLeft in Shift)
    then begin
         p := Mouse.CursorPos;
         Dec( p.x, anchor_c.x );
         Dec( p.y, anchor_c.y );

         r.Left   := form_ref.Left;
         r.Top    := form_ref.Top;
         r.Right  := form_ref.Width;
         r.Bottom := form_ref.Height;

         if (resize_m and ResizeMaskLeft)   <> 0 then begin r.Left   := anchor_g.Left   + p.x;  p.x := -p.x end;
         if (resize_m and ResizeMaskTop)    <> 0 then begin r.Top    := anchor_g.Top    + p.y;  p.y := -p.y end;
         if (resize_m and ResizeMaskWidth)  <> 0 then       r.Right  := anchor_g.Right  + p.x;
         if (resize_m and ResizeMaskHeight) <> 0 then       r.Bottom := anchor_g.Bottom + p.y;

         with r do form_ref.SetBounds( Left, Top, Right, Bottom )
         end
  end;

//----------------------------------------------------------------------------
procedure TResizeForm.FormMouseUp(
  Sender: TObject;
  Button: TMouseButton;
  Shift:  TShiftState;
  X, Y:   Integer
  );
  begin
  ReleaseCapture;
  form_ref := nil
  end;

end.

现在，您的应用程序中的任何无边框表单都可以通过挂接到 ResizeForm 来平滑地调整大小，方法是使用一个简单的

ResizeForm.SetMouseDown( self, (sender as TComponent).Tag );

方法将其放置在您用来跟踪无边框表单边缘的任何组件的 MouseDown 事件中。 （请注意 Tag 属性如何用于指示您希望拖动/调整大小的表单边缘）。

哦，并将您的表单设置为 DoubleBuffered = true 以消除任何剩余的闪烁。

这只是我能给你的一点点幸福。