Programa de gestión desde 0

[[José Luis Garcí]]

Aquí la 2º parte del código del archivo pas 682 lineas


Aquí el código del archivo pas 682 lineas

Código Delphi [-]

procedure TUConfi.SpeedButtonBC10Click(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************************[ Carga texto ]****
//------------------------------------------------------------------------------
begin
  if OpenDialog1.Execute then
  begin
     DBIBMemo4.Lines.LoadFromFile(OpenPictureDialog1.FileName);
  end;
end;


procedure TUConfi.SpeedButtonBC11Click(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************************[ Pegar Texto ]****
// Pegamos del clipboard el texto
//------------------------------------------------------------------------------
begin
  DsPrincipal.DataSet.FieldByName('XLDPD3').Value:=Clipboard.AsText;
end;

procedure TUConfi.SpeedButtonBC12Click(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************************[ Carga texto ]****
//------------------------------------------------------------------------------
begin
  if OpenDialog1.Execute then
  begin
     DBIBMemo2.Lines.LoadFromFile(OpenPictureDialog1.FileName);
  end;
end;

procedure TUConfi.SpeedButtonBC15Click(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************[ Page Control pestaña anterior ]****
//------------------------------------------------------------------------------
begin
  if PGC.TabIndex>0 then PGC.TabIndex:=PGC.TabIndex-1;
end;

procedure TUConfi.SpeedButtonBC16Click(Sender: TObject);
//------------------------------------------------------------------------------
//****************************************[ Page Control siguiente pestaña ]****
//------------------------------------------------------------------------------
begin
  if PGC.TabIndexthen PGC.TabIndex:=PGC.TabIndex+1;
end;

procedure TUConfi.SpeedButtonBC1Click(Sender: TObject);
//------------------------------------------------------------------------------
//*********************************************************[ Cargar imagen ]****
//------------------------------------------------------------------------------
begin
  if OpenPictureDialog1.Execute then
  begin
     DBImage1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
  end;
end;

procedure TUConfi.SpeedButtonBC2Click(Sender: TObject);
//------------------------------------------------------------------------------
//*********************************************************[ 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
//------------------------------------------------------------------------------
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(Self);

  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;
          Errorx('Pegar-1','Ingredientes','Pegar','El Portapapeles contiene más de un único fichero. No es posible pegar','','',False,clSkyBlue,clNavy,500);
          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;
      Errorx('Pegar-2','Ingredientes','Pegar','Fichero seleccionado no contiene ninguna Imagen del Tipo JPEG o BMP','','',False,clSkyBlue,clNavy,500);
      Exit;
    end;

  end
  else if Clipboard.HasFormat(CF_BITMAP) then
    ImageAux.Picture.Assign(Clipboard)
  else begin
    ImageAux.Free;
    Errorx('Pegar-3','Ingredientes','Pegar','El Portapapeles no contiene ninguna Imagen del Tipo JPEG o BMP','','',False,clSkyBlue,clNavy,500);
    Exit;
  end;

  Jpg := TJpegImage.Create;
  try
    Jpg.Assign(ImageAux.Picture.Graphic);
  except
    ImageAux.Free;
    Errorx('Pegar-4','Ingredientes','Pegar','El Portapapeles no contiene ninguna Imagen del Tipo JPEG o BMP','','',False,clSkyBlue,clNavy,500);
    Jpg.Free;
    Exit;
  end;
  Jpg.Free;
  DBImage1.Picture.Assign(ImageAux.Picture);
end;

procedure TUConfi.SpeedButtonBC3Click(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************************[ Pegar Texto ]****
// Pegamos del clipboard el texto
//------------------------------------------------------------------------------
begin
  DsPrincipal.DataSet.FieldByName('XLDPD1').Value:=Clipboard.AsText;
end;

procedure TUConfi.SpeedButtonBC4Click(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************************************[ Cargar imagen ]****
//------------------------------------------------------------------------------
begin
  if OpenDialog1.Execute then
  begin
     DBIBMemo1.Lines.LoadFromFile(OpenPictureDialog1.FileName);
  end;
end;

procedure TUConfi.SpeedButtonBC5Click(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************************[ Pegar Texto ]****
// Pegamos del clipboard el texto
//------------------------------------------------------------------------------
begin
  DsPrincipal.DataSet.FieldByName('XLDPD2').Value:=Clipboard.AsText;
end;

procedure TUConfi.SpeedButtonBC6Click(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************************[ Carga texto ]****
//------------------------------------------------------------------------------
begin
  if OpenDialog1.Execute then
  begin
     DBIBMemo3.Lines.LoadFromFile(OpenPictureDialog1.FileName);
  end;
end;

procedure TUConfi.Timer1Timer(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************************[ El evento del Timer ]******
//------------------------------------------------------------------------------
begin
  SBBarraStatus.Panels[2].Text:=TimeToStr(now);
  if SBBarraStatus.Panels[1].Text<>DateToStr(Now) then SBBarraStatus.Panels[1].Text:=DateToStr(Now);
end;

end.

[[José Luis Garcí]]

y por último los componente usados.

He usado componentes estándar excepto , NewPAnelDb, SpeedButtonBC, GroupBoxJL, DbComboBoxExt, DBIBCheckbox, DBIBMemo que ya los he subido al club en su momento y que son gratuitos, pro último esta el DBColorBox que lo he creado esta tarde y que pongo su código a continuación

Componente DBColorBox

Código Delphi [-]
unit DBColorComboBox;

interface

uses
    WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,
     Forms, Graphics, Stdctrls, DbTables, DB, ExtCtrls, DBCtrls;

type
  TDBColorBox = class(TColorBox)
  private
    FDataLink : TFieldDataLink;
    procedure AutoInitialize;
    procedure AutoDestroy;
    function GetDataField : String;
    procedure SetDataField(Value : String);
    function GetDataSource : TDataSource;
    procedure SetDataSource(Value : TDataSource);
    procedure ActiveChange(Sender : TObject);
    procedure DataChange(Sender : TObject);
    procedure EditingChange(Sender : TObject);
    procedure UpdateData(Sender : TObject);
  protected
    procedure Change; override;
    procedure Click; override;
    procedure KeyPress(var Key : Char); override;
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property DataField :     String     read GetDataField         write SetDataField;
    property DataSource : TDataSource read GetDataSource         write SetDataSource;
end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Data Controls', [TDBColorBox]);
end;


procedure TDBColorBox.ActiveChange(Sender: TObject);
const IntFieldTypes = [ftSmallInt, ftInteger, ftWord];
begin
     if DataField = '' then Exit;
     if FDataLink <> nil then
        if FDataLink.Dataset <> nil then
           if FDataLink.Dataset.Active then  TColorBox(Self).Selected:=StringToColor(FDataLink.Dataset.FieldByName(DataField).AsString);
end;

procedure TDBColorBox.AutoDestroy;
begin
     FDataLink.Free;
end;

procedure TDBColorBox.AutoInitialize;
begin
     FDataLink := TFieldDataLink.Create;
     with FDataLink do
     begin
          OnDataChange := DataChange;
          OnUpdateData := UpdateData;
          OnEditingChange := EditingChange;
          OnActiveChange := ActiveChange;
     end;
end; { of AutoInitialize }

procedure TDBColorBox.Change;
begin
     inherited Change;
end;

procedure TDBColorBox.Click;
begin
     if DataField = '' then Exit;
     if FDataLink <> nil then
        if FDataLink.Dataset <> nil then
           if FDataLink.Dataset.Active then
              if FDataLink.Dataset.State in [dsEdit,dsInsert] then
              FDataLink.Dataset.FieldByName(DataField).Value:=ColorToString(TColorBox(Self).Selected);
     inherited Click;
end;

constructor TDBColorBox.Create(AOwner: TComponent);
begin
     inherited Create(AOwner);
     AutoInitialize;
end;

procedure TDBColorBox.DataChange(Sender: TObject);
begin
     if FDataLink.Field = nil then
     begin
        { No field assigned }
     end else
     begin
         if FDataLink.Dataset.FieldByName(DataField).AsString <> '' then  TColorBox(Self).Selected:=StringToColor(FDataLink.Dataset.FieldByName(DataField).AsString)
                                                                   else  TColorBox(Self).Selected:=clBlack;
     end
end;

destructor TDBColorBox.Destroy;
begin
     AutoDestroy;
     inherited Destroy;
end;

procedure TDBColorBox.EditingChange(Sender: TObject);
begin
      {...}
end;

function TDBColorBox.GetDataField: String;
begin
     Result := FDataLink.FieldName;
end;

function TDBColorBox.GetDataSource: TDataSource;
begin
      Result := FDataLink.DataSource;
end;

procedure TDBColorBox.KeyPress(var Key: Char);
const  TabKey = Char(VK_TAB);
       EnterKey = Char(VK_RETURN);
begin
     inherited KeyPress(Key);
end;

procedure TDBColorBox.Loaded;
begin
     inherited Loaded;
end;

procedure TDBColorBox.SetDataField(Value: String);
begin
      FDataLink.FieldName := Value;
end;

procedure TDBColorBox.SetDataSource(Value: TDataSource);
begin
      FDataLink.DataSource := Value;
end;

procedure TDBColorBox.UpdateData(Sender: TObject);
begin
//    FDataLink.Dataset.FieldByName(DataField).Value:=ColorToString(TColorBox(Self).Selected);
end;

end.

[mamcx]

Serie bueno que este tipo de cosas las pongan en un repositorio de codigo fuente. Un foro no es muy bueno pa mostar mas que unas cuantas lineas de codigo.

Te recomiendo github (git), bitbucket (git, mercurial) google (git, mercurial, subversion). Los 2 primeros son mas populares y mejores caracteristicas. Ademas, gratis.

Si no te interesa porque mucha vuelta usar git o mercurial, usa :

https://gist.github.com/

Que puedes postear multiples archivos en un solo gist, y es solo copiar y pegar el contenido. Ej:

https://gist.github.com/mamcx/3777791

P.D: No retrae de actualizar el foro, pero ftp y codigo esparcido es taan siglo XX

[[José Luis Garcí]]

Gracias mamcx, vere los enlaces que de dices.

[Casimiro Notevi]

Empezado por José Luis Garcí

Bueno aquí mi pantalla de configuración, por desgracia no soy muy bueno haciendo las pantallas vistosas

A mi me parecen bien, y a quien no le guste, que la cambie

[mamcx]

Eso es una queja constante entre programadores (no ser bueno en diseño). Pero ahora es mas facil que nunca dotar de una interface atractiva los programas. Una forma es usando un GUI Pack:

http://graphicriver.net/search?utf8=...&term=gui+pack

Y seguir las guis de buen diseño de apps, como la interface humana de Apple - que igual es aplicable a otras plataformas-.

Tambien se pueden copiar ideas de frameworks como http://twitter.github.io/bootstrap/. Con el nuevo estilo de "apps planas" que es la forma mas barata y directa de hacer un diseño "facil" no es complicado:

http://dribbble.com/search?q=flat+gui

Y con un conjunto de iconos decente (hay muchos iconos gratis como http://www.webappers.com/category/design/icons/ y de pago (estos los compre) http://www.iconshock.com) estamos casi listos.

[Casimiro Notevi]

Pero esas cosas no sirven para delphi, ¿no?

[mamcx]

Y porque no van a servir? Son solo graficos (pngs por ejemplo) e ideas para inspirarse. No es muy dificil de lograr una pantalla atractiva si se piensa en capas y se ajustan las cosas.

[PepeLolo]

Para la interface es cuestión de mirar aplicaciones y ver las partes que estéticamente quedan bien. Colores, agrupaciones, estilos, etc, cuestión de fisgar mucho.
Un ejercicio muy bueno es dibujar en papel lo que se quiere. No es necesario toda la interface de golpe sino lo repetitivo, ejemplo:
- Como voy a distribuir los botones de navegación y de acciones y donde colocarlos. Pues se pintan estos en un papel, se recortan y se reservan.
- Datos grupales, ejemplo "Dirección", los Pinto, los recorto y se reservan.
- Asi con cada grupo de botones, elementos, etc.

Cuando ya tienes un grupo de elementos habituales de la interface, sólo es cuestión de colocarlos sobre una superficie lisa y empezar a moverlos para ver como quedan mejor y seguir esa línea de trabajo.

Los recordables hacen mucho bien cuando no eres un manitas con el diseño.

[[José Luis Garcí]]

Primero disculparme por el retraso, pero debido a un problema en el apartado de configuración de un programa y a los dos componentes que ya he puesto aquí, no he podido seguir adecuadamente con el programa, en primer lugar un cambio en Data Module, quedando el código al final de la siguiente manera;

Código Delphi [-]
 //Primero añadimos las llamadas

    procedure conectar;
    procedure DataModuleCreate(Sender: TObject);

//y luego el código

implementation

{$R *.dfm}

procedure TDM.conectar;
//------------------------------------------------------------------------------
//**************************************************************[ Conectar ]****
//Nos permite conectar las tablas, querrys + IBDatabase + IBTransaction
//------------------------------------------------------------------------------
begin
   IBDatabase1.Connected:=True;            //La base de datos
  IBTransaction1.Active:=True;  //Las Tansacciones
   IBDCLIEN.Active:=True;        //La tabla Clientes
   IBDirecciones.Active:=True;   //La tabla Direcciones
   IBDPC.Active:=True;           //La tabla Personas de Contacto
   IBDContacto.Active:=True;     //La Tabla de datos de contacto
   IBDBcos.Active:=True;         //La tabla de Bancos
   IBDCONFI.Active:=True;        //La tabla de Configuración
   IBDUSUA.Active:=True;         //La tabla de usuarios (permisos de acceso)
end;

procedure TDM.DataModuleCreate(Sender: TObject);
//------------------------------------------------------------------------------
//************************************************************[ Al crearse ]****
// 1º Debemos irnoa l menú de Delphi a  Project > View Source y arir el proyecto
// 2º Según tengamos la carga del proyecto ponemos el modulo de datos el primero
// Con esto conseguimos la carga de la base de datos este ok
//------------------------------------------------------------------------------
begin
   VarBPrimeraConeccion:=False;        //Para sólo la primera conección con la base de datos
   IBDatabase1BeforeConnect(Sender);
end;

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

Ahora las tablas (las dejo como estaban pues supone cambiar todo el código, las que tenga que hacer nuevas ya aplicare los sabios concejos de los compañeros)

CREATE TABLE CLIENTES (
ID INTEGER NOT NULL,
NOMMODULO T20 /* T20 = VARCHAR(20) */, //Nombre del módulo*
CODIGO T20 /* T20 = VARCHAR(20) */, //Código asignado en este Módulo
NOMBRE T80 /* T80 = VARCHAR(80) */, //Nombre del cliente
FORMAPAGO T40 /* T40 = VARCHAR(40) */, //Forma de pago
FECHAALTA DATE, //Fecha de alta
DTO NUMERIC(15,4), //Dto máximo a aplicar (1)
NOTAS MEMO /* MEMO = BLOB SUB_TYPE 1 SEGMENT SIZE 80 */, //Campo memo para notas (se podría poner en una tabla independiente)
IMG IMG /* IMG = BLOB SUB_TYPE 0 SEGMENT SIZE 80 */, //Campo Imagen (se podría poner en una tabla independiente)
IMPUESTOS LOG /* LOG = CHAR(1) */, //Aplicar impuestos en nuestro caso sería S o N
TIPOIMP INTEGER, //Tipo de impuesto vinculado a La tabla de configuración
CIF T20 /* T20 = VARCHAR(20) */, //C.I.F., N.I.F. etc. (no ponemos comprobador, para que funcione con otros tipos de documentos)
RET LOG /* LOG = CHAR(1) */, //Usar la retenciones en nuestro caso sería S o N
PORRET POR /* POR = NUMERIC(15,4) */, //Porcentaje de retenciones vinculado a La tabla de configuración
TARIFA T20 /* T20 = VARCHAR(20) */, //Que tarifa de precios aplicaremos de la tabla artículos
USARRAPEL LOG /* LOG = CHAR(1) */, //Usar Rapel, si el cliente usa albaranes, sumaremos los artículos del código y se aplica el precio según el rapel
DIASPRESENT T20 /* T20 = VARCHAR(20) */, //Días de presentación de la factura/s
DIASDECOBRO T20 /* T20 = VARCHAR(20) */, //Días de cobro de la factura/s
AVISOS MEMO /* MEMO = BLOB SUB_TYPE 1 SEGMENT SIZE 80 */, //Campo memo para avisos (se podría poner en una tabla independiente) a la hora de facturar
LIMITECREDITO POR /* POR = NUMERIC(15,4) */, // Limite de crédito que asignamos, si lo sobrepasa nos avisa
PENDIENTEPAGO POR /* POR = NUMERIC(15,4) */, //El pendiente actual de crédito que tiene dispuesto
SECTOR T20 /* T20 = VARCHAR(20) */, //Sector que tipo de sector de trabaja (Hostelería, Automoción, etc)
CODAGENTE T20 /* T20 = VARCHAR(20) */ //Código del Agente (Comercial) asignado
);

[[José Luis Garcí]]

Primero explicar los * y el (1)

el * se refiere a NOMMODULO (Nombre del módulo) en el caso anterior seria (CLIENTES), si fuera Artículos sería (ARTICULOS), etc. en cuanto a CODIGO (Código asignado en el módulo). Funciona de la siguiente manera tenemos tablas con campos en común, como por ejemplo, Proveedores, Clientes, Personal, Agentes, etc tiene en común, los campos Teléfono, Móvil, email, Etc. al ponerlos en una tabla independiente para poder vincular los datos (Seguimos con el ejemplo clientes)de la tabla Contactos con la tabla clientes, usamos el NOMMODULO=CLIENTES y el CODIGO= al código asignado al cliente. de esta manera logramos poder tener varios medios de contacto, personas de contacto o bancos, por poner algunos ejemplos.

el (1) se refiere al campo DTO de la tabla CLIENTES, tenemos que tener en cuenta a la hora de hacer un documento de venta (Presupuesto, pedido, Albarán, factura, etc.), que el descuento aplicado al cliente puede ser superior o inferior al del artículo, yo normalmente suelo optar por si el del articulo menor que el del cliente cojo el del articulo, y si es mayor el del cliente.

[[José Luis Garcí]]

Ahora ale toca a la tabla bancos

CREATE TABLE BCOS (
ID INTEGER NOT NULL,
MODULO T20 /* T20 = VARCHAR(20) */,//Nombre del módulo*
CODIGO T20 /* T20 = VARCHAR(20) */, //Código asignado en este Módulo
BANCO T80 /* T80 = VARCHAR(80) */, //Nombre del Banco
ENTIDAD INTEGER,//Dígitos de la entidad de la cuenta corriente
OFICINA INTEGER,//Dígitos de la oficina de la cuenta corriente
DC INTEGER,//Dígitos de control de la cuenta corriente
TF T20 /* T20 = VARCHAR(20) */,//Teléfono de la sucursal
CUENTA INTEGER//Dígitos de la entidad //Dígitos de la cuenta corriente( Podría usar un varchar, pero personalmente me gusta más un integer)
);

[[José Luis Garcí]]

Ahora toca a contactos

CREATE TABLE CONTACTOS (
ID INTEGER NOT NULL,
MODULO T20 /* T20 = VARCHAR(20) */,//Nombre del módulo*
CODIGO T20 /* T20 = VARCHAR(20) */, //Código asignado en este Módulo
NOMBRE T80 /* T80 = VARCHAR(80) */, //Nombre sea entidad o persona física (de esta manera, tenemos ya la agenda de contactos sin ninguna tabla adicional)
TF T20 /* T20 = VARCHAR(20) */, //Teléfono
TF2 T20 /* T20 = VARCHAR(20) */, //2º número de teléfono
FAX T20 /* T20 = VARCHAR(20) */, //Número de fax
MAIL T80 /* T80 = VARCHAR(80) */, //Email
MAIL2 T80 /* T80 = VARCHAR(80) */, //Si dispone de un segundo email
WEB T80 /* T80 = VARCHAR(80) */, //Dirección de la página web
CLAVEWEB T40 /* T40 = VARCHAR(40) */, //Si para acceder a la web tiene clave (este campo ha de ser ocultado según el acceso que tenga la persona que esta consultando)
MOVIL T20 /* T20 = VARCHAR(20) */, //Número de móvil
MOVIL2 T20 /* T20 = VARCHAR(20) */, //Si disponemos de otro número de móvil
NOTAS MEMO /* MEMO = BLOB SUB_TYPE 1 SEGMENT SIZE 80 */ //Campo memo para notas (se podría poner en una tabla independiente)
);

[[José Luis Garcí]]

Ahora direcciones

CREATE TABLE DIRECCIONES (
ID INTEGER NOT NULL,
MODULO T20 /* T20 = VARCHAR(20) */,//Nombre del módulo*
CODIGO T20 /* T20 = VARCHAR(20) */, //Código asignado en este Módulo
DIRECCION T80 /* T80 = VARCHAR(80) */, //Dirección
CP T10 /* T10 = VARCHAR(20) */, //Código postal
POBLACION T80 /* T80 = VARCHAR(80) */, //Población
PROVINCIA T80 /* T80 = VARCHAR(80) */, //Provincia
TF T20 /* T20 = VARCHAR(20) */, //Teléfono
NOTA MEMO /* MEMO = BLOB SUB_TYPE 1 SEGMENT SIZE 80 */, //Campo memo para notas (se podría poner en una tabla independiente)
PAIS T20 /* T20 = VARCHAR(20) */ //País
);

[[José Luis Garcí]]

y ya hoy por último

Código Delphi [-]
CREATE TABLE PC (
    ID          INTEGER NOT NULL,
MODULO T20 /* T20 = VARCHAR(20) */,//Nombre del módulo*
CODIGO T20 /* T20 = VARCHAR(20) */, //Código asignado en este Módulo
    NOMBRE      T80 /* T80 = VARCHAR(80) */,  //Nombre de la persona de contacto
    MOVIL       T40 /* T40 = VARCHAR(40) */,  //Número de móvil
    EMAIL       T80 /* T80 = VARCHAR(80) */,  //Email
    CASADO      LOG /* LOG = CHAR(1) */,    //Esta caso (S o N)
    HIJOS       LOG /* LOG = CHAR(1) */,    //Tiene Hijos (S o N)
    FECHANACIM  DATE,     //Fecha de nacimiento. (Teniendo este dato podemos hacer que el programa nos avise en la fecha)
    PUESTO      T40 /* T40 = VARCHAR(40) */,  //Puesto que ocupa
    EXT         T10 /* T10 = VARCHAR(20) */,  //Si para llamarlo tiene extensión desde una centralita
    NOTAS       MEMO /* MEMO = BLOB SUB_TYPE 1 SEGMENT SIZE 80 */,  //Campo memo para notas (se podría poner en una tabla independiente) (aquí podriamos los datos del nombre de la mujer y de los hijos si esta casado y tiene claro)
    FOTO        IMG /* IMG = BLOB SUB_TYPE 0 SEGMENT SIZE 80 */  //Campo Imagen (se podría poner en una tabla independiente)
);

Espero poder mañana terminar un poco de código que me queda de estos módulos y lo subo.

[[José Luis Garcí]]

Ahora voy a poner las funciones usadas

Archivo: FUN_DBGRID

La siguiente función no tiene descripción, pero lo que hace es colocar el grid con dos colores, ver en el código de los módulos para que quede más claro

Código Delphi [-]
function Zebrado(DST:TDataSource; GridsDb:TDBGrid; Rect:TRect; Column:TColumn; State:TGridDrawState; ColorA:TColor=clWhite; Colorb:TColor=clMoneyGreen; ColorSelect:TColor=clAqua):Boolean;
begin
   if not odd(DST.dataSet.RecNo) then GridsDb.Canvas.Brush.Color := Colorb
                                else GridsDb.Canvas.Brush.Color := Colora;
    TDbGrid(GridsDb).Canvas.font.Color:= clBlack;
    if gdSelected in State then
    with (GridsDb as TDBGrid).Canvas do
    begin
        Brush.Color := ColorSelect;
        FillRect(Rect);
        Font.Style := [fsbold]
    end;
     TDbGrid(GridsDb).DefaultDrawDataCell(Rect,TDbGrid(GridsDb).columns[Column.ID].field, State);
     Result:=True;
End;

Ahora pongo el módulo completo Fun_Errores:

Código Delphi [-]
unit Fun_Errores;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms;

function ErrorDetail(Error:string):string;

function ErrorX(ID:string='';
               Unidad:string='';
               Modulo:STring='';
               Mensaje:string='';
               Clase_Error:string='';
               Mensaje_Error:string='';
               B_Salir:Boolean=False;
               Color:TColor=clBtnFace;
               FontColor:TColor=clMaroon;
               Delay:Integer=500):string;

implementation
 uses UErrores;   //Modulo para mostrar el Error

//------------------------------------------------------------------------------
//***********************************************[ ErrorX ]*******
// 18/10/2011 JLGT basada en la idea del Compañero enecumene
//  Expuesta en http://www.delphiaccess.com/forum/(d...ersonalizadas/
//  Nos muestra una pantalla para los errores, que dados unos parámetros, mostrara
//  más o menos información, Devuelve como hemos cerrado
//---[Parámetros]---------------------------------------------------------------
//  Parámetro       Tipo         Por defecto    Explicación
//  --------------  -----------  -------------  --------------------------------
//  ID              string       ''             Identificador del error, nos permite encontrar a los programadores
//                                              con mayor facilidad, donde se ha producido el error si es '' no se muestra
//  Unidad          string       ''             Form si es '' no se muestra
//  Modulo          STring       ''             Donde esta el control de la Excepción (Grabar, borrar, etc) si es '' no se muestra
//  Mensaje         string       ''             Mensaje que queremos mostrar, no es eliminable
//  Clase_Error     string       ''             Clase del error (E.ClassName) si es '' no se muestra
//  Mensaje_Error   string       ''             Muestra una breve nota del por que del error, si esta dentro de la
//                                              lista de ErrorDetail, será en Español, en caso contrario muestra el mensaje originas,
//                                              si es '' no se muestra
//  B_Salir         Boolean     False           Muestra el botón salir, aparte del botón continuar(fijo),
//                                              dándonos opciones en el result diferente, por si queremos cerrar el programa después
//                                              del Error, si es false no se muestra
//  Color           TColor      clBtnFace       Color de los paneles
//  FontColor       TColor      clMaroon        Color en el que nos mostrara los textos
//  Delay           Integer     500             Parpadeo del icono de error y el mensaje de error (se alternan)
//--EJEMPLOS--------------------------------------------------------------------
//  procedure TForm1.BitBtn1Click(Sender: TObject);
//  var i : integer;
//      VarSdev:string;
//  begin
//    num:=10;
//    try
//    i := StrToInt(Edit1.Text);
//      Label1.caption := format('El cuadrado es: %d', [ i * i ]);
//    except
//         on E: Exception do
//         begin
//            VarSdev:=Errorx('125','Form1','Buton1','Error adrede',E.ClassName,E.Message,False,clTeal,clNavy,500);
//            Memo1.Lines.Add(DateToStr(now)+' - '+varsdev);
//            VarSdev:=Errorx('125','Form1','Buton1','Error adrede','','',False,clMoneyGreen,clRed,500);
//            Memo1.Lines.Add(DateToStr(now)+' - '+varsdev);
//            VarSdev:=Errorx('125','','Buton1','Error adrede',E.ClassName,E.Message,True,clMoneyGreen,clBlue,250);
//            Memo1.Lines.Add(DateToStr(now)+' - '+varsdev);
//            VarSdev:=Errorx('125','Form1','Buton1','Error adrede',E.ClassName,E.Message,False,clTeal,clPurple,500);
//            Memo1.Lines.Add(DateToStr(now)+' - '+varsdev);
//            VarSdev:=Errorx('125','Form1','Buton1','Error adrede',E.ClassName,E.Message,False,$000066FF,clAqua,50);
//            Memo1.Lines.Add(DateToStr(now)+' - '+varsdev);
//         end;
//    end;
//  end;
//------------------------------------------------------------------------------
function ErrorX(ID:string='';
               Unidad:string='';
               Modulo:STring='';
               Mensaje:string='';
               Clase_Error:string='';
               Mensaje_Error:string='';
               B_Salir:Boolean=False;
               Color:TColor=clBtnFace;
               FontColor:TColor=clMaroon;
               Delay:Integer=500):string;
begin
   try // Bajado del Club delphi   // FEnvases =form
      if not Assigned(FError) then  Ferror := TFerror.Create(nil);
      begin
          FError.LabeledEdit1.Font.Color:=FontColor;
          FError.LabeledEdit2.Font.Color:=FontColor;
          FError.LabeledEdit3.Font.Color:=FontColor;
          FError.LabeledEdit4.Font.Color:=FontColor;
          FError.Memo1.Font.Color:=FontColor;
          FError.Memo2.Font.Color:=FontColor;
          if (ID='')  then Ferror.LabeledEdit1.visible:=False
                                 else
                                 begin
                                      FError.LabeledEdit1.visible:=True;
                                      FError.LabeledEdit1.text:=ID;
                                 end;
          if (Unidad='')  then FError.LabeledEdit2.visible:=False
                                 else
                                 begin
                                      FError.LabeledEdit2.visible:=True;
                                      FError.LabeledEdit2.text:=Unidad;
                                 end;
          if (Modulo='') then FError.LabeledEdit3.visible:=False
                                 else
                                 begin
                                      FError.LabeledEdit3.visible:=True;
                                      FError.LabeledEdit3.text:=Modulo;
                                 end;
          if (Clase_Error='') then FError.LabeledEdit4.visible:=False
                                 else
                                 begin
                                      FError.LabeledEdit4.visible:=True;
                                      FError.LabeledEdit4.text:=Clase_Error;
                                 end;
          FError.Memo1.lines.Clear;
          FError.Memo1.lines.Add(Mensaje);
          if (Mensaje_Error='') then
          begin
             FError.Memo1.Height:=265;
             FError.Memo2.Visible:=False;
          end
          else
          begin
             FError.Memo1.Height:=105;
             FError.Memo2.Visible:=True;
             FError.memo2.lines.Clear;
             if errorDetail(Clase_Error)<>Clase_Error then FError.Memo2.lines.Add(errorDetail(Clase_Error)+#13#10+'---Mensaje Original---------------------------------------'+#13#10+Mensaje_Error)
                                                      else FError.Memo2.lines.Add(Mensaje_Error);
          end;
          if (B_Salir=False) then  FError.SpeedButton1.visible:=false
                               else  FError.SpeedButton1.visible:=True;
          FError.Panel1.Color:=Color;
          FError.Panel2.Color:=Color;
          FError.Timer1.interval:=Delay;
          FError.ShowModal;
      end
   finally
    Result:=FError.VarSFErrorResult;
   end;
end;


//------------------------------------------------------------------------------
//********************************************[ ErroDetail ]*******
// 18/10/2011 JLGT Si damos la Clase del error nos da un texto mas Descriptivo
//--Ejemplo---------------------------------------------------------------------
// var MenError
// ...
//  Showmessage(ErrorDetail(E.ClassName));
//------------------------------------------------------------------------------
function ErrorDetail(Error:string):string;
begin
   Result:=Error;
   if Trim(UpperCase(Error))=Trim(UpperCase('EAbort')) then Result:='Finaliza la secuencia de eventos sin mostrar el mensaje de error.';
   if Trim(UpperCase(Error))=Trim(UpperCase('EAccessViolation')) then Result:='Comprueba errores de acceso a memoria inválidos.';
   if Trim(UpperCase(Error))=Trim(UpperCase('EBitsError')) then Result:='Previene intentos para acceder a arrays de elementos booleanos. ';
   if Trim(UpperCase(Error))=Trim(UpperCase('EComponentError')) then Result:='Nos informa de un intento inválido de registrar o renombrar un componente. ';
   if Trim(UpperCase(Error))=Trim(UpperCase('EConvertError')) then Result:='Muestra un error al convertir objetos o cadenas de texto string. ';
   if Trim(UpperCase(Error))=Trim(UpperCase('EDatabaseError')) then Result:='Especifica un error de acceso a bases de datos. ';
   if Trim(UpperCase(Error))=Trim(UpperCase('EDBEditError')) then Result:='Error al introducir datos incompatibles con una máscara de texto. ';
   if Trim(UpperCase(Error))=Trim(UpperCase('EDivByZero')) then Result:='Errores de división por cero. ';
   if Trim(UpperCase(Error))=Trim(UpperCase('EExternalException')) then Result:='Significa que no reconoce el tipo de excepción (viene de fuera). ';
   if Trim(UpperCase(Error))=Trim(UpperCase('EIntOutError')) then Result:='Representa un error de entrada/salida a archivos. ';
   if Trim(UpperCase(Error))=Trim(UpperCase('EIntOverflow')) then Result:='Especifica que se ha provocado un desbordamiento de un tipo de dato. ';
   if Trim(UpperCase(Error))=Trim(UpperCase('EInvalidCast')) then Result:='Comprueba un error de conversión de tipos ';
   if Trim(UpperCase(Error))=Trim(UpperCase('EInvalidGraphic')) then Result:='Indica un intento de trabajar con gráficos que tienen un formato desconocido. ';
   if Trim(UpperCase(Error))=Trim(UpperCase('EInvalidOperation')) then Result:='Ocurre cuando se ha intentado realizar una operación inválida sobre un componente.';
   if Trim(UpperCase(Error))=Trim(UpperCase('EInvalidPointer')) then Result:='Se produce en operaciones con punteros inválidos.';
   if Trim(UpperCase(Error))=Trim(UpperCase('EMenuError')) then Result:='Controla todos los errores relacionados con componentes de menú.';
   if Trim(UpperCase(Error))=Trim(UpperCase('EOleCtrlError')) then Result:='Detecta problemas con controles ActiveX.';
   if Trim(UpperCase(Error))=Trim(UpperCase('EOleError')) then Result:='Especifica errores de automatización de objetos OLE.';
   if Trim(UpperCase(Error))=Trim(UpperCase('EPrinterError')) then Result:='Errores al imprimir.';
   if Trim(UpperCase(Error))=Trim(UpperCase('EPropertyError')) then Result:=' Ocurre cuando se intenta asignar un valor erroneo a una propiedad del componente.';
   if Trim(UpperCase(Error))=Trim(UpperCase('ERangeError')) then Result:='Indica si se intenta asignar un número entero demasiado grande a una propiedad. ';
   if Trim(UpperCase(Error))=Trim(UpperCase('ERegistryExcepcion')) then Result:='Controla los errores en el registro. ';
   if Trim(UpperCase(Error))=Trim(UpperCase('EZeroDivide')) then Result:='Controla los errores de división para valores reales. ';
   if Trim(UpperCase(Error))=Trim(UpperCase('ArgumentException')) then Result:='Pasado argumento no válido (base de excepciones de argumentos) ';
   if Trim(UpperCase(Error))=Trim(UpperCase('ArgumentNullException')) then Result:='Pasado argumento nulo';
   if Trim(UpperCase(Error))=Trim(UpperCase('ArgumentOutOfRangeException')) then Result:='Pasado argumento fuera de rango ';
   if Trim(UpperCase(Error))=Trim(UpperCase('ArrayTypeMistmatchException')) then Result:='Asignación a tabla de elemento que no es de su tipo';
   if Trim(UpperCase(Error))=Trim(UpperCase('COMException')) then Result:='Excepción de objeto COM ';
   if Trim(UpperCase(Error))=Trim(UpperCase('DivideByZeroException')) then Result:='División por cero ';
   if Trim(UpperCase(Error))=Trim(UpperCase('IndexOutOfRangeException')) then Result:='Índice de acceso a elemento de tabla fuera del rango válido (menor que cero o mayor que el tamaño de la tabla) ';
   if Trim(UpperCase(Error))=Trim(UpperCase('InvalidCastException')) then Result:='Conversión explícita entre tipos no válida ';
   if Trim(UpperCase(Error))=Trim(UpperCase('InvalidOperationException')) then Result:='Operación inválida en estado actual del objeto ';
   if Trim(UpperCase(Error))=Trim(UpperCase('InteropException')) then Result:='Base de excepciones producidas en comunicación con código inseguro ';
   if Trim(UpperCase(Error))=Trim(UpperCase('NullReferenceException')) then Result:='Acceso a miembro de objeto que vale null ';
   if Trim(UpperCase(Error))=Trim(UpperCase('OverflowException')) then Result:='Desbordamiento dentro de contexto donde se ha de comprobar los desbordamientos (expresión constante, instrucción checked, operación checked u opción del compilador /checked)';
   if Trim(UpperCase(Error))=Trim(UpperCase('OutOfMemoryException')) then Result:='Falta de memoria para crear un objeto con new ';
   if Trim(UpperCase(Error))=Trim(UpperCase('SEHException')) then Result:='Excepción SHE del API Win32 ';
   if Trim(UpperCase(Error))=Trim(UpperCase('StackOverflowException')) then Result:='Desbordamiento de la pila, generalmente debido a un excesivo número de llamadas recurrentes. ';
   if Trim(UpperCase(Error))=Trim(UpperCase('EConvertError')) then Result:='No se puede convertir esa cadena';
   if Trim(UpperCase(Error))=Trim(UpperCase('TypeInizializationException')) then Result:='Ha ocurrido alguna excepción al inicializar los campos estáticos o el constructor estático de un tipo. En InnerException se indica cuál es.';
end;

end.

[[José Luis Garcí]]

Aquí la imagen del modulo necesario para la función ErrorX



y el código del módulo

Código Delphi [-]
unit UErrores;

interface

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

type
  TFError = class(TForm)
    Panel1: TPanel;
    Image1: TImage;
    Label1: TLabel;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    LabeledEdit3: TLabeledEdit;
    Label2: TLabel;
    Timer1: TTimer;
    Memo1: TMemo;
    LabeledEdit4: TLabeledEdit;
    Label3: TLabel;
    Memo2: TMemo;
    Panel2: TPanel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    procedure Timer1Timer(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    var VarSFErrorResult:string;
  end;

var
  FError: TFError;

implementation

{$R *.dfm}

procedure TFError.FormActivate(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************[ Al Activarse ]*******
//------------------------------------------------------------------------------
begin
  if Timer1.Enabled=false then Timer1.Enabled:=True;
end;

procedure TFError.FormClose(Sender: TObject; var Action: TCloseAction);
//------------------------------------------------------------------------------
//*******************************************[ Al Cerrarse ]*******
//------------------------------------------------------------------------------
begin
  if VarSFErrorResult='' then VarSFErrorResult:='Omisión';
  if Timer1.Enabled=true then Timer1.Enabled:=False;
  if Image1.Visible=false then Image1.Visible:=True;
  if Label1.Visible=False then Label1.Visible:=True;
end;

procedure TFError.SpeedButton1Click(Sender: TObject);
//------------------------------------------------------------------------------
//************************************************[ Salir ]*******
//------------------------------------------------------------------------------
begin
  VarSFErrorResult:='Salir';
  Close;
end;

procedure TFError.SpeedButton2Click(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************[ Continuar ]*******
//------------------------------------------------------------------------------
begin
 VarSFErrorResult:='Continuar';
 Close;
end;

procedure TFError.Timer1Timer(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************[ Timer ]*******
//------------------------------------------------------------------------------
begin
    if Image1.Visible=true then
    begin
          Image1.Visible:=False;
          Label1.Visible:=True;
    end else
    begin
          Image1.Visible:=True;
          Label1.Visible:=False
    end;
end;

end.

[[José Luis Garcí]]

Seguimos con las funciones

De mi archivo Fun.pas

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;
        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;

//-----------------------------------------------------------------------------
//******************************************[ ActIBDataset ]******
//  15/02/2011  JLGT  Para modificar la sentencia de un TIbdataset
//-----------------------------------------------------------------------------
//  Estudiando como poder hacer mi código mas corto se me ocurrió esta función
//  para usar un los Tibdataset basada en mi otra función ActQuerry, para mi base
//  de datos Firebird.
//  El tema es que cada vez que utilizo un Ibdtatset y lo modifico tengo que
//  escribir unas 4 lineas y mediante este sistema, logro reducirlo a una sola
//  ya que es un, código repetitivo y soló varia el nombre del Ibdtaset y la
//  sentencia Sql, cree esta función
//-----------------------------------------------------------------------------
//  Base de datos a usar CLIENTES //El error podría ser otro pero es un ejemplo
//   if ActIbdataset(IBDataset,'Select * form Clientex')=true then  showmessage('Existe la base de datos')
//                                                                              else showmessage('No existe la base de datos');
//-----------------------------------------------------------------------------
function ActIbdataset(ibdata: TIBDataSet; SQL:string):Boolean;
var VPorsiacaso:string;
begin
  VPorsiacaso:=ibdata.SelectSQL.Text;  //Por si falla
  try
    try
      ibdata.Active:=False;
      ibdata.SelectSQL.Clear;
      ibdata.SelectSQL.Add(SQL);
      ibdata.Active:=True;
      Result:=true
    except
      on E: Exception do
      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');
        Result:=false;
      end;
    end;
  finally
     if Result=false then
     begin
        ibdata.Active:=false;
        ibdata.SelectSQL.Clear;
        ibdata.SelectSQL.Add(VPorsiacaso);
        ibdata.Active:=true;
     end;
  end;
end;

//-----------------------------------------------------------------------------
//********************************************[ QuerryOC ]******
//  07/10/2011  JLGT  Para comprobar y cerrar o abrir un querry
//-----------------------------------------------------------------------------
//  Para evitar tener que repetir el mismo código una y otra vez, abreviando lo
//  considerablemente
//-----------------------------------------------------------------------------
// [QRY]              Tibquery a actualizar
// [OpenClose]        Valor Bolean True, comprueba si no esta activo y lo activa
//                                 False, hace todo lo Contrario, por defecto False
//-----------------------------------------------------------------------------
//  Querry a usar CLIENTES
//  QuerryOC(Clientes);  //Es igual que if Cliente.active=true then Clientes.active=false;
//  y QuerryOC(Clientes,True); // igual que Cliente.active=False then Clientes.active=True;
//-----------------------------------------------------------------------------
Function QuerryOC(QRY:TIBQuery; OpenClose:boolean=False): Boolean;
begin
  if OpenClose=true then
  begin
    if QRY.Active=false then QRY.Active:=true;
    Result:=True;
  end else
  begin
    if QRY.Active=true then  QRY.Active:=False;
    Result:=False;
  end;
end;


//------------------------------------------------------------------------------
//*********************************************[ SoloInteger ]****
// 14/07/2012 JLGT nos devuelve un número entero, aunque la cadena tenga letras
// en caso de no tener ninguno devuelve 0
// Nace con la idea de usarlo para las numeraciones de Documentos, así aunque tenga
// letras, nos da un numero al que podemos incrementar o usar en el método deseado
//------------------------------------------------------------------------------
// [Cadena]     String     Cadena a pasar
//------------------------------------------------------------------------------
//---Ejemplo--------------------------------------------------------------------
//  SoloInteger('A1fa120 eco89');  //=112089
//------------------------------------------------------------------------------
function SoloInteger(cadena:string):Integer;
var VarSCadena,VarSCaracter:String;
    VarIContadorFor:Integer;
begin
    VarSCadena:='';
    for VarIContadorFor := 1 to Length(cadena) do
    begin
      VarSCaracter:=Copy(cadena,VarIContadorFor,1);
      if VarSCaracter='0' then VarSCadena:=VarSCadena+'0';
      if VarSCaracter='1' then VarSCadena:=VarSCadena+'1';
      if VarSCaracter='2' then VarSCadena:=VarSCadena+'2';
      if VarSCaracter='3' then VarSCadena:=VarSCadena+'3';
      if VarSCaracter='4' then VarSCadena:=VarSCadena+'4';
      if VarSCaracter='5' then VarSCadena:=VarSCadena+'5';
      if VarSCaracter='6' then VarSCadena:=VarSCadena+'6';
      if VarSCaracter='7' then VarSCadena:=VarSCadena+'7';
      if VarSCaracter='8' then VarSCadena:=VarSCadena+'8';
      if VarSCaracter='9' then VarSCadena:=VarSCadena+'9';
    end;
    if VarSCadena='' then VarSCadena:='0';
    Result:=StrToInt(VarSCadena);
end;

Si veis que se me ha pasado poner alguna función por favor decidme lo.

[[José Luis Garcí]]

Empezamos con el módulo clientes
Aquí os pongo la imagen



Por cierto me he dado cuenta al poner la imagen en la pestaña otros datos el botón que pone siguiente debe poner anterior

y aquí como me aconsejo mamcx os pongo el enlace para que veáis el código https://gist.github.com/anonymous/5692959

[[José Luis Garcí]]

Ahora el modulo que reúne las direcciones


Aquí la imagen




Aquí el código https://gist.github.com/anonymous/5693046