Ver Mensaje Individual
  #3  
Antiguo 17-08-2010
cloayza cloayza is offline
Miembro
 
Registrado: may 2003
Ubicación: San Pedro de la Paz, Chile
Posts: 915
Reputación: 23
cloayza Tiene un aura espectacularcloayza Tiene un aura espectacular
Este codigo lo encontre un dia navegando por la web...

No recuerdo al autor...Si alguien lo sabe seria bueno que lo escribiera...

Código Delphi [-]
procedure TForm1.BitBtn5Click(Sender: TObject);
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);
var
  FStream: TFileStream;
  I, J: Integer;

      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;

begin
     FStream := TFileStream.Create('D:\sample.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;

Saludos
Responder Con Cita