unit FunctionP;
interface
Uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,Forms, Dialogs, ComObj, Grids,
  StdCtrls, DBGrids,DBTables,DB, DBCtrls, Mask , Registry;
  {自定義類型}

  Type
  TDateStyle = (pDate, pTime, pDateTime);
  TStatusStyle =(Clear,Stat);

  {自定義函數}
  Function ExportExcel(FileName:String;ReportTitle:String;ObjectSource:TObject):Boolean;
  Function GetSysDateTime(DateStyle:TDateStyle=pDate):String;
  Function ComponentStat(FormName:TForm;StatusStyle:TStatusStyle=Clear;Status:Boolean=False):Integer;
  Function FeeCalcMonth(CDate:String='';BetweenMonth:Integer=-1):String;
  Function OpRegister(Path:String;ValuesName:String;OpearteStyle:Integer=0;Values:String=''):String;

implementation


{
*******************************************************************
* 作者：陳庭昀        編寫日期：2001-08-12                        *
*                                                                 *
* 函數：ImportExcel                                               *
* 功能：將StringGrid、DBGrid組合中的值傳至Excel文件中             *
* 參數：FileName      導出至Excel的文件名                         *
*       ReportTitle   報表標題名                                  *
* 返回值：無                                                      *
*                                                                 *
* 基本要求：系統必須按裝Excel應用軟件                             *
*                                                                 *
* 可導出文件：DBF、TXT、XLS                                       *
*                                                                 *
*******************************************************************
}
Function ExportExcel(FileName:String;ReportTitle:String;ObjectSource:TObject):Boolean;
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;

  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
                          if TDBGrid(ObjectSource).DataSource.DataSet.FieldByName(TDBGrid(ObjectSource).Columns.Items[ColNumber].FieldName).AsString='' then
                            break
                          else
                           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文件中}