Question

我试图弄清楚如何以用户可以向所有方向滚动但使用固定行和列的方式进行自定义控件。网格不适合我尝试做的事情，因为它逐列滚动。我需要水平滚动才能像素一样平滑。我没有使用列，只有可视网格线。垂直滚动不仅应滚动右侧区域，还应滚动左侧的固定区域。与水平滚动相同：标题行应与水平滚动条一起移动。

这只是我正在进行的最终控制的草稿。

Rough Control Design

请注意滚动条如何不覆盖完整控件，仅覆盖较大的区域。固定的列/行也应该能够与相应的滚动条一起移动。

我应该如何实现滚动条以实现这一目标？

PS - 这是为了取代一个更彻底的问题，因为这是一个误导的请求而被删除的问题。很抱歉，如果我缺少您可能需要了解的详细信息。

Answer 1

首先，我认为你可以使用能够在单元格中保存控件的this component（示例image），但是根据你的评论，我知道你想自己绘制所有内容。所以我写了一个'THeaderGrid'组件：

procedure TForm1.FormCreate(Sender: TObject);
begin
  with THeaderGrid.Create(Self) do
  begin
    Align := alClient;
    OnDrawCell := DrawCell;
    OnDrawColHeader := DrawCell;
    OnDrawRowHeader := DrawCell;
    Parent := Self;
  end;
end;

procedure TForm1.DrawCell(Sender: TObject; ACanvas: TCanvas; ACol,
  ARow: Integer; R: TRect);
begin
  ACanvas.TextOut(R.Left + 2, R.Top + 2, Format('(%d,%d)', [ACol, ARow]));
end;

Screenshot

该组件是由三个TPaintScroller控件（TPaintBox上的TScrollBox）构建的。实际上，对于这两个标题，TScrollBox有点重量级，但使用与数据区域相同的控制方式有点方便。

有三个OnDraw事件，一个用于标题，一个用于单元格，但您可以将它们设置为相同的处理程序，类似于上面的示例。通过列或行索引区分每个-1。

unit HeaderGrid;

interface

uses
  Classes, Controls, Windows, Messages, Graphics, Forms, ExtCtrls, StdCtrls;

type
  TPaintEvent = procedure(ACanvas: TCanvas) of object;

  TPaintScroller = class(TScrollingWinControl)
  private
    FOnPaint: TPaintEvent;
    FOnScroll: TNotifyEvent;
    FPainter: TPaintBox;
    function GetPaintHeight: Integer;
    function GetPaintWidth: Integer;
    function GetScrollBars: TScrollStyle;
    procedure SetPaintHeight(Value: Integer);
    procedure SetPaintWidth(Value: Integer);
    procedure SetScrollBars(Value: TScrollStyle);
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMHScroll(var Message: TWMScroll); message WM_HSCROLL;
    procedure WMVScroll(var Message: TWMScroll); message WM_VSCROLL;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
      MousePos: TPoint): Boolean; override;
    procedure DoPaint(Sender: TObject); virtual;
    procedure DoScroll; virtual;
    procedure PaintWindow(DC: HDC); override;
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property OnPaint: TPaintEvent read FOnPaint write FOnPaint;
    property OnScroll: TNotifyEvent read FOnScroll write FOnScroll;
    property PaintHeight: Integer read GetPaintHeight write SetPaintHeight;
    property PaintWidth: Integer read GetPaintWidth write SetPaintWidth;
    property ScrollBars: TScrollStyle read GetScrollBars write SetScrollBars
      default ssBoth;
  end;

  TDrawCellEvent = procedure(Sender: TObject; ACanvas: TCanvas; ACol,
    ARow: Integer; R: TRect) of object;

  THeaderGrid = class(TCustomControl)
  private
    FCellScroller: TPaintScroller;
    FColCount: Integer;
    FColHeader: TPaintScroller;
    FColWidth: Integer;
    FOnDrawCell: TDrawCellEvent;
    FOnDrawColHeader: TDrawCellEvent;
    FOnDrawRowHeader: TDrawCellEvent;
    FRowCount: Integer;
    FRowHeader: TPaintScroller;
    FRowHeight: Integer;
    procedure CellsScrolled(Sender: TObject);
    function GetColHeaderHeight: Integer;
    function GetRowHeaderWidth: Integer;
    procedure PaintCells(ACanvas: TCanvas);
    procedure PaintColHeader(ACanvas: TCanvas);
    procedure PaintRowHeader(ACanvas: TCanvas);
    procedure SetColCount(Value: Integer);
    procedure SetColHeaderHeight(Value: Integer);
    procedure SetColWidth(Value: Integer);
    procedure SetRowCount(Value: Integer);
    procedure SetRowHeaderWidth(Value: Integer);
    procedure SetRowHeight(Value: Integer);
    procedure UpdateSize;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure DoDrawCell(ACanvas: TCanvas; ACol, ARow: Integer;
      R: TRect); virtual;
    procedure DoDrawColHeader(ACanvas: TCanvas; ACol: Integer;
      R: TRect); virtual;
    procedure DoDrawRowHeader(ACanvas: TCanvas; ARow: Integer;
      R: TRect); virtual;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure MouseWheelHandler(var Message: TMessage); override;
  published
    property ColCount: Integer read FColCount write SetColCount default 5;
    property ColHeaderHeight: Integer read GetColHeaderHeight
      write SetColHeaderHeight default 24;
    property ColWidth: Integer read FColWidth write SetColWidth default 64;
    property OnDrawCell: TDrawCellEvent read FOnDrawCell write FOnDrawCell;
    property OnDrawColHeader: TDrawCellEvent read FOnDrawColHeader
      write FOnDrawColHeader;
    property OnDrawRowHeader: TDrawCellEvent read FOnDrawRowHeader
      write FOnDrawRowHeader;
    property RowCount: Integer read FRowCount write SetRowCount default 5;
    property RowHeaderWidth: Integer read GetRowHeaderWidth
      write SetRowHeaderWidth default 64;
    property RowHeight: Integer read FRowHeight write SetRowHeight default 24;
  published
    property Color;
    property Font;
    property ParentColor default False;
    property TabStop default True;
  end;

implementation

{ TPaintScroller }

constructor TPaintScroller.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csOpaque];
  HorzScrollBar.Tracking := True;
  VertScrollBar.Tracking := True;
  Width := 100;
  Height := 100;
  FPainter := TPaintBox.Create(Self);
  FPainter.SetBounds(0, 0, 100, 100);
  FPainter.OnPaint := DoPaint;
  FPainter.Parent := Self;
end;

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

function TPaintScroller.DoMouseWheel(Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint): Boolean;
begin
  VertScrollBar.Position := VertScrollBar.Position - WheelDelta;
  DoScroll;
  Result := True;
end;

procedure TPaintScroller.DoPaint(Sender: TObject);
begin
  if Assigned(FOnPaint) then
    FOnPaint(FPainter.Canvas);
end;

procedure TPaintScroller.DoScroll;
begin
  if Assigned(FOnScroll) then
    FOnScroll(Self);
end;

function TPaintScroller.GetPaintHeight: Integer;
begin
  Result := FPainter.Height;
end;

function TPaintScroller.GetPaintWidth: Integer;
begin
  Result := FPainter.Width;
end;

function TPaintScroller.GetScrollBars: TScrollStyle;
begin
  if HorzScrollBar.Visible and VertScrollBar.Visible then
    Result := ssBoth
  else if not HorzScrollBar.Visible and VertScrollBar.Visible then
    Result := ssVertical
  else if HorzScrollBar.Visible and not VertScrollBar.Visible then
    Result := ssHorizontal
  else
    Result := ssNone;
end;

procedure TPaintScroller.PaintWindow(DC: HDC);
begin
  with FPainter do
    ExcludeClipRect(DC, 0, 0, Width + Left, Height + Top);
  FillRect(DC, ClientRect, Brush.Handle);
end;

procedure TPaintScroller.Resize;
begin
  DoScroll;
  inherited Resize;
end;

procedure TPaintScroller.SetPaintHeight(Value: Integer);
begin
  FPainter.Height := Value;
end;

procedure TPaintScroller.SetPaintWidth(Value: Integer);
begin
  FPainter.Width := Value;
end;

procedure TPaintScroller.SetScrollBars(Value: TScrollStyle);
begin
  HorzScrollBar.Visible := (Value = ssBoth) or (Value = ssHorizontal);
  VertScrollBar.Visible := (Value = ssBoth) or (Value = ssVertical);
end;

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

procedure TPaintScroller.WMHScroll(var Message: TWMScroll);
begin
  inherited;
  DoScroll;
end;

procedure TPaintScroller.WMVScroll(var Message: TWMScroll);
begin
  inherited;
  DoScroll;
end;

{ THeaderGrid }

procedure THeaderGrid.CellsScrolled(Sender: TObject);
begin
  FColHeader.FPainter.Left := -FCellScroller.HorzScrollBar.Position;
  FRowHeader.FPainter.Top := -FCellScroller.VertScrollBar.Position;
end;

constructor THeaderGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csOpaque];
  ParentColor := False;
  TabStop := True;
  FCellScroller := TPaintScroller.Create(Self);
  FCellScroller.Anchors := [akLeft, akTop, akRight, akBottom];
  FCellScroller.OnPaint := PaintCells;
  FCellScroller.OnScroll := CellsScrolled;
  FCellScroller.AutoScroll := True;
  FCellScroller.Parent := Self;
  FColHeader := TPaintScroller.Create(Self);
  FColHeader.Anchors := [akLeft, akTop, akRight];
  FColHeader.OnPaint := PaintColHeader;
  FColHeader.ScrollBars := ssNone;
  FColHeader.Parent := Self;
  FRowHeader := TPaintScroller.Create(Self);
  FRowHeader.Anchors := [akLeft, akTop, akBottom];
  FRowHeader.OnPaint := PaintRowHeader;
  FRowHeader.ScrollBars := ssNone;
  FRowHeader.Parent := Self;
  Width := 320;
  Height := 120;
  ColCount := 5;
  RowCount := 5;
  ColWidth := 64;
  RowHeight := 24;
  ColHeaderHeight := 24;
  RowHeaderWidth := 64;
end;

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

procedure THeaderGrid.DoDrawCell(ACanvas: TCanvas; ACol, ARow: Integer;
  R: TRect);
begin
  if Assigned(FOnDrawCell) then
    FOnDrawCell(Self, ACanvas, ACol, ARow, R);
end;

procedure THeaderGrid.DoDrawColHeader(ACanvas: TCanvas; ACol: Integer;
  R: TRect);
begin
 if Assigned(FOnDrawColHeader) then
   FOnDrawColHeader(Self, ACanvas, ACol, -1, R);
end;

procedure THeaderGrid.DoDrawRowHeader(ACanvas: TCanvas; ARow: Integer;
  R: TRect);
begin
  if Assigned(FOnDrawRowHeader) then
    FOnDrawRowHeader(Self, ACanvas, -1, ARow, R);
end;

function THeaderGrid.GetColHeaderHeight: Integer;
begin
  Result := FColHeader.Height;
end;

function THeaderGrid.GetRowHeaderWidth: Integer;
begin
  Result := FRowHeader.Width;
end;

procedure THeaderGrid.MouseWheelHandler(var Message: TMessage);
begin
  with Message do
    Result := FCellScroller.Perform(CM_MOUSEWHEEL, WParam, LParam);
  if Message.Result = 0 then
    inherited MouseWheelHandler(Message);
end;

procedure THeaderGrid.Paint;
var
  R: TRect;
begin
  Canvas.Brush.Color := Color;
  R := Rect(0, 0, RowHeaderWidth, ColHeaderHeight);
  if IntersectRect(R, R, Canvas.ClipRect) then
    Canvas.FillRect(R);
  Canvas.Brush.Color := clBlack;
  R := Rect(0, ColHeaderHeight, Width, ColHeaderHeight + 1);
  if IntersectRect(R, R, Canvas.ClipRect) then
    Canvas.FillRect(R);
  R := Rect(RowHeaderWidth, 0, RowHeaderWidth + 1, Height);
  if IntersectRect(R, R, Canvas.ClipRect) then
    Canvas.FillRect(R);
end;

procedure THeaderGrid.PaintCells(ACanvas: TCanvas);
var
  Col: Integer;
  Row: Integer;
  R: TRect;
  Dummy: TRect;
begin
  ACanvas.Brush.Color := Color;
  ACanvas.Font := Font;
  ACanvas.FillRect(ACanvas.ClipRect);
  for Row := 0 to FRowCount - 1 do
  begin
    R := Bounds(0, Row * FRowHeight, FColWidth, FRowHeight);
    for Col := 0 to FColCount - 1 do
    begin
      if IntersectRect(Dummy, R, ACanvas.ClipRect) then
      begin
        DoDrawCell(ACanvas, Col, Row, R);
        if ACanvas.Pen.Style <> psSolid then
          ACanvas.Pen.Style := psSolid;
        if ACanvas.Pen.Color <> clSilver then
          ACanvas.Pen.Color := clSilver;
        ACanvas.MoveTo(R.Left, R.Bottom - 1);
        ACanvas.LineTo(R.Right - 1, R.Bottom - 1);
        ACanvas.LineTo(R.Right - 1, R.Top - 1);
      end;
      OffsetRect(R, FColWidth, 0);
    end;
  end;
end;

procedure THeaderGrid.PaintColHeader(ACanvas: TCanvas);
var
  Col: Integer;
  R: TRect;
  Dummy: TRect;
begin
  ACanvas.Brush.Color := Color;
  ACanvas.Font := Font;
  ACanvas.FillRect(ACanvas.ClipRect);
  R := Rect(0, 0, FColWidth, ColHeaderHeight);
  for Col := 0 to FColCount - 1 do
  begin
    if IntersectRect(Dummy, R, ACanvas.ClipRect) then
      DoDrawColHeader(ACanvas, Col, R);
    OffsetRect(R, FColWidth, 0);
  end;
end;

procedure THeaderGrid.PaintRowHeader(ACanvas: TCanvas);
var
  Row: Integer;
  R: TRect;
  Dummy: TRect;
begin
  ACanvas.Brush.Color := Color;
  ACanvas.Font := Font;
  ACanvas.FillRect(ACanvas.ClipRect);
  R := Rect(0, 0, RowHeaderWidth, FRowHeight);
  for Row := 0 to FRowCount - 1 do
  begin
    if IntersectRect(Dummy, R, ACanvas.ClipRect) then
    begin
      DoDrawRowHeader(ACanvas, Row, R);
      if ACanvas.Pen.Style <> psSolid then
        ACanvas.Pen.Style := psSolid;
      if ACanvas.Pen.Color <> clSilver then
        ACanvas.Pen.Color := clSilver;
      ACanvas.MoveTo(R.Left, R.Bottom - 1);
      ACanvas.LineTo(R.Right - 1, R.Bottom - 1);
    end;
    OffsetRect(R, 0, FRowHeight);
  end;
end;

procedure THeaderGrid.SetColCount(Value: Integer);
begin
  if FColCount <> Value then
  begin
    FColCount := Value;
    UpdateSize;
  end;
end;

procedure THeaderGrid.SetColHeaderHeight(Value: Integer);
begin
  if Value >= 0 then
  begin
    FColHeader.Height := Value;
    FRowHeader.BoundsRect := Rect(0, Value + 1, RowHeaderWidth, Height);
    FCellScroller.BoundsRect := Rect(RowHeaderWidth + 1, Value + 1, Width,
      Height);
  end;
end;

procedure THeaderGrid.SetColWidth(Value: Integer);
begin
  if FColWidth <> Value then
  begin
    FColWidth := Value;
    FCellScroller.HorzScrollBar.Increment := Value;
    UpdateSize;
  end;
end;

procedure THeaderGrid.SetRowCount(Value: Integer);
begin
  if FRowCount <> Value then
  begin
    FRowCount := Value;
    UpdateSize;
  end;
end;

procedure THeaderGrid.SetRowHeaderWidth(Value: Integer);
begin
  if Value >= 0 then
  begin
    FRowHeader.Width := Value;
    FColHeader.BoundsRect := Rect(Value + 1, 0, Width, ColHeaderHeight);
    FCellScroller.BoundsRect := Rect(Value + 1, ColHeaderHeight + 1, Width,
      Height);
  end;
end;

procedure THeaderGrid.SetRowHeight(Value: Integer);
begin
  if FRowHeight <> Value then
  begin
    FRowHeight := Value;
    FCellScroller.VertScrollBar.Increment := Value;
    UpdateSize;
  end;
end;

procedure THeaderGrid.UpdateSize;
begin
  FColHeader.PaintWidth := FColCount * FColWidth;
  FRowHeader.PaintHeight := FRowCount * FRowHeight;
  FCellScroller.PaintWidth := FColCount * FColWidth;
  FCellScroller.PaintHeight := FRowCount * FRowHeight;
end;

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

end.

Answer 2

最简单的方法是制作一个没有滚动条的控件，然后将滚动条放在它上面，并精确控制它们的大小和位置。

使用Delphi 3-5，您可以使用Custom Containers Pack将其封装为新控件，并像使用常规网格一样放入新表单。

由于D5 CCP不再可用，但有限的模拟作为VCL TFrame给出。或者你可以在运行时创建这些滚动条 - 你需要搜索Windows Handle创建例程，（跟踪TControl.Handle getter方法），可能是ReCreateWnd等，并且当创建GDI句柄时 - 在它上面创建滚动条。 / p>

如何创建可以使用固定的行和列滚动的自定义控件？

2 个答案: