DELPHI FAQ: Создаём Excel файл без OLE


Создаём Excel файл без OLE
Previous  Home  Next




const
 
  CXlsBof: array
[0..5of Word = ($809800$1000); 
  CXlsEof: array
[0..1of Word = ($0A00); 
  CXlsLabel: array
[0..5of Word = ($20400000); 
  CXlsNumber: array
[0..4of Word = ($20314000); 
  CXlsRk: array
[0..4of Word = ($27E10000); 

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
 2or 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


procedure
 TForm1.Button1Click(Sender: TObject); 
var
 
  FStream: TFileStream; 
  I, J: Integer; 
begin
 
  FStream := TFileStream.Create('c:\e.xls'
, fmCreate); 
  try
 
    XlsBeginStream(FStream, 0
); 
    for
 I := 0 to 99 do 
      for
 J := 0 to 99 do 
      begin
 
        XlsWriteCellNumber(FStream, I, J, 34
.34); 
        // XlsWriteCellRk(FStream, I, J, 3434); 

        // XlsWriteCellLabel(FStream, I, J, Format('Cell: %d,%d', [I, J])); 

      end

    XlsEndStream(FStream); 
  finally
 
    FStream.Free; 
  end

end
;


Взято с www.delphiworld.narod.ru




DELPHI FAQ




EOMY TOP 100      Рейтинг@Mail.ru      Rambler's Top100