Tecsitel_FactuGES/Informes/InformeCarta.pas

{
===============================================================================
  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.