Smooth resizing in a borderless form/window in Delphi

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

Warren P

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.

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. ;)

Have you tried setting the form to DoubleBuffered := True?

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

标签

forms

Delphi

resize

smooth

borderless