在德尔福的无边界窗体/窗口中平滑调整大小

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; 

我该如何避免该区域和/或强制窗口被重绘？我使用德尔福而是一个通用的解决方案（或其他语言），甚至一个方向往前走就可以了，我

预先感谢您

Answer 1

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

即使使用没有可调整边界的裸TForm，添加我自己的可调整大小的边框并向下处理鼠标并直接移动并鼠标移动消息也证明存在问题。我放弃了你在这里展示的代码的方法，而是我发现了两个可行的办法：

1. 使用的方法，我接手非客户区绘画。这就是Google Chrome和许多其他完全自定义窗口所做的。您仍然有一个非客户端区域，由您来绘制并处理非客户端和边框颜色。换句话说，它不是真正的无边界，但它可以都是单一的颜色，如果你想要它。阅读此help about WM_NCPAINT messages，开始。

2. 使用仍然得到认可（即使没有它的非工作区作为一个可调整大小的窗口，一个无国界的可调整大小的窗口。想想后它音符的小程序的。Here是我提出的问题前一段时间，在底部我的问题是一个完全工作演示，能够提供流畅，无闪烁的方式有一个无国界的可调整大小的窗口。为答案的基础技术是由大卫H.提供

Answer 2

您是否尝试过的形式设置为DoubleBuffered := True？

Answer 3

好，沃伦·P已经相当令人信服地指出你的另一个方向，但我会试着回答你的问题，或者不是真的。

你的编辑，使这个问题很清楚现在：

效果更明显，当你从左侧边界调整，甚至从BOTTOMLEFT角落，这是可怕的无处不在（我试着与其他商业应用程序和它也发生了）。当我切换到相当大的边框时，也会发生这种效果，但这并不像删除边框时那么糟糕。

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

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

如果我不得不猜测解释这种效果，那么我会说在调整大小操作期间，顶部和左侧的更新优先于宽度和高度的更新，这导致两者不会被更新为相等次数。也许它是与显卡有关的。或者，也许......地狱我在说什么？这是我无法接触的方式。

虽然，我仍然无法重新调整它的权利和/或形式的底部。如果控件的数量或者它们的对齐和锚定属性（的组合）是一个问题，那么你可以考虑暂时禁用所有对齐，但我几乎可以肯定你不想要那样做。下面是我的测试代码，从问题的复制，略有变化，当然与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 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); 

一个好地方，把那个是什么成分（S）的MouseDown事件调整你正在用于跟踪无边界窗体的边缘。 （请注意标签属性用于指示您想要拖动/调整大小的表单的边缘）。

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

这只是一个小幸福，我可以给你。