Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   OOP (https://www.clubdelphi.com/foros/forumdisplay.php?f=5)
-   -   Problemas con ejecución de hilo (https://www.clubdelphi.com/foros/showthread.php?t=86920)

GerTorresM 23-10-2014 16:39:19

Problemas con ejecución de hilo
 
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

Héctor Randolph 23-10-2014 17:37:02

Hola GerTorresM

El problema es que destruyes la instancia del hilo justo de después de que comienza la ejecución.

Lo mejor es crearlo, ejecutarlo y dejar que el mismo hilo se libere de memoria al terminar su trabajo.

Para esto existe la propiedad FreeOnTerminate

Código Delphi [-]
procedure TFAuditoria.BitBtn1Click(Sender: TObject);
Var PruebaXLS : TExportarXLS_MultiHilo;
begin

    PruebaXLS := TExportarXLS_MultiHilo.create('c:\Datos\test.ppp',Self.SGDatos);
    PruebaXLS.FreeOnTerminate:=True;
    PruebaXLS.Resume;

end;

Saludos

GerTorresM 23-10-2014 18:14:29

Vale quedo Ok
 
Muchas gracias por tu solución me aplico de lujo !!

dec 23-10-2014 19:01:12

Cita:

Empezado por Héctor Randolph (Mensaje 483602)
Hola GerTorresM

El problema es que destruyes la instancia del hilo justo de después de que comienza la ejecución.

Lo mejor es crearlo, ejecutarlo y dejar que el mismo hilo se libere de memoria al terminar su trabajo.

Para esto existe la propiedad FreeOnTerminate

Código Delphi [-]
procedure TFAuditoria.BitBtn1Click(Sender: TObject);
Var PruebaXLS : TExportarXLS_MultiHilo;
begin

    PruebaXLS := TExportarXLS_MultiHilo.create('c:\Datos\test.ppp',Self.SGDatos);
    PruebaXLS.FreeOnTerminate:=True;
    PruebaXLS.Resume;

end;

Saludos

¡Muy bien visto Héctor! :)


La franja horaria es GMT +2. Ahora son las 06:58:06.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi