{ =============================================================================== 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.1 Fecha versión actual: 18-03-2005 =============================================================================== Modificaciones: Fecha Comentarios --------------------------------------------------------------------------- 18-03-2005 Adaptación para poder añadir la firma o no =============================================================================== } unit InformeCarta; interface uses windows, classes, AHWord97, IB, IBCustomDataSet, Ibdatabase, Mensajes, Word2000; type TInformeCarta = class(TComponent) private FWordApp : TWordApp; FDocumento : TWordDoc; FPlantilla : string; function RellenarInforme: Boolean; procedure RellenarDatosCarta; function Generar: Boolean; public FNombre : string; FDireccion : string; FPoblacion : string; FPersonaContacto : string; FFecha : string; FCarta : string; FNombreFichero : string; FNombreFicheroCarta : string; FFirma : boolean; function Exportar(Fichero : String): Boolean; function Imprimir: Boolean; constructor Create (AOwner : TComponent); override; destructor Destroy; override; end; implementation { TInformeAlbaranCliente } uses BaseDatos, TablaAlbaranesCliente, DB, Sysutils, Controls, DateFunc, Configuracion, Forms, StrFunc, RdxUtilidades, RdxEmpresaActiva, SysFunc, Literales, Constantes; constructor TInformeCarta.Create(AOwner: TComponent); begin inherited; FPlantilla := ExtractFileDir(ParamStr(0))+ '\informes\' + IntToStr(EmpresaActiva.ModeloInforme) + '\Carta.rdx'; end; destructor TInformeCarta.Destroy; begin FDocumento := NIL; inherited; end; function TInformeCarta.Generar: Boolean; begin if (VerMensajePreguntaSN(msgCarFirma) <> IDYES) then FFirma := False else FFirma := True; Screen.Cursor := crHourglass; FWordApp := TWordApp.Create (False, True); with FWordApp do begin { OnQuit := WordAppQuit; OnChangeDocument := WordDocChange; OnOpenDocument := WordDocOpen; OnPreCloseDocument := WordPreClose; OnCloseDocument := WordDocClose; } Visible := False; end; FDocumento := TWordDoc.CreateOpenDoc (FWordApp, FPlantilla); try if not RellenarInforme then begin Result := False; Exit; end; FDocumento.SaveAs(FNombreFichero); FWordApp.CloseApp(wdDoNotSaveChanges); Result := True; finally FDocumento := NIL; FWordApp := NIL; Screen.Cursor := crArrow; end; end; function TInformeCarta.RellenarInforme: Boolean; begin with FDocumento do begin RellenarDatosCarta; end; Result := True; end; procedure TInformeCarta.RellenarDatosCarta; var NombreFichero, Texto, FicheroTemporal : String; LinkToFile, SaveWithDocument, _Range : OleVariant; Imagen : InlineShape; What, Which, Count, Name : 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 do begin ReplaceBookmark('Nombre', FNombre); ReplaceBookmark('Direccion', FDireccion); ReplaceBookmark('Poblacion', FPoblacion); if not EsCadenaVacia(FPersonaContacto) then ReplaceBookmark('PersonaContacto', 'A la atención de ' + FPersonaContacto) else ReplaceBookmark('PersonaContacto', ''); ReplaceBookmark('Dia', copy(FFecha,0,2)); ReplaceBookmark('Mes', DarMes(StrToInt(copy(FFecha,4,2)))); ReplaceBookmark('Ano', copy(FFecha,7,4)); FWordApp.InsertFile(FNombreFicheroCarta, 'Carta'); 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); //Incluimos firma en carta if FFirma then begin FWordApp.Application.ActiveWindow.ActivePane.Selection.InlineShapes.AddPicture(ExtractFileDir(ParamStr(0))+ '\informes\' + IntToStr(EmpresaActiva.ModeloInforme) + '\f.gif', LinkToFile, SaveWithDocument, _Range); FWordApp.Application.ActiveWindow.ActivePane.Selection.ParagraphFormat.Alignment := wdAlignParagraphRight; end; end; end; function TInformeCarta.Exportar(Fichero: String): Boolean; begin if EsCadenaVacia(Fichero) then begin Result := False; raise Exception.Create(msgInfFaltaFicheroListado); end; FNombreFichero := Fichero; Result := Generar; end; function TInformeCarta.Imprimir: Boolean; begin FNombreFichero := DarFicheroTemporal; if not Generar then begin Result := False; Exit; end; Result := ImprimirDoc(FNombreFichero); DeleteFile(FNombreFichero); end; end.