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;

  TRptWordPresupuestosCliente = class(TDataModule)
    DABin2DataStreamer: TDABin2DataStreamer;
    tbl_Cabecera: TDAMemDataTable;
    tbl_Detalles: 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, Literales;

const
  rptInforme = 'Presupuesto.rdx';
  DISPLAY_EUROS2 = '#,0.00 €';

type
  TCharSet = set of Char;

procedure VerMensaje(const A : String);
begin
  ShowMessage(A);
end;

function DarRutaTemporal: String;
var
  nBufferLength : DWORD; // size, in characters, of the buffer
  lpBuffer      : PChar; // address of buffer for temp. path
begin
  nBufferLength := MAX_PATH + 1; // initialize
  GetMem( lpBuffer, nBufferLength );
  try
    if GetTempPath( nBufferLength, lpBuffer ) <> 0 then
      Result := StrPas( lpBuffer )
    else
      Result := '';
  finally
    FreeMem( lpBuffer );
  end;
end;

function DarFicheroTemporal : String;
var
  Buf: array [0..MAX_PATH] of Char;
  RutaTmp : string;
begin
  RutaTmp := DarRutaTemporal;
  if GetTempFileName(PChar(RutaTmp), 'tmp', 0, Buf) <> 0 then
    SetString(Result, Buf, StrLen(Buf))
  else
    Result := '';
end;

function DarFicheroBMPTemporal : String;
var
  Cadena : String;
begin
  Cadena := DarFicheroTemporal;
  Result := Copy(Cadena, 0, (Length(Cadena)-3)) + 'bmp';
end;

function DarFicheroExportar (var Fichero : String) : Boolean;
var
  DialogoSalvar : TSaveDialog;
begin
  Result := False;
  DialogoSalvar := TSaveDialog.Create(NIL);
  try
    with DialogoSalvar do
    begin
      DefaultExt := 'doc';
      Filter := 'Documento de Word (*.doc)|*.doc';
      FilterIndex := 0;
      Options := [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofEnableSizing];
    end;
    Result := DialogoSalvar.Execute;
    if Result then
      Fichero := DialogoSalvar.FileName;
  finally
    DialogoSalvar.Free;
  end;
end;


procedure EscribirEnFichero (NombreFichero, Texto : string);
var
  FicheroAux : TextFile;
begin
  SysUtils.DeleteFile(NombreFichero);
  AssignFile(FicheroAux, NombreFichero);
  Rewrite(FicheroAux);
  WriteLn(FicheroAux, Texto);
  CloseFile(FicheroAux);
end;


function EsCadenaVacia(const S: AnsiString): Boolean; overload;
begin
  Result := (Length(Trim(S)) = 0)
end;

function EsCadenaVacia(const S: Variant): Boolean; overload;
begin
  Result := True;
  if VarIsNull(S) then
    Exit;
  Result := EsCadenaVacia(VarToStr(S));
end;

function EsCadenaVacia(const S: AnsiString; const EmptyChars: TCharSet): Boolean; overload;
var
  I, SLen: Integer;
begin
  SLen := Length(S);
  I := 1;
  while I <= SLen do begin
    if not (S[I] in EmptyChars) then begin
      Result := False;
      Exit;
    end
    else Inc(I);
  end;
  Result := True;
end;


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

  FPlantilla := DarRutaInformes + rptInforme;
end;

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

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

  inherited;
end;

function TRptWordPresupuestosCliente.Exportar(Codigo, Fichero: String): Boolean;
begin
  if EsCadenaVacia(Fichero) then
  begin
    Result := False;
    raise Exception.Create(msgInfFaltaFicheroListado);
  end;

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

function TRptWordPresupuestosCliente.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 RellenarPortada then
    begin
      VerMensaje(msgInfFalloRellenarPortada);
      Exit;
    end;

    if not RellenarCabecera then
    begin
      VerMensaje(msgInfFalloRellenarCabecera);
      Exit;
    end;

    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;
  end;
end;


procedure TRptWordPresupuestosCliente.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; {------- 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í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 TRptWordPresupuestosCliente.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
  { --------------------- 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
    { ----------------------- PENDIENTE
    FDesBonificacion := FieldByName('DESBONIFICACION').AsVariant;
    FImpBonificacion := FieldByName('IMPBONIFICACION').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);

    { ----------------------------------------- pendiente
    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);
    --------------------------------------------- }

  end;
  Result := True;
end;

function TRptWordPresupuestosCliente.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ítulo ' + IntToStr(FContadorCap + 1) + '. ' + FieldByName('CONCEPTO').AsString
        else begin
          NombreCapitulo := 'Capí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í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 TRptWordPresupuestosCliente.RellenarPortada: boolean;
var
  NombreFichero,
  Texto,
  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ó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 TRptWordPresupuestosCliente.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 = 'Opcional') then
        continue; // No sumamos los capí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ía que sobra
    Rows.Item(iContador).Cells.Delete(shiftCells);
    if FImportes then
    begin
      //Comprobamos si el presupuesto tiene bonificación
      if VarIsNull(FDesBonificacion) then
      begin
         Cell(iContador, 1).Range.Text := 'Total: ' + FormatFloat(DISPLAY_EUROS2, TotalConceptos);
         // Borrar filas de bonificació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ó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ó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 TRptWordPresupuestosCliente._GenerarPresupuesto(const AID: 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;
  Generar;
end;

end.