Registriert seit: 21. Jul 2003
Ort: Neumarkt
263 Beiträge
|
ListView mit Images nach Excel
7. Jul 2004, 08:20
Ich benutze zwar im Moment die AdvListView, aber ich denke, es müsste ja mit einer normalen ListView das gleiche sein:
Ich habe in der ersten Spalten verschiedene Images, in der 2. und 3. Text. Wenn ich die View jetzt mit Hilfe von nachfolgendem Code nach Excel exportieren will, speichert er leider die Grafiken nicht mit.
Delphi-Quellcode:
Procedure Tfrm_report_std.Button1Click(Sender: TObject);
begin
if SaveDialog1.Execute then { <-- ask for a filename first }
begin
ListViewSaveToXLS(View, SaveDialog1.FileName);
end;
end;
procedure Tfrm_report_std.ListViewSaveToXLS(AListView: TListView; const sFileName: TFileName);
const
{$J+}
CXlsBof: array[0..5] of Word = ($809, 8, 00, $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);
{$J-}
var
idxItem, idxSub: Integer;
I, Code: Integer;
ItemCount, SubCount: Word;
FStream: TFileStream;
procedure XlsWriteCellNumber(XlsStream: TStream; const ACol, ARow: Word;
const AValue: Double);
begin
CXlsNumber[2] := ARow;
CXlsNumber[3] := ACol;
XlsStream.WriteBuffer(CXlsNumber, SizeOf(CXlsNumber));
XlsStream.WriteBuffer(AValue, 8);
end;
procedure XlsWriteCellLabel(XlsStream: TStream; const ACol, ARow: Word;
const AValue: string);
var
L: Word;
begin
L := Length(AValue);
CXlsLabel[1] := 8 + L;
CXlsLabel[2] := ARow;
CXlsLabel[3] := ACol;
CXlsLabel[5] := L;
XlsStream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel));
XlsStream.WriteBuffer(Pointer(AValue)^, L);
end;
begin
//Initialization
FStream := TFileStream.Create(sFileName, fmCreate);
try
CXlsBof[4] := 0;
FStream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));
with AListView do
begin
if Items.Count = 0 then
ItemCount := 0
else
ItemCount := Items.Count;
if Items.Count > 0 then
begin
for idxItem := 1 to ItemCount do
begin
with Items[idxItem - 1] do
begin
//Save subitems Count
if SubItems.Count = 0 then
SubCount := 0
else
SubCount := Subitems.Count;
Val(Items[idxItem - 1].Caption, I, Code);
if Code <> 0 then
XlsWriteCellLabel(FStream, 0, idxItem - 1, Items[idxItem - 1].Caption)
else
XlsWriteCellNumber(FStream, 0, idxItem - 1, I);
if SubCount > 0 then
begin
for idxSub := 0 to SubItems.Count - 1 do
begin
//Save Item's Subitems
Val(SubItems[idxSub], I, Code);
if Code <> 0 then
XlsWriteCellLabel(FStream, idxSub + 1, idxItem - 1, SubItems[idxSub])
else
XlsWriteCellNumber(FStream, idxSub + 1, idxItem - 1, I);
end;
end;
end;
end;
end;
end;
FStream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
finally
FStream.Free;
end;
end;
Hat jemand eine Lösung für mich?
|