问题
I am trying to resize a borderless form but when I increase the size using the right/bottom side, I get a gap between the border and the old client area that depends of the speed you move the mouse.
The effect is more noticeable when you resize from the left border or even from the bottomleft corner, it's horrible everywhere (I tried with other commercial apps and it happens as well). This effect happens as well when I change to sizable border, but it's not as awful as when I remove form borders
The form layout consists in a top panel doing the title bar function (with some tImages and buttons), and some other panels showing other info (like a memo, other controls, etc)
There's a snip of my code where I capture the mouse button and send a message to windows, but I also tried to do it manually with the similar results
Activating the double buffer for the top panel avoids flickering, but resizing the panel is not synchronized with form resizing, thus appearing a gap, or part of the panel disapearing
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;
How could I avoid that area and/or force windows to be redrawn? I am using Delphi but a generic solution (or in other language) or even a direction to go forward would be fine for me
Thank you in advance
回答1:
Last time I attempted to manually make a top level window that resizes via WM_SYSCOMMAND and mouse drag, whether involving any nested panels or no, I found the problems were not limited only to flicker.
Even with a bare-TForm without a resizeable border, adding my own resizeable border and handling the mouse down and mouse move and mouse up messages directly proved too problematic. I gave up on the code-approach you are showing here, and instead I found two workable approaches:
use an approach where I take over the painting of the non-client areas. This is what Google Chrome and many other fully-custom windows do. You still have a nonclient area and it's up to you to paint it and handle the non-client and border paint. In other words, it's not truly borderless, but it could all be a single color, if you wanted it to be. Read this help about WM_NCPAINT messages, to get started.
Use a borderless resizeable window that still gets recognized (even without its nonclient area as a resizeable window. Think of a post-it-note-applet. Here is a question I asked a while ago, at the bottom of my question is a fully working demo that provides a smooth flicker free way to have a borderless resizeable window. The underlying technique for the answer was provided by David H.
回答2:
Well, Warren P already pretty convincingly pointed you in another direction, but I'll try to answer your question. Or not really.
Your edit makes the question very clear now:
The effect is more noticeable when you resize from the left border or even from the bottomleft corner, it's horrible everywhere (I tried with other commercial apps and it happens as well). This effect happens as well when I change to sizeable border, but it's not as awful as when I remove the border.
Not only other commercial applications, but also every OS window manifests this effect. Stretching the top of an Explorer window also "hides" and "expands" the status bar or bottom panel. I am pretty sure it cannot be defeated.
It may seem worse for a borderless form, but I think that is just optical deception.
If I had to take a guess at explaining this effect, then I would say that during the resize operation, the update of top and left takes precedence over that of width and height, which results in both not being updated an equal amount of times. Maybe it is graphics card related. Or maybe, ...hell what am I talking about? This is way out of my reach.
Though, I still can not reproduce it for resizing the right and/or bottom of the form. If the amount of controls or (the combination of) their align and anchor properties is a problem, then you could consider temporarily disabling align all together, but I am almost sure you do not want that either. Below is my test code, copied from the question, slightly changed and of course with Sertac's constants added:
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;
Concerning your top aligned panel: try setting Align = alCustom and Anchors = [akLeft, akTop, akRight], though the enhancement may depend on the panel having a different color from that of the form, or maybe on me being optical deceived. ;)
回答3:
Have you tried setting the form to DoubleBuffered := True?
回答4:
I know this thread is fairly old, but it is one that people still struggle with.
The answer is simple, though. The problem is that trying to do resize stuff makes you want to use the form you are resizing as a reference. Don't do that.
Use another form.
Here is the complete source for a TForm that can help you. Make sure that this form has BorderStyle = bsNone. You probably also want to make sure it is not visible.
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.
Now any borderless form in your application can be smoothly resized by hooking into ResizeForm with a simple
ResizeForm.SetMouseDown( self, (sender as TComponent).Tag );
A good place to put that is in the MouseDown event of whatever component(s) you are using to track the edges of your borderless form(s). (Notice how the Tag property is used to indicate what edge of your form you wish to drag/resize).
Oh, and set your form to DoubleBuffered = true to get rid of any remaining flicker.
This is just a small happiness I can give to you.
来源：https://stackoverflow.com/questions/6652655/smooth-resizing-in-a-borderless-form-window-in-delphi