Tutorial vídeo club

[[José Luis Garcí]]

Para seguir con el módulo de usuarios y hacerlo bien antes he tenido que hacer el de capturas desde la webcam



A la izquierda del todo es un panel, los 5 speedbuton que veis y un timagen a la derecha. Este es el código

Código Delphi [-]
unit UCapturas;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Webcam, Buttons, ExtCtrls, jpeg, Clipbrd;      //Añadimos la unit WEBCAM y Jpeg

type
  TFCapturas = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Image1: TImage;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SpeedButton4: TSpeedButton;
    procedure SpeedButton5Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    camera: TWebcam;  //Para la webcam
  end;

var
  FCapturas: TFCapturas;

implementation

{$R *.dfm}

USES UDM,UUsuarios;

procedure TFCapturas.FormCreate(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************************[ FormCreate ]*****
//------------------------------------------------------------------------------
begin
  camera := TWebcam.Create('WebCaptured', Panel1.Handle, 0, 0,1000, 1000);
end;

procedure TFCapturas.SpeedButton1Click(Sender: TObject);
//------------------------------------------------------------------------------
//****************************************************************[ Salir ]*****
// Cierra el formulario de capturas
//------------------------------------------------------------------------------
begin
   camera.Disconnect;
   (Sender as TSpeedButton).Caption:='Apagar camara';
   Close;
end;

procedure TFCapturas.SpeedButton2Click(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************************[ Pasar foto ]*****
// Pasa la imagen y cierra el formulario de capturas
//------------------------------------------------------------------------------
var JPGImage: TJPEGImage;
    Clip: TClipboard;
    AData: THandle;
    APalette: hPalette;
begin
   JPGImage:= TJPEGImage.Create;
   JPGImage.Assign(Image1.Picture.Bitmap);
   JPGImage.SaveToClipboardFormat(CF_PICTURE, AData,APalette);
   if VarSUnidad='UUSUARIOS' then FUsuarios.DBImage1.Picture.LoadFromClipboardFormat(CF_PICTURE, AData,APalette);
   JPGImage.Free;
   camera.Disconnect;
   SpeedButton5.Caption:='Apagar camara';
   Close;

end;

procedure TFCapturas.SpeedButton3Click(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************************[ Captura ]*****
//------------------------------------------------------------------------------
var
  PanelDC: HDC;
begin
if not Assigned(Image1.Picture.Bitmap) then Image1.Picture.Bitmap := TBitmap.Create
  else
  begin
    Image1.Picture.Bitmap.Free;
    Image1.picture.Bitmap := TBitmap.Create;
  end;
  Image1.Picture.Bitmap.Height := Panel1.Height;
  Image1.Picture.Bitmap.Width  := Panel1.Width;
  Image1.Stretch := True;
  PanelDC := GetDC(Panel1.Handle);
  try
    BitBlt(Image1.Picture.Bitmap.Canvas.Handle,0,0,Panel1.Width, Panel1.Height, PanelDC, 0,0, SRCCOPY);
  finally
    ReleaseDC(Handle, PanelDC);
  end;
end;

procedure TFCapturas.SpeedButton4Click(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************************[ Iniciar cámara ]*****
//------------------------------------------------------------------------------
begin
  camera.Connect;
  camera.Preview(true);
  Camera.PreviewRate(4);
  SpeedButton4.Enabled:=False;
  SpeedButton5.Enabled:=True;
  SpeedButton5.Caption:='Apagar camara';
end;

procedure TFCapturas.SpeedButton5Click(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************[ Encender/apagar cámara ]*****
//------------------------------------------------------------------------------
const //Gran parte de este código ha sido bajado de http://www.clubdelphi.com/foros/showthread.php?t=67582
  str_Connect = 'Encender la camara';
  str_Disconn = 'Apagar la camara';
begin
  if (Sender as TSpeedButton).Caption = str_Connect then  begin

    camera.Connect;
    camera.Preview(true);
    Camera.PreviewRate(4);
    (Sender as TSpeedButton).Caption:=str_Disconn;
  end
  else begin
    camera.Disconnect;
    (Sender as TSpeedButton).Caption:=str_Connect;
  end;
END;

end.

Podéis ver que llamamos a una unit webcam este es su código

Código Delphi [-]
unit Webcam;
interface
uses
  Windows, Messages;
type
  TWebcam = class
    constructor Create(
      const WindowName: String = '';
      ParentWnd: Hwnd = 0;
      Left: Integer = 0;
      Top: Integer = 0;
      Width: Integer = 0;
      height: Integer = 0;
      Style: Cardinal = WS_CHILD or WS_VISIBLE;
      WebcamID: Integer = 0);
    public
      const
        WM_Connect     = WM_USER + 10;
        WM_Disconnect  = WM_USER + 11;
        WM_GrabFrame   = WM_USER + 60;
        WM_SaveDIB     = WM_USER + 25;
        WM_Preview     = WM_USER + 50;
        WM_PreviewRate = WM_USER + 52;
        WM_Configure   = WM_USER + 41;
    public
      procedure Connect;
      procedure Disconnect;
      procedure GrabFrame;
      procedure SaveDIB(const FileName: String = 'webcam.bmp');
      procedure Preview(&on: Boolean = True);
      procedure PreviewRate(Rate: Integer = 42);
      procedure Configure;
    private
      CaptureWnd: HWnd;
  end;
implementation
function capCreateCaptureWindowA(
  WindowName: PChar;
  dwStyle: Cardinal;
  x,y,width,height: Integer;
  ParentWin: HWnd;
  WebcamID: Integer): Hwnd; stdcall external 'AVICAP32.dll';
{ TWebcam }
procedure TWebcam.Configure;
begin
  if CaptureWnd <> 0 then
    SendMessage(CaptureWnd, WM_Configure, 0, 0);
end;
procedure TWebcam.Connect;
begin
  if CaptureWnd <> 0 then
    SendMessage(CaptureWnd, WM_Connect, 0, 0);
end;
constructor TWebcam.Create(const WindowName: String; ParentWnd: Hwnd; Left, Top,
  Width, height: Integer; Style: Cardinal; WebcamID: Integer);
begin
  CaptureWnd := capCreateCaptureWindowA(PChar(WindowName), Style, Left, Top, Width, Height,
    ParentWnd, WebcamID);
end;
procedure TWebcam.Disconnect;
begin
  if CaptureWnd <> 0 then
    SendMessage(CaptureWnd, WM_Disconnect, 0, 0);
end;
procedure TWebcam.GrabFrame;
begin
  if CaptureWnd <> 0 then
    SendMessage(CaptureWnd, WM_GrabFrame, 0, 0);
end;
procedure TWebcam.Preview(&on: Boolean);
begin
  if CaptureWnd <> 0 then
    if &on then
      SendMessage(CaptureWnd, WM_Preview, 1, 0)
    else
      SendMessage(CaptureWnd, WM_Preview, 0, 0);
end;
procedure TWebcam.PreviewRate(Rate: Integer);
begin
  if CaptureWnd <> 0 then
    SendMessage(CaptureWnd, WM_PreviewRate, Rate, 0);
end;
procedure TWebcam.SaveDIB(const FileName: String);
begin
  if CaptureWnd <> 0 then
    SendMessage(CaptureWnd, WM_SaveDIB, 0, Cardinal(PChar(FileName)));
end;
end.

Comentar que en el DataModule (DM) esta la variable fija VarSUnidad, a la que le hemos asignado el valor de UUSUARIOS desde el módulo de usuarios, cuando estemos en clientes haremos los mismo pero dando el nombre de clientes, así el mismo módulo sirve para varios apartados, igual pasa con el editor aunque este trabajara con ciertas diferencias.

[[José Luis Garcí]]

En el módulo Ueditor cambiamos el siguiente procedimiento para que sepamos a que unidad debemos devolver el dato

Código Delphi [-]
procedure TFeditor.SBOkClick(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************************[ SBOk ]*****
// Graba los datos en la variable y salimos
//------------------------------------------------------------------------------
begin
   VarSMEMO:=Memo1.Lines.Text;
   if VarSUnidad='UUSUARIOS' then FUsuarios.MEmoNotas.Lines:=Memo1.Lines;
   Close;
end;

[[José Luis Garcí]]

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;    //Añadimos la unit WEBCAM

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
    { Private declarations }
  public
    { Public declarations }

  end;

var
  FUsuarios: TFUsuarios;

implementation

{$R *.dfm}

USES UDM,UEditor,funciones,UCapturas;

procedure TFUsuarios.comprobar;
//------------------------------------------------------------------------------
//************************************************************[ 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);
//------------------------------------------------------------------------------
//******************************************************[ Cambia de datos ]*****
//------------------------------------------------------------------------------
begin
   comprobar;
end;

procedure TFUsuarios.FormActivate(Sender: TObject);
//------------------------------------------------------------------------------
//**********************************************************[ On Activate ]*****
//------------------------------------------------------------------------------
begin
   comprobar;
   if VarIModoApertura=1 then  SBNuevoClick(sender);

end;

procedure TFUsuarios.FormKeyPress(Sender: TObject; var Key: Char);
//------------------------------------------------------------------------------
//************************************************[  Al pulsar una tecla ]******
// Al pulsar la tecla salta al foco del siguiente componente, si esta admitido
//------------------------------------------------------------------------------
begin
    if (Key = #13) then {Si se ha pulsado enter }
    if (ActiveControl is TEdit)
    or (ActiveControl is TDBEdit)
    or (ActiveControl is TDBComboBox) then
    begin
      Key := #0; { anula la puulsación }
      Perform(WM_NEXTDLGCTL, 0, 0); { mueve al próximo control }
    end
end;

procedure TFUsuarios.SbBajarClick(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************************[ SBBajar ]*****
//------------------------------------------------------------------------------
begin
  DsPrincipal.DataSet.Prior;
end;

procedure TFUsuarios.SBBorrarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Borrar el Actual Registro ]******
//------------------------------------------------------------------------------
begin                                //Cambiar por el mensaje elegido
   if (MessageBox(0, '¿Esta seguro  de eliminar el registro actual?',   //Aqui no se porque me manda la última comilla simple y la coma a la linea de abajo, por favor subir al final de la linea anterior
   '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);
//------------------------------------------------------------------------------
//******************************************************[ Abrir Búsqueda ]******
//------------------------------------------------------------------------------
begin
   Botonera2.Visible:=True;
   Edit1.SetFocus;
end;

procedure TFUsuarios.SBCargarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*********************************************************[ Cargar imagen ]****
//------------------------------------------------------------------------------
begin
  CargaIimagenADBImagen(OpenPictureDialog1,DBImage1);
end;

procedure TFUsuarios.SBEditarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Editar el actual registro ]******
//------------------------------------------------------------------------------
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);
//------------------------------------------------------------------------------
//******************************************************[ Editor del memo ]*****
//------------------------------------------------------------------------------
begin
     VarSUnidad:='UUSUARIOS';
     VarSMEMO:=MEmoNotas.Lines.Text;
     Feditor.Memo1.Lines:=MEmoNotas.Lines;
     Feditor.Show;
end;

procedure TFUsuarios.SBNuevoClick(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************************[ SBnuevo ]*****
//------------------------------------------------------------------------------
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);
//------------------------------------------------------------------------------
//**************************************************************[ SBSalir ]*****
//------------------------------------------------------------------------------
begin
  Close;
end;

procedure TFUsuarios.sbSubirClick(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************************[ SBSubir ]*****
//------------------------------------------------------------------------------
begin
  DsPrincipal.DataSet.Next;
end;

procedure TFUsuarios.SBWebCamClick(Sender: TObject);
//------------------------------------------------------------------------------
//***************************************************************[ Webcam ]*****
//------------------------------------------------------------------------------
begin
  VarSUnidad:='UUSUARIOS';
  FCapturas.show;
end;

procedure TFUsuarios.SpeedButton16Click(Sender: TObject);
//------------------------------------------------------------------------------
//****************************************************[ Salir de búsqueda ]*****
//------------------------------------------------------------------------------
begin
   Edit1.Text:='';
   Botonera2.Visible:=False;
end;

procedure TFUsuarios.SpeedButton17Click(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************[ ejecutamos la búsqueda ]*****
//------------------------------------------------------------------------------
begin
   DSPrincipal.DataSet.Locate('NOMBRE',Edit1.Text,[loCaseInsensitive,loPartialKey]);
end;

procedure TFUsuarios.SpeedButton8Click(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************[ Cancelar Proceso]******
//------------------------------------------------------------------------------
begin
  if DsPrincipal.DataSet.State in [dsEdit,dsInsert] then DSPrincipal.DataSet.Cancel;
  DM.IBT.RollbackRetaining;   //Donde IBT es el nombre de su Ibtrasaction, con ruta
  PanelOculto.Visible:=False;
  Botonera1.Enabled:=True;
  PanelMover.Enabled:=True;
  PanelDatos.Enabled:=False;
end;

procedure TFUsuarios.SpeedButton9Click(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************************[ Grabar datos ]******
//------------------------------------------------------------------------------
 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;    //Donde IBT es el nombre de su Ibtrasaction, con ruta
    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;    //Donde IBT es el nombre de su Ibtrasaction, con ruta
    end;
  end;

  PanelOculto.Visible:=False;
  PanelDatos.Enabled:=False;
  Botonera1.Enabled:=True;
  PanelMover.Enabled:=True;
end;

procedure TFUsuarios.SBMasClick(Sender: TObject);
//------------------------------------------------------------------------------
//****************************************************************[ SBMas ]*****
// Aumenta en 1  el nivel del usuario
// No dejando que supere el 9
//------------------------------------------------------------------------------
begin
  if DBENivel.Field.Value<9 then DBENivel.Field.value:=DBENivel.Field.value+1;
end;

procedure TFUsuarios.SBMenosClick(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************************[ SBMenos ]*****
// Disminuye 1  el nivel del usuario
// No dejando que sea inferior a 1
//------------------------------------------------------------------------------
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);
//------------------------------------------------------------------------------
//***************************************************************[ Webcam ]*****
//------------------------------------------------------------------------------
begin
  VarSUnidad:='UUSUARIOS';
  FCapturas.show;
end;

O al editor

Código Delphi [-]
procedure TFUsuarios.SBEditMemoClick(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************************[ Editor del memo ]*****
//------------------------------------------------------------------------------
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);
//------------------------------------------------------------------------------
//*******************************************[ Editar el actual registro ]******
//------------------------------------------------------------------------------
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

[[José Luis Garcí]]

Este es el módulo de funciones hasta este momento

Código Delphi [-]
unit Funciones;

interface

uses ExtDlgs,DBCtrls, Graphics,Clipbrd, SysUtils;



//------------------------------------------------------------------------------
//*************************************************[ CargaIimagenADBImagen ]****
//  Parte de la idea original de   ??? 09/06/2013
// bajada de http://www.planetadelphi.com.br/dica...-um-campo-blob
//------------------------------------------------------------------------------
// Pequeñas modificaciones y convertido a unción por mi permitiendo cargar varios
// tipos de imágenes diferentes
//------------------------------------------------------------------------------
//  [Dialog]  TOpenPictureDialog   Dialogo de cargad de la imagen
//  [Dbimage] TDBImage            El nº de cuenta de 10 digitos usar la funcion ceros
//------------------------------------------------------------------------------
//---EJEMPLO--------------------------------------------------------------------
//  CargaIimagenADBImagenOpenPictureDialog1,Dbimage1);
//------------------------------------------------------------------------------

function CargaIimagenADBImagen(Dialog:TOpenPictureDialog;Dbimage:TDBImage):Boolean;


 //------------------------------------------------------------------------------
//**********************************************************[ ENCRIPTAR ]*******
//  Encripta una cadena segun un valor integer
//  BAJADO DE AJPDSOFT
//------------------------------------------------------------------------------
function encriptar(aStr: String; aKey: Integer): String;



//------------------------------------------------------------------------------
//*******************************************************[ DESENCRIPTAR ]*******
//  Desencripta una cadena segun un valor integer (El mismo que para encriptarla
//  BAJADO DE AJPDSOFT
//------------------------------------------------------------------------------
function desencriptar(aStr: String; aKey: Integer): String;

implementation

//------------------------------------------------------------------------------
//*************************************************[ CargaIimagenADBImagen ]****
//  Parte de la idea original de   ??? 09/06/2013
// bajada de http://www.planetadelphi.com.br/dica...-um-campo-blob
//------------------------------------------------------------------------------
// Pequeñas modificaciones y convertido a unción por mi permitiendo cargar varios
// tipos de imágenes diferentes
//------------------------------------------------------------------------------
//  [Dialog]  TOpenPictureDialog   Dialogo de cargad de la imagen
//  [Dbimage] TDBImage            El nº de cuenta de 10 digitos usar la funcion ceros
//------------------------------------------------------------------------------
//---EJEMPLO--------------------------------------------------------------------
//  CargaIimagenADBImagenOpenPictureDialog1,Dbimage1);
//------------------------------------------------------------------------------

function CargaIimagenADBImagen(Dialog:TOpenPictureDialog;Dbimage:TDBImage):Boolean;
var imagem : TPicture;
begin
  if Dialog.Execute then
  begin
    try
      imagem:=TPicture.Create;
      imagem.LoadFromFile(Dialog.FileName);
      Clipboard.Assign(imagem);
      Dbimage.PasteFromClipboard;
      imagem.Free;
      Result:=True;
    except on E: Exception do
      Result:=False;
    end;
  end;
end;


//------------------------------------------------------------------------------
//**********************************************************[ ENCRIPTAR ]*******
//  Encripta una cadena segun un valor integer
//  BAJADO DE AJPDSOFT
//------------------------------------------------------------------------------
function encriptar(aStr: String; aKey: Integer): String;
begin
   Result:='';
   RandSeed:=aKey;
   for aKey:=1 to Length(aStr) do
       Result:=Result+Chr(Byte(aStr[aKey]) xor random(256));
end;


//------------------------------------------------------------------------------
//*******************************************************[ DESENCRIPTAR ]*******
//  Desencripta una cadena segun un valor integer (El mismo que para encriptarla
//  BAJADO DE AJPDSOFT
//------------------------------------------------------------------------------
function desencriptar(aStr: String; aKey: Integer): String;
begin
   Result:='';
   RandSeed:=aKey;
   for aKey:=1 to Length(aStr) do
       Result:=Result+Chr(Byte(aStr[aKey]) xor random(256));
end;

end.

Y estas las variables del módulo DM

Código Delphi [-]
var
  DM: TDM;
  VarSMEMO: string;
  Ventana: hwnd; //Handle de la ventana de captura
  VarSUnidad: string;
  VarBGrabarNumerador:Boolean;
  VarIModoApertura:Integer;
  VarSUsuario:string;
  VarINivelUSuario:Integer;

[[José Luis Garcí]]

Se me olvido comentar en el módulo de usuarios el procedure comprobar al que llamamos desde el onactive y desde el OnDataChange desde nuestro datasource

Código Delphi [-]
//------------------------------------------------------------------------------
//************************************************************[ 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;

Primero comprobamos que el formulario este activo
Luego que el datasoruce no este en edición o inserción en este momento
El siguiente paso es que la base de datos no este vacía
Y por último pasamos la traducción de la clave a un label y colocamos el texto que corresponde en nuestro memoNotas

[[José Luis Garcí]]

Ya por último en esta semana pondré parte del Onactive del menú, ya que en el nos aseguramos de 2 cosas, primero que la tabla configuración tenga unos datos básicos y segundo de crear un primer usuario con nivel supervisor.

Código Delphi [-]
//------------------------------------------------------------------------------
//***********************************************************[ OnActivate ]*****
//------------------------------------------------------------------------------
 var VarSClaveIntroducida:String;
begin
   if FMENU.Active=True then
   begin
       if DM.IBDConfiguracion.IsEmpty then
       begin
         try
           DM.IBDConfiguracion.Insert;
           DM.IBDConfiguracionNUMERADOR_CLIENTE.Value:=0;
           DM.IBDConfiguracionNUMERADOR_UNIDAD.Value:=0;
           DM.IBDConfiguracionNUMERADOR_VALOR_ALQUILER.Value:=0;
           DM.IBDConfiguracionNUMERADOR_ALQUILER.Value:=0;
           DM.IBDConfiguracionNUMERADOR_CAJA.Value:=0;
           DM.IBDConfiguracionNUMERADOR_MOVIMIENTOS.Value:=0;
           DM.IBDConfiguracionNUMERADOR_FORMATO.Value:=0;
           DM.IBDConfiguracionNUMERADOR_FORMA_PAGO.Value:=0;
           DM.IBDConfiguracionNUMERADOR_CARGOS.Value:=0;
           DM.IBDConfiguracionNUMERADOR_GENERO.Value:=0;
           DM.IBDConfiguracionNUMERADOR_USUARIOS.Value:=0;
           DM.IBDConfiguracionSEGUNDOS_RETENIDOS.Value:=2;
           DM.IBDConfiguracionSALTO_REGISTROS.Value:=20;
           DM.IBDConfiguracionCOLOR_DISPONIBLE.Value:='clmoneygreen';
           DM.IBDConfiguracionCOLOR_NO_DISPONIBLE.Value:='clwhite';
           DM.IBDConfiguracionCOLOR_BLOQUEADA.Value:='clred';
           DM.IBDConfiguracion.Post;
           ShowMessage('Se ha creado los datos mínimos de la configuración, debe terminar de rellenar los datos' +
                       'de configuración'+ Chr(13) + Chr(13)+
                       '   --- Este proceso no se volvera a repetir ---');
         except
            on E: Exception do
            begin
                MessageBeep(1000);
                ShowMessage('Se ha producido un error y el proceso no se ha podido terminar   Unidad:[ UMEnu ]   Modulo:[ OnActive ]' + 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');

                DM.IBT.RollbackRetaining;
            end;
         end;
       end;
       if DM.IBDUsuarios.IsEmpty then
       begin
         MessageBeep(1000);
         ShowMessage('SE va a crear el usuario supervisor. '+#13+#10+ #13+#10+
                     'Sin este no es posible crear nuevos usuarios'+#13+#10+ #13+#10+
                     'Recuerde los niveles son los siguientes:'+#13+#10+ #13+#10+
                     '[6] Usuario normal'+#13+#10+ #13+#10+
                     '[7] Usuario con privilegios (se le mostrará más información).'+#13+#10+ #13+#10+
                     '[8] Supervisor. Apartir de este nivel se crean los otros usuarios');
         VarIModoApertura:=1;
         FUsuarios.Show;
       end;

No pongo el resto para no liarla ya que tengo que corregir algunas cosas aun.


Ya sabéis como siempre espero vuestros comentarios, dudas, aportaciones y criticas. también me gustaría ver el diseño que le vais dando comentando que componente habéis usado.

[Ñuño Martínez]

Me despisto un poco, y la que lías, macho...

¿Has puesto un esquema Entidad/Relación de la base de datos? Porque no me parece haberla visto. Es una herramienta muy útil a la hora de diseñar bases de datos, y también ayuda a definir la lógica puesto que de un vistazo (casi) puedes ver todas las dependencias.

Y no uses [quote][/quote] para poner el código fuente, que para eso están las etiquetas de código fuente [delphi][/delphi], leñes... (Si quieres, un moderador puede cambiarlas por ti).