unit CbStrGrid;
{************************扩展的TStringGrid控件TcbStrGrid********************
[功能简介] 增强的字符串表格控件，主要功能有
1.在strGrid上显示带CheckBox的列;
2.设置列标题及列数据对齐方式，列数据的显示方式,如按货币的方式，数字的方式;
若是按货币/数字方式显示的话，能进行输入控制，即只能输入数字。
3.自动生成行号，设置要显示合计的行，自动求合计;
4.加入清除表格clear方法等
[实现思想]
1.重载DrawCell方法。按照属性的设置情况，自定义画出显示的内容。
而实际的值保持不变。
2.重载SelectCell方法实现设置只读列等。
3.重载SizeChanged方法实现自动添加行号
4.根据上面的方法其实你可以做得更多，包括
在表格中画图片，进度条等
绑定数据集，相信会对做三层很有帮助。
[关键属性/方法]
集合字符串，特指以数字和,构成的字符串,如 '1,2,3'
1.procedure clear; //清空表格中的数据
2.procedure DoSumAll; //对所有的数字列/货币求和
property OnSumValueChanged: TSumValueChanged
合计值发生变化时触发
property DisplaySumRow: Boolean
是否要显示合计，要显示合计，则用户在strGrid上编辑时，自动更新合计值，若要手动更新合计，
请调用doSumAll方法
3.property CheckColumnIndex:integer //设置带checkBox的列
property OnCheckChanged: TCheckChanged
当鼠标/空格键操作导致checkBox列的值发生变化时触发该事件
注意: 只是响应了鼠标/键盘在strGrid上操作，当在程序中赋值而导致的checkbox变化时，该事件并不触发
function NonChecked: boolean; //若没有check选择任何行返回True;
4.property TitleAlign: TTitleAlign //标题对齐方式
5.property ColsCurrency: String //以货币方式显示的列的集合字符串
property ColsNumber: String //以数字方式显示的列的集合字符串
property ColsAlignLeft: String //向左靠齐显示的列的集合字符串
property ColsAlignCenter: String //居中显示的列的集合字符串
property ColsAlignRight: String //向右靠齐显示的列的集合字符串
注意：设置时请不要重复设置列，包括checkColumnIndex，为什么呢? 请看源代码
6.property ColsReadOnly: string //设置只读的列的集合字符串，其他的列可以直接编辑
[注意事项]
按方向键有点画FocusRect时有点小问题。
[修改日志]
作者: majorsoft(杨美忠) 创建日期: 2004-6-6 修改日期 2004-6-8 Ver0.92
Email: majorcompu@163.com QQ:122646527 (dfw) 欢迎指教!
[版权声明] Ver0.92
该程序版权为majorsoft(杨美忠)所有，你可以免费地使用、修改、转载，不过请附带上本段注释，
请尊重别人的劳动成果，谢谢。
****************************************************************************}
interface
uses
Windows, SysUtils, Classes, Controls, Grids, Graphics;
const
STRSUM='合计';
type
TTitleAlign=(taLeft, taCenter, taRight); //标题对齐方式
TInteger=set of 0..254;
TCheckChanged = procedure (Sender: TObject; ARow: Longint) of object;
TSumValueChanged = procedure (Sender: TObject) of object;
TCbStrGrid = class(TStringGrid)
private
fCheckColumnIndex: integer;
FDownColor: TColor;
fIsDown: Boolean; //鼠标(或键盘)是否按下 用来显示动画效果
fTitleAlign: TTitleAlign; //标题对齐方式
FAlignLeftCols: String;
FAlignLeftSet: TInteger;
FAlignRightCols: String;
FAlignRightSet: TInteger;
FAlignCenterCols: String;
FAlignCenterSet: TInteger;
fCurrCols: string; //需要以货币方式显示的列的字符串，以','分隔
fCurrColsSet: TInteger; //需要以货币方式显示的列的序号的集合
fNumCols: string; //需要以数字方式显示的列的字符串，以','分隔
fNumColsSet: TInteger; //需要以数字方式显示的列的序号的集合
FColsReadOnly: string; //只读列的列序号字符串
FReadOnlySet: TInteger; //只读列的序号的集合
FCheckChanged: TCheckChanged; //最近check变化事件
FDisplaySumRow: Boolean;
FOnSumValueChanged: TSumValueChanged;
procedure AlterCheckColValue; //交替更换带checkbox的列的值
procedure SetAlignLeftCols(const Value: String);
procedure SetAlignCenterCols(const Value: String);
procedure SetAlignRightCols(const Value: String);
procedure setCheckColumnIndex(const value:integer);
procedure SetColorDown(const value: TColor);
procedure setTitleAlign(const value: TTitleAlign);
procedure setCurrCols(const value: string);
procedure setNumCols(const value: string);
procedure SetColsReadOnly(const Value: string);
procedure SetDisplaySumRow(const Value: Boolean);
procedure SetOnSumValueChanged(const Value: TSumValueChanged);
protected
procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
AState: TGridDrawState); override; //画
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
function SelectCell(ACol, ARow: Longint): Boolean; override;
procedure SizeChanged(OldColCount, OldRowCount: Longint); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure clear; //清空表格中的数据
procedure DoSumAll; //对所有的数字列/货币求和
function NonChecked: boolean; //若没有check选择任何行返回True;
published
property CheckColumnIndex:integer read FCheckColumnIndex write SetCheckColumnIndex default 1; //设置带checkBox的列
property ColorDown: TColor read FDownColor write SetColorDown default $00C5D6D9;
property TitleAlign: TTitleAlign read fTitleAlign write setTitleAlign default taLeft; //标题对齐方式
property ColsCurrency: String read fCurrCols write setCurrCols; //以货币方式显示的列的集合字符串
property ColsNumber: String read fNumCols write SetNumCols; //以数字方式显示的列的集合字符串
property ColsAlignLeft: String read FAlignLeftCols write SetAlignLeftCols; //向左靠齐显示的列的集合字符串
property ColsAlignCenter: String read FAlignCenterCols write SetAlignCenterCols; //居中显示的列的集合字符串
property ColsAlignRight: String read FAlignRightCols write SetAlignRightCols; //向右靠齐显示的列的集合字符串
property ColsReadOnly: string read FColsReadOnly write SetColsReadOnly; //设置只读的列的集合字符串，其他的列可以直接编辑
{property DisplaySumRow:
是否要显示合计，要显示合计，则用户在strGrid上编辑时，自动更新合计值，若要手动更新合计，
请调用doSumAll方法}
property DisplaySumRow: Boolean read FDisplaySumRow write SetDisplaySumRow;
{property OnCheckChanged:
当鼠标/空格键操作导致checkBox列的值发生变化时触发该事件
注意: 只是响应了鼠标/键盘在strGrid上操作，当在程序中赋值而导致的checkbox变化时，该事件并不触发}
property OnCheckChanged: TCheckChanged read FCheckChanged write FCheckChanged;
property OnSumValueChanged: TSumValueChanged read FOnSumValueChanged write SetOnSumValueChanged;
end;
procedure Register;
function MyStrToint(Value:string):integer;
function MyStrToFloat(str:string):extended;
function PointInRect(const pt:Tpoint; const Rect: TRect):boolean;
function ExtractNumToSet(const str: string; var aSet: TInteger):Boolean; //从 str中提取数字放到aSet集合中,若成功则返回true
implementation
function MyStrToint(value:string):integer;
begin
tryStrToInt(trim(value),result);
end;
function MyStrToFloat(str:string):extended;
begin
if trim(str)='' then
result:=0.0
else TryStrTofloat(trim(str),result);
end;
function PointInRect(const pt:Tpoint; const Rect: TRect):boolean;
begin
if (Pt.X>=Rect.Left) and (Pt.X<=Rect.Right) and
(Pt.Y>= Rect.Top) and (Pt.Y<=Rect.Bottom) then
result:=True
else result:=false;
end;
function ExtractNumToSet(const str: string; var aSet: TInteger):Boolean;
var
tmpStr:string;
iComma, i:Integer; //逗号位置
begin
aSet:=[]; //初始化集合
if Length(str)=0 then
begin
result:=true;
exit;
end;
if not (str[1] in ['0'..'9']) then //检查合法性1
begin
result:=false;
exit;
end;
for i:=1 to Length(str) do //检查合法性2
if not (str[i] in ['0'..'9', ',']) then
begin
result:=false;
exit;
end;
tmpStr:=Trim(Str);
while length(tmpStr)>0 do
begin
iComma:=pos(',', tmpStr);
if (tmpstr[1] in ['0'..'9']) then
if (iComma>0) then
begin
include(aSet, StrToInt(Copy(tmpStr, 1, iComma-1)));
tmpStr:=copy(tmpStr, iComma+1, length(tmpStr)-iComma);
end
else begin
include(aSet, StrToInt(tmpStr));
tmpStr:='';
end
else tmpStr:=copy(tmpStr, iComma+1, length(tmpStr)-iComma);
end;
result:=true;
end;
procedure Register;
begin
RegisterComponents('MA', [TCbStrGrid]);
end;
{ TCbStrGrid }
procedure TCbStrGrid.AlterCheckColValue;
begin
if (Row>0) and (col=fCheckColumnIndex) then
begin
if MyStrToint(Cells[col,Row])=0 then
Cells[col, Row]:='1'
else Cells[col, Row]:='0';
end;
end;
constructor TCbStrGrid.Create(AOwner: TComponent);
begin
inherited;
Options:=Options + [goColSizing];
fCheckColumnIndex:=1;
FDownColor:=$00C5D6D9;
Height:=150;
Width:=350;
col:=ColCount-1;
end;
destructor TCbStrGrid.Destroy;
begin
inherited;
end;
procedure TCbStrGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
AState: TGridDrawState);
var
area, CheckboxRect: TRect;
CurPt: TPoint;
value, OffSetX, OffSetY:integer;
strCell: String;
begin
Area:= ARect;
InflateRect(Area, -2, -2); //缩小区域 主要作为text out区域
if (ARow>0) then
begin
if aCol in fNumColsSet then //数字方式
begin
strCell:=FormatFloat('#,##0.##', MyStrToFloat(Cells[ACol, ARow]));
DrawText(canvas.Handle, PChar(strCell), Length(strCell), Area, DT_RIGHT) //设为靠右
end
else if aCol in fCurrColsSet then //货币方式
begin
strCell:='￥'+FormatFloat('#,###.00', MyStrToFloat(Cells[ACol, ARow]));
DrawText(canvas.Handle, PChar(strCell), Length(strCell), Area, DT_RIGHT) //设为靠右
end
else if aCol in FAlignLeftSet then
DrawText(Canvas.Handle, PChar(Cells[ACol, ARow]),Length(Cells[ACol, ARow]), Area, DT_Left)
else if aCol in FAlignCenterSet then
DrawText(Canvas.Handle, PChar(Cells[ACol, ARow]),Length(Cells[ACol, ARow]), Area, DT_Center)
else if aCol in FAlignRightSet then
DrawText(Canvas.Handle, PChar(Cells[ACol, ARow]),Length(Cells[ACol, ARow]), Area, DT_Right)
else if (aCol=fCheckColumnIndex) then //checkBox方式
begin
if (Cells[0, ARow]=STRSUM) then exit; //合计行的checkBox不画
value:=MyStrToint(Cells[fCheckColumnIndex,aRow]);
Canvas.FillRect(ARect);
with ARect do
begin
OffSetX:=(Right- Left- 10) div 2;
OffSetY:=(Bottom- Top- 10) div 2;
end;
CheckboxRect:=Rect(ARect.Left+OffSetX, ARect.Top + OffSetY, //取得checkBox要画的区域
ARect.Left+OffSetX+11, ARect.Top + OffSetY +11);
canvas.pen.style := psSolid;
canvas.pen.width := 1;
getCursorPos(CurPt);
CurPt:=self.ScreenToClient(CurPt);
{画背景}
if (fisDown) and PointInRect(CurPt, ARect) then
begin
canvas.brush.color := fDownColor;
canvas.pen.color := clBlack;
end
else begin
canvas.brush.color := color;
canvas.pen.color := clBlack;
end;
canvas.FillRect(CheckboxRect);
{ 画勾}
if (value<>0) then //不为0表示checked=true;
begin
canvas.penpos := Point(CheckboxRect.left+2, CheckboxRect.top+4);//设置起点
canvas.lineto(CheckboxRect.left+6, CheckboxRect.top+8); //画到...
canvas.penpos := Point(CheckboxRect.left+2, CheckboxRect.top+5);
canvas.lineto(CheckboxRect.left+5, CheckboxRect.top+8);
canvas.penpos := Point(CheckboxRect.left+2, CheckboxRect.top+6);
canvas.lineto(CheckboxRect.left+5, CheckboxRect.top+9);
canvas.penpos := Point(CheckboxRect.left+8, CheckboxRect.top+2);
canvas.lineto(CheckboxRect.left+4, CheckboxRect.top+6);
canvas.penpos := Point(CheckboxRect.left+8, CheckboxRect.top+3);
canvas.lineto(CheckboxRect.left+4, CheckboxRect.top+7);
canvas.penpos := Point(CheckboxRect.left+8, CheckboxRect.top+4);
canvas.lineto(CheckboxRect.left+5, CheckboxRect.top+7);
end;
{画边界}
Area:=CellRect(Col, Row);
DrawFocusRect(canvas.Handle, Area); //
canvas.brush.color :=clBlack;
canvas.FrameRect(CheckboxRect);
end
else inherited DrawCell(ACol, ARow, ARect, AState);
end
else if (ARow=0) then
begin
Canvas.FillRect(ARect);
case fTitleAlign of
taLeft: DrawText(Canvas.Handle, PChar(Cells[ACol, ARow]),Length(Cells[ACol, ARow]), Area, DT_Left);
taCenter: DrawText(Canvas.Handle, PChar(Cells[ACol, ARow]),Length(Cells[ACol, ARow]), Area, DT_Center);
taRight: DrawText(Canvas.Handle, PChar(Cells[ACol, ARow]),Length(Cells[ACol, ARow]), Area, DT_Right);
end;
end
else inherited DrawCell(ACol, ARow, ARect, AState);
end;
procedure TCbStrGrid.KeyDown(var Key: Word; Shift: TShiftState);
begin
if (key=vk_space) and (Row>0) and (col=fCheckColumnIndex)then
fIsDown:=True;
inherited;
end;
procedure TCbStrGrid.KeyUp(var Key: Word; Shift: TShiftState);
var
Area:TRect;
begin
if (key=vk_space) and (Row>0) and (col=fCheckColumnIndex)then
begin
AlterCheckColValue;
fIsDown:=false;
if Assigned(FCheckChanged) then FCheckChanged(self, Row);
end;
inherited;
if key=vk_Up then //vk_up TMD变态
begin
Area:=self.CellRect(Col, Row);
DrawFocusRect(canvas.Handle, Area);
end;
if FDisplaySumRow then DoSumAll;
end;
procedure TCbStrGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
if (Row>0) and (col=fCheckColumnIndex)then
fIsDown:=True;
inherited;
end;
procedure TCbStrGrid.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
var
curPt: TPoint;
Area:TRect;
begin
getCursorPos(CurPt);
CurPt:=self.ScreenToClient(CurPt);
Area:=self.CellRect(Col, Row);
if (Row>0) and (col=fCheckColumnIndex) and PointInRect(CurPt, Area) then
begin
AlterCheckColValue;
fIsDown:=false;
if Assigned(FCheckChanged) then FCheckChanged(self, Row);
end;
inherited;
if FDisplaySumRow then DoSumAll;
end;
procedure TCbStrGrid.SetAlignLeftCols(const Value: String);
begin
if ExtractNumToSet(Value, fAlignLeftSet) then
FAlignLeftCols := Value
else Raise Exception.Create('属性值设置错误, 请用数字和,分隔的方式设置属性');
InvalidateGrid;
end;
procedure TCbStrGrid.setCheckColumnIndex(const value: integer);
begin
if (value>colCount) then raise exception.Create('CheckColumnIndex越界');
fCheckColumnIndex:=Value;
repaint;
end;
procedure TCbStrGrid.SetColorDown(const value: TColor);
begin
fDownColor:=value;
InvalidateCell(fCheckColumnIndex, row);
end;
procedure TCbStrGrid.SetAlignCenterCols(const Value: String);
begin
if ExtractNumToSet(Value, FAlignCenterSet) then
FAlignCenterCols := Value
else Raise Exception.Create('属性值设置错误, 请用数字和,分隔的方式设置属性');
InvalidateGrid;
end;
procedure TCbStrGrid.SetAlignRightCols(const Value: String);
begin
if ExtractNumToSet(Value, FAlignRightSet) then
FAlignRightCols := Value
else Raise Exception.Create('属性值设置错误, 请用数字和,分隔的方式设置属性');
InvalidateGrid;
end;
procedure TCbStrGrid.setCurrCols(const value: string);
begin
if ExtractNumToSet(Value, fCurrColsSet) then
fCurrCols:=value
else Raise Exception.Create('属性值设置错误, 请用数字和,分隔的方式设置属性');
InvalidateGrid;
end;
procedure TCbStrGrid.setNumCols(const value: string);
begin
if ExtractNumToSet(Value, fNumColsSet) then
fNumCols:=value
else Raise Exception.Create('属性值设置错误, 请用数字和,分隔的方式设置属性');
InvalidateGrid;
end;
procedure TCbStrGrid.setTitleAlign(const value: TTitleAlign);
begin
if not(value in [taLeft, taCenter, taRight]) then Raise Exception.Create('属性值设置错误，请在[taLeft, taCenter, taRight]选择');
fTitleAlign:=value;
InvalidateGrid;
end;
function TCbStrGrid.SelectCell(ACol, ARow: Integer): Boolean;
begin
if (ACol=fCheckColumnIndex) or (ACol in FReadOnlySet) then
Options:=Options - [goEditing]
else Options:=Options + [goEditing];
Inherited SelectCell(ACol, ARow);
end;
procedure TCbStrGrid.SetColsReadOnly(const Value: string);
begin
if ExtractNumToSet(Value,FReadOnlySet) then
FColsReadOnly := Value
else Raise Exception.Create('属性值设置错误, 请用数字和,分隔的方式设置属性');
InvalidateGrid;
end;
procedure TCbStrGrid.clear;
var
i,j:integer;
begin
for i:=1 to RowCount-1 do
for j:=1 to ColCount-1 do
Cells[j,i]:=''; //注意j,i的顺序
InvalidateGrid;
end;
procedure TCbStrGrid.SizeChanged(OldColCount, OldRowCount: Integer);
var
i:integer;
begin
inherited;
for i:=1 to RowCount-1 do
Cells[0,i]:=inttostr(i);
if FDisplaySumRow then cells[0, RowCount-1]:=STRSUM;
InvalidateGrid;
end;
procedure TCbStrGrid.SetDisplaySumRow(const Value: Boolean);
begin
FDisplaySumRow := Value;
RowCount:=RowCount+1; //仅做刷新用 会调用SizeChanged
RowCount:=RowCount-1; //非常规做法。没想到好办法。
if FDisplaySumRow then DoSumAll;
InvalidateGrid;
end;
procedure TCbStrGrid.DoSumAll;
var
i, j:integer;
begin
if not fDisplaySumRow then exit;
for j:=1 to ColCount-1 do //先初始化
if (j in fCurrColsSet) or (j in fNumColsSet) then
Cells[j, RowCount-1]:='0';
for i:=1 to RowCount-2 do
for j:=1 to ColCount-1 do
if (j in fCurrColsSet) or (j in fNumColsSet) then
Cells[j, RowCount-1]:=FloatToStr((MyStrToFloat(Cells[j, RowCount-1]) + MyStrToFloat(Cells[j, i])));
if Assigned(FOnSumValueChanged) then FOnSumValueChanged(self);
end;
procedure TCbStrGrid.KeyPress(var Key: Char);
begin
if (Col in fCurrColsSet+ fNumColsSet) then
if not(key in ['0'..'9', '.', '-', char(VK_back), char(VK_Delete)]) then
key:=#0;
inherited KeyPress(Key);
end;
function TCbStrGrid.NonChecked: boolean;
var
i, iMax:integer;
begin
result:=True;
if FDisplaySumRow then IMax:= RowCount-2 else IMax:= RowCount-1;
for i:=1 to iMax do
begin
if Cells[CheckColumnIndex, i]='1' then
begin
result:=false;
exit;
end
end;
end;
procedure TCbStrGrid.SetOnSumValueChanged(const Value: TSumValueChanged);
begin
FOnSumValueChanged := Value;
end;
end.
