Tecsitel_FactuGES2/Source/Modulos/Presupuestos de cliente/Reports/uRptWordPresupuestoCliente.pas

unit uRptWordPresupuestoCliente;

interface

uses
  SysUtils, Classes, AHWord97, IB, IBCustomDataSet, IBDatabase,
  Word2000,
  uDAInterfaces, uDADataStreamer, uDABin2DataStreamer, uDAClasses,
  uDAScriptingProvider, uDADataTable, uDAMemDataTable;

type
  TCapitulo = record
    Tipo : string;
    Nombre : string;
    Total : double;
  end;

  TRptWordPresupuestoCliente = class(TDataModule)
    DABin2DataStreamer: TDABin2DataStreamer;
    tbl_Cabecera: TDAMemDataTable;
    tbl_Detalles: TDAMemDataTable;
    tbl_Empresa: TDAMemDataTable;
    schReport: TDASchema;
    DataDictionary: TDADataDictionary;
    procedure DataModuleCreate(Sender: TObject);
  private
    FConnection: IDAConnection;
    FImportes : Boolean;
    FDesBonificacion : Variant;
    FImpBonificacion : Double;
    FPlantilla : string;
    FWordApp : TWordApp;
    FDocumento : TWordDoc;
    FNumCapitulos : Integer;
    FNumCapOpc : Integer;
    FContadorCap : Integer;
    FCodigoPresupuesto : string;
    FNombreFichero : String;
    ListaCapitulos : array[1..1000] of TCapitulo;
    procedure InsertarConceptos(Tabla : Table);
    function Generar : Boolean;
    function RellenarPortada : boolean; virtual;
    function RellenarCabecera : boolean; virtual;
    function RellenarInforme : boolean; virtual;
    function RellenarResumen : boolean; virtual;
    procedure _GenerarPresupuesto(const AID : String);
  public
    constructor Create (AOwner : TComponent); override;
    destructor Destroy; override;
    function Exportar(Codigo, Fichero : String): Boolean;
  end;


implementation

{$R *.dfm}

uses
  Windows, Variants, Dialogs, uDataModuleServer, uStringsUtils, uSistemaFunc,
  srvEmpresas_Impl, uROTypes, uROClasses;

const
  rptInforme = 'Presupuesto.rdx';


constructor TRptWordPresupuestoCliente.Create(AOwner: TComponent);
begin
  inherited;
  FDocumento := NIL;
  FImportes := True;
  FNumCapitulos := 0;

  FPlantilla := DarRutaInformes + rptInforme;
end;

procedure TRptWordPresupuestoCliente.DataModuleCreate(Sender: TObject);
begin
  schReport.ConnectionManager := dmServer.ConnectionManager;
  FConnection := dmServer.DarNuevaConexion;
end;

destructor TRptWordPresupuestoCliente.Destroy;
begin
  if FDocumento <> NIL then
    FDocumento.Free;
  FDocumento := NIL;

  inherited;
end;

function TRptWordPresupuestoCliente.Exportar(Codigo, Fichero: String): Boolean;
begin
  if EsCadenaVacia(Fichero) then
    RaiseError('Falta indicar el fichero donde se exportar<61> el listado.');

  FNombreFichero := Fichero;
  FCodigoPresupuesto := Codigo;
  _GenerarPresupuesto(Codigo);
  Result := True;
end;

function TRptWordPresupuestoCliente.Generar : Boolean;
begin
  FWordApp := TWordApp.Create (False, False);
  with FWordApp do
  begin
    Visible := False;
    ScreenUpdating := False;
  end;

  FDocumento := TWordDoc.CreateNewDoc(FWordApp, FPlantilla);
  FWordApp.ScreenUpdating := False;
  try
    if not RellenarPortada then
      RaiseError('Se producido un error al generar la portada del informe en MS Word.');

    if not RellenarCabecera then
      RaiseError('Se producido un error al generar la cabecera del informe en MS Word.');

    if not RellenarInforme then
      RaiseError('Se producido un error al generar el informe en MS Word.');

    if (FNumCapitulos <> 0) and (FNumCapOpc < FNumCapitulos) then
    begin
      if not RellenarResumen then
        RaiseError('Se producido un error al generar el resumen en MS Word.');
    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;
  end;
end;


procedure TRptWordPresupuestoCliente.InsertarConceptos(Tabla : Table);
var
  numRows, numCols, mergeSplit, shiftCells : OleVariant;
  iContador : Integer;
  TotalConceptos : Double;
begin
  TotalConceptos := 0;
  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, tbl_Detalles do
  begin
    while not EOF do
    begin
      if FieldByName('TIPO_DETALLE').AsString <> 'Concepto' 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('CONCEPTO').AsString;
      Cell(iContador, 2).Range.Text := FieldByName('CANTIDAD').AsString; {------- PENDIENTE  + ' ' +
                                       FieldByName('UNIDADESMEDIDA').AsString; ------}
      if FImportes then
        Cell(iContador, 3).Range.Text := FormatFloat(DISPLAY_EUROS2, FieldByName('IMPORTE_UNIDAD').AsFloat)
      else
        Cell(iContador, 3).Range.Text := '';

      if FImportes then
        Cell(iContador, 4).Range.Text := FormatFloat(DISPLAY_EUROS2, FieldByName('IMPORTE_TOTAL').AsFloat)
      else
        Cell(iContador, 4).Range.Text := '';

      TotalConceptos := TotalConceptos + FieldByName('IMPORTE_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 TRptWordPresupuestoCliente.RellenarCabecera: boolean;
var
  NombreFichero,
  Texto : String;
{  FicheroTemporal : String;
  LinkToFile, SaveWithDocument, _Range : OleVariant;
  Imagen : InlineShape;
  ovRange : OleVariant;
  Which, Name : OleVariant;}
  What, Count : OleVariant;
  ovBookMarkName : OleVariant;
  TempRange : Word2000.Range;
begin

  //PARA DIBUJAR EL LOGOTIPO MULTIEMPRESA
  { --------------------- PENDIENTE
  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, tbl_Cabecera do
  begin
    if FieldByName('DESCUENTO').AsFloat > 0 then
       FDesBonificacion := 'Bonificaci<63>n ' + FormatFloat(DISPLAY_PORCENTAJE, FieldByName('DESCUENTO').AsFloat)
    else
       FDesBonificacion := Null;
    FImpBonificacion := FieldByName('IMPORTE_DESCUENTO').AsFloat;

    ReplaceBookmark('CodigoPresupuestoCab', FieldByName('REFERENCIA').AsString);
    ReplaceBookmark('FechaPresupuestoCab', FieldByName('FECHA_PRESUPUESTO').AsString);
    ReplaceBookmark('NombreClienteCab', FieldByName('NOMBRE').AsString);
    ReplaceBookmark('DireccionClienteCab', FieldByName('CALLE').AsString);
    ReplaceBookmark('PoblacionClienteCab',
       FieldByName('CODIGO_POSTAL').AsString + ' ' +
       FieldByName('POBLACION').AsString + ' ' + FieldByName('PROVINCIA').AsString);
    ReplaceBookmark('ContactoClienteCab', FieldByName('PERSONA_CONTACTO').AsString);
    ReplaceBookmark('NombreClienteFirma', FieldByName('NOMBRE').AsString);

    if not EsCadenaVacia(FieldByName('MEMORIA').AsString) then
    begin
      Texto := FieldByName('MEMORIA').AsString;
      NombreFichero := DarFicheroTemporal;
      EscribirEnFichero(NombreFichero, Texto);
      FWordApp.InsertFile(NombreFichero, 'TextoPresupuesto');
      SysUtils.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('OBSERVACIONES').AsString;
    NombreFichero := DarFicheroTemporal;
    EscribirEnFichero(NombreFichero, Texto);
    FWordApp.InsertFile(NombreFichero, 'Notas');
    SysUtils.DeleteFile(NombreFichero);

    ReplaceBookmark('NombreEmpresaPortada', tbl_Empresa.FieldByName('NOMBRE').AsString);
    ReplaceBookmark('DireccionEmpresaPortada',
      Format('%s. %s %s', [tbl_Empresa.FieldByName('CALLE').AsString,
      tbl_Empresa.FieldByName('CODIGO_POSTAL').AsString, tbl_Empresa.FieldByName('POBLACION').AsString]));
    ReplaceBookmark('TelefonoEmpresaPortada', tbl_Empresa.FieldByName('TELEFONO_1').AsString);
    ReplaceBookmark('FaxEmpresaPortada', tbl_Empresa.FieldByName('FAX').AsString);
    ReplaceBookmark('CorreoEmpresaPortada', tbl_Empresa.FieldByName('EMAIL_1').AsString);

    ReplaceBookmark('NombreEmpresa', tbl_Empresa.FieldByName('NOMBRE').AsString);
    ReplaceBookmark('CifEmpresa', tbl_Empresa.FieldByName('NIF_CIF').AsString);
    ReplaceBookmark('DireccionEmpresa',
      Format('%s. %s %s', [tbl_Empresa.FieldByName('CALLE').AsString,
      tbl_Empresa.FieldByName('CODIGO_POSTAL').AsString, tbl_Empresa.FieldByName('POBLACION').AsString]));
    ReplaceBookmark('TelefonoEmpresa', tbl_Empresa.FieldByName('TELEFONO_1').AsString);
    ReplaceBookmark('FaxEmpresa', tbl_Empresa.FieldByName('FAX').AsString);
    ReplaceBookmark('CorreoEmpresa', tbl_Empresa.FieldByName('EMAIL_1').AsString);

    ReplaceBookmark('NombreEmpresaFirma', tbl_Empresa.FieldByName('NOMBRE').AsString);

  end;
  Result := True;
end;

function TRptWordPresupuestoCliente.RellenarInforme: boolean;
var
  NombreCapitulo : String;
  Estilo : OleVariant;
begin
  FContadorCap := 0;
  FNumCapOpc := 0;
  with FDocumento, tbl_Detalles do
  begin
    First;

    FieldByName('IMPORTE_UNIDAD').DisplayFormat := DISPLAY_EUROS2;
    FieldByName('IMPORTE_TOTAL').DisplayFormat := DISPLAY_EUROS2;
    
    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_DETALLE').AsString = 'Subtotal') then
      begin
        Next;
        Continue;
      end;

      if (FieldByName('TIPO_DETALLE').AsString = 'Titulo') or
         (FieldByName('TIPO_DETALLE').AsString = 'Opcional') then
      begin
        NombreCapitulo := '';
        Estilo := 'TituloCapitulo';
        FWordApp.Application.Selection.Set_Style(Estilo);
        if (FieldByName('TIPO_DETALLE').AsString = 'Titulo') then
          NombreCapitulo := 'Cap<61>tulo ' + IntToStr(FContadorCap + 1) + '. ' + FieldByName('CONCEPTO').AsString
        else begin
          NombreCapitulo := 'Cap<61>tulo opcional. ' + FieldByName('CONCEPTO').AsString;
          Inc(FNumCapOpc);
        end;
        FWordApp.InsertText(NombreCapitulo);
        FWordApp.InsertText(#13);

        Inc(FContadorCap);
        ListaCapitulos[FContadorCap].Tipo := FieldByName('TIPO_DETALLE').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;
    FNumCapitulos := FContadorCap;
  end;
  Result := True;
end;

function TRptWordPresupuestoCliente.RellenarPortada: boolean;
var
  NombreFichero,
  Texto : String;
  {FicheroTemporal : string;
  LinkToFile, SaveWithDocument, _Range : OleVariant;
  Imagen : InlineShape;}
begin

  //PARA DIBUJAR EL LOGOTIPO MULTIEMPRESA
  {---------------------------  PENDIENTE
  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, tbl_Cabecera do
  begin
    ReplaceBookmark('CodigoPresupuestoPortada', FieldByName('REFERENCIA').AsString);
    ReplaceBookmark('FechaPresupuestoPortada', FieldByName('FECHA_PRESUPUESTO').AsString);
    ReplaceBookmark('NombreClientePortada', FieldByName('NOMBRE').AsString);
    if not EsCadenaVacia(FieldByName('PERSONA_CONTACTO').AsString) then
      ReplaceBookmark('PersonaContactoClientePortada', 'A la atenci<63>n de: ' + FieldByName('PERSONA_CONTACTO').AsString);

    Texto := FieldByName('PORTADA').AsString;
    NombreFichero := DarFicheroTemporal;
    EscribirEnFichero(NombreFichero, Texto);
    FWordApp.InsertFile(NombreFichero, 'TextoPortada');
    SysUtils.DeleteFile(NombreFichero);
  end;
  Result := True;
end;

function TRptWordPresupuestoCliente.RellenarResumen : boolean;
var
  numRows, numCols, mergeSplit, shiftCells : OleVariant;
  iAux : Integer;
  iContador : Integer;
  TotalConceptos : Double;
  Tabla : Table;
  Estilo : OleVariant;
begin
  TotalConceptos := 0;
  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 = 'Opcional') 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;

procedure TRptWordPresupuestoCliente._GenerarPresupuesto(const AID: String);
var
  ACopiaPlantilla: string;
begin
  tbl_Cabecera.ParamByName('ID').AsString := AID;
  tbl_Detalles.ParamByName('ID_PRESUPUESTO').AsString := AID;

  tbl_Cabecera.Active := True;
  tbl_Detalles.Active := True;

  FCodigoPresupuesto := AID;

  if RecuperarEmpresa(tbl_Cabecera.FieldByName('ID_EMPRESA').AsInteger, tbl_Empresa) then
  begin
    ACopiaPlantilla := DarFicheroTemporal;
    CopiarFichero(FPlantilla, ACopiaPlantilla);
    FPlantilla := ACopiaPlantilla;
    try
      Generar;
    finally
      SysUtils.DeleteFile(ACopiaPlantilla);
    end;
  end;
end;

end.