是否可以将VirtualStringTree导出为Excel或CSV格式?
我正在使用Delphi 2007,尝试将我的VirtualStringTree数据记录保存为Excel或CSV格式。
是否可以将VirtualStringTree导出为Excel或CSV格式?
我正在使用Delphi 2007,尝试将我的VirtualStringTree数据记录保存为Excel或CSV格式。
class function TExcelWriter.ExportToExcelVariantArray(const VArray: Variant; const Title, SubTitle: WideString): Boolean;
var
xl: OleVariant;
workbook: OleVariant;
worksheet: OleVariant;
range: OleVariant;
Rowcount, ColumnCount: Integer;
HeaderRowIndex: Integer;
s: WideString;
begin
Result := False;
if not VarIsArray(VArray) then
raise EExcelWriterException.Create('ExportToExcelVariantArray: Supplied variant is not an array');
if VarArrayDimCount(VArray) <> 2 then
raise EExcelWriterException.Create('ExportToExcelEVariantArray: Supplied variant array does not have 2 dimensions ('+IntToStr(VarArrayDimCount(VArray))+')');
ColumnCount := VarArrayHighBound(VArray, 2) - VarArrayLowBound(VArray, 2); //2 for "leftmost dimension"
rowCount := VarArrayHighBound(VArray, 1) - VarArrayLowBound(VArray, 1); //1 for "leftmost dimension"
try
xl := CreateOleObject('Excel.Application');
except
on E:Exception do
begin
if (E is EOleSysError) then
begin
if EOleSysError(E).ErrorCode = CO_E_CLASSSTRING then
raise EExcelWriterException.Create('Excel is not installed.'+CRLF+
'Could not load "Excel.Application" object (Co_E_CLASSSTRING)')
else
raise;
end
else
raise;
end;
end;
try
xl.ScreenUpdating := False;
xl.DisplayAlerts := False; // Don't display dialogs such as "save changes to workbook".
workbook := xl.Workbooks.Add;
try
Worksheet := Workbook.Worksheets[1];
try
Worksheet.Activate;
Worksheet.Cells.WrapText := False;
HeaderRowIndex := 1; //Rows&Columns in Excel start at one.
range := TExcelWriter.GetRange(worksheet, HeaderRowIndex, 1, HeaderRowIndex+RowCount, ColumnCount);
range.Value := VArray;
//Bold the header row
Worksheet.Rows[HeaderRowIndex].Font.Bold := True;
Worksheet.Rows[HeaderRowIndex].Font.Underline := True;
Worksheet.Columns.AutoFit;
//Set printed header&footer
if Copy(Title, 1, 2) = '@@' then
s := Copy(Title, 3, MaxInt)
else
s := Title;
if SubTitle <> '' then
begin
if s <> '' then s := s+#13;
s := s + SubTitle;
end;
TExcelWriter.SetHeaderAndFooters(Worksheet,
s, '', '',
'&D &T', '', 'Page &P of &N');
finally
Worksheet := Unassigned;
end;
finally
Workbook := Unassigned;
end;
//When all done
xl.ScreenUpdating := True;
xl.Visible := True;
xl.UserControl := True; // Very important, prevents Excel from going
// away when we nil out our reference to it below.
finally
xl := Unassigned;
end;
Result := True;
end;
我们有一个继承自TVirtualStringTree
的TVirtualListView
,这使得过渡到VirtualTrees变得容易(它有TVirtualListItem
等)。它还有一个辅助方法ContentToVariantArray
,类似于ContentToHtml
和ContentToRtf
:
function TVirtualListView.ContentToVariantArray: Variant;
var
Columns: TColumnsArray;
VArray: Variant;
Node: PVirtualNode;
ColumnCount: Integer;
RowCount: Integer;
nRow: Integer;
i: Integer;
begin
Columns := Self.Columns.GetVisibleColumns;
ColumnCount := Length(Columns);
RowCount := Self.Items.Count+1; //+1 for the heaader
VArray := VarArrayCreate([0, RowCount-1, 0, ColumnCount-1], varOleStr); //Docs say cannot use varString, must be varOleStr (which is a BSTR i.e. WideString)
nRow := 0;
for i := 0 to ColumnCount-1 do
begin
VArray[nRow, i] := Self.Columns.Items[Columns[i].Index].Text;
end;
Node := Self.GetFirst;
while Assigned(Node) do
begin
Inc(nRow);
for i := 0 to ColumnCount-1 do
begin
VArray[nRow, i] := Self.Text[Node, Columns[i].Index];
end;
Node := Self.GetNextSibling(Node);
end;
Result := VArray;
end;
使用CSV会更加容易。
你的数据是你自己的数据,因为VirtualStringTree不包含数据,它只是一个虚拟容器。所以,如果你的虚拟字符串树是TMyObjects列表(容器)的视图,那么输出到CSV应该相对容易,并且只有当你的列可以按不同顺序排列或可见的列集时,Virtual Tree的内容才真正重要。
我建议你调查免费的JVCL JvCsvDataSet,这是一种非常简单的编写CSV文件的方法。
如果你真的想要XLS输出,有相应的库可用。
写入CSV与HTML的方式相同:
var ss : AnsiString;
...
if ExtractFileExt(DestFileName)='.htm'
then
ss:=VST.ContentToHtml(tstAll, 'Html exp')
else
ss:=VST.ContentToText(tstAll, ';');
with TFileStream.Create(DestFileName, fmCreate or fmShareDenyWrite) do
begin
Write(ss[1], length(ss));
Free;
end;