Delphi关于StringGrid的公用模块[转]
unit SGridFunction; {******************************************* 模块名称:StringGrid操作函数模块 编写者:Tony 开始日期:2006年12月05日 版本号:v1.0.7 ********************************************} interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,SConnect, Dialogs, Global, Grids, DBGrids, DB, DBClient, WinSkinData, StdCtrls, Buttons, ExtCtrls, ComCtrls, ComObj, Clipbrd, ADODB; //成功提示框 //AMsg: 成功提示信息 procedure SuccessMsgbox(AMsg: String ); //错误提示框 //AMsg: 错误提示信息 procedure ErrorMsgbox(AMsg: String ); //询问提示框 //strMsg:询问信息 function AskMsgbox(AMsg: String ): Boolean ; //信息提示框 //AMsg: 提示信息 procedure InfoMsgbox(AMsg: String ); //导出数据到Excel //ASGrid:需要导出的StringGrid //ExcelModalPath: 报表模版全路径,为空则新建工作簿 //ExcelFileName: Excel文件的默认文件名 //AGridStartCol, AGridStartRow: StringGrid的起始列和行,从0开始 //AExcelStartCol, AExcelStartRow: Excel的起始列和行,从1开始 procedure ExportToExcel(ASGrid: TStringGrid; ExcelModalPath, ExcelFileName: String ; AGridStartCol, AGridStartRow, AExcelStartCol, AExcelStartRow: Integer ); //取得某一列数据的最大长度 //ASgrid: 目标StringGrid //ACol: 目标列,从0开始 //AStartRow: 起始行,从0开始 function GetColMaxDataLength(ASGrid: TStringGrid; ACol, AStartRow: Integer ): Integer ; //根据数据长度自动设置指定列的列宽 //ASgrid: 目标StringGrid //ACol: 目标列,从0开始 procedure SetOneColWidth(ASGrid: TStringGrid; ACol: Integer ); //根据数据长度自动设置全部列的列宽 //ASgrid: 目标StringGrid procedure SetAllColWidth(ASGrid: TStringGrid); //显示ClientDataSet中的数据 //ASgrid: 目标StringGrid //ACDSet: 包含数据的ClientDataSet //AGridStartCol, AGridStartRow: StringGrid的起始列和行,从0开始 procedure ShowClientDataSetData(ASGrid: TStringGrid; ACDSet: TClientDataSet; AGridStartCol, AGridStartRow: Integer ); //显示ADOQuery中的数据 //ASgrid: 目标StringGrid //AQuery: 包含数据的ADOQuery //AGridStartCol, AGridStartRow: StringGrid的起始列和行,从0开始 procedure ShowQueryData(ASGrid: TStringGrid; AQuery: TADOQuery; AGridStartCol, AGridStartRow: Integer ); //判断是否含有数据 //true: 包含数据 //false: 不包含数据 //ASgrid: 目标StringGrid //AStartCol, AStartRow: 起始列和行,从0开始 function HaveData(ASGrid: TStringGrid; AStartCol, AStartRow: Integer ): Boolean ; //取得9位以内整数位数 //>=1: 该整型数的长度 //0: 空值 //-1: 长度超过9位 //ANumber: 需要判断位数的整型数 function GetIntegerNumberLength(ANumber: Integer ): Integer ; //为指定的序号列赋值 //序号编号从1开始 //ASGrid: 目标StringGrid //ACol: 目标列,从0开始 //AStartRow: 起始行,从0开始 procedure SetNumberFields(ASGrid: TStringGrid; ACol, AStartRow: Integer ); //设置指定的列的对齐方式为右对齐 //实现方式为在数据左边补空格,所以取数据时应注意去掉空格 //ASGrid: 目标StringGrid //ACol: 目标列,从0开始 //AStartRow: 起始行,从0开始 procedure SetColAlignRight(ASGrid: TStringGrid; ACol, AStartRow: Integer ); //设置指定行的左边距 //ASGrid: 目标StringGrid //ARow: 目标行,从0开始 procedure SetRowLeftSpace(ASGrid: TStringGrid; ARow, SpaceLength: Integer ); //设置指定行的最小右边距 //ASGrid: 目标StringGrid //ARow: 目标行,从0开始 procedure SetRowMinRightSpace(ASGrid: TStringGrid; ARow, SpaceLength: Integer ); //设置指定行的最小边距 //ASGrid: 目标StringGrid //ARow: 目标行,从0开始 procedure SetRowMinSpaceWidth(ASGrid: TStringGrid; ARow, SpaceLength: Integer ); //获得当前X坐标所在的列 //ASGrid: 目标StringGrid //AX: 坐标的X值 function GetColByCX(ASGrid: TStringGrid; AX: Integer ): Integer ; //获得当前Y坐标所在的行 //ASGrid: 目标StringGrid //AY: 坐标的Y值 function GetRowByCY(ASGrid: TStringGrid; AY: Integer ): Integer ; //获得当前坐标所处的单元格的行列值 //ASGrid: 目标StringGrid //AX, AY: 坐标的X,Y值 //ACol, ARow: 单元格的列,行索引,从0开始 procedure GetCellByCoordinate(ASGrid: TStringGrid; AX, AY: Integer ; out ACol, ARow: Integer ); //填充空的单元格为指定值 //ASGrid: 目标StringGrid //AStartCol, AStartRow: 开始列和行,从0开始 //AEndCol, AEndRow: 结束列和行 //AValue: 填充值 procedure SetSpaceCells(ASGrid: TStringGrid; AStartCol, AStartRow, AEndCol, AEndRow: Integer ; AValue: String ); implementation //----------------------------------------------------------------------------// //成功提示框 //----------------------------------------------------------------------------// procedure SuccessMsgbox(AMsg: String ); begin Application . MessageBox( Pchar (AMsg), '完成' , MB_ICONINFORMATION + MB_OK); end ; //----------------------------------------------------------------------------// //错误提示框 //----------------------------------------------------------------------------// procedure ErrorMsgbox(AMsg: String ); begin Application . MessageBox( Pchar (AMsg), '错误' , MB_ICONSTOP + MB_OK); end ; //----------------------------------------------------------------------------// //询问提示框 //----------------------------------------------------------------------------// function AskMsgbox(AMsg: String ): Boolean ; begin if Application . MessageBox( Pchar (AMsg), '确认' , MB_ICONQUESTION + MB_YESNO) = IDYES then begin result := true ; end else begin result := false ; end ; end ; //----------------------------------------------------------------------------// //消息提示框 //----------------------------------------------------------------------------// procedure InfoMsgbox(AMsg: String ); begin Application . MessageBox( Pchar (AMsg), '提示' , MB_ICONINFORMATION + MB_OK); end ; //----------------------------------------------------------------------------// //导出数据到Excel //----------------------------------------------------------------------------// procedure ExportToExcel(ASGrid: TStringGrid; ExcelModalPath, ExcelFileName: String ; AGridStartCol, AGridStartRow, AExcelStartCol, AExcelStartRow: Integer ); var ExcelApp: Variant; ColIndex, RowIndex: Integer ; OneRowData: String ; //单行数据 DataList: TStringList; //所有数据 SaveDlg: TSaveDialog; //保存对话框 SaveExcelFilePath: String ; //Excel文件的保存路径 begin try //没有数据时直接退出 if not HaveData(ASGrid, AGridStartCol, AGridStartRow) then begin InfoMsgBox( '没有数据需要导出。' ); exit; end ; //选择保存路径 try SaveDlg := TSaveDialog . Create(ASGrid); //创建保存窗口对象 SaveDlg . InitialDir := ExtractFilePath(Application . ExeName); //文件保存在当前目录 SaveDlg . Filter := 'Excel Files(*.xls)| *.xls' ; //文件类型过滤 SaveDlg . FileName := ExcelFileName + VarToStr(date); //定义默认文件名 if SaveDlg . Execute then begin SaveExcelFilePath := SaveDlg . FileName; //保存文件路径 end else begin exit; //放弃导出 end ; finally SaveDlg . Free; //释放对象 end ; //创建Excel对象 try ExcelApp := CreateOleObject( 'Excel.Application' ); //创建新Excel对象 except ErrorMsgBox( '请确认您的机器已经安装 Microsoft Excel 。' ); Exit; end ; try //打开Excel工作簿 try //打开报表模版 if (excelModalPath <> null) and (excelModalPath <> '' ) then begin ExcelApp . WorkBooks . Open(ExcelModalPath); end //添加新工作簿 else begin ExcelApp . WorkBooks . Add; //设置列宽 for ColIndex := 0 to ASGrid . ColCount - AGridStartCol - 1 do begin //此处不能使用ASGrid.ColWidths[AGridStartCol + ColIndex]; ExcelApp . ActiveSheet . Columns[AExcelStartCol + ColIndex].ColumnWidth := GetColMaxDataLength(ASGrid, AGridStartCol + ColIndex, AGridStartRow); end ; //数字 NumberFormatLocal = "0.00_ " //日期 NumberFormatLocal = "yyyy-m-d" //时间 NumberFormatLocal = "[$-F400]h:mm:ss AM/PM" //文本 NumberFormatLocal = "@" ExcelApp . Cells . NumberFormatLocal := '@' ; //设置单元格为文本格式 end ; ExcelApp . WorkSheets[ 1 ].Activate; //设置第1个工作表为活动工作表 ExcelApp . Cells . Item[AExcelStartRow, AExcelStartCol].Select; //设定Excel起始单元格 except ErrorMsgBox( '无法打开报表模版:' + # 13 + ExcelModalPath); //#13为回车换行 exit; end ; try //通过剪切板导出数据 try //初始化DataList DataList := TStringList . Create; DataList . Clear; //将数据保存到DataList with ASGrid do begin //行 for RowIndex := AGridStartRow to RowCount - 1 do begin OneRowData := '' ; //列 for ColIndex := AGridStartCol to ColCount - 1 do begin OneRowData := OneRowData + Trim(Cells[ColIndex, RowIndex]) + # 9 ; //#9为制表符 end ; DataList . Add(OneRowData); //将该行数据添加到DataList end ; end ; ClipBoard . AsText := DataList . Text; //将DataList中的数据拷贝到剪切板 ExcelApp . ActiveSheet . Paste; //将剪切板中的数据拷贝到Excel finally DataList . Free; //释放DataList ClipBoard . Clear; //清空剪切板 end ; //保存Excel文件 ExcelApp . ActiveWorkbook . SaveAs(SaveExcelFilePath); //另存为到指定目录 SuccessMsgBox( '成功将文件保存到:' + # 13 + SaveExcelFilePath); //保存成功 finally ExcelApp . DisplayAlerts := false ; //不弹出保存提示对话框 ExcelApp . WorkBooks . Close; //关闭工作簿 end ; finally ExcelApp . Quit; //关闭Excel进程 ExcelApp:= Unassigned; //释放ExcelApp end ; except On e: Exception do begin ErrorMsgbox(e . Message); end ; end ; end ; //----------------------------------------------------------------------------// //取得某一列数据的最大长度 //----------------------------------------------------------------------------// function GetColMaxDataLength(ASGrid: TStringGrid; ACol, AStartRow: Integer ): Integer ; var ColIndex, RowIndex: Integer ; MaxColLength: Integer ; //列数据的最大长度 begin MaxColLength := 0 ; with ASGrid do begin //取得列数据的最大长度 for RowIndex := AStartRow to RowCount - 1 do begin if length(Cells[ACol, RowIndex]) > MaxColLength then begin MaxColLength:= length(Cells[ACol, RowIndex]); end ; end ; end ; result := MaxColLength; end ; //----------------------------------------------------------------------------// //根据数据长度自动设置指定列的列宽 //----------------------------------------------------------------------------// procedure SetOneColWidth(ASGrid: TStringGrid; ACol: Integer ); var OneCharPixel: Integer ; //一个字符所占的像素数 RightSpaceWidth: Integer ; //右边距空隙 begin RightSpaceWidth := 3 ; //设置为3达到和左边距一致的效果 OneCharPixel := 6 ; //6对应9号字[*此处最好写成一个根据字号获得像素值的函数*] ASGrid . ColWidths[ACol] := GetColMaxDataLength(ASGrid, ACol, 0 ) * OneCharPixel + RightSpaceWidth; end ; //----------------------------------------------------------------------------// //根据数据长度自动设置全部列的列宽 //----------------------------------------------------------------------------// procedure SetAllColWidth(ASGrid: TStringGrid); var ColIndex: Integer ; //需要设置的列 begin for ColIndex := 0 to ASGrid . ColCount - 1 do begin SetOneColWidth(ASGrid, ColIndex); end ; end ; //----------------------------------------------------------------------------// //显示ClientDataSet中的数据 //----------------------------------------------------------------------------// procedure ShowClientDataSetData(ASGrid: TStringGrid; ACDSet: TClientDataSet; AGridStartCol, AGridStartRow: Integer ); var ColIndex: Integer ; RowIndex: Integer ; begin try with ASGrid do begin //没有记录时,清空StringGrid并返回 if ACDSet . RecordCount <= 0 then begin RowCount := 2 ; for ColIndex := 0 to ColCount - 1 do begin Cells[ColIndex, 1 ] := '' ; end ; exit; end ; RowCount := AGridStartRow + ACDSet . RecordCount; //StringGrid行数 ColCount := AGridStartCol + ACDSet . FieldCount; //StringGrid列数 RowIndex := AGridStartRow; //当前行为起始行 while not ACDSet . Eof do begin //显示数据 for ColIndex := AGridStartCol to ColCount - 1 do begin Cells[ColIndex, RowIndex] := ACDSet . Fields . Fields[ColIndex - AGridStartCol].AsString end ; //转到下一行 RowIndex := RowIndex + 1 ; ACDSet . Next; end ; end ; except On e: Exception do begin ErrorMsgBox(e . Message); end ; end ; end ; //----------------------------------------------------------------------------// //显示ADOQuery中的数据 //----------------------------------------------------------------------------// procedure ShowQueryData(ASGrid: TStringGrid; AQuery: TADOQuery; AGridStartCol, AGridStartRow: Integer ); var ColIndex: Integer ; RowIndex: Integer ; begin try with ASGrid do begin //没有记录时,清空StringGrid并返回 if AQuery . RecordCount <= 0 then begin RowCount := 2 ; for ColIndex := 0 to ColCount - 1 do begin Cells[ColIndex, 1 ] := '' ; end ; exit; end ; RowCount := AGridStartRow + AQuery . RecordCount; //StringGrid行数 ColCount := AGridStartCol + AQuery . FieldCount; //StringGrid列数 RowIndex := AGridStartRow; //当前行为起始行 while not AQuery . Eof do begin //显示数据 for ColIndex := AGridStartCol to ColCount - 1 do begin Cells[ColIndex, RowIndex] := AQuery . Fields . Fields[ColIndex - AGridStartCol].AsString end ; //转到下一行 RowIndex := RowIndex + 1 ; AQuery . Next; end ; end ; except On e: Exception do begin ErrorMsgBox(e . Message); end ; end ; end ; //----------------------------------------------------------------------------// //判断是否含有数据 //----------------------------------------------------------------------------// function HaveData(ASGrid: TStringGrid; AStartCol, AStartRow: Integer ): Boolean ; var ColIndex, RowIndex: Integer ; begin with ASgrid do begin for ColIndex := AStartCol to ColCount - 1 do begin for RowIndex := AStartRow to RowCount - 1 do begin //包含数据,返回true if Cells[ColIndex, RowIndex] <> '' then begin result := true ; exit; end ; end ; end ; end ; //没有数据,返回false result := false ; end ; //----------------------------------------------------------------------------// //取得9位以内整数位数 //----------------------------------------------------------------------------// function GetIntegerNumberLength(ANumber: Integer ): Integer ; var IsNegativeNumber: Boolean ; //参数的正负,负数为true LoopIndex: Integer ; //循环变量 ComporeNumber: Integer ; //用于比较的数 NumberLength: Integer ; //返回值,长度大于10返回-1 begin if ANumber = null then begin result := 0 ; //空值返回0 exit; end ; //判断参数的正负 if ANumber < 0 then begin ANumber := 0 - ANumber; //转换成正数用于计算长度 IsNegativeNumber := true ; //是负数 end else begin if ANumber = 0 then begin result := 1 ; //是0,直接返回1 exit; end ; IsNegativeNumber := false ; //是正数 end ; //开始比较 ComporeNumber:= 10 ; for LoopIndex:= 1 to 9 do begin //长度符合要求 if (ComporeNumber div ANumber) > 0 then begin //得到长度 if ComporeNumber = ANumber then NumberLength := LoopIndex + 1 else NumberLength := LoopIndex; //如果是负数,则长度加1,即包含负号 if IsNegativeNumber then result:= NumberLength + 1 else result := NumberLength; exit; end ; //增大1位继续比较 ComporeNumber := ComporeNumber * 10 ; continue; end ; result := - 1 ; //长度大于9,返回-1 end ; //----------------------------------------------------------------------------// //为指定的序号列赋值 //----------------------------------------------------------------------------// procedure SetNumberFields(ASGrid: TStringGrid; ACol, AStartRow: Integer ); var RowIndex: Integer ; //当前序号 begin with ASGrid do begin for RowIndex := 1 to RowCount - AStartRow do begin //添加序号 Cells[ACol, AStartRow + RowIndex - 1 ] := VarToStr(RowIndex); end ; end ; end ; //----------------------------------------------------------------------------// //设置指定的列的对齐方式为右对齐 //----------------------------------------------------------------------------// procedure SetColAlignRight(ASGrid: TStringGrid; ACol, AStartRow: Integer ); var RowIndex: Integer ; MaxDataLength: Integer ; //该列最大的数据长度 begin MaxDataLength := GetColMaxDataLength(ASGrid, ACol, 0 ); //取得该列最大的数据长度 with ASGrid do begin for RowIndex := AStartRow to RowCount - 1 do begin while length(Cells[ACol, RowIndex]) < MaxDataLength do begin Cells[ACol, RowIndex] := ' ' + Cells[ACol, RowIndex]; //在前面补空格 end ; end ; end ; end ; //----------------------------------------------------------------------------// //设置指定行的左边距 //----------------------------------------------------------------------------// procedure SetRowLeftSpace(ASGrid: TStringGrid; ARow, SpaceLength: Integer ); var ColIndex, LoopIndex: Integer ; begin with ASGrid do begin for ColIndex := 0 to ColCount - 1 do begin Cells[ColIndex, ARow] := TrimLeft(Cells[ColIndex, ARow]); //去掉左边空格 for LoopIndex := 1 to SpaceLength do begin Cells[ColIndex, ARow] := ' ' + Cells[ColIndex, ARow]; //在左边补空格 end ; end ; end ; end ; //----------------------------------------------------------------------------// //设置指定行的最小右边距 //----------------------------------------------------------------------------// procedure SetRowMinRightSpace(ASGrid: TStringGrid; ARow, SpaceLength: Integer ); var ColIndex, LoopIndex: Integer ; begin with ASGrid do begin for ColIndex := 0 to ColCount - 1 do begin Cells[ColIndex, ARow] := TrimRight(Cells[ColIndex, ARow]); //去掉右边空格 for LoopIndex := 1 to SpaceLength do begin Cells[ColIndex, ARow] := Cells[ColIndex, ARow] + ' ' ; //在右边补空格 end ; end ; end ; end ; //----------------------------------------------------------------------------// //设置指定行的最小边距 //----------------------------------------------------------------------------// procedure SetRowMinSpaceWidth(ASGrid: TStringGrid; ARow, SpaceLength: Integer ); var ColIndex, LoopIndex: Integer ; begin with ASGrid do begin for ColIndex := 0 to ColCount - 1 do begin Cells[ColIndex, ARow] := Trim(Cells[ColIndex, ARow]); //去掉两边空格 for LoopIndex := 1 to SpaceLength do begin Cells[ColIndex, ARow] := ' ' + Cells[ColIndex, ARow] + ' ' ; //在两边补空格 end ; end ; end ; end ; //----------------------------------------------------------------------------// //获得当前X坐标所在的列 //----------------------------------------------------------------------------// function GetColByCX(ASGrid: TStringGrid; AX: Integer ): Integer ; var ColIndex: Integer ; CurCellRect: TRect; //当前列的矩形区域 begin with ASGrid do begin for ColIndex := 0 to ColCount - 2 do begin CurCellRect := CellRect(ColIndex, 0 ); //当前列被隐藏,继续判断下一列 if CurCellRect . Left = CurCellRect . Right then continue; //X坐标在当前列的范围内 if (AX >= CurCellRect . Left) and (AX < CurCellRect . Right) then begin result := ColIndex; exit; end ; end ; result := ColCount - 1 ; //返回最后一列的索引 end ; end ; //----------------------------------------------------------------------------// //获得当前Y坐标所在的行 //----------------------------------------------------------------------------// function GetRowByCY(ASGrid: TStringGrid; AY: Integer ): Integer ; var RowIndex: Integer ; CurCellRect: TRect; //当前行的矩形区域 begin with ASGrid do begin for RowIndex := 0 to RowCount - 2 do begin CurCellRect := CellRect( 0 , RowIndex); //当前行被隐藏,继续判断下一行 if CurCellRect . Top = CurCellRect . Bottom then continue; //Y坐标在当前行的范围内 if (AY > CurCellRect . Top) and (AY < CurCellRect . Bottom) then begin result := RowIndex; exit; end ; end ; result := RowCount - 1 ; //返回最后一行的索引 end ; end ; //----------------------------------------------------------------------------// //获得当前坐标所处的单元格的行列值 //----------------------------------------------------------------------------// procedure GetCellByCoordinate(ASGrid: TStringGrid; AX, AY: Integer ; out ACol, ARow: Integer ); begin ACol := GetColByCX(ASGrid, AX); //取得列索引 ARow := GetRowByCY(ASGrid, AY); //取得行索引 end ; //----------------------------------------------------------------------------// //填充空的单元格为指定值 //----------------------------------------------------------------------------// procedure SetSpaceCells(ASGrid: TStringGrid; AStartCol, AStartRow, AEndCol, AEndRow: Integer ; AValue: String ); var ColIndex, RowIndex: Integer ; begin with ASGrid do begin for ColIndex := AStartCol to AEndCol do begin for RowIndex := AStartRow to AEndRow do begin //单元格为空(不含空格)时填充 if Trim(Cells[ColIndex, RowIndex]) = '' then begin Cells[ColIndex, RowIndex] := AValue; end ; end ; end ; end ; end ; end . |