Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > OOP
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Grupo de Teaming del ClubDelphi

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 23-10-2014
Avatar de GerTorresM
GerTorresM GerTorresM is offline
Miembro
 
Registrado: nov 2005
Ubicación: Tunja - Boyacá
Posts: 210
Poder: 19
GerTorresM Va por buen camino
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

Última edición por GerTorresM fecha: 23-10-2014 a las 17:50:40.
Responder Con Cita
  #2  
Antiguo 23-10-2014
Avatar de Héctor Randolph
[Héctor Randolph] Héctor Randolph is offline
Miembro Premium
 
Registrado: dic 2004
Posts: 882
Poder: 20
Héctor Randolph Va por buen camino
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
Responder Con Cita
  #3  
Antiguo 23-10-2014
Avatar de GerTorresM
GerTorresM GerTorresM is offline
Miembro
 
Registrado: nov 2005
Ubicación: Tunja - Boyacá
Posts: 210
Poder: 19
GerTorresM Va por buen camino
Vale quedo Ok

Muchas gracias por tu solución me aplico de lujo !!
Responder Con Cita
  #4  
Antiguo 23-10-2014
Avatar de dec
dec dec is offline
Moderador
 
Registrado: dic 2004
Ubicación: Alcobendas, Madrid, España
Posts: 13.107
Poder: 34
dec Tiene un aura espectaculardec Tiene un aura espectacular
Cita:
Empezado por Héctor Randolph Ver Mensaje
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!
__________________
David Esperalta
www.decsoftutils.com
Responder Con Cita
Respuesta


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Problemas con un Hilo aguml C++ Builder 10 08-03-2014 01:20:58
Dudas con Hilo en ejecución danielmj Varios 30 31-10-2013 20:52:54
Pasar cadena de conexion a tadoconnections dentro de un hilo de ejecucion richy08 OOP 4 03-08-2010 00:49:32
como crear un hilo de ejecucion ayudenme plis!!! jazmin OOP 4 21-06-2010 10:55:13
Parar un hilo de ejecución deivi Varios 6 21-11-2006 14:36:49


La franja horaria es GMT +2. Ahora son las 12:07:11.


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
Copyright 1996-2007 Club Delphi