如何创建可以用固定行和列滚动的自定义控件？ [英] How to create a custom control which can scroll with a fixed row and column?
本文介绍了如何创建可以用固定行和列滚动的自定义控件？的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我想知道如何以一种方式进行自定义控件，用户可以在各个方向上滚动，但使用固定的行和列。网格不适合我想要做的，因为它逐列滚动。我需要水平滚动来平滑，逐个像素。我没有使用列，只有视觉网格线。垂直滚动不仅应该滚动右侧的区域，还可以滚动左侧的固定区域。与水平滚动相同：标题行应与水平滚动条一起移动。
这只是我正在进行的最终控件的粗略草稿。 >
请注意，滚动条不能覆盖完整的控件，只能覆盖较大的区域。固定的列/行也应该能够与其相应的滚动条一起移动。
如何实现滚动条可以实现？
PS - 这是替代一个更为彻底的问题，被删除是一个错误的领先请求。很抱歉，如果我缺少可能需要了解的细节。
解决方案
首先，我以为你可以用此组件（示例图像），它能够控制单元格，但从您的评论我明白你想自己绘制一切。所以我写了一个' THeaderGrid '组件：
procedure TForm1.FormCreate （发件人：TObject）;
begin
with THeaderGrid.Create（Self）do
begin
对齐：= alClient;
OnDrawCell：= DrawCell;
OnDrawColHeader：= DrawCell;
OnDrawRowHeader：= DrawCell;
父母：=自我;
结束
结束
程序TForm1.DrawCell（发件人：TObject; ACanvas：TCanvas; ACol，
ARow：Integer; R：TRect）;
begin
ACanvas.TextOut（R.Left + 2，R.Top + 2，Format（'（％d，％d）'，[ACol，ARow]））;
结束
该组件是由三个 TPaintScroller 控件（一个 TPaintBox 在 TScrollBox ）。实际上，对于两个标题， TScrollBox 有点重量级，但是与单元格的数据区域使用相同的控件是很方便的。
有三个OnDraw事件，一个用于两个头文件，一个用于单元格，但您可以将它们都设置为同一个处理程序，与上述示例相同。按列或行索引区分每个索引为 -1 。
单位HeaderGrid;
接口
使用
类，控件，Windows，消息，图形，窗体，ExtCtrls，StdCtrls;
类型
TPaintEvent =对象的过程（ACanvas：TCanvas）;
TPaintScroller = class（TScrollingWinControl）
private
FOnPaint：TPaintEvent;
FOnScroll：TNotifyEvent;
FPainter：TPaintBox;
函数GetPaintHeight：Integer;
函数GetPaintWidth：Integer;
函数GetScrollBars：TScrollStyle;
程序SetPaintHeight（Value：Integer）;
程序SetPaintWidth（Value：Integer）;
程序SetScrollBars（Value：TScrollStyle）;
procedure WMEraseBkgnd（var Message：TWMEraseBkgnd）;消息WM_ERASEBKGND;
procedure WMHScroll（var Message：TWMScroll）;消息WM_HSCROLL;
程序WMVScroll（var Message：TWMScroll）;消息WM_VSCROLL;
protected
procedure CreateParams（var Params：TCreateParams）;覆盖
函数DoMouseWheel（Shift：TShiftState; WheelDelta：Integer;
MousePos：TPoint）：Boolean;覆盖
procedure DoPaint（Sender：TObject）;虚拟;
程序DoScroll;虚拟;
程序PaintWindow（DC：HDC）;覆盖
procedure调整大小;覆盖
public
构造函数Create（AOwner：TComponent）;覆盖
发布
属性OnPaint：TPaintEvent读取FOnPaint写入FOnPaint;
属性OnScroll：TNotifyEvent读取FOnScroll写入FOnScroll;
属性PaintHeight：整数读取GetPaintHeight写入SetPaintHeight;
属性PaintWidth：整数读取GetPaintWidth写入SetPaintWidth;
属性ScrollBars：TScrollStyle读取GetScrollBars写入SetScrollBars
默认ssBoth;
结束
TDrawCellEvent =过程（发件人：TObject; ACanvas：TCanvas; ACol，
ARow：Integer; R：TRect）
THeaderGrid = class（TCustomControl）
private
FCellScroller：TPaintScroller;
FColCount：整数;
FColHeader：TPaintScroller;
FColWidth：Integer;
FOnDrawCell：TDrawCellEvent;
FOnDrawColHeader：TDrawCellEvent;
FOnDrawRowHeader：TDrawCellEvent;
FRowCount：Integer;
FRowHeader：TPaintScroller;
FRowHeight：整数;
procedure CellsScrolled（Sender：TObject）;
函数GetColHeaderHeight：Integer;
函数GetRowHeaderWidth：Integer;
程序PaintCells（ACanvas：TCanvas）;
程序PaintColHeader（ACanvas：TCanvas）;
程序PaintRowHeader（ACanvas：TCanvas）;
程序SetColCount（Value：Integer）;
程序SetColHeaderHeight（Value：Integer）;
程序SetColWidth（Value：Integer）;
程序SetRowCount（Value：Integer）;
程序SetRowHeaderWidth（Value：Integer）;
程序SetRowHeight（Value：Integer）;
procedure UpdateSize;
procedure WMEraseBkgnd（var Message：TWMEraseBkgnd）;消息WM_ERASEBKGND;
protected
procedure CreateParams（var Params：TCreateParams）;覆盖
程序DoDrawCell（ACanvas：TCanvas; ACol，ARow：Integer;
R：TRect）;虚拟;
procedure DoDrawColHeader（ACanvas：TCanvas; ACol：Integer;
R：TRect）;虚拟;
procedure DoDrawRowHeader（ACanvas：TCanvas; ARow：Integer;
R：TRect）;虚拟;
程序油漆;覆盖
public
构造函数Create（AOwner：TComponent）;覆盖
procedure MouseWheelHandler（var Message：TMessage）;覆盖
发布
属性ColCount：整数读取FColCount写SetColCount默认5;
属性ColHeaderHeight：整数读取GetColHeaderHeight
写入SetColHeaderHeight默认值24;
属性ColWidth：整数读取FColWidth写SetColWidth默认64;
属性OnDrawCell：TDrawCellEvent读取FOnDrawCell写入FOnDrawCell;
属性OnDrawColHeader：TDrawCellEvent读取FOnDrawColHeader
写入FOnDrawColHeader;
属性OnDrawRowHeader：TDrawCellEvent read FOnDrawRowHeader
write FOnDrawRowHeader;
属性RowCount：整数读取FRowCount写SetRowCount默认为5;
属性RowHeaderWidth：整数读取GetRowHeaderWidth
写入SetRowHeaderWidth默认值64;
属性RowHeight：整数读取FRowHeight写SetRowHeight默认24;
发布
属性颜色;
属性Font;
属性ParentColor default False;
属性TabStop default True;
结束
实现
{TPaintScroller}
构造函数TPaintScroller.Create（AOwner：TComponent）;
begin
继承Create（AOwner）;
ControlStyle：= [csOpaque];
HorzScrollBar.Tracking：= True;
VertScrollBar.Tracking：= True;
宽度：= 100;
身高：= 100;
FPainter：= TPaintBox.Create（Self）;
FPainter.SetBounds（0，0，100，100）;
FPainter.OnPaint：= DoPaint;
FPainter.Parent：= Self;
结束
程序TPaintScroller.CreateParams（var Params：TCreateParams）;
begin
继承CreateParams（Params）;
with Params.WindowClass do
样式：= Style not not（CS_HREDRAW或CS_VREDRAW）;
结束
函数TPaintScroller.DoMouseWheel（Shift：TShiftState;
WheelDelta：Integer; MousePos：TPoint）：Boolean;
begin
VertScrollBar.Position：= VertScrollBar.Position - WheelDelta;
DoScroll;
结果：= True;
结束
procedure TPaintScroller.DoPaint（Sender：TObject）;
begin
如果分配（FOnPaint）然后
FOnPaint（FPainter.Canvas）;
结束
程序TPaintScroller.DoScroll;
begin
如果分配（FOnScroll）然后
FOnScroll（Self）;
结束
函数TPaintScroller.GetPaintHeight：Integer;
begin
结果：= FPainter.Height;
结束
函数TPaintScroller.GetPaintWidth：Integer;
begin
结果：= FPainter.Width;
结束
函数TPaintScroller.GetScrollBars：TScrollStyle;
begin
如果HorzScrollBar.Visible和VertScrollBar.Visible然后
结果：= ssBoth
否如果不是HorzScrollBar.Visible和VertScrollBar.Visible然后
结果：= ssVertical
else如果HorzScrollBar.Visible而不是VertScrollBar.Visible然后
结果：= ssHorizontal
else
结果：= ssNone;
结束
程序TPaintScroller.PaintWindow（DC：HDC）;
开始
与FPainter do
ExcludeClipRect（DC，0，0，Width + Left，Height + Top）;
FillRect（DC，ClientRect，Brush.Handle）;
结束
程序TPaintScroller.Resize;
begin
DoScroll;
继承了Resize;
结束
程序TPaintScroller.SetPaintHeight（Value：Integer）;
begin
FPainter.Height：= Value;
结束
程序TPaintScroller.SetPaintWidth（Value：Integer）;
begin
FPainter.Width：= Value;
结束
程序TPaintScroller.SetScrollBars（Value：TScrollStyle）;
begin
HorzScrollBar.Visible：=（Value = ssBoth）或（Value = ssHorizontal）;
VertScrollBar.Visible：=（Value = ssBoth）或（Value = ssVertical）;
结束
程序TPaintScroller.WMEraseBkgnd（var Message：TWMEraseBkgnd）;
begin
Message.Result：= 1;
结束
程序TPaintScroller.WMHScroll（var Message：TWMScroll）;
开始
继承;
DoScroll;
结束
程序TPaintScroller.WMVScroll（var Message：TWMScroll）;
开始
继承;
DoScroll;
结束
{THeaderGrid}
程序THeaderGrid.CellsScrolled（发件人：TObject）;
begin
FColHeader.FPainter.Left：= -FCellScroller.HorzScrollBar.Position;
FRowHeader.FPainter.Top：= -FCellScroller.VertScrollBar.Position;
结束
构造函数THeaderGrid.Create（AOwner：TComponent）;
begin
继承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：=自我;
FRowHeader：= TPaintScroller.Create（Self）;
FRowHeader.Anchors：= [akLeft，akTop，akBottom];
FRowHeader.OnPaint：= PaintRowHeader;
FRowHeader.ScrollBars：= ssNone;
FRowHeader.Parent：=自我;
宽度：= 320;
身高：= 120;
ColCount：= 5;
RowCount：= 5;
ColWidth：= 64;
RowHeight：= 24;
ColHeaderHeight：= 24;
RowHeaderWidth：= 64;
结束
程序THeaderGrid.CreateParams（var Params：TCreateParams）;
begin
继承CreateParams（Params）;
with Params.WindowClass do
样式：= Style not not（CS_HREDRAW或CS_VREDRAW）;
结束
程序THeaderGrid.DoDrawCell（ACanvas：TCanvas; ACol，ARow：Integer;
R：TRect）;
begin
如果分配（FOnDrawCell）然后
FOnDrawCell（Self，ACanvas，ACol，ARow，R）;
结束
procedure THeaderGrid.DoDrawColHeader（ACanvas：TCanvas; ACol：Integer;
R：TRect）;
begin
如果Assigned（FOnDrawColHeader）然后
FOnDrawColHeader（Self，ACanvas，ACol，-1，R）;
结束
程序THeaderGrid.DoDrawRowHeader（ACanvas：TCanvas; ARow：Integer;
R：TRect）;
begin
if Assigned（FOnDrawRowHeader）then
FOnDrawRowHeader（Self，ACanvas，-1，ARow，R）;
结束
函数THeaderGrid.GetColHeaderHeight：Integer;
begin
结果：= FColHeader.Height;
结束
函数THeaderGrid.GetRowHeaderWidth：Integer;
begin
结果：= FRowHeader.Width;
结束
程序THeaderGrid.MouseWheelHandler（var Message：TMessage）;
begin
with Message do
结果：= FCellScroller.Perform（CM_MOUSEWHEEL，WParam，LParam）;
如果Message.Result = 0然后
继承MouseWheelHandler（Message）;
结束
程序THeaderGrid.Paint;
var
R：TRect;
begin
Canvas.Brush.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）;
结束
程序THeaderGrid.PaintCells（ACanvas：TCanvas）;
var
Col：Integer;
行：整数;
R：TRect;
Dummy：TRect;
开始
ACanvas.Brush.Color：=颜色;
ACanvas.Font：= Font;
ACanvas.FillRect（ACanvas.ClipRect）;
for Row：= 0 to FRowCount - 1 do
begin
R：= Bounds（0，Row * FRowHeight，FColWidth，FRowHeight）;
Col：= 0 to FColCount - 1 do
begin
if IntersectRect（Dummy，R，ACanvas.ClipRect）then
begin
DoDrawCell（ACanvas，Col， Row，R）;
如果ACanvas.Pen.Style<> psSolid然后
ACanvas.Pen.Style：= psSolid;
如果ACanvas.Pen.Color<> clSilver然后
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）;
结束
OffsetRect（R，FColWidth，0）;
结束
结束
结束
程序THeaderGrid.PaintColHeader（ACanvas：TCanvas）;
var
Col：Integer;
R：TRect;
Dummy：TRect;
begin
ACanvas.Brush.Color：=颜色;
ACanvas.Font：= Font;
ACanvas.FillRect（ACanvas.ClipRect）;
R：= Rect（0，0，FColWidth，ColHeaderHeight）;
为Col：= 0到FColCount - 1 do
begin
如果IntersectRect（Dummy，R，ACanvas.ClipRect）然后
DoDrawColHeader（ACanvas，Col，R）;
OffsetRect（R，FColWidth，0）;
结束
结束
程序THeaderGrid.PaintRowHeader（ACanvas：TCanvas）;
var
行：整数;
R：TRect;
Dummy：TRect;
begin
ACanvas.Brush.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）;
如果ACanvas.Pen.Style<> psSolid然后
ACanvas.Pen.Style：= psSolid;
如果ACanvas.Pen.Color<> clSilver然后
ACanvas.Pen.Color：= clSilver;
ACanvas.MoveTo（R.Left，R.Bottom - 1）;
ACanvas.LineTo（R.Right - 1，R.Bottom - 1）;
结束
OffsetRect（R，0，FRowHeight）;
结束
结束
程序THeaderGrid.SetColCount（Value：Integer）;
begin
如果FColCount<>值然后
begin
FColCount：= Value;
UpdateSize;
结束
结束
程序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）;
结束
结束
程序THeaderGrid.SetColWidth（Value：Integer）;
begin
如果FColWidth<>值然后
begin
FColWidth：= Value;
FCellScroller.HorzScrollBar.Increment：= Value;
UpdateSize;
结束
结束
程序THeaderGrid.SetRowCount（Value：Integer）;
begin
如果FRowCount<>值
begin
FRowCount：= Value;
UpdateSize;
结束
结束
程序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）;
结束
结束
程序THeaderGrid.SetRowHeight（Value：Integer）;
begin
如果FRowHeight<>值然后
开始
FRowHeight：= Value;
FCellScroller.VertScrollBar.Increment：= Value;
UpdateSize;
结束
结束
程序THeaderGrid.UpdateSize;
begin
FColHeader.PaintWidth：= FColCount * FColWidth;
FRowHeader.PaintHeight：= FRowCount * FRowHeight;
FCellScroller.PaintWidth：= FColCount * FColWidth;
FCellScroller.PaintHeight：= FRowCount * FRowHeight;
结束
程序THeaderGrid.WMEraseBkgnd（var Message：TWMEraseBkgnd）;
begin
Message.Result：= 1;
结束
结束。
I'm trying to figure out how I can make a custom control in a way where user can scroll in all directions, but with a fixed row and column. A grid is not suitable for what I'm trying to do, because it scrolls column by column. I need horizontal scrolling to be smooth, pixel by pixel. I have no use for columns, only visual grid lines. Vertical scrolling should scroll not only the area on the right, but also the fixed region on the left. Same with horizontal scrolling: the header row should move along with the horizontal scrollbar.
This is just a rough draft of the final control I'm working on.
Note how the scrollbars do not cover the full control, only the larger region. The fixed column/row should also be able to move along with their corresponding scrollbar.
How should I implement the scrollbars to make this possible?
PS - This is to replace a much more thorough question which was deleted for being a mis-leading request. So sorry if I'm lacking details which you might need to know.
解决方案
First, I thought you could do with this component (sample image) which is capable of holding controls in cells, but from your comment I understand that you want to draw everything yourself. So I wrote a 'THeaderGrid' component:
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;
The component is build up out of three TPaintScroller controls (a TPaintBox on a TScrollBox). Actually, for both headers, TScrollBox is a little bit heavyweighted, but it was kind of handy to use the same control as for the data region with the cells.
There are three OnDraw events, one for both headers and one for the cells, but you could all set them to the same handler, alike the example above. Distinguish each by the column or row index being -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.
这篇关于如何创建可以用固定行和列滚动的自定义控件？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
