多表头的DBGridEH导出到Excel中
把自己的解决法子说一下，虽然解决的不是很完美，缺少单元格合并和字体设置。
我重写了单元DBGridEhImpExp中的函数TDBGridEhExportAsXLS.WriteTitle
希望有高手继续完善这个函数，让之最终导出的Excel格式和Elib一样。
//------------------------------------------------------------------
procedure TDBGridEhExportAsXLS.WriteTitle(ColumnsList: TColumnsEhList);
var
i, k: Integer;
FPTitleExpArr: TTitleExpArr;
ListOfHeadTreeNodeList: TList;
ColSpan, RowSpan: Integer;
str1:String;
L: Word; //writestringcell
begin
if ColumnsList.Count = 0 then
Exit;
if DBGridEh.UseMultiTitle then
begin
try
CreateMultiTitleMatrix(DBGridEh, ColumnsList, FPTitleExpArr, ListOfHeadTreeNodeList);
//输出除最后一行表头的内容
for k := ListOfHeadTreeNodeList.Count - 1 downto 1 do
begin
for i := 0 to ColumnsList.Count - 1 do
begin
if THeadTreeNode(TList(ListOfHeadTreeNodeList.Items[k]).Items[i]) <> nil then
begin
CalcSpan(ColumnsList, ListOfHeadTreeNodeList, k, i, ColSpan, RowSpan);
str1:=THeadTreeNode(TList(ListOfHeadTreeNodeList.Items[k]).Items[i]).Text;
//=====================================
L := Length(str1);
CXlsLabel[1] := 8 + L;
CXlsLabel[2] := FRow;
CXlsLabel[3] := FCol;
CXlsLabel[5] := L;
StreamWriteWordArray(Stream, CXlsLabel);
StreamWriteAnsiString(Stream, str1);
if FCol = ExpCols.Count - 1 then
begin
Inc(FRow);
FCol := 0;
end
else
FCol:=FCol+ColSpan;
//=====================================
end;
end;
end;
FRow := ListOfHeadTreeNodeList.Count - 1;
FCol :=0;
//输出最后一行表头
for i := 0 to ColumnsList.Count - 1 do
begin
if THeadTreeNode(TList(ListOfHeadTreeNodeList.Items[0]).Items[i]) <> nil then
begin
CalcSpan(ColumnsList, ListOfHeadTreeNodeList, 0, i, ColSpan, RowSpan);
str1:=THeadTreeNode(TList(ListOfHeadTreeNodeList.Items[0]).Items[i]).Text;
//WriteStringCell(str1);
//==================================
L := Length(str1);
CXlsLabel[1] := 8 + L;
CXlsLabel[2] := FRow;
CXlsLabel[3] := FCol;
CXlsLabel[5] := L*ColSpan;
StreamWriteWordArray(Stream, CXlsLabel);
StreamWriteAnsiString(Stream, str1);
if FCol = ExpCols.Count - 1 then
begin
Inc(FRow);
FCol := 0;
end
else
FCol:=FCol+ColSpan;
//==================================
end
else
begin
Inc(FCol);//单云格进一
end;
end;
FRow:=ListOfHeadTreeNodeList.Count;
FCol:=0;
finally
for i := 0 to ListOfHeadTreeNodeList.Count - 1 do
TList(ListOfHeadTreeNodeList.Items[i]).Free;
ListOfHeadTreeNodeList.Free;
end;
end
else //不使用多表头
begin
for i := 0 to ColumnsList.Count - 1 do
begin
WriteStringCell(ColumnsList[i].Title.Caption);
end;
end;
end;
//------------------------------------------------------------------ （出处：www.2ccc.com）
|
