{ =============================================================================== Copyright (©) 2001. Rodax Software. =============================================================================== Los contenidos de este fichero son propiedad de Rodax Software titular del copyright. Este fichero sólo podrá ser copiado, distribuido y utilizado, en su totalidad o en parte, con el permiso escrito de Rodax Software, o de acuerdo con los términos y condiciones establecidas en el acuerdo/contrato bajo el que se suministra. ----------------------------------------------------------------------------- Web: www.rodax-software.com =============================================================================== Fecha primera versión: 01-10-2001 Versión actual: 1.0.7 Fecha versión actual: 18-03-2004 =============================================================================== Modificaciones: Fecha Comentarios --------------------------------------------------------------------------- 17-10-2001 Añadir la persona de contacto en la portada del presupuesto. 27-11-2001 Se ha añadido la columna 'Unid. medida'. 12-01-2002 Se ha cambiado el orden de las páginas: 1º portada 2º contenido 3º memoria 15-01-2002 Se han añadido 'capítulos opcionales'. 07-04-2002 Se ha adaptado para la transacción única. 08-03-2004 p272. Adaptación a multiempresa. 18-03-2004 p587. Adaptación a Bonificaciones =============================================================================== } unit InformePresupuesto; interface uses classes, AHWord97, IB, IBCustomDataSet, Ibdatabase, Mensajes, Word2000; type TCapitulo = record Tipo : string; Nombre : string; Total : double; end; TInformePresupuesto = class(TComponent) private FImportes : Boolean; FDesBonificacion : Variant; FImpBonificacion : Double; sqlCabeceraPresupuesto : TStrings; sqlDetallesPresupuesto : TStrings; FPlantilla : string; FWordApp : TWordApp; FDocumento : TWordDoc; FTransaccion : TIBTransaction; FBaseDatos : TIBDatabase; FNumCapitulos : Integer; FNumCapOpc : Integer; FContadorCap : Integer; FCodigoPresupuesto : string; FTabla : TIBDataSet; FNombreFichero : String; SentenciaSQL : TStrings; ListaCapitulos : array[1..1000] of TCapitulo; procedure InsertarConceptos(Tabla : Table); function Generar (Codigo : string) : Boolean; procedure InicializarSQLInforme; virtual; procedure InicializarParametrosSQL; virtual; function InicializarTabla : boolean; function RellenarPortada : boolean; virtual; function RellenarCabecera : boolean; virtual; function RellenarInforme : boolean; virtual; function RellenarResumen : boolean; virtual; public constructor Create (AOwner : TComponent); override; destructor Destroy; override; function Exportar(Codigo, Fichero : String): Boolean; function Imprimir(Codigo : String): Boolean; end; implementation { TInformePresupuesto } uses Windows, BaseDatos, TablaPresupuestos, DB, Sysutils, Controls, Constantes, Configuracion, Forms, StrFunc, RdxUtilidades, RdxEmpresaActiva, Literales, SysFunc; { TInformePresupuesto } constructor TInformePresupuesto.Create(AOwner: TComponent); begin inherited; FDocumento := NIL; FImportes := True; SentenciaSQL := TStringList.Create; FNumCapitulos := 0; sqlCabeceraPresupuesto := TStringList.Create; sqlDetallesPresupuesto := TStringList.Create; FBaseDatos := dmBaseDatos.BD; FTransaccion := dmBaseDatos.Transaccion; FPlantilla := ExtractFileDir(ParamStr(0))+ '\informes\' + IntToStr(EmpresaActiva.ModeloInforme) + '\Presupuesto.rdx'; end; destructor TInformePresupuesto.Destroy; begin FTabla.Close; FTabla.Free; FTabla := NIL; if FDocumento <> NIL then FDocumento.Free; FDocumento := NIL; FTransaccion := NIL; FBaseDatos := NIL; sqlCabeceraPresupuesto.Free; sqlDetallesPresupuesto.Free; inherited; end; function TInformePresupuesto.Exportar(Codigo, Fichero: String): Boolean; begin if EsCadenaVacia(Fichero) then begin Result := False; raise Exception.Create(msgInfFaltaFicheroListado); end; FNombreFichero := Fichero; Result := Generar(Codigo); end; function TInformePresupuesto.Generar (Codigo : string) : Boolean; var Aux : OleVariant; begin if EsCadenaVacia(Codigo) then raise Exception.Create(msgInfFaltaCodPre); {if (VerMensajePreguntaSN(msgInfDeseaImportes) <> IDYES) then FImportes := False;} FCodigoPresupuesto := Codigo; Screen.Cursor := crHourglass; FWordApp := TWordApp.Create (False, False); with FWordApp do begin Visible := False; ScreenUpdating := False; end; FDocumento := TWordDoc.CreateNewDoc(FWordApp, FPlantilla); FWordApp.ScreenUpdating := False; try InicializarSQLInforme; SentenciaSQL := sqlCabeceraPresupuesto; InicializarTabla; InicializarParametrosSQL; if not RellenarPortada then begin VerMensaje(msgInfFalloRellenarPortada); Exit; end; if not RellenarCabecera then begin VerMensaje(msgInfFalloRellenarCabecera); Exit; end; SentenciaSQL := sqlDetallesPresupuesto; InicializarTabla; InicializarParametrosSQL; if not RellenarInforme then begin VerMensaje(msgInfFalloRellenarInforme); Exit; end; if (FNumCapitulos <> 0) and (FNumCapOpc < FNumCapitulos) then begin if not RellenarResumen then begin VerMensaje(msgInfFalloRellenarResumen); Exit; end; end else begin FDocumento.Document.Tables.Item(FDocumento.Document.Tables.Count-1).Delete; end; FDocumento.SaveAs(FNombreFichero); FWordApp.CloseApp(wdDoNotSaveChanges); Result := True; finally FDocumento := NIL; FWordApp := NIL; Screen.Cursor := crArrow; end; end; function TInformePresupuesto.Imprimir(Codigo: String): Boolean; begin FNombreFichero := DarFicheroTemporal; if not Generar(Codigo) then begin Result := False; Exit; end; Result := ImprimirDoc(FNombreFichero); DeleteFile(FNombreFichero); end; procedure TInformePresupuesto.InicializarParametrosSQL; begin with FTabla do begin ParamByName('CODIGOPRESUPUESTO').AsString := FCodigoPresupuesto; ParamByName('CODIGOEMPRESA').AsInteger := EmpresaActiva.Codigo; end; end; procedure TInformePresupuesto.InicializarSQLInforme; begin with sqlCabeceraPresupuesto do begin Add('select * from PRESUPUESTOSCLIENTE '); Add('where (CODIGO = :CODIGOPRESUPUESTO)'); Add('and (CODIGOEMPRESA = :CODIGOEMPRESA)'); end; with sqlDetallesPresupuesto do begin Add('select * '); Add('from DETALLESPRESUPUESTOSCLIENTE '); Add('where (CODIGOPRESUPUESTO = :CODIGOPRESUPUESTO) '); Add('and (CODIGOEMPRESA = :CODIGOEMPRESA)'); Add('order by NUMCONCEPTO'); end; end; function TInformePresupuesto.InicializarTabla: boolean; begin Result := True; FTabla := TIBDataSet.Create(Self); try FTabla.Database := FBaseDatos; FTabla.Transaction := FTransaccion; FTabla.SelectSQL.Assign(SentenciaSQL); except on E : EIBError do begin VerMensaje(E.Message); Result := False; end; end; end; procedure TInformePresupuesto.InsertarConceptos(Tabla : Table); var numRows, numCols, mergeSplit, shiftCells : OleVariant; iContador : Integer; TotalConceptos : Double; begin 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, FTabla do begin while not EOF do begin if FieldByName('TIPO').AsString <> 'CON' 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('DESCRIPCION').AsString; Cell(iContador, 2).Range.Text := FieldByName('CANTIDAD').AsString + ' ' + FieldByName('UNIDADESMEDIDA').AsString; if FImportes then Cell(iContador, 3).Range.Text := FieldByName('PRECIO').DisplayText else Cell(iContador, 3).Range.Text := ''; if FImportes then Cell(iContador, 4).Range.Text := FieldByName('TOTAL').DisplayText else Cell(iContador, 4).Range.Text := ''; TotalConceptos := TotalConceptos + FieldByName('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 TInformePresupuesto.RellenarCabecera: boolean; var NombreFichero, Texto, FicheroTemporal : String; LinkToFile, SaveWithDocument, _Range : OleVariant; Imagen : InlineShape; What, Which, Count, Name : OleVariant; ovBookMarkName : OleVariant; TempRange : Word2000.Range; ovRange : OleVariant; begin //PARA DIBUJAR EL LOGOTIPO MULTIEMPRESA 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, FTabla do begin Prepare; Open; FDesBonificacion := FieldByName('DESBONIFICACION').AsVariant; FImpBonificacion := FieldByName('IMPBONIFICACION').AsFloat; ReplaceBookmark('CodigoPresupuestoCab', FCodigoPresupuesto); ReplaceBookmark('FechaPresupuestoCab', FieldByName('FECHAALTA').AsString); ReplaceBookmark('NombreClienteCab', FieldByName('NOMBRE').AsString); ReplaceBookmark('DireccionClienteCab', FieldByName('CALLE').AsString + ', ' + FieldByName('NUMERO').AsString + ' ' + FieldByName('PISO').AsString); ReplaceBookmark('PoblacionClienteCab', FieldByName('CODIGOPOSTAL').AsString + ' ' + FieldByName('POBLACION').AsString + ' ' + FieldByName('PROVINCIA').AsString); ReplaceBookmark('ContactoClienteCab', FieldByName('PERSONACONTACTO').AsString); ReplaceBookmark('NombreClienteFirma', FieldByName('NOMBRE').AsString); if not EsCadenaVacia(FieldByName('DESCRIPCION').AsString) then begin Texto := FieldByName('DESCRIPCION').AsString; NombreFichero := DarFicheroTemporal; EscribirEnFichero(NombreFichero, Texto); FWordApp.InsertFile(NombreFichero, 'TextoPresupuesto'); 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('NOTAS').AsString; NombreFichero := DarFicheroTemporal; EscribirEnFichero(NombreFichero, Texto); FWordApp.InsertFile(NombreFichero, 'Notas'); DeleteFile(NombreFichero); ReplaceBookmark('NombreEmpresaPortada', EmpresaActiva.Nombre); ReplaceBookmark('DireccionEmpresaPortada', Format('%s, %s. %s %s', [EmpresaActiva.Calle, EmpresaActiva.Numero, EmpresaActiva.CodigoPostal, EmpresaActiva.Poblacion])); ReplaceBookmark('TelefonoEmpresaPortada', EmpresaActiva.Telefono); ReplaceBookmark('FaxEmpresaPortada', EmpresaActiva.Fax); ReplaceBookmark('CorreoEmpresaPortada', EmpresaActiva.Correo); ReplaceBookmark('NombreEmpresa', EmpresaActiva.Nombre); ReplaceBookmark('CifEmpresa', EmpresaActiva.NifCif); ReplaceBookmark('DireccionEmpresa', Format('%s, %s. %s %s', [EmpresaActiva.Calle, EmpresaActiva.Numero, EmpresaActiva.CodigoPostal, EmpresaActiva.Poblacion])); ReplaceBookmark('TelefonoEmpresa', EmpresaActiva.Telefono); ReplaceBookmark('FaxEmpresa', EmpresaActiva.Fax); ReplaceBookmark('CorreoEmpresa', EmpresaActiva.Correo); ReplaceBookmark('NombreEmpresaFirma', EmpresaActiva.Nombre); Close; end; Result := True; end; function TInformePresupuesto.RellenarInforme: boolean; var NombreCapitulo : String; Estilo : OleVariant; begin FContadorCap := 0; FNumCapOpc := 0; with FDocumento, FTabla do begin Prepare; Open; with (FieldByName('PRECIO') as TFloatField) do begin DisplayFormat := DISPLAY_EUROS2; EditFormat := EDIT_EUROS2; end; with (FieldByName('TOTAL') as TFloatField) do begin DisplayFormat := DISPLAY_EUROS2; EditFormat := EDIT_EUROS2; end; GoToSection(3); { Copiar la tabla de conceptos al portapapeles } Document.Tables.Item(2).Select; FWordApp.Application.Selection.Cut; while not Eof do begin if (FieldByName('TIPO').AsString = 'TIT') or (FieldByName('TIPO').AsString = 'OPC') then begin NombreCapitulo := ''; Estilo := 'TituloCapitulo'; FWordApp.Application.Selection.Set_Style(Estilo); if (FieldByName('TIPO').AsString = 'TIT') then NombreCapitulo := 'Capítulo ' + IntToStr(FContadorCap + 1) + '. ' + FieldByName('DESCRIPCION').AsString else begin NombreCapitulo := 'Capítulo opcional. ' + FieldByName('DESCRIPCION').AsString; Inc(FNumCapOpc); end; FWordApp.InsertText(NombreCapitulo); FWordApp.InsertText(#13); Inc(FContadorCap); ListaCapitulos[FContadorCap].Tipo := FieldByName('TIPO').AsString; ListaCapitulos[FContadorCap].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. { 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; Close; FNumCapitulos := FContadorCap; end; Result := True; end; function TInformePresupuesto.RellenarPortada: boolean; var NombreFichero, Texto, FicheroTemporal : string; LinkToFile, SaveWithDocument, _Range : OleVariant; Imagen : InlineShape; begin //PARA DIBUJAR EL LOGOTIPO MULTIEMPRESA 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, FTabla do begin Prepare; Open; ReplaceBookmark('CodigoPresupuestoPortada', FCodigoPresupuesto); ReplaceBookmark('FechaPresupuestoPortada', FieldByName('FECHAALTA').AsString); ReplaceBookmark('NombreClientePortada', FieldByName('NOMBRE').AsString); if not EsCadenaVacia(FieldByName('PERSONACONTACTO').AsString) then ReplaceBookmark('PersonaContactoClientePortada', 'A la atención de: ' + FieldByName('PERSONACONTACTO').AsString); Texto := FieldByName('PORTADA').AsString; NombreFichero := DarFicheroTemporal; EscribirEnFichero(NombreFichero, Texto); FWordApp.InsertFile(NombreFichero, 'TextoPortada'); DeleteFile(NombreFichero); Close; end; Result := True; end; function TInformePresupuesto.RellenarResumen : boolean; var numRows, numCols, mergeSplit, shiftCells : OleVariant; iAux : Integer; iContador : Integer; TotalConceptos : Double; Tabla : Table; Estilo : OleVariant; begin 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); FWordApp.InsertText('RESUMEN'); Tabla := FDocumento.Document.Tables.Item(FDocumento.Document.Tables.Count-1); with Tabla do begin for iAux := 1 to FNumCapitulos do begin if (ListaCapitulos[iAux].Tipo = 'OPC') 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; Result := True; end; end.