Fatal编程技术网
  • delphi/
  • Delphi 如何创建可以滚动固定行和列的自定义控件？

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

delphi

Delphi 如何创建可以滚动固定行和列的自定义控件？,delphi,custom-controls,scrollbar,delphi-xe2,Delphi,Custom Controls,Scrollbar,Delphi Xe2,我正试图弄明白，我如何能够以一种用户可以向所有方向滚动的方式创建一个自定义控件，但要有固定的行和列。网格不适合我尝试做的事情，因为它逐列滚动。我需要水平滚动平滑，逐像素。我不使用列，只使用可视网格线。垂直滚动不仅应该滚动右边的区域，还应该滚动左边的固定区域。与水平滚动相同：标题行应随水平滚动条一起移动 这只是我正在研究的最终控制的一个粗略草案 请注意，滚动条如何不覆盖整个控件，只覆盖较大的区域。固定的列/行也应该能够与其相应的滚动条一起移动 我应该如何实现滚动条来实现这一点 PS-这是为了取代

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

这只是我正在研究的最终控制的一个粗略草案

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

我应该如何实现滚动条来实现这一点

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

最简单的方法是创建一个没有滚动条的控件，然后将滚动条放置在上面，并对其大小和位置进行精确控制

使用Delphi3-5，您可以使用自定义容器包将其封装为新控件，并像使用常规网格一样放置到新窗体上

由于D5 CCP不再可用，但作为VCL TFrame给出了有限的模拟。
或者，您可以在运行时创建这些滚动条-您需要搜索Windows句柄创建例程（trace TControl.Handle getter method），该例程可能会被重新创建，或者类似于GDI句柄的创建-在其上创建滚动条。

首先，我认为您可以使用（示例），它能够在单元格中保存控件，但是从你的评论中我知道你想自己画所有的东西。所以我写了一个“
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;

该组件由三个
TPaintScroller
控件组成（在
TScrollBox
上的
TPaintBox
）。实际上，对于这两个标题，
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.

unitheadergrid；
接口
使用
类、控件、窗口、消息、图形、窗体、extctrl、stdctrl；
类型
TpanEvent=对象的程序（ACanvas:TCanvas）；
TPaintScroller=类（TScrollingWinControl）
私有的
FOnPaint:Tpaintent；
Fonsroll:TNotifyEvent；
油漆工：TPaintBox；
函数GetPaintHeight:整数；
函数GetPaintWidth:整数；
函数GetScrollBars:TScrollStyle；
程序SetPaintHeight（值：整数）；
程序SetPaintWidth（值：整数）；
程序设置crollbars（值：TScrollStyle）；
程序WMEraseBkgnd（var消息：TWMEraseBkgnd）；消息WM_ERASEBKGND；
程序WMHScroll（var消息：TWMScroll）；信息WM_HSCROLL；
程序WMVSCROL（var消息：TWMScroll）；消息WM_VSCROLL；
受保护的
过程CreateParams（变量参数：TCreateParams）；推翻
函数DoMouseWheel（Shift:TSShift状态；WheelDelta:Integer；
鼠标点：TPoint）：布尔值；推翻
程序油漆（发送方：TObject）；事实上的
多斯克罗尔程序；事实上的
程序窗口（DC:HDC）；推翻
程序调整；推翻
公众的
构造函数创建（AOwner:TComponent）；推翻
出版
油漆属性：Tpaint-read-FOnPaint-write-FOnPaint；
OnScroll属性：TNotifyEvent read FonSroll write FonSroll；
属性PaintHeight：整数读取GetPaintHeight写入SetPaintHeight；
属性PaintWidth：整数读取GetPaintWidth写入SetPaintWidth；
属性滚动条：TScrollStyle读取GetScrollBars写入SetScrollBars
两者皆有；
结束；
TDrawCellEvent=过程（发送方：TObject；ACanvas:TCanvas；ACol，
对象的ARow:Integer；R:TRect）；
THeaderGrid=类（TCustomControl）
私有的
FCellScroller:TPaintScroller；
FColCount：整数；
FColHeader:TPaintScroller；
FColWidth：整数；
FOnDrawCell:TDrawCellEvent；
FOnDrawColHeader:TDrawCellEvent；
FOnDrawRowHeader:TDrawCellEvent；
FRowCount：整数；
FRowHeader:TPaintScroller；
FRowHeight：整数；
程序单元（发送方：TObject）；
函数GetColHeaderHeight:整数；
函数GetRowHeaderWidth:整数；
程序单元（ACanvas:TCanvas）；
程序PaintColHeader（ACanvas:TCanvas）；
程序PaintRowHeader（ACanvas:TCanvas）；
过程SetColCount（值：整数）；
过程SetColHeaderHeight（值：整数）；
过程SetColWidth（值：整数）；
过程SetRowCount（值：整数）；
过程SetRowHeaderWidth（值：整数）；
过程SetRowHeight（值：整数）；
程序更新；
程序WMEraseBkgnd（var消息：TWMEraseBkgnd）；消息WM_ERASEBKGND；
受保护的
过程CreateParams（变量参数：TCreateParams）；推翻
过程DoDrawCell（ACanvas:TCanvas；ACol，ARow:Integer；
R:TRect）；事实上的
过程DoDrawColHeader（ACanvas:TCanvas；ACol:Integer；
R:TRect）；事实上的
过程DoDrawRowHeader（ACanvas:TCanvas；ARow:Integer；
R:TRect）；事实上的
程序漆；推翻
公众的
构造函数创建（AOwner:TComponent）；推翻
过程MouseWheelHandler（变量消息：TMessage）；推翻
出版
属性ColCount：整数读取FColCount写入SetColCount默认值5；
属性ColHeaderHeight:整数读取GetColHeaderHeight
写入SetColHeaderHeight默认值24；
属性ColWidth：整数读取FColWidth写入SetColWidth默认值64；
赞成的意见