{ =============================================================================== 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.6 Fecha versión actual: 14-07-2004 =============================================================================== Modificaciones: Fecha Comentarios --------------------------------------------------------------------------- 21-10-2001 Se ha añadido la columna 'Unidad' en el informe del pedido. 30-10-2001 La columna 'Unidad' se coje de la propia tabla de pedidos no de la tabla de materiales. 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. 07-03-2004 Adaptación a multiempresa. 14-07-2004 Arreglo de cambio de empresa para (ME) en la firma del pedido =============================================================================== } unit InformePedidoProveedor; interface uses classes, AHWord97, IB, IBCustomDataSet, Ibdatabase, Mensajes; type TInformePedidoProveedor = class(TComponent) private FImportes : Boolean; sqlCabeceraPedido : TStrings; sqlDetallesPedido : TStrings; FWordApp : TWordApp; FDocumento : TWordDoc; FTablaPedidosProveedor : TIBDataSet; FTablaDetallesPedidos : TIBDataSet; FTransaccion : TIBTransaction; FBaseDatos : TIBDataBase; FPlantilla : string; FCodigoPedido : string; FNombreFichero : string; procedure IniciarSQLInformes; procedure BuscarPedido; function RellenarInforme (Codigo : String) : Boolean; procedure RellenarDatosPedido; 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 { TInformePedidoProveedor } uses Windows, BaseDatos, TablaPedidosProveedor, DB, Sysutils, Controls, SysFunc, Configuracion, Forms, StrFunc, Word2000, RdxEmpresaActiva, Literales, Constantes; procedure TInformePedidoProveedor.BuscarPedido; begin if FTransaccion = NIL then exit; try FTablaPedidosProveedor.Close; FTablaDetallesPedidos.Close; // Buscar la fila a tratar si es necesario if not VarIsNull(FCodigoPedido) then begin FTablaPedidosProveedor.Params.ByName('CODIGOEMPRESA').AsInteger := EmpresaActiva.Codigo; FTablaPedidosProveedor.Params.ByName('CODIGO').AsString := FCodigoPedido; FTablaDetallesPedidos.Params.ByName('CODIGOEMPRESA').AsInteger := EmpresaActiva.Codigo; FTablaDetallesPedidos.Params.ByName('CODIGOPEDIDO').AsString := FCodigoPedido; end; FTablaPedidosProveedor.Prepare; FTablaDetallesPedidos.Prepare; FTablaPedidosProveedor.Open; FTablaDetallesPedidos.Open; dmTablaPedidosProveedor.InicializarTablaPedidos(@FTablaPedidosProveedor); dmTablaPedidosProveedor.InicializarTablaDetalles(@FTablaDetallesPedidos); except on E : EIBError do begin VerMensaje(E.Message); end; on E : EDatabaseError do begin VerMensaje(E.Message); end; end; end; constructor TInformePedidoProveedor.Create(AOwner: TComponent); begin inherited; FPlantilla := ExtractFileDir(ParamStr(0))+ '\informes\' + IntToStr(EmpresaActiva.ModeloInforme) + '\PedidoProveedor.rdx'; FImportes := True; sqlCabeceraPedido := TStringList.Create; sqlDetallesPedido := TStringList.Create; IniciarSQLInformes; FBaseDatos := dmBaseDatos.BD; FTransaccion := dmBaseDatos.Transaccion; FTablaPedidosProveedor := TIBDataSet.Create(Self); FTablaDetallesPedidos := TIBDataSet.Create(Self); with FTablaPedidosProveedor do begin Database := FBaseDatos; Transaction := FTransaccion; SelectSQL.Assign(sqlCabeceraPedido); end; with FTablaDetallesPedidos do begin Database := FBaseDatos; Transaction := FTransaccion; SelectSQL.Assign(sqlDetallesPedido); end; end; destructor TInformePedidoProveedor.Destroy; begin FTablaPedidosProveedor.Close; FTablaDetallesPedidos.Close; FTablaPedidosProveedor.UnPrepare; FTablaDetallesPedidos.Unprepare; FTablaPedidosProveedor.Free; FTablaDetallesPedidos.Free; FTablaPedidosProveedor := NIL; FTablaDetallesPedidos := NIL; FTransaccion := NIL; FBaseDatos := NIL; FDocumento := NIL; sqlCabeceraPedido.Free; sqlDetallesPedido.Free; inherited; end; function TInformePedidoProveedor.Generar(Codigo: String): Boolean; begin if EsCadenaVacia(Codigo) then raise Exception.Create(msgInfFaltaCodPed); if (VerMensajePreguntaSN(msgInfDeseaImportes) <> IDYES) then FImportes := False; FCodigoPedido := Codigo; Screen.Cursor := crHourglass; FWordApp := TWordApp.Create (False, True); with FWordApp do begin { OnQuit := WordAppQuit; OnChangeDocument := WordDocChange; OnOpenDocument := WordDocOpen; OnPreCloseDocument := WordPreClose; OnCloseDocument := WordDocClose; } WindowState := wdWindowStateMaximize; 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 TInformePedidoProveedor.RellenarInforme(Codigo: String): Boolean; begin BuscarPedido; RellenarDatosPedido; RellenarDatosDetalle; Result := True; end; procedure TInformePedidoProveedor.RellenarDatosPedido; var DireccionEntrega, 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, FTablaPedidosProveedor do begin ReplaceBookmark('CodigoPedido', FieldByName('CODIGO').AsString); ReplaceBookmark('FechaPedido', FieldByName('FECHAEMISION').AsString); // En la dirección mostrar aquellos campos que estén rellenos. DireccionEntrega := ''; if not EsCadenaVacia(FieldByName('CALLEALMACEN').AsString) then DireccionEntrega := DireccionEntrega + FieldByName('CALLEALMACEN').AsString; if not EsCadenaVacia(FieldByName('NUMEROALMACEN').AsString) then DireccionEntrega := DireccionEntrega + ' ' + FieldByName('NUMEROALMACEN').AsString; if not EsCadenaVacia(FieldByName('PISOALMACEN').AsString) then DireccionEntrega := DireccionEntrega + ', ' + FieldByName('PISOALMACEN').AsString; if not EsCadenaVacia(FieldByName('CODIGOPOSTALALMACEN').AsString) then DireccionEntrega := DireccionEntrega + ', ' + FieldByName('CODIGOPOSTALALMACEN').AsString; if not EsCadenaVacia(FieldByName('POBLACIONALMACEN').AsString) then DireccionEntrega := DireccionEntrega + ', ' + FieldByName('POBLACIONALMACEN').AsString; if not EsCadenaVacia(FieldByName('PROVINCIAALMACEN').AsString) then DireccionEntrega := DireccionEntrega + ', ' + FieldByName('PROVINCIAALMACEN').AsString; ReplaceBookmark('LugarEntrega', DireccionEntrega); { ReplaceBookmark('LugarEntrega', FieldByName('CALLEALMACEN').AsString + ' ' + FieldByName('NUMEROALMACEN').AsString + ', ' + FieldByName('PISOALMACEN').AsString + ', ' + FieldByName('CODIGOPOSTALALMACEN').AsString + ' ' + FieldByName('POBLACIONALMACEN').AsString + ', ' + FieldByName('PROVINCIAALMACEN').AsString);} ReplaceBookmark('PersonaEntrega', FieldByName('PERSONACONTACTOALMACEN').AsString); ReplaceBookmark('NombreProveedor', FieldByName('NOMBRE').AsString); ReplaceBookmark('FaxProveedor', FieldByName('FAX').AsString); ReplaceBookmark('PersonaContactoProveedor', FieldByName('PERSONACONTACTO').AsString); ReplaceBookmark('CodigoClienteProveedor', FieldByName('CODIGOCLIENTE').AsString); if FImportes then ReplaceBookmark('ImporteTotal', FieldByName('IMPORTETOTAL').DisplayText) else ReplaceBookmark('ImporteTotal', ''); ReplaceBookmark('NotasPedido', FieldByName('NOTAS').AsString); ReplaceBookmark('NombreEmpresa', EmpresaActiva.Nombre); ReplaceBookmark('NombreEmpresa2', 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 TInformePedidoProveedor.RellenarDatosDetalle; var numRows, numCols, mergesplit : OleVariant; MaxCols, iRowCount : Integer; begin iRowCount := 2; numrows := 2; numcols := 1; mergeSplit := False; MaxCols := 12; with FDocumento.Document.Tables.Item(1), FTablaDetallesPedidos do begin FTablaDetallesPedidos.First; while not FTablaDetallesPedidos.EOF do begin Rows.Item (iRowCount).Cells.Split (numRows, numCols, mergesplit); Cell(iRowCount, 1).Range.Text := FieldByName('REFPROVEEDOR').AsString; Cell(iRowCount, 2).Range.Text := FieldByName('REFFABRICANTE').AsString; Cell(iRowCount, 3).Range.Text := FieldByName('DESCRIPCION').AsString; Cell(iRowCount, 4).Range.Text := FieldByName('CANTIDAD').AsString + ' ' + FieldByName('UNIDADESMEDIDA').AsString; if FImportes then Cell(iRowCount, 5).Range.Text := FieldByName('PRECIO').DisplayText else Cell(iRowCount, 5).Range.Text := ''; if FImportes then Cell(iRowCount, 6).Range.Text := FieldByName('TOTAL').DisplayText else Cell(iRowCount, 6).Range.Text := ''; 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 TInformePedidoProveedor.IniciarSQLInformes; begin with sqlCabeceraPedido do begin Add('select * from PEDIDOSPROVEEDOR '); Add('where (CODIGO = :CODIGO) '); Add('and (CODIGOEMPRESA = :CODIGOEMPRESA) '); end; with sqlDetallesPedido do begin Add('select CODIGOPEDIDO, NUMCONCEPTO, CODIGOARTICULO, REFPROVEEDOR, REFFABRICANTE, '); Add('DESCRIPCION, CANTIDAD, UNIDADESMEDIDA, PRECIO, DESCUENTO, TOTAL '); Add('from DETALLESPEDIDOSPROVEEDOR'); Add('where (CODIGOPEDIDO = :CODIGOPEDIDO) '); Add('and (CODIGOEMPRESA = :CODIGOEMPRESA) '); Add('order by NUMCONCEPTO'); end; end; function TInformePedidoProveedor.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 TInformePedidoProveedor.Imprimir(Codigo: String): Boolean; begin FNombreFichero := DarFicheroTemporal; if not Generar(Codigo) then begin Result := False; Exit; end; Result := ImprimirDoc(FNombreFichero); DeleteFile(FNombreFichero); end; end.