{Original-Code von [url]http://www.swissdelphicenter.ch/de/showcode.php?id=725[/url] }
{siehe auch [url]http://www.swissdelphicenter.ch/de/showcode.php?id=379[/url] }
procedure TFrmBewertZiff.p_InExcel(
const TabellenName:
String);
const
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);
CXlsRk:
array[0..4]
of Word = ($27E, 10, 0, 0, 0);
//---inbound Procs ----------------//
procedure XlsBeginStream(XlsStream: TStream;
const BuildNumber: Word);
begin
CXlsBof[4] := BuildNumber;
XlsStream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));
end;
procedure XlsEndStream(XlsStream: TStream);
begin
XlsStream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
end;
procedure XlsWriteCellRk(XlsStream: TStream;
const ACol, ARow: Word;
const AValue: Integer);
var
V: Integer;
begin
CXlsRk[2] := ARow;
CXlsRk[3] := ACol;
XlsStream.WriteBuffer(CXlsRk, SizeOf(CXlsRk));
V := (AValue
shl 2)
or 2;
XlsStream.WriteBuffer(V, 4);
end;
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;
//---ENDE inbound Procs----------------------//
var
FStream: TFileStream;
Spalte, Zeile: Integer;
begin
//--Grid etc 'einfrieren'
DBGrid2.DataSource.DataSet.DisableControls;
FStream := TFileStream.Create(PChar(TabellenName), fmCreate);
try
XlsBeginStream(FStream, 0);
Zeile := 0;
//--Spaltenbezeichnung eintragen
XlsWriteCellLabel(FStream, 0, Zeile, '
Leitung/Station-Nr');
XlsWriteCellLabel(FStream, 1, Zeile, '
Bezeichnung');
XlsWriteCellLabel(FStream, 2, Zeile, '
Bewertungsziffer');
Zeile := 1;
while not Query2.Eof
do begin
for Spalte := 0
to Query2.Fields.Count -1
do
case Spalte
of
0,1 : XlsWriteCellLabel(FStream, Spalte, Zeile, Query2.Fields[Spalte].Text);
2: XlsWriteCellNumber(FStream, Spalte, Zeile, Query2.Fields[Spalte].Value);
end;
INC(Zeile);
Query2.Next;
end;
XlsEndStream(FStream);
finally
FStream.Free;
end;
//--Grid 'freigeben'
DBGrid2.DataSource.DataSet.EnableControls;
end;