Smooth resizing in a borderless form/window in Delphi

前端 未结 4 1905
难免孤独
难免孤独 2021-01-18 17:00

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

相关标签:
4条回答
  • 2021-01-18 17:36

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

    0 讨论(0)
  • 2021-01-18 17:51

    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.

    0 讨论(0)
  • 2021-01-18 17:59

    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:

    1. 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.

    2. 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.

    0 讨论(0)
  • 2021-01-18 17:59

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

    0 讨论(0)
提交回复
热议问题