[GerTorresM]

Hola a tod@s:


Bien el problema que me aqueja hoy es el siguiente:

Estoy intentando crear un clase Thread que me permita exportar el contenido de un Dataset o de TStringList a archivo excel, quiero se claro que parte del código lo he tomados de otros foros

Código Delphi [-]

{$J+} // {$WRITEABLECONST ON}
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);
{$J-} // {$WRITEABLECONST OFF}

type
  TExportarXLS_MultiHilo = class(TThread)
  constructor create(pNombreArchivo : String; pDataset : TDataset); reintroduce; overload;
  constructor create(pNombreArchivo : String; pStringGrid : TStringGrid); reintroduce; overload;
  procedure Terminate;
  procedure Execute; override;
  private
    NombreArchivo : string;
    FStream: TFileStream;
    Dataset_temporal : TDataSet;
    StringGrid_temporal: TStringGrid;
  procedure XlsBeginStream(XlsStream: TStream; const BuildNumber: Word);
  procedure XlsEndStream(XlsStream: TStream);
  procedure XlsWriteCellLabel(XlsStream: TStream; const ACol, ARow: Word;
    const AValue: string);
  procedure XlsWriteCellNumber(XlsStream: TStream; const ACol,
    ARow: Word; const AValue: Double);
  procedure XlsWriteCellRk(XlsStream: TStream; const ACol, ARow: Word;
    const AValue: Integer);
  protected
  public
  published
end;

estos son los métodos

Código Delphi [-]
{ TExportarXLS_MultiHilo }

constructor TExportarXLS_MultiHilo.create(pNombreArchivo: String;
  pDataset: TDataset);
begin
  inherited Create(True);
  NombreArchivo:= pNombreArchivo;
  self.FStream:= TFileStream.Create(NombreArchivo, fmCreate);
  Dataset_temporal := pDataset ;
  StringGrid_temporal:= nil;
  self.Suspended:= False;
  Self.Resume;
end;

constructor TExportarXLS_MultiHilo.create(pNombreArchivo: String;
  pStringGrid: TStringGrid);
begin
  inherited Create(True);
  NombreArchivo:= pNombreArchivo;
  self.FStream:= TFileStream.Create(NombreArchivo, fmCreate);
  Self.Dataset_temporal := nil;
  Self.StringGrid_temporal:= pStringGrid;
  // self.Suspended:= False;
  self.Resume;
end;

procedure TExportarXLS_MultiHilo.Execute;
var campos_local, i_local, j_local, k_local : LongInt;
    listadoCampos_local : TStringList;
begin
  inherited;
  listadoCampos_local:= TStringList.Create;
  XlsBeginStream(Self.FStream, 0);
  k_local:= 5; // Numero de la fila Inicial para la escritura del archivo XLS

  // Dataset
  if Self.Dataset_temporal.Active then
    begin
      // Inicia la escritura
     for j_local:= 0 to Self.Dataset_temporal.RecordCount -1 do
       begin
         for i_local:= 0 to Self.Dataset_temporal.Fields.Count -1 do
           case Self.Dataset_temporal.Fields[i_local].DataType of
             ftInteger: XlsWriteCellNumber(Self.FStream, k_local, i_local + 1,
               Self.Dataset_temporal.Fields[i_local].value);
             ftFloat: XlsWriteCellRk(Self.FStream, k_local, i_local + 1,
               Self.Dataset_temporal.Fields[i_local].value);
             else XlsWriteCellLabel(Self.FStream, k_local, i_local + 1,
               Self.Dataset_temporal.Fields[i_local].value);
           end;
         Inc(k_local);
         Self.Dataset_temporal.Next;
       end;
    end else begin
    // String Grid
    if self.StringGrid_temporal.ColCount > 0 then
      begin
        for j_local:= 0 to self.StringGrid_temporal.RowCount -1 do
          begin
        // Inicia la escritura
            for i_local:= 0 to self.StringGrid_temporal.ColCount -1 do
              begin
                XlsWriteCellLabel(Self.FStream, k_local, i_local + 1,
                  self.StringGrid_temporal.Cells[i_local,j_local]);
              end;
            Inc(k_local);
          end;
      end;
    end;

  if not Self.Terminated then
    Self.WaitFor;
  XlsEndStream(Self.FStream);
  listadoCampos_local.Free;
end;

procedure TExportarXLS_MultiHilo.Terminate;
begin
  Self.FStream.Free;
  inherited;
end;

procedure TExportarXLS_MultiHilo.XlsBeginStream(XlsStream: TStream;
  const BuildNumber: Word);
begin
  XlsStream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));
end;

procedure TExportarXLS_MultiHilo.XlsEndStream(XlsStream: TStream);
begin
  XlsStream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
end;

procedure TExportarXLS_MultiHilo.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 TExportarXLS_MultiHilo.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 TExportarXLS_MultiHilo.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;

por medio de este código invoco la clase

Código Delphi [-]
procedure TFAuditoria.BitBtn1Click(Sender: TObject);
Var PruebaXLS : TExportarXLS_MultiHilo;
begin
  try
    PruebaXLS := TExportarXLS_MultiHilo.create('c:\Datos\test.ppp',Self.SGDatos);
    PruebaXLS.Resume;
  finally
    PruebaXLS.Free;
  end;
end;

Cuando hago seguimiento, se ejecuta en forma correcta el constructor, pero cuando debería ejecutar el resume simplemente no sucede nada.

Agradezco cualquier colaboración que me puedan prestar



Cordialmente



GerTorresM
Colombia