?? unit_public_1.pas
字號:
1:
begin
with Tbarseries.Create(Aparent) do //直方圖
begin
ParentChart:=Achart;
OldTimeSepa := TimeSeparator;
TimeSeparator := '_';
name:='series'+TimeToStr(time);
TimeSeparator := OldTimeSepa ;
title:=Atitle;
DataSource:=Atable;
XLabelsSource:=x;
YValues.ValueSource:=y;
CheckDatasource;
Marks.Style:=smsValue;
end;
end;
2:
begin
with Tpieseries.Create(Aparent) do //圓餅圖
begin
ParentChart:=Achart;
OldTimeSepa := TimeSeparator;
TimeSeparator := '_';
name:='series'+TimeToStr(time);
TimeSeparator := OldTimeSepa ;
title:=Atitle;
DataSource:=Atable;
XLabelsSource:=x;
YValues.ValueSource:=y;
CheckDatasource;
Marks.Style:=smsLabelValue;
end;
end;
end;
end;
{
*******************************************************************
* 作者：陳庭昀 編寫日期：2001-08-12 *
* *
* 函數：GF_ImportData *
* 功能：將StringGrid、DBGrid組合中的值傳至Excel文件中 *
* 參數：FileName 導出至Excel的文件名 *
* ReportTitle 報表標題名 *
* 返回值：無 *
* *
* 基本要求：系統必須按裝Excel應用軟件 *
* *
* 可導出文件：DBF、TXT、XLS *
* *
*修改歷史： *
2002.01.22日 把函數名稱修改為現在名稱，原來的名稱為ExportExcel *
*******************************************************************
}
Function GF_ExportData(FileName : String ; //數據導出的文件名，
ReportTitle : String ; //到處報表的標題
ObjectSource : TObject //導出的數據源的存放地
):Boolean; //導出成功 - true 導出錯誤 - false
Var
ExcelSaveDialog:TSaveDialog;
eclApp,WorkBook:Variant;
xlsFileName:String;
ColNumber,RowNumber:Integer;
Msg:String;
tmptable : TTable;
OutDir :string;
OutFileName :TFileName;
tmpfieldname : string;
begin
Application.CreateForm(TSaveDialog,ExcelSaveDialog);
ExcelSaveDialog.Filter:='Microsoft Excel 工作簿|*.xls|DBF文件格式|*.dbf|文本文件格式|*.txt';
ExcelSaveDialog.FileName:=FileName;
Result := False ; //加入返回默認的值，防止出現警告，add by zengzc 2002.01.21
If Not ExcelSaveDialog.Execute Then
Exit ;
case ExcelSaveDialog.FilterIndex of
1://xls
begin
If Pos('.xls',LowerCase(ExcelSaveDialog.FileName))=0 Then
xlsFileName:=ExcelSaveDialog.FileName+'.xls'
Else
xlsFileName:=ExcelSaveDialog.FileName;
If FileExists(xlsFileName) Then
Begin
Msg:=xlsFileName+'已經存在，您確定替換原來的文件嗎？';
If Application.MessageBox(Pchar(Msg),'確認文件替換',MB_ICONINFORMATION+MB_YESNO)=IDNO Then
Exit
Else
If Not DeleteFile(xlsFileName) Then
Application.MessageBox('不能正確操作該文件。可能是該文件已被其他程序打開, 或系統錯誤','提示',MB_ICONINFORMATION);
End;
Try
eclApp:=CreateOleObject('Excel.Application');
WorkBook:=CreateOleobject('Excel.Sheet');
Except
Application.MessageBox('您的機器里未安裝Microsoft Excel。','提示',MB_ICONINFORMATION);
Exit;
End;
Try
WorkBook:=eclApp.workBooks.Add;
eclApp.Cells(1,1):=ReportTitle;
If ObjectSource is TStringGrid Then
For ColNumber:=0 To TStringGrid(ObjectSource).ColCount-1 Do
For RowNumber:=0 To TStringGrid(ObjectSource).RowCount-1 Do
eclApp.Cells(RowNumber+2,ColNumber+1):=TStringGrid(ObjectSource).Cells[ColNumber,RowNumber];
If ObjectSource Is TDBGrid Then
Begin
{將DBGrid列標題名寫入Excel文件中}
For ColNumber:=0 To TDBGrid(ObjectSource).Columns.Count-1 Do
eclApp.Cells(2,ColNumber+1):=TDBGrid(ObjectSource).Columns.Items[ColNumber].Title.Caption;
{將DBGrid中的記錄寫入Excel文件中}
RowNumber:=3;
If Not ((TDBGrid(ObjectSource).DataSource.DataSet.Eof) And (TDBGrid(ObjectSource).DataSource.DataSet.Bof)) Then
Begin
TDBGrid(ObjectSource).DataSource.DataSet.First;
While Not TDBGrid(ObjectSource).DataSource.DataSet.Eof Do
Begin
For ColNumber:=0 To TDBGrid(ObjectSource).Columns.Count-1 Do
eclApp.Cells(RowNumber,ColNumber+1):=TDBGrid(ObjectSource).DataSource.DataSet.FieldByName(TDBGrid(ObjectSource).Columns.Items[ColNumber].FieldName).AsString;
RowNumber:=RowNumber+1;
TDBGrid(ObjectSource).DataSource.DataSet.Next;
End;
End;
end;
WorkBook.saveas(xlsFileName);
WorkBook.close;
eclApp.Quit;
eclApp:=Unassigned;
Msg:='數據導出成功，存放在'+xlsFileName;
Application.MessageBox(Pchar(Msg),'提示',MB_ICONINFORMATION);
Result:=True;
except
Msg:='不能正確操作Excel文件。可能是該文件已被其他程序打開, 或系統錯誤。';
Application.MessageBox(Pchar(Msg),'提示',MB_ICONINFORMATION);
WorkBook.close;
eclApp.Quit;
eclApp:=Unassigned;
Result:=False;
end;
ExcelSaveDialog.free;
end;
2://dbf;
begin
If Pos('.dbf',LowerCase(ExcelSaveDialog.FileName))=0 Then
xlsFileName:=ExcelSaveDialog.FileName+'.dbf'
Else
xlsFileName:=ExcelSaveDialog.FileName;
If FileExists(xlsFileName) Then
Begin
Msg:=xlsFileName+'已經存在，您確定替換原來的文件嗎？';
If Application.MessageBox(Pchar(Msg),'確認文件替換',MB_ICONINFORMATION+MB_YESNO)=IDNO Then
Exit
Else
If Not DeleteFile(xlsFileName) Then
Application.MessageBox('不能正確操作該文件。可能是該文件已被其他程序打開, 或系統錯誤','提示',MB_ICONINFORMATION);
End;
OutDir := '';
OutFileName := xlsFileName;
while pos('\',OutFileName)<>0 do
begin
OutDir := OutDir + Copy(OutFileName,1,pos('\',OutFileName));
OutFileName := Copy(OutFileName,pos('\',OutFileName)+1,Length(OutFileName));
end;
tmptable := TTable.Create(application);
with tmptable DO
begin
DatabaseName := OutDir;
TableType := ttFoxPro;
TableName := OutFileName;
end;
Try
If ObjectSource is TStringGrid Then
begin
with tmptable do
begin
For ColNumber:=0 To TStringGrid(ObjectSource).ColCount-1 Do
begin
//clear;
with FieldDefs.AddFieldDef do
begin
Name := 'Field'+inttostr(ColNumber);
Size := 250;
DataType := ftString;
end;
end;
CreateTable;
end;
tmptable.open;
for RowNumber:=0 to TStringGrid(ObjectSource).RowCount-1 do
begin
tmptable.Insert;
For ColNumber:=0 To TStringGrid(ObjectSource).ColCount-1 Do
tmptable.FieldByName('field'+inttostr(colnumber)).asstring := TStringGrid(ObjectSource).Cells[ColNumber,RowNumber];
tmptable.post;
end;
end;
If ObjectSource Is TDBGrid Then
Begin
with tmptable do
begin
//clear;
For ColNumber:=0 To TDBGrid(ObjectSource).Columns.Count - 1 Do
begin
with FieldDefs.AddFieldDef do
begin
Name := 'Field'+inttostr(ColNumber);
Size := 250;
DataType := ftString;
end;
end;
createtable;
end;
tmptable.open;
{將DBGrid中的記錄寫入Dbf文件中}
If Not ((TDBGrid(ObjectSource).DataSource.DataSet.Eof) And (TDBGrid(ObjectSource).DataSource.DataSet.Bof)) Then
Begin
TDBGrid(ObjectSource).DataSource.DataSet.First;
While Not TDBGrid(ObjectSource).DataSource.DataSet.Eof Do
Begin
tmptable.Insert;
For ColNumber:=0 To TDBGrid(ObjectSource).Columns.Count - 1 Do
begin
tmpfieldname := 'field'+inttostr(colnumber);
tmptable.FieldByName(tmpfieldname).asstring := TDBGrid(ObjectSource).DataSource.DataSet.FieldByName(TDBGrid(ObjectSource).Columns.Items[ColNumber].FieldName).AsString;
end;
tmptable.post;
RowNumber:=RowNumber+1;
TDBGrid(ObjectSource).DataSource.DataSet.Next;
End;
End;
End;
Msg := '數據導出成功，存放在'+xlsFileName;
Application.MessageBox(Pchar(Msg), '提示', MB_ICONINFORMATION);
tmptable.Free;
Result := True;
except
Msg := '不能正確操作DBF文件。可能是該文件已被其他程序打開, 或系統錯誤。';
Application.MessageBox(Pchar(Msg), '提示', MB_ICONINFORMATION);
Result:=False;
end;
ExcelSaveDialog.free;
end;
3://.txt;
begin
If Pos('.txt',LowerCase(ExcelSaveDialog.FileName))=0 Then
xlsFileName:=ExcelSaveDialog.FileName+'.txt'
Else
xlsFileName:=ExcelSaveDialog.FileName;
If FileExists(xlsFileName) Then
Begin
Msg:=xlsFileName+'已經存在，您確定替換原來的文件嗎？';
If Application.MessageBox(Pchar(Msg),'確認文件替換',MB_ICONINFORMATION+MB_YESNO)=IDNO Then
Exit
Else
If Not DeleteFile(xlsFileName) Then
Application.MessageBox('不能正確操作該文件。可能是該文件已被其他程序打開, 或系統錯誤','提示',MB_ICONINFORMATION);
End;
OutDir := '';
OutFileName := xlsFileName;
while pos('\',OutFileName)<>0 do
begin
OutDir := OutDir + Copy(OutFileName,1,pos('\',OutFileName));
OutFileName := Copy(OutFileName,pos('\',OutFileName)+1,Length(OutFileName));
end;
try
AssignFile(Output,OutFileName);
Rewrite(Output);
Writeln(ReportTitle);
Writeln('');
If ObjectSource is TStringGrid Then
For RowNumber:=0 To TStringGrid(ObjectSource).RowCount-1 Do
begin
For ColNumber:=0 To TStringGrid(ObjectSource).ColCount-1 Do
begin
Write(TStringGrid(ObjectSource).Cells[ColNumber,RowNumber]+' ');
end;
WriteLn(' ');
end;
If ObjectSource Is TDBGrid Then
Begin
//將DBGrid列標題名寫入Excel文件中}
For ColNumber:=0 To TDBGrid(ObjectSource).Columns.Count-1 Do
begin
write(TDBGrid(ObjectSource).Columns.Items[ColNumber].Title.Caption+' ');
{將DBGrid中的記錄寫入Excel文件中}
end;
Writeln(' ');
If Not ((TDBGrid(ObjectSource).DataSource.DataSet.Eof) And (TDBGrid(ObjectSource).DataSource.DataSet.Bof)) Then
Begin
TDBGrid(ObjectSource).DataSource.DataSet.First;
While Not TDBGrid(ObjectSource).DataSource.DataSet.Eof Do
Begin
For ColNumber:=0 To TDBGrid(ObjectSource).Columns.Count-1 Do
write(TDBGrid(ObjectSource).DataSource.DataSet.FieldByName(TDBGrid(ObjectSource).Columns.Items[ColNumber].FieldName).AsString+' ');
writeln(' ');
RowNumber:=RowNumber+1;
TDBGrid(ObjectSource).DataSource.DataSet.Next;
End;
End;
End;
CloseFile(Output);
Msg := '數據導出成功，存放在' + xlsFileName;
Application.MessageBox(Pchar(Msg), '提示', MB_ICONINFORMATION);
Result := True;
except
Msg := '不能正確操作Txt文件。可能是該文件已被其他程序打開, 或系統錯誤。';
Application.MessageBox(Pchar(Msg), '提示', MB_ICONINFORMATION);
Result:=False;
end;
ExcelSaveDialog.free;
end;
end;
end;
Function GF_ConnectDB( PS_ConnectUserName : String ) : TDatabase ;
//------------------------------------------------------------------------
//設計時間 : 2002.1.22
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -