67 respuestas en este tema

[Desart]

CREATE TABLE CAJA (
    ID        INTEGER NOT NULL,
    REGISTRO  VARCHAR(20),
    CONCEPTO  VARCHAR(100),
    CLIENTE   VARCHAR(20),
    USUARIO   VARCHAR(20),
    LIBRE     VARCHAR(80),
    CARGO     VARCHAR(100),
    FECHA     DATE,
    CANTIDAD  NUMERIC(15,4)
);

ALTER TABLE CAJA ADD CONSTRAINT PK_CAJA PRIMARY KEY (ID);

[Desart]

CREATE TABLE MOVIMIENTO (
    ID        INTEGER NOT NULL,
    REGISTRO  VARCHAR(20),
    CONCEPTO  VARCHAR(100),
    CLIENTE   VARCHAR(20),
    USUARIO   VARCHAR(20),
    LIBRE     VARCHAR(80),
    CARGO     VARCHAR(100),
    FECHA     DATE,
    CANTIDAD  NUMERIC(15,4)
);

ALTER TABLE MOVIMIENTO ADD CONSTRAINT PK_MOVIMIENTO PRIMARY KEY (ID);

[Desart]

CREATE TABLE ETIQUETAS (
    ID             INTEGER NOT NULL,
    FECHA          DATE,
    UNIDAD         VARCHAR(20),
    TITULO         VARCHAR(20),
    CODIGO_BARRAS  VARCHAR(20),
    USUARIO        VARCHAR(20),
    IMPRIMIDO      DOMSN /* DOMSN = CHAR(1) CHECK (VALUE IN ('S','N')) */
);

ALTER TABLE ETIQUETAS ADD CONSTRAINT PK_ETIQUETAS PRIMARY KEY (ID);

[Desart]

Creamos la tabla USUARIO y añadimos los campos telefono y movil, con esta de momento y esperemos que siga así están nuestras tablas

CREATE TABLE USUARIO (
    ID        INTEGER,
    NIVEL     INTEGER,
    CODIGO    VARCHAR(20) NOT NULL,
    NOMBRE    VARCHAR(80),
    CLAVE     VARCHAR(100),
    TELEFONO  VARCHAR(20),
    MOVIL     VARCHAR(20),
    EMAIL     VARCHAR(120),
    LIBRE     VARCHAR(80),
    NOTAS     BLOB SUB_TYPE 1 SEGMENT SIZE 80,
    FOTO      BLOB SUB_TYPE 0 SEGMENT SIZE 80
);

ALTER TABLE USUARIO ADD CONSTRAINT PK_USUARIO PRIMARY KEY (CODIGO);

[Desart]

Antes de proseguir con el tutorial nos toca algunas explicaciones para los más novatos , sobre todo algunos términos que suelo usar.

Los módulos de altas bajas y modificaciones o (ABM), son los módulos principales donde introduciremos los datos, pero algunos no tendrán muchas veces todas estas opciones aun así usare este termino muchas veces. Podréis encontrar otro tutorial mio sobre este tema y aplicare algunos de los conceptos en el en este.

Ahorraremos código usando un dbnavigator sólo para los movimientos entre registros, no teniendo que controlar así el Fist, Prior, Next y Last.

También usaremos un Dtasourse llamado Dsprincipal en cada formulario que mueva datos, añadiendo los restantes para otras tablas.

Por supuesto usaremos un Datamodule, que en mi caso llamare DM, donde tendremos nuestra base de datos y ibdataset principales, por cierto usaremos los componente IBX que vienen de forma nativa con delphi en este tutorial ya que como dije no quiero usar componentes de terceros ni míos propios.

Como vamos a trabajar con la idea de una pantalla táctil, usaremos botones grandes y por ello si es necesario, crearemos  sistemas algo más complejos para ciertos campos debido  a las limitaciones de ciertos componentes para usar en estos sistemas.

Para evitar ciertos errores comunes usaremos un sistema de paneles que nos evitaran ciertos quebraderos de cabeza, su distribución sera la siguiente:

Panel botornera: será el panel donde estarán todas las acciones posibles sobre movimiento, edición, creación y borrado de nuestra tabla/s, así como otras opciones como búsqueda, imprimir, etc.

Panel de datos: en este encontraremos los apartados los campos a rellenar y los grid con información, pero dentro de estos estarán dos paneles que haremos visibles en ciertas condiciones.

Panel ocultable: dentro de Panel de datos para información que será visible según elñ nivel del usuario.

Panel Confirmación: dentro de Panel de datos permite confirmar o cancelar los cambios o creación de datos

Panel de búsqueda: quedará fuera del panel de datos al igual que el de botonera y sólo se mostrará en el caso de querer hacer búsquedas, simples o más complejas.


¿Por que este lió de paneles y su control? por el simple motivo de que por un error podemos registrar los cambios en una tabla sin querer al pulsar sobre un botón deseado, o entrar en edición de un registro al pulsar sobre uno de sus campos, errores mucho más típico de lo que pensamos. Debo decir que para evitar estas cosas uso normalmente un componente mio que podéis buscar en los foros llamado panelDB, este nos ahorraría bastante código y trabajo, ya que esta conectado al datasource que queremos controlando de esta manera, que esta visible , editable, etc... automáticamente.


Creo que ya comente las colecciones de iconos usados, por lo que no usare ninguno que no este dentro de estas colecciones, si hace falta diré donde se encuentran.


Por su puesto explicaré las cosas una vez salvo que alguien no lo entienda, por lo que los primeros módulos serán algo más extensos que los siguientes.

Al estar diseñado para táctil, usaremos un menú basado en botones, pero también usare un menú normal, junto con un actionlist, para controlar las ejecuciones y no tener que estar repitiendo código. Para este motivo también usaremos muchas funciones.

Todas las funciones irán dentro de un módulo que llamaremos UFunciones.Pas, así no estarán desperdigadas por el programa y será más fácil controlarla.

En el modulo DM (Data module) también insertaremos varias variables , para ciertas operaciones que nos permitirán movernos de un form a otro sin tener que estar recordando donde estaba esa variable, llamándolas variables fijas.

Haré especial hincapié en ciertas partes de código sobre todo algunas funciones, ya que de estas  dependerán partes del programa.

Por último usaremos ciertos diálogos estándar en operaciones, como crear, editar, borra y las transacciones de error al grabar, aparte de estos habrá otros más que ya iremos viendo.

Después de todo esto, comenzamos con la aplicación de nuestro sistema en el tutorial, como tengo que ir creándolo lo iré explicando según vaya terminan dolo. haciendo alguna anotación especial sobre ciertos procesos antes.

[Desart]

Bueno ya estoy con el menú trabajando y debo deciros algunas cosas comunes para todos nuestros forms.

En todos llevaremos un statusbar en la parte baja y haremnos algunas cosas con el ya las iremos viendo más delante.

Todos nuestros paneles deben aparecer inicialmente centrados por lo que usaremos la propiedad position a poScreenCenter

También activaremos a true la propiedad Keypreview, para que detecte las pulsaciones del teclado en nuestro form

Y por supuesto usaremos mucho la propiedad aling, para distribuir nuestros componentes

Y el fom tendra un height de 800 por un width de 1000 en estado normal

[Desart]

Se que dije que primero haría el menú, pero para explicar ciertas características primero debo explicar el data module (DM) y como lo vamos con formando.

Lo primero lo creamos gracias al repositorio de Delphi, en el delphi 10 es Flie>New>Otther y luego dentro de Delphi File

Una vez lo tengamos añadimos el componente IBDataBase de la pestaña interbase, cambiamos su propiedad name por DB y en vez de rellenar las propiedades aquí hacemos lo siguiente




Rellenamos este pequeño formulario teniendo en cuenta lo siguiente



Después de esto añadimos un componente IBTransaction de la misma pestaña cambiamos el name por IBT y pulsamos en la propiedad defaultDatabase  seleccionando DB, luego pulsamos dos veces con el botón derecho sobre el y  seleccionamos como en la siguiente imagen




Con esto ya tenemos configurado la base de datos y la transacciones (quienes se aseguran de grabar los datos en las tablas)

Ahora añadimos dos IBDataSet uno sera para la configuración y otra para el usuario llamándolos IBDConfiguracion y IBDUsuarios, los seleccionamos a ambos y rellenamos su propiedad Database seleccionando DB con lo que nos rellena automáticamente la propiedad transaction con IBT.

Seleccionamos IBDUsuarios y pulsamos sobre SelectSQL haciendo lo siguiente

[img width=800 height=287]http://nsae02.casimages.net/img/2015/02/21/15022103545933831.jpg[/img]

Seguimos sobre la misma tabla y pulsamos en GeneratorFiled rellenando el siguiente formulario



Con esto activamos los campos auto incremento, por lo que debemos usar el generador adecuado a nuestra tabla, el campo de incremento, la cantidad a incrementar (Incrment By) y por último seleccionar el evento On Post para realizar este. Pulsamos Ok y esto también está configurado para esta tabla.

Seguimos en la misma tabla y pulsamos sobre el IBDUsuario con el ratón derecho saliendo el popmenu del el  seguimos los siguientes pasos

[img width=707 height=600]http://nsae02.casimages.net/img/2015/02/21/150221041330600213.jpg[/img]

En rojo y en más grande los números de los pasos a seguir, por lo que ahora explico el paso 3 y el 4, dentro del paso 3 tenemos las siguientes opciones:

[1] Elegimos el campo clave en este caso código
[2] Seleccionamos todos los campos sobre los que queremos actuar, normalmente todos
[3] Seleccionamos el Quoters Identifirs, para que nos registre adecuadamente los campos y sus valores
[4]  Seleccionamos el generate SQl con lo que nos muestra la pantalla 4 con los códigos necesarios para modificar, insertar, borrar y refrescar los datos en sus diversos apartados
[5] realmente debería ir en la siguiente pantalla con esto confirmamos los cambios

Ya nos quedan dos pasos con esta tabla y terminamos, el siguiente aunque lioso nos permite mejorar la vista de nuestros datos y el siguiente es mucho más sencillo lo prometo.

Para el primero volvemos a pulsar sobre el IBDUsuario con el ratón derecho saliendo el popmenu, seleccionamos la primera opción y seguimos los siguientes pasos


[img width=509 height=600]http://nsae02.casimages.net/img/2015/02/21/150221042708649761.jpg[/img]

[1] Es el formulario que nos sale tras elegir la opción, pulsamos con el botón derecho del ratón saliendo un nuevo popmenu
[2] Elegimos añadir todos los campos
[3] Así nos queda ahora con los campos de nuestra taba añadidos
[4] Ahora podemos usar el inspector de objeto y cambiar campos como los siguientes

DisplayLabel: la etiqueta con la que aparecerá nuestros campos
DisplayWidth: el número de caracteres a mostrar de nuestra etiqueta
EditFormat: el formato de entrada y mostrar nuestros datos usando máscaras para ellos como  #,##0.00

Hay muchas más pero no es que nos interesen demasiado ahora salvo tal vez el Maxvalue y Minvalue para cierto campo que ya veremos

Bueno con esto  sólo quedaría ahora activar nuestra tabla  colocándonos nuevamente sobre el IBDUsuario y pulsando sobre la propiedad active a true, si no ha habido problemas así se quedará.

[Desart]

Con esto ya hemos aprendido a usar las tablas de nuestra base de datos con los componentes IBX de interbase, tienen ciertas limitaciones que ya comentaré en breve, ahora deberíais hacer lo mismo con la de configuración, pero teniendo en cuenta que es para la tabla configuración y no usuarios.

No se si podre poneros algo más hoy pero si os pondré para que sirve el editar los campos de la tabla

Tener en cuenta que esto no sirve salvo como demostración para ellos crear un nuevo formulario dentro de vuestra aplicación que luego vamos a eliminar.



Como ya digo esto no sirve de nada salvo como demostración de la utilidad de este sistema. Podéis ver que tenemos el listado de campos de la tabla usuarios (IBDUusario) al lado, seleccionaremos todos los campos menos notas (en poco os explico por qué).



Como veréis tampoco he cogido el campo ID ya que no sería de utilidad aquí. Pulsamos con el botón izquierdo de nuestro ratón y mantenemos pulsado  el mismo mientras lo soltamos donde queremos dentro del formulario, saltándonos el siguiente aviso



Este nos dice básicamente que no  hay conección entre el Datamodule (DM) y este form si queremos crearlo le damos al Ok y ved lo que pasa

[img width=800 height=406]http://nsae02.casimages.net/img/2015/02/21/150221045011846441.jpg[/img]

Como veis nos ha creado las etiquetas de los campos con los valores como los hemos modificado, añadiendo un datasourse que esta conectado a IBDUsuarios dentro del data module.

Como ya he dicho este ejemplo es sólo eso ya que no tenemos control aun sobre los procesos, pero esto es lo que haremos con los campos una vez editados, viéndose así en los dbgrid y demás conexiones con los campos que hagamos. Por su puesto en vez de arrastrando todos podemos arrastrar uno por uno y colocandolos donde queremos, pero eso como veáis.

Advertiros que en tablas con muchos campos, estos datos desaparecen de la vista, por lo que debéis ser cautos al usar este sistema,seleccionando pocos campos a la vez.

Podéis seleccionar los campos  manteniendo la tecla Shift después de seleccionar el primer campo y eligiendo el último antes de soltarla, así todos los que estén entra ambos quedarán seleccionados.

Bueno por hoy es todo, intentare mañana proseguir con ejemplo de formularios, el menú, ciertos procesos y demás.

[Desart]

Buenos días, lo prometido es deuda, así que empecemos con algo sencillo, será convertir el punto del teclado numérico en una coma, para los decimales, respetando el del teclado normal, para ello debemos hacer lo siguiente.

//Uses  ShellAPI ///1

//-----------------------------------------------------

//Después del TYPE
procedure ApplicationEvents1Message(var Msg: tagMSG;var Handled: Boolean); //2
//-----------------------------------------------------

var
  FMenu: TFMenu;  //O como se llame nuestro primer formulario
  MapearPuntoAComa: Boolean;  //3
implementation

//-----------------------------------------------------

procedure TFMenu.ApplicationEvents1Message(var Msg: tagMSG;var Handled: Boolean); //4
//-------------------------------------------------------------------------------
//*******************************[DEcimal del teclado númerico el . por coma]****
//-------------------------------------------------------------------------------
begin

  if MapearPuntoAComa AND (Msg.message = WM_KEYDOWN) AND
    (Msg.wParam = VK_DECIMAL) AND (DecimalSeparator = ',') then
  begin
    Msg.message := WM_CHAR;  // cambiamos el tipo de mensaje
    Msg.wParam := 44;  // si omitimos la línea anterior, aquí sería Msg.wParam := 188;
    Handled := FALSE;
  end;
  //Se puede activar o desactivar a la entrada y sadila de componentes
end;

procedure TFMenu.FormCreate(Sender: TObject);  //5
begin
  MapearPuntoAComa:=True;
  Application.OnMessage:=ApplicationEvents1Message;
end;

Como veis lo he dividido en cinco partes y aunque creo que esta claro lo explicare un poco
1: en donde metemos las unit que usamos para nuestros componentes y funciones por defecto de delphi, llamamos al ShellApi
2:Declaramos un procedimiento estándar de delphi
3:Donde esta declarada nuestra variable del form de la unidad principal añadimos la variable MapearPuntoAComa
4:rellenamos el procedimiento descrito en el punto 2
5: añadimos al evento OnCreate de diño form  la linea MapearPuntoAComa: Boolean; y la linea siguiente


Y con esto tenemos el resultado que buscabamos

[Desart]

Bueno estoy trabajando en las form, más adelante hoy pondré la de usuarios terminada y algo de código de la del menú.



Como veis el menú aun le falta mucho, pero ya podemos ver los paneles de la botonera, hay cosas que quitar y sobre todo corregir, pero indica parte del camino ya veremos como ir perfilandolo

[img width=747 height=600]http://nsae02.casimages.net/img/2015/02/22/150222122215961511.jpg[/img]

Aunque la pantalla de usuario no esta terminada ni por asomo., podemos ver como ira quedando y voy a a explicar un poco el diseño y uso de paneles

1:  Como podemos apreciar en este apartado tenemos  1 panel (Botonera1) 1 Dbnavigator, del que hemos seleccionado de su propiedad VisibleButtons, los cuatro primeros y hemos dejado el nombre por defecto (DbNavigator1) y 5 Spedbuttons que hemos llamado SBNuevo, SBEdit, SBBorrar, SBBuscar y SBSalir, tanto el dbnavigator como los 4 primeros speddbutton estan alineados a la izquierda, mientras que el último está alineado a la derecha

El panel tiene un height de 81, los speddbuttons tien un width de 80 y el del dbnavigator de 304.

El panel inicialmente esta enble y visible, pero su estado enable cambiara a false cuando entremos a insertar o modificar un registro.

//--------------------------

2: Panel de datos (PanelDatos) contendrá la información de nuestros campo para que los editemos, como podemos ver tanto los campos nivel como código tienen un color diferente, ya que se los he cambiado ya que los he puesto en enable=False, ya vereis por que.

Este panel es de tamaño fijo y dentro de el podemos ver lo puntos 3 y 4 que luego explicaremos.

El estado inicial de este panel es enable=false cambiando cuando entremos en edición o inserción de datos.

Los campos son la mayoría dbedits, cada uno se llamara inicialmente DBE y el campo que el, por ejemplo nivel sería DBENivel, mientras que código seria DBECódigo

También podemos ver un DBImagen, al que no le cambiare el nombre ya que es único en el formulario

Y por último tenemos un Memo al que he llamado  MemoNotas, el motivo de no usar un DBMEMO es que los componentes IBX  con Firebird dan problemas directamente con los componentes dbMemo  estándar de Delphi, por lo que haremos el trabajo a pelo y usaremos un editor para el.

Realmente deberíamos usar un editor para los campos también, pero confiaremos en el sistema táctil de windows y dejaremos que el ponga su propio teclado, también podríamos hacerlo para el memo, pero quiero que veáis las dos opciones.

//----------------------------------

3:  Para el DBnivel he añadido dos spedbuttons llamados SBmas y SBMenos, cada pulsación aumentara o disminuirá el nivel del usuario dentro de unos limites claro  y estos están contenidos dentro del PanelDatos

//-----------------------------------

4: Otro Panel (PanelOculto) este contendrá los botones necesarios para ciertos campos, así como la confirmación o cancelación del registro. Su contenido en este caso es el siguiente  SbCargarImagen, SbWebCam, SBEditMemo, SBConfirmar y SBCancelar, el primero carga una imagen, el segundo obtiene una imagen des de cámaras webcan (De muchos modelos), el tercero abre el editor del memo, el cuarto confirma los cambios y el último cancela el registro.

Este panel está oculto hasta que pulsemos nuevo o editar, volviéndose a ocultar en cuanto le demos a confirmar o cancelar

Podéis ver que hay varios Speedbuttons que están en enable=False, el motivo es que ahora los uso de separadores, ya que salvo los dos últimos estan alineados a la izquierda, mientras que los de confirmar y cancelar lo están a la derecha. Los botones no usados pueden estar enables por tener utilidad en otros momentos, ya lo veremos más adelante.

//----------------------------------

5: Es un dbgrid y he dejado el nombre que tenia, por supuesto queda organizar su aspecto. Lo he puesto en enable False

//---------------------------------

6: Panel mover (PanelMover) es una tontería de panel que podemos eliminar ya que sus opciones subir y bajar también las podemos usar con el DBNavigator, en este caso lo dejare a modo de que los que no tiene experiencia, puedan ver como movernos por los registros sin usar un dbnavigator, pero sólo aumenta el trabajo y no lo pondré en otras pantallas. Tendrá los mismo controles que el Botonera1

//-----------------------------------

7:  Panel botonera 2 (Botonera2) este panel solo se pone visible cuando pulsemos búsqueda y en este caso será muy sencillo usando un simple locate, pero en otros casos será mucho más complejo su uso, ademas tiene los spedbuttons SBSalirBusqueda y SBEncontrar, supongo que se entiende su utilidad. Además tiene un edit que he dejado como tal
//-----------------------------------


Debo comentaros que los puntos 2,3,4,5,6 están dentro de otro panel que he llamado panelcontenedor y que para la distribución de los paneles y demás he usado mucho la propiedad Align

[Desart]

Primer campo que Faltaba  ,  Hay que añadir a la tabla configuración el campo NUMERADOR_USUARIO tipo integer

[Desart]

Vamos con el editor, lo he hecho muy simple y aunque ahora no lo entendáis en cuanto ponga el modulo de usuarios lo entenderéis bien



Y este es su código, aunque normalmente pondré un enlace para poner los módulos completo, este lo hago al ser pequeño

unit UEditor;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, Keyboard, StdCtrls, ExtCtrls;

type
  TFeditor = class(TForm)
    Panel1: TPanel;
    Memo1: TMemo;
    TouchKeyboard1: TTouchKeyboard;
    SBRecarga: TSpeedButton;
    SBBlanco: TSpeedButton;
    SBCancelar: TSpeedButton;
    SBOk: TSpeedButton;
    procedure SBBlancoClick(Sender: TObject);
    procedure SBRecargaClick(Sender: TObject);
    procedure SBOkClick(Sender: TObject);
    procedure SBCancelarClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Feditor: TFeditor;

implementation

{$R *.dfm}

uses UDM;

procedure TFeditor.SBBlancoClick(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************************************[ SBBlanco ]*****
// Pone el memo en blanco
//------------------------------------------------------------------------------
begin
  Memo1.Lines.Clear;
end;

procedure TFeditor.SBCancelarClick(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************************[ SBCancelar ]*****
// No graba los datos salimos
//------------------------------------------------------------------------------
begin
  Close;
end;

procedure TFeditor.SBOkClick(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************************[ SBOk ]*****
// Graba los datos en la variable y salimos
//------------------------------------------------------------------------------
begin
  VarSMEMO:=Memo1.Lines.Text;
  Close;

end;

procedure TFeditor.SBRecargaClick(Sender: TObject);
//------------------------------------------------------------------------------
//************************************************************[ SBRecarga ]*****
// Recupera el texto de la variable fija VarSMemo
//------------------------------------------------------------------------------
begin
  Memo1.Lines.Text:=VarSMEMO;
end;

end.

[Desart]

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

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.clubdelph...ead.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

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.

[Desart]

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

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;

[Desart]

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.

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

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

O al editor

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)

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

[Desart]

Este es el módulo de funciones hasta este momento

unit Funciones;

interface

uses ExtDlgs,DBCtrls, Graphics,Clipbrd, SysUtils;



//------------------------------------------------------------------------------
//*************************************************[ CargaIimagenADBImagen ]****
//  Parte de la idea original de  ??? 09/06/2013
// bajada de http://www.planetade...a-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--------------------------------------------------------------------
//  CargaIimagenADBImagen:(OpenPictureDialog1,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.planetade...a-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--------------------------------------------------------------------
//  CargaIimagenADBImagen:(OpenPictureDialog1,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

var
  DM: TDM;
  VarSMEMO: string;
  Ventana: hwnd; //Handle de la ventana de captura
  VarSUnidad: string;
  VarBGrabarNumerador:Boolean;
  VarIModoApertura:Integer;
  VarSUsuario:string;
  VarINivelUSuario:Integer;

[Desart]

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

//------------------------------------------------------------------------------
//************************************************************[ 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

[Desart]

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.

//------------------------------------------------------------------------------
//***********************************************************[ 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.

[Desart]

Vamos a prepararnos para que nuestra base de datos se ejecute siempre donde este el ejecutable, lo primero es declarar una variable en nuestro modulo Data module (DM)

[DELPHI]VarBPrimeraConeccion:Boolean;[/DELPHI]

Tambien añadimos al uses de nuestro DM en el uses Forms, para poder usar application, añadiremos también Dialogs, para usar el Showmessage y con todo esto iremos a nuestro IBDatabase que hemos llamado (DB) y en seleccionamos el evento BeforeConnect donde añadiremos el siguiente código

[DELPHI]procedure TDM.DBBeforeConnect(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************[ Antes de conectar ]****
// Cogemos la ruta del Ejecutable
//------------------------------------------------------------------------------
var Ruta:string;
    VarBPaso:Boolean;
begin
    VarBPaso:=false;
    if VarBPrimeraConeccion=False then
    begin
      Ruta:=ExtractFilePath(Application.ExeName);    //Sacamos la ruta
      if FileExists(Ruta+ 'VIDEOCLUB.FDB') then
      begin
        DB.DatabaseName:=ruta + 'VIDEOCLUB.FDB';
        VarBPaso:=True;
      end else
      begin
        if FileExists(ruta+'bd\'+'VIDEOCLUB.FDB') then
        begin
          DB.DatabaseName:=Ruta+'bd\' + 'VIDEOCLUB.FDB';
          VarBPaso:=True;
        end else Showmessage('Lo sentimos pero no encontramos el archivo VIDEOCLUB.FDB, donde se encuentra el ejecutable, o en la capeta BD de la ubicación del Ejecutable'+
          #13+#10+'La Aplicación se cerrara');
      end;
      //ShowMessage(IBDatabase1.DatabaseName);
      VarBPrimeraConeccion:=True;
      if (VarBPaso) then
      begin
//        if ibdatabase.Connected=False then ShowMessage('No conectada') else ShowMessage('Conectada');
        if DB.Connected=False then
        begin
            DB.Connected:=True;  //La base de datos
        end;
        Conectar                //si encontro la B.D. Activa el conjunto
      end
                  else Application.Terminate;  //Si no la encontro sale del programa
  end;
end;[/DELPHI]

Para que funciones nos queda crear el procedure conectar que tiene el siguiente código

[DELPHI]procedure TDM.conectar;
//------------------------------------------------------------------------------
//**************************************************************[ Conectar ]****
//Nos permite conectar las tablas, querrys + IBDatabase + IBTransaction
//------------------------------------------------------------------------------
begin
  if DB.Connected=False then DB.Connected:=True;                        //La base de datos
  if IBT.Active=False then IBT.Active:=True;                            //Las Tansacciones
  if IBDUsuarios.Active=false then IBDUsuarios.Active:=True;            //La tabla Usuarios
  if IBDCONFIGURACION.Active=false then IBDCONFIGURACION.Active:=True;  //LA tabla configuración
end;[/DELPHI]

En el procedure anterior mirábamos si la base de datos se encontraba en donde estuviese ubicada la aplicación mediante la ruta, sacando la ubicación de la propia aplicación, como podemos ser un poco más organizados, comprobamos directamente en esta o si dentro de esta ruta esta en una carpeta llamada DB. Si lo encuentra pasa al procedure Conectar, en caso contrario nos muestra un mensaje diciendo que no se encuentra.

¿Por qué hacer esto? fácil para evitar que si cambiamos nuestro programa de ubicación no nos deje de trabajar, además si la aplicación no lleva más vínculos con el sistema, nos permite incluso trabajarla desde un pendrive.

El otro procedure CONECTAR, e s el encargado de volver a conectar tanto nuestra Base de datos (DB), como nuestras transiciones (IBT) y tablas o  consultas que pongamos en este módulo, ya que en el resto pondremos simples consultas (IBQUERRYS) que deberemos controlar nosotros, así si tenemos por algún motivo desconectar la base de datos sólo tendremos que llamar al procedure CONECTAR para que todo el sistema vuelva a activarse y seguir trabajando sin tener que reiniciar la aplicación.

Para ello este procedure pregunta si esta activo o no para activarlo.

[Desart]

En el OnActive de nuestro menú debemos cambiar la linea

[DELPHI]if (VarINivelUSuario<>Null and (not (DM.IBDUsuarios.IsEmpty))  then[/DELPHI]

por

[DELPHI]if (VarINivelUSuario=0) and (not (DM.IBDUsuarios.IsEmpty))  then[/DELPHI]