{ =============================================================================== Copyright (©) 2002. 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: 02-12-2002 Versión actual: 1.0.1 Fecha versión actual: 02-02-2004 =============================================================================== Modificaciones: Fecha Comentarios --------------------------------------------------------------------------- 02-02-2004 Se ha adaptado a los nuevos contadores =============================================================================== } unit ContratosClientes; interface uses Windows, Db, Menus, am2000menuitem, am2000popupmenu, am2000, RdxBarras, RdxBotones, Grids, DBGrids, RXDBCtrl, Classes, Controls, RdxFrame, ExtCtrls, RdxPaneles, RdxFrameContratos, Dialogs, Configuracion, Graphics, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxEdit, cxDBData, cxGridLevel, cxClasses, cxControls, cxGridCustomView, cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGrid, Entidades, ActnList, cxContainer, cxTextEdit, cxMaskEdit, cxDropDownEdit, StdCtrls, am2000utils, cxDataStorage; type TfrContratosClientes = class(TRdxFrameContratos) pnlCuerpo: TRdxPanel; pnlGrid: TRdxPanel; pnlCabecera: TRdxBarraSuperior; bModificar: TRdxBotonSuperior; bEliminar: TRdxBotonSuperior; bConsultar: TRdxBotonSuperior; dsContratos: TDataSource; brSeleccion: TRdxBarraInferior; bSeleccionar: TRdxBoton; bCancelar: TRdxBoton; brSimple: TRdxBarraInferior; bSalir: TRdxBoton; gridContratos: TcxGrid; gridContratosDBTableView1: TcxGridDBTableView; gridContratosLevel1: TcxGridLevel; bSeparador1: TShape; bBuscar: TRdxBotonSuperior; MenuOpciones: TPopupMenu2000; MenuItem20002: TMenuItem2000; Contadores: TMenuItem2000; MenuItem1: TMenuItem2000; Acciones: TActionList; actModificar: TAction; actEliminar: TAction; actConsultar: TAction; bImprimir: TRdxBotonSuperior; actImprimir: TAction; actSeleccionar: TAction; actCancelar: TAction; actAceptar: TAction; pnlExtra: TRdxBarraSuperior; bFacturar: TRdxBoton; actAnadirDePresupuesto: TAction; bAnadir: TRdxBotonMenu; MenuItem15: TMenuItem2000; MenuItem16: TMenuItem2000; Panel1: TPanel; bSeparador2: TShape; eFamilia: TLabel; cbxDocumento: TcxComboBox; actFacturarContrato: TAction; MenuItem2: TMenuItem2000; imgSombra: TImage; menuAnadir: TPopupMenu2000; MenuItem6: TMenuItem2000; MenuItem7: TMenuItem2000; mnNuevo: TMenuItem2000; MenuItem9: TMenuItem2000; MenuItem8: TMenuItem2000; MenuItem10: TMenuItem2000; MenuItem20004: TMenuItem2000; mnCopiar: TMenuItem2000; MenuItem3: TMenuItem2000; MenuItem4: TMenuItem2000; Shape1: TShape; bRefrescar: TRdxBoton; Panel2: TPanel; eNombre: TLabel; Buscar: TcxTextEdit; bLimpiar: TRdxBoton; actConsultarBeneficio: TAction; actCrearObra: TAction; bAnadirObra: TRdxBoton; MenuItem5: TMenuItem2000; MenuItem11: TMenuItem2000; procedure RdxFrameContratosShow(Sender: TObject); procedure gridContratosDBTableView1DblClick(Sender: TObject); procedure actSeleccionarExecute(Sender: TObject); procedure actCancelarExecute(Sender: TObject); procedure actAceptarExecute(Sender: TObject); procedure actModificarExecute(Sender: TObject); procedure actEliminarExecute(Sender: TObject); procedure actConsultarExecute(Sender: TObject); procedure actAnadirDePresupuestoExecute(Sender: TObject); procedure cbxFamiliaPropertiesEditValueChanged( Sender: TObject); procedure actAnadirCocinaExecute(Sender: TObject); procedure actImprimirExecute(Sender: TObject); procedure actAnadirBanoExecute(Sender: TObject); procedure actAnadirArmariosExecute(Sender: TObject); procedure actAnadirElectroExecute(Sender: TObject); procedure gridContratosDBTableView1CustomDrawCell( Sender: TcxCustomGridTableView; ACanvas: TcxCanvas; AViewInfo: TcxGridTableDataCellViewInfo; var ADone: Boolean); procedure actRechazarContratoUpdate(Sender: TObject); procedure actFacturarContratoExecute(Sender: TObject); procedure actAnadirExecute(Sender: TObject); procedure actAnadirUpdate(Sender: TObject); procedure actModificarUpdate(Sender: TObject); procedure actAnadirCopiaExecute(Sender: TObject); procedure actRefrescarDatosExecute(Sender: TObject); procedure BuscarPropertiesChange(Sender: TObject); procedure bLimpiarClick(Sender: TObject); procedure actConsultarBeneficioExecute(Sender: TObject); procedure actCrearObraExecute(Sender: TObject); procedure actCrearObraUpdate(Sender: TObject); private FCodigoPresupuesto : Variant; protected procedure FreeContenido; override; procedure BuscarContrato; override; procedure ActualizarBarras; override; procedure SetContenido (NuevoFrame : TRdxFrame); override; procedure CambiarModo(ModoAnterior, Modo : TRdxModo); override; procedure VerModal; override; public constructor Create (AOwner : TComponent); override; destructor Destroy; override; end; var frContratosClientes: TfrContratosClientes; implementation {$R *.DFM} uses Variants, TablaContratos, BaseDatos, IBCustomDataSet, TablaDocumentos, Mensajes, Sysutils, PresupuestosClientes, RdxFramePresupuestos, ImprimirContratosCliente, StrFunc, ContratoCliente, FacturarContrato, TablaFacturasCliente, TablaFacturasProveedor, ListadoBeneficios, TablaObras, Literales, RdxDBFrame; { TfrContratossClientes } procedure TfrContratosClientes.BuscarContrato; begin with TablaContratos do begin DisableControls; Close; Open; dmTablaContratos.InicializarTablaContratos(@TablaContratos); EnableControls; if not Locate('CODIGO', CodigoContrato, []) then gridContratosDBTableView1.Controller.GoToFirst else gridContratosDBTableView1.Controller.TopRowIndex := gridContratosDBTableView1.Controller.FocusedRowIndex; end; end; constructor TfrContratosClientes.Create(AOwner: TComponent); begin inherited Create(AOwner); Entidad := entContratoCliente; BaseDatos := dmBaseDatos.BD; Transaccion := dmBaseDatos.Transaccion; TablaContratos := TIBDataSet.Create(Self); dsContratos.DataSet := TablaContratos; with TablaContratos do begin DisableControls; Database := BaseDatos; Transaction := Transaccion; SelectSQL.Assign(dmTablaContratos.sqlConsultarGridContratos); Prepare; Open; EnableControls; end; dmTablaContratos.InicializarTablaContratos(@TablaContratos); dmTablaContratos.InicializargridContratos(gridContratos); gridContratosDBTableView1.Controller.GoToFirst; FCodigoContrato := TablaContratos.fieldbyname('CODIGO').AsString; cbxDocumento.Properties.Items.Add('Todos'); cbxDocumento.Properties.Items.AddStrings(dmTablaDocumentos.DarDocumentos); cbxDocumento.ItemIndex := 0; end; destructor TfrContratosClientes.Destroy; begin TablaContratos.Close; TablaContratos.UnPrepare; TablaContratos.Free; inherited; end; procedure TfrContratosClientes.FreeContenido; begin if (Contenido is TRdxFrameContratos) then CodigoContrato := (Contenido as TRdxFrameContratos).CodigoContrato; if (ContenidoModal is TRdxFramePresupuestos) then FCodigoPresupuesto := (ContenidoModal as TRdxFramePresupuestos).CodigoPresupuesto; inherited FreeContenido; //gridContratos.SetFocus; end; procedure TfrContratosClientes.ActualizarBarras; begin inherited; case Modo of Consultar : begin if BarraSeleccion <> NIL then BarraSeleccion.Visible := False; if BarraSalir <> NIL then BarraSalir.Visible := True; if BarraOperacion <> NIL then BarraOperacion.Visible := False; end; Facturar : begin if BarraSeleccion <> NIL then BarraSeleccion.Visible := True; if BarraSalir <> NIL then BarraSalir.Visible := False; if BarraOperacion <> NIL then BarraOperacion.Visible := False; end; end; end; procedure TfrContratosClientes.RdxFrameContratosShow( Sender: TObject); begin Buscar.SetFocus end; procedure TfrContratosClientes.gridContratosDBTableView1DblClick( Sender: TObject); begin if Modo in [Seleccionar, Facturar, AbrirObra] then actSeleccionar.Execute else actModificar.Execute; end; procedure TfrContratosClientes.actSeleccionarExecute(Sender: TObject); begin CodigoContrato := TablaContratos.FieldByName('CODIGO').AsString; CloseFrame; end; procedure TfrContratosClientes.actCancelarExecute(Sender: TObject); begin FCodigoContrato := NULL; CloseFrame; end; procedure TfrContratosClientes.actAceptarExecute(Sender: TObject); begin CloseFrame; end; procedure TfrContratosClientes.actModificarExecute(Sender: TObject); begin Contenido := TfrContratoCliente.Create(Self); Contenido.Modo := Modificar; end; procedure TfrContratosClientes.actEliminarExecute(Sender: TObject); begin if dmTablaFacturasCliente.ExisteFacturaConContrato( TablaContratos.FieldByName('CODIGO').AsString) then begin VerMensaje('No se puede eliminar este contrato porque tiene al menos una factura de cliente relacionada.'); Exit; end; if dmTablaFacturasProveedor.ExisteFacturaConContrato( TablaContratos.FieldByName('CODIGO').AsString) then begin VerMensaje('No se puede eliminar este contrato porque tiene al menos una factura de proveedor relacionada.'); Exit; end; Contenido := TfrContratoCliente.Create(Self); Contenido.Modo := Eliminar; end; procedure TfrContratosClientes.actConsultarExecute(Sender: TObject); begin Contenido := TfrContratoCliente.Create(Self); Contenido.Modo := Consultar; end; procedure TfrContratosClientes.actAnadirDePresupuestoExecute(Sender: TObject); var CodAux : String; begin // Mostrar la lista de presupuestos CaptionModal := 'Elija el presupuesto sobre el que desea hacer el contrato'; ContenidoModal := TfrPresupuestosClientes.Create(Self); if (not EsCadenaVacia(FCodigoPresupuesto)) then begin CodAux := dmTablaContratos.CrearContrato(FCodigoPresupuesto); if EsCadenaVacia(CodAux) then begin VerMensaje('No se ha podido crear el contrato'); Rollback; end else begin Commit; CodigoContrato := CodAux; Contenido := TfrContratoCliente.Create(Self); Contenido.Modo := Modificar; Contenido.Visible := True; end; end; end; procedure TfrContratosClientes.cbxFamiliaPropertiesEditValueChanged( Sender: TObject); var Columna : TcxGridDBColumn; TextoDocumento : String; begin TextoDocumento := cbxDocumento.Text; with gridContratos.ActiveView.DataController.Filter do begin BeginUpdate; try Columna := (gridContratos.ActiveView as TcxGridDBTableView).GetColumnByFieldName('DESCRIPCION'); if UpperCase(TextoDocumento) = 'TODOS' then begin Columna.Visible := True; Entidad := entContratoCliente; Clear; end else begin Columna.Visible := False; Root.Clear; Root.AddItem(Columna, foEqual, TextoDocumento, 'DESCRIPCION'); Active := True; Entidad := dmTablaDocumentos.DarEntidadDocumento(entContratoCliente,TablaContratos.FieldByName('CODIGODOCUMENTO').AsString); end; finally EndUpdate; gridContratos.ActiveView.DataController.GotoFirst; end; end; end; procedure TfrContratosClientes.actAnadirCocinaExecute(Sender: TObject); begin Contenido := TfrContratoCliente.Create(Self); Contenido.Entidad := entContratoCocina; Contenido.Modo := Anadir; end; procedure TfrContratosClientes.actImprimirExecute(Sender: TObject); begin Contenido := TfrImprimirContratosCliente.Create(Self); Contenido.Modo := Imprimir; end; procedure TfrContratosClientes.actAnadirBanoExecute(Sender: TObject); begin Contenido := TfrContratoCliente.Create(Self); Contenido.Entidad := entContratoBano; Contenido.Modo := Anadir; end; procedure TfrContratosClientes.actAnadirArmariosExecute( Sender: TObject); begin Contenido := TfrContratoCliente.Create(Self); Contenido.Entidad := entContratoArmarios; Contenido.Modo := Anadir; end; procedure TfrContratosClientes.actAnadirElectroExecute(Sender: TObject); begin Contenido := TfrContratoCliente.Create(Self); Contenido.Entidad := entContratoElectro; Contenido.Modo := Anadir; end; procedure TfrContratosClientes.SetContenido(NuevoFrame: TRdxFrame); begin inherited; if (Contenido is TfrImprimirContratosCliente) then (Contenido as TfrImprimirContratosCliente).CodigoContrato := FCodigoContrato; if (Contenido is TfrListadoBeneficios) then (Contenido as TfrListadoBeneficios).Modo := Consultar; end; procedure TfrContratosClientes.gridContratosDBTableView1CustomDrawCell( Sender: TcxCustomGridTableView; ACanvas: TcxCanvas; AViewInfo: TcxGridTableDataCellViewInfo; var ADone: Boolean); var IndiceCol : Integer; begin if not AViewInfo.Selected then begin IndiceCol := (Sender as TcxGridDBTableView).GetColumnByFieldName('SITUACION').Index; if UpperCase(AViewInfo.GridRecord.DisplayTexts[IndiceCol]) = 'RECHAZADO' then ACanvas.Canvas.Font.Color := clGray; if UpperCase(AViewInfo.GridRecord.DisplayTexts[IndiceCol]) = 'ACEPTADO' then ACanvas.Canvas.Font.Color := clNavy; end; end; procedure TfrContratosClientes.actRechazarContratoUpdate( Sender: TObject); begin if (UpperCase(TablaContratos.FieldByName('SITUACION').AsString) = 'ANULADO') then (Sender as TAction).Enabled := False else (Sender as TAction).Enabled := True; end; procedure TfrContratosClientes.actFacturarContratoExecute( Sender: TObject); var CodAux : String; begin CodigoContrato := TablaContratos.FieldByName('CODIGO').AsString; frFacturarContrato := TfrFacturarContrato.Create(Self); with frFacturarContrato do begin try frFacturarContrato.CodigoContrato := Self.CodigoContrato; ShowModal; if ModalResult = mrYes then begin Commit; VerMensajeFmt('La factura asociada a este contrato es %s.', [frFacturarContrato.CodigoFactura]) end else begin Rollback; VerMensaje('No se ha podido facturar el contrato') end; finally Free; end; end; end; procedure TfrContratosClientes.VerModal; begin if (ContenidoModal is TRdxFramePresupuestos) then (ContenidoModal as TRdxFramePresupuestos).Modo := Contratar; inherited; end; procedure TfrContratosClientes.CambiarModo(ModoAnterior, Modo: TRdxModo); begin with TablaContratos do begin Close; case Modo of Facturar : begin SelectSQL.Assign(dmTablaContratos.sqlConsultarGridContratosFacturar); BarraExtra.Visible := False; end; AbrirObra : begin SelectSQL.Assign(dmTablaContratos.sqlConsultarGridContratosObra); BarraExtra.Visible := False; end; else BarraExtra.Visible := True; end; end; inherited; dmTablaContratos.InicializarTablaContratos(@TablaContratos); end; procedure TfrContratosClientes.actAnadirExecute(Sender: TObject); begin Contenido := TfrContratoCliente.Create(Self); Contenido.Entidad := entContratoVarios; Contenido.Modo := Anadir; end; procedure TfrContratosClientes.actAnadirUpdate(Sender: TObject); begin (Sender as TAction).Enabled := not (BaseDatos.IsReadOnly); end; procedure TfrContratosClientes.actModificarUpdate(Sender: TObject); begin if BaseDatos.IsReadOnly then (Sender as TAction).Enabled := False else begin if (TablaContratos.Active) and (TablaContratos.RecordCount > 0) then (Sender as TAction).Enabled := True else (Sender as TAction).Enabled := False end; end; procedure TfrContratosClientes.actAnadirCopiaExecute(Sender: TObject); var FCodAux : String; begin CodigoContrato := TablaContratos.FieldByName('CODIGO').AsString; FCodAux := dmTablaContratos.CopiarContrato(CodigoContrato); if EsCadenaVacia(FCodAux) then begin Rollback; VerMensaje('No se ha podido copiar el contrato') end else begin FCodigoContrato := FCodAux; Commit; VerMensajeFmt('El contrato nuevo es el %s', [FCodAux]) end; BuscarContrato; end; procedure TfrContratosClientes.actRefrescarDatosExecute(Sender: TObject); begin FCodigoContrato := TablaContratos.FieldByName('CODIGO').AsString; BuscarContrato; end; procedure TfrContratosClientes.BuscarPropertiesChange(Sender: TObject); begin FiltrarGrid(gridContratos, Buscar.Text); end; procedure TfrContratosClientes.bLimpiarClick(Sender: TObject); begin Buscar.Text := ''; end; procedure TfrContratosClientes.actConsultarBeneficioExecute( Sender: TObject); begin Contenido := TfrListadoBeneficios.Create(Self); end; procedure TfrContratosClientes.actCrearObraExecute(Sender: TObject); begin CodigoContrato := TablaContratos.FieldByName('CODIGO').AsVariant; if dmTablaObras.CrearObra(CodigoContrato) then begin Commit; VerMensajeFmt(msgObrAnadida,[CodigoContrato]); BuscarContrato; end end; procedure TfrContratosClientes.actCrearObraUpdate(Sender: TObject); begin if (TablaContratos.RecordCount > 0) then (Sender as TAction).Enabled := True else (Sender as TAction).Enabled := False; end; end.