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

根特SUD

根特SUD

2016-02-19 12:38

今天图老师小编要向大家分享个公布TstringGrid增强控件TcbStrGrid源码带CheckBox的TStringGr教程,过程简单易学,相信聪明的你一定能轻松get!
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 (iComma0) 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 (Row0) 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 (ARow0) 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 (value0) 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 (Row0) 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 (Row0) 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 (Row0) 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 (Row0) 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 (valuecolCount) 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.    
展开更多 50%)
分享

猜你喜欢

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

编程语言 网络编程
公布TstringGrid增强控件TcbStrGrid源码带CheckBox的TStringGr

获得WebBrowser控件中的HTML源码

编程语言 网络编程
获得WebBrowser控件中的HTML源码

s8lol主宰符文怎么配

英雄联盟 网络游戏
s8lol主宰符文怎么配

Android控件系列之CheckBox使用介绍

编程语言 网络编程
Android控件系列之CheckBox使用介绍

带颜色的listbox控件

电脑网络
带颜色的listbox控件

lol偷钱流符文搭配推荐

英雄联盟 网络游戏
lol偷钱流符文搭配推荐

ASP.Net 分页控件源码

Web开发
ASP.Net 分页控件源码

VC增强Edit控件为日期输入控件

编程语言 网络编程
VC增强Edit控件为日期输入控件

lolAD刺客新符文搭配推荐

英雄联盟
lolAD刺客新符文搭配推荐

Command模式

Command模式

金额大写转换

金额大写转换
下拉加载更多内容 ↓