hwexport.pas

这是一个功能齐全的,代码完整的ERP企业信息管理系统,现在上传和大家分享

unit HwExport;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, CheckLst, Buttons, ComCtrls, DB, ADODB, ShellAPI,
  dxDBGrid, dxDBTL;

type
  THwExportForm = class(TForm)
    gbFields: TGroupBox;
    rgType: TRadioGroup;
    clbFields: TCheckListBox;
    bbtnOk: TBitBtn;
    bbtnExit: TBitBtn;
    ProgressBar1: TProgressBar;
    SaveDialog1: TSaveDialog;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure bbtnOkClick(Sender: TObject);
    procedure bbtnExitClick(Sender: TObject);
  private
    FDataSet:TDataSet;
    AFieldList:TStringList;
    procedure SetInterface;
    { Private declarations }
  public
    procedure GetDataFields(ASheet:string;ADataSet:TDataSet); overload;
    procedure GetDataFields(ASheet:string;AdxDBGrid:TdxDBGrid); overload;
    procedure GetDataFields(ASheet:string;AdxDBTreeList:TdxDBTreeList); overload;
    procedure ExportExcelFile(AFileName:string;ADataSet:TDataSet;AWriteTitle:Boolean=True);overload;
    procedure ExportTextFile(AFileName:string;ADataSet:TDataSet;AWriteTitle:Boolean=True);overload;
    procedure ExportWordFile(AFileName:string;ADataSet:TDataSet;AWriteTitle:Boolean=True);overload;
    { Public declarations }
  end;

var
  HwExportForm: THwExportForm;
  arXlsBegin: array[0..5] of Word = ($809, 8, 0, $10, 0, 0);
  arXlsEnd: array[0..1] of Word = ($0A, 00);
  arXlsString: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
  arXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);
  arXlsInteger: array[0..4] of Word = ($27E, 10, 0, 0, 0);
  arXlsBlank: array[0..4] of Word = ($201, 6, 0, 0, $17);

implementation

uses CommFun;

{$R *.dfm}

procedure THwExportForm.GetDataFields(ASheet:string;ADataSet:TDataSet);
var
  I,J:Integer;
begin
  if not ADataSet.Active then ADataSet.Open;
  AFieldList:=TStringList.Create;
  FDataSet:=ADataSet;
  clbFields.Items.Clear;
  for I:=0 to ADataSet.FieldCount-1 do
  begin
    if ADataSet.Fields[I].Visible then
    begin
      AFieldList.Add(ADataSet.Fields[I].FieldName);
      J:=clbFields.Items.Add(ADataSet.Fields[I].DisplayLabel);
      clbFields.Checked[J]:=True;
    end;
  end;
end;

procedure THwExportForm.GetDataFields(ASheet:string;AdxDBGrid:TdxDBGrid);
var
  I,J:Integer;
begin
  AFieldList:=TStringList.Create;
  FDataSet:=AdxDBGrid.DataSource.DataSet;
  clbFields.Items.Clear;
  for I:=0 to AdxDBGrid.ColumnCount-1 do
  begin
    if AdxDBGrid.Columns[I].Visible then
    begin
      AFieldList.Add(FDataSet.Fields[I].FieldName);
      J:=clbFields.Items.Add(AdxDBGrid.Columns[I].Caption);
      clbFields.Checked[J]:=True;
    end;
  end;
end;

procedure THwExportForm.GetDataFields(ASheet:string;AdxDBTreeList:TdxDBTreeList);
var
  I,J:Integer;
begin
  AFieldList:=TStringList.Create;
  FDataSet:=AdxDBTreeList.DataSource.DataSet;
  clbFields.Items.Clear;
  for I:=0 to AdxDBTreeList.ColumnCount-1 do
  begin
    if AdxDBTreeList.Columns[I].Visible then
    begin
      AFieldList.Add(FDataSet.Fields[I].FieldName);
      J:=clbFields.Items.Add(AdxDBTreeList.Columns[I].Caption);
      clbFields.Checked[J]:=True;
    end;
  end;
end;

procedure THwExportForm.SetInterface;
begin
  Caption:=GetDBString('COM00004004');  //导出数据
  rgType.Caption:=GetDBString('COM00004039');  //导出类型
  gbFields.Caption:=GetDBString('COM00004040');  //字段选择
  bbtnOk.Caption:=GetDBString('COM00004041');  //确定(&O)
  bbtnExit.Caption:=GetDBString('COM00004042');  //退出(&X)
  ProgressBar1.Visible:=False;
end;

procedure THwExportForm.FormCreate(Sender: TObject);
begin
  Font.Name:=AFontName;
  //设置界面信息
  SetInterface;
end;

procedure THwExportForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
//
end;

procedure THwExportForm.bbtnOkClick(Sender: TObject);
var
  AFileName:string;
begin
//确定
  SaveDialog1.Title:=GetDBString('COM00004004');  //导出数据;
  case rgType.ItemIndex of
    0:
      begin
        SaveDialog1.Filter:=GetDBString('COM00004005');  //Excel文件(*.xls)|*.xls
        SaveDialog1.DefaultExt:='xls';
      end;
    1:
      begin
        SaveDialog1.Filter:=GetDBString('COM00004037');  //Text文件(*.txt)|*.txt
        SaveDialog1.DefaultExt:='txt';
      end;
{    2:
      begin
        SaveDialog1.Filter:=GetDBString('COM00004034');  //Word文件(*.doc)|*.doc
        SaveDialog1.DefaultExt:='doc';  
      end;  }
  end;

  //保存文件的名称
  if not SaveDialog1.Execute then Exit;
  AFileName:=SaveDialog1.FileName;
  try
    Application.ProcessMessages;
    ProgressBar1.Position:=0;
    ProgressBar1.Visible:=True;
    Update;
    case rgType.ItemIndex of
      0:ExportExcelFile(AFileName,FDataSet);
      1:ExportTextFile(AFileName,FDataSet);
      2:ExportWordFile(AFileName,FDataSet);
    end;
    ModalResult:=1;
    if ShowDialog('UMS10000032',0,MB_DEFBUTTON1)=IDYES then  //导出数据成功，是否现在打开？
    begin
      ShellExecute(Handle, nil, PChar(AFileName),nil,nil,SW_NORMAL);
    end;
  except
    ProgressBar1.Visible:=False;
    ProgressBar1.Position:=0;
    Update;
    ShowMsg('UMS10000033');  //导出数据失败，检查是否有安装Microsoft Office软件
    Abort
  end;
end;

procedure THwExportForm.bbtnExitClick(Sender: TObject);
begin
//退出
  Close;
end;
{
function GetFieldName(ADataSet:TDataSet;AFieldName:string):String;
var
  I:Integer;
begin
  for I:=0 to ADataSet.FieldCount-1 do
  begin
    if ADataSet.Fields[I].Visible then
    begin
      if AFieldName=ADataSet.Fields[I].DisplayLabel then
      begin
        Result:=ADataSet.Fields[I].FieldName;
        Exit;
      end;
    end;
  end;
end;
}
procedure THwExportForm.ExportExcelFile(AFileName:string;ADataSet:TDataSet;AWriteTitle:Boolean=True);
var
  I,ACount:Integer;
  Col,Row:word;
  ABookMark:TBookMark;
  AFileStream:TFileStream;
  AFieldName:String;
  //在函数声明的地方实现函数的内容
  //增加行列号
  procedure incColRow;
  begin
    //因为Col的初始值为0,所以ACount必须减1,才是数据集的真正字段数量
    if Col=ACount-1 then
    begin
      Inc(Row);
      Col:=0;
    end
    else
      Inc(Col);
  end;
  //写字符串数据
  procedure WriteStringCell(AValue: string);
  var
    L: Word;
  begin
    L := Length(AValue);
    arXlsString[1]:=8+L;
    //保存行数和列数
    arXlsString[2]:=Row;
    arXlsString[3]:=Col;
    arXlsString[5]:=L;
    AFileStream.WriteBuffer(arXlsString, SizeOf(arXlsString));
    AFileStream.WriteBuffer(Pointer(AValue)^, L);
    //改变单元格的位置
    IncColRow;
  end;
  //写整数
  procedure WriteIntegerCell(AValue: integer);
  var
    V: Integer;
  begin
    arXlsInteger[2]:=Row;
    arXlsInteger[3]:=Col;
    AFileStream.WriteBuffer(arXlsInteger, SizeOf(arXlsInteger));
    V := (AValue shl 2) or 2;
    AFileStream.WriteBuffer(V, 4);
    IncColRow;
  end;
  //写浮点数
  procedure WriteFloatCell(AValue: double);
  begin
    arXlsNumber[2]:=Row;
    arXlsNumber[3]:=Col;
    AFileStream.WriteBuffer(arXlsNumber, SizeOf(arXlsNumber));
    AFileStream.WriteBuffer(AValue, 8);
    IncColRow;
  end;
begin
  ACount:=0;
  for I:=0 to clbFields.Count-1 do
  begin
    if clbFields.Checked[I] then Inc(Acount);
  end;
  //打开对话框,获得文件的存放位置和名称
  if FileExists(AFileName) then DeleteFile(AFileName); //文件存在，先删除
  AFileStream:=TFileStream.Create(AFileName,fmCreate);
  try
    //写文件头
    AFileStream.WriteBuffer(arXlsBegin, SizeOf(arXlsBegin));
    //写列头
    Col:=0; Row:= 0;
    if AWriteTitle then
    begin
      for I:=0 to clbFields.Count-1 do
      begin
        if clbFields.Checked[I] then WriteStringCell(clbFields.Items[I]);
      end;
    end;
    //写数据集中的数据
    ADataSet.DisableControls;
    ABookMark:=ADataSet.GetBookmark;
    ADataSet.First;
    //控制进度条
    ProgressBar1.Max:=ADataSet.RecordCount;
    ProgressBar1.Position:=0;
    while not ADataSet.Eof do
    begin
      for I:=0 to clbFields.Count-1 do
      begin
        if clbFields.Checked[I] then
        begin
//          AFieldName:=GetFieldName(ADataSet,clbFields.Items[I]);
          AFieldName:=AFieldList[I];
          //测试备注字段的关键
          case ADataSet.FieldByName(AFieldName).DataType of
            ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes: WriteIntegerCell(ADataSet.FieldByName(AFieldName).AsInteger);
            ftFloat, ftCurrency, ftBCD: WriteFloatCell(ADataSet.FieldByName(AFieldName).AsFloat)
          else
            //备注信息在这里导出,类型为:ftmemo,可以正常导出
            WriteStringCell(ADataSet.FieldByName(AFieldName).AsString);
          end;
        end;
      end;
      ProgressBar1.Position:=ProgressBar1.Position+1;
      ProgressBar1.Update;
      ADataSet.Next;
    end;
    //写文件尾
    AFileStream.WriteBuffer(arXlsEnd, SizeOf(arXlsEnd));
    if ADataSet.BookmarkValid(ABookMark) then ADataSet.GotoBookmark(ABookMark);
  finally
    AFileStream.Free;
    ADataSet.EnableControls;
  end;
end;

procedure THwExportForm.ExportTextFile(AFileName:string;ADataSet:TDataSet;AWriteTitle:Boolean);
var
  I:Integer;
  ABookMark:TBookMark;
  AStringList:TStringList;
  S:WideString;
  AFieldName:String;
begin
  if FileExists(AFileName) then DeleteFile(AFileName); //文件存在，先删除
  AStringList:=TStringList.Create;
  //处理标题
  if AWriteTitle then
  begin
    S:='';
    for I:=0 to clbFields.Count-1 do
    begin
      if clbFields.Checked[I] then
      begin
        S:=S+clbFields.Items[I];
        if I<>clbFields.Count-1 then S:=S+#9;  //加入TAB键分隔每个字段
      end;
    end;
    AStringList.Add(S);
  end;
  //处理数据
  try
    ADataSet.DisableControls;
    ABookMark:=ADataSet.GetBookmark;
    ADataSet.First;
    ProgressBar1.Max:=ADataSet.RecordCount;
    ProgressBar1.Position:=0;
    while not ADataSet.Eof do
    begin
      S:='';
      for I:=0 to clbFields.Count-1 do
      begin
        if clbFields.Checked[I] then
        begin
//          AFieldName:=GetFieldName(ADataSet,clbFields.Items[I]);
          AFieldName:=AFieldList[I];
          S:=S+ADataSet.FieldByName(AFieldName).AsString;
          if I<>clbFields.Count-1 then S:=S+#9;  //加入TAB键分隔每个字段
        end;
      end;
      AStringList.Add(S);
      ProgressBar1.Position:=ProgressBar1.Position+1;
      ProgressBar1.Update;
      ADataSet.Next;
    end;
    AStringList.SaveToFile(AFileName);
    if ADataSet.BookmarkValid(ABookMark) then ADataSet.GotoBookmark(ABookMark);
  finally
    AStringList.Free;
    ADataSet.EnableControls;
  end;
end;

procedure THwExportForm.ExportWordFile(AFileName:string;ADataSet:TDataSet;AWriteTitle:Boolean);
begin

end;

end.