Question

There's a problem with the TScrollBox in Delphi 5 when using Cirtix, on some systems, when a user scrolls by clicking the button at the top or bottom of the end of scrollbar the whole application freezes. We had the issue in QucikReports previews initially and got round it by implementing our own scrollbars in the TScrollBox.

We now have a piece of bespoke work that uses a TScrollBox and the client is reporting a similar problem so I'm working round it in the same way. I hide the TScrollBox scrollbars and add in my own. When those are clicked I call the following.

Note, this test code is not currently running in Citrix, I've tested on XP and Window 7.

I am turning off redrawing of the control, moving all the child controls, then turning drawing back on and calling Invalidate. I would expect invalidate to fully redraw the control but that's not happening.

procedure TScrollBoxScrollReplacement.ScrollControls(x: Integer; y: Integer);
var
  I: Integer;
begin
  if (x = 0) and (y = 0) then
    Exit;

  // Stop the control from repaining while we're updating it
  try
    SendMessage(FScrollBox.Handle, WM_SETREDRAW, 0, 0);

    for I := 0 to FScrollBox.ControlCount - 1 do
    begin
      if (FScrollBox.Controls[I] = FVScrollBar) or (FScrollBox.Controls[I] = FHScrollBar) then
        Continue;

      FScrollBox.Controls[I].Left := FScrollBox.Controls[I].Left + x;
      FScrollBox.Controls[I].Top := FScrollBox.Controls[I].Top + y;
    end;

  finally
    // Turn on painting again
    SendMessage(FScrollBox.Handle, WM_SETREDRAW, 1, 0);
  end;
  // Redraw everything
  InvalidateEverything(FScrollBox);
end;

Code to redraw controls

procedure TScrollBoxScrollReplacement.InvalidateEverything(AControl: TControl);
var
  I: Integer;
begin
  AControl.Invalidate();

  if (AControl is TWinControl) then
    for I := 0 to TWinControl(AControl).ControlCount - 1 do
      InvalidateEverything(TWinControl(AControl).Controls[I]);
end;

I added in the Invalidate, Refresh and Reapint and loop through all child controls in an effort to get it working, but still no luck. The edit boxes look as follows:

enter image description here

If I set Visible to false and back to true then they'll redraw correctly, but there is obviously a horrible flicker. They also redraw correctly if I minimise the maximise the window, or drag it off and on the screen.

Any help would be much appreciated.

edit : Some info about the answers.

Users looking for a solution, I'd recommend you try both. David's and Sertac's. David's looks like it is the correct solution according to Microsoft's documentation. However, with the Delphi scrollbox, labels placed directly in the scrollbox flicker, where are labels placed in groupboxes in the scrollbox are perfectly smooth. I think this might be an issue with all components that don't descend from TWinControl. Scrolling itself is smoother with David's solution, but there's less flicking using WM_SETREDRAW and RedrawWindow. I would have liked to accept both as answers as both have their advantages and disadvantages.

edit : Code for the whole class below To test just add a scrollbox with some controls to your form and call

TScrollBoxScrollReplacement.Create(ScrollBox1);

.

unit ScrollBoxScrollReplacement;

interface

uses extctrls, stdctrls, SpScrollBox, forms, Controls, classes, Messages, Windows, Sysutils, Math;

type
  TScrollBoxScrollReplacement = class(TComponent)
  private
    FLastVScrollPos: Integer;
    FLastHScrollPos: Integer;
    FScrollBox: TScrollBox;
    FVScrollBar: TScrollBar;
    FHScrollBar: TScrollBar;
    FVScrollBarVisible: Boolean;
    FHScrollBarVisible: Boolean;
    FCornerPanel: TPanel;
    FMaxRight: Integer;
    FMaxBottom: Integer;
    FOriginalResizeEvent: TNotifyEvent;
    FOriginalCanResizeEvent: TCanResizeEvent;
    FInScroll: Boolean;
    function GetHScrollHeight: Integer;
    function GetVScrollWidth: Integer;
    procedure ReplaceScrollBars;
    function SetUpScrollBar(AControlScrollBar: TControlScrollBar; AKind: TScrollBarKind): TScrollBar;
    procedure ScrollBoxResize(Sender: TObject);
    procedure ScrollBarEnter(Sender: TObject);
    procedure PositionScrollBars;
    procedure Scroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
    procedure ScrollControls(x, y: Integer);
    procedure CalculateControlExtremes();
    procedure ResetVScrollBarRange;
    procedure ResetHScrollBarRange;
    function IsReplacementControl(AControl: TControl): Boolean;
    property HScrollHeight: Integer read GetHScrollHeight;
    property VScrollWidth: Integer read GetVScrollWidth;
    procedure ScrollBoxCanResize(Sender: TObject; var NewWidth,
      NewHeight: Integer; var Resize: Boolean);
  public
    constructor Create(AScrollBox: TScrollBox); reintroduce; overload;
    destructor Destroy(); override;
    procedure ResetScrollBarRange();
    procedure BringReplacementControlsToFront();
  end;

implementation

{ TScrollBoxScrollReplacement }

constructor TScrollBoxScrollReplacement.Create(AScrollBox: TScrollBox);
begin
  // Set up the scrollbox as our owner so we're destroyed when the scrollbox is
  inherited Create(AScrollBox);

  FScrollBox := AScrollBox;
  ReplaceScrollBars();

  // We make a note of any existing resize and can resize events so we can call them to make sure we don't break anything
  FOriginalResizeEvent := FScrollBox.OnResize;
  FScrollBox.OnResize := ScrollBoxResize;

  FOriginalCanResizeEvent := FScrollBox.OnCanResize;
  FScrollBox.OnCanResize := ScrollBoxCanResize;
end;

// This is called (unintuitively) when controls are moved within the scrollbox. We can use this to reset our scrollbar ranges

procedure TScrollBoxScrollReplacement.ScrollBoxCanResize(Sender: TObject; var NewWidth,
  NewHeight: Integer; var Resize: Boolean);
begin
  if (not FInScroll) then
  begin
    ResetScrollBarRange();
    BringReplacementControlsToFront();
  end;

  if (Assigned(FOriginalCanResizeEvent)) then
    FOriginalCanResizeEvent(Sender, NewWidth, NewHeight, Resize);
end;


procedure TScrollBoxScrollReplacement.ScrollBoxResize(Sender: TObject);
begin
  if (Assigned(FOriginalResizeEvent)) then
    FOriginalResizeEvent(Sender);

  ResetScrollBarRange();
end;

// Hides the original scrollbars and adds in ours

procedure TScrollBoxScrollReplacement.ReplaceScrollBars();
begin
  FVScrollBar := SetUpScrollBar(FScrollBox.VertScrollBar, sbVertical);
  FVScrollBarVisible := FVScrollBar.Visible;
  FHScrollBar := SetUpScrollBar(FScrollBox.HorzScrollBar, sbHorizontal);
  FHScrollBarVisible := FHScrollBar.Visible;

  FCornerPanel := TPanel.Create(FScrollBox);
  FCornerPanel.Parent := FScrollBox;

  ResetScrollBarRange();
end;


procedure TScrollBoxScrollReplacement.PositionScrollBars();
begin
  // Align our scrollbars correctly
  FVScrollBar.Top := 0;
  FVScrollBar.Left := FScrollBox.ClientWidth - FVScrollBar.Width;
  FVScrollBar.Height := FScrollBox.ClientHeight - HScrollHeight;
  //  FVScrollBar.BringToFront();

  FHScrollBar.Left := 0;
  FHScrollBar.Top := FScrollBox.ClientHeight - FHScrollBar.Height;
  FHScrollBar.Width := FScrollBox.ClientWidth - VScrollWidth;
  //  FHScrollBar.BringToFront();

    // If both scrollbars are visible we'll put a panel in the corner so we can't see components through it
  if (FVScrollBar.Visible) and (FHScrollBar.Visible) then
  begin
    FCornerPanel.Left := FHScrollBar.Width;
    FCornerPanel.Top := FVScrollBar.Height;
    FCornerPanel.Width := FVScrollBar.Width;
    FCornerPanel.Height := FHScrollBar.Height;
    FCornerPanel.Visible := True;
    //    FCornerPanel.BringToFront();
  end
  else
    FCornerPanel.Visible := False;
end;


procedure TScrollBoxScrollReplacement.ResetScrollBarRange();
begin
  CalculateControlExtremes();

  ResetVScrollBarRange();
  ResetHScrollBarRange();

  PositionScrollBars();
end;

procedure TScrollBoxScrollReplacement.ResetVScrollBarRange();
var
  ScrollMax: Integer;
  ScrollAmount: Integer;
begin
  // If all the controls fit to the right of the screen, but there are controls off the left then we'll scroll right.
  ScrollMax := FMaxBottom - FScrollBox.ClientHeight + FHScrollBar.Height;
  if (ScrollMax < 0) and (FLastVScrollPos > 0) then
  begin
    ScrollAmount := Min(Abs(ScrollMax), FLastVScrollPos);
    ScrollControls(0, ScrollAmount);
    FLastVScrollPos := FLastVScrollPos - ScrollAmount;
    CalculateControlExtremes();
  end;

  FVScrollBar.Max := Max(FMaxBottom - FScrollBox.ClientHeight + FHScrollBar.Height + FLastVScrollPos, 0);
  FVScrollBar.Visible := (FVScrollBar.Max > 0) and FVScrollBarVisible;
end;


procedure TScrollBoxScrollReplacement.ResetHScrollBarRange();
var
  ScrollMax: Integer;
  ScrollAmount: Integer;
begin
  // If all the controls fit to the bottom of the screen, but there are controls off the top then we'll scroll up.
  ScrollMax := FMaxRight - FScrollBox.ClientWidth + FVScrollBar.Width;
  if (ScrollMax < 0) and (FLastHScrollPos > 0) then
  begin
    ScrollAmount := Min(Abs(ScrollMax), FLastHScrollPos);
    ScrollControls(ScrollAmount, 0);
    FLastHScrollPos := FLastHScrollPos - ScrollAmount;
    CalculateControlExtremes();
  end;

  FHScrollBar.Max := Max(FMaxRight - FScrollBox.ClientWidth + FVScrollBar.Width + FLastHScrollPos, 0);
  FHScrollBar.Visible := (FHScrollBar.Max > 0) and FHScrollBarVisible;
end;


function TScrollBoxScrollReplacement.SetUpScrollBar(AControlScrollBar: TControlScrollBar; AKind: TScrollBarKind): TScrollBar;
begin
  Result := TScrollBar.Create(FScrollBox);
  Result.Visible := AControlScrollBar.Visible;
  Result.Parent := FScrollBox;
  Result.Kind := AKind;
  Result.Ctl3D := False;
  Result.Max := AControlScrollBar.Range;
  Result.OnEnter := ScrollBarEnter;
  Result.OnScroll := Scroll;
  Result.SmallChange := 5;
  Result.LargeChange := 20;

  AControlScrollBar.Visible := False;
end;

destructor TScrollBoxScrollReplacement.Destroy;
begin
  inherited;
end;

procedure TScrollBoxScrollReplacement.ScrollBarEnter(Sender: TObject);
begin
  // We just call this here to make sure our ranges are set correctly - a backup in case things go wrong
  ResetScrollBarRange();
end;

procedure TScrollBoxScrollReplacement.Scroll(Sender: TObject;
  ScrollCode: TScrollCode; var ScrollPos: Integer);
var
  Change: Integer;
begin
  ResetScrollBarRange();

  if (Sender = FVScrollBar) then
  begin
    Change := FLastVScrollPos - ScrollPos;
    ScrollControls(0, Change);
    FLastVScrollPos := ScrollPos;
  end
  else if (Sender = FHScrollBar) then
  begin
    Change := FLastHScrollPos - ScrollPos;
    ScrollControls(Change, 0);
    FLastHScrollPos := ScrollPos;
  end;
end;

// Moves all the controls in the scrollbox except for the scrollbars we've added

{procedure TScrollBoxScrollReplacement.ScrollControls(x: Integer; y: Integer);
var
  I: Integer;
begin
  if (x = 0) and (y = 0) then
    Exit;

  // Stop the control from repaining while we're updating it
  SendMessage(FScrollBox.Handle, WM_SETREDRAW, 0, 0);
  FInScroll := True;
  try
    for I := 0 to FScrollBox.ControlCount - 1 do
    begin
      if IsReplacementControl(FScrollBox.Controls[I]) then
        Continue;

      FScrollBox.Controls[I].Left := FScrollBox.Controls[I].Left + x;
      FScrollBox.Controls[I].Top := FScrollBox.Controls[I].Top + y;
    end;

  finally
    // Turn on painting again
    FInScroll := False;
    SendMessage(FScrollBox.Handle, WM_SETREDRAW, 1, 0);
  end;

  // Redraw everything
  RedrawWindow(FSCrollBox.Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_ALLCHILDREN);
end;  }


procedure TScrollBoxScrollReplacement.ScrollControls(x: Integer; y: Integer);
var
  I: Integer;
  Control: TControl;
  WinControl: TWinControl;
  hWinPosInfo: HDWP;
begin
  if (x = 0) and (y = 0) then
    Exit;

  hWinPosInfo := BeginDeferWindowPos(0);
  Win32Check(hWinPosInfo<>0);
  try
    for I := 0 to FScrollBox.ControlCount - 1 do
    begin
      Control := FScrollBox.Controls[I];
      if (Control = FVScrollBar) or (Control = FHScrollBar) then
        Continue;
      if Control is TWinControl then
      begin
        WinControl := FScrollBox.Controls[I] as TWinControl;
        hWinPosInfo := DeferWindowPos(
          hWinPosInfo,
          WinControl.Handle,
          0,
          WinControl.Left + x,
          WinControl.Top + y,
          WinControl.Width,
          WinControl.Height,
          SWP_NOZORDER or SWP_NOOWNERZORDER or SWP_NOACTIVATE
        );
        Win32Check(hWinPosInfo<>0);
      end
      else
        Control.SetBounds(Control.Left + x, Control.Top + y, Control.Width, Control.Height);
    end;
  finally
    EndDeferWindowPos(hWinPosInfo);
  end;
end;



// works out where our right most and bottom most controls are so we can set the scrollbars correctly

procedure TScrollBoxScrollReplacement.CalculateControlExtremes();
var
  I: Integer;
  Right: Integer;
  Bottom: Integer;
begin
  FMaxRight := 0;
  FMaxBottom := 0;
  for I := 0 to FScrollBox.ControlCount - 1 do
  begin
    if IsReplacementControl(FScrollBox.Controls[I]) then
      Continue;

    Right := FScrollBox.Controls[I].Left + FScrollBox.Controls[I].Width;
    Bottom := FScrollBox.Controls[I].Top + FScrollBox.Controls[I].Height;

    FMaxRight := Max(FMaxRight, Right);
    FMaxBottom := Max(FMaxBottom, Bottom);
  end;
end;

function TScrollBoxScrollReplacement.GetHScrollHeight: Integer;
begin
  if (FHScrollBar.Visible) then
    Result := FHScrollBar.Height
  else
    Result := 0;
end;

function TScrollBoxScrollReplacement.GetVScrollWidth: Integer;
begin
  if (FVScrollBar.Visible) then
    Result := FVScrollBar.Width
  else
    Result := 0;
end;

// Returns true if the passed control is one of the controls we've added

function TScrollBoxScrollReplacement.IsReplacementControl(
  AControl: TControl): Boolean;
begin
  Result := (AControl = FVScrollBar) or (AControl = FHScrollBar) or (AControl = FCornerPanel);
end;

procedure TScrollBoxScrollReplacement.BringReplacementControlsToFront;
begin
  FVScrollBar.BringToFront();
  FHScrollBar.BringToFront();
  FCornerPanel.BringToFront();
end;

end.
Was it helpful?

Solution

I found that your code started working once I remove the two WM_SETREDRAW messages. That's your fundamental problem. You will need to remove the WM_SETREDRAW messages.

That will no doubt mean you still need to solve your problem with flickering, but that's a different problem. My quick experiments suggest that DeferWindowPos could solve that problem. For example:

procedure TScrollBoxScrollReplacement.ScrollControls(x: Integer; y: Integer);
var
  I: Integer;
  Control: TControl;
  WinControl: TWinControl;
  hWinPosInfo: HDWP;
begin
  if (x = 0) and (y = 0) then
    Exit;

  hWinPosInfo := BeginDeferWindowPos(0);
  Win32Check(hWinPosInfo<>0);
  try
    for I := 0 to FScrollBox.ControlCount - 1 do
    begin
      Control := FScrollBox.Controls[I];
      if (Control = FVScrollBar) or (Control = FHScrollBar) then
        Continue;
      if Control is TWinControl then
      begin
        WinControl := FScrollBox.Controls[I] as TWinControl;
        hWinPosInfo := DeferWindowPos(
          hWinPosInfo,
          WinControl.Handle,
          0,
          WinControl.Left + x,
          WinControl.Top + y,
          WinControl.Width,
          WinControl.Height,
          SWP_NOZORDER or SWP_NOOWNERZORDER or SWP_NOACTIVATE
        );
        Win32Check(hWinPosInfo<>0);
      end
      else
        Control.SetBounds(Control.Left + x, Control.Top + y, Control.Width, Control.Height);
    end;
  finally
    EndDeferWindowPos(hWinPosInfo);
  end;
end;

Your non-windowed controls will still flicker, but you can make them windowed, or indeed put the whole content of the scroll box inside a windowed control. Heck, if you just did that, it would be enough to solve the problem!

For what it is worth, my trials indicate that DeferWindowPos gives smoother scrolling than WM_SETREDRAW and RedrawWindow. But these tests were hardly exhaustive and you might find different outcomes in your app.


Some asides regarding your code:

Your use of try/finally is incorrect. The pattern must be:

BeginSomething;
try
  Foo;
finally
  EndSomething;
end;

You get that wrong with your calls to SendMessage.

And you use an incorrect cast in InvalidateEverything. You cannot blindly cast a TControl to TWinControl. That said, that function does no good. You can remove it altogether. What it is attempting to do can be performed with a single call to Invalidate of the parent control.

OTHER TIPS

You can replace your

FScrollBox.Invalidate();

with

RedrawWindow(FSCrollBox.Handle, nil, 0,
    RDW_ERASE or RDW_INVALIDATE or RDW_ALLCHILDREN);

to have all controls invalidated and updated properly. RDW_ERASE is for erasing the previous positions of controls and RDW_ALLCHILDREN is for taking care of windowed controls inside. Non-win controls like labels should already be repainted because of RDW_INVALIDATE.

Although this approach may help avoiding the flicker that you observe, it may also cause some loss of smoothness of scrolling while thumb tracking. That's because the scroll position might need to be updated more often than a paint cycle is processed. To circumvent this, instead of invalidating you can update the control positions immediately:

RedrawWindow(FSCrollBox.Handle, nil, 0,
    RDW_ERASE or RDW_INVALIDATE or RDW_UPDATENOW or RDW_ALLCHILDREN);
Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top