procedure ExportExcelFile(FileName: string; bWriteTitle: Boolean; aLv: TListView); //无需安装excel
var
i, j: integer;
Col, row: word;
s: string;
aFileStream: TFileStream;
procedure IncColRow; //增加行列号
begin
if Col = aLv.Columns.Count - 1 then
begin
Inc(Row);
Col :=0;
end
else
Inc(Col);
end;
procedure WriteStringCell(AValue: string);//写字符串数据
var
L: Word;
begin
L := Length(AValue);
arXlsString[1] := 8 + L;
arXlsString[2] := Row;
arXlsString[3] := Col;
arXlsString[5] := L;
aFileStream.WriteBuffer(arXlsString, SizeOf(arXlsString));
aFileStream.WriteBuffer(Pointer(AValue)^, L);
IncColRow;
end;
procedure WriteIntegerCell(AValue: integer);//写整数
var
V: Integer;
begin
arXlsInteger[2] := Row;
arXlsInteger[3] := Col;
aFileStream.WriteBuffer(arXlsInteger, SizeOf(arXlsInteger));
V := (AValue shl 2) or 2;
aFileStream.WriteBuffer(V, 4);
IncColRow;
end;
procedure WriteFloatCell(AValue: double);//写浮点数
begin
arXlsNumber[2] := Row;
arXlsNumber[3] := Col;
aFileStream.WriteBuffer(arXlsNumber, SizeOf(arXlsNumber));
aFileStream.WriteBuffer(AValue, 8);
IncColRow;
end;
begin
if FileExists(FileName) then DeleteFile(FileName); //文件存在,先删除
aFileStream := TFileStream.Create(FileName, fmCreate);
Try
aFileStream.WriteBuffer(arXlsBegin, SizeOf(arXlsBegin));
Col := 0; Row := 0;
if bWriteTitle then
begin
for i := 0 to aLv.Columns.Count - 1 do
WriteStringCell(aLv.Columns[i].Caption);
end;
for i := 0 to aLv.Items.Count - 1 do
begin
for j := 0 to aLv.Columns.Count - 1 do
begin
if j = 0 then
s := aLv.Items[i].Caption
else
s := aLv.Items[i].SubItems[j-1];
WriteStringCell(s);
end;
end;
AFileStream.WriteBuffer(arXlsEnd, SizeOf(arXlsEnd));
showinfo('导出成功!');
Finally
AFileStream.Free;
end;
end;
var
i, j: integer;
Col, row: word;
s: string;
aFileStream: TFileStream;
procedure IncColRow; //增加行列号
begin
if Col = aLv.Columns.Count - 1 then
begin
Inc(Row);
Col :=0;
end
else
Inc(Col);
end;
procedure WriteStringCell(AValue: string);//写字符串数据
var
L: Word;
begin
L := Length(AValue);
arXlsString[1] := 8 + L;
arXlsString[2] := Row;
arXlsString[3] := Col;
arXlsString[5] := L;
aFileStream.WriteBuffer(arXlsString, SizeOf(arXlsString));
aFileStream.WriteBuffer(Pointer(AValue)^, L);
IncColRow;
end;
procedure WriteIntegerCell(AValue: integer);//写整数
var
V: Integer;
begin
arXlsInteger[2] := Row;
arXlsInteger[3] := Col;
aFileStream.WriteBuffer(arXlsInteger, SizeOf(arXlsInteger));
V := (AValue shl 2) or 2;
aFileStream.WriteBuffer(V, 4);
IncColRow;
end;
procedure WriteFloatCell(AValue: double);//写浮点数
begin
arXlsNumber[2] := Row;
arXlsNumber[3] := Col;
aFileStream.WriteBuffer(arXlsNumber, SizeOf(arXlsNumber));
aFileStream.WriteBuffer(AValue, 8);
IncColRow;
end;
begin
if FileExists(FileName) then DeleteFile(FileName); //文件存在,先删除
aFileStream := TFileStream.Create(FileName, fmCreate);
Try
aFileStream.WriteBuffer(arXlsBegin, SizeOf(arXlsBegin));
Col := 0; Row := 0;
if bWriteTitle then
begin
for i := 0 to aLv.Columns.Count - 1 do
WriteStringCell(aLv.Columns[i].Caption);
end;
for i := 0 to aLv.Items.Count - 1 do
begin
for j := 0 to aLv.Columns.Count - 1 do
begin
if j = 0 then
s := aLv.Items[i].Caption
else
s := aLv.Items[i].SubItems[j-1];
WriteStringCell(s);
end;
end;
AFileStream.WriteBuffer(arXlsEnd, SizeOf(arXlsEnd));
showinfo('导出成功!');
Finally
AFileStream.Free;
end;
end;