Ver Mensaje Individual
  #4  
Antiguo 16-10-2008
JosepGA JosepGA is offline
Miembro
 
Registrado: jun 2007
Ubicación: Tarragona
Posts: 166
Reputación: 17
JosepGA Va por buen camino
Espero que te sirva, te lo envio por partes:

unit RptConsultaMantRB;

interface

uses
Forms, SysUtils, Dialogs, Graphics, Provider, SqlExpr, DBXpress, SimpleDS, DB, TXComp, ppDB, ppDBPipe, DBClient, DBLocal, DBLocalS,
ppParameter, ppVar, ppBands, ppMemo, ppStrtch, ppRegion, ppCtrls, ppPrnabl, ppClass, ppCache, Classes, ppComm, ppRelatv, ppProd,
ppReport, ppTypes, Printers, ppRichTx, Parser10, ppWWRichEd,
//ppVar, ppBands, ppMemo, ppStrtch, ppRegion, ppCtrls, ppPrnabl, ppClass, ppCache, Classes, ppComm, ppRelatv, ppProd, ppReport, Printers,
//ppRichTx, ppWWRichEd, Parser10, ppChrt, ppTypes, ppParameter,

TXRB;

type
TFormRptConsultaMantenimientos = class(TForm)
ppReportConsultaMant: TppReport;
DSTablaConsulta: TDataSource;
ppCabecera: TppHeaderBand;
ppDetalle: TppDetailBand;
ppPiePagina: TppFooterBand;
ppLabelTituloListado: TppLabel;
ppSystemVariable1: TppSystemVariable;
ppSystemVariable2: TppSystemVariable;
ppLine1: TppLine;
ppLine2: TppLine;
ppLabel2: TppLabel;
ppVariable1: TppVariable;
Calculadora: TParser;
tContabilidades: TSQLClientDataSet;
tEmpresasContables: TSQLClientDataSet;
tLogoClientes: TSQLClientDataSet;
tEmpresasComercial: TSQLClientDataSet;
tParamClientes: TSQLClientDataSet;
ppDBPipeline1: TppDBPipeline;
ppLabel1: TppLabel;
ppVariable2: TppVariable;
ExtraOptions1: TExtraOptions;
tSQLConexionGeneral: TSQLConnection;
tSQLConexionGestion: TSQLConnection;
tSQLConexionContabilidad: TSQLConnection;
tTablaConsulta: TSimpleDataSet;
tTablaRelacionada: TSimpleDataSet;
ppParameterList1: TppParameterList;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure DarDeAltaCamposEnReport( TamanyoFuente : Double );
procedure ppVariable1GetText(Sender: TObject; var Text: String);
procedure ppReportConsultaMantPreviewFormCreate(Sender: TObject);
procedure ppVariable2GetText(Sender: TObject; var Text: String);
private
{ Private declarations }
TituloDelReport : String;
ListaCampos : tStringList;
ListaTitulos : tStringList;
ListaFormulas : tStringList;
ListaFormulasExpresion : tStringList;
ListaLongitud : tStringList;
ListaAlineacion : tStringList;
ListaFormatoCampos : tStringList;
ListaSumados : tStringList;
ListaCamposConRango : tStringList;
ListaRangosDesde : tStringList;
ListaRangosHasta : tStringList;
ListaValoresSustituir : tStringList;
//ListaBDTablasRelacionadasSQL : tStringList;
ListaTablasRelacionadasSQL : tStringList;

ListaTotalesSumados : tStringList;

MostratPiePagina : Boolean;

NombreEmpresa, NombreEmpresaCtb : String;
CamposMaestroAux : String;
CamposRelacionadoAux : String;

ListaTablasRelacionadas : Array[ 0..10 ] Of TSimpleDataSet;
ListaTablasRelacionadasCamposMaestro : Array[ 0..10 ] Of String;
ListaTablasRelacionadasCamposRelacionado : Array[ 0..10 ] Of String;
ListaTablasRelacionadasCampoDevolver : Array[ 0..10 ] Of String;

function CalcularExpresion( Expresion : String ) : String;

Procedure ActivarConexionesModuloDeDatos( Const tSQLConexionGeneralOrigen, tSQLConexionGestionOrigen, tSQLConexionContabilidadOrigen : tSQLConnection );
Procedure DesactivarConexionesModuloDeDatos( Const tSQLConexionGeneralOrigen, tSQLConexionGestionOrigen, tSQLConexionContabilidadOrigen : tSQLConnection );

Procedure ActivarConexionGeneral;
Procedure ActivarConexionGestion;
Procedure ActivarConexionContabilidad;

Procedure DesactivarConexionGeneral;
Procedure DesactivarConexionGestion;
Procedure DesactivarConexionContabilidad;
protected
procedure tCalculoFormulas( sender: TObject; Var Value: String );
procedure tCalculoFormulasSumatorio( sender: TObject; Var Value: String );
procedure tFormateadoCampo(sender: TObject; var Value: String);
procedure tBuscarDatoCampoRelacionado(Sender: TObject; var Text: String);
procedure ppEtiquetaCampoClick(Sender, aDrawCommand: TObject);
public
{ Public declarations }
end;

procedure EjecutarRptConsultaMantenimientos(
vGlobales : tVariablesGlobales;
Const auxSQLConexionGestion: TSQLConnection;
Const auxSQLConexionGeneral: TSQLConnection;
Const auxSQLConexionContabilidad: TSQLConnection;
Titulo : String;
BaseDeDatos : Integer;
ConsultaTablaSQL : String;
Apaisado : Boolean;
TamanyoFuente : Double;
LstCampos : tStringList;
LstTitulos : tStringList;
LstFormulas : tStringList;
LstFormulasExpresion : tStringList;
LstLongitud : tStringList;
LstAlineacion : tStringList;
LstFormatoCampos : tStringList;
LstSumados : tStringList;
LstCamposConRango : tStringList;
LstRangosDesde : tStringList;
LstRangosHasta : tStringList;
LstValoresSustituir : tStringList;
//LstBDTablasRelacionadasSQL : tStringList;
LstTablasRelacionadasSQL : tStringList;
EmpresaActual, EmpresaCtb, CtbActual : String;
NombreEmpresaActual, NombreEmpresaCtbActual : String ); far; Export;
var
FormRptConsultaMantenimientos: TFormRptConsultaMantenimientos;
FilaTitulos : Integer;

implementation

procedure EjecutarRptConsultaMantenimientos(
vGlobales : tVariablesGlobales;
Const auxSQLConexionGestion: TSQLConnection;
Const auxSQLConexionGeneral: TSQLConnection;
Const auxSQLConexionContabilidad: TSQLConnection;
Titulo : String;
BaseDeDatos : Integer;
ConsultaTablaSQL : String;
Apaisado : Boolean;
TamanyoFuente : Double;
LstCampos : tStringList;
LstTitulos : tStringList;
LstFormulas : tStringList;
LstFormulasExpresion : tStringList;
LstLongitud : tStringList;
LstAlineacion : tStringList;
LstFormatoCampos : tStringList;
LstSumados : tStringList;
LstCamposConRango : tStringList;
LstRangosDesde : tStringList;
LstRangosHasta : tStringList;
LstValoresSustituir : tStringList;
//LstBDTablasRelacionadasSQL : tStringList;
LstTablasRelacionadasSQL : tStringList;
EmpresaActual, EmpresaCtb, CtbActual : String;
NombreEmpresaActual, NombreEmpresaCtbActual : String ); far; Export;
Var
i : LongInt;
TieneFiltros : Boolean;
PosicionNombreEmpresa : LongInt;

PosicionArray : LongInt;
Parametros : String;
auxBaseDeDatos : String;
TablaRelacionada : String;
IndiceRango : String;
CamposMaestro : String;
CamposRelacionado : String;
CampoDevolver : String;
PosicionCorchete : LongInt;
PosicionPuntoComa : LongInt;
CampoRangoMaestro : String;
CampoRangoRelacionado : String;
TipoBaseDatos : LongInt;

Begin
AsignacionValoresGlobales( vGlobales );

FilaTitulos := 60;

If ( Pos( '( ' + NombreEmpresaActual + ' )', Titulo ) <> 0 ) Then
Delete( Titulo, Pos( '( ' + NombreEmpresaActual + ' )', Titulo ), Length( '( ' + NombreEmpresaActual + ' )' ) );

AsignarLaConfiguracionDeLasAplicaciones;

setEmpresaActual := EmpresaActual;
setEmpresaContable := EmpresaCtb;
Try
setContabilidad := StrToInt( CtbActual );
Except
setContabilidad := -1;
End;

Application.CreateForm( tFormRptConsultaMantenimientos, FormRptConsultaMantenimientos );

With FormRptConsultaMantenimientos Do
Try
ActivarConexionesModuloDeDatos( auxSQLConexionGeneral, auxSQLConexionGestion, auxSQLConexionContabilidad );

tContabilidades.DBConnection := tSQLConexionGeneral;
tEmpresasContables.DBConnection := tSQLConexionGeneral;
tLogoClientes.DBConnection := tSQLConexionGeneral;
tEmpresasComercial.DBConnection := tSQLConexionGeneral;
tParamClientes.DBConnection := tSQLConexionGeneral;

tContabilidades.Active := TRUE;
tEmpresasContables.Active := TRUE;
tLogoClientes.Active := TRUE;
tEmpresasComercial.Active := TRUE;
tParamClientes.Active := TRUE;

ppReportConsultaMant.BeginUpdate;

TituloDelReport := Titulo;
ppLabelTituloListado.Caption := TituloDelReport;
ppReportConsultaMant.PrinterSetup.DocumentName := TituloDelReport;
ppReportConsultaMant.ShowAutoSearchDialog := FALSE;
ppReportConsultaMant.Units := utScreenPixels;

If Apaisado Then
Begin
ppReportConsultaMant.PrinterSetup.Orientation := poLandscape;
ppLabelTituloListado.Width := ppReportConsultaMant.PrinterSetup.PaperWidth - 50;
ppLine2.Width := ppLabelTituloListado.Width;
ppSystemVariable2.Left := ppLabelTituloListado.Width - ppSystemVariable2.Width;
End;

ListaCampos.AddStrings( LstCampos );
ListaTitulos.AddStrings( LstTitulos );
ListaFormulas.AddStrings( LstFormulas );
ListaFormulasExpresion.AddStrings( LstFormulasExpresion );
ListaLongitud.AddStrings( LstLongitud );
ListaAlineacion.AddStrings( LstAlineacion );
ListaFormatoCampos.AddStrings( LstFormatoCampos );
ListaSumados.AddStrings( LstSumados );
ListaCamposConRango.AddStrings( LstCamposConRango );
ListaRangosDesde.AddStrings( LstRangosDesde );
ListaRangosHasta.AddStrings( LstRangosHasta );
ListaValoresSustituir.AddStrings( LstValoresSustituir );
//ListaBDTablasRelacionadasSQL.AddStrings( LstBDTablasRelacionadasSQL );
ListaTablasRelacionadasSQL.AddStrings( LstTablasRelacionadasSQL );

For i := 0 To ( ListaCampos.Count - 1 ) Do
Begin
ListaFormulas.Strings[ i ] := UpperCase( Trim( ListaFormulas.Strings[ i ] ) );
ListaAlineacion.Strings[ i ] := UpperCase( Trim( ListaAlineacion.Strings[ i ] ) );
ListaSumados.Strings[ i ] := UpperCase( Trim( ListaSumados.Strings[ i ] ) );
ListaCamposConRango.Strings[ i ] := UpperCase( Trim( ListaCamposConRango.Strings[ i ] ) );
ListaTotalesSumados.Add( '0' );
End;

For i := 0 To ( ListaTablasRelacionadasSQL.Count - 1 ) Do
Begin
Parametros := ListaTablasRelacionadasSQL.Strings[ i ];
If Parametros <> '' Then
Begin
PosicionCorchete := Pos( ']', Parametros );
auxBaseDeDatos := Copy( Parametros, 2, ( PosicionCorchete - 2 ) );
Delete( Parametros, 1, PosicionCorchete );
Try
TipoBaseDatos := StrToInt( auxBaseDeDatos );
Except
TipoBaseDatos := 1; { 0=General, 1=Producción, 2=Facturacion, 3=Contabilidad }
End;

PosicionCorchete := Pos( '[', Parametros );
Delete( Parametros, 1, ( PosicionCorchete - 1 ) );

PosicionCorchete := Pos( ']', Parametros );
TablaRelacionada := Copy( Parametros, 2, ( PosicionCorchete - 2 ) );
Delete( Parametros, 1, PosicionCorchete );

PosicionCorchete := Pos( '[', Parametros );
Delete( Parametros, 1, ( PosicionCorchete - 1 ) );

PosicionCorchete := Pos( ']', Parametros );
IndiceRango := Copy( Parametros, 2, ( PosicionCorchete - 2 ) );
Delete( Parametros, 1, PosicionCorchete );

PosicionCorchete := Pos( '[', Parametros );
Delete( Parametros, 1, ( PosicionCorchete - 1 ) );

PosicionCorchete := Pos( ']', Parametros );
CamposMaestro := Copy( Parametros, 2, ( PosicionCorchete - 2 ) );
Delete( Parametros, 1, PosicionCorchete );

PosicionCorchete := Pos( '[', Parametros );
Delete( Parametros, 1, ( PosicionCorchete - 1 ) );

PosicionCorchete := Pos( ']', Parametros );
CamposRelacionado := Copy( Parametros, 2, ( PosicionCorchete - 2 ) );
Delete( Parametros, 1, PosicionCorchete );

PosicionCorchete := Pos( '[', Parametros );
Delete( Parametros, 1, ( PosicionCorchete - 1 ) );

PosicionCorchete := Pos( ']', Parametros );
CampoDevolver := Copy( Parametros, 2, ( PosicionCorchete - 2 ) );
Delete( Parametros, 1, PosicionCorchete );

ListaTablasRelacionadas[ i ] := TSimpleDataSet.Create( FormRptConsultaMantenimientos );
ListaTablasRelacionadasCamposMaestro[ i ] := CamposMaestro;
ListaTablasRelacionadasCamposRelacionado[ i ] := CamposRelacionado;
ListaTablasRelacionadasCampoDevolver[ i ] := CampoDevolver;

Case TipoBaseDatos Of
0 : { General }
Begin
ListaTablasRelacionadas[ i ].Connection := tSQLConexionGeneral;
End;
1 : { Producción }
Begin
ListaTablasRelacionadas[ i ].Connection := tSQLConexionGestion;
End;
2 : { Facturación }
Begin
ListaTablasRelacionadas[ i ].Connection := tSQLConexionGestion;
End;
3 : { Contabilidad }
Begin
ListaTablasRelacionadas[ i ].Connection := tSQLConexionContabilidad;
End;
End;

ListaTablasRelacionadas[ i ].DataSet.CommandText := TablaRelacionada;
ListaTablasRelacionadas[ i ].Open;
End;
End;

MostratPiePagina := FALSE;
For i := 0 To ( ListaSumados.Count - 1 ) Do
If ( ListaSumados.Strings[ i ] = 'S' ) Then
MostratPiePagina := TRUE;

TieneFiltros := FALSE;
For i := 0 To ( LstCamposConRango.Count - 1 ) Do
If ( LstCamposConRango.Strings[ i ] = 'S' ) Then
TieneFiltros := TRUE;

With tTablaConsulta Do
Begin
Case BaseDeDatos Of
0 : { General }
Connection := tSQLConexionGeneral;
1 : { Producción }
Connection := tSQLConexionGestion;
2 : { Facturación }
Connection := tSQLConexionGestion;
3 : { Contabilidad }
Connection := tSQLConexionContabilidad;
End;

DataSet.CommandText := ConsultaTablaSQL;

Try
If Not Active Then
Open;
Except
on E: Exception do ShowMessage( E.Message );
End;
End;

If BaseDeDatos = 3 Then { Contabilidad }
Begin
FilaTitulos := FilaTitulos + 20;
ppCabecera.Height := ppCabecera.Height + 20;
End;

Try
DarDeAltaCamposEnReport( TamanyoFuente );
Finally
ppReportConsultaMant.EndUpdate;
tTablaConsulta.EnableControls;
End;

With tTablaConsulta Do
Try
If Not Active Then
Open;
Except
on E: Exception do ShowMessage( E.Message );
End;

Case BaseDeDatos Of
0, 1, 2 : { General, Producción, Facturación }
Begin
With tEmpresasComercial Do
If FindKey( [ EmpresaActual ] ) Then
NombreEmpresa := FieldByName( 'Nombre' ).AsString
Else
NombreEmpresa := NombreEmpresaActual;
NombreEmpresaCtb := '';
ppLabel1.Visible := FALSE;
ppVariable2.Visible := FALSE;
End;
3 : { Contabilidad }
Begin
With tEmpresasContables Do
If FindKey( [ EmpresaCtb ] ) Then
NombreEmpresa := FieldByName( 'DESCRIPCION' ).AsString
Else
NombreEmpresa := NombreEmpresaActual;

With tContabilidades Do
If FindKey( [ EmpresaCtb, CtbActual ] ) Then
NombreEmpresaCtb := FieldByName( 'DESCRIPCION' ).AsString
Else
NombreEmpresaCtb := NombreEmpresaCtbActual;
End;
End;

(*Application.CreateForm( tFormPrevisualizacionRts, FormPrevisualizacionRts );
With FormPrevisualizacionRts Do
Try
ppVisualizador.Hint := 'Pulse en un Título para ordenar por el campo';
ppVisualizadorSegundaPagina.Hint := 'Pulse en un Título para ordenar por el campo';
ppVisualizador.Report := ppReportConsultaMant;

FormPrevisualizacionRts.ShowModal;
Finally
Free;
End;*)

ppReportConsultaMant.Print;

ChDir( setRutaEjecutable );
Finally
DesactivarConexionesModuloDeDatos( auxSQLConexionGeneral, auxSQLConexionGestion, auxSQLConexionContabilidad );

Free;
End;
End;
Responder Con Cita