{ =============================================================================== 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.5 Fecha versión actual: 08-03-2004 =============================================================================== Modificaciones: Fecha Comentarios --------------------------------------------------------------------------- 27-11-2001 Se han añadido las unidades de medida. 15-01-2002 Imprimir la provincia del cliente junto con el resto de la dirección. 18-01-2002 Ya no se rellena con filas vacias cuando los detalles no cubren todas las hojas. 07-04-2002 Se ha adaptado para la transacción única. 08-03-2004 p272. Adaptación a multiempresa. =============================================================================== } unit InformeAlbaranCliente; interface uses classes, AHWord97, IB, IBCustomDataSet, Ibdatabase, Mensajes; type TInformeAlbaranCliente = class(TComponent) private sqlCabeceraAlbaran : TStrings; sqlDetallesAlbaran : TStrings; FWordApp : TWordApp; FDocumento : TWordDoc; FTablaAlbaranes : TIBDataSet; FTablaDetallesAlbaranes : TIBDataSet; FTransaccion : TIBTransaction; FBaseDatos : TIBDataBase; FPlantilla : string; FCodigoAlbaran : string; FNombreFichero : string; procedure IniciarSQLInformes; procedure BuscarAlbaran; function RellenarInforme (Codigo : String) : Boolean; procedure RellenarDatosAlbaran; procedure RellenarDatosDetalle; function Generar(Codigo: String): Boolean; public function Exportar(Codigo, Fichero : String): Boolean; function Imprimir(Codigo: String): Boolean; constructor Create (AOwner : TComponent); override; destructor Destroy; override; end; implementation { TInformeAlbaranCliente } uses BaseDatos, TablaAlbaranesCliente, DB, Sysutils, Controls, Configuracion, Forms, StrFunc, Word2000, RdxEmpresaActiva, Constantes, Literales, SysFunc; procedure TInformeAlbaranCliente.BuscarAlbaran; begin if FTransaccion = NIL then exit; try FTablaAlbaranes.Close; FTablaDetallesAlbaranes.Close; // Buscar la fila a tratar si es necesario if not EsCadenaVacia(FCodigoAlbaran) then begin FTablaAlbaranes.Params.ByName('CODIGOEMPRESA').AsInteger := EmpresaActiva.Codigo; FTablaAlbaranes.Params.ByName('CODIGO').AsString := FCodigoAlbaran; FTablaDetallesAlbaranes.Params.ByName('CODIGOEMPRESA').AsInteger := EmpresaActiva.Codigo; FTablaDetallesAlbaranes.Params.ByName('CODIGOALBARAN').AsString := FCodigoAlbaran; end; FTablaAlbaranes.Prepare; FTablaDetallesAlbaranes.Prepare; FTablaAlbaranes.Open; FTablaDetallesAlbaranes.Open; dmTablaAlbaranesCliente.InicializarTablaAlbaranes(@FTablaAlbaranes); dmTablaAlbaranesCliente.InicializarTablaDetalles(@FTablaDetallesAlbaranes); except on E : EIBError do begin VerMensaje(E.Message); end; on E : EDatabaseError do begin VerMensaje(E.Message); end; end; end; constructor TInformeAlbaranCliente.Create(AOwner: TComponent); begin inherited; FPlantilla := ExtractFileDir(ParamStr(0)) + '\informes\' + IntToStr(EmpresaActiva.ModeloInforme) + '\AlbaranCliente.rdx'; sqlCabeceraAlbaran := TStringList.Create; sqlDetallesAlbaran := TStringList.Create; IniciarSQLInformes; FBaseDatos := dmBaseDatos.BD; FTransaccion := dmBaseDatos.Transaccion; FTablaAlbaranes := TIBDataSet.Create(Self); FTablaDetallesAlbaranes := TIBDataSet.Create(Self); with FTablaAlbaranes do begin Database := FBaseDatos; Transaction := FTransaccion; SelectSQL.Assign(sqlCabeceraAlbaran); end; with FTablaDetallesAlbaranes do begin Database := FBaseDatos; Transaction := FTransaccion; SelectSQL.Assign(sqlDetallesAlbaran); end; end; destructor TInformeAlbaranCliente.Destroy; begin FTablaAlbaranes.Close; FTablaDetallesAlbaranes.Close; FTablaAlbaranes.UnPrepare; FTablaDetallesAlbaranes.Unprepare; FTablaAlbaranes.Free; FTablaDetallesAlbaranes.Free; FTablaAlbaranes := NIL; FTablaDetallesAlbaranes := NIL; FTransaccion := NIL; FBaseDatos := NIL; FDocumento := NIL; sqlCabeceraAlbaran.Free; sqlDetallesAlbaran.Free; inherited; end; function TInformeAlbaranCliente.Generar(Codigo: String): Boolean; begin if EsCadenaVacia(Codigo) then raise Exception.Create(msgInfFaltaCodAlb); FCodigoAlbaran := Codigo; 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(Codigo) 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 TInformeAlbaranCliente.RellenarInforme(Codigo: String): Boolean; begin BuscarAlbaran; with FDocumento do begin RellenarDatosAlbaran; RellenarDatosDetalle; end; Result := True; end; procedure TInformeAlbaranCliente.RellenarDatosAlbaran; var FicheroTemporal : String; LinkToFile, SaveWithDocument, _Range : OleVariant; Imagen : InlineShape; begin //PARA DIBUJAR EL LOGOTIPO MULTIEMPRESA 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, FTablaAlbaranes do begin ReplaceBookmark('CodigoAlbaranCab', FieldByName('CODIGO').AsString); ReplaceBookmark('FechaAlbaranCab', 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); {P571 ReplaceBookmark('BaseImponible', FieldByName('BASEIMPONIBLE').DisplayText); if esCadenaVacia(FieldByName('Descuento').DisplayText) then ReplaceBookmark('Descuento', '0') else ReplaceBookmark('Descuento', FieldByName('DESCUENTO').DisplayText); ReplaceBookmark('ImporteDescuento', FieldByName('IMPORTEDESCUENTO').DisplayText); if esCadenaVacia(FieldByName('IVA').DisplayText) then ReplaceBookmark('IVA', '0') else ReplaceBookmark('IVA', FieldByName('IVA').DisplayText); ReplaceBookmark('ImporteIVA', FieldByName('IMPORTEIVA').DisplayText); ReplaceBookmark('ImporteTotal', FieldByName('IMPORTETOTAL').DisplayText); } 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); end; end; procedure TInformeAlbaranCliente.RellenarDatosDetalle; var numRows, numCols, mergesplit : OleVariant; MaxCols, iRowCount : Integer; begin iRowCount := 2; numrows := 2; numcols := 1; mergeSplit := False; MaxCols := 24; with FDocumento.Document.Tables.Item(1), FTablaDetallesAlbaranes do begin FTablaDetallesAlbaranes.First; while not FTablaDetallesAlbaranes.EOF do begin Rows.Item (iRowCount).Cells.Split (numRows, numCols, mergesplit); Cell(iRowCount, 1).Range.Text := FieldByName('CODIGOARTICULO').AsString; Cell(iRowCount, 2).Range.Text := FieldByName('DESCRIPCION').AsString; Cell(iRowCount, 3).Range.Text := FieldByName('CANTIDAD').AsString + ' ' + FieldByName('UNIDADESMEDIDA').AsString; if (FieldByName('PRECIOUNIDAD').AsFloat = 0) then Cell(iRowCount, 4).Range.Text := '' else Cell(iRowCount, 4).Range.Text := FieldByName('PRECIOUNIDAD').DisplayText; if (FieldByName('TOTAL').AsFloat = 0) then Cell(iRowCount, 5).Range.Text := '' else Cell(iRowCount, 5).Range.Text := FieldByName('TOTAL').DisplayText; Next; Inc (iRowCount); end; Rows.Item(iRowCount).Delete; {while iRowCount <= MaxCols do begin Rows.Item (iRowCount).Cells.Split (numRows, numCols, mergesplit); inc (iRowCount); end;} end; end; procedure TInformeAlbaranCliente.IniciarSQLInformes; begin with sqlCabeceraAlbaran do begin Add('select * from ALBARANESCLIENTE '); Add('where (CODIGO = :CODIGO)'); Add('and (CODIGOEMPRESA = :CODIGOEMPRESA)'); end; with sqlDetallesAlbaran do begin Add('select CODIGOALBARAN, NUMCONCEPTO, CODIGOARTICULO, DESCRIPCION, '); Add('CANTIDAD, UNIDADESMEDIDA, PRECIOUNIDAD, TOTAL '); Add('from DETALLESALBARANESCLIENTE '); Add('where (CODIGOALBARAN = :CODIGOALBARAN) '); Add('and (CODIGOEMPRESA = :CODIGOEMPRESA)'); Add('order by NUMCONCEPTO'); end; end; function TInformeAlbaranCliente.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 TInformeAlbaranCliente.Imprimir(Codigo: String): Boolean; begin FNombreFichero := DarFicheroTemporal; if not Generar(Codigo) then begin Result := False; Exit; end; Result := ImprimirDoc(FNombreFichero); DeleteFile(FNombreFichero); end; end.