Bueno ya tengo terminado el módulo fuentes y algunas cosas más que ahora comentaré pero hoy no he terminado
Como ya dije esta es la única vez en colocare todo el código directamente así y lo comentaré salvo que entremos en cosas nuevas.
Código Delphi
[-]unit UUsuarios;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, Buttons, DBCtrls, ComCtrls, ExtCtrls, StdCtrls, Grids, DBGrids,
Mask, ExtDlgs;
type
TFUsuarios = class(TForm)
Botonera1: TPanel;
Botonera2: TPanel;
StatusBar1: TStatusBar;
DBNavigator1: TDBNavigator;
SBNuevo: TSpeedButton;
SBEditar: TSpeedButton;
SBBorrar: TSpeedButton;
SBSalir: TSpeedButton;
SBBuscar: TSpeedButton;
DsPrincipal: TDataSource;
Panelcontenedor: TPanel;
PanelDatos: TPanel;
Label1: TLabel;
DBECodigo: TDBEdit;
Label2: TLabel;
DBENombre: TDBEdit;
Label3: TLabel;
DBEClave: TDBEdit;
Label4: TLabel;
DBETelefono: TDBEdit;
Label5: TLabel;
DBEMovil: TDBEdit;
Label6: TLabel;
DBEEmail: TDBEdit;
Label7: TLabel;
DBImage1: TDBImage;
Notas: TLabel;
MEmoNotas: TMemo;
DBENivel: TDBEdit;
SBMas: TSpeedButton;
Label8: TLabel;
SBMenos: TSpeedButton;
PanelOculto: TPanel;
SpeedButton8: TSpeedButton;
SpeedButton9: TSpeedButton;
SpeedButton10: TSpeedButton;
SBEditMemo: TSpeedButton;
SpeedButton12: TSpeedButton;
SBWebCam: TSpeedButton;
SBCargar: TSpeedButton;
DBGrid1: TDBGrid;
PanelMover: TPanel;
sbSubir: TSpeedButton;
SbBajar: TSpeedButton;
Label9: TLabel;
Edit1: TEdit;
SpeedButton16: TSpeedButton;
SpeedButton17: TSpeedButton;
OpenPictureDialog1: TOpenPictureDialog;
Label10: TLabel;
procedure SBSalirClick(Sender: TObject);
procedure sbSubirClick(Sender: TObject);
procedure SbBajarClick(Sender: TObject);
procedure SBNuevoClick(Sender: TObject);
procedure SBEditarClick(Sender: TObject);
procedure SBBorrarClick(Sender: TObject);
procedure SBBuscarClick(Sender: TObject);
procedure SBMasClick(Sender: TObject);
procedure SBMenosClick(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure SpeedButton8Click(Sender: TObject);
procedure SpeedButton9Click(Sender: TObject);
procedure SBCargarClick(Sender: TObject);
procedure SBWebCamClick(Sender: TObject);
procedure SBEditMemoClick(Sender: TObject);
procedure SpeedButton17Click(Sender: TObject);
procedure SpeedButton16Click(Sender: TObject);
procedure DsPrincipalDataChange(Sender: TObject; Field: TField);
procedure FormActivate(Sender: TObject);
procedure comprobar;
private
public
end;
var
FUsuarios: TFUsuarios;
implementation
{$R *.dfm}
USES UDM,UEditor,funciones,UCapturas;
procedure TFUsuarios.comprobar;
begin
if FUsuarios.Active then
begin
if not (DsPrincipal.DataSet.State in [dsEdit,dsInsert]) then
begin
if not (DM.IBDUsuarios.IsEmpty) then
begin
if DBEClave.Text<>'' then Label10.Caption:=desencriptar(dbeclave.Field.Value,2112) else Label10.Caption:='';
if DsPrincipal.DataSet.FieldByName('NOTAS').Value<>'' then MEmoNotas.Lines.Text:=DsPrincipal.DataSet.FieldByName('NOTAS').AsString
else MEmoNotas.Lines.Clear;
end;
end;
end;
end;
procedure TFUsuarios.DsPrincipalDataChange(Sender: TObject; Field: TField);
begin
comprobar;
end;
procedure TFUsuarios.FormActivate(Sender: TObject);
begin
comprobar;
if VarIModoApertura=1 then SBNuevoClick(sender);
end;
procedure TFUsuarios.FormKeyPress(Sender: TObject; var Key: Char);
begin
if (Key = #13) then
if (ActiveControl is TEdit)
or (ActiveControl is TDBEdit)
or (ActiveControl is TDBComboBox) then
begin
Key := #0;
Perform(WM_NEXTDLGCTL, 0, 0);
end
end;
procedure TFUsuarios.SbBajarClick(Sender: TObject);
begin
DsPrincipal.DataSet.Prior;
end;
procedure TFUsuarios.SBBorrarClick(Sender: TObject);
begin if (MessageBox(0, '¿Esta seguro de eliminar el registro actual?', 'Eliminar Registro', MB_ICONSTOP or MB_YESNO or MB_DEFBUTTON2) = ID_No) then abort
else begin
DSPrincipal.DataSet.Delete;
DM.IBT.CommitRetaining;
ShowMessage('El registro ha sido eliminado');
end;
end;
procedure TFUsuarios.SBBuscarClick(Sender: TObject);
begin
Botonera2.Visible:=True;
Edit1.SetFocus;
end;
procedure TFUsuarios.SBCargarClick(Sender: TObject);
begin
CargaIimagenADBImagen(OpenPictureDialog1,DBImage1);
end;
procedure TFUsuarios.SBEditarClick(Sender: TObject);
begin
if DsPrincipal.DataSet.IsEmpty<>true then
begin
DSPrincipal.DataSet.Edit;
PanelDatos.Enabled:=True;
PanelOculto.Visible:=True;
PanelMover.Enabled:=False;
Botonera1.Enabled:=false;
DBEClave.Field.Value:=desencriptar(dbeclave.Field.Value,2112);
DBENombre.SetFocus;
end else ShowMessage('No hay tregistros disponibles para editar')
end;
procedure TFUsuarios.SBEditMemoClick(Sender: TObject);
begin
VarSUnidad:='UUSUARIOS';
VarSMEMO:=MEmoNotas.Lines.Text;
Feditor.Memo1.Lines:=MEmoNotas.Lines;
Feditor.Show;
end;
procedure TFUsuarios.SBNuevoClick(Sender: TObject);
var VarIRegistro:Integer;
begin
DsPrincipal.DataSet.Insert;
VarIRegistro:=DM.IBDConfiguracionNUMERADOR_USUARIOS.Value;
VarIRegistro:=VarIRegistro+1;
DBECodigo.Field.Value:=IntToStr(VarIRegistro);
MEmoNotas.Lines.Clear;
if VarIModoApertura=1 then
begin
SBMas.Enabled:=False;
SBMenos.Enabled:=False;
DBENivel.Field.Value:=8;
end else DBENivel.Field.Value:=5;
PanelDatos.Enabled:=True;
PanelOculto.Visible:=True;
PanelMover.Enabled:=False;
Botonera1.Enabled:=false;
VarIModoApertura:=0;
DBENombre.SetFocus;
end;
procedure TFUsuarios.SBSalirClick(Sender: TObject);
begin
Close;
end;
procedure TFUsuarios.sbSubirClick(Sender: TObject);
begin
DsPrincipal.DataSet.Next;
end;
procedure TFUsuarios.SBWebCamClick(Sender: TObject);
begin
VarSUnidad:='UUSUARIOS';
FCapturas.show;
end;
procedure TFUsuarios.SpeedButton16Click(Sender: TObject);
begin
Edit1.Text:='';
Botonera2.Visible:=False;
end;
procedure TFUsuarios.SpeedButton17Click(Sender: TObject);
begin
DSPrincipal.DataSet.Locate('NOMBRE',Edit1.Text,[loCaseInsensitive,loPartialKey]);
end;
procedure TFUsuarios.SpeedButton8Click(Sender: TObject);
begin
if DsPrincipal.DataSet.State in [dsEdit,dsInsert] then DSPrincipal.DataSet.Cancel;
DM.IBT.RollbackRetaining; PanelOculto.Visible:=False;
Botonera1.Enabled:=True;
PanelMover.Enabled:=True;
PanelDatos.Enabled:=False;
end;
procedure TFUsuarios.SpeedButton9Click(Sender: TObject);
var VarIFase:Integer;
begin
try
VarIFase:=1;
DM.IBDUsuariosCLAVE.Value:=encriptar(DM.IBDUsuariosCLAVE.Value,2112);
if DsPrincipal.DataSet.State in [dsInsert] then VarBGrabarNumerador:=True else VarBGrabarNumerador:=False;
if DsPrincipal.DataSet.State in [dsEdit,dsInsert] then DSPrincipal.DataSet.Post;
if VarBGrabarNumerador=true then
begin
VarIFase:=2;
DM.IBDConfiguracion.Edit;
DM.IBDConfiguracionNUMERADOR_USUARIOS.Value:=StrToInt(DBECodigo.Field.Value);
DM.IBDConfiguracion.Post;
VarBGrabarNumerador:=False;
end;
DM.IBT.CommitRetaining; if SBMas.Enabled=false then
begin
SBMas.Enabled:=True;
SBMenos.Enabled:=True;
end;
except
on E: Exception do
begin
MessageBeep(1000);
ShowMessage('Se ha producido un error y el proceso no se ha podido terminar Unidad:[ UUsuarios ] Modulo:[ Grabar ]' + Chr(13) + Chr(13)
+ 'Clase de error: ' + E.ClassName + Chr(13) + Chr(13)
+ 'Mensaje del error:' + E.Message+Chr(13) + Chr(13)
+ ' '+Chr(13) + Chr(13)
+ 'El proceso ha quedado interrumpido');
if DsPrincipal.DataSet.State in [dsEdit,dsInsert] then DSPrincipal.DataSet.Cancel;
DM.IBT.RollbackRetaining; end;
end;
PanelOculto.Visible:=False;
PanelDatos.Enabled:=False;
Botonera1.Enabled:=True;
PanelMover.Enabled:=True;
end;
procedure TFUsuarios.SBMasClick(Sender: TObject);
begin
if DBENivel.Field.Value<9 then DBENivel.Field.value:=DBENivel.Field.value+1;
end;
procedure TFUsuarios.SBMenosClick(Sender: TObject);
begin
if DBENivel.Field.Value>1 then DBENivel.Field.value:=DBENivel.Field.value-1;
end;
en
Podemos ver como simplemente llamamos a los formularios de capturas
Código Delphi
[-]procedure TFUsuarios.SBWebCamClick(Sender: TObject);
begin
VarSUnidad:='UUSUARIOS';
FCapturas.show;
end;
O al editor
Código Delphi
[-]procedure TFUsuarios.SBEditMemoClick(Sender: TObject);
begin
VarSUnidad:='UUSUARIOS';
VarSMEMO:=MEmoNotas.Lines.Text;
Feditor.Memo1.Lines:=MEmoNotas.Lines;
Feditor.Show;
end;
También tenemos la carga de una imagen mediante el siguiente código (al final pondré las funciones)
Código Delphi
[-]procedure TFUsuarios.SBEditarClick(Sender: TObject);
begin
if DsPrincipal.DataSet.IsEmpty<>true then
begin
DSPrincipal.DataSet.Edit;
PanelDatos.Enabled:=True;
PanelOculto.Visible:=True;
PanelMover.Enabled:=False;
Botonera1.Enabled:=false;
DBEClave.Field.Value:=desencriptar(dbeclave.Field.Value,2112);
DBENombre.SetFocus;
end else ShowMessage('No hay tregistros disponibles para editar')
end;
Pero en especial sería el botón nuevo, que no solo controla los paneles, además cargamos el numerador de configuración y controla si es el primer usuario marcándolo con el nivel de supervisor
En el caso de edición además hemos tenido en cuenta que la base no este vacía, evitando un error sin sentido muchas veces lo mismo que en el borrado
Confirmar hace varias cosas primero mira en que fase se puede producir el error, luego encripta la clave del usuario, para que no sea visible salvo desde el programa, luego añade el numerador el nuevo registro igualando el código y si no ha habido errores seguimos normalmente, cancelando todos los nuevos datos en caso contrario.
Creo que el resto es bastante sencillo.
Tened en cuenta que hay variables declarada en el DM y que no encontrareis en el formulario