{ =============================================================================== 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: 04-10-2004 Versión actual: 1.0.0 Fecha versión actual: 04-10-2004 =============================================================================== Modificaciones: Fecha Comentarios --------------------------------------------------------------------------- =============================================================================== } unit InformeAlbaranInstalador; interface uses classes, AHWord97, IB, IBCustomDataSet, Ibdatabase, Mensajes; type TInformeAlbaranInstalador = 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 { TInformeAlbaranInstalador } uses BaseDatos, TablaAlbaranesCliente, DB, Sysutils, Controls, Configuracion, Forms, StrFunc, Word2000, RdxEmpresaActiva, Constantes, Literales, SysFunc; procedure TInformeAlbaranInstalador.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); except on E : EIBError do begin VerMensaje(E.Message); end; on E : EDatabaseError do begin VerMensaje(E.Message); end; end; end; constructor TInformeAlbaranInstalador.Create(AOwner: TComponent); begin inherited; FPlantilla := ExtractFileDir(ParamStr(0)) + '\informes\' + IntToStr(EmpresaActiva.ModeloInforme) + '\AlbaranInstalador.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 TInformeAlbaranInstalador.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 TInformeAlbaranInstalador.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 TInformeAlbaranInstalador.RellenarInforme(Codigo: String): Boolean; begin BuscarAlbaran; with FDocumento do begin RellenarDatosAlbaran; RellenarDatosDetalle; end; Result := True; end; procedure TInformeAlbaranInstalador.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('TELEFONO').AsString); 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 TInformeAlbaranInstalador.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; 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 TInformeAlbaranInstalador.IniciarSQLInformes; begin with sqlCabeceraAlbaran do begin Add('select * from ALBARANESINSTALADOR '); Add('where (CODIGO = :CODIGO)'); Add('and (CODIGOEMPRESA = :CODIGOEMPRESA)'); end; with sqlDetallesAlbaran do begin Add('select CODIGOALBARAN, NUMCONCEPTO, CODIGOARTICULO, DESCRIPCION, '); Add('CANTIDAD, UNIDADESMEDIDA '); Add('from DETALLESALBARANESINSTALADOR '); Add('where (CODIGOALBARAN = :CODIGOALBARAN) '); Add('and (CODIGOEMPRESA = :CODIGOEMPRESA)'); Add('order by NUMCONCEPTO'); end; end; function TInformeAlbaranInstalador.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 TInformeAlbaranInstalador.Imprimir(Codigo: String): Boolean; begin FNombreFichero := DarFicheroTemporal; if not Generar(Codigo) then begin Result := False; Exit; end; Result := ImprimirDoc(FNombreFichero); DeleteFile(FNombreFichero); end; end.