savexls.pas

纯的将数据直接存为Excel格式

unit SaveXLS;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, DBTables, Grids, DBGrids, StdCtrls, ExtCtrls;

type
  TForm2 = class(TForm)
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    Table1: TTable;
    SaveDialog1: TSaveDialog;
    Panel1: TPanel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  
var
  XLSBOF: array[0..4] of Word = ($409, 6, 0, $10, 0);
  XLSGUTS: array[0..5] of Word = ($80, 8, 0, 0, 0, 0);
  XLSPalette: array[0..2] of Word = ($92, $36, $0D);
  XLSDimension: array [0..6] of Word = ($200, $0A, 0, $FFFF, 0, $FF, 0);
  XLSEOF: array[0..1] of Word = ($0A, 0);
  XLSFONT: array[0..9] of Byte = ($31, 2, 0, 0, 0, 0, 0, 0, 0, 0);
  XLSXF1: array[0..15] of Byte = ($43, 4, $0C, 0, 0, 0, $F5, $FF, $20, 0, 0, $CE, 0, 0, 0, 0);
  XLSXF2: array[0..15] of Byte = ($43, 4, $0C, 0, 1, 0, $F5, $FF, $20, $F4, 0, $CE, 0, 0, 0, 0);
  XLSXF3: array[0..15] of Byte = ($43, 4, $0C, 0, 2, 0, $F5, $FF, $20, $F4, 0, $CE, 0, 0, 0, 0);
  XLSXF4: array[0..15] of Byte = ($43, 4, $0C, 0, 0, 0, $F5, $FF, $20, $F4, 0, $CE, 0, 0, 0, 0);
  XLSXF5: array[0..15] of Byte = ($43, 4, $0C, 0, 0, 0, 1, 0, $20, 0, 0, $CE, 0, 0, 0, 0);
  XLSXF6: array[0..15] of Byte = ($43, 4, $0C, 0, 1, $21, $F5, $FF, $20, $F8, 0, $CE, 0, 0, 0, 0);
  XLSXF7: array[0..15] of Byte = ($43, 4, $0C, 0, 1, $1F, $F5, $FF, $20, $F8, 0, $CE, 0, 0, 0, 0);
  XLSXF8: array[0..15] of Byte = ($43, 4, $0C, 0, 1, $20, $F5, $FF, $20, $F8, 0, $CE, 0, 0, 0, 0);
  XLSXF9: array[0..15] of Byte = ($43, 4, $0C, 0, 1, $1E, $F5, $FF, $20, $F8, 0, $CE, 0, 0, 0, 0);
  XLSXF10: array[0..15] of Byte = ($43, 4, $0C, 0, 1, $0D, $F5, $FF, $20, $F8, 0, $CE, 0, 0, 0, 0);
  XLSXF: array[0..15] of Byte = ($43, 4, $0C, 0, 5, 0, 1, 0, $21, $78, $41, 3, 0, 0, 0, 0);
  XLSXFB: array[0..15] of Byte = ($43, 4, $0C, 0, 8, 0, 1, 0, $22, $78, $41, 2, $71, $71, $71, 0);
  XLSXFH: array[0..15] of Byte = ($43, 4, $0C, 0, 6, 0, 1, 0, $22, $78, $41, 2, $71, $71, $71, $71);
  XLSXFG: array[0..15] of Byte = ($43, 4, $0C, 0, 7, 0, 1, 0, $21, $78, $C1, 2, 0, 0, 0, 0);
  XLSXFF: array[0..15] of Byte = ($43, 4, $0C, 0, 5, 0, 1, 0, $22, $78, $C1, 2, $B9, $B9, $B9, $B9);
  XLSXFF1: array[0..15] of Byte = ($43, 4, $0C, 0, 5, 0, 1, 0, $22, $78, $C1, 2, $B9, 0, $B9, 0);
  XLSXFRF: array[0..15] of Byte = ($43, 4, $0C, 0, 9, 0, 1, 0, $21, $78, $C1, 2, $B9, $B9, $B9, $B9);
  XLSXFRF1: array[0..15] of Byte = ($43, 4, $0C, 0, 9, 0, 1, 0, $21, $78, $C1, 2, $B9, 0, $B9, 0);
  XLSCOL: array[0..7] of Word = ($7D, $0C, 0, 0, 0, $F, 0, 0);
  XLSSFONT: array[0..15] of Byte = ($31, 2, $0C, 0, $C8, 0, 0, 0, $FF, $7F, 5, $41, $72, $69, $61, $6C);
  XLSLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
  XLSBlank: array[0..4] of Word = ($201, 6, 0, 0, $17);
  XLSNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);
  XLSRK: array[0..4] of Word = ($27E, 10, 0, 0, 0);
  XLSFormula: array[0..15] of Word =($406, $1D, 0, 0, $18, 0, 0, 0, 0, 3, $0B, $25, 0, 0, 0, 0);

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
var
  tmpFile: TFileStream;
  i,c:integer;
  s:String;
  B:Byte;
  row,col:integer;

  XLSColor1: DWORD;
  XLSColor2: DWORD;
  bk: TBookmark;
begin

  XLSColor1 := 0;
  XLSColor2 := $FFFFFF;

  if SaveDialog1.Execute then
  begin
    tmpFile := TFileStream.Create(SaveDialog1.FileName,fmCreate);
    bk := DBGrid1.DataSource.DataSet.GetBookmark;
    DBGrid1.DataSource.DataSet.DisableControls;
    screen.Cursor := crHourGlass;
    try
      with tmpFile do
      begin
        //写文件头
        WriteBuffer(XLSBOF, SizeOf(XLSBOF));
        WriteBuffer(XLSGUTS, SizeOf(XLSGUTS));
        WriteBuffer(XLSPalette,SizeOf(XLSPalette));

        for i:=0 to 5 do //颜色值
        begin
          WriteBuffer(XLSColor1, SizeOf(XLSColor1));
          WriteBuffer(XLSColor2, SizeOf(XLSColor2));
        end;
        WriteBuffer(XLSColor1,SizeOf(XLSColor1));

        for i:=0 to 3 do //系统默认字体
          WriteBuffer(XLSSFont, SizeOf(XLSSFont));

        S:='宋体';
        B := Length(S);
        XLSFont[2] := B+7;
        XLSFont[4] := $B4; //宋体9号
        XLSFont[8] := 12;
        WriteBuffer(XLSFont,SizeOf(XLSFont)); //Grid Font
        WriteBuffer(B, SizeOf(B));
        WriteBuffer(Pointer(S)^, Length(S));

        XLSFont[8] := 8;
        WriteBuffer(XLSFont,SizeOf(XLSFont)); //Header Font
        WriteBuffer(B, SizeOf(B));
        WriteBuffer(Pointer(S)^, Length(S));

        XLSFont[8] := 10;
        WriteBuffer(XLSFont,SizeOf(XLSFont)); //Group Font
        WriteBuffer(B, SizeOf(B));
        WriteBuffer(Pointer(S)^, Length(S));

        XLSFont[8] := 16;
        WriteBuffer(XLSFont,SizeOf(XLSFont)); //Band Font
        WriteBuffer(B, SizeOf(B));
        WriteBuffer(Pointer(S)^, Length(S));
        
        XLSFont[8] := 18;
        WriteBuffer(XLSFont,SizeOf(XLSFont)); //Footer Font
        WriteBuffer(B, SizeOf(B));
        WriteBuffer(Pointer(S)^, Length(S));

        //Column Font
        XLSFont[8] := 12;
        for i:=0 to dbgrid1.Columns.Count-1 do
        begin
          WriteBuffer(XLSFont,SizeOf(XLSFont));
          WriteBuffer(B, SizeOf(B));
          WriteBuffer(Pointer(S)^, Length(S));
        end;

        // Save XF...
        WriteBuffer(XLSXF1,SizeOf(XLSXF1));
        WriteBuffer(XLSXF2,SizeOf(XLSXF2));
        WriteBuffer(XLSXF2,SizeOf(XLSXF2));
        WriteBuffer(XLSXF3,SizeOf(XLSXF3));
        WriteBuffer(XLSXF3,SizeOf(XLSXF3));
        for i:=0 to 9 do
          WriteBuffer(XLSXF4,SizeOf(XLSXF4));
        WriteBuffer(XLSXF5,SizeOf(XLSXF5));
        WriteBuffer(XLSXF6,SizeOf(XLSXF6));
        WriteBuffer(XLSXF7,SizeOf(XLSXF7));
        WriteBuffer(XLSXF8,SizeOf(XLSXF8));
        WriteBuffer(XLSXF9,SizeOf(XLSXF9));
        WriteBuffer(XLSXF10,SizeOf(XLSXF10));
        XLSXF[12] := $A1;
        XLSXF[13] := $A1;
        XLSXF[14] := $A1;
        XLSXF[15] := $A1;
        WriteBuffer(XLSXF,SizeOf(XLSXF));
        WriteBuffer(XLSXFH,SizeOf(XLSXFH));
        WriteBuffer(XLSXFG,SizeOf(XLSXFG));
        WriteBuffer(XLSXFF,SizeOf(XLSXFF));
        WriteBuffer(XLSXFF1,SizeOf(XLSXFF1));
        WriteBuffer(XLSXFB,SizeOf(XLSXFB));
        WriteBuffer(XLSXFRF,SizeOf(XLSXFRF));
        WriteBuffer(XLSXFRF1,SizeOf(XLSXFRF1));

        for i:=0 to 30 {DBGrid1.Columns.Count-1} do
        begin
          XLSXF[4] := i + 10;
          if i>=dbgrid1.Columns.Count then
            XLSXF[8] := $21
          else
          case dbgrid1.Columns.Items[i].Alignment of
            taLeftJustify : XLSXF[8] := $21;
            taRightJustify: XLSXF[8] := $23;
            taCenter :      XLSXF[8] := $22;
          end;
          WriteBuffer(XLSXF, SizeOf(XLSXF));
        end;

        //Columns COL 属性
        for i := 0 to  30 {dbgrid1.Columns.Count - 1} do
        begin
          XLSCOL[2] := i;
          XLSCOL[3] := i;
          if i>=dbgrid1.Columns.Count then
            XLSCOL[4] := 0
          else
            XLSCOL[4] := 36 * dbgrid1.Columns.Items[i].Width;
          WriteBuffer(XLSCOL, SizeOf(XLSCOL));
        end;
        WriteBuffer(XLSDimension, SizeOf(XLSDimension));

        //写标题
        row := 0;
        col := 0;
        for i := 0 to  dbgrid1.Columns.Count - 1 do
        begin
          S := dbgrid1.Columns.Items[i].Title.Caption;
          XLSLabel[1] := Length(S) + 8;
          XLSLabel[2] := row;
          XLSLabel[3] := col+i;
          XLSLabel[4] := $16;
          XLSLabel[5] := Length(S);
          WriteBuffer(XLSLabel, SizeOf(XLSLabel));
          WriteBuffer(Pointer(S)^, Length(S));
        end;
        //存记录
        dbGrid1.DataSource.DataSet.First;
        for i:=0 to dbGrid1.DataSource.DataSet.RecordCount-1 do
        begin
          row := row + 1;
          col := 0;
          for c:=0 to dbGrid1.Columns.Count-1 do
          begin
            //所有值作为字符型.
            s := dbGrid1.Columns.Items[c].FieldName;
            S:= vartoStr(dbGrid1.DataSource.DataSet.FieldByName(s).Value);
            if s='' then s:= ' ';
            XLSLabel[1] := Length(S) + 8;
            XLSLabel[2] := row;
            XLSLabel[3] := col + c;

            XLSLabel[4] := $1D + c; ///对齐方式是否来自列属性?
            XLSLabel[5] := Length(S);
            WriteBuffer(XLSLabel, SizeOf(XLSLabel));
            WriteBuffer(Pointer(S)^, Length(S));
           end;
           dbgrid1.DataSource.DataSet.Next;
        end;

        //写文件未
        WriteBuffer(XLSEof,SizeOf(XLSEof));
      end;
    finally
      tmpFile.Free;
      dbgrid1.DataSource.DataSet.GotoBookmark(bk);
      dbgrid1.DataSource.DataSet.FreeBookmark(bk);
      DBGrid1.DataSource.DataSet.EnableControls;
      screen.Cursor := crDefault;
    end;
  end; 

end;

end.