⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 dbgridehtoexcel.~pas

📁 高校教师工作量计算管理系统的设计与开发
💻 ~PAS
📖 第 1 页 / 共 2 页
字号:
FCol := 5;

WriteStringCell(OpDate,False);

FCol := 0;

Inc(FRow);  

end;

procedure TDBGridEhToExcel.WriteTitle;

var

i, j: integer;

DBGridEhTitle: TDBGridEhTitle;

TitleCell: TTitleCell;

begin

DBGridEhTitle := TDBGridEhTitle.Create;

try

DBGridEhTitle.DBGridEh := FDBGridEh;

DBGridEhTitle.GetTitleData(TitleCell);

try

for i := 0 to DBGridEhTitle.RowCount - 1 do

begin

for j := 0 to DBGridEhTitle.ColumnCount - 1 do

begin

FCol := j;

WriteStringCell(TitleCell[j,i],False);

end;

Inc(FRow);

end;

FCol := 0;

except

end;

finally

DBGridEhTitle.Free;

end;

end;



procedure TDBGridEhToExcel.WriteDataCell;

var

i: integer;

begin

DBGridEh.DataSource.DataSet.DisableControls;

FBookMark := DBGridEh.DataSource.DataSet.GetBookmark;

try

DBGridEh.DataSource.DataSet.First;

while not DBGridEh.DataSource.DataSet.Eof do

begin

for i := 0 to DBGridEh.DataSource.DataSet.FieldCount - 1 do

begin

if DBGridEh.DataSource.DataSet.Fields[i].IsNull or (not DBGridEh.DataSource.DataSet.Fields[i].Visible) then

WriteBlankCell

else

begin

case DBGridEh.DataSource.DataSet.Fields[i].DataType of

ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:

WriteIntegerCell(DBGridEh.DataSource.DataSet.Fields[i].AsInteger);

ftFloat, ftCurrency, ftBCD:

WriteFloatCell(DBGridEh.DataSource.DataSet.Fields[i].AsFloat);

else

if DBGridEh.DataSource.DataSet.Fields[i] Is TBlobfield then  // 此类型的字段(图像等)暂无法读取显示

WriteStringCell('')

else

WriteStringCell(DBGridEh.DataSource.DataSet.Fields[i].AsString);

end;

end;

end;

//显示进度条进度过程

if ShowProgress then

begin

FGauge.Progress := DBGridEh.DataSource.DataSet.RecNo;

FGauge.Refresh;

end;

DBGridEh.DataSource.DataSet.Next;

end;

finally

if DBGridEh.DataSource.DataSet.BookmarkValid(FBookMark) then

DBGridEh.DataSource.DataSet.GotoBookmark(FBookMark);

DBGridEh.DataSource.DataSet.EnableControls;

end;

end;

procedure TDBGridEhToExcel.WriteFooter;

var

i, j: integer;

begin

if DBGridEh.FooterRowCount = 0 then exit;

FCol := 0;

if DBGridEh.FooterRowCount = 1 then

begin

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

begin

if DBGridEh.Columns[i].Visible then

begin

WriteStringCell(DBGridEh.Columns[i].Footer.Value,False);

Inc(FCol);

end;

end;

end

else if DBGridEh.FooterRowCount > 1 then

begin

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

begin

if DBGridEh.Columns[i].Visible then

begin

for j := 0 to DBGridEh.Columns[i].Footers.Count - 1 do

begin

WriteStringCell(DBGridEh.Columns[i].Footers[j].Value ,False);

Inc(FRow);

end;

Inc(FCol);

FRow := FRow - DBGridEh.Columns[i].Footers.Count;

end;

end;

end;

FCol := 0;

end;

procedure TDBGridEhToExcel.SaveStream(aStream: TStream);

begin

FCol := 0;

FRow := 0;

Stream := aStream;

//输出前缀

WritePrefix;

//输出表格标题

WriteHeader;

//输出列标题

WriteTitle;

//输出数据集内容

WriteDataCell;

//输出DBGridEh表脚

WriteFooter;

//输出后缀

WriteSuffix;

end;

procedure TDBGridEhToExcel.ExportToExcel;

var

FileStream: TFileStream;

Msg: String;

begin

//如果数据集为空或没有打开则退出

if (DBGridEh.DataSource.DataSet.IsEmpty) or (not DBGridEh.DataSource.DataSet.Active) then

exit;

//如果保存的文件名为空则退出 

if Trim(FileName) = '' then

exit;



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

SetDataSetCrossIndexDBGridEh;

Screen.Cursor := crHourGlass;

try

try

if FileExists(FileName) then

begin

Msg := '已存在文件(' + FileName + '),是否覆盖?';

if Application.MessageBox(PChar(Msg),'提示',MB_YESNO+MB_ICONQUESTION+MB_DEFBUTTON2) = IDYES then

begin

//删除文件

DeleteFile(FileName)

end

else

exit;

end;

//显示进度窗体

if ShowProgress then

CreateProcessForm(nil);



FileStream := TFileStream.Create(FileName, fmCreate);

try

//输出文件

SaveStream(FileStream);

finally

FileStream.Free;

end;



//打开Excel文件

ShellExecute(0, 'Open', PChar(FileName), nil, nil, SW_SHOW);

except

end;

finally

if ShowProgress then

FreeAndNil(FProgressForm);

Screen.Cursor := crDefault;

end;

end;

destructor TDBGridEhToExcel.Destroy;

begin

inherited Destroy;

end;

procedure TDBGridEhToExcel.CreateProcessForm(AOwner: TComponent);

var

Panel: TPanel;

Prompt: TLabel;                                           {提示的标签}

begin

if Assigned(FProgressForm) then

exit;

FProgressForm := TForm.Create(AOwner);

with FProgressForm do

begin

try

Font.Name := '宋体';                                  {设置字体}

Font.Size := 9;

BorderStyle := bsNone;

Width := 300;

Height := 100;

BorderWidth := 1;

Color := clBlack;

Position := poScreenCenter;

Panel := TPanel.Create(FProgressForm);

with Panel do

begin

Parent := FProgressForm;

Align := alClient;

BevelInner := bvNone;

BevelOuter := bvRaised;

Caption := '';

end;

Prompt := TLabel.Create(Panel);

with Prompt do

begin

Parent := Panel;

AutoSize := True;

Left := 25;

Top := 25;

Caption := '正在导出数据,请稍候......';

Font.Style := [fsBold];

end;

FGauge := TGauge.Create(Panel);

with FGauge do

begin

Parent := Panel;

ForeColor := clBlue;

Left := 20;

Top := 50;

Height := 13;

Width := 260;

MinValue := 0;

MaxValue := DBGridEh.DataSource.DataSet.RecordCount;

end;

except

end;

end;

FProgressForm.Show;

FProgressForm.Update;

end;

procedure TDBGridEhToExcel.SetDataSetCrossIndexDBGridEh;

var

i: integer;

begin

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

begin

DBGridEh.DataSource.DataSet.FieldByName(DBGridEh.Columns.Items[i].FieldName).Index := i;

DBGridEh.DataSource.DataSet.FieldByName(DBGridEh.Columns.Items[i].FieldName).DisplayLabel

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

DBGridEh.DataSource.DataSet.FieldByName(DBGridEh.Columns.Items[i].FieldName).Visible :=

DBGridEh.Columns.Items[i].Visible;

end;

for i := 0 to DBGridEh.DataSource.DataSet.FieldCount - 1 do

begin

if POS('*****',DBGridEh.DataSource.DataSet.Fields[i].DisplayLabel) > 0 then

DBGridEh.DataSource.DataSet.Fields[i].Visible := False;

end;  

end;

end.


⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -