procedure ListViewSaveToXLS(aForm: tForm; Grid: TListViewScroll; OpenYesNo, MailTo: Boolean);
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;
sFileName: TFileName;
ExePath:
string;
ProcessID:
string;
// ColOrd: array of Integer;
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) * SizeOf(Char);
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
Application.ProcessMessages;
// ProzessID ermitteln
Cache.Value := '
';
Cache.Run('
s VALUE=$j');
ProcessID := Cache.Value;
if ProcessID = '
'
then
Exit;
// Path und File ermitteln
ExePath := ExtractFilePath(ParamStr(0));
sFileName := ExePath + '
Temp\' + ProcessID + '
\' + aForm.Caption + '
_' + ProcessID + '
.xls';
if not DirectoryExists(ExePath + '
Temp')
then
CreateDir(ExePath + '
Temp');
if not DirectoryExists(ExePath + '
Temp\' + ProcessID)
then
CreateDir(ExePath + '
Temp\' + ProcessID);
if FileExists(sFileName)
then
DeleteFile(sFileName);
// Initialization
FStream := TFileStream.Create(sFileName, fmCreate);
try
CXlsBof[4] := 0;
FStream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));
with Grid
do
begin
if Items.Count = 0
then
ItemCount := 0
else
ItemCount := Items.Count;
if Items.Count > 0
then
begin
// Zuerst den Header
// Get Column Order (falls durch Benutzer umsortiert)
{ SetLength(ColOrd, Columns.Count);
ListView_GetColumnOrderArray(Handle, Columns.Count, PInteger(ColOrd)); }
// for idxItem := 1 to Columns.Count do
for idxItem := 1
to Columns.Count
do
begin
with Columns[idxItem - 1]
do
begin
Val(Columns[idxItem - 1].Caption, i, Code);
if Code <> 0
then
XlsWriteCellLabel(FStream, idxItem - 1, 0, Columns[idxItem - 1].Caption)
else
XlsWriteCellNumber(FStream, idxItem - 1, 0, i);
end;
end;
// Jetzt die Einträge
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, Items[idxItem - 1].Caption)
else
XlsWriteCellNumber(FStream, 0, idxItem, 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, SubItems[idxSub])
else
XlsWriteCellNumber(FStream, idxSub + 1, idxItem, i);
end;
end;
end;
end;
end;
end;
FStream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
finally
FStream.Free;
end;
// File soll gleich geöffnet werden
if OpenYesNo = True
then
begin
if not ePowerSuite
then
begin
ShellExecute(0, '
open', PChar(sFileName),
nil,
nil, sw_ShowNormal);
end;
end;
// Datei per Mail versenden
if MailTo
then
begin
SendFileToMail(Cache.UserMandNr, Cache.UserNr, '
', '
', sFileName);
end;
end;