Ir al contenido



Foto

Tutorial vídeo club


  • Por favor identifícate para responder
67 respuestas en este tema

#41 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 714 mensajes
  • LocationEspaña

Escrito 28 febrero 2015 - 04:09

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

[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;[/code]

Esto fue bajado de http://www.planetade...ord-no-inputbox

Intentare explicarlo por encima


Justo despues de nuestro USES y antes del TYPE al principio de la unidad añadimos
 
[DELPHI] const    // InputBoxMessage = WM_USER + 200;    //Para imputboxt con password chard[/code]

En el Type en su parte private la lamada del procedimiento

[DELPHI] procedure InputBoxSetPasswordChar(var Msg: TMessage); message InputBoxMessage;[/code]

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

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

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
  • 0

#42 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 714 mensajes
  • LocationEspaña

Escrito 28 febrero 2015 - 06:25

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í

Imagen Enviada

y aquí tenéis el código completo

https://gist.github....637878de9278273

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

[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;[/DELPHI]

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

[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;[/DELPHI]

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

[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;[/DELPHI]

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

[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;[/DELPHI]

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

[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;
[/DELPHI]

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

#43 poliburro

poliburro

    Advanced Member

  • Administrador
  • 4.939 mensajes
  • LocationMéxico

Escrito 28 febrero 2015 - 10:55

Me gusta cómo va avanzando el tutorial... Todo muy sencillo y bien explicado. Gracias amigo.
  • 0

#44 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 714 mensajes
  • LocationEspaña

Escrito 01 marzo 2015 - 01:37

Me gusta cómo va avanzando el tutorial... Todo muy sencillo y bien explicado. Gracias amigo.


No gracias a ti amigo poliburro, que un maestro como tú piense eso de mi tutorial es algo muy grande :)
  • 0

#45 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 714 mensajes
  • LocationEspaña

Escrito 01 marzo 2015 - 02:26

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

Imagen Enviada

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

[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[/DELPHI]
  • 0

#46 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 714 mensajes
  • LocationEspaña

Escrito 01 marzo 2015 - 06:54

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

Imagen Enviada

y el código en:

https://gist.github....48a1622608c1734
  • 0

#47 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 714 mensajes
  • LocationEspaña

Escrito 01 marzo 2015 - 06:56

Formatos

Imagen Enviada

el código

https://gist.github....91b789fc000041d
  • 0

#48 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 714 mensajes
  • LocationEspaña

Escrito 01 marzo 2015 - 06:58

Cargos

Imagen Enviada

El código

https://gist.github....56b628d3e23f97b
  • 0

#49 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 714 mensajes
  • LocationEspaña

Escrito 01 marzo 2015 - 07:00

Valor de alquiler

Imagen Enviada

El código

https://gist.github....0131f48e6d15ea4
  • 0

#50 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 714 mensajes
  • LocationEspaña

Escrito 01 marzo 2015 - 07:03

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

[DELPHI]
//------------------------------------------------------------------------------
//*************************************************[ Pegarimagen ]****
//  Parte de la idea original de  Ricardo S.    [27/07/2013]
// bajada de http://www.clubdelph...ead.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.clubdelph...ead.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;[/DELPHI]


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
  • 0

#51 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 714 mensajes
  • LocationEspaña

Escrito 01 marzo 2015 - 07:07

Aquí el módulo de Formas de pago

Imagen Enviada


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....a21c39c22cb9ab8
  • 0

#52 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 714 mensajes
  • LocationEspaña

Escrito 01 marzo 2015 - 07:11

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

[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;[/DELPHI]



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


[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;[/DELPHI]
  • 0

#53 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 714 mensajes
  • LocationEspaña

Escrito 01 marzo 2015 - 07:42

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

Imagen Enviada

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

[img width=800 height=404]http://nsae02.casimages.net/img/2015/03/01/150301021447204726.jpg[/img]

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

El siguiente es el código

https://gist.github....17cef6c1c53c46f

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

[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;[/DELPHI]

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.

[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;
[/DELPHI]


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.

[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;[/DELPHI]

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

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

end;[/DELPHI]

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.
  • 1

#54 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 714 mensajes
  • LocationEspaña

Escrito 07 marzo 2015 - 04:06

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

Imagen Enviada

hablamos de los marcados con el 1

Este es el código para la baja

[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;[/DELPHI]


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

[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;[/DELPHI]

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

[DELPHI]DM.MiControlDeErrores(Dsprincipal,'UUnidades','Baja',E);[/DELPHI]

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

[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;[/DELPHI]

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

[DELPHI]  if ((DM.IBDUnidadesDISPONIBLE.Value='N') or (DM.IBDUnidadesPERDIDA.Value='S')) and (DM.IBDUnidadesVENDIDA.Value='N') then[/DELPHI]

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

[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;[/DELPHI]


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

[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;
[/DELPHI]

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.

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

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

Imagen Enviada
  • 0

#55 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 714 mensajes
  • LocationEspaña

Escrito 07 marzo 2015 - 06:45

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

Imagen Enviada

Y otra en ejecución

[img width=745 height=600]http://nsae02.casimages.net/img/2015/03/07/150307014538692842.jpg[/img]

El código en

https://gist.github....ebc05abf548bb61

  • 0

#56 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 714 mensajes
  • LocationEspaña

Escrito 07 marzo 2015 - 06:51

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
  • 0

#57 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 714 mensajes
  • LocationEspaña

Escrito 07 marzo 2015 - 06:53

Veamos los cambios en el DataModule (DM)

[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;[/DELPHI]

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

#58 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 714 mensajes
  • LocationEspaña

Escrito 07 marzo 2015 - 06:56

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

Imagen Enviada

El código

https://gist.github....1f5cd2b6ef0b6e2
  • 0

#59 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 714 mensajes
  • LocationEspaña

Escrito 07 marzo 2015 - 07:08

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


[DELPHI]//------------------------------------------------------------------------------
//**************************************************************[ SBnuevo ]*****
//------------------------------------------------------------------------------
var VarIRegistro:Integer;
    VarBSeguimos:Boolean;[/DELPHI]

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

[DELPHI]begin
    VarBSeguimos:=True;
    if DM.IBDClientes.IsEmpty then VarBSeguimos:=false;
    if DM.IBDCargos.IsEmpty then VarBSeguimos:=false;[/DELPHI]

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

[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; [/DELPHI]

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

[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;[/DELPHI]


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

[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;[/DELPHI]

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
  • 0

#60 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 714 mensajes
  • LocationEspaña

Escrito 07 marzo 2015 - 07:24

Sigamos con confirmar



[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;[/DELPHI]


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

[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;[/DELPHI]

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

[DELPHI]VarIRegistro:=DM.IBDConfiguracionNUMERADOR_CARGOS.Value;[/DELPHI]

debe ser

[DELPHI]VarIRegistro:=DM.IBDConfiguracionNUMERADOR_MOVIMIENTOS.Value;[/DELPHI]
  • 0