在德爾福的無邊界窗體/窗口中平滑調整大小

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以擺脫任何剩餘的閃爍。

這只是一個小幸福，我可以給你。