unit SGridFunction;
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;
procedure SuccessMsgbox(AMsg: String);
procedure ErrorMsgbox(AMsg: String);
function AskMsgbox(AMsg: String): Boolean;
procedure InfoMsgbox(AMsg: String);
procedure ExportToExcel(ASGrid: TStringGrid; ExcelModalPath, ExcelFileName: String;
AGridStartCol, AGridStartRow, AExcelStartCol, AExcelStartRow: Integer);
function GetColMaxDataLength(ASGrid: TStringGrid; ACol, AStartRow: Integer): Integer;
procedure SetOneColWidth(ASGrid: TStringGrid; ACol: Integer);
procedure SetAllColWidth(ASGrid: TStringGrid);
procedure ShowClientDataSetData(ASGrid: TStringGrid; ACDSet: TClientDataSet;
AGridStartCol, AGridStartRow: Integer);
procedure ShowQueryData(ASGrid: TStringGrid; AQuery: TADOQuery;
AGridStartCol, AGridStartRow: Integer);
function HaveData(ASGrid: TStringGrid; AStartCol, AStartRow: Integer): Boolean;
function GetIntegerNumberLength(ANumber: Integer): Integer;
procedure SetNumberFields(ASGrid: TStringGrid; ACol, AStartRow: Integer);
procedure SetColAlignRight(ASGrid: TStringGrid; ACol, AStartRow: Integer);
procedure SetRowLeftSpace(ASGrid: TStringGrid; ARow, SpaceLength: Integer);
procedure SetRowMinRightSpace(ASGrid: TStringGrid; ARow, SpaceLength: Integer);
procedure SetRowMinSpaceWidth(ASGrid: TStringGrid; ARow, SpaceLength: Integer);
function GetColByCX(ASGrid: TStringGrid; AX: Integer): Integer;
function GetRowByCY(ASGrid: TStringGrid; AY: Integer): Integer;
procedure GetCellByCoordinate(ASGrid: TStringGrid; AX, AY: Integer;
out ACol, ARow: Integer);
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;
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;
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;
try
ExcelApp := CreateOleObject( 'Excel.Application' );
except
ErrorMsgBox('请确认您的机器已经安装 Microsoft Excel 。');
Exit;
end;
try
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
ExcelApp.ActiveSheet.Columns[AExcelStartCol + ColIndex].ColumnWidth
:= GetColMaxDataLength(ASGrid, AGridStartCol + ColIndex, AGridStartRow);
end;
ExcelApp.Cells.NumberFormatLocal := '@';
end;
ExcelApp.WorkSheets[1].Activate;
ExcelApp.Cells.Item[AExcelStartRow, AExcelStartCol].Select;
except
ErrorMsgBox('无法打开报表模版：' + #13 + ExcelModalPath);
exit;
end;
try
try
DataList := TStringList.Create;
DataList.Clear;
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;
end;
DataList.Add(OneRowData);
end;
end;
ClipBoard.AsText := DataList.Text;
ExcelApp.ActiveSheet.Paste;
finally
DataList.Free;
ClipBoard.Clear;
end;
ExcelApp.ActiveWorkbook.SaveAs(SaveExcelFilePath);
SuccessMsgBox('成功将文件保存到：' + #13 + SaveExcelFilePath);
finally
ExcelApp.DisplayAlerts := false;
ExcelApp.WorkBooks.Close;
end;
finally
ExcelApp.Quit;
ExcelApp:= Unassigned;
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;
OneCharPixel := 6;
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;
procedure ShowClientDataSetData(ASGrid: TStringGrid; ACDSet: TClientDataSet;
客服电话
APP下载
官方微信
请发表评论