unit uRptWordPresupuestoCliente; interface uses SysUtils, Classes, AHWord97, IB, IBCustomDataSet, IBDatabase, Word2000, uDAInterfaces, uDADataStreamer, uDABin2DataStreamer, uDAClasses, uDAScriptingProvider, uDADataTable, uDAMemDataTable; type TCapitulo = record Tipo : string; Nombre : string; Total : double; end; TRptWordPresupuestoCliente = class(TDataModule) DABin2DataStreamer: TDABin2DataStreamer; tbl_Cabecera: TDAMemDataTable; tbl_Detalles: TDAMemDataTable; tbl_Empresa: TDAMemDataTable; schReport: TDASchema; DataDictionary: TDADataDictionary; procedure DataModuleCreate(Sender: TObject); private FConnection: IDAConnection; FImportes : Boolean; FDesBonificacion : Variant; FImpBonificacion : Double; FPlantilla : string; FWordApp : TWordApp; FDocumento : TWordDoc; FNumCapitulos : Integer; FNumCapOpc : Integer; FContadorCap : Integer; FCodigoPresupuesto : string; FNombreFichero : String; ListaCapitulos : array[1..1000] of TCapitulo; FVerSello: Integer; FTablaInicioContenido: Table; procedure InsertarConceptos(Tabla : Table); function Generar : Boolean; function RellenarPortada : boolean; virtual; function RellenarCabecera : boolean; virtual; function RellenarInforme : boolean; virtual; function RellenarResumen : boolean; virtual; procedure _GenerarPresupuesto(const AID : String); public constructor Create (AOwner : TComponent); override; destructor Destroy; override; function Exportar(Codigo, Fichero : String; const VerSello: Integer): Boolean; end; implementation {$R *.dfm} uses Windows, Variants, Dialogs, uDataModuleServer, uStringsUtils, uSistemaFunc, srvEmpresas_Impl, uROTypes, uROClasses; const rptInforme = 'Presupuesto.rdx'; constructor TRptWordPresupuestoCliente.Create(AOwner: TComponent); begin inherited; FDocumento := NIL; FImportes := True; FNumCapitulos := 0; FVerSello:= 1; end; procedure TRptWordPresupuestoCliente.DataModuleCreate(Sender: TObject); begin schReport.ConnectionManager := dmServer.ConnectionManager; FConnection := dmServer.DarNuevaConexion; end; destructor TRptWordPresupuestoCliente.Destroy; begin if FDocumento <> NIL then FDocumento.Free; FDocumento := NIL; inherited; end; function TRptWordPresupuestoCliente.Exportar(Codigo, Fichero: String; const VerSello: Integer): Boolean; begin if EsCadenaVacia(Fichero) then RaiseError('Falta indicar el fichero donde se exportará el listado.'); FNombreFichero := Fichero; FCodigoPresupuesto := Codigo; FVerSello := VerSello; _GenerarPresupuesto(Codigo); Result := True; end; function TRptWordPresupuestoCliente.Generar : Boolean; begin FWordApp := TWordApp.Create (False, False); with FWordApp do begin Visible := False; ScreenUpdating := False; end; FDocumento := TWordDoc.CreateNewDoc(FWordApp, FPlantilla); FWordApp.SaveActiveDocAs(FNombreFichero); FTablaInicioContenido := FDocumento.Document.Tables.Item(2); try if not RellenarPortada then RaiseError('Se producido un error al generar la portada del informe en MS Word.'); if not RellenarCabecera then RaiseError('Se producido un error al generar la cabecera del informe en MS Word.'); if not RellenarInforme then RaiseError('Se producido un error al generar el informe en MS Word.'); if (FNumCapitulos <> 0) and (FNumCapOpc < FNumCapitulos) then begin if not RellenarResumen then RaiseError('Se producido un error al generar el resumen en MS Word.'); end else begin FDocumento.Document.Tables.Item(FDocumento.Document.Tables.Count-1).Delete; end; FWordApp.CloseApp(wdSaveChanges); Result := True; finally FDocumento := NIL; FWordApp := NIL; end; end; procedure TRptWordPresupuestoCliente.InsertarConceptos(Tabla : Table); var numRows, numCols, mergeSplit, shiftCells : OleVariant; iContador : Integer; TotalConceptos : Double; ACantidad: String; AIndice: Integer; AText : String; begin TotalConceptos := 0; numRows := 2; numCols := 1; mergeSplit := False; shiftCells := False; iContador := 2; // Empezar en la 2ª fila de celdas. La primera es la // cabecera de la tabla. with Tabla, tbl_Detalles do begin while not EOF do begin if FieldByName('TIPO_DETALLE').AsString <> 'Concepto' then Break; // Partir la celda actual en 2 filas de 1 columna. Rows.Item(iContador).Cells.Split (numRows, numCols, mergesplit); Cell(iContador, 1).Range.Text := FieldByName('CONCEPTO').AsString; ACantidad := FloatToStr(FieldByName('CANTIDAD').AsFloat); if ACantidad = '0' then AText := '' else begin AIndice := Pos(',', ACantidad); if AIndice > 0 then AText := FormatFloat('#,0.00', FieldByName('CANTIDAD').AsFloat) else AText := FormatFloat('#,0.##', FieldByName('CANTIDAD').AsFloat); end; Cell(iContador, 2).Range.Text := AText + ' ' + FieldByName('UNIDAD_MEDIDA').AsString; if FImportes and (FieldByName('IMPORTE_UNIDAD').AsFloat <> 0) then Cell(iContador, 3).Range.Text := FormatFloat(DISPLAY_EUROS4, FieldByName('IMPORTE_UNIDAD').AsFloat) else Cell(iContador, 3).Range.Text := ''; if FImportes and (FieldByName('IMPORTE_TOTAL').AsFloat <> 0) then Cell(iContador, 4).Range.Text := FormatFloat(DISPLAY_EUROS4, FieldByName('IMPORTE_TOTAL').AsFloat) else Cell(iContador, 4).Range.Text := ''; TotalConceptos := TotalConceptos + FieldByName('IMPORTE_TOTAL').AsFloat; Next; Inc (iContador); end; ListaCapitulos[FContadorCap].Total := TotalConceptos; // Borrar la fila vacía que sobra Rows.Item(iContador).Cells.Delete(shiftCells); if FImportes then Cell(iContador, 1).Range.Text := 'Total: ' + FormatFloat(DISPLAY_EUROS2, TotalConceptos) else Cell(iContador, 1).Range.Text := ''; AutoFitBehavior(wdAutoFitWindow); end; end; function TRptWordPresupuestoCliente.RellenarCabecera: boolean; var NombreFichero, Texto : String; { FicheroTemporal : String; LinkToFile, SaveWithDocument, _Range : OleVariant; Imagen : InlineShape; ovRange : OleVariant; Which, Name : OleVariant;} What, Count : OleVariant; ovBookMarkName : OleVariant; TempRange : Word2000.Range; begin //PARA DIBUJAR EL LOGOTIPO MULTIEMPRESA { --------------------- PENDIENTE if (EmpresaActiva.Logotipo <> Nil) then begin //Activamos cabecera segunda What:=wdGoToSection; Which:=wdGoToFirst; Count:=2; Name:=''; FWordApp.Application.ActiveWindow.ActivePane.Selection.GoTo_ (What, Which, Count, Name); FWordApp.Application.ActiveWindow.ActivePane.View.SeekView := wdSeekCurrentPageHeader; LinkToFile := False; SaveWithDocument := True; _Range := EmptyParam; FicheroTemporal := DarFicheroTemporal; EmpresaActiva.Logotipo.SaveToFile (FicheroTemporal); Imagen := FWordApp.Application.ActiveWindow.ActivePane.Selection.InlineShapes.AddPicture(FicheroTemporal, LinkToFile, SaveWithDocument, _Range); //Formateamos imagen if ((Imagen.Get_Width > ANCHO_LOGO_INF)) then begin Imagen.Set_Height(((ANCHO_LOGO_INF * Imagen.Get_Height) /Imagen.Get_Width)); Imagen.Set_Width(ANCHO_LOGO_INF); end; end; -------------------------------------- } with FDocumento, tbl_Cabecera do begin if FieldByName('IMPORTE_BONIFICACION').AsFloat > 0 then FDesBonificacion := FieldByName('DESCRIPCION_BONIFICACION').AsString else FDesBonificacion := Null; FImpBonificacion := FieldByName('IMPORTE_BONIFICACION').AsFloat; ReplaceBookmark('CodigoPresupuestoCab', FieldByName('REFERENCIA').AsString); ReplaceBookmark('FechaPresupuestoCab', FieldByName('FECHA_PRESUPUESTO').AsString); ReplaceBookmark('NombreClienteCab', FieldByName('NOMBRE').AsString); ReplaceBookmark('DireccionClienteCab', FieldByName('CALLE').AsString); ReplaceBookmark('PoblacionClienteCab', FieldByName('CODIGO_POSTAL').AsString + ' ' + FieldByName('POBLACION').AsString + ' ' + FieldByName('PROVINCIA').AsString); ReplaceBookmark('ContactoClienteCab', FieldByName('PERSONA_CONTACTO').AsString); ReplaceBookmark('NombreClienteFirma', FieldByName('NOMBRE').AsString); //Solo para la empresa de tecsitel se debe elegir uno u otra firma //esto es un poco parche pero bueno if (tbl_Cabecera.FieldByName('ID_EMPRESA').AsInteger = 1) then begin if (FVerSello = 1) then ReplaceBookmark('Firma2', '') else ReplaceBookmark('Firma1', ''); if (tbl_Cabecera.FieldByName('CERTIFICADO_ISO').AsInteger <> 1) then begin ReplaceBookmark('ISO1', ''); ReplaceBookmark('ISO2', ''); end; end; if not EsCadenaVacia(FieldByName('MEMORIA').AsString) then begin Texto := FieldByName('MEMORIA').AsString; NombreFichero := DarFicheroTemporal; EscribirEnFichero(NombreFichero, Texto); FWordApp.InsertFile(NombreFichero, 'TextoPresupuesto'); SysUtils.DeleteFile(NombreFichero); end else begin ovBookMarkName := 'TextoPresupuesto'; TempRange := FWordApp.Application.ActiveDocument.Bookmarks.Item (ovBookMarkName).Range; What := wdCharacter; Count := 3; TempRange.Delete(What, Count); end; Texto := FieldByName('OBSERVACIONES').AsString; NombreFichero := DarFicheroTemporal; EscribirEnFichero(NombreFichero, Texto); FWordApp.InsertFile(NombreFichero, 'Notas'); SysUtils.DeleteFile(NombreFichero); if (tbl_Cabecera.FieldByName('ID_EMPRESA').AsInteger <> 3) then begin ReplaceBookmark('NombreEmpresaPortada', tbl_Empresa.FieldByName('NOMBRE').AsString); ReplaceBookmark('DireccionEmpresaPortada', Format('%s. %s %s', [tbl_Empresa.FieldByName('CALLE').AsString, tbl_Empresa.FieldByName('CODIGO_POSTAL').AsString, tbl_Empresa.FieldByName('POBLACION').AsString])); ReplaceBookmark('TelefonoEmpresaPortada', tbl_Empresa.FieldByName('TELEFONO_1').AsString); ReplaceBookmark('FaxEmpresaPortada', tbl_Empresa.FieldByName('FAX').AsString); ReplaceBookmark('CorreoEmpresaPortada', tbl_Empresa.FieldByName('EMAIL_1').AsString); ReplaceBookmark('NombreEmpresa', tbl_Empresa.FieldByName('NOMBRE').AsString); ReplaceBookmark('CifEmpresa', tbl_Empresa.FieldByName('NIF_CIF').AsString); ReplaceBookmark('DireccionEmpresa', Format('%s. %s %s', [tbl_Empresa.FieldByName('CALLE').AsString, tbl_Empresa.FieldByName('CODIGO_POSTAL').AsString, tbl_Empresa.FieldByName('POBLACION').AsString])); ReplaceBookmark('TelefonoEmpresa', tbl_Empresa.FieldByName('TELEFONO_1').AsString); ReplaceBookmark('FaxEmpresa', tbl_Empresa.FieldByName('FAX').AsString); ReplaceBookmark('CorreoEmpresa', tbl_Empresa.FieldByName('EMAIL_1').AsString); ReplaceBookmark('NombreEmpresaFirma', tbl_Empresa.FieldByName('NOMBRE').AsString); end; end; Result := True; end; function TRptWordPresupuestoCliente.RellenarInforme: boolean; var NombreCapitulo : String; Estilo : OleVariant; begin FNumCapitulos := 0; FContadorCap := 0; FNumCapOpc := 0; with FDocumento, tbl_Detalles do begin First; FieldByName('IMPORTE_UNIDAD').DisplayFormat := DISPLAY_EUROS4; FieldByName('IMPORTE_TOTAL').DisplayFormat := DISPLAY_EUROS4; GoToSection(3); { Copiar la tabla de conceptos al portapapeles } FTablaInicioContenido.Select; FWordApp.Application.Selection.Cut; while not Eof do begin if (FieldByName('TIPO_DETALLE').AsString = 'Subtotal') then begin Next; Continue; end; if (FieldByName('TIPO_DETALLE').AsString = 'Titulo') or (FieldByName('TIPO_DETALLE').AsString = 'Titulo opcional') then begin NombreCapitulo := ''; Estilo := 'TituloCapitulo'; FWordApp.Application.Selection.Set_Style(Estilo); if (FieldByName('TIPO_DETALLE').AsString = 'Titulo') then begin NombreCapitulo := 'Capítulo ' + IntToStr(FContadorCap + 1) + '. ' + FieldByName('CONCEPTO').AsString; Inc(FContadorCap); Inc(FNumCapitulos); end else begin NombreCapitulo := 'Capítulo opcional. ' + FieldByName('CONCEPTO').AsString; Inc(FContadorCap); Inc(FNumCapOpc); Inc(FNumCapitulos); end; FWordApp.InsertText(NombreCapitulo); FWordApp.InsertText(#13); ListaCapitulos[FNumCapitulos].Tipo := FieldByName('TIPO_DETALLE').AsString; ListaCapitulos[FNumCapitulos].Nombre := NombreCapitulo; { Pegar una tabla para rellenarla } FWordApp.Application.Selection.Paste; Next; end else begin if FContadorCap = 0 then begin Inc(FContadorCap); // Se considera el conjunto de conceptos sueltos como un capítulo. Inc(FNumCapitulos); { Pegar una tabla para rellenarla } FWordApp.Application.Selection.Paste; InsertarConceptos(Document.Tables.Item(Document.Tables.Count - 2)); end else InsertarConceptos(Document.Tables.Item(Document.Tables.Count - 2)); end; end; end; Result := True; end; function TRptWordPresupuestoCliente.RellenarPortada: boolean; var NombreFichero, Texto : String; {FicheroTemporal : string; LinkToFile, SaveWithDocument, _Range : OleVariant; Imagen : InlineShape;} begin //PARA DIBUJAR EL LOGOTIPO MULTIEMPRESA {--------------------------- PENDIENTE if (EmpresaActiva.Logotipo <> Nil) then begin FWordApp.GotoBookmark ('LogotipoEmpresa'); LinkToFile := False; SaveWithDocument := True; _Range := EmptyParam; FicheroTemporal := DarFicheroTemporal; EmpresaActiva.Logotipo.SaveToFile (FicheroTemporal); Imagen := FWordApp.Application.ActiveWindow.ActivePane.Selection.InlineShapes.AddPicture(FicheroTemporal, LinkToFile, SaveWithDocument, _Range); //Formateamos imagen if ((Imagen.Get_Width > ANCHO_LOGO_INF_PRE)) then begin Imagen.Set_Height(((ANCHO_LOGO_INF_PRE * Imagen.Get_Height) /Imagen.Get_Width)); Imagen.Set_Width(ANCHO_LOGO_INF_PRE); end; end; ---------------------------- } with FDocumento, tbl_Cabecera do begin if (tbl_Cabecera.FieldByName('ID_EMPRESA').AsInteger <> 3) then begin ReplaceBookmark('CodigoPresupuestoPortada', FieldByName('REFERENCIA').AsString); ReplaceBookmark('FechaPresupuestoPortada', FieldByName('FECHA_PRESUPUESTO').AsString); ReplaceBookmark('NombreClientePortada', FieldByName('NOMBRE').AsString); if not EsCadenaVacia(FieldByName('PERSONA_CONTACTO').AsString) then ReplaceBookmark('PersonaContactoClientePortada', 'A la atención de: ' + FieldByName('PERSONA_CONTACTO').AsString); end; Texto := FieldByName('PORTADA').AsString; NombreFichero := DarFicheroTemporal; EscribirEnFichero(NombreFichero, Texto); FWordApp.InsertFile(NombreFichero, 'TextoPortada'); SysUtils.DeleteFile(NombreFichero); end; Result := True; end; function TRptWordPresupuestoCliente.RellenarResumen : boolean; var numRows, numCols, mergeSplit, shiftCells : OleVariant; iAux : Integer; iContador : Integer; TotalConceptos : Double; Tabla : Table; Estilo : OleVariant; begin TotalConceptos := 0; numRows := 2; numCols := 1; mergeSplit := False; shiftCells := False; iContador := 2; // Empezar en la 2ª fila de celdas. La primera es la // cabecera de la tabla. Estilo := 'TituloCapitulo'; FWordApp.Application.Selection.Set_Style(Estilo); Tabla := FDocumento.Document.Tables.Item(FDocumento.Document.Tables.Count-1); //Solo se sacará el resumen si hay más de un capitulo if (FNumCapitulos > 1) then begin FWordApp.InsertText('RESUMEN'); with Tabla do begin for iAux := 1 to FNumCapitulos do begin if (ListaCapitulos[iAux].Tipo = 'Titulo opcional') then continue; // No sumamos los capítulos opcionales. // Partir la celda actual en en 2 filas de 1 columna. Rows.Item(iContador).Cells.Split (numRows, numCols, mergesplit); if EsCadenaVacia(ListaCapitulos[iAux].Nombre) then Cell(iContador, 1).Range.Text := 'General' else Cell(iContador, 1).Range.Text := ListaCapitulos[iAux].Nombre; if FImportes then Cell(iContador, 2).Range.Text := FormatFloat(DISPLAY_EUROS2, ListaCapitulos[iAux].Total) else Cell(iContador, 2).Range.Text := ''; TotalConceptos := TotalConceptos + ListaCapitulos[iAux].Total; Inc (iContador); end; // Borrar la fila vacía que sobra Rows.Item(iContador).Cells.Delete(shiftCells); if FImportes then begin //Comprobamos si el presupuesto tiene bonificación if VarIsNull(FDesBonificacion) then begin Cell(iContador, 1).Range.Text := 'Total: ' + FormatFloat(DISPLAY_EUROS2, TotalConceptos); // Borrar filas de bonificación inc(iContador); Rows.Item(iContador).Cells.Delete(shiftCells); Rows.Item(iContador).Cells.Delete(shiftCells); Rows.Item(iContador).Cells.Delete(shiftCells); end else begin //Elimino la ultima fila para enlazar la tabla las tres filas de bonificación Rows.Item(iContador).Cells.Delete(shiftCells); with FDocumento do begin ReplaceBookmark('DescripcionImpTotal', 'Total'); ReplaceBookmark('ImporteTotal', FormatFloat(DISPLAY_EUROS2, TotalConceptos)); ReplaceBookmark('DescripcionBonificacion', FDesBonificacion); ReplaceBookmark('ImporteBonificacion', FormatFloat(DISPLAY_EUROS2, ((-1)*FImpBonificacion))); ReplaceBookmark('DescripcionImpFinal', 'Importe final'); ReplaceBookmark('ImpFinal', FormatFloat(DISPLAY_EUROS2, TotalConceptos - FImpBonificacion)); end; end; end else begin Cell(iContador, 1).Range.Text := ''; // Borrar filas de bonificación inc(iContador); Rows.Item(iContador).Cells.Delete(shiftCells); Rows.Item(iContador).Cells.Delete(shiftCells); Rows.Item(iContador).Cells.Delete(shiftCells); end; AutoFitBehavior(wdAutoFitWindow); end; end else begin // Tabla.Delete; Tabla.Rows.Item(1).Cells.Delete(shiftCells); //Cabecera Tabla.Rows.Item(1).Cells.Delete(shiftCells); //Capitulo General Tabla.Rows.Item(1).Cells.Delete(shiftCells); //Capitulo General Tabla.Rows.Item(1).Cells.Delete(shiftCells); //Capitulo General //Comprobamos si el presupuesto tiene bonificación if VarIsNull(FDesBonificacion) then begin Tabla.Rows.Item(1).Cells.Delete(shiftCells); //Capitulo General Tabla.Rows.Item(1).Cells.Delete(shiftCells); //Capitulo General end else begin FDocumento.ReplaceBookmark('DescripcionBonificacion', FDesBonificacion); FDocumento.ReplaceBookmark('ImporteBonificacion', FormatFloat(DISPLAY_EUROS2, ((-1)*FImpBonificacion))); FDocumento.ReplaceBookmark('DescripcionImpFinal', 'Importe final'); FDocumento.ReplaceBookmark('ImpFinal', FormatFloat(DISPLAY_EUROS2, tbl_Cabecera.FieldByName('IMPORTE_TOTAL').AsFloat)); end; end; Result := True; end; procedure TRptWordPresupuestoCliente._GenerarPresupuesto(const AID: String); var ACopiaPlantilla: string; begin FConnection.BeginTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" try tbl_Cabecera.ParamByName('ID').AsString := AID; tbl_Detalles.ParamByName('ID_PRESUPUESTO').AsString := AID; tbl_Cabecera.Active := True; tbl_Detalles.Active := True; FPlantilla := DarRutaInformes + tbl_Cabecera.FieldByName('ID_EMPRESA').AsString + '\' + rptInforme; FCodigoPresupuesto := AID; if RecuperarEmpresa(tbl_Cabecera.FieldByName('ID_EMPRESA').AsInteger, tbl_Empresa) then begin ACopiaPlantilla := DarFicheroTemporal; CopiarFichero(FPlantilla, ACopiaPlantilla); FPlantilla := ACopiaPlantilla; try Generar; finally SysUtils.DeleteFile(ACopiaPlantilla); end; end; finally FConnection.RollbackTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" end; end; end.