Question

我正在尝试调整无边框形状的大小，但是当我使用右侧/底部增加大小时，我会在边框和旧客户区之间产生间隙，这取决于您移动鼠标的速度。

当你从左边框或从左下角调整大小时效果更明显，到处都是可怕的（我尝试过其他商业应用程序，它也会发生）。当我改变为相当大的边框时，也会发生这种效果，但它并不像我删除表格边框那样糟糕

表单布局包含一个顶部面板，用于执行标题栏功能（带有一些tImages和按钮），还有一些其他面板显示其他信息（如备忘录，其他控件等）

我的代码中有一段我捕获鼠标按钮并向Windows发送消息，但我也试图用类似的结果手动完成

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

 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，添加我自己的可调整大小的边框并处理鼠标，鼠标移动和鼠标移动消息直接证明是有问题的。我放弃了你在这里展示的代码方法，而是找到了两种可行的方法：

使用一种方法来接管非客户区域的绘画。这就是谷歌Chrome和许多其他完全自定义的窗口。您仍然有一个非客户区域，由您来绘制它并处理非客户端和边框绘制。换句话说，它不是真正的无边框，但如果你想要的话，它可能都是单一的颜色。请阅读此help about WM_NCPAINT messages，开始使用。
使用仍然可以识别的无边框可调整大小的窗口（即使没有非客户区域作为可调整大小的窗口。想想一个post-it-note-applet。Here是我刚问过的一个问题，在我的问题的底部是一个完全工作的演示，提供了一个平滑的无闪烁方式，以无边框可调整窗口。答案的基础技术由大卫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 以消除任何剩余的闪烁。

这只是我能给你的一点点快乐。

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

4 个答案: