This repository has been archived on 2024-11-29. You can view files and clone it, but cannot push or open issues or pull requests.
Tecsitel_FactuGES/Informes/InformeCarta.pas

220 lines
6.6 KiB
ObjectPascal
Raw Normal View History

{
===============================================================================
Copyright (<EFBFBD>) 2001. Rodax Software.
===============================================================================
Los contenidos de este fichero son propiedad de Rodax Software titular del
copyright. Este fichero s<EFBFBD>lo podr<EFBFBD> ser copiado, distribuido y utilizado,
en su totalidad o en parte, con el permiso escrito de Rodax Software, o de
acuerdo con los t<EFBFBD>rminos y condiciones establecidas en el acuerdo/contrato
bajo el que se suministra.
-----------------------------------------------------------------------------
Web: www.rodax-software.com
===============================================================================
Fecha primera versi<EFBFBD>n: 01-10-2001
Versi<EFBFBD>n actual: 1.0.1
Fecha versi<EFBFBD>n actual: 18-03-2005
===============================================================================
Modificaciones:
Fecha Comentarios
---------------------------------------------------------------------------
18-03-2005 Adaptaci<EFBFBD>n para poder a<EFBFBD>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<63>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.