公布TstringGrid增强控件TcbStrGrid源码，带CheckBox的TStringGrid控件

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.