Tutorial vídeo club

[[José Luis Garcí]]

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

[[José Luis Garcí]]

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;
     1BESegundos.field.Value:=DBESegundos.field.Value+1;
     2BERegistros.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.

[[José Luis Garcí]]

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

[[José Luis Garcí]]

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

[[José Luis Garcí]]

Formatos



el código

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

[[José Luis Garcí]]

Cargos



El código

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

[[José Luis Garcí]]

Valor de alquiler



El código

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

[[José Luis Garcí]]

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

[[José Luis Garcí]]

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

[[José Luis Garcí]]

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;

[[José Luis Garcí]]

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 .

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.

[Ñuño Martínez]

Empezado por José Luis Garcí

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
(...)

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!

[[José Luis Garcí]]

Empezado por Ñuño Martínez

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

[[José Luis Garcí]]

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

[[José Luis Garcí]]

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

[[José Luis Garcí]]

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

[[José Luis Garcí]]

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

[[José Luis Garcí]]

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

[[José Luis Garcí]]

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

[[José Luis Garcí]]

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;