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+} 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-}
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
[-]
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.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;
if Self.Dataset_temporal.Active then
begin
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
if self.StringGrid_temporal.ColCount > 0 then
begin
for j_local:= 0 to self.StringGrid_temporal.RowCount -1 do
begin
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