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.

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;

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

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

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;

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

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.

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

¿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... :mad: (Si quieres, un moderador puede cambiarlas por ti).

Gracias Ñuño, pero el motivo de ponerlo en código Delphi es por que como lo pongo también en delphiAcces allí me da problema cuando lo pongo con las etiquetas y no así con las quote.


a:

No en este caso no utilizare tablas maestro detalle, si no me equivoco te refieres a esto

Y no te te preocupes a partir de ahora pondel el código dentro de sus etiquetas :D

Ahora se ve mejor. Más claro. ^\||/

Respecto al E/R, aunque no uses relaciones "maestro-detalle", estaría bien por lo menos para saber qué va con qué (o sea, clientes se relaciona con película a través de alquiler, por ejemplo...). La verdad es que no he leído el tutorial todavía porque tengo un cacao impresionante (entre el trabajo y el resto)... :(

Ñuño y que herramientas usas para los esquema Entidad/Relación, si puedes poner un ejemplo te lo agradecería ^\||/

Y ya me gustaría a mi tener un cacao impresionante (digo por lo del trabajo) :).

A mi es que me parece que aveces hago estas cosas para nada, ya que al no recibir comentarios, seán los que sean, no se si interesa, supongo que será la vena narcisista que necesita reconocimiento. Aúnque creo que no soy de esos pues no soy de los que se cuida mucho y prefiero pasar un poco desapercibido, como suelo decirle a mi hermano que es homosesual y muy metrosexual.

Yo de metrosexual, tengo lo mismo que el metro de una ferretería. :D:D:D

Pienso que sí interesa, en menos de una semana tiene ya más de 500 visitas :)

Si pero estoy seguro que buena parte de ellas son mias :rolleyes:

Punto A: Hay mucha gente que leemos el trabajo que haces.
Punto B: Tú no eres metrosexual porque eres KILOMETROSEXUAL :D.

Entre tú y yo abuelete, sigue con tu trabajo, que aunque en algunas cosas no coincido o lo haría de otra manera, es muy bueno.

Saludos

Sigue así, aunque no comentemos nada lo estamos leyendo y nos es de gran ayuda.Por mi parte no suelo comentar mucho puesto que estoy en la fase de principiante ya que no tengo muchos conocimientos,aunque programo cosas basíquisimas para mi, este tipo de tutoriales nos son de muy GRANDE AYUDAR,que son realizados con gente como tú.

Saludos y sigue así. Es un gran trabajo

respondo al punto B, ni hablar que mi mujer me mata :D:D:D
y es lógico que muchas cosas se hagan de manera bastante diferente, al final soy un novato avanzado y esto es para lo más novatos aún

Gracias Tuni, pero creo que es bueno oír los comentarios, tenía un profesor que decía algún comentario, nadie decía nada, a no pues entonces para que coño lo explico.

Eso es por que normalmente es imposible que lo entiendan todo a la primera y muchas veces es más el temor a preguntar que ha resolver la duda y te lo digo por experiencia.

Yo uso GNU/Dia. Está un poco parado, pero funciona muy bien. Además de para hacer diagramas E/R te permite hacer también diagramas de flujo, UML y multitud de cosas más.

Aquí tienes multitud de ejemplos de diagramas. Parecen complejos, pero es fácil de utilizar, y no hay que ser muy estricto para las cosas.

El que más me gusta es este:


Los mios son más simples, pero no encuentro ninguno en este ordenador. :(

Veamos Ñuño aun no controlo el programa y me ha quedado un poco grande, pero aquí lo pongo, espero que sea lo que me habías dicho

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)

Código Delphi [-]
VarBPrimeraConeccion:Boolean;

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

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;

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

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;

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.

En el OnActive de nuestro menú debemos cambiar la linea

Código Delphi [-]
if (VarINivelUSuario<>Null and (not (DM.IBDUsuarios.IsEmpty))  then

por

Código Delphi [-]
if (VarINivelUSuario=0) and (not (DM.IBDUsuarios.IsEmpty))  then

En nuestro menú para que funcione la petición de clave y no muestre los números que estamos metiendo tenemos que hacer lo siguiente, pongo el código tal cual lo baje

Código Delphi [-]
Const
  InputBoxMessage = WM_USER + 200;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    procedure InputBoxSetPasswordChar(var Msg: TMessage); message InputBoxMessage;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.InputBoxSetPasswordChar(var Msg: TMessage);
var
  hInputForm, hEdit: HWND;
begin
  hInputForm := Screen.Forms[0].Handle;
  if (hInputForm <> 0) then
  begin
    hEdit := FindWindowEx(hInputForm, 0, 'TEdit', nil);
    SendMessage(hEdit, EM_SETPASSWORDCHAR, Ord('*'), 0);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  InputString: string;
begin
  PostMessage(Handle, InputBoxMessage, 0, 0);                             
  InputString := InputBox('Senha', 'Digite a senha', '');
end;

Esto fue bajado de http://www.planetadelphi.com.br/dica...rd-no-inputbox

Intentare explicarlo por encima


Justo despues de nuestro USES y antes del TYPE al principio de la unidad añadimos

Código Delphi [-]
 const    // InputBoxMessage = WM_USER + 200;    //Para imputboxt con password chard

En el Type en su parte private la lamada del procedimiento

Código Delphi [-]
 procedure InputBoxSetPasswordChar(var Msg: TMessage); message InputBoxMessage;

Es importante la parte de message InputBoxMessage;, ya que si no la añadimos funcionara, pero no nos ocultara los dígitos por asteriscos

Y luego las dos siguientes lineas

Código Delphi [-]
 PostMessage(Handle, InputBoxMessage, 0, 0);    //Para imputboxt con password chard
 if InputBox('Comprobando seguridad', 'Por favor introduzca su clave de usuario', '')  = VarClaveUSusario then

Yo lo he usado en este ejemplo en un If then, pero podira usarse como respuesta a una variable en mi caso está es en el ejemplo VarClaveUSusario

Nuestro siguiente módulo es configuración, dándole al formulario los siguientes parámetros

Nombre UNIT UCONFIGURACION
Name=FConfiguracion
Caption=Configuración
Height=800
Width=1000
Position=PoScreenCenter
Shohint=True
KeyPreview=true

El módulo configuración sólo trabaja con tres paneles, nuestro botonera 1 que sólo contendrá el botón Salir y editar, eliminando el resto, el PanelOculto, con los botones Confirmar y cancelar para grabar los datos y el panel de datos, en el que muchos de ellos estarán des habilitados

Las secciones las he dividido con Groupbox, he usado separadores mediante simples etiquetas y bevels y por último he puesto un seleccionador con un radioGroup y para los colores he usado colorbox, por lo que estos junto al memo para el texto de la ley de protección de datos tendremos que controlarlos manualmente. Claro esta hay componentes que nos ahorrarían este trabajo, algunos de pagos y otros libres, teniendo yo algunos de ellos, pero como dije en este tutorial no usaremos más componentes que los estándar de Delphi.

El form quedaría así



y aquí tenéis el código completo

https://gist.github.com/anonymous/0c376637878de9278273

Vamos a comentar algunas parte del código, empecemos como controlar que nos muestre el texto y el color seleccionado en el memo y los colorbox para eso usamos el evento OnShow del formulario

Código Delphi [-]
procedure TFCONFIGURACION.FormShow(Sender: TObject);
//------------------------------------------------------------------------------
//***************************************************************[ OnShow ]*****
// Al mostrarse
//------------------------------------------------------------------------------
begin
   if not (DsPrincipal.DataSet.State in [dsEdit]) then
   begin
      if DM.IBDConfiguracionCOLOR_DISPONIBLE.Value<>'' then ColorBox1.Selected:=StringToColor(DM.IBDConfiguracionCOLOR_DISPONIBLE.Value);
      if DM.IBDConfiguracionCOLOR_NO_DISPONIBLE.Value<>'' then ColorBox2.Selected:=StringToColor(DM.IBDConfiguracionCOLOR_NO_DISPONIBLE.Value);
      if DM.IBDConfiguracionCOLOR_BLOQUEADA.Value<>'' then ColorBox3.Selected:=StringToColor(DM.IBDConfiguracionCOLOR_BLOQUEADA.Value);
      if DM.IBDConfiguracionLEY_PROTECCION_DATOS.Value<>'' then Memo1.Lines.Text:=DM.IBDConfiguracionLEY_PROTECCION_DATOS.Value;
   end;
end;

Como veis la única condición es que no este en modo edición nuestro datasource (DsPrincipal)

En el momento de grabar deberemos controlar estos mismos campos por lo que antes de hacer el post haremos los siguiente

Código Delphi [-]
if DsPrincipal.DataSet.State in [dsEdit] then
    begin
      if ColorBox1.Selected<>StringToColor(DM.IBDConfiguracionCOLOR_DISPONIBLE.Value) then DM.IBDConfiguracionCOLOR_DISPONIBLE.Value:=ColorToString(ColorBox1.Selected);
      if ColorBox2.Selected<>StringToColor(DM.IBDConfiguracionCOLOR_NO_DISPONIBLE.Value) then DM.IBDConfiguracionCOLOR_NO_DISPONIBLE.Value:=ColorToString(ColorBox2.Selected);
      if ColorBox3.Selected<>StringToColor(DM.IBDConfiguracionCOLOR_BLOQUEADA.Value) then DM.IBDConfiguracionCOLOR_BLOQUEADA.Value:=ColorToString(ColorBox3.Selected);
      if Memo1.Lines.Text<>DM.IBDConfiguracionLEY_PROTECCION_DATOS.Value then DM.IBDConfiguracionLEY_PROTECCION_DATOS.Value:=Memo1.Lines.Text;
      DSPrincipal.DataSet.Post;
    end;

Siguiendo el resto del proceso como ya hemos visto

También cambia nuestros procedures en los botones SBMAS y SBMENOS por los siguientes, ya que sirven para varios campos

Código Delphi [-]
procedure TFCONFIGURACION.SBMasClick(Sender: TObject);
//------------------------------------------------------------------------------
//****************************************************************[ SBMas ]*****
// Aumenta en 1  el nivel del campo seleccionado entre Día, segundos y Registros

//------------------------------------------------------------------------------
begin
  case RadioGroup1.ItemIndex of
     0:begin
         if DBEDia.Field.IsNull then DBEDia.field.Value:=1;
         if DBEDia.Field.value<7 then DBEDia.field.Value:=DBEDia.field.Value+1;
       end;
     1:DBESegundos.field.Value:=DBESegundos.field.Value+1;
     2:DBERegistros.field.Value:=DBERegistros.field.Value+1;
  end;
end;

procedure TFCONFIGURACION.SBMenosClick(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************************[ SBMenos ]*****
// Disminuye 1  el nivel del campo seleccionado entre Día, segundos y Registros
//------------------------------------------------------------------------------
begin
  case RadioGroup1.ItemIndex of
     0:begin
         if DBEDia.Field.IsNull then DBEDia.field.Value:=1;
         if DBEDia.Field.value>1 then DBEDia.field.Value:=DBEDia.field.Value-1;
       end;
     1:if DBESegundos.Field.value>1 then DBESegundos.field.Value:=DBESegundos.field.Value-1;
     2:if DBERegistros.Field.value>1 then DBERegistros.field.Value:=DBERegistros.field.Value-1;
  end;
end;

Esto implica que hacemos una nueva llamada al editor por lo que el siguiente procedure en este módulo cambia de la siguiente manera

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;
   if VarSUnidad='UCONFI' then FCONFIGURACION.Memo1.Lines:=Memo1.Lines;
   Close;
end;

y por último está sería la manera de llamarlo

Código Delphi [-]
procedure TFMENU.act_ConfigurarExecute(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************************[ Configuración ]*****
// Llamamos al módulo de configuración
// Nivel mínimo para acceder [   6  ]
//------------------------------------------------------------------------------
begin
   if VarINivelUSuario>=6 then  FCONFIGURACION.Show
                          else ShowMessage('No tiene nivel suficiente para acceder al apartado');
end;

Ya mañana seguiré ya que hoy tengo otras cosas que terminar.

Sigamos con el tutorial, lo primero es añadir nuevas tablas para poder proseguir a nuestro DM (El DataModule)



Un par de cosas a recordar, los pasos que hay que seguir para activarlos

1) Seleccionamos nuestros Ibddataset y le damos nombre (está última parte se puede hacer luego)
2) Ponemos en su propiedad Database el nombre de ibDatabase en nuestro caso DB, esto activara también la transaction a IBT
3) En la propiedad SelectSql seleccionamos la tabla y los campos, dándoles a los botones de cada una y luego al OK
4) Luego pasamos al GeneratorField y lo rellenamos aprovechando el evento OnPost
5) Pulsamos con el ratón sobre el ibdataset y pulsamos botón derecho seleccionamos Dataset Editor
6) Rellenamos los campos, 1 el del indice, 2 normalmente seleccionamos todos los campos, 3 marcamos el Quote Identifiers, 4 el Generate Sql y 5 por último el OK
7) bien pulsamos dos veces con el ratón sobre el Ibddataset o selecionamos con el botón derecho del menú la opción Fields Editor, Botón derecho nuevamente para seleccionar normalmente Add all fields, después modificamos cada uno para que queden más estéticos
8) le damos al Active del IbddataSet y si todo ha ido bien ya tenemos activa nuestra tabla

La segunda cosa a recordar es que si hacemos una modificación en nuestra tabla a nivel estructural y tenemos activo el delphi o nuestro programa con la base de datos en marcha, este no se refleja, por lo que tendremos que cerrar la base de datos y volver a abrirla, bien manualmente, con lo que tendremos que activar cada una a mano, bien cerrando bien sea nuestro proyecto o nuestra aplicación, para que los nuevos cambios estén disponible.


Si he dicho disponibles, por que tendremos que trabajar sobre las tablas que hemos modificado, repitiendo muchas veces los pasos 5,6,7 y 8 de los explicados hace un momento e incluso otros como el 4, para que estos cambios se reflejen en nuestro proyecto y aplicación.

Por último deberemos añadir las siguientes lineas al procedure Conectar de nuestro módulo DM

Código Delphi [-]
   if IBDCargos.Active=false then IBDCargos.Active:=True;                //La tabla cargos
   if IBDFormaPago.Active=false then IBDFormaPago.Active:=True;          //La tabla Forma de pago
   if IBDFormatos.Active=false then IBDFormatos.Active:=True;            //La tabla Formatos
   if IBDGeneros.Active=false then IBDGeneros.Active:=True;              //La tabla Generos
   if IBDValorAlquiler.Active=false then IBDValorAlquiler.Active:=True;  //La tabla Valor de alquiler
   if IBDUnidades.Active=false then IBDUnidades.Active:=True;            //La tabla Unidades

Bueno os pongo una serie de pantallas en alas que básicamente he hecho un corta y pega



y el código en:

https://gist.github.com/anonymous/97e4048a1622608c1734

Formatos



el código

https://gist.github.com/anonymous/0d3e091b789fc000041d

Cargos



El código

https://gist.github.com/anonymous/cd3cf56b628d3e23f97b

Valor de alquiler



El código

https://gist.github.com/anonymous/5f8710131f48e6d15ea4

Como e dicho hasta el momento ha sido un simple copia y pega pero para el siguiente módulo nos hace falta la siguiente función así que la pongo por adelantado

Código Delphi [-]
//------------------------------------------------------------------------------
//*************************************************[ Pegarimagen ]****
//  Parte de la idea original de   Ricardo S.     [27/07/2013]
// bajada de http://www.clubdelphi.com/foros/showthread.php?t=57360
//------------------------------------------------------------------------------
// Pequeñas modificaciones y adaptado por mi permitiendo añadir imagenes copiadas al portapapeles
// Convertida en funcion para poder ahorrar código en la estructura de los programas
//------------------------------------------------------------------------------
//  [DbImagen]  TDBImage      Donde cargaremos la imagen copiada
//  [Modulo] string      Cadena de identificacion en caso de error
//------------------------------------------------------------------------------
//---EJEMPLO--------------------------------------------------------------------
//  PegarImagen(DBImgLibre,'Imagen libre');
//------------------------------------------------------------------------------
function PegarImagen(DbImagen:TDBImage;Modulo:string):Boolean;
//------------------------------------------------------------------------------
//*********************************************************[ Botón pegar ]******
//  código bajado de http://www.clubdelphi.com/foros/showthread.php?t=57360
//  Del compañero Gluglu, para pegar desde el portapapeles
// Añadir al Uses las unit   Clipbrd, jpeg, ShellAPI, Windows, ExtCtrls, Dialogs, Graphics, Classes
//------------------------------------------------------------------------------
var
  f    : TFileStream;
  Jpg  : TJpegImage;
  Hand : THandle;
  Buffer    : Array [0..MAX_PATH] of Char;
  numFiles  : Integer;
  File_Name : String;
  Jpg_Bmp   : String;
  BitMap    : TBitMap;
  ImageAux  : TImage;

begin

  ImageAux := TImage.Create(Application);

  if Clipboard.HasFormat(CF_HDROP) then begin

    Clipboard.Open;
    try
      Hand := Clipboard.GetAsHandle(CF_HDROP);
      If Hand <> 0 then begin
        numFiles := DragQueryFile(Hand, $FFFFFFFF, nil, 0) ;       //Unit ShellApi
        if numFiles > 1 then begin
          Clipboard.Close;
          ImageAux.Free;
          ShowMessage('Error - El Portapapeles contiene más de un único fichero. No es posible pegar');
          Exit;
        end;
        Buffer[0] := #0;
        DragQueryFile( Hand, 0, buffer, sizeof(buffer)) ;
        File_Name := buffer;
      end;
    finally
      Clipboard.close;
    end;

    f      := TFileStream.Create(File_Name, fmOpenRead);
    Jpg    := TJpegImage.Create;
    Bitmap := TBitmap.Create;

    // Check if Jpg File
    try
      Jpg.LoadFromStream(f);
      ImageAux.Picture.Assign(Jpg);
      Jpg_Bmp := 'JPG';
    except
      f.seek(0,soFromBeginning);
      Jpg_Bmp := '';
    end;

    if Jpg_Bmp = '' then begin
      try
        Bitmap.LoadFromStream(f);
        Jpg.Assign(Bitmap);
        ImageAux.Picture.Assign(Jpg);
        Jpg_Bmp := 'BMP';
      except
        Jpg_Bmp := '';
      end;
    end;

    Jpg.Free;
    Bitmap.Free;
    f.Free;

    if Jpg_Bmp = '' then begin
      ImageAux.Free;
      ShowMessage('Error - Fichero seleccionado no contiene ninguna Imagen del Tipo JPEG o BMP');
      Exit;
    end;

  end
  else if Clipboard.HasFormat(CF_BITMAP) then
    ImageAux.Picture.Assign(Clipboard)
  else begin
    ImageAux.Free;
    ShowMessage('Error - El Portapapeles no contiene ninguna Imagen del Tipo JPEG o BMP');
    Exit;
  end;

  Jpg := TJpegImage.Create;
  try
    Jpg.Assign(ImageAux.Picture.Graphic);
  except
    ImageAux.Free;
    ShowMessage('Error - El Portapapeles no contiene ninguna Imagen del Tipo JPEG o BMP');
    Jpg.Free;
    Exit;
  end;
  Jpg.Free;
  DbImagen.Picture.Assign(ImageAux.Picture);
  Result:=True;
end;

El funcionamiento es sencillo cogemos una imagen desde internet o cual quier otro lado y la copiamos al portapapeles, está función se encarga de cargarla en nuestro Dbimagen

Aquí el módulo de Formas de pago




El botón no se ve al estar en modo normal, pero no os preocupéis veréis el botón copiar en el próximo form junto al de cargar

El código

https://gist.github.com/anonymous/d1fcea21c39c22cb9ab8

En el siguiente módulo veremos muchas cosas nuevas, más botones, componentes DblookucpCombobox, IbQuerrys y el uso del color en los paneles, explicare varios procedimientos, pero antes debo publicar una función que usaremos

Código Delphi [-]
//-----------------------------------------------------------------------------
//**********************************************************[ ActQuerry ]******
//  20/11/2010  JLGT  Para modificar la sentencia de un querry
//-----------------------------------------------------------------------------
//  Estudiando como poder hacer mi código mas corto se me ocurrio esta función
//  para usar un los IBQerry, para mi base de datos Firebird.
//  El tema es que cada vez que utilizo un querry y lo modifico tengo que
//  escribir unas 20 lineas y mediante este sistema, logro reducirlo a una sola
//  ya que es un, código repetitivo y soló varia el nombre del query y la
//  sentencia Sql, cree esta función
//-----------------------------------------------------------------------------
// [QRY]              Tibquery a actualizar
// [TxtSql]           Cadena de texto con sentencia SQL
// [MostrarMEnsaje]   Si muestra el mensaje de la Exception
// [RetornarMEnsaje]  Si retorna la cadena Sql que da el Error
// [RetornarQuerry]   Si retorna El querry a la cadena sql de antes del error
//-----------------------------------------------------------------------------
//  Base de datos a usar CLIENTES
//   if ActQuerry(IBQuerry1,'Select * form Clientex')=true then
//                   showmessage('Existe la base de datos')
//   else showmessage('No existe la base de datos');
//-----------------------------------------------------------------------------
Function ActQuery(QRY:TIBQuery; TxtSql:string; MostrarMensaje:boolean=VMiLogico;Retornarmensaje:boolean=VMiLogico; RetornarQuerry:boolean=VMiLogico): Boolean;
var AntSql:string;
begin
    try
      try
        AntSql:=QRY.SQL.Text;
        QRY.Active:=false;
        QRY.SQL.Clear;
        QRY.SQL.Text:=TxtSql;
        QRY.Active:=true;
//        ShowMessage('Sentencia Sql OK' + Chr(13) + Chr(13)+
//                      QRY.SQL.Text);
        Result:=true;
      except
        on E: Exception do
        begin
           if MostrarMensaje=true then
           begin
             ShowMessage('Se ha producido un error: ' + 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)
                       +'Se volvera al estado anterior');
           end;
        Result:=false;
        end;
      end;
    finally
      if Result=false then
      begin
         if Retornarmensaje=true then  ShowMessage('Sentencia Sql que ha dado Error' + Chr(13) + Chr(13)+ QRY.SQL.Text);
         if RetornarQuerry=true then
         begin
            QRY.Active:=false;
            QRY.SQL.Clear;
            QRY.SQL.Text:=AntSql;
            QRY.Active:=true;
         end;
      end;
    end;
end;

Podéis modificara o añadir al principio de funciones mis valores por defecto, os pongo las primeras lineas de como yo lo tengo

Código Delphi [-]
unit Funciones;

interface

uses ExtDlgs,DBCtrls, Clipbrd, SysUtils, Forms, StdCtrls,  jpeg, ShellAPI, Windows, ExtCtrls, Dialogs,  Classes, Graphics,
      IBQuery;

const                  
   VMiAutoCodTipo='L';
   VMiAutoCodCod='0';
   VMiAutoCodFC=' ';
   VMiAutoCodLong=0;
   VMiAutoFecha='';
   VMiLogico=True;

Vamos con el módulo Unidades, primero os pongo una imagen en uso



Dentro de poco veremos los indicadores puestos en esta imagen, pero antes veamos parte del mismo Form en fase de diseño



Así podéis apreciar el botón de copiar en el panel (PanelOculto)

El siguiente es el código

https://gist.github.com/anonymous/600ac17cef6c1c53c46f

El apartado 1 indica una serie de botones que aun no están activos por lo que este módulo no esta totalmente terminado, dejando el resto para la semana que viene.

El 2 nos muestra una serie de DBLoocupComboBox, que es la manera de leer desde otra tabla a la nuestra sin muchas operaciones por media, después del 3 apartado seguiré hablando de ellos.

El 3 es el Panel nivel que sólo se vera si el usuario tiene un nivel determinado, no estando visible siempre.

Volviendo a los DBLoocupComboBox, debo explicaros que hay 5 apartados que deben estar rellenos para que funcionen estos son

DataSource: Donde ponemos el datasource de la base que pide los datos
DataField: El campo donde guardaremos el dato
ListSource: El datasource de donde obtendremos los datos
KeyField: El Campo clave por donde nos ordenara los datos
ListField: La lista de campos a mostrar, siendo el primero el dato a registrar, para poder mostrar varios campos debemos separa el nombre de estos con un punto y coma (;)

Pero aun así debemos hacer varios cambios en este componente para que funcione todo lo bien que debería, os diré los que yo hago, en primer lugar cambio la propiedad DropDownWidth para que me deje ver los diversos campos que muestro. si me hace falta cambio también DropDownRows, pero nunca me deja mostrar más de 7 registros, si alguien sabe como que lo comparta :D.

Luego usos los eventos Onenter y Onclick como el primero solo añadiendo el siguiente código

Código Delphi [-]
procedure TFunidades.DBLBValorEnter(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************[ Entrar en Valor de alquiler ]*****
// Abre el dialogo
//------------------------------------------------------------------------------
begin
   DM.IBDValorAlquiler.Last;
   DBLBValor.perform(CB_SHOWDROPDOWN,1,0);
end;

Si veis la última imagen tenemos 7 datasource, el del principal, los de los 3 querrys y 3 más que parecen estar repetidos, pero no es así, explico por que, de la tabla valor Alquiler, tenemos 2 datasource, el primero esta unido a la tabla directamente y el segundo a un querry (IBQValor), el primero lo uso para posicionarme al final de la tabla y así nos muestre todos los registros en nuestro DBLoocupComboBox, ya que si no sólo mostraría 1 registro, claro que podria usar este mismo Datasource, para mostrar el dato que hay al lado del DBLoocupComboBox en dbtext de color marrón, pero si lo hago asi siempre mostraria un dato no siendo este cierto muchas veces.

Por ello uso el segundo dataSource unido al Querry, para que nos muestre este dato correctamente, usando tanto el procedure comprobar, que ahora veremos como el Onexit de nuestro DBLoocupComboBox.

Código Delphi [-]
//------------------------------------------------------------------------------
//******************************************[ Salir del DBLoockupCombobox ]*****
// Actualizamos datos
//------------------------------------------------------------------------------
begin
   if DBLBValor.Text<>'' then  ActQuery(IBQValor,'select * from VALOR_ALQUILER   WHERE (VALOR_ALQUILER.CODIGO = '+QuotedStr(DBLBValor.Text)+')');
end;

Como dije en comprobar añadimos parte del mismo código, la diferencia es que comprobar sólo se ejecuta cuando la tabla esta en reposo, mientras que con el OnExit lo usamos cuando estemos insertando editando, aclarado esto este es el código.

Código Delphi [-]
procedure TFunidades.comprobar;
//------------------------------------------------------------------------------
//************************************************************[ comprobar ]*****
//------------------------------------------------------------------------------
begin
   if Funidades.Active then
   begin
      if not (DsPrincipal.DataSet.State in [dsEdit,dsInsert]) then
      begin
         if not (DM.IBDUnidades.IsEmpty) then
         begin
            if DsPrincipal.DataSet.FieldByName('NOTAS').Value<>'' then Memo1.Lines.Text:=DsPrincipal.DataSet.FieldByName('NOTAS').AsString
                                                                  else Memo1.Lines.Clear;
            if DBLBFormato.Text<>'' then  ActQuery(IBQFormatos,'select * from FORMATOS WHERE (FORMATOS.CODIGO = '+QuotedStr(DBLBFormato.Text)+')');
            if DBLBGenero.Text<>'' then  ActQuery(IBQGeneros,'select * from GENEROS   WHERE (GENEROS.CODIGO = '+QuotedStr(DBLBGenero.Text)+')');
            if DBLBValor.Text<>'' then  ActQuery(IBQValor,'select * from VALOR_ALQUILER   WHERE (VALOR_ALQUILER.CODIGO = '+QuotedStr(DBLBValor.Text)+')');
            if (DM.IBDUnidadesDISPONIBLE.value='S') and (DM.IBDUnidadesPERDIDA.value='N') and (DM.IBDUnidadesVENDIDA.value='N') then PanelDatos.Color:=StringToColor(DM.IBDConfiguracionCOLOR_DISPONIBLE.Value);
   if (DM.IBDUnidadesDISPONIBLE.value='N') and (DM.IBDUnidadesPERDIDA.value='N') and (DM.IBDUnidadesVENDIDA.value='N') then PanelDatos.Color:=StringToColor(DM.IBDConfiguracionCOLOR_NO_DISPONIBLE.Value);
   if (DM.IBDUnidadesDISPONIBLE.value='N') and ((DM.IBDUnidadesPERDIDA.value='S') or (DM.IBDUnidadesVENDIDA.value='S')) then PanelDatos.Color:=StringToColor(DM.IBDConfiguracionCOLOR_BLOQUEADA.Value);
         end;
      end;
   end;
end;

Como veréis también aquí es donde decidimos colocar el color en el panel de datos para que funcione debemos poner a false el ParentBackGorund y el parentColor

Y ya por último usamos el evento OnShow del formulario para decidir si mostramos o no el PanelNivel (3), este es el código

Código Delphi [-]
procedure TFunidades.FormShow(Sender: TObject);
//------------------------------------------------------------------------------
//***************************************************************[ OnShow ]*****
// Cuando muestra la pantalla
//------------------------------------------------------------------------------
begin
   if VarINivelUSuario<8 then PAnelNivel.Visible:=False
                         else PAnelNivel.Visible:=True;

end;

Como véis si la variable de nivel de usuario es menor de 8 no lo muestra, en caso contrario si.

Se me olvidaba comentar que también he añadido al Onkeypress para que nos admita el saltar entre componente con el entre en los DBLoocupComboBox , podéis verlo en el código completo.

Ahora hasta la próxima semana.

No exactamente, pero se acerca mucho. Al menos así se puede ver de qué forma se organizan los datos.

A ver cuándo puedo hacer el tutorial con Lazarus y pongo las diferencias que encuentre, si hay alguna.

¡Buen trabajo! ^\||/

Muchas gracias Ñuño

Buenos días compañeros sigamos con la explicación de los botones, para recordar cuales pongo la imagen nuevamente



hablamos de los marcados con el 1

Este es el código para la baja

Código Delphi [-]
procedure TFunidades.sbBajaClick(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************************[ Baja ]*****
//------------------------------------------------------------------------------
begin
    Case MessageBox(0,
      pchar(  '¿Está seguro de querer marcar como baja esta unidad?' +#13#10
      +#13#10+'Marcar como baja simplemente marca una unidad como no disponible y la fecha en que esta de baja, pudiendo recuperarse su utilidad con el botón recuperada'),
      pchar('Marcar como Baja'),4+32+256) of
       6:begin       //Si
            try
              VarSCadena:=chr(13)+'---[ MARCADA COMO BAJA EL '+DateToStr(Now)+' ]----------------[ '+VarSUsuario+' ]-----'+chr(13);
              DM.IBDUnidades.Edit;
              if DM.IBDUnidadesDISPONIBLE.Value='S' then DM.IBDUnidadesDISPONIBLE.Value:='N';
              DM.IBDUnidadesFECHA_BAJA.Value:=Now;
              DM.IBDUnidadesNOTAS.value:=DM.IBDUnidadesNOTAS.value+(VarSCadena);
              DM.IBDUnidades.post;
              DM.IBT.CommitRetaining;
            except
              on E: Exception do
              DM.MiControlDeErrores(Dsprincipal,'UUnidades','Baja',E);
            end;
         end;
    end;
end;

Como veis es un procedimiento sencillos, en el que marcamos como no disponible si no lo esta ya, añadimos una cadena de texto a nuestras notas notificando la baja y el usuario y por último ponemos la fecha de baja.

Para ello hay dos apartados que son nuevo la cadena VarSCadena, que hemos creado en el datamodule para que la usemos genéricamente llamando únicamente al modulo, que es lo más normal y por otra parte el procedimiento MiControlDeErrores que vemos a continuación

Código Delphi [-]
procedure TDM.MiControlDeErrores(Ds: TDataSource; Unidad, Apartado: string;E:Exception);
//------------------------------------------------------------------------------
//***************************************************[ MiControlDeErrores ]*****
//   Ds   Es el datasource a conectar
//   Unidad    LA unidad desde el que la llamamos
//   Apartado  El apartado
//   E    La  exception producida
//------------------------------------------------------------------------------
begin
   MessageBeep(1000);
   ShowMessage('Se ha producido un error y el proceso no se ha podido terminar   Unidad:[ '+Unidad+']   Modulo:[ '+Apartado+' ]' + 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 Ds.DataSet.State in [dsEdit,dsInsert] then DS.DataSet.Cancel;
  DM.IBT.RollbackRetaining;    //Donde IBT es el nombre de su Ibtrasaction, con ruta
end;

Al que hemos hecho la llamada de la siguiente manera en el código anterior

Código Delphi [-]
DM.MiControlDeErrores(Dsprincipal,'UUnidades','Baja',E);

Vamos con Recuperar que nos sirve tanto para las bajas como para perdidas

Código Delphi [-]
procedure TFunidades.SBRecuperadaClick(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************************[ Recuperada ]*****
//------------------------------------------------------------------------------
var
  I,Indice: integer;
begin
  //----------Esta parte esta basada en el código de Egostar bajado de:
  //----http://www.delphiaccess.com/forum/oop-7/(resuelto)-buscar-palabras-en-un-memo/
  Indice := 0;
  for I := 0 to memo1.lines.count - 1 do
  begin
    if pos('[ MARCADA COMO BAJA',memo1.lines[i]) <> 0 then begin
       Indice := i;
       Break;
    end;
  end;
  //----------------------------------
  if ((DM.IBDUnidadesDISPONIBLE.Value='N') or (DM.IBDUnidadesPERDIDA.Value='S')) and (DM.IBDUnidadesVENDIDA.Value='N') then
  begin
    Case MessageBox(0,pchar(  '¿La unidad ha sido recuperada?'+#13#10
      +#13#10+'Si la unidad ha sido recuperada se establecera  para el alquiler nuevamente, marcando su disponivilidad'),
      pchar('Unidad recuperada'),4+32+256) of
       6:begin       //Si
            try
              VarSCadena:=chr(13)+'---[ Unidad recuperada '+DateToStr(Now)+' ]----------------[ '+VarSUsuario+' ]-----'+chr(13);
              DM.IBDUnidades.Edit;
              DM.IBDUnidadesDISPONIBLE.Value:='S';
              if DM.IBDUnidadesPERDIDA.Value='S' then  DM.IBDUnidadesPERDIDA.Value:='N';   
              DM.IBDUnidadesFECHA_BAJA.Clear;
              if Indice>0 then Memo1.Lines.Delete(Indice);
              Memo1.lines.Add(VarSCadena);
              DM.IBDUnidadesNOTAS.value:=Memo1.Lines.Text;
              DM.IBDUnidades.post;
              DM.IBT.CommitRetaining;
            except
              on E: Exception do
              DM.MiControlDeErrores(Dsprincipal,'UUnidades','Recuperada',E);
            end;
         end;
    end;
  end;
end;

Lo primero que hacemos es comprobar nuestro memo para saber si esta marcada como baja en el en algún momento por nuestro sistema automatizado +- después pasamos a comprobar con la siguiente linea

Código Delphi [-]
  if ((DM.IBDUnidadesDISPONIBLE.Value='N') or (DM.IBDUnidadesPERDIDA.Value='S')) and (DM.IBDUnidadesVENDIDA.Value='N') then

que se produzca las siguientes condiciones, que la unidad no este disponible o este perdida y que ademas en ningún caso este vendida, si es así seguimos y quitamos la fecha de baja, marcamos el disponible como 'S' ya que tanto si estaba de baja como si estaba perdida nos pondría este campo como 'N' y si de la busca en nuestro memo de si estaba en baja nos da algún acierto lo eliminamos marcando el texto de recuperada.

Podéis ver que usado parte del código facilitado en una ocasión por EGostar, para poder posicionarme dentro del memo y saber que linea habría que borrar.

El siguiente es el botón de perdida, no creo que tenga que explicar el código

Código Delphi [-]
procedure TFunidades.SBPErdidaClick(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************************[ Perdida ]*****
//------------------------------------------------------------------------------
begin
    Case MessageBox(0,
      pchar(  '¿Está seguro de querer marcar como perdida esta unidad?' +#13#10
      +#13#10+'Marcar como perdida simplemente marca una unidad como no disponible, perdida y la fecha en que esta de baja, pudiendo recuperarse su utilidad con el botón recuperada'),
      pchar('Marcar como Baja'),4+32+256) of
       6:begin       //Si
            try
              VarSCadena:=chr(13)+'---[ PERDIDA EL '+DateToStr(Now)+' ]----------------[ '+VarSUsuario+' ]-----'+chr(13);
              DM.IBDUnidades.Edit;
              if DM.IBDUnidadesDISPONIBLE.Value='S' then DM.IBDUnidadesDISPONIBLE.Value:='N';
              DM.IBDUnidadesPERDIDA.Value:='S';
              DM.IBDUnidadesFECHA_BAJA.Value:=Now;
              DM.IBDUnidadesNOTAS.value:=DM.IBDUnidadesNOTAS.value+(VarSCadena);
              DM.IBDUnidades.post;
              DM.IBT.CommitRetaining;
            except
              on E: Exception do
              DM.MiControlDeErrores(Dsprincipal,'UUnidades','Perdida',E);
            end;
         end;
    end;
end;

Bien el siguiente apartado es mandar a otra base de datos la etiqueta, para que cuando imprimamos la hoja, podamos ponérsela a nuestra unidad para el alquiler.
Aunque no veamos ahora ese módulo (Ya lo haremos más adelante) es importante saber que este funcionara, registrando varias unidades, para cuando lo imprimamos sacar en un una sola hoja varias unidades, ya lo veremos más adelante

Código Delphi [-]
procedure TFunidades.SBEtiquetaClick(Sender: TObject);
//------------------------------------------------------------------------------
//**********************************************************[ A etiquetas ]*****
//------------------------------------------------------------------------------
begin
   try
     DM.IbdEtiquetas.Insert;
     Dm.IbdEtiquetasFECHA.Value:=Now;
     DM.IbdEtiquetasUNIDAD.Value:=DbeCodigo.Text;
     DM.IbdEtiquetasTITULO.Value:=DBETitulo.Text;
     DM.IbdEtiquetasCODIGO_BARRAS.Value:=DBECodigoBarras.Text;
     DM.IbdEtiquetasUSUARIO.Value:=VarSUsuario;
     DM.IbdEtiquetasIMPRIMIDO.Value:='N';
     DM.IbdEtiquetas.Post;
     DM.IBT.CommitRetaining;
   except
     on E: Exception do
     DM.MiControlDeErrores(Dsprincipal,'UUnidades','A Etiquetas',E);
   end;
end;

Bien ahora pondré el código de nuestro siguiente botón, el cual realmente manda a otro módulo los datos y registra usando ambos módulos ya que entramos en dos apartados muy diferentes en el que se usan 3 tablas de nuestra base de datos.

Código Delphi [-]
procedure TFunidades.SBVendidaClick(Sender: TObject);
//------------------------------------------------------------------------------
//***************************************************************[ vender ]*****
//------------------------------------------------------------------------------
begin
    VarIModoApertura:=1;
    FMovimientos.Show;
end;

Tanto para este último botón como para el anterior hemos usado nuevas tablas que hemos creado junto a otras, de las cuales hoy y mañana veremos únicamente la de movimientos, clientes, dejando las otras para más adelante

Vamos primero con el módulo de cliente, primero una imagen en fase de diseño



Y otra en ejecución



El código en

https://gist.github.com/anonymous/29671ebc05abf548bb61

Comentar que este módulo es necesario antes del próximo ya descubriremos por que, comentemos los 3 botones que tenemos de más

A Cuenta: nos permite introducir una cantidad de dinero que estará a favor de nuestro cliente, para ello limitamos el código del cliente a este, no haciéndolo en los cargos, ya que estos los podemos crear de manera muy diferente a la mía, pero rellenamos partes de los conceptos y lo registramos en el cliente en notas

Pagos: Permite que un cliente pague el pendiente que tiene existiendo tres posibilidades al realizarlo que veremos en el otro módulo que es donde se hace

Carnet: este es un módulo que de momento no tocaremos haciéndolo cuando entremos en la parte de impresión, pero lo que hace es el carnet del cliente

Veamos los cambios en el DataModule (DM)

Código Delphi [-]
//------------------------------------------------------------------------------
//**************************************************************[ Conectar ]****
//Nos permite conectar las tablas, querrys + IBDatabase + IBTransaction
//------------------------------------------------------------------------------
begin
   ...
   if IBDCaja.Active=false then IBDCaja.Active:=True;                    //La tabla Cajas
   if IBDClientes.Active=false then IBDClientes.Active:=True;            //La tabla Clientes
   if IBDMovimientos.Active=false then IBDMovimientos.Active:=True;      //La tabla Movimientos
   if IbdEtiquetas.Active=false then IbdEtiquetas.Active:=True;          //La tabla Etiquetas
end;

Como vemos vamos añadiendo nuestras tablas según avanzamos y vamos insertandolas

Y ya por último en esta semana ya que mañana dudo que pueda ponerme con el tutorial os pongo el módulo de movimiento y algunas partes a comentar



El código

https://gist.github.com/anonymous/fcad11f5cd2b6ef0b6e2

Veamos el procedimiento del botón nuevo del módulo movimientos, lo he dividido en partes para ir comentandolo

Código Delphi [-]
//------------------------------------------------------------------------------
//**************************************************************[ SBnuevo ]*****
//------------------------------------------------------------------------------
var VarIRegistro:Integer;
    VarBSeguimos:Boolean;

Creamos la variable VarBSeguimos, para saber si debemos continuar por uno u otor lado, ya lo veremos más adelante

Código Delphi [-]
begin
    VarBSeguimos:=True;
    if DM.IBDClientes.IsEmpty then VarBSeguimos:=false;
    if DM.IBDCargos.IsEmpty then VarBSeguimos:=false;

Le decimos a la variable que es true y lo primero que hacemos es saber si estas tablas tiene datos, en caso contrario marcamos la variable para no seguir

Código Delphi [-]
    if VarBSeguimos then
    begin
      ActQuery(IBQClientes,'Select * From CLIENTES');
      ActQuery(IBQCargos,'Select * From CARGOS');
      DsPrincipal.DataSet.Insert;
      VarIRegistro:=DM.IBDConfiguracionNUMERADOR_MOVIMIENTOS.Value;
      VarIRegistro:=VarIRegistro+1;
      DbeRegistro.Field.Value:=IntToStr(VarIRegistro);
      PanelDatos.Enabled:=True;
      PanelOculto.Visible:=True;
      Botonera1.Enabled:=false;
      DbeFecha.Field.Value:=Now;

Si tenemos datos usamos la variable y seguimos, activamos los ibquerry con todos los clientes y seguimos con los datos

Código Delphi [-]
 VarIModoApertura=1 then DbeConcepto.Field.Value:='Venta de la unidad [ '+DM.IBDUnidadesTITULO.Value+' ]';
      if VarIModoApertura=2 then DbeConcepto.Field.Value:='A cuenta del cliente [ '+DM.IBDClientesCODIGO.Value+' ]';
      if VarIModoApertura=3 then
      begin
         DbeConcepto.Field.Value:='Pagado por el cliente[ '+DM.IBDClientesCODIGO.Value+' ]';
         DbeCantidad.Field.Value:=DM.IBDClientesPENDIENTE.Value;
      end;
     DBLBCliente.SetFocus;
     end else ShowMessage('O bien clientes o cargos esta vacía, por lo que no puede continuar, anulando este proceso');
end;

Ahora dependerá de nuestro método de apertura preparamos ciertos datos usando la variable VarIModoApertura y para que este funcione automáticamente usamos el siguiente código

Código Delphi [-]
//------------------------------------------------------------------------------
//***************************************************************[ OnShow ]*****
// Cuando muestra la pantalla
//------------------------------------------------------------------------------
begin
   if not (DsPrincipal.DataSet.State in [dsEdit,dsInsert]) then
   begin
      if (VarIModoApertura=1) or (VarIModoApertura=2) or (VarIModoApertura=3) then SBNuevoClick(sender);
   end;
end;

Como vemos dice que si hay elegido un método de apertura diferente a o automáticamente nos genere un nuevo registro, ya que estos métodos vienen de los módulos Unidades en el botón vendida y de Clientes en los botones A Cuenta y Pagar

Sigamos con confirmar

Código Delphi [-]
procedure TFMovimientos.SpeedButton9Click(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************************[ Grabar datos ]******
//------------------------------------------------------------------------------
 var VarIFase:Integer;
     VarbSaltar:Boolean;
begin
  try
    VarIFase:=1;
    VarbSaltar:=False;
    if DsPrincipal.DataSet.State in [dsInsert] then VarBGrabarNumerador:=True else VarBGrabarNumerador:=False;
    if DsPrincipal.DataSet.State in [dsEdit,dsInsert] then
    begin
       DSPrincipal.DataSet.Post;
    end;
    if VarBGrabarNumerador=true then
    begin
      VarIFase:=2;
      DM.IBDConfiguracion.Edit;
      DM.IBDConfiguracionNUMERADOR_MOVIMIENTOS.Value:=StrToInt(DbeRegistro.Field.Value);
      DM.IBDConfiguracion.Post;
    end;
    VarIFase:=3;
    if ((DM.IBDCaja.IsEmpty)) then VarbSaltar:=True;
    if VarbSaltar=False then  //Comprobamos si hay registro de la caja con esta fecha
    begin
       DM.IBDCaja.last;
       if DM.IBDCajaFECHA.Value<>Now then  VarbSaltar:=True;
    end;
    if VarbSaltar then
    begin
      DM.IBDConfiguracion.Edit;
      DM.IBDConfiguracionNUMERADOR_CAJA.Value:=DM.IBDConfiguracionNUMERADOR_CAJA.Value+1;
      DM.IBDConfiguracion.Post;
    end;
    DM.IBDCaja.Insert;
    DM.IBDCajaREGISTRO.Value:=IntToStr(DM.IBDConfiguracionNUMERADOR_CAJA.Value);
    DM.IBDCajaCLIENTE.Value:=DBLBCliente.Text;
    DM.IBDCajaCONCEPTO.Value:=DbeConcepto.Field.Value;
    DM.IBDCajaCARGO.Value:=DBLBCargo.Text;
    DM.IBDCajaFECHA.Value:=DbeFecha.Field.Value;
    DM.IBDCajaCANTIDAD.Value:=DbeCantidad.Field.Value;
    DM.IBDCajaUSUARIO.Value:=VarSUsuario;
    DM.IBDCaja.Post;
    VarIFase:=4;
    if VarIModoApertura=1 then
    begin
       DM.IBDUnidades.Edit;
       DM.IBDUnidadesVENDIDA.Value:='S';
       DM.IBDUnidadesDISPONIBLE.Value:='N';
       DM.IBDUnidadesFECHA_BAJA.Value:=Now;
       if DM.IBDUnidadesRENDIMIENTO.value=0 then DM.IBDUnidadesRENDIMIENTO.Value:=DbeCantidad.Field.Value
                                            else DM.IBDUnidadesRENDIMIENTO.Value:=DM.IBDUnidadesRENDIMIENTO.Value+DbeCantidad.Field.Value;
       VarSCadena:='chr(13)+--[ VENDIDA el '+DateToStr(now)+' al cliente número '+DBLBCliente.Text+'------------------Por ['+VarSUsuario+']';
       DM.IBDUnidadesNOTAS.Value:=DM.IBDUnidadesNOTAS.Value+VarSCadena;
       DM.IBDUnidades.post;
    end;
    if VarIModoApertura=2 then
    begin
       DM.IBDClientes.Edit;
       if DM.IBDClientesA_CUENTA.Value=0 then DM.IBDClientesA_CUENTA.Value:=DbeCantidad.Field.Value
                                         else DM.IBDClientesA_CUENTA.Value:=DM.IBDClientesA_CUENTA.Value+DbeCantidad.Field.Value;
       VarSCadena:=chr(13)+'--[ Entregado a cuenta  el '+DateToStr(now)+' La cantidad de  '+DbeCantidad.Text+'------------------Por ['+VarSUsuario+']';
       DM.IBDClientesNOTAS.Value:=DM.IBDClientesNOTAS.Value+VarSCadena;
       DM.IBDClientes.post;
    end;
    if VarIModoApertura=3 then
    begin
       DM.IBDClientes.Edit;
       if DM.IBDClientesPENDIENTE.Value=DbeCantidad.Field.Value then DM.IBDClientesPENDIENTE.Value:=0
       Else begin
          if DM.IBDClientesPENDIENTE.Value>DbeCantidad.Field.Value then DM.IBDClientesPENDIENTE.Value:=DM.IBDClientesPENDIENTE.Value-DbeCantidad.Field.Value
          else begin
             Case MessageBox(0, pchar(  'Ha entregado más dinero del que tenia pendiente de pagar'
                            +#13#10+#13#10+'¿Desea que el sobrante se lo añadamos a su cuenta en el apartado '
                            +#13#10+#13#10+'                                            [ A Cuenta ]'),
                            pchar('Entregado más que el pendiente'), 4+32+256) of
               6:begin       //Si
                    if DM.IBDClientesA_CUENTA.Value=0 then DM.IBDClientesA_CUENTA.Value:=DbeCantidad.Field.Value-DM.IBDClientesPENDIENTE.Value
                                                      else DM.IBDClientesA_CUENTA.Value:=DM.IBDClientesA_CUENTA.Value+(DbeCantidad.Field.Value-DM.IBDClientesPENDIENTE.Value);
                 end;
             end;
          end;
          DM.IBDClientesPENDIENTE.Value:=0
       end;
       VarSCadena:=chr(13)+'--[ Pagado el '+DateToStr(now)+' La cantidad de  '+DbeCantidad.Text+'------------------Por ['+VarSUsuario+']';
       DM.IBDClientesNOTAS.Value:=DM.IBDClientesNOTAS.Value+VarSCadena;
       DM.IBDClientes.post;
    end;
    VarIModoApertura:=0;
    VarIFase:=5;
    DM.IBT.CommitRetaining;    //Donde IBT es el nombre de su Ibtrasaction, con ruta
  except
    on E: Exception do
    begin
        MessageBeep(1000);
        ShowMessage('Se ha producido un error y el proceso no se ha podido terminar   Unidad:[ UMovimientos ]   Modulo:[ Grabar ]' + Chr(13) + Chr(13)
                  + 'Fase del error [ '+IntToStr(VarIFase)+' ]'+ 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;
end;

Como vemos difiere mucho de los otros botones confirmar, pero es muy simple de seguir el procedimiento, para ellos vamos a guiarnos por los valores que le vamos dando a la variable VarIFase, cuando vale 1 hacemos lo siguiente

-Comprobamos si estamos insertando, para en tal caso actualizar el numerador en Configuración y grabamos los datos de la tabla movimientos

Cuando VarIFase vale 2

-Actualizamos el numerador de configuración, pero sólo si la tabla estaba en inserción

Cuando VarIFase vale 3

-1º comprobamos si la caja ya tiene registro con esta fecha, en caso de no hacerlo pasamos al 2 paso

-2º En caso de no tener registro la creamos el aumento de este en el numerador de cajas de configuración

-3 Independientemente de que necesitemos el paso 2 o no grabamos los datos en la caja cogiendo el registro directamente del valor actual del numerador en configuración, por esto si no existe debemos registrarlo con el paso 2

Pasemos a cuando VarIFase vale 4

-Aquí dependerá del modo de apertura, modificando los campos necesarios de las tablas Unidades o clientes, según ha sido nuestra apertura, omitiendolos todos si estamos en modo de apertura 0

Aquí debemos registrar un cambio en el código que es el siguiente por un error mio

Código Delphi [-]
 if (VarIModoApertura=1) and (VarBGrabarNumerador) then
    begin
       DM.IBDUnidades.Edit;
       DM.IBDUnidadesVENDIDA.Value:='S';
       DM.IBDUnidadesDISPONIBLE.Value:='N';
       DM.IBDUnidadesFECHA_BAJA.Value:=Now;
       if DM.IBDUnidadesRENDIMIENTO.value=0 then DM.IBDUnidadesRENDIMIENTO.Value:=DbeCantidad.Field.Value
                                            else DM.IBDUnidadesRENDIMIENTO.Value:=DM.IBDUnidadesRENDIMIENTO.Value+DbeCantidad.Field.Value;
       VarSCadena:='chr(13)+--[ VENDIDA el '+DateToStr(now)+' al cliente número '+DBLBCliente.Text+'------------------Por ['+VarSUsuario+']';
       DM.IBDUnidadesNOTAS.Value:=DM.IBDUnidadesNOTAS.Value+VarSCadena;
       DM.IBDUnidades.post;
    end;
    if VarIModoApertura=2 and (VarBGrabarNumerador)  then
    begin
       DM.IBDClientes.Edit;
       if DM.IBDClientesA_CUENTA.Value=0 then DM.IBDClientesA_CUENTA.Value:=DbeCantidad.Field.Value
                                         else DM.IBDClientesA_CUENTA.Value:=DM.IBDClientesA_CUENTA.Value+DbeCantidad.Field.Value;
       VarSCadena:=chr(13)+'--[ Entregado a cuenta  el '+DateToStr(now)+' La cantidad de  '+DbeCantidad.Text+'------------------Por ['+VarSUsuario+']';
       DM.IBDClientesNOTAS.Value:=DM.IBDClientesNOTAS.Value+VarSCadena;
       DM.IBDClientes.post;
    end;
    if VarIModoApertura=3 and (VarBGrabarNumerador)  then
    begin
       DM.IBDClientes.Edit;
       if DM.IBDClientesPENDIENTE.Value=DbeCantidad.Field.Value then DM.IBDClientesPENDIENTE.Value:=0
       Else begin
          if DM.IBDClientesPENDIENTE.Value>DbeCantidad.Field.Value then DM.IBDClientesPENDIENTE.Value:=DM.IBDClientesPENDIENTE.Value-DbeCantidad.Field.Value
          else begin
             Case MessageBox(0, pchar(  'Ha entregado más dinero del que tenia pendiente de pagar'
                            +#13#10+#13#10+'¿Desea que el sobrante se lo añadamos a su cuenta en el apartado '
                            +#13#10+#13#10+'                                            [ A Cuenta ]'),
                            pchar('Entregado más que el pendiente'), 4+32+256) of
               6:begin       //Si
                    if DM.IBDClientesA_CUENTA.Value=0 then DM.IBDClientesA_CUENTA.Value:=DbeCantidad.Field.Value-DM.IBDClientesPENDIENTE.Value
                                                      else DM.IBDClientesA_CUENTA.Value:=DM.IBDClientesA_CUENTA.Value+(DbeCantidad.Field.Value-DM.IBDClientesPENDIENTE.Value);
                 end;
             end;
          end;
          DM.IBDClientesPENDIENTE.Value:=0
       end;
       VarSCadena:=chr(13)+'--[ Pagado el '+DateToStr(now)+' La cantidad de  '+DbeCantidad.Text+'------------------Por ['+VarSUsuario+']';
       DM.IBDClientesNOTAS.Value:=DM.IBDClientesNOTAS.Value+VarSCadena;
       DM.IBDClientes.post;
    end;

De esta manera la modificación solo se registra si estamos en insercción

Por último vamos cuando VarIFase vale 5 que eles el final

-Pasamos el DM.IBT.CommitRetaining; para que nuestros cambios se hagan efectivos

Por cierto hay otro cambio en el botón nuevo de este módulo donde pone

Código Delphi [-]
VarIRegistro:=DM.IBDConfiguracionNUMERADOR_CARGOS.Value;

debe ser

Código Delphi [-]
VarIRegistro:=DM.IBDConfiguracionNUMERADOR_MOVIMIENTOS.Value;