一個可以顯示CheckBox或RadioButtons的StringGrid類.

2016-02-19 14:18 12 1 收藏

下面,图老师小编带您去了解一下一個可以顯示CheckBox或RadioButtons的StringGrid類.,生活就是不断的发现新事物,get新技能~

【 tulaoshi.com - 编程语言 】

 

  unit StringGridEx;

  interface

  uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    Grids;

(本文来源于图老师网站,更多请访问https://www.tulaoshi.com/bianchengyuyan/)

  type TBtns = (CheckBoxes,RadioButtons);

(本文来源于图老师网站,更多请访问https://www.tulaoshi.com/bianchengyuyan/)

  type
    TStringGridEx = class(TStringGrid)
    private
      { Private declarations }
      FTickCol:Integer;
      FShowTick:Boolean;
      FSelArray:Array of Boolean;
      FSelRows:Array of TStrings;
      FRowHeight:integer;
      FDblClick:TNotifyEvent;
      FSelectCell:TSelectCellEvent;
      FBtns : TBtns;
      IsDblClicked:Boolean;
      FTitles:TStrings;

      procedure SetTickCol(Value : integer);
      procedure SetShowTick(Value : Boolean);
      procedure SetRowHeight(Value:Integer);
      procedure SetBtns(Value : TBtns);
      procedure SetRowSelected(RowIndex:integer;Value:Boolean);
      procedure DoSelectCell(Sender: TObject; ACol, ARow: Longint;
       var CanSelect: Boolean);
      procedure DoDblClick(Sender:TObject);

      function GetCurrentRow:integer;
      function GetRowSelected(RowIndex : Integer):Boolean;
      function GetSelCells(ColIndex,RowIndex:integer):String;
      function GetSelCnt:Integer;
  
    procedure SetTitles(Value : TStrings);
    protected
      { Protected declarations }
      procedure SizeChanged(OldColCount, OldRowCount: Longint);override;
      procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
        AState: TGridDrawState);override;
    public
      { Public declarations }
      constructor Create(AOwner:Tcomponent);override;
      destructor Destroy;override;
      property ColWidths;
      property RowHeights;

      procedure SelectAll;
      procedure UnSelectAll;

      property CurrentRow :Integer read GetCurrentRow;
      property SelectCount:Integer read GetSelCnt;
      property RowSelected[RowIndex:Integer]:Boolean read GetRowSelected write SetRowSelected;
      property CellsOfSelection[Col,Row:Integer]:String read GetSelCells;

    published
      { Published declarations }
      property ShowTick:Boolean read FShowTick write SetShowTick default false;
      property TickCol:integer read FTickCol write SetTickCol default -1;
      property TickButton : TBtns read FBtns write SetBtns default CheckBoxes;
      property Titles:TStrings read FTitles write SetTitles;
      property RowHeight:Integer read FRowHeight write SetRowHeight default 18;

      property OnCellDblClick:TNotifyEvent read FDblClick write FDblClick;
      property OnCellSelected:TSelectCellEvent read FSelectCell write FSelectCell;
    end;

  procedure Register;

  implementation

  procedure Register;
  begin
    RegisterComponents('MyControls', [TStringGridEx]);
  end;

  constructor TStringGridEx.Create(AOwner:Tcomponent);
  var i:integer;
  begin
    inherited;
    FTitles := TStringList.Create;
    FTitles.Clear;
    SetLength(FSelArray,RowCount);
    SetLength(FSelRows,RowCount);
    for i:=0 to Rowcount-1 do
     FSelRows[i] := TStringList.Create;
    IsDblClicked := False;
    OnDblClick := DoDblClick;
    OnSelectCell := DoSelectCell;
    for i:=0 to RowCount -1 do
      if FRowHeight RowHeights[i] then FRowHeight := RowHeights[i];
  end;

  destructor TStringGridEx.Destroy;
  var i:integer;
  begin
    for i:=0 to RowCount-1 do
     FSelRows[i].Free;
    FTitles.Free;
    inherited;
  end;

  procedure TStringGridEx.DrawCell(ACol, ARow: Longint; ARect: TRect;
    AState: TGridDrawState);
  var Checked:Boolean;
  const
    CheckBox : array[Boolean] of Integer = (DFCS_BUTTONCHECK,
    DFCS_BUTTONCHECK or DFCS_CHECKED);
    RadioButton : array[Boolean] of Integer = (DFCS_BUTTONRADIO,
    DFCS_BUTTONRADIO or DFCS_CHECKED);
  begin

    inherited DrawCell(ACol, ARow,ARect,AState);
    if FShowTick and (ACol = FTickCol) and (ARow = FixedRows) then 
    begin
      Checked := FSelArray[ARow];
      Canvas.FillRect(ARect);
      if FBtns = CheckBoxes then
        DrawFrameControl(Canvas.Handle,ARect,DFC_BUTTON,
            CheckBox[Checked])
      else
      DrawFrameControl(Canvas.Handle,ARect,DFC_BUTTON,
          RadioButton[Checked]);
    end;

  end;

  procedure TStringGridEx.SetTickCol(Value : Integer);
  begin
    FTickCol := Value;
  end;

  procedure TStringGridEx.SetShowTick(Value : Boolean);
  begin
    FShowTick := Value;
  end;

  function TStringGridEx.GetRowSelected(RowIndex : Integer):Boolean;
  begin
    Result := FSelArray[RowIndex];
  end;

  procedure TStringGridEx.SetRowSelected(RowIndex:integer;Value:Boolean);
  var i:integer;
  begin
    Row := RowIndex;
    if Value then begin
      FSelRows[RowIndex].Clear;
      for i:=0 to ColCount-1 do
       FSelRows[RowIndex].Add(Cells[i,RowIndex]);
    end;
    FSelArray[RowIndex] := Value;
  end;

  function TStringGridEx.GetCurrentRow : Integer;
  begin
    Result := Row;
  end;

  procedure TStringGridEx.DoDblClick(Sender : TObject);
  begin
    if FShowTick and (Col = FTickCol) then
      FSelArray[Row] := not FSelArray[Row];
    If FSelArray[Row] then
      SetRowSelected(Row,FSelArray[Row]);
    if Assigned(FDblClick) then FDblClick(Sender);
    IsDblClicked := True;
  end;

  procedure TStringGridEx.DoSelectCell(Sender: TObject; ACol, ARow: Longint;
      var CanSelect: Boolean);
  var i:integer;
  begin
    if IsDblClicked then
    begin
     if FShowTick and (ACol = FTickCol) then
      FSelArray[ARow] := not FSelArray[ARow];
    end;
    If FSelArray[ARow] then begin
      FSelRows[ARow].Clear;
      for i:=0 to ColCount-1 do
       FSelRows[ARow].Add(Cells[i,ARow]);
    end;
    if Assigned(FSelectCell) then FSelectCell(Sender,ACol,ARow,CanSelect);
  end;

  procedure TStringGridEx.SetRowHeight(Value : Integer);
  var i:integer;
  begin
    for i:=0 to RowCount -1 do
      RowHeights[i] := Value;
    FRowHeight := Value;
    Invalidate;
  end;

  procedure TStringGridEx.SetBtns(Value : TBtns);
  begin
    FBtns := value;
    Invalidate;
  end;

  procedure TStringGridEx.SizeChanged(OldColCount, OldRowCount: Longint);
  var i:integer;
  begin
    inherited SizeChanged(OldColCount,oldRowCount);
    SetLength(FSelArray,RowCount);
    if RowCountOldrowCount then
     for i:=0 to OldRowCount-1 do
       FSelRows[i].Free;
    SetLength(FSelRows,RowCount);
    for i:=0 to Rowcount-1 do
     FSelRows[i] := TStringList.Create;
    IsDblClicked := False;
  end;

  procedure TStringGridEx.SelectAll;
  var i:integer;
  begin
    for i:=1 to RowCount-1 do
    begin
      SetRowSelected(i,True);
    end;

    IsDblClicked := False;
    Row := 0;
    invalidate;
  end;

  procedure TStringGridEx.UnSelectAll;
  var i:integer;
  begin
    for i:=1 to RowCount-1 do
    begin
      SetRowSelected(i,False);
      FSelRows[i].Clear;
    end;

    Row :=0;
    IsDblClicked := False;
    invalidate;
  end;

  procedure TStringGridEx.SetTitles(Value : TStrings);
  begin
    if FTitlesValue then FTitles.Assign(Value);
    Rows[0].Assign(Ftitles);
    Invalidate;
  end;

  function TStringGridEx.GetSelCells(ColIndex,RowIndex:integer):String;
  var i,SelRow:integer;
  begin
    SelRow := 0;
    for i:=1 to RowCount-1 do
    begin
     if RowSelected[I] then inc(SelRow);
     if SelRow = RowIndex then Break;
    end;
    Result := FSelRows[i].Strings[ColIndex];
  end;

  function TStringGridEx.GetSelCnt:Integer;
  var i,R:integer;
  begin
    R:=0;
    for i:=0 to Rowcount-1 do
     if RowSelected[i] then Inc(R);
    Result := R;
  end;

  end.

来源:https://www.tulaoshi.com/n/20160219/1606679.html

延伸阅读
  procedure TDM.CopyDbDataToExcel(Target: TDBGridEh;mb,FileName: string); var iCount, jCount: Integer; XLApp: Variant; Sheet: Variant; begin Screen.Cursor := crHourGlass; if not VarIsEmpty(XLApp) then begin  XLApp.DisplayAlerts := False;  XLApp.Quit;  ...
标签: 电脑入门
关了灯的房间没有人会怕黑 是剩下的热咖啡没有人会喝醉 回忆后的过去被狠狠的撕碎 只剩下那些零碎的记忆 -------------------------------------------------------------------------------- /。       、  、        - ○ -       ′...
标签: ASP
  我们知道,如果在asp,只要response.write request.form("checkboxName")就可以判断是否有选择至少一项,但是必须递交后才可以这样做,那么就要接触脚本语言js,vbs 假设我们有个checkbox叫optHSCameratyp,我们写个函数来判断 function chkCheckBoxChs(objNam){ //檢測是否有選擇多选框的至少一项  var obj = document.getEleme...
产妇营养小贴示 经过辛苦的十月怀胎,孕妈们还要经历产后保养,生产会让妈妈们的身体状况很虚弱,怎样才能帮孕妈妈们快速恢复体力,又能让孕妈有充足的营养?一起看看图老师小编为妈妈们送上的产妇营养小贴示吧。   红糖 营养特点:含铁量高,给产妇补血。 营养作用:含多种微量元素和...
饮食可以加速或延缓衰老 加速衰老的食物 1、酒精饮料 生活中大量或经常饮酒,会使肝脏发生酒精中毒而致使发炎肿大,导致男性精子畸形,性功能衰退、阳痿等;女子则会出现月经不调,停止排卵,性欲减退甚至性冷淡等早衰现象。 2、含铅食品 铅会使脑内去钾肾上腺素、多巴胺和5-羟色胺的含量明显降低,造成神经...

经验教程

358

收藏

34
微博分享 QQ分享 QQ空间 手机页面 收藏网站 回到头部