我的自定义控件闪烁。是什么原因造成的，我该如何消除它？

Question

简介

我正在编写一个派生自 TScrollBox 的自定义控件，但我在克服看似应该很容易解决的问题时遇到了一些困难。

该控件将用于在顶部显示一个静态的标题栏（即，当滚动框滚动时从不移动），然后在标题栏下方我将在自己的列中绘制一些值例如行号等

这是控件目前的样子，可以提供更好的想法（非常早期的工作正在进行中）：

闪烁问题

我面临的问题是闪烁，我没有找到消除它的简单方法。我感觉闪烁是因为我试图在我的标题栏下方绘制，当闪烁发生时，您实际上可以看到在标题栏下方绘制的值，尽管我的假设可能是完全错误的。

所有的绘图都是在 TGraphicControl 上完成的，它是 child 滚动框，快速滚动时闪烁很多，当使用滚动条按钮时它仍然闪烁但不那么频繁。

我无法捕捉到闪烁并在此处显示为图像，但是您可以使用下面的代码构建并安装到新包中并自行测试：

unit MyGrid;

interface

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

type
  TMyCustomGrid = class(TGraphicControl)
  private
    FFont: TFont;
    FRowNumbers: TStringList;
    FRowCount: Integer;
    FCaptionBarRect: TRect;
    FRowNumbersBackgroundRect: TRect;
    FValuesBackgroundRect: TRect;

    procedure CalculateNewHeight;
    function GetMousePosition: TPoint;
    function RowIndexToMousePosition(ARowIndex: Integer): Integer;
    function GetRowHeight: Integer;
    function RowExists(ARowIndex: Integer): Boolean;
    function GetRowNumberRect(ARowIndex: Integer): TRect;
    function GetRowNumberTextRect(ARowIndex: Integer): TRect;
    function GetValueRect(ARowIndex: Integer): TRect;
    function GetValueTextRect(ARowIndex: Integer): TRect;
    function GetFirstVisibleRow: Integer;
    function GetLastVisibleRow: Integer;
  protected
    procedure Paint; override;

    procedure DrawCaptionBar;
    procedure DrawRowNumbers;
    procedure DrawValues;
    procedure DrawColumnLines;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

  TMyGrid = class(TScrollBox)
  private
    FGrid: TMyCustomGrid;
  protected
    procedure Loaded; override;
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

const
  FCaptionBarHeight = 20;
  FRowNumbersWidth  = 85;
  FValuesWidth      = 175;
  FTextSpacing      = 5;

implementation

constructor TMyCustomGrid.Create(AOwner: TComponent);
var
  I: Integer;
begin
  inherited Create(AOwner);

  FFont        := TFont.Create;
  FFont.Color  := clBlack;
  FFont.Name   := 'Tahoma';
  FFont.Size   := 10;
  FFont.Style  := [];

  FRowNumbers := TStringList.Create;

  //FOR TEST PURPOSES
  for I := 0 to 1000 do
  begin
    FRowNumbers.Add(IntToStr(I));
  end;

  Canvas.Font.Assign(FFont);
end;

destructor TMyCustomGrid.Destroy;
begin
  FFont.Free;
  FRowNumbers.Free;
  inherited Destroy;
end;

procedure TMyCustomGrid.Paint;
begin
  FCaptionBarRect := Rect(0, 0, Self.Width, GetRowHeight + TMyGrid(Self.Parent).VertScrollBar.Position + 2);
  FRowCount       := FRowNumbers.Count;

  DrawRowNumbers;
  DrawValues;
  DrawCaptionBar;
  DrawColumnLines;
end;

procedure TMyCustomGrid.DrawCaptionBar;
var
  R: TRect;
  S: string;
begin
  {background}
  Canvas.Brush.Color  := clSkyBlue;
  Canvas.Brush.Style  := bsSolid;
  Canvas.FillRect(FCaptionBarRect);

  {text}
  Canvas.Brush.Style := bsClear;
  R := Rect(FTextSpacing, FCaptionBarRect.Top + TMyGrid(Self.Parent).VertScrollBar.Position, FRowNumbersWidth - FTextSpacing, FCaptionBarRect.Bottom);
  S := 'Row No.';
  DrawText(Canvas.Handle, PChar(S), Length(S), R, DT_LEFT or DT_SINGLELINE or DT_VCENTER);

  R := Rect(FTextSpacing + FRowNumbersWidth, FCaptionBarRect.Top + TMyGrid(Self.Parent).VertScrollBar.Position, FValuesWidth - FTextSpacing, FCaptionBarRect.Bottom);
  S := 'Item No.';
  DrawText(Canvas.Handle, PChar(S), Length(S), R, DT_LEFT or DT_SINGLELINE or DT_VCENTER);
end;

procedure TMyCustomGrid.DrawRowNumbers;
var
  I, Y: Integer;
  R: TRect;
  S: string;
begin
  {background}
  FRowNumbersBackgroundRect := Rect(0, FCaptionBarRect.Bottom, FRowNumbersWidth, FCaptionBarRect.Height + GetLastVisibleRow * GetRowHeight + 1);
  Canvas.Brush.Color := clCream;
  Canvas.Brush.Style := bsSolid;
  Canvas.FillRect(FRowNumbersBackgroundRect);

  {text}
  Y := 0;

  // a bit of optimization here, instead of iterating every item in FRowNumbers
  // which would be slow - instead determine the the top and last visible row
  // and paint only that area.
  for I := GetFirstVisibleRow to GetLastVisibleRow do
  begin
    if RowExists(I) then
    begin
      R := GetRowNumberTextRect(I);
      S := FRowNumbers.Strings[I];
      DrawText(Canvas.Handle, PChar(S), Length(S), R, DT_LEFT or DT_SINGLELINE or DT_VCENTER);
      Inc(Y, GetRowHeight);
    end;
  end;
end;

procedure TMyCustomGrid.DrawValues;
var
  I, Y: Integer;
  R: TRect;
  S: string;
begin
  {background}
  FValuesBackgroundRect := Rect(FRowNumbersBackgroundRect.Width, FCaptionBarRect.Bottom, FValuesWidth + FRowNumbersWidth, FCaptionBarRect.Height + GetLastVisibleRow * GetRowHeight + 1);
  Canvas.Brush.Color    := clMoneyGreen;
  Canvas.Brush.Style    := bsSolid;
  Canvas.FillRect(FValuesBackgroundRect);

  {text}
  Y := 0;

  // a bit of optimization here, instead of iterating every item in FRowNumbers
  // which would be slow - instead determine the the top and last visible row
  // and paint only that area.
  for I := GetFirstVisibleRow to GetLastVisibleRow do
  begin
    if RowExists(I) then
    begin
      R := GetValueTextRect(I);
      S := 'This is item number ' + FRowNumbers.Strings[I];
      DrawText(Canvas.Handle, PChar(S), Length(S), R, DT_LEFT or DT_SINGLELINE or DT_VCENTER);
      Inc(Y, GetRowHeight);
    end;
  end;
end;

procedure TMyCustomGrid.DrawColumnLines;
begin
  Canvas.Brush.Style  := bsClear;
  Canvas.Pen.Color    := clBlack;

  {row numbers column}
  Canvas.MoveTo(FRowNumbersBackgroundRect.Right, FCaptionBarRect.Top);
  Canvas.LineTo(FRowNumbersBackgroundRect.Right, FCaptionBarRect.Height + GetLastVisibleRow * GetRowHeight + 1);

  {values column}
  Canvas.MoveTo(FValuesBackgroundRect.Right, FCaptionBarRect.Top);
  Canvas.LineTo(FValuesBackgroundRect.Right, FCaptionBarRect.Height + GetLastVisibleRow * GetRowHeight + 1);
end;

procedure TMyCustomGrid.CalculateNewHeight;
var
  I, Y: Integer;
begin
  FRowCount := FRowNumbers.Count;

  Y := 0;
  for I := 0 to FRowCount -1 do
  begin
    Inc(Y, GetRowHeight);
  end;

  if Self.Height <> Y then
    Self.Height := Y + FCaptionBarHeight + 1;
end;

function TMyCustomGrid.GetMousePosition: TPoint;
var
  P: TPoint;
begin
  Winapi.Windows.GetCursorPos(P);
  Winapi.Windows.ScreenToClient(Self.Parent.Handle, P);
  Result := P;
end;

function TMyCustomGrid.RowIndexToMousePosition(
  ARowIndex: Integer): Integer;
begin
  if RowExists(ARowIndex) then
    Result := ARowIndex * GetRowHeight;
end;

function TMyCustomGrid.GetRowHeight: Integer;
begin
  Result := 18;
end;

function TMyCustomGrid.RowExists(ARowIndex: Integer): Boolean;
var
  I: Integer;
  Y: Integer;
begin
  Result := False;

  Y := 0;
  for I := GetFirstVisibleRow to GetLastVisibleRow -1 do
  begin
    if ARowIndex = I then
    begin
      Result := True;
      Break;
    end;

    Inc(Y, GetRowHeight);
  end;
end;

function TMyCustomGrid.GetRowNumberRect(ARowIndex: Integer): TRect;
begin
  Result.Bottom := RowIndexToMousePosition(ARowIndex) + FCaptionBarHeight + GetRowHeight;
  Result.Left   := 0;
  Result.Right  := FRowNumbersWidth;
  Result.Top    := RowIndexToMousePosition(ARowIndex) + FCaptionBarHeight + 1;
end;

function TMyCustomGrid.GetRowNumberTextRect(ARowIndex: Integer): TRect;
begin
  Result := GetRowNumberRect(ARowIndex);
  Result.Inflate(-FTextSpacing, 0);
end;

function TMyCustomGrid.GetValueRect(ARowIndex: Integer): TRect;
begin
  Result.Bottom := RowIndexToMousePosition(ARowIndex) + FCaptionBarHeight + GetRowHeight;
  Result.Left   := FRowNumbersWidth;
  Result.Right  := FValuesBackgroundRect.Right;
  Result.Top    := RowIndexToMousePosition(ARowIndex) + FCaptionBarHeight + 1;
end;

function TMyCustomGrid.GetValueTextRect(ARowIndex: Integer): TRect;
begin
  Result := GetValueRect(ARowIndex);
  Result.Inflate(-FTextSpacing, 0);
end;

function TMyCustomGrid.GetFirstVisibleRow: Integer;
begin
  Result := TMyGrid(Self.Parent).VertScrollBar.Position div GetRowHeight;
end;

function TMyCustomGrid.GetLastVisibleRow: Integer;
begin
  Result := GetFirstVisibleRow + TMyGrid(Self.Parent).Height div GetRowHeight -1;
end;

constructor TMyGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  Self.DoubleBuffered           := True;
  Self.Height                   := 150;
  Self.HorzScrollBar.Visible    := False;
  Self.TabStop                  := True;
  Self.Width                    := 250;

  FGrid                         := TMyCustomGrid.Create(Self);
  FGrid.Align                   := alTop;
  FGrid.Parent                  := Self;
  FGrid.CalculateNewHeight;

  Self.VertScrollBar.Smooth     := False;
  Self.VertScrollBar.Increment  := FGrid.GetRowHeight;
  Self.VertScrollBar.Tracking   := True;
end;

destructor TMyGrid.Destroy;
begin
  FGrid.Free;
  inherited Destroy;
end;

procedure TMyGrid.Loaded;
begin
  inherited Loaded;
  Self.VertScrollBar.Range := FGrid.Height - FGrid.FCaptionBarRect.Height;
end;

procedure TMyGrid.WMVScroll(var Message: TWMVScroll);
begin
  inherited;
  Self.Invalidate;
end;

end.

问题

我应该采取哪些不同的措施来克服闪烁？

将滚动框的 DoubleBuffered 设置为 True 似乎没什么区别。我对 WM_ERASEBACKGROUND 消息进行了一些试验，它使滚动框变黑了。

我还尝试在滚动框上实现 canvas 并将我的标题栏直接绘制到它上面，然后将滚动框上的填充设置为我的标题栏的高度并将其余部分绘制在我的 TGraphicControl 但这会导致更严重的闪烁。至此我不知道闪烁到底是什么原因以及如何消除它？

最后一件事是如何在使用滚动条拇指时使滚动条以设定的增量滚动？我已将垂直滚动条增量设置为等于行高，这在按下滚动条按钮时有效，当使用滚动条拇指上下滚动时，它不是固定增量。我试图让滚动条以增量方式工作，而不是松散地滚动。

Answer 1

一个快速修复方法是将 TMyGrid.WMVScroll 中的 Self.Invalidate 替换为 FGrid.Repaint（或 .Update 或 .Refresh）。您会看到这消除了闪烁，但它仍然展示了在拖动滚动条拇指时绘制的多个标题栏的问题。解释：Invalidate 在消息 queue 中提出一个重绘请求，它被推迟到 queue 为空，因此不会立即处理，即不会在您想要的时候处理。 Repaint 另一方面是立即执行的。但通常 Invalidate 应该足够了...

问题的主要原因在于客户端 space 中 'sticky' header（或标题栏）的布局。每个带有 TControlScrollBar 的窗口控件都使用 ScrollWindow internally which 'moves' your caption bar up and down, depending on scroll direction. You could prevent that with some hacking，但从设计的角度来看，当滚动条从 header.

下方开始时也更好看

然后您有几个组件内部布局的选项：

为 header 使用 alTop 对齐的 PaintBox，为网格使用 alRight 对齐的 ScrollBar 和 alClient 对齐的 PaintBox。这就是 Sertac 评论的内容，需要在您的组件中使用 3 个控件。
为 header 使用 alTop 对齐的 PaintBox，为网格使用 alClient 对齐的 ScrollBox 和 alTop 对齐的 PaintBox。此设计具有嵌套控件。
使用 TScrollingWinControl 并在 header 的顶部添加 non-client 边框，并为网格使用 alTop 对齐的 PaintBox。此组件包含 1 个控件。
使用 TScrollingWinControl 并在 header 的顶部添加 non-client 边框，并在其 PaintWindow 方法中绘制网格。这种设计根本不需要额外的控制。
...

作为例子，特此实现第三种方案：

unit MyGrid;

interface

uses
  System.Classes, System.SysUtils, Winapi.Windows, Winapi.Messages,
  Vcl.Controls, Vcl.Forms, Vcl.Graphics, Vcl.ExtCtrls, System.Math,
  System.UITypes;

type
  TMyCustomGrid = class(TScrollingWinControl)
  private const
    DefHeaderHeight = 20;
    DefRowHeight = 18;
    HeaderColor = clSkyBLue;
    RowIdColCaption = 'Row no.';
    RowIdColWidth = 85;
    RowIdColColor = clCream;
    TextSpacing = 5;
    ValueColCaption = 'Item no.';
    ValueColWidth = 175;
    ValueColColor = clMoneyGreen;
  private
    FHeaderHeight: Integer;
    FPainter: TPaintBox;
    FRowHeight: Integer;
    FRows: TStrings;
    function GetRowCount: Integer;
    procedure PainterPaint(Sender: TObject);
    procedure RowsChanged(Sender: TObject);
    procedure SetHeaderHeight(Value: Integer);
    procedure SetRowHeight(Value: Integer);
    procedure SetRows(Value: TStrings);
    procedure UpdatePainter;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
    procedure WMVScroll(var Message: TWMScroll); message WM_VSCROLL;
  protected
    function CanResize(var NewWidth, NewHeight: Integer): Boolean; override;
    procedure Click; override;
    procedure CreateParams(var Params: TCreateParams); override;
    function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
      MousePos: TPoint): Boolean; override;
    procedure PaintWindow(DC: HDC); override;
    property AutoScroll default True;
    property HeaderHeight: Integer read FHeaderHeight write SetHeaderHeight
      default DefHeaderHeight;
    property RowCount: Integer read GetRowCount;
    property RowHeight: Integer read FRowHeight write SetRowHeight
      default DefRowHeight;
    property Rows: TStrings read FRows write SetRows;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

  TMyGrid = class(TMyCustomGrid)
  public
    procedure Test;
  published
    property AutoScroll;
    property HeaderHeight;
    property RowHeight;
  end;

implementation

function Round(Value, Rounder: Integer): Integer; overload;
begin
  if Rounder = 0 then
    Result := Value
  else
    Result := (Value div Rounder) * Rounder;
end;

{ TMyCustomGrid }

function TMyCustomGrid.CanResize(var NewWidth, NewHeight: Integer): Boolean;
begin
  Result := inherited CanResize(NewWidth, NewHeight);
  NewHeight := FHeaderHeight + Round(NewHeight - FHeaderHeight, FRowHeight);
end;

procedure TMyCustomGrid.Click;
begin
  inherited Click;
  SetFocus;
end;

constructor TMyCustomGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csCaptureMouse, csClickEvents, csOpaque, csDoubleClicks];
  AutoScroll := True;
  TabStop := True;
  VertScrollBar.Tracking := True;
  VertScrollBar.Increment := DefRowHeight;
  Font.Name := 'Tahoma';
  Font.Size := 10;
  FHeaderHeight := DefHeaderHeight;
  FRowHeight := DefRowHeight;
  FPainter := TPaintBox.Create(Self);
  FPainter.ControlStyle := [csOpaque, csNoStdEvents];
  FPainter.Enabled := False;
  FPainter.Align := alTop;
  FPainter.OnPaint := PainterPaint;
  FPainter.Parent := Self;
  FRows := TStringList.Create;
  TStringList(FRows).OnChange := RowsChanged;
  UpdatePainter;
end;

procedure TMyCustomGrid.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params.WindowClass do
    Style := Style and not (CS_HREDRAW or CS_VREDRAW);
end;

destructor TMyCustomGrid.Destroy;
begin
  FRows.Free;
  inherited Destroy;
end;

function TMyCustomGrid.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  MousePos: TPoint): Boolean;
var
  Delta: Integer;
begin
  with VertScrollBar do
  begin
    Delta := Increment * Mouse.WheelScrollLines;
    if WheelDelta > 0 then
      Delta := -Delta;
    Position := Min(Round(Range - ClientHeight, Increment), Position + Delta);
  end;
  Result := True;
end;

function TMyCustomGrid.GetRowCount: Integer;
begin
  Result := FRows.Count;
end;

procedure TMyCustomGrid.PainterPaint(Sender: TObject);
const
  TextFlags = DT_LEFT or DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX;
var
  C: TCanvas;
  FromIndex: Integer;
  ToIndex: Integer;
  I: Integer;
  BackRect: TRect;
  TxtRect: TRect;
begin
  C := FPainter.Canvas;
  FromIndex := (C.ClipRect.Top) div FRowHeight;
  ToIndex := Min((C.ClipRect.Bottom) div FRowHeight, RowCount - 1);
  for I := FromIndex to ToIndex do
  begin
    BackRect := Bounds(0, I * FRowHeight, RowIdColWidth, FRowHeight);
    TxtRect := BackRect;
    TxtRect.Inflate(-TextSpacing, 0);
    C.Brush.Color := RowIdColColor;
    C.FillRect(BackRect);
    DrawText(C.Handle, FRows.Names[I], -1, TxtRect, TextFlags);
    BackRect.Left := RowIdColWidth;
    BackRect.Width := ValueColWidth;
    Inc(TxtRect.Left, RowIdColWidth);
    Inc(TxtRect.Right, ValueColWidth);
    C.Brush.Color := ValueColColor;
    C.FillRect(BackRect);
    DrawText(C.Handle, FRows.ValueFromIndex[I], -1, TxtRect, TextFlags);
    C.MoveTo(BackRect.Left, BackRect.Top);
    C.LineTo(BackRect.Left, BackRect.Bottom);
    BackRect.Offset(ValueColWidth, 0);
    C.Brush.Color := Brush.Color;
    C.FillRect(BackRect);
    C.MoveTo(BackRect.Left, BackRect.Top);
    C.LineTo(BackRect.Left, BackRect.Bottom);
  end;
end;

procedure TMyCustomGrid.PaintWindow(DC: HDC);
begin
  if FPainter.Height < ClientHeight then
  begin
    ExcludeClipRect(DC, 0, 0, ClientWidth, FPainter.Height);
    FillRect(DC, ClientRect, Brush.Handle);
  end;
end;

procedure TMyCustomGrid.RowsChanged(Sender: TObject);
begin
  UpdatePainter;
end;

procedure TMyCustomGrid.SetHeaderHeight(Value: Integer);
begin
  if FHeaderHeight <> Value then
  begin
    FHeaderHeight := Value;
    RecreateWnd;
  end;
end;

procedure TMyCustomGrid.SetRowHeight(Value: Integer);
begin
  if FRowHeight <> Value then
  begin
    FRowHeight := Value;
    VertScrollBar.Increment := FRowHeight;
    UpdatePainter;
    Invalidate;
  end;
end;

procedure TMyCustomGrid.SetRows(Value: TStrings);
begin
  FRows.Assign(Value);
end;

procedure TMyCustomGrid.UpdatePainter;
begin
  FPainter.Height := RowCount * FRowHeight;
end;

procedure TMyCustomGrid.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;

procedure TMyCustomGrid.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
  inherited;
  Inc(Message.CalcSize_Params.rgrc0.Top, HeaderHeight);
end;

procedure TMyCustomGrid.WMNCPaint(var Message: TWMNCPaint);
const
  TextFlags = DT_LEFT or DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX;
var
  DC: HDC;
  OldFont: HFONT;
  Brush: HBRUSH;
  R: TRect;
begin
  DC := GetWindowDC(Handle);
  OldFont := SelectObject(DC, Font.Handle);
  Brush := CreateSolidBrush(ColorToRGB(HeaderColor));
  try
    FillRect(DC, Rect(0, 0, Width, FHeaderHeight), Brush);
    SetBkColor(DC, ColorToRGB(HeaderColor));
    SetRect(R, TextSpacing, 0, RowIdColWidth - TextSpacing, FHeaderHeight);
    DrawText(DC, RowIdColCaption, -1, R, TextFlags);
    Inc(R.Left, RowIdColWidth);
    Inc(R.Right, ValueColWidth);
    DrawText(DC, ValueColCaption, -1, R, TextFlags);
    MoveToEx(DC, RowIdColWidth, 0, nil);
    LineTo(DC, RowIdColWidth, FHeaderHeight);
    MoveToEx(DC, RowIdColWidth + ValueColWidth, 0, nil);
    LineTo(DC, RowIdColWidth + ValueColWidth, FHeaderHeight);
  finally
    SelectObject(DC, OldFont);
    DeleteObject(Brush);
    ReleaseDC(Handle, DC);
  end;
  inherited;
end;

procedure TMyCustomGrid.WMVScroll(var Message: TWMScroll);
begin
  Message.Pos := Round(Message.Pos, FRowHeight);
  inherited;
end;

{ TMyGrid }

procedure TMyGrid.Test;
var
  I: Integer;
begin
  for I := 0 to 40 do
    Rows.Add(Format('%d=This is item number %d', [I, I]));
end;

end.

关于您的代码的一些一般性评论：

你的祖先 TMyCustomGrid 不能没有你的后代 TMyGrid，通常是 no-no。顺便说一下，代码 TMyGrid(Self.Parent).VertScrollBar.Position 等于 -Top，这样就不需要知道它的后代了。
无需创建字体。 TControl已有字体，发布即可。
除非你想要 TScrollBox 的 border-options，一般来说最好从 - 在这种情况下 - TScrollingWinControl 继承，因为只有这样你才能控制哪些属性应该是已发布。

One last thing is how can I make the scrollbar scroll at a set increment when using the scrollbar thumb?

按照上面的代码调整 WM_VSCROLL 中的滚动位置：

procedure TMyCustomGrid.WMVScroll(var Message: TWMScroll);
begin
  if FRowHeight <> 0 then
    Message.Pos := (Message.Pos div FRowHeight) * FRowHeight;
  inherited;
end;

Answer 2

重绘时，一行一行地重绘。这具有消隐第一行然后重新绘制它的效果，然后是第二行，还有一些，这会产生闪烁效果。比较赏心悦目的是先把整个矩形涂上底色。否则，您可能需要考虑实施和使用 InvalidateRect。

Answer 3

问题是您直接在 canvas 上绘画。将您的内容绘制到位图上，然后将其绘制到您的 canvas 上：这是您的组件的修改版本：

unit MyGrid;

interface

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

type
  TMyCustomGrid = class(TGraphicControl)
  private
    FFont: TFont;
    FRowNumbers: TStringList;
    FRowCount: Integer;
    FCaptionBarRect: TRect;
    FRowNumbersBackgroundRect: TRect;
    FValuesBackgroundRect: TRect;
    FBuffer: TBitmap;
    procedure CalculateNewHeight;
    function GetMousePosition: TPoint;
    function RowIndexToMousePosition(ARowIndex: Integer): Integer;
    function GetRowHeight: Integer;
    function RowExists(ARowIndex: Integer): Boolean;
    function GetRowNumberRect(ARowIndex: Integer): TRect;
    function GetRowNumberTextRect(ARowIndex: Integer): TRect;
    function GetValueRect(ARowIndex: Integer): TRect;
    function GetValueTextRect(ARowIndex: Integer): TRect;
    function GetFirstVisibleRow: Integer;
    function GetLastVisibleRow: Integer;
  protected
    procedure Resize; override;
    procedure Paint; override;

    procedure DrawCaptionBar;
    procedure DrawRowNumbers;
    procedure DrawValues;
    procedure DrawColumnLines;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

  TMyGrid = class(TScrollBox)
  private
    FGrid: TMyCustomGrid;
  protected
    procedure Loaded; override;
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

const
  FCaptionBarHeight = 20;
  FRowNumbersWidth = 85;
  FValuesWidth = 175;
  FTextSpacing = 5;

implementation

constructor TMyCustomGrid.Create(AOwner: TComponent);
var
  I: Integer;
begin
  inherited Create(AOwner);
  FBuffer := TBitmap.Create;

  FFont := TFont.Create;
  FFont.Color := clBlack;
  FFont.Name := 'Tahoma';
  FFont.Size := 10;
  FFont.Style := [];

  FRowNumbers := TStringList.Create;

  // FOR TEST PURPOSES
  for I := 0 to 1000 do
  begin
    FRowNumbers.Add(IntToStr(I));
  end;

  FBuffer.Canvas.Font.Assign(FFont);
end;

destructor TMyCustomGrid.Destroy;
begin
  FFont.Free;
  FRowNumbers.Free;
  inherited Destroy;
end;

procedure TMyCustomGrid.Paint;
begin
  FCaptionBarRect := Rect(0, 0, Self.Width, GetRowHeight + TMyGrid(Self.Parent).VertScrollBar.Position + 2);
  FRowCount := FRowNumbers.Count;

  DrawRowNumbers;
  DrawValues;
  DrawCaptionBar;
  DrawColumnLines;

  // Draw the bitmap onto the canvas
  Canvas.Draw(0, 0, FBuffer);
end;

procedure TMyCustomGrid.DrawCaptionBar;
var
  R: TRect;
  S: string;
begin
  { background }
  FBuffer.Canvas.Brush.Color := clSkyBlue;
  FBuffer.Canvas.Brush.Style := bsSolid;
  FBuffer.Canvas.FillRect(FCaptionBarRect);

  { text }
  FBuffer.Canvas.Brush.Style := bsClear;
  R := Rect(FTextSpacing, FCaptionBarRect.Top + TMyGrid(Self.Parent).VertScrollBar.Position, FRowNumbersWidth - FTextSpacing, FCaptionBarRect.Bottom);
  S := 'Row No.';
  DrawText(FBuffer.Canvas.Handle, PChar(S), Length(S), R, DT_LEFT or DT_SINGLELINE or DT_VCENTER);

  R := Rect(FTextSpacing + FRowNumbersWidth, FCaptionBarRect.Top + TMyGrid(Self.Parent).VertScrollBar.Position, FValuesWidth - FTextSpacing, FCaptionBarRect.Bottom);
  S := 'Item No.';
  DrawText(FBuffer.Canvas.Handle, PChar(S), Length(S), R, DT_LEFT or DT_SINGLELINE or DT_VCENTER);
end;

procedure TMyCustomGrid.DrawRowNumbers;
var
  I, Y: Integer;
  R: TRect;
  S: string;
begin
  { background }
  FRowNumbersBackgroundRect := Rect(0, FCaptionBarRect.Bottom, FRowNumbersWidth, FCaptionBarRect.Height + GetLastVisibleRow * GetRowHeight + 1);
  FBuffer.Canvas.Brush.Color := clCream;
  FBuffer.Canvas.Brush.Style := bsSolid;
  FBuffer.Canvas.FillRect(FRowNumbersBackgroundRect);

  { text }
  Y := 0;

  // a bit of optimization here, instead of iterating every item in FRowNumbers
  // which would be slow - instead determine the the top and last visible row
  // and paint only that area.
  for I := GetFirstVisibleRow to GetLastVisibleRow do
  begin
    if RowExists(I) then
    begin
      R := GetRowNumberTextRect(I);
      S := FRowNumbers.Strings[I];
      DrawText(FBuffer.Canvas.Handle, PChar(S), Length(S), R, DT_LEFT or DT_SINGLELINE or DT_VCENTER);
      Inc(Y, GetRowHeight);
    end;
  end;
end;

procedure TMyCustomGrid.DrawValues;
var
  I, Y: Integer;
  R: TRect;
  S: string;
begin
  { background }
  FValuesBackgroundRect := Rect(FRowNumbersBackgroundRect.Width, FCaptionBarRect.Bottom, FValuesWidth + FRowNumbersWidth, FCaptionBarRect.Height + GetLastVisibleRow * GetRowHeight + 1);
  FBuffer.Canvas.Brush.Color := clMoneyGreen;
  FBuffer.Canvas.Brush.Style := bsSolid;
  FBuffer.Canvas.FillRect(FValuesBackgroundRect);

  { text }
  Y := 0;

  // a bit of optimization here, instead of iterating every item in FRowNumbers
  // which would be slow - instead determine the the top and last visible row
  // and paint only that area.
  for I := GetFirstVisibleRow to GetLastVisibleRow do
  begin
    if RowExists(I) then
    begin
      R := GetValueTextRect(I);
      S := 'This is item number ' + FRowNumbers.Strings[I];
      DrawText(FBuffer.Canvas.Handle, PChar(S), Length(S), R, DT_LEFT or DT_SINGLELINE or DT_VCENTER);
      Inc(Y, GetRowHeight);
    end;
  end;
end;

procedure TMyCustomGrid.DrawColumnLines;
begin
  FBuffer.Canvas.Brush.Style := bsClear;
  FBuffer.Canvas.Pen.Color := clBlack;

  { row numbers column }
  FBuffer.Canvas.MoveTo(FRowNumbersBackgroundRect.Right, FCaptionBarRect.Top);
  FBuffer.Canvas.LineTo(FRowNumbersBackgroundRect.Right, FCaptionBarRect.Height + GetLastVisibleRow * GetRowHeight + 1);

  { values column }
  FBuffer.Canvas.MoveTo(FValuesBackgroundRect.Right, FCaptionBarRect.Top);
  FBuffer.Canvas.LineTo(FValuesBackgroundRect.Right, FCaptionBarRect.Height + GetLastVisibleRow * GetRowHeight + 1);
end;

procedure TMyCustomGrid.CalculateNewHeight;
var
  I, Y: Integer;
begin
  FRowCount := FRowNumbers.Count;

  Y := 0;
  for I := 0 to FRowCount - 1 do
  begin
    Inc(Y, GetRowHeight);
  end;

  if Self.Height <> Y then
    Self.Height := Y + FCaptionBarHeight + 1;
end;

function TMyCustomGrid.GetMousePosition: TPoint;
var
  P: TPoint;
begin
  Winapi.Windows.GetCursorPos(P);
  Winapi.Windows.ScreenToClient(Self.Parent.Handle, P);
  Result := P;
end;

function TMyCustomGrid.RowIndexToMousePosition(ARowIndex: Integer): Integer;
begin
  if RowExists(ARowIndex) then
    Result := ARowIndex * GetRowHeight;
end;

function TMyCustomGrid.GetRowHeight: Integer;
begin
  Result := 18;
end;

procedure TMyCustomGrid.Resize;
begin
  inherited;
  FBuffer.SetSize(Width, Height);
  FBuffer.Canvas.Brush.Color := clWhite;
  FBuffer.Canvas.FillRect(ClientRect);
end;

function TMyCustomGrid.RowExists(ARowIndex: Integer): Boolean;
var
  I: Integer;
  Y: Integer;
begin
  Result := False;

  Y := 0;
  for I := GetFirstVisibleRow to GetLastVisibleRow - 1 do
  begin
    if ARowIndex = I then
    begin
      Result := True;
      Break;
    end;

    Inc(Y, GetRowHeight);
  end;
end;

function TMyCustomGrid.GetRowNumberRect(ARowIndex: Integer): TRect;
begin
  Result.Bottom := RowIndexToMousePosition(ARowIndex) + FCaptionBarHeight + GetRowHeight;
  Result.Left := 0;
  Result.Right := FRowNumbersWidth;
  Result.Top := RowIndexToMousePosition(ARowIndex) + FCaptionBarHeight + 1;
end;

function TMyCustomGrid.GetRowNumberTextRect(ARowIndex: Integer): TRect;
begin
  Result := GetRowNumberRect(ARowIndex);
  Result.Inflate(-FTextSpacing, 0);
end;

function TMyCustomGrid.GetValueRect(ARowIndex: Integer): TRect;
begin
  Result.Bottom := RowIndexToMousePosition(ARowIndex) + FCaptionBarHeight + GetRowHeight;
  Result.Left := FRowNumbersWidth;
  Result.Right := FValuesBackgroundRect.Right;
  Result.Top := RowIndexToMousePosition(ARowIndex) + FCaptionBarHeight + 1;
end;

function TMyCustomGrid.GetValueTextRect(ARowIndex: Integer): TRect;
begin
  Result := GetValueRect(ARowIndex);
  Result.Inflate(-FTextSpacing, 0);
end;

function TMyCustomGrid.GetFirstVisibleRow: Integer;
begin
  Result := TMyGrid(Self.Parent).VertScrollBar.Position div GetRowHeight;
end;

function TMyCustomGrid.GetLastVisibleRow: Integer;
begin
  Result := GetFirstVisibleRow + TMyGrid(Self.Parent).Height div GetRowHeight - 1;
end;

constructor TMyGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  Self.DoubleBuffered := True;
  Self.Height := 150;
  Self.HorzScrollBar.Visible := False;
  Self.TabStop := True;
  Self.Width := 250;

  FGrid := TMyCustomGrid.Create(Self);
  FGrid.Align := alTop;
  FGrid.Parent := Self;
  FGrid.CalculateNewHeight;

  Self.VertScrollBar.Smooth := False;
  Self.VertScrollBar.Increment := FGrid.GetRowHeight;
  Self.VertScrollBar.Tracking := True;
end;

destructor TMyGrid.Destroy;
begin
  FGrid.Free;
  inherited Destroy;
end;

procedure TMyGrid.Loaded;
begin
  inherited Loaded;
  Self.VertScrollBar.Range := FGrid.Height - FGrid.FCaptionBarRect.Height;
end;

procedure TMyGrid.WMVScroll(var Message: TWMVScroll);
begin
  inherited;
  Self.Invalidate;
end;

end.

Answer 4

如果您查看 Delphi Project Options 内的 Version Info 部分，IDE 有一个网格控件，看起来像是固定的 header 不会与其余内容一起滚动。

TValueListEditor 组件似乎是完全相同的控件。可能值得研究 ownerdrawing TValueListEditor 或更深入地查看组件源以了解它如何实现具有不滚动的滚动窗口区域的效果。

我的自定义控件闪烁。是什么原因造成的，我该如何消除它？

I have flickering on my custom control. What is causing it and how can I eliminate it?

delphi

delphi-xe7

简介

闪烁问题

问题