Tecsitel_FactuGES2/Source/Modulos/Facturas de cliente/Reports/uRptWordFacturaCliente.pas

unit uRptWordFacturaCliente;

interface

uses
  SysUtils, Classes, AHWord97, IB, IBCustomDataSet, IBDatabase,
  Word2000,
  uDAInterfaces, uDADataStreamer, uDABin2DataStreamer, uDAClasses,
  uDAScriptingProvider, uDADataTable, uDAMemDataTable;
  
type
  TRptWordFacturaCliente = class(TDataModule)
    DABin2DataStreamer: TDABin2DataStreamer;
    tbl_Cabecera: TDAMemDataTable;
    tbl_Detalles: TDAMemDataTable;
    tbl_Empresa: TDAMemDataTable;
    schReport: TDASchema;
    DataDictionary: TDADataDictionary;
    procedure DataModuleCreate(Sender: TObject);
  private
    FConnection: IDAConnection;  
    FPlantilla : string;
    FWordApp : TWordApp;
    FDocumento : TWordDoc;
    FNumCapitulos : Integer;
    FCodigoFactura : string;
    FNombreFichero : String;
    function DarNumCapitulos : Integer;
    procedure InsertarConceptos(Tabla : Table);
    function Generar : Boolean;
    function RellenarCabecera : boolean; virtual;
    function RellenarInforme : boolean; virtual;
    procedure _GenerarFactura(const AID: String);	
  public
    function Exportar(Codigo, Fichero : String): Boolean;
    constructor Create (AOwner : TComponent); override;
    destructor Destroy; override;
  end;

implementation

{ TRptWordFacturaCliente }

{$R *.dfm}

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

const
  rptInforme = 'FacturaCliente.rdx';  
  
constructor TRptWordFacturaCliente.Create(AOwner: TComponent);
begin
  inherited;
  FDocumento := NIL;
  FPlantilla := DarRutaInformes + rptInforme;
end;

function TRptWordFacturaCliente.DarNumCapitulos: Integer;
var
  AuxNumCapitulos : integer;
begin
  AuxNumCapitulos := 0;
  tbl_Cabecera.First;
  while not tbl_Cabecera.Eof do
  begin
    if tbl_Cabecera.FieldByName('TIPO_DETALLE').AsString = 'Titulo' then
      AuxNumCapitulos := AuxNumCapitulos + 1;
    tbl_Cabecera.Next;
  end;
  tbl_Cabecera.First;
  Result := AuxNumCapitulos;
end;

destructor TRptWordFacturaCliente.Destroy;
begin
  if FDocumento <> NIL then
    FDocumento.Free;
  FDocumento := NIL;
  inherited;
end;

function TRptWordFacturaCliente.Exportar(Codigo, Fichero: String): Boolean;
begin
  if EsCadenaVacia(Fichero) then
  begin
    Result := False;
    raise Exception.Create('Falta indicar el fichero donde se exportar<61> el listado.');
  end;

  FNombreFichero := Fichero;
  FCodigoFactura := Codigo;
  _GenerarFactura(Codigo);
  Result := True;
end;

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

function TRptWordFacturaCliente.Generar : Boolean;
var
  Aux : OleVariant;
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 RellenarCabecera then
      RaiseError('Se producido un error al generar la cabecera en MS Word.');

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

    FDocumento.SaveAs(FNombreFichero);
    FWordApp.CloseApp(wdDoNotSaveChanges);
    Result := True;
  finally
    FDocumento := NIL;
    FWordApp := NIL;
  end;
end;

procedure TRptWordFacturaCliente.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, 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;
      Cell(iContador, 3).Range.Text := FormatFloat(DISPLAY_EUROS2, FieldByName('IMPORTE_UNIDAD').AsFloat);
      Cell(iContador, 4).Range.Text := FormatFloat(DISPLAY_EUROS2, FieldByName('IMPORTE_TOTAL').AsFloat);
      TotalConceptos := TotalConceptos + FieldByName('IMPORTE_TOTAL').AsFloat;
      Next;
      Inc (iContador);
    end;
    // Borrar la fila vac<61>a que sobra
    Rows.Item(iContador).Cells.Delete(shiftCells);
    Cell(iContador, 1).Range.Text := 'Total: ' + FormatFloat(DISPLAY_EUROS2, TotalConceptos);
    AutoFitBehavior(wdAutoFitWindow);
  end;
end;

function TRptWordFacturaCliente.RellenarCabecera: boolean;
var
  NombreFichero,
  Texto,
  FicheroTemporal : String;
  LinkToFile, SaveWithDocument, _Range : OleVariant;
  Imagen : InlineShape;
  _ShiftCells : OleVariant;
  ImporteAux : Double;
begin

  //PARA DIBUJAR EL LOGOTIPO MULTIEMPRESA
  {---------------------------  PENDIENTE
  if (EmpresaActiva.Logotipo <> Nil) then
  begin
    //Activamos cabecera
    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
    //Activamos cabecera
    FWordApp.Application.ActiveWindow.ActivePane.View.SeekView := wdSeekCurrentPageHeader;

    ReplaceBookmark('CodigoFacturaCab', FieldByName('REFERENCIA').AsString);
    ReplaceBookmark('FechaFacturaCab', FieldByName('FECHA_FACTURA').AsString);
    ReplaceBookmark('VencimientoCab', ''{FieldByName('FECHAVENCIMIENTO').AsString});
    ReplaceBookmark('FormaPagoCab', FieldByName('FORMA_PAGO').AsString);
    ReplaceBookmark('BancoCab', ''{FieldByName('BANCO').AsString});

    ReplaceBookmark('NombreClienteCab', FieldByName('NOMBRE').AsString);
    ReplaceBookmark('CIFClienteCab', FieldByName('NIF_CIF').AsString);

    ReplaceBookmark('DireccionClienteCab', FieldByName('CALLE').AsString);
    ReplaceBookmark('PoblacionClienteCab',
       FieldByName('CODIGO_POSTAL').AsString + ' ' +
       FieldByName('POBLACION').AsString + ' ' + FieldByName('PROVINCIA').AsString);

    ReplaceBookmark('BaseImponible', FormatFloat(DISPLAY_EUROS2, FieldByName('BASE_IMPONIBLE').AsFloat));
    ImporteAux := FieldByName('BASE_IMPONIBLE').AsFloat - FieldByName('IMPORTE_DESCUENTO').AsFloat;
    ReplaceBookmark('BaseImponible2', FormatFloat(DISPLAY_EUROS2, ImporteAux));

    if (FieldByName('DESCUENTO').AsInteger = 0) then
    begin
      ReplaceBookmark('BaseImponibleTexto', 'Base imponible');
      FWordApp.GotoBookmark('CeldasDescuento');
      _ShiftCells := wdDeleteCellsShiftLeft;
      FWordApp.Application.Selection.Cells.Delete(_ShiftCells);
    end
    else begin
      ReplaceBookmark('Descuento', FieldByName('DESCUENTO').AsString);
      ReplaceBookmark('ImporteDto', FormatFloat(DISPLAY_EUROS2, FieldByName('IMPORTE_DESCUENTO').AsFloat));
    end;
    if EsCadenaVacia(FieldByName('IVA').AsString) then
      ReplaceBookmark('IVA', '0')
    else
      ReplaceBookmark('IVA', FieldByName('IVA').AsString);
    ReplaceBookmark('ImporteIVA', FormatFloat(DISPLAY_EUROS2, FieldByName('IMPORTE_IVA').AsFloat));
    ReplaceBookmark('ImporteTotal', FormatFloat(DISPLAY_EUROS2, FieldByName('IMPORTE_TOTAL').AsFloat));

    Texto := FieldByName('OBSERVACIONES').AsString;
    if not EsCadenaVacia(Texto) then
    begin
      NombreFichero := DarFicheroTemporal;
      EscribirEnFichero(NombreFichero, Texto);
      FWordApp.InsertFile(NombreFichero, 'Descripcion');
      SysUtils.DeleteFile(NombreFichero);
    end;

    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('DatosRegistroMercantil', tbl_Empresa.FieldByName('REGISTRO_MERCANTIL').AsString);
    Close;
  end;
  Result := True;
end;

function TRptWordFacturaCliente.RellenarInforme : boolean;
var
  numRows, numCols, mergesplit : OleVariant;
  iRowCount : Integer;
  TipoConAnterior : String;
  Seleccion : TWordRange;
  TotalCapitulo : Double;
  EsCapitulo : Boolean;
begin
  Result := False;
  iRowCount := 2;
  numrows := 2;
  numcols := 1;
  mergeSplit := False;
  TipoConAnterior := '';
  TotalCapitulo := 0;
  EsCapitulo := False;

  with FDocumento.Document.Tables.Item(1), tbl_detalles do
  begin
    First;
    while not tbl_detalles.EOF do
    begin
        if (TipoConAnterior = 'Concepto') and (FieldByName('TIPO_DETALLE').AsString = 'Titulo') then
        begin
          Rows.Item (iRowCount).Cells.Split (numRows, numCols, mergesplit);
          if EsCapitulo then
          begin
            Rows.Item (iRowCount).Cells.Split (numRows, numCols, mergesplit);
            Cell(iRowCount, 2).Range.Text := 'TOTAL DEL CAP<41>TULO';
            Cell(iRowCount, 5).Range.Text := FormatFloat(DISPLAY_EUROS2, TotalCapitulo);
            TotalCapitulo := 0;
            Inc (iRowCount);
          end;
          Inc (iRowCount);
        end;
        Rows.Item (iRowCount).Cells.Split (numRows, numCols, mergesplit);
        if FieldByName('TIPO_DETALLE').AsString = 'Titulo' then
        begin
          Cell(iRowCount, 2).Range.Text := FieldByName('CONCEPTO').AsString;
          Rows.Item(iRowCount).Select;
          Seleccion := FDocumento.AddRangeFromSelection;
          Seleccion.Bold := True;
          TotalCapitulo := 0;
          EsCapitulo := True;
        end
        else begin
          Cell(iRowCount, 1).Range.Text := FieldByName('REFERENCIA').AsString;
          Cell(iRowCount, 2).Range.Text := FieldByName('CONCEPTO').AsString;
          Cell(iRowCount, 3).Range.Text := FieldByName('CANTIDAD').AsString; { + ' ' +
                                           FieldByName('UNIDADESMEDIDA').AsString;}
          Cell(iRowCount, 4).Range.Text := FormatFloat(DISPLAY_EUROS2, FieldByName('IMPORTE_UNIDAD').AsFloat);
          Cell(iRowCount, 5).Range.Text := FormatFloat(DISPLAY_EUROS2, FieldByName('IMPORTE_TOTAL').AsFloat);
          TotalCapitulo := TotalCapitulo + FieldByName('IMPORTE_TOTAL').AsFloat;
        end;
        TipoConAnterior := FieldByName('TIPO_DETALLE').AsString;
        Next;
        Inc (iRowCount);
    end;
    if EsCapitulo then
    begin
      Rows.Item (iRowCount).Cells.Split (numRows, numCols, mergesplit);
      Cell(iRowCount, 2).Range.Text := 'TOTAL DEL CAP<41>TULO';
      Cell(iRowCount, 5).Range.Text := FormatFloat(DISPLAY_EUROS2, TotalCapitulo);
      TotalCapitulo := 0;
    end;
    Close;
  end;
  Result := True;
end;

procedure TRptWordFacturaCliente._GenerarFactura(const AID: String);
var
  ACopiaPlantilla : String;
begin
  tbl_Cabecera.ParamByName('ID').AsString := AID;
  tbl_Detalles.ParamByName('ID_FACTURA').AsString := AID;

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

  FCodigoFactura := 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.