使用 VCL-styles 时，滚动条会导致丑陋的 Window 更新 - 解决方法？

Question

Delphi 版本 10.3.3（社区）。

下面是一个显示不良行为的表单单元。它只有一个按钮和一个滚动框。如果在表单的项目中启用了任何 VCL-style，并且 window 很大，比如最大化，则滚动条滚动会导致 window 的更新延迟，看起来很难看。当使用 mouse-wheel 时，一切都很好。此外，当从滚动框的 StyleElements 中删除 seBorder 时，该行为就消失了。我看到有人抱怨闪烁的帖子，我想这个错误已经被报告过了。

有人知道如何解决这个问题吗？当我查看源代码时，只见树木不见森林:)。

编辑：我在 Listbox-View 中将滚动框设置为原来的 3 倍宽，那样效果更明显。这里有两张截图，第一张来自test-app，第二张来自我的真实应用程序，其中绘画稍微复杂一些。

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.

为了让事情更舒服一点，这里的表格是：

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

Answer 1

好像没有其他人有这个问题。我找到了一个修复程序，虽然不完美，但好多了，所以为了完整起见，这里是我的答案。对所有 space 表示抱歉，感谢所有花时间思考这个问题的人。

通过调用 inherited 和 update 创建一个处理 WM_VScroll 和 WM_HScroll 的 TScrollbox 后代。不作废，不重绘。

可以在表单的 OnCreate，父级设置为窗体。切换滚动选项，也许你会看到不同。

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.

使用 VCL-styles 时，滚动条会导致丑陋的 Window 更新 - 解决方法？

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

delphi

scrollbar

vcl-styles