delphiscrollbarvcl-styles

Scrollbar causes ugly Window update when using VCL-styles - workaround?

Delphi version 10.3.3 (community).

Below is a form unit that displays the unwanted behavior. It only has a button and a scrollbox on it. If any VCL-style is enabled in the form's project, and the window is large, say, maximized, scrolling by scrollbar causes delayed updates of the window, looking unacceptably ugly. When the mouse-wheel is used, all is fine. Also, when seBorder is removed from the scrollbox's StyleElements, the behavior is gone. I've seen posts where people complain about flicker, and I think this bug has been reported already.

Does anybody have an idea how to work around this? When I look at the source code I can't see the forest for trees :).

Edit: I made the scrollbox 3 times as wide in the Listbox-View, the effect is more noticable that way. Here are 2 screenshots, the first is from the test-app, the second from my real app, in which the painting is a bit more complex.

unit UStoryTest;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;

type
  TfrmSTest = class(TForm)
    Scroller: TScrollBox;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure PaintBoxPaint(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ScrollerMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
  private
    { Private declarations }
    Picturelist, Colorlist: TList;
    ScrollerSize: integer;
    Procedure DisplayStoryBoard;
    procedure DisplayListbox;
  public
    { Public declarations }
  end;

var
  frmSTest: TfrmSTest;

implementation

{$R *.dfm}

procedure TfrmSTest.Button1Click(Sender: TObject);
begin
  if Scroller.Align = alRight then

    DisplayStoryBoard
  else
    DisplayListbox;
end;

procedure TfrmSTest.DisplayStoryBoard;
var
  i, x, dx: integer;
  aP: TPaintbox;
begin
  for i := 0 to Picturelist.Count - 1 do
    TControl(Picturelist[i]).Parent := nil;
  Scroller.Align := alNone;
  Scroller.Height := MulDiv(ScrollerSize,Monitor.PixelsPerInch,96);
  Scroller.VertScrollBar.Visible := false;
  Scroller.HorzScrollBar.Visible := true;
  Scroller.AutoScroll := true;
  Scroller.HorzScrollBar.Tracking := true;
  Scroller.Align := alBottom;
  dx := 10;
  x := dx - Scroller.HorzScrollBar.Position;
  Scroller.DisableAlign;
  for i := 0 to Picturelist.Count - 1 do
  begin
    aP := TPaintbox(Picturelist[i]);
    aP.Parent := Scroller;
    aP.SetBounds(x, dx, aP.Width, aP.Height);
    x := x + aP.Width + dx;
  end;
  Scroller.EnableAlign;
  Scroller.Invalidate;
end;

procedure TfrmSTest.DisplayListbox;
var
  i, x, y, dx: integer;
  aP: TPaintbox;
begin
  for i := 0 to Picturelist.Count - 1 do
    TControl(Picturelist[i]).Parent := nil;
  Scroller.Align := alNone;
  Scroller.Width := MulDiv(3*ScrollerSize,Monitor.PixelsPerInch,96);
  Scroller.HorzScrollBar.Visible := false;
  Scroller.VertScrollBar.Visible := true;
  Scroller.AutoScroll := true;
  Scroller.VertScrollBar.Tracking := true;
  Scroller.Align := alRight;
  dx := 10;
  y := dx - Scroller.VertScrollBar.Position;
  Scroller.DisableAlign;
  x := dx;
  for i := 0 to Picturelist.Count - 1 do
  begin
    aP := TPaintbox(Picturelist[i]);
    aP.Parent := Scroller;
    aP.SetBounds(x, y, aP.Width, aP.Height);
    x := x + aP.Width + dx;
    if x + aP.Width > Scroller.Width then
    begin
      x := dx;
      y := y + aP.Height + dx
    end;
  end;
  Scroller.EnableAlign;
  Scroller.Invalidate;
end;

procedure TfrmSTest.FormCreate(Sender: TObject);
var
  i: integer;
  aP: TPaintbox;
begin
  Picturelist := TList.Create;
  Colorlist := TList.Create;
  ScrollerSize:=200;
  for i := 0 to 120 do
  begin
    aP := TPaintbox.Create(self);
    aP.Height := ScrollerSize - 40;
    aP.Width := aP.Height;
    aP.OnPaint := PaintBoxPaint;
    aP.Tag := i;
    Picturelist.Add(aP);
    Colorlist.Add(Pointer(RGB(random(255), random(255), random(255))));
  end;
end;

procedure TfrmSTest.FormDestroy(Sender: TObject);
begin
  Picturelist.Free;
  Colorlist.Free;
end;

procedure TfrmSTest.FormShow(Sender: TObject);
begin
  DisplayStoryBoard;
end;

procedure TfrmSTest.PaintBoxPaint(Sender: TObject);
var
  aP: TPaintbox;
begin
  if Sender is TPaintbox then
  begin
    aP := TPaintbox(Sender);
    aP.Canvas.Brush.Color := TColor(Colorlist[aP.Tag]);
    aP.Canvas.Pen.Color := clLime;
    aP.Canvas.Rectangle(aP.ClientRect);
    aP.Canvas.Font.Color := clWhite;
    aP.Canvas.Font.Style := [fsBold];
    aP.Canvas.TextOut(3, 3, IntToStr(aP.Tag));
  end;
end;

procedure TfrmSTest.ScrollerMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var SB: TControlScrollbar;
begin
  if (Scroller.Align=alBottom) then
  SB:=Scroller.HorzScrollBar
  else
  SB:=Scroller.VertScrollBar;
  SB.Position:=SB.Position-WheelDelta;
  Handled:=true;
end;

initialization

ReportMemoryLeaksOnShutDown := true;

end.

To make things a little more comfortable here is the form:

object frmSTest: TfrmSTest
  Left = 0
  Top = 0
  Caption = 'frmSTest'
  ClientHeight = 291
  ClientWidth = 505
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object Scroller: TScrollBox
    Left = 0
    Top = 98
    Width = 505
    Height = 193
    Align = alBottom
    DoubleBuffered = False
    ParentDoubleBuffered = False
    TabOrder = 0
    OnMouseWheel = ScrollerMouseWheel
    ExplicitLeft = 2
  end
  object Button1: TButton
    Left = 8
    Top = 8
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 1
    OnClick = Button1Click
  end
end
Solution

  • Seems like nobody else has this problem. I found a fix, not perfect, but a lot better, so for completeness' sake here is my answer. Sorry about all the space, and thanks to all who took the time to think about this.

    Make a TScrollbox descendant that handles WM_VScroll and WM_HScroll by calling inherited and then update. Not invalidate, not repaint.

    The scrollbox can be created in the form's OnCreate, parent set to the form. Toggle the Scrolloption, maybe you see a difference.

    interface

type
  TScrolloption = (soVCL, soNew);

TStyleScroller = class(TScrollbox)
  private
  protected
    procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
    procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL;
  public
    Scrolloption: TScrolloption;
    Constructor Create(AOwner: TComponent); override;
  end;

implementation

{ TStyleScroller }

constructor TStyleScroller.Create(AOwner: TComponent);
begin
  inherited;
  Scrolloption := soNew;
end;

procedure TStyleScroller.WMHScroll(var Msg: TWMHScroll);
begin
  inherited;
  if Scrolloption = soNew then
    update;
end;

procedure TStyleScroller.WMVScroll(var Msg: TWMVScroll);
begin
  inherited;
  if Scrolloption = soNew then
    update;
end;

end.