UTiposDiario.pas | searchcode

/Fuentes/UTiposDiario.pas

http://sencontab.googlecode.com/
Pascal | 444 lines | 386 code | 45 blank | 13 comment | 38 complexity | 336437340e0c80a49445bbb7eac2a902 MD5 | raw file

unit UTiposDiario;

interface

uses Buttons, Classes, Controls, DB, DBClient, DBCtrls, DBTables, Dialogs, ExtCtrls, fcButton, fcImage,

     fcimageform, fcImgBtn, Forms, Graphics, Grids, IBCustomDataSet, IBDatabase, IBTableSet, jpeg, Mask,

     Messages, navegadorNotarios, OvcBase, OvcDbNF, OvcDbPF, OvcEF, OvcNF, OvcPB, OvcPF, StdCtrls,

     SysUtils, WinProcs, WinTypes, Wwdatsrc, Wwdbgrid, Wwdbigrd, Wwkeycb, CustomView;

type

   TWTiposDiario = class(TCustomView)

      OvcController1:  TOvcController;

      SFichero:        TwwDataSource;

      QFichero:        TIBTableSet;

      Transaccion:     TIBTransaction;

      Datos:           TGroupBox;

      Label1:          TLabel;

      Label2:          TLabel;

      eDescripcion:    TOvcDbPictureField;

      Shape1:          TShape;

      Label3:          TLabel;

      Panel1:          TPanel;

      BtnNavAniadir:   TfcImageBtn;

      BtnNavBorrar:    TfcImageBtn;

      BtnNavCerrar:    TfcImageBtn;

      BtnEdtGuardar:   TfcImageBtn;

      BtnEdtCancelar:  TfcImageBtn;

      FiltroBuscar:    TGroupBox;

      FiltroBDescripcion: TOvcDbPictureField;

      TbFiltro:        TClientDataSet;

      sFiltro:         TDataSource;

      fcIBCerrar:      TfcImageBtn;

      Panel3:          TPanel;

      Panel5:          TPanel;

      Panel4:          TPanel;

      fcImageBtnMinimizar: TfcImageBtn;

      PanelSombra:     TPanel;

      Navegador:       TDBNavegadorNotarios;

      Label4:          TLabel;

      Label5:          TLabel;

      BtnNavFiltro:    TfcImageBtn;

      BtnNavImprimir:  TfcImageBtn;

      BtnNavModificar: TfcImageBtn;

      eCodigo:         TOvcDbPictureField;

      FiltroBCodigo:   TOvcDbPictureField;

      QFicheroDESCRIPCION: TIBStringField;

      QFicheroTIPODIARIO: TIBStringField;

      Rejilla:         TwwDBGrid;

      Panel2:          TPanel;

      Formulario:      TfcImageForm;

      procedure BtnNavAniadirClick(Sender: TObject);

      procedure BtnNavBorrarClick(Sender: TObject);

      procedure BtnEdtGuardarClick(Sender: TObject);

      procedure BtnEdtCancelarClick(Sender: TObject);

      procedure RejillaDblClick(Sender: TObject);

      procedure FormKeyPress(Sender: TObject; var Key: Char);

      procedure FormShow(Sender: TObject);

      procedure FormCreate(Sender: TObject);

      procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

      procedure RejillaTitleButtonClick(Sender: TObject; AFieldName: String);

      procedure RejillaCalcTitleAttributes(Sender: TObject; AFieldName: String;

         AFont: TFont; ABrush: TBrush; var ATitleAlignment: TAlignment);

      procedure BtnNavCerrarClick(Sender: TObject);

      procedure FormClose(Sender: TObject; var Action: TCloseAction);

      procedure fcImageBtnMinimizarClick(Sender: TObject);

      procedure fcImageBtnMouseEnter(Sender: TObject);

      procedure fcImageBtnMouseLeave(Sender: TObject);

      procedure LimpiarFiltro(Sender: TObject);

      procedure VerTabla(Sender: TObject);

      procedure BtnNavImprimirClick(Sender: TObject);

   private

      FCampoOrden: String;

      procedure CrearFiltro;

      procedure PrepararQuery;

      procedure RefrescarBD;

   public

   end;



var WTiposDiario: TWTiposDiario;



implementation

uses DM, DMControl, General, Globales, MenuPrincipal;

{$R *.DFM}



const CADENA_MANUAL  = 'Seleccione AYUDA si desea obtener más información sobre el problema surgido';

      CADENA_BORRADO = 'El tipo de diario seleccionado se encuentra referenciado en algún apunte.';



procedure TWTiposDiario.CrearFiltro;

begin

   {$Message Warn 'La instrucción WITH es ofuscadora de código`'}

   with TbFiltro, FieldDefs do begin

      active := False;

      Clear;

      Add('BCodigo', ftString, 2, False);

      Add('BDescripcion', ftstring, 30, False);

      CreateDataSet;

      active := True;

      append;

      FieldByName('BCodigo').AsString      := '';

      FieldByName('BDescripcion').AsString := '';

   end;

end;



procedure TWTiposDiario.PrepararQuery;

begin

   {$Message Warn 'La instrucción WITH es ofuscadora de código`'}

   with QFichero, ModifySql do begin

      Close;

      Clear;

      Add('UPDATE TIPODIARIO SET DESCRIPCION = :DESCRIPCION,');

      Add('TIPODIARIO = :TIPODIARIO WHERE TIPODIARIO = :OLD_TIPODIARIO');

   end;

   {$Message Warn 'La instrucción WITH es ofuscadora de código`'}

   with QFichero, SelectSQL do begin

      DisableControls;

      Close;

      Clear;

      Add('SELECT * FROM TIPODIARIO');



      if TbFiltro.FieldByName('BCODIGO').AsString <> '' then   begin

         add('WHERE TIPODIARIO LIKE :TIPODIARIO');

      end

      else

      if TbFiltro.FieldByName('BDESCRIPCION').AsString <> '' then   begin

         add('WHERE UPPER(DESCRIPCION) LIKE UPPER(:DESCRIPCION)');

      end;



      if FCampoOrden <> '' then begin

         Add('ORDER BY ' + FCampoOrden);

      end;



      if TbFiltro.FieldByName('BCODIGO').AsString <> '' then   begin

         params.byname('TIPODIARIO').AsString :=

            Copy(TbFiltro.FieldByName('BCODIGO').AsString + '%', 1,

            TbFiltro.FieldByName('BCODIGO').Size);

      end

      else

      if TbFiltro.FieldByName('BDESCRIPCION').AsString <> '' then   begin

         Params.byname('DESCRIPCION').AsString :=

            Copy(TbFiltro.FieldByName('BDESCRIPCION').AsString + '%', 1,

            TbFiltro.FieldByName('BDESCRIPCION').Size);

      end;



      Prepare;

      Open;

      EnableControls;

   end;

end;



procedure TWTiposDiario.RefrescarBD;

begin

   FibQueryRefresh(DmRef.QTipoDiario);

   FibQueryRefresh(DmRef.QTipodiarioNom);

end;



procedure TWTiposDiario.BtnNavAniadirClick(Sender: TObject);

begin

   if not DmControlRef.PermisoUsuario(gvID_Usuario, UpperCase(Self.Name), ANIADIR) then begin

      Exit;

   end;



   Navegador.Visible := False;



   eCodigo.SetFocus;

   try

      QFichero.Insert;

   except

      DatabaseError('No se ha podido insertar un nuevo tipo de diario.' + #13 +

         CADENA_MANUAL);

   end;

   Modo(Self, Edita);

end;



procedure TWTiposDiario.BtnNavBorrarClick(Sender: TObject);

begin

   if not DmControlRef.PermisoUsuario(gvID_Usuario, UpperCase(Self.Name), BORRAR) then begin

      Exit;

   end;



   if not QFichero.IsEmpty then begin

      if MessageDlg('?Desea borrar este tipo de diario?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin

         try QFichero.Delete;

             QFichero.Transaction.CommitRetaining;

             RefrescarBD;

         except DatabaseError('No se ha podido borrar el tipo de diario seleccionado.' + #13 + CADENA_BORRADO);

         end;

      end;

   end;

end;



procedure TWTiposDiario.BtnNavImprimirClick(Sender: TObject);

begin

   if not DmControlRef.PermisoUsuario(gvID_Usuario, UpperCase(Self.Name), IMPRESION) then begin

      Exit;

   end;



   FormPrincipal.LanzarListado('LTiposDiario.rtm', SFichero);

end;



procedure TWTiposDiario.BtnEdtGuardarClick(Sender: TObject);

var

   ha_insertado: Boolean;

begin

   // Comprobamos si el usuario ha insertado un nuevo registro.

   ha_insertado := QFichero.State = dsInsert;



   // Pasamos al siguiente registro para que el ultimo campo se guarde correctamente

   Perform(wm_NextDlgCtl, 0, 0);



   if QFichero.FieldByName('TIPODIARIO').AsString = '' then  begin

      eCodigo.SetFocus;

      DatabaseError('No se puede dejar el código del tipo de diario en blanco.' +

         #13 + 'Por favor, revise los datos de entrada.');

   end;



   if QFichero.FieldByName('DESCRIPCION').AsString = '' then  begin

      eDescripcion.SetFocus;

      DatabaseError('No se puede dejar la descripción del tipo de diario en blanco.' +

         #13 + 'Por favor, revise los datos de entrada.');

   end;



   QFichero.Post;

   QFichero.Transaction.CommitRetaining;



   RefrescarBD;

   Navegador.Visible := True;

   Modo(Self, Naveg);

   Rejilla.SetFocus;

   if ha_insertado then  begin

      if not (TbFiltro.State in dsEditModes) then begin

         TbFiltro.Edit;

      end;

      TbFiltro.FieldByName('BCODIGO').AsString := QFicheroTIPODIARIO.AsString;

      PrepararQuery;

      LimpiarFiltro(Sender);

   end;



end;



procedure TWTiposDiario.BtnEdtCancelarClick(Sender: TObject);

begin

   Perform(wm_NextDlgCtl, 0, 0);



   if not QFichero.Modified then Exit;



   if MessageDlg('?Quiere anular las modificaciones realizadas a este tipo de diario?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin

      Navegador.Visible := True;

      try    QFichero.Cancel;

      except DatabaseError('No se ha podido cancelar la operación.' + #13 + CADENA_MANUAL);

      end;

      Modo(Self, Naveg);

   end;

end;



procedure TWTiposDiario.RejillaDblClick(Sender: TObject);

begin

   if not DmControlRef.PermisoUsuario(gvID_Usuario, UpperCase(Self.Name), MODIFICAR) then begin

      Exit;

   end;



   if not QFichero.IsEmpty then  begin

      Navegador.Visible := False;

      try QFichero.Edit;

      except MessageDlg('No se puede editar el registro seleccionado.' + #13 + CADENA_MANUAL, mtInformation, [mbOK], 0);

      end;

      Modo(Self, Edita);

      eCodigo.SetFocus;

   end;

end;



procedure TWTiposDiario.FormKeyPress(Sender: TObject; var Key: Char);

begin

   // Si pulsamos enter y el control actual no es un grid pasamos al siguiente

   // control

   if (Key = Chr(VK_RETURN)) then   begin

      // Comprobacion del filtro por código

      if (FiltroBCodigo.Focused) and (FiltroBCodigo.Text <> '') then   begin

         key := #0;

         if tbFiltro.State in dsEditModes then begin

            tbFiltro.Post;

         end;

         PrepararQuery;

      end



      // Comprobacion del filtro por descripción

      else

      if (FiltroBDescripcion.Focused) and (FiltroBDescripcion.Text <> '') then   begin

         key := #0;

         if tbFiltro.State in dsEditModes then begin

            tbFiltro.Post;

         end;

         PrepararQuery;

      end



      //Si no es ninguno de los otros dos pasamos al siguiente control

      else

      if (not (ActiveControl is TwwDBGrid)) then   begin

         Key := #0;

         SelectNext(ActiveControl, GetKeyState(vk_Shift) and $80 = 0, True);

      end;

   end;

end;



procedure TWTiposDiario.FormShow(Sender: TObject);

begin

   SetBounds(0, FormPrincipal.Panel1.Top + FormPrincipal.Panel1.Height + 1, Width, Height);

   FiltroBCodigo.SetFocus;

end;



procedure TWTiposDiario.FormCreate(Sender: TObject);

begin

   ActivarTransacciones(self);

   CrearFiltro;

   FCampoOrden := 'TIPODIARIO';

   PrepararQuery;

   Modo(Self, Naveg);

end;



procedure TWTiposDiario.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

   case key of

      VK_ESCAPE: begin

         key := 0;

         if QFichero.State in dsEditModes then begin

            BtnEdtCancelar.Click;

         end

         else begin

            BtnNavCerrar.Click;

         end;

      end;

      VK_SPACE: begin

         if (ActiveControl <> FiltroBCodigo) and

            (ActiveControl <> FiltroBDescripcion) and not

            (QFichero.State in dsEditModes) then   begin

            //Anulamos el evento de la tecla

            Key := 0;

            RejillaDblClick(Self);

         end;

      end;

      VK_F2: begin

         if not (QFichero.State in dsEditModes) then begin

            BtnNavAniadir.Click;

         end;

      end;

      VK_F3: begin

         if QFichero.State in dsEditModes then begin

            BtnEdtGuardar.Click;

         end;

      end;

      VK_F4: begin

         if not (QFichero.State in dsEditModes) then begin

            RejillaDblClick(Self);

         end;

      end;

      VK_UP: begin

         if not (ActiveControl is TwwDBGrid) then begin

            SelectNext(ActiveControl, not (GetKeyState(VK_SHIFT) and $80 = 0), True);

         end;

      end;

      VK_DOWN: begin

         if not (ActiveControl is TwwDBGrid) then begin

            SelectNext(ActiveControl, GetKeyState(VK_SHIFT) and $80 = 0, True);

         end;

      end;

      VK_F12: begin

         if not (QFichero.State in dsEditModes) then begin

            VerTabla(Sender);

         end;

      end;

   end;

end;



procedure TWTiposDiario.RejillaTitleButtonClick(Sender: TObject; AFieldName: String);

begin

   if (UpperCase(AFieldName) = 'DESCRIPCION') or (UpperCase(AFieldName) = 'TIPODIARIO') then  begin

      FCampoOrden := UpperCase(AFieldName);

      PrepararQuery;

   end;

   Rejilla.SetFocus;

end;



procedure TWTiposDiario.RejillaCalcTitleAttributes(Sender: TObject; AFieldName: String;

   AFont: TFont; ABrush: TBrush; var ATitleAlignment: TAlignment);

begin

   if (UpperCase(AFieldName) = UpperCase(FCampoOrden)) then  begin

      ABrush.Color := clBlue;

      AFont.Style  := [fsBold];

      AFont.Color  := clWhite;

   end;

end;



procedure TWTiposDiario.BtnNavCerrarClick(Sender: TObject);

begin

   Close;

end;



procedure TWTiposDiario.FormClose(Sender: TObject; var Action: TCloseAction);

begin

   if QFichero.State = dsBrowse then  begin

      Action := caFree;

      Formulario.Free;

      Formulario   := nil;

      WTiposDiario := nil;

   end

   else begin

      MessageBeep(0);

      Abort;

   end;

end;



procedure TWTiposDiario.fcImageBtnMinimizarClick(Sender: TObject);

begin

   windowState := wsminimized;

end;



procedure TWTiposDiario.fcImageBtnMouseEnter(Sender: TObject);

begin

   (Sender as TfcImageBtn).Image.LoadFromFile(gvDirImagenes + gcBtnBlanco);

end;



procedure TWTiposDiario.fcImageBtnMouseLeave(Sender: TObject);

begin

   (Sender as TfcImageBtn).Image.LoadFromFile(gvDirImagenes + gcBtn);

end;



procedure TWTiposDiario.LimpiarFiltro(Sender: TObject);

begin

   if not (TbFiltro.state in dseditmodes) then begin

      TbFiltro.edit;

   end;

   TbFiltro.FieldByName('BCODIGO').AsString      := '';

   TbFiltro.FieldByName('BDESCRIPCION').AsString := '';

end;



procedure TWTiposDiario.VerTabla(Sender: TObject);

begin

  {$Message Warn 'La instrucción WITH es ofuscadora de código`'}

   with TbFiltro do begin

      Edit;

      FieldByName('BCODIGO').AsString      := '';

      FieldByName('BDESCRIPCION').AsString := '';

      Post;

   end;

   PrepararQuery;

end;



end.