Question

简介

我正在编写一个源自TScrollBox的自定义控件，但我遇到了一些困难，无法克服看起来应该是一个容易解决的问题。

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

这就是控件目前看起来更好的想法（非常早期的工作）：

闪烁问题

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

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

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

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消息进行了一些实验，该消息刚刚使滚动框变黑。

我还尝试在滚动框上实现一个画布并直接在其上绘制标题栏，然后将滚动框上的填充设置为我的标题栏的高度，并在我的TGraphicControl上绘制其余部分，但这会导致均匀更糟糕的闪烁。在这一点上，我不知道究竟是什么导致了闪烁以及如何消除它？

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

Answer 1

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

问题的主要来源在于客户端空间中带有“粘性”标题（或标题栏）的布局。每个带有TControlScrollBar的窗口控件都会在内部使用ScrollWindow，根据滚动方向上下移动标题栏。您可以阻止with some hacking，但从设计的角度来看，滚动条在标题下方开始时也会更好。

然后，您可以选择组件的内部布局：

使用alTop对齐的PaintBox作为标题，alRight对齐的ScrollBar和alClient对齐的PaintBox用于网格。这是Sertac评论的内容，需要您的组件中有3个控件。
使用alTop对齐的PaintBox作为标题，alClient对齐的ScrollBox以及其中alTop对齐的PaintBox用于网格。此设计具有嵌套控件。
使用标题顶部添加了非客户端边框的TScrollingWinControl和网格的alTop对齐PaintBox。该组件包含1个控件。
在标题顶部使用添加了非客户端边框的TScrollingWinControl，并在其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，这通常是禁忌。顺便说一下，代码TMyGrid(Self.Parent).VertScrollBar.Position等于-Top，这消除了对其后代知识的需要。
无需创建字体。 TControl已经有了一个字体，只需发布它。
除非你想要来自TScrollBox的边框选项，否则一般来说最好是从 - TScrollingWinControl下降 - 因为只有这样才能控制应该发布哪些属性。

最后一件事是如何在使用滚动条拇指时使滚动条以设定的增量滚动？

通过调整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

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

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 IDE Version Info内的Project Options部分，有一个网格控件，看起来像一个固定的标题，不会滚动其余的内容。

TValueListEditor组件似乎是完全相同的控件。可能值得查看所有者绘制TValueListEditor或深入了解组件源，看看它是如何实现滚动窗口区域不滚动的效果。

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

简介

闪烁问题

问题

4 个答案: