unit_public.pas

delphi开发的中国移动大客户管理系统,后台数据库为oracle

  Result := Result + IntToStr(VersionInfo.dwMajorVersion)+'.'+IntToStr(VersionInfo.dwMinorVersion) ;    
  Result := Result + ' Build '+IntToStr(VersionInfo.dwBuildNumber)+'(内部版本号)';
end;


function GetPhysicalMemory : String;
//@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
//@                                                @
//@        获取系统的内存的容量                    @
//@     arthur by zengzc 2001.11.19                @
//@                                                @
//@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
var
  MemoryStatus: TMemoryStatus;
begin
  MemoryStatus.dwLength := sizeof(MemoryStatus);
  GlobalMemoryStatus(MemoryStatus);
  Result := FloatToStr(MemoryStatus.dwTotalPhys/1024/1024)+' M';
end;



Procedure Obtain_A_Chart(
             Aparent:Twincontrol;
             Achart:TcustomAxisPanel;
             ATable:Tdataset;
             X,Y,ATitle:string;
             Aflag:integer=0);
var
 OldTimeSepa : Char;
begin
  case Aflag of
    0:
    begin
      with Tlineseries.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;
      end;
    end;
    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));