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