Tecsitel_FactuGES/Informes/InformePresupuesto.pas

{
===============================================================================
  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.7
  Fecha versi<EFBFBD>n actual: 18-03-2004
===============================================================================
  Modificaciones:

    Fecha         Comentarios
    ---------------------------------------------------------------------------
    17-10-2001    A<EFBFBD>adir la persona de contacto en la portada del presupuesto.

    27-11-2001    Se ha a<EFBFBD>adido la columna 'Unid. medida'.

    12-01-2002    Se ha cambiado el orden de las p<EFBFBD>ginas:
                    1<EFBFBD> portada
                    2<EFBFBD> contenido
                    3<EFBFBD> memoria

    15-01-2002    Se han a<EFBFBD>adido 'cap<61>tulos opcionales'.

    07-04-2002    Se ha adaptado para la transacci<EFBFBD>n <EFBFBD>nica.

    08-03-2004    p272. Adaptaci<EFBFBD>n a multiempresa.

    18-03-2004    p587. Adaptaci<EFBFBD>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<61>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<61>tulo ' + IntToStr(FContadorCap + 1) + '. ' + FieldByName('DESCRIPCION').AsString
        else begin
          NombreCapitulo := 'Cap<61>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<61>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<63>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<61>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<61>a que sobra
    Rows.Item(iContador).Cells.Delete(shiftCells);
    if FImportes then
    begin
      //Comprobamos si el presupuesto tiene bonificaci<63>n
      if VarIsNull(FDesBonificacion) then
      begin
         Cell(iContador, 1).Range.Text := 'Total: ' + FormatFloat(DISPLAY_EUROS2, TotalConceptos);
         // Borrar filas de bonificaci<63>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<63>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<63>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.