公布TstringGrid增強控件TcbStrGrid源碼，帶CheckBox的TStringGrid控件

2019-11-18 18:21:19

字體：大中小

來源：轉載

供稿：網友

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.

上一篇：關于DBGRIDEH導出數據到CSV

下一篇：新世紀的五四運動：程序白話文(1)