dbgridehtoexcel.~pas

高校教师工作量计算管理系统的设计与开发

unit DBGridEhToExcel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, ComCtrls, ExtCtrls, StdCtrls, Gauges, DBGridEh, ShellApi;
type
TTitleCell = array of array of String;
//分解DBGridEh的标题
TDBGridEhTitle = class
private
FDBGridEh: TDBGridEh;  //对应DBGridEh
FColumnCount: integer; //DBGridEh列数(指visible为True的列数)
FRowCount: integer;    //DBGridEh多表头层数(没有多表头则层数为1)
procedure SetDBGridEh(const Value: TDBGridEh);
function GetTitleRow: integer;    //获取DBGridEh多表头层数
function GetTitleColumn: integer; //获取DBGridEh列数
public
//分解DBGridEh标题，由TitleCell二维动态数组返回
procedure GetTitleData(var TitleCell: TTitleCell);
published
property DBGridEh: TDBGridEh read FDBGridEh write SetDBGridEh;
property ColumnCount: integer read FColumnCount;
property RowCount: integer read FRowCount;
end;
TDBGridEhToExcel = class(TComponent)
private
FCol: integer;
FRow: integer;
FProgressForm: TForm;                                  {进度窗体}
FGauge: TGauge;                                        {进度条}

Stream: TStream;                                       {输出文件流}

FBookMark: TBookmark;                                  

FShowProgress: Boolean;                                {是否显示进度窗体}

FDBGridEh: TDBGridEh;

FBeginDate: TCaption;                                  {开始日期}

FTitleName: TCaption;                                  {Excel文件标题}

FEndDate: TCaption;                                    {结束日期}

FUserName: TCaption;                                   {制表人}

FFileName: String;                                     {保存文件名}

procedure SetShowProgress(const Value: Boolean);

procedure SetDBGridEh(const Value: TDBGridEh);

procedure SetBeginDate(const Value: TCaption);

procedure SetEndDate(const Value: TCaption);

procedure SetTitleName(const Value: TCaption);

procedure SetUserName(const Value: TCaption);

procedure SetFileName(const Value: String);    

procedure IncColRow;

procedure WriteBlankCell;                              {写空单元格}

{写数字单元格}

procedure WriteFloatCell(const AValue: Double; const IncStatus: Boolean=True);

{写整型单元格}

procedure WriteIntegerCell(const AValue: Integer; const IncStatus: Boolean=True);

{写字符单元格}

procedure WriteStringCell(const AValue: string; const IncStatus: Boolean=True);

procedure WritePrefix;

procedure WriteSuffix;

procedure WriteHeader;                                 {输出Excel标题}

procedure WriteTitle;                                  {输出Excel列标题}

procedure WriteDataCell;                               {输出数据集内容}

procedure WriteFooter;                                 {输出DBGridEh表脚}

procedure SaveStream(aStream: TStream);

procedure CreateProcessForm(AOwner: TComponent);       {生成进度窗体}

{根据表格修改数据集字段顺序及字段中文标题}

procedure SetDataSetCrossIndexDBGridEh;

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

procedure ExportToExcel; {输出Excel文件}

published

property DBGridEh: TDBGridEh read FDBGridEh write SetDBGridEh;

property ShowProgress: Boolean read FShowProgress write SetShowProgress;

property TitleName: TCaption read FTitleName write SetTitleName;

property BeginDate: TCaption read FBeginDate write SetBeginDate;

property EndDate: TCaption read FEndDate write SetEndDate;

property UserName: TCaption read FUserName write SetUserName;

property FileName: String read FFileName write SetFileName;

end;

var

CXlsBof: array[0..5] of Word = ($809, 8, 0, $10, 0, 0);

CXlsEof: array[0..1] of Word = ($0A, 00);

CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);

CXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);

CXlsRk: array[0..4] of Word = ($27E, 10, 0, 0, 0);

CXlsBlank: array[0..4] of Word = ($201, 6, 0, 0, $17);

implementation

{ TDBGridEhTitle }



function TDBGridEhTitle.GetTitleColumn: integer;

var

i, ColumnCount: integer;

begin

ColumnCount := 0;

for i := 0 to DBGridEh.Columns.Count - 1 do

begin

if DBGridEh.Columns[i].Visible then

Inc(ColumnCount);

end;

Result := ColumnCount;

end;

procedure TDBGridEhTitle.GetTitleData(var TitleCell: TTitleCell);

var

i, Row, Col: integer;

Caption: String;

begin

FColumnCount := GetTitleColumn;

FRowCount := GetTitleRow;

SetLength(TitleCell,FColumnCount,FRowCount);

Row := 0;

for i := 0 to DBGridEh.Columns.Count - 1 do

begin

if DBGridEh.Columns[i].Visible then

begin

Col := 0;

Caption := DBGridEh.Columns[i].Title.Caption;

while POS('|', Caption) > 0 do

begin

TitleCell[Row,Col] := Copy(Caption, 1, Pos('|',Caption)-1);

Caption := Copy(Caption,Pos('|', Caption)+1, Length(Caption));

Inc(Col);

end;

TitleCell[Row, Col] := Caption;

Inc(Row);

end;

end;

end;

function TDBGridEhTitle.GetTitleRow: integer;

var

i, j: integer;

MaxRow, Row: integer;

begin

MaxRow := 1;

for i := 0 to DBGridEh.Columns.Count - 1 do

begin

Row := 1;

for j := 0 to Length(DBGridEh.Columns[i].Title.Caption) do

begin

if DBGridEh.Columns[i].Title.Caption[j] = '|' then

Inc(Row);

end;

if MaxRow < Row then

MaxRow :=  Row;

end;

Result := MaxRow;

end;

procedure TDBGridEhTitle.SetDBGridEh(const Value: TDBGridEh);

begin

FDBGridEh := Value;

end;

{ TDBGridEhToExcel }

constructor TDBGridEhToExcel.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

FShowProgress := True;

end;

procedure TDBGridEhToExcel.SetShowProgress(const Value: Boolean);

begin

FShowProgress := Value;

end;

procedure TDBGridEhToExcel.SetDBGridEh(const Value: TDBGridEh);

begin

FDBGridEh := Value;

end;

procedure TDBGridEhToExcel.SetBeginDate(const Value: TCaption);

begin

FBeginDate := Value;

end;

procedure TDBGridEhToExcel.SetEndDate(const Value: TCaption);

begin

FEndDate := Value;

end;

procedure TDBGridEhToExcel.SetTitleName(const Value: TCaption);

begin

FTitleName := Value;

end;

procedure TDBGridEhToExcel.SetUserName(const Value: TCaption);

begin

FUserName := Value;

end;

procedure TDBGridEhToExcel.SetFileName(const Value: String);

begin

FFileName := Value;

end;

procedure TDBGridEhToExcel.IncColRow;

begin

if FCol = DBGridEh.DataSource.DataSet.FieldCount - 1 then

begin

Inc(FRow);

FCol := 0;

end

else

Inc(FCol);

end;

procedure TDBGridEhToExcel.WriteBlankCell;

begin

CXlsBlank[2] := FRow;

CXlsBlank[3] := FCol;

Stream.WriteBuffer(CXlsBlank, SizeOf(CXlsBlank));

IncColRow;

end;

procedure TDBGridEhToExcel.WriteFloatCell(const AValue: Double; const IncStatus: Boolean=True);

begin

CXlsNumber[2] := FRow;

CXlsNumber[3] := FCol;

Stream.WriteBuffer(CXlsNumber, SizeOf(CXlsNumber));

Stream.WriteBuffer(AValue, 8);

if IncStatus then

IncColRow;

end;

procedure TDBGridEhToExcel.WriteIntegerCell(const AValue: Integer; const IncStatus: Boolean=True);

var

V: Integer;

begin

CXlsRk[2] := FRow;

CXlsRk[3] := FCol;

Stream.WriteBuffer(CXlsRk, SizeOf(CXlsRk));

V := (AValue Shl 2) Or 2;

Stream.WriteBuffer(V, 4);

if IncStatus then

IncColRow;

end;

procedure TDBGridEhToExcel.WriteStringCell(const AValue: string; const IncStatus: Boolean=True);

var

L: integer;

begin

L := Length(AValue);

CXlsLabel[1] := 8 + L;

CXlsLabel[2] := FRow;

CXlsLabel[3] := FCol;

CXlsLabel[5] := L;

Stream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel));

Stream.WriteBuffer(Pointer(AValue)^, L);

if IncStatus then

IncColRow;

end;

procedure TDBGridEhToExcel.WritePrefix;

begin

Stream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));

end;

procedure TDBGridEhToExcel.WriteSuffix;

begin

Stream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));

end;

procedure TDBGridEhToExcel.WriteHeader;

var

OpName, OpDate: String; 

begin

//标题

FCol := 3;

WriteStringCell(TitleName,False);

FCol := 0;

Inc(FRow);

if Trim(BeginDate) <> '' then

begin

//开始日期

FCol := 0;

WriteStringCell(BeginDate,False);

FCol := 0

end;

if Trim(EndDate) <> '' then

begin

//结束日期

FCol := 5;

WriteStringCell(EndDate,False);

FCol := 0;

end;

if (Trim(BeginDate) <> '') or (Trim(EndDate) <> '') then

Inc(FRow);

//制表人

OpName := '制表人：' + UserName;

FCol := 0;

WriteStringCell(OpName,False);

FCol := 0;

//制表时间

OpDate := '制表时间：' + DateTimeToStr(Now);