procedure TMainForm.CopyInfoAreasToDstSheet(ASrcData: TInfo; ASrcSheet, ADstSheet: TSheet;
AAreas: TAreaList; var ALeft, ATop: Integer);
var
I, J, lLeft, lTop, TempLeft, TempRight, TempCount, lOldRowCount: Integer;
lDataset: TDataset;
TempArea, lNextArea, lEndArea, lSubArea: TSheetArea;
lIsNullDataset: Boolean;
begin
AAreas.SortAreaBounds;
for I := 0 to AAreas.Count - 1 do
begin
TempArea := AAreas[I];
//考虑到页头区域等没有数据集的区域,就直接copy过来。
if not (TempArea is TDataSheetArea) then
begin
//***************考虑页头区域等没有数据集的区域*********************//
TempCount := TempArea.Bottom - TempArea.Top;
//设置每行的行高
lOldRowCount := ADstSheet.RowCount;
ADstSheet.RowCount := ADstSheet.RowCount + TempCount;
for J := 0 to TempCount - 1 do
ADstSheet.RowHeights[lOldRowCount + J] := ASrcSheet.RowHeights[TempArea.Top + J];
TempLeft := TempArea.Left;
TempRight := TempArea.Right;
ADstSheet.CopyClientSection(ASrcSheet, Types.Rect(TempLeft, TempArea.Top, TempRight, TempArea.Bottom), ALeft, ATop, False, False, TOutProp.opAll, False);
ATop := ATop + TempCount;
end
else
begin
//按数据集的记录数添加区域
lDataset := ASrcData.DatasetByID((TempArea as TDataSheetArea).DataSetDefID);
lDataset.First;
if lDataset.Eof then
lIsNullDataset := True
else
lIsNullDataset := False;
while (not lDataset.Eof) or lIsNullDataset do
begin
lIsNullDataset := False;
//***************拷贝当前区域中当前区域的头到第一个子区域头的部分********//
if TempArea.SubAreas.Count > 0 then
begin
lSubArea := TempArea.SubAreas[0];
//设置每行的行高
TempCount := lSubArea.Top - TempArea.Top;
lOldRowCount := ADstSheet.RowCount;
ADstSheet.RowCount := ADstSheet.RowCount + TempCount;
for J := 0 to TempCount - 1 do
ADstSheet.RowHeights[lOldRowCount + J] := ASrcSheet.RowHeights[TempArea.Top + J];
ADstSheet.CopyClientSection(ASrcSheet, Types.Rect(TempArea.Left, TempArea.Top, TempArea.Right, lSubArea.Top), ALeft, ATop, False, False, TOutProp.opAll, False);
ATop := ATop + TempCount;//只设置了top, 没有设置left
CopyInfoAreasToDstSheet(ASrcData, ASrcSheet, ADstSheet, TempArea.SubAreas, ALeft, ATop);
//**********************************************************//
end else
begin
//******如果没有子区域,那么就把当前区域拷贝过去*********//
TempCount := TempArea.Bottom - TempArea.Top;
//设置每行的行高
lOldRowCount := ADstSheet.RowCount;
ADstSheet.RowCount := ADstSheet.RowCount + TempCount;
for J := 0 to TempCount - 1 do
ADstSheet.RowHeights[lOldRowCount + J] := ASrcSheet.RowHeights[TempArea.Top + J];
if Assigned(TempArea.ParentArea) then
begin
TempLeft := TempArea.ParentArea.Left;
TempRight := TempArea.ParentArea.Right;
end else
begin
TempLeft := TempArea.Left;
TempRight := TempArea.Right;
end;
ADstSheet.CopyClientSection(ASrcSheet, Types.Rect(TempLeft, TempArea.Top, TempRight, TempArea.Bottom), ALeft, ATop, False, False, TOutProp.opAll, False);
ATop := ATop + TempCount;
//**********************************************************//
end;
lDataset.Next;
end;
//********copy 两个同级区域之间的空间(当前区域下的主区域的空间)**********//
if I < AAreas.Count - 1 then
begin
lNextArea := AAreas[I+1];
if TempArea.Bottom < lNextArea.Bottom then
begin
TempCount := lNextArea.Top - TempArea.Bottom;
//设置每行的行高
lOldRowCount := ADstSheet.RowCount;
ADstSheet.RowCount := ADstSheet.RowCount + TempCount;
for J := 0 to TempCount - 1 do
ADstSheet.RowHeights[lOldRowCount + J] := ASrcSheet.RowHeights[TempArea.Bottom + J];
if Assigned(TempArea.ParentArea) then
begin
TempLeft := TempArea.ParentArea.Left;
TempRight := TempArea.ParentArea.Right;
end else
begin
TempLeft := TempArea.Left;
TempRight := TempArea.Right;
end;
ADstSheet.CopyClientSection(ASrcSheet, Types.Rect(TempLeft, TempArea.Bottom, TempRight, lNextArea.Top), ALeft, ATop, False, False, TOutProp.opAll, False);
ATop := ATop + TempCount;
end;
end
//**********************************************************//
//********拷贝最后一个子区域到当前区域末的当前区域的部分**************//
else if I = AAreas.Count - 1 then
begin
lEndArea := AAreas[AAreas.Count - 1];
if Assigned(lEndArea.ParentArea) and (lEndArea.Bottom < lEndArea.ParentArea.Bottom) then
begin
TempCount := lEndArea.ParentArea.Bottom - lEndArea.Bottom;
//设置每行的行高
lOldRowCount := ADstSheet.RowCount;
ADstSheet.RowCount := ADstSheet.RowCount + TempCount;
for J := 0 to TempCount - 1 do
ADstSheet.RowHeights[lOldRowCount + J] := ASrcSheet.RowHeights[lEndArea.Bottom + J];
ADstSheet.CopyClientSection(ASrcSheet, Types.Rect(lEndArea.ParentArea.Left, lEndArea.Bottom, lEndArea.ParentArea.Right, lEndArea.ParentArea.Bottom), ALeft, ATop, False, False, TOutProp.opAll, False);
ATop := ATop + TempCount;
end;
end;
//**********************************************************//
end;
end;
end;
//以两种方式来生成到Excel(树节点、DocView)
procedure TMainForm.ExportToExcelFile(ADocViewList: TList);
var
lExcelExp: TExcelExporter;
lOpenDialog: TOpenDialog;
lAreaRows, lAreaCols, TempLeft, TempTop: Integer;
lDstSheet, lSrcSheet: TSheet;
lDstSheetArea, lSrcSheetArea: TSheetArea;
I, J: Integer;
TempStrList: TStringList;
lInfo: TInfo;
lDocView: TDocView;
const
cLeft = 1;
cTop = 5;
begin
if ADocViewList = nil then
begin
MessageBox(0, '生成Excel文件失败!没有对象传入!', '提示框');
Exit;
end;
try
lOpenDialog := TSaveDialog.Create(nil);
try
lOpenDialog.Filter := 'Microsoft Excel Workbook(*.xls)|*.xls|All files (*.*)|*.*';
// if lOpenDialog.Execute then
begin
// UseUnit('\TIB\USER\TIBDIALOG.PAS');
try
showmessage('正在生成Excel文件,请等待....');
lDstSheet := TSheetDoc(DocView1.Doc).Sheet;
// lDstSheet := TSheet.Create(nil);
// lExcelExp := TExcelExporter.Create(nil);
try
//lSrcSheet := ASrcSheet;//;TempDocView.Doc.DocObject;
TempLeft := cLeft;
for I := 0 to ADocViewList.Count - 1 do
begin
lDocView := ADocViewList[I] as TDocView;
lInfo := lDocView.InfoBroker.Info;
lSrcSheet := TSheetDoc(lDocView.Doc).Sheet;
//把第一个Docview中的sheet的基本属性应用到整个目标Sheet中
if I = 0 then
begin
if lSrcSheet.Areas.Count > 0 then //为了确保lSrcSheetArea能够得到赋值
lSrcSheetArea := lSrcSheet.Areas[0]
else
begin
MessageBox(0, '表单没有定义数据区域!', '错误');
Exit;
end;
lDstSheet.SheetProperty.UnitType := lSrcSheet.SheetProperty.UnitType;//mmPixel;
lDstSheet.ColDefWidth := lSrcSheet.ColDefWidth + 15;
lDstSheet.RowDefHeight := lSrcSheet.RowDefHeight;
lDstSheet.ColCount := lSrcSheet.ColCount;
for J := 0 to lSrcSheet.ColCount - 1 do
lDstSheet.ColWidths[J] := lSrcSheet.ColWidths[J];
for J := 0 to lSrcSheetArea.Top - 1 do //标题
lDstSheet.RowHeights[J] := lSrcSheet.RowHeights[J];
lDstSheet.RowCount := lSrcSheetArea.Top;
TempLeft := cLeft;
TempTop := lSrcSheetArea.Top;
//拷贝头:第一个Sheet的从1到3行作为生成Excel后的头
//lDstSheet.CopyClientSection(lSrcSheet, Rect(0, 0, lSrcSheetArea.Top-1, lSrcSheetArea.Right), 0, 0, False, False);
end;
// ReFreshFrm;
CopyInfoAreasToDstSheet(lInfo, lSrcSheet, lDstSheet, lSrcSheet.Areas, TempLeft, TempTop);
end;
lExcelExp := TExcelExporter.Create(lDstSheet);
// lExcelExp. Sheet := lDstSheet;
lExcelExp.ExportToFile('C:\aa.xls');//lOpenDialog.FileName);
finally
lDstSheet.Free;
lExcelExp.Free;
end;
//CloseDialog;
finally
// UnLoadUnit('\TIB\USER\TIBDIALOG.PAS');
end;
end;
finally
lOpenDialog.Free;
end;
except
// MessageBox(0, '生成Excel文件失败!错误信息:'+ ExceptionMessage, '提示框', MB_OK + MB_ICONINFORMATION);
Exit;
end;
// MessageBox(0, '生成Excel文件成功!', '提示框', MB_OK + MB_ICONINFORMATION);
end;
procedure TMainForm.Button2Click(Sender: TObject);
var
lDocList: TList;
lFileName: String;
begin
lDocList := TList.Create;
try
lDocList.Add(DocViewINF_BGWDXX_CEL_ZCBGWD);
ExportToExcelFile(lDocList);
{ lFileName := jsSysUtils.GetSystemTempPath + 'JustepTemp.XLS';
ExcelAccess.CellToExcel(INF_BGWDXX.TCEL_ZCBGWD(DocViewINF_BGWDXX_CEL_ZCBGWD.Doc).Sheet,
lFileName);
Borland.Delphi.ShellAPI.ShellExecute(Handle, 'Open', lFileName, '', '', Borland.Delphi.Windows.Sw_ShowNormal);
} finally
lDocList.Free;
end;
end; |