Programa de gestión desde 0
 

Hola compañeros mi idea es montar un programa de gestión desde 0, por supuesto animo a los compañeros a corregirme, aportar y a criticar, sugerir etc. En primer lugar decir que no creo que yo sea el más adecuado para crear un programa desde 0 pero, como empiezo uno nuevo he dicho por que no, lo voy haciendo y lo publico.

He de decir que lo haré a ratos y mientras pueda y tenga disponibilidad y siempre que los miembros del club estén de acuerdo con la idea.

Intentare ser los más especifico posible y explicar todo claramente, espero perdonéis mis faltas de ortografía.

Por que hacer otro programa de gestión, por que por lo que veo, falta muchas cosas en los programas de gestión que se suelen hacer, ejemplos ADR, LOPD, REQ términos que ya iré especificando y que son muy muy sencillos de llevar al programa:rolleyes:

Por supuesto como lo hago con mi sistema, pondré que componentes uso, el código completo del modulo y una imagen del mismo, usaré los estándar de Delphi y los míos propios, lo haré con firbird y Delphi 2010 e Ibexpert edición personal, si hubiese otros programas ya os iria diciendo.

Doy por hecho que sabéis, usarlos y por lo tanto crear la base de datos, tablas, dominios, formularios, aplicaciones, etc.

Aquí pongo una imagen de los dominios usados



Pues bien comenzamos creando la B.D. en mi caso la llamo PGF2 (Programa de Gestión y Fabricación) y creamos la tabla Confi (Configuración), a cada campo le e antepuesto la X para cuando estemos haciendo consultas sepamos si es de la configuración o de la tabla que sea oportuna. Aquí os pongo la estructura de la tabla:

Código Delphi [-]
 CREATE TABLE CONFI (                                         
    ID               INTEGER NOT NULL,        
    XEMPRESA         T80 /* T80 = VARCHAR(80) */,
    XCALLE           T80 /* T80 = VARCHAR(80) */,
    XCP              T10 /* T10 = VARCHAR(20) */,
    XPOBLACION       T80 /* T80 = VARCHAR(80) */,
    XPROVINCIA       T80 /* T80 = VARCHAR(80) */,
    XTF              T20 /* T20 = VARCHAR(20) */,
    XTF2             T20 /* T20 = VARCHAR(20) */,
    XLOGO            IMG /* IMG = BLOB SUB_TYPE 0 SEGMENT SIZE 80 */,
    XWEB             T80 /* T80 = VARCHAR(80) */,
    XEMAIL           T80 /* T80 = VARCHAR(80) */,
    XMOVIL           T20 /* T20 = VARCHAR(20) */,
    XFAX             T20 /* T20 = VARCHAR(20) */,
    XCIF             T20 /* T20 = VARCHAR(20) */,
    XREGMERCANTIL    T80 /* T80 = VARCHAR(80) */,
    XNOTA            MEMO /* MEMO = BLOB SUB_TYPE 1 SEGMENT SIZE 80 */,
    XCOLORA          T20 /* T20 = VARCHAR(20) */,
    XCOLORB          T20 /* T20 = VARCHAR(20) */,
    XCOLORACT        T20 /* T20 = VARCHAR(20) */,
    XCOLORNOACT      T20 /* T20 = VARCHAR(20) */,
    XNUMPRE          T20 /* T20 = VARCHAR(20) */,
    XNUMPED          T20 /* T20 = VARCHAR(20) */,
    XNUMALB          T20 /* T20 = VARCHAR(20) */,
    XNUMFAC          T20 /* T20 = VARCHAR(20) */,
    XNUMLOTE         T20 /* T20 = VARCHAR(20) */,
    XNUMCLI          T20 /* T20 = VARCHAR(20) */,
    XNUMPRO          T20 /* T20 = VARCHAR(20) */,
    XNUMAGEN         T20 /* T20 = VARCHAR(20) */,
    XNUMALMACEN      T20 /* T20 = VARCHAR(20) */,
    XNUMALMACENDEF   T20 /* T20 = VARCHAR(20) */,
    XLARGOLOTE       INTEGER,
    XLARGONUM        INTEGER,
    XSERIE           T3 /* T3 = VARCHAR(3) */,
    XSERIE2          T3 /* T3 = VARCHAR(3) */,
    XSERIE3          T3 /* T3 = VARCHAR(3) */,
    XUASARSERIEYEAR  LOG /* LOG = CHAR(1) */,
    XLDPD1           MEMO /* MEMO = BLOB SUB_TYPE 1 SEGMENT SIZE 80 */,
    XLDPD2           MEMO /* MEMO = BLOB SUB_TYPE 1 SEGMENT SIZE 80 */,
    XLDPD3           MEMO /* MEMO = BLOB SUB_TYPE 1 SEGMENT SIZE 80 */,
    XNOMMONEDA       T10 /* T10 = VARCHAR(20) */,
    XNOMIMPUESTO     T10 /* T10 = VARCHAR(20) */,
    XDESIMP1         T20 /* T20 = VARCHAR(20) */,
    XIMP1            POR /* POR = NUMERIC(15,4) */,
    XDESIMP2         T20 /* T20 = VARCHAR(20) */,
    XIMP2            POR /* POR = NUMERIC(15,4) */,
    XDESIMP3         T20 /* T20 = VARCHAR(20) */,
    XIMP3            POR /* POR = NUMERIC(15,4) */,
    XDESIMP4         T20 /* T20 = VARCHAR(20) */,
    XIMP4            POR /* POR = NUMERIC(15,4) */,
    XDESREQ1         T20 /* T20 = VARCHAR(20) */,
    XREQ1            POR /* POR = NUMERIC(15,4) */,
    XDESREQ2         T20 /* T20 = VARCHAR(20) */,
    XREQ2            POR /* POR = NUMERIC(15,4) */,
    XDESREQ3         T20 /* T20 = VARCHAR(20) */,
    XREQ3            POR /* POR = NUMERIC(15,4) */,
    XDESREQ4         T20 /* T20 = VARCHAR(20) */,
    XREQ4            POR /* POR = NUMERIC(15,4) */,
    XMODCOPIASEG     T20 /* T20 = VARCHAR(20) */
);

Ahora iré detallando los campos

Código Delphi [-]
    ID               INTEGER NOT NULL,                          //Campo  de identificación y con el Primary Key

{----------------------------------------------------------------------------------------------------------------
 Datos de la empresa
 ----------------------------------------------------------------------------------------------------------------}
    XEMPRESA         T80 /* T80 = VARCHAR(80) */,       //Nombre
    XCALLE           T80 /* T80 = VARCHAR(80) */,         //Calle
    XCP              T10 /* T10 = VARCHAR(20) */,           //Código Postal
    XPOBLACION       T80 /* T80 = VARCHAR(80) */,      //Población
    XPROVINCIA       T80 /* T80 = VARCHAR(80) */,      //Provincia
    XTF              T20 /* T20 = VARCHAR(20) */,          //Teléfono
    XTF2             T20 /* T20 = VARCHAR(20) */,         //Teléfono 2
    XLOGO            IMG /* IMG = BLOB SUB_TYPE 0 SEGMENT SIZE 80 */,     //Logo (Imagen) de la empresa
    XWEB             T80 /* T80 = VARCHAR(80) */,         //Página web de la empresa
    XEMAIL           T80 /* T80 = VARCHAR(80) */,        //Email de la empresa
    XMOVIL           T20 /* T20 = VARCHAR(20) */,        //Móvil 
    XFAX             T20 /* T20 = VARCHAR(20) */,         //Número de Fax
    XCIF             T20 /* T20 = VARCHAR(20) */,          //(CIF, NIF, etc)  Documento identificativo de la empresa
    XREGMERCANTIL    T80 /* T80 = VARCHAR(80) */,   //Registro mercantil de la empresa si lo tiene

{----------------------------------------------------------------------------------------------------------------
 Notas, no es que tenga mucho sentido pero se de clientes que quieren que en ciertos documentos aparezca este texto
 ----------------------------------------------------------------------------------------------------------------}
    XNOTA            MEMO /* MEMO = BLOB SUB_TYPE 1 SEGMENT SIZE 80 */,  //Para recoger dicho texto

{----------------------------------------------------------------------------------------------------------------
 Colores del programa
 ----------------------------------------------------------------------------------------------------------------}
    XCOLORA          T20 /* T20 = VARCHAR(20) */,   //Color Del grid y otros para las lineas pares 
    XCOLORB          T20 /* T20 = VARCHAR(20) */,  //color del grid y otros para las lineas impares
    XCOLORACT        T20 /* T20 = VARCHAR(20) */,      //Color para en mi caso el NewPanelDB cuando esta activo
    XCOLORNOACT      T20 /* T20 = VARCHAR(20) */,    //Color para en mi caso el NewPanelDB cuando no esta activo

{----------------------------------------------------------------------------------------------------------------
 Numeradores serán compuestos de la serie y contador (en el programa descontaremos la serie para saber el numerador)
 ----------------------------------------------------------------------------------------------------------------}
    XNUMPRE          T20 /* T20 = VARCHAR(20) */,      //Numerador de presupuestos
    XNUMPED          T20 /* T20 = VARCHAR(20) */,      //Numerador de Pedidos
    XNUMALB          T20 /* T20 = VARCHAR(20) */,      //Numerador de Albaranes
    XNUMFAC          T20 /* T20 = VARCHAR(20) */,      //Numerador de Facturas
    XNUMLOTE         T20 /* T20 = VARCHAR(20) */,      //Numerador de Lotes  para la trazabilidad
    XNUMCLI          T20 /* T20 = VARCHAR(20) */,      //Numerador de Cliente
    XNUMPRO          T20 /* T20 = VARCHAR(20) */,      //Numerador de Producto
    XNUMAGEN         T20 /* T20 = VARCHAR(20) */,      //Numerador de Agente
    XNUMALMACEN      T20 /* T20 = VARCHAR(20) */,      //Numerador de Almacén
    XNUMALMACENDEF   T20 /* T20 = VARCHAR(20) */,      //Numerador de Almacén por defecto

{----------------------------------------------------------------------------------------------------------------
 Control del tamaño de los diferentes numeradores
 ----------------------------------------------------------------------------------------------------------------}
    XLARGOLOTE       INTEGER,      //Largo del lote por defecto suelo poner 6
    XLARGONUM        INTEGER,      //Largo de los numeradores  incluyendo la serie por defecto pongo 6

{----------------------------------------------------------------------------------------------------------------
 Las Series
 ----------------------------------------------------------------------------------------------------------------}
    XSERIE           T3 /* T3 = VARCHAR(3) */,      //Primera serie de 3 dígitos
    XSERIE2          T3 /* T3 = VARCHAR(3) */,      //Segunda serie de 3 dígitos
    XSERIE3          T3 /* T3 = VARCHAR(3) */,      //Tercera serie de 3 dígitos
    XUASARSERIEYEAR  LOG /* LOG = CHAR(1) */,  //Usar el Año como serie por defecto cogeríamos los dígitos últimos del año en curso
                                                                    //Aquí usaríamos S o N para si o no

{----------------------------------------------------------------------------------------------------------------
 Ley de protección de datos  Ley Orgánica 15/1999 de Protección de Datos de Carácter Personal
 El motivo de que se divida en tres apartados es por que dependiendo del documento podemos usar una o otra e
  incluso podríamos elegirla antes de imprimir con un simple ComboBox
 ----------------------------------------------------------------------------------------------------------------}
    XLDPD1           MEMO /* MEMO = BLOB SUB_TYPE 1 SEGMENT SIZE 80 */,  //Texto para la LOPD
    XLDPD2           MEMO /* MEMO = BLOB SUB_TYPE 1 SEGMENT SIZE 80 */,  //Texto para la LOPD
    XLDPD3           MEMO /* MEMO = BLOB SUB_TYPE 1 SEGMENT SIZE 80 */,  //Texto para la LOPD

{----------------------------------------------------------------------------------------------------------------
 Nombre de la moneda de uso
 ----------------------------------------------------------------------------------------------------------------}
    XNOMMONEDA       T10 /* T10 = VARCHAR(20) */,    //Nombre de la moneda que usaremos

{----------------------------------------------------------------------------------------------------------------
 Impuestos
 ----------------------------------------------------------------------------------------------------------------}
    XNOMIMPUESTO     T10 /* T10 = VARCHAR(20) */,   //Nombre del impuesto (IVA, IGIC, etc.)
    XDESIMP1         T20 /* T20 = VARCHAR(20) */,   //Descripción del tipo impuesto Exento, normal, reducido, otros      
    XIMP1            POR /* POR = NUMERIC(15,4) */,   //Porcentaje de impuesto a aplicar
    XDESIMP2         T20 /* T20 = VARCHAR(20) */,   //Descripción del tipo impuesto Exento, normal, reducido, otros      
    XIMP2            POR /* POR = NUMERIC(15,4) */,   //Porcentaje de impuesto a aplicar
    XDESIMP3         T20 /* T20 = VARCHAR(20) */,   //Descripción del tipo impuesto Exento, normal, reducido, otros      
    XIMP3            POR /* POR = NUMERIC(15,4) */,   //Porcentaje de impuesto a aplicar
    XDESIMP4         T20 /* T20 = VARCHAR(20) */,   //Descripción del tipo impuesto Exento, normal, reducido, otros      
    XIMP4            POR /* POR = NUMERIC(15,4) */,   //Porcentaje de impuesto a aplicar

{----------------------------------------------------------------------------------------------------------------
 Tipos de recargo equivalencia Según el Real-Decreto Ley 20/2012 los tipos de recargo de equivalencia aplicables a partir 
 del 1 de septiembre de 2012  hasta hoy día son: (Aplicables en España al Iva como al IGIC)
 -          El 5,2% para los artículos que tienen un IVA al tipo general del 21%.
 -          El 1,4% para los artículos que tienen un IVA al tipo reducido del 10%.
 -          El 0,5% para los artículos que tienen un IVA al tipo reducido del 4%.
 -          El 0,75% para el tabaco.
  El recargo de equivalencia es cuando compramos un producto y se lo vendemos a otro  sin alterarlo básicamente
 ----------------------------------------------------------------------------------------------------------------}
    XDESREQ1         T20 /* T20 = VARCHAR(20) */,    //Descripción del tipo de equivalencia
    XREQ1            POR /* POR = NUMERIC(15,4) */,    //Porcentaje de la equivalencia a aplicar
    XDESREQ2         T20 /* T20 = VARCHAR(20) */,    //Descripción del tipo de equivalencia
    XREQ2            POR /* POR = NUMERIC(15,4) */,    //Porcentaje de la equivalencia a aplicar
    XDESREQ3         T20 /* T20 = VARCHAR(20) */,    //Descripción del tipo de equivalencia
    XREQ3            POR /* POR = NUMERIC(15,4) */,    //Porcentaje de la equivalencia a aplicar
    XDESREQ4         T20 /* T20 = VARCHAR(20) */,    //Descripción del tipo de equivalencia
    XREQ4            POR /* POR = NUMERIC(15,4) */,    //Porcentaje de la equivalencia a aplicar

{----------------------------------------------------------------------------------------------------------------
 Modo de copias de seguridad en mi caso usare los siguientes modos, al salir del programa
  nulo (ningún día se hará manualmente)
  Lunes .. Domingo (se hará el día marcado 
  Todos (Todos los días de la semana)

 ----------------------------------------------------------------------------------------------------------------}
    XMODCOPIASEG     T20 /* T20 = VARCHAR(20) */     //Cuando haremos la copia de seguridad

Espero que estén de acuerdo con este proyecto, que exista bastante colaboración, que aporten ideas, código e imágenes, para poder mejorar nuestros programas.

Por cierto lo lógico sería seguir con este hilo para ir poniendo las diferentes partes del mismo.

El siguiente el módulo de configuración

Se que dije que pondría primero el módulo de configuración, pero primero tengo que poner el módulo de datos (Data Module) en mi caso el nombre de la Unidad es UDM

Aquí una imagen



Aquí el código

Código Delphi [-]
unit UDM;

interface

uses
  SysUtils, Classes, IBDatabase, DB,Forms, IBCustomDataSet, Dialogs;

//  uses
//  SysUtils, Classes, DB, IBCustomDataSet, IBDatabase,Forms, IBQuery;

type
  TDM = class(TDataModule)
    IBDatabase1: TIBDatabase;
    IBTransaction1: TIBTransaction;
    IBDCLIEN: TIBDataSet;
    IBDCLIENID: TIntegerField;
    IBDCLIENNOMMODULO: TIBStringField;
    IBDCLIENCODIGO: TIBStringField;
    IBDCLIENNOMBRE: TIBStringField;
    IBDCLIENFORMAPAGO: TIBStringField;
    IBDCLIENFECHAALTA: TDateField;
    IBDCLIENDTO: TIBBCDField;
    IBDCLIENNOTAS: TWideMemoField;
    IBDCLIENIMG: TBlobField;
    IBDCLIENIMPUESTOS: TIBStringField;
    IBDCLIENTIPOIMP: TIntegerField;
    IBDCLIENCIF: TIBStringField;
    IBDCLIENRET: TIBStringField;
    IBDCLIENPORRET: TIBBCDField;
    IBDCLIENTARIFA: TIBStringField;
    IBDCLIENUSARRAPEL: TIBStringField;
    IBDCLIENDIASPRESENT: TIBStringField;
    IBDCLIENDIASDECOBRO: TIBStringField;
    IBDCLIENAVISOS: TWideMemoField;
    IBDCLIENLIMITECREDITO: TIBBCDField;
    IBDCLIENPENDIENTEPAGO: TIBBCDField;
    IBDCLIENSECTOR: TIBStringField;
    IBDCLIENCODAGENTE: TIBStringField;
    IBDUSUA: TIBDataSet;
    IBDUSUAID: TIntegerField;
    IBDUSUACLAVE: TIBStringField;
    IBDUSUAUSUARIO: TIBStringField;
    IBDUSUANIVEL: TIntegerField;
    IBDUSUANOMBRE: TIBStringField;
    IBDirecciones: TIBDataSet;
    IBDireccionesID: TIntegerField;
    IBDireccionesMODULO: TIBStringField;
    IBDireccionesCODIGO: TIBStringField;
    IBDireccionesDIRECCION: TIBStringField;
    IBDireccionesCP: TIBStringField;
    IBDireccionesPOBLACION: TIBStringField;
    IBDireccionesPROVINCIA: TIBStringField;
    IBDireccionesTF: TIBStringField;
    IBDireccionesNOTA: TWideMemoField;
    IBDireccionesPAIS: TIBStringField;
    IBDConfi: TIBDataSet;
    IBDPC: TIBDataSet;
    IBDPCID: TIntegerField;
    IBDPCMODULO: TIBStringField;
    IBDPCCODIGO: TIBStringField;
    IBDPCNOMBRE: TIBStringField;
    IBDPCMOVIL: TIBStringField;
    IBDPCEMAIL: TIBStringField;
    IBDPCCASADO: TIBStringField;
    IBDPCHIJOS: TIBStringField;
    IBDPCFECHANACIM: TDateField;
    IBDPCPUESTO: TIBStringField;
    IBDPCEXT: TIBStringField;
    IBDPCNOTAS: TWideMemoField;
    IBDPCFOTO: TBlobField;
    IBDContacto: TIBDataSet;
    IBDContactoID: TIntegerField;
    IBDContactoMODULO: TIBStringField;
    IBDContactoCODIGO: TIBStringField;
    IBDContactoNOMBRE: TIBStringField;
    IBDContactoTF: TIBStringField;
    IBDContactoTF2: TIBStringField;
    IBDContactoFAX: TIBStringField;
    IBDContactoMAIL: TIBStringField;
    IBDContactoMAIL2: TIBStringField;
    IBDContactoWEB: TIBStringField;
    IBDContactoCLAVEWEB: TIBStringField;
    IBDContactoMOVIL: TIBStringField;
    IBDContactoMOVIL2: TIBStringField;
    IBDContactoNOTAS: TWideMemoField;
    IBDBcos: TIBDataSet;
    IBDBcosID: TIntegerField;
    IBDBcosMODULO: TIBStringField;
    IBDBcosCODIGO: TIBStringField;
    IBDBcosBANCO: TIBStringField;
    IBDBcosENTIDAD: TIntegerField;
    IBDBcosOFICINA: TIntegerField;
    IBDBcosDC: TIntegerField;
    IBDBcosCUENTA: TIntegerField;
    IBDBcosTF: TIBStringField;
    IBDConfiID: TIntegerField;
    IBDConfiXEMPRESA: TIBStringField;
    IBDConfiXCALLE: TIBStringField;
    IBDConfiXCP: TIBStringField;
    IBDConfiXPOBLACION: TIBStringField;
    IBDConfiXPROVINCIA: TIBStringField;
    IBDConfiXTF: TIBStringField;
    IBDConfiXTF2: TIBStringField;
    IBDConfiXLOGO: TBlobField;
    IBDConfiXWEB: TIBStringField;
    IBDConfiXEMAIL: TIBStringField;
    IBDConfiXMOVIL: TIBStringField;
    IBDConfiXFAX: TIBStringField;
    IBDConfiXCIF: TIBStringField;
    IBDConfiXREGMERCANTIL: TIBStringField;
    IBDConfiXNOTA: TWideMemoField;
    IBDConfiXCOLORA: TIBStringField;
    IBDConfiXCOLORB: TIBStringField;
    IBDConfiXCOLORACT: TIBStringField;
    IBDConfiXCOLORNOACT: TIBStringField;
    IBDConfiXNUMPRE: TIBStringField;
    IBDConfiXNUMPED: TIBStringField;
    IBDConfiXNUMALB: TIBStringField;
    IBDConfiXNUMFAC: TIBStringField;
    IBDConfiXNUMLOTE: TIBStringField;
    IBDConfiXNUMCLI: TIBStringField;
    IBDConfiXNUMPRO: TIBStringField;
    IBDConfiXNUMAGEN: TIBStringField;
    IBDConfiXNUMALMACEN: TIBStringField;
    IBDConfiXNUMALMACENDEF: TIBStringField;
    IBDConfiXLARGOLOTE: TIntegerField;
    IBDConfiXLARGONUM: TIntegerField;
    IBDConfiXSERIE: TIBStringField;
    IBDConfiXSERIE2: TIBStringField;
    IBDConfiXSERIE3: TIBStringField;
    IBDConfiXUASARSERIEYEAR: TIBStringField;
    IBDConfiXLDPD1: TWideMemoField;
    IBDConfiXLDPD2: TWideMemoField;
    IBDConfiXLDPD3: TWideMemoField;
    IBDConfiXNOMMONEDA: TIBStringField;
    IBDConfiXNOMIMPUESTO: TIBStringField;
    IBDConfiXDESIMP1: TIBStringField;
    IBDConfiXIMP1: TIBBCDField;
    IBDConfiXDESIMP2: TIBStringField;
    IBDConfiXIMP2: TIBBCDField;
    IBDConfiXDESIMP3: TIBStringField;
    IBDConfiXIMP3: TIBBCDField;
    IBDConfiXDESIMP4: TIBStringField;
    IBDConfiXIMP4: TIBBCDField;
    IBDConfiXDESREQ1: TIBStringField;
    IBDConfiXREQ1: TIBBCDField;
    IBDConfiXDESREQ2: TIBStringField;
    IBDConfiXREQ2: TIBBCDField;
    IBDConfiXDESREQ3: TIBStringField;
    IBDConfiXREQ3: TIBBCDField;
    IBDConfiXDESREQ4: TIBStringField;
    IBDConfiXREQ4: TIBBCDField;
    IBDConfiXMODCOPIASEG: TIBStringField;
    procedure IBDatabase1BeforeConnect(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  DM: TDM;

implementation

{$R *.dfm}


procedure TDM.IBDatabase1BeforeConnect(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************[ Antes de conectar ]****
// Cogemos la ruta del Ejecutable
//------------------------------------------------------------------------------
var Ruta:string;
begin
    Ruta:=ExtractFilePath(Application.ExeName);    //Sacamos la ruta
    if FileExists(Ruta+ 'PGF2.FDB') then  IBDatabase1.DatabaseName:=ExtractFilePath(Application.ExeName) + 'PGF2.FDB'
                       else
    begin
       if FileExists(ruta+'bd\'+'PGF2.FDB') then IBDatabase1.DatabaseName:=ExtractFilePath(Application.ExeName)+'bd\' + 'PGF2.FDB'
                                           else
                                           begin
                                               Showmessage('Lo sentimos pero no encontramos el archivo PGF2.FDB, donde se encuentra el ejecutable, o en la capeta BD de la ubicación del Ejecutable');
                                           end;
    end;
//    ShowMessage(ruta+'bd\'+'PGF2.FDB');
//    ShowMessage(Ruta+ 'PGF2.FDB');
end;

end.

Como podemos ver tenemos en el evento IBDatabase1BeforeConnect el buscar la base de datos donde esta el ejecutable o en su defecto dentro de la carpeta bd\ que debe estar donde este el ejecutable, con lo que podemos usar el programa desde un pendrive por ejemplo (teóricamente)

Por ahora solo una cuestión. (no pondría campos Blob de tipo texto) los dejaría solo para el subtipo binary.
Varchar soporta desde 1 to 32,765 bytes

^\||/^\||/^\||/

Por cierto, creo que el dominio T10 debería ser varchar(10)

En cuanto a campos memo "grandes" yo uso también blob de texto.

Hola PepeLolo, suelo usar campos memos muy a menudo y no creas que me han crecido mucho las bases de datos, de todas maneras, mi idea es ponerlos en una tabla independiente con llamadas al módulo.

Hola Casimiro Notevi, cierto en el Dominio tendría que ser un varchar 10 pero esta a 20 gracias.

Hola...

Aquí metiendo mi cuchara... :p

Yo te recomendaría usar UTF8 en el chartset y UNICODE_CI_AI en el collation, esto si usas Firebird 2.5. Esto por que en Delphi 2010 los tipos string ahora son Unicode.



Saludos...

Gracias maeyanes, pero uso firebird 2. algo pero no es 2.5

Muy buena la idea.

Pero, a proposito, que te parece la idea revolucionaria de llamar a campos como "XCP", no se, como "CodigoPostal"!

He hecho integraciones a decenas de ERPs, y no sabes lo complicado que es porque los nombres son obtusos y poco claros. Las abreviaciones y las construcciones tipo "XXXAAAYYTT" no solo obscurecen sino que son innecesarias, no ganan nada en cuanto a desempeño, almacenamiento ni nada por el estilo.

El el sistema que tengo, uso asi (estoy estandarizado a hacer todo en ingles):

Código SQL [-]
CREATE TABLE Customer (
  Id             integer PRIMARY KEY AUTOINCREMENT,
  Code           varchar NOT NULL UNIQUE COLLATE NOCASE,
  Name           varchar NOT NULL COLLATE NOCASE,
  IsSupplier     boolean NOT NULL DEFAULT 0,
  Image          varchar,
  Zone           varchar,
  IsActive       boolean NOT NULL DEFAULT 1,
  Email          varchar,
  DefaultPrice   integer NOT NULL DEFAULT 1, /*1-5*/
  Contact        varchar COLLATE NOCASE,
  Company        varchar COLLATE NOCASE,
  IdLocation     integer NOT NULL,
  Address        varchar COLLATE NOCASE,
  ZipCode        varchar,
  Phone          varchar,
  Phone2         varchar,
  Cellphone      varchar,
  Notes          varchar,
  MaxBalance     double,
  Status         integer DEFAULT 0,/*RECORD_OK=0, RECORD_NEW=1, RECORD_UPDATED=2, RECORD_DELETED=-1*/
  Info           varchar,
  /* Foreign keys */
  FOREIGN KEY (IdLocation)
    REFERENCES Location(Id) ON DELETE CASCADE
);

No tengo que documentar que significa los campos (los comentarios no deben usarse para saber lo que el codigo te puede decir) sino para decir que valores se esperan (que realmente es lo necesario).

Ya que los nombres son claros, cuando construyo la interfaz de usuario, puedo hacer gracias como:

Código Delphi [-]
forma.titulo = _([Customer tableName]); //Sale "Customer" y la funcion _() lo convierte a otros idiomas
lbName.text = Customer.NAME; //No tengo que repetir que customer name es Name, porque ya lo se!

Osea, puedo reusar los nombres como etiquetas. Puedo mostrar la tabla a clientes, sin mucho lio. Puedo hacer consultas SIN MIRAR DOCUMENTACION, solo mirando tablas y nombres de campos.


-----
Y aproposito, que piensas hacer con esto? Un proyecto open source? Si es asi, considera montarlo en github o bitbucket...

Ciertamente maeyanes y mamcx tienen razón.
No es necesario ser "crípticos" con los nombres de campos y demás, no estamos limitados a 8 caracteres de longitud :)
Ejemplo ():

Código SQL [-]
set sql dialect 3; 
create database "rankings.fdb" PAGE_SIZE 8192 user "SYSDBA" password "masterkey"; 

/**/ 
create domain domCodigoNoNulo integer not null; 
create domain domNombre varchar(64) character set ISO8859_1;  /* fb < 2.1 */ 
/*create domain domNombre varchar(64) character set UTF8 collate ES_ES_CI_AI default '';*/  /* fb >= 2.1 */ 
create domain domImagen blob sub_type 0; 
create domain domFecha date; 
create domain domHora time; 
create domain domFechaHora timestamp; 
create domain domComentarios blob sub_type text; 
create domain domSiNo smallint default 0 check (value between 0 and 1); /* 0-No, 1-Si*/
create domain domEstadoUsuario smallint; /* (0.sinconfirmar,1.activo,2.baja) (sinconfirmar hasta que responda el email de confirmaciﺃ٣n de alta) */ 
create domain domPuntos integer;  /* 0,1,2,3,4,5,6,7,8,9,10 */ 
create domain domLogin varchar(32); 
create domain domContrasena varchar(64); 
create domain domDescripcion varchar(256); 
create domain domEmail varchar(48); 
create domain domWeb varchar(128); 
create domain domYear integer; 
create domain domNIF varchar(16) not null; 
create domain domIP varchar(16); 
create domain domTelefono varchar(16);
create domain domWebBrowser varchar(64);  /* navegador del usuario */
create domain domSO varchar(64); /* sistema operativo del usuario */
create domain domTitulo varchar(64); /* para título de las opiniones/comentarios */
create domain domInteger integer; 
create domain domAlias varchar(16);
create domain domCaracter varchar(1);
create domain domConcepto varchar(96);
create domain domCP varchar(5);
create domain domDescripcion varchar(256);
create domain domDireccion varchar(256);
create domain domPoblacion varchar(96); 
create domain domPorcentaje double precision;
/* 
*/ 
 
create table 
tbTIPOSPROFESIONALES  
( 
  ID          domCodigoNoNulo, 
  Nombre      domNombre,      
  primary key (ID) 
); 
 
create table 
tbPAISES 
( 
  ID          domCodigoNoNulo, 
  Nombre      domNombre, 
  primary key (ID) 
); 

create table 
tbCIUDADES 
( 
  ID          domCodigoNoNulo, 
  ID_pais     domCodigoNoNulo, 
  Nombre      domNombre, 
  primary key (ID), 
  foreign key (ID_pais) references tbPAISES(ID) 
); 
 
create table 
tbESPECIALIDADES 
( 
  ID          domCodigoNoNulo, 
  Nombre      domNombre,  
  primary key (ID) 
); 
 
create table 
tbNIVELESUSUARIOS 
( 
  ID          domCodigoNoNulo, 
  Nombre      domNombre,  /* (normal,avanzado,admin,god) */ 
  primary key (ID) 
); 
   
create table 
tbAVATARES 
( 
  ID          domCodigoNoNulo, 
  Imagen      domImagen, 
  primary key (ID) 
); 
   
create table   
tbIDIOMAS 
( 
  ID        domCodigoNoNulo, 
  Idioma    domNombre,  
  primary key (ID) 
); 
 
create table 
tbPROFESIONALES 
( 
  ID                  domCodigoNoNulo, 
  ID_TipoProfesional  domCodigoNoNulo, 
  Nombre              domNombre, 
  ID_Especialidad     domCodigoNoNulo, 
  CentroTrabajo       domNombre,
  Privado             domSiNo, 
  SS                  domSiNo, 
  ID_Pais             domCodigoNoNulo, 
  ID_Ciudad           domCodigoNoNulo, 
  primary key (ID), 
  foreign key (ID_TipoProfesional) references tbTIPOSPROFESIONALES (ID), 
  foreign key (ID_Especialidad) references tbESPECIALIDADES (ID), 
  foreign key (ID_Pais) references tbPAISES (ID), 
  foreign key (ID_Ciudad) references tbCIUDADES (ID) 
); 
 
create table 
tbUSUARIOS 
( 
  ID              domCodigoNoNulo, 
  ID_NivelUsuario domCodigoNoNulo, 
  Login           domLogin,            
  Contrasena      domContrasena, 
  Nombre          domNombre, 
  Email           domEmail, 
/* [..] */     
  NIF             domNIF,   
  YearNacimiento  domYear, 
  Telefono        domTelefono, 
  ID_Avatar       domCodigoNoNulo, 
  ID_Idioma       domCodigoNoNulo, 
/* [..] */   
  ID_Pais         domCodigoNoNulo, 
  ID_Ciudad       domCodigoNoNulo, 
/* [..] */ 
  FechaHoraAlta   domFechaHora, 
  Estado          domEstadoUsuario,  /* (0.sinconfirmar,1.activo,2.baja) (sinconfirmar hasta que responda el email de confirmaciﺃ٣n de alta) */ 
/* [..] */ 
  IP              domIP,
  WebBrowser      domWebBrowser,
  SO              domSO, 
  primary key (ID), 
  foreign key (ID_NivelUsuario) references tbNIVELESUSUARIOS (ID), 
  foreign key (ID_Avatar) references tbAVATARES (ID), 
  foreign key (ID_Idioma) references tbIDIOMAS (ID), 
  foreign key (ID_Pais) references tbPAISES (ID), 
  foreign key (ID_Ciudad) references tbCIUDADES (ID)   
); 

...

Cuando se tiene razón se da y aqui como queda ahora la base de datos

Código Delphi [-]
CREATE TABLE CONFI (
    ID                               INTEGER NOT NULL,
    EMPRESA                          T80 /* T80 = VARCHAR(80) */,
    CALLE                            T80 /* T80 = VARCHAR(80) */,
    CODIGOPOSTAL                     T10 /* T10 = VARCHAR(20) */,
    POBLACION                        T80 /* T80 = VARCHAR(80) */,
    PROVINCIA                        T80 /* T80 = VARCHAR(80) */,
    TELEFONO                         T20 /* T20 = VARCHAR(20) */,
    TELEFONO2                        T20 /* T20 = VARCHAR(20) */,
    LOGO                             IMG /* IMG = BLOB SUB_TYPE 0 SEGMENT SIZE 80 */,
    WEB                              T80 /* T80 = VARCHAR(80) */,
    EMAIL                            T80 /* T80 = VARCHAR(80) */,
    MOVIL                            T20 /* T20 = VARCHAR(20) */,
    FAX                              T20 /* T20 = VARCHAR(20) */,
    CIF                              T20 /* T20 = VARCHAR(20) */,
    REGISTROMERCANTIL                T80 /* T80 = VARCHAR(80) */,
    NOTA                             MEMO /* MEMO = BLOB SUB_TYPE 1 SEGMENT SIZE 80 */,
    COLORA                           T20 /* T20 = VARCHAR(20) */,
    COLORB                           T20 /* T20 = VARCHAR(20) */,
    COLORACTIVO                      T20 /* T20 = VARCHAR(20) */,
    COLORNOACTIVO                    T20 /* T20 = VARCHAR(20) */,
    NUMEROPRESUPUESTO                T20 /* T20 = VARCHAR(20) */,
    NUMEROPEDIDO                     T20 /* T20 = VARCHAR(20) */,
    NUMEROALBARAN                    T20 /* T20 = VARCHAR(20) */,
    NUMEROFACTURA                    T20 /* T20 = VARCHAR(20) */,
    NUMEROLOTE                       T20 /* T20 = VARCHAR(20) */,
    NUMEROCLIENTE                    T20 /* T20 = VARCHAR(20) */,
    NUMEROPROVEEDOR                  T20 /* T20 = VARCHAR(20) */,
    NUMEROAGENTE                     T20 /* T20 = VARCHAR(20) */,
    NUMEROALMACEN                    T20 /* T20 = VARCHAR(20) */,
    NUMEROALMACENPORDEFECTO          T20 /* T20 = VARCHAR(20) */,
    LARGOLOTE                        INTEGER,
    LAGONUMEROS                      INTEGER,
    SERIE                            T3 /* T3 = VARCHAR(3) */,
    SERIE2                           T3 /* T3 = VARCHAR(3) */,
    SERIE3                           T3 /* T3 = VARCHAR(3) */,
    USARSERIEYEAR                    LOG /* LOG = CHAR(1) */,
    LDPD1                            MEMO /* MEMO = BLOB SUB_TYPE 1 SEGMENT SIZE 80 */,
    LDPD2                            MEMO /* MEMO = BLOB SUB_TYPE 1 SEGMENT SIZE 80 */,
    LDPD3                            MEMO /* MEMO = BLOB SUB_TYPE 1 SEGMENT SIZE 80 */,
    NOMBREMONEDA                     T10 /* T10 = VARCHAR(20) */,
    NOMBREIMPUESTO                   T10 /* T10 = VARCHAR(20) */,
    DESCRIPCIONIMPUESTO1             T20 /* T20 = VARCHAR(20) */,
    IMPUESTO1                        POR /* POR = NUMERIC(15,4) */,
    DESCRIPCIONIMPUESTO2             T20 /* T20 = VARCHAR(20) */,
    IMPUESTO2                        POR /* POR = NUMERIC(15,4) */,
    DESCRIPCIONIMPUESTO3             T20 /* T20 = VARCHAR(20) */,
    IMPUESTO3                        POR /* POR = NUMERIC(15,4) */,
    DESCRIPCIONIMPUESTO4             T20 /* T20 = VARCHAR(20) */,
    IMPUESTO4                        POR /* POR = NUMERIC(15,4) */,
    DESCRIPCIONRECARGOEQUIVALENCIA1  T20 /* T20 = VARCHAR(20) */,
    RECARGOEQUIVALENCIA1             POR /* POR = NUMERIC(15,4) */,
    DESCRIPCIONRECARGOEQUIVALENCIA2  T20 /* T20 = VARCHAR(20) */,
    RECARGOEQUIVALENCIA2             POR /* POR = NUMERIC(15,4) */,
    DESCRIPCIONRECARGOEQUIVALENCIA3  T20 /* T20 = VARCHAR(20) */,
    RECARGOEQUIVALENCIA3             POR /* POR = NUMERIC(15,4) */,
    DESCRIPCIONRECARGOEQUIVALENCIA4  T20 /* T20 = VARCHAR(20) */,
    RECARGOEQUIVALENCIA4             POR /* POR = NUMERIC(15,4) */,
    MODOCOPIADESEGURIDAD             T20 /* T20 = VARCHAR(20) */
);

Buenos otro aporte haber si gusta.
Yo no soy partidario de múltiples campos idénticos en una tabla, ya que complican el asunto y necesitas meter código de programación, tanto en aplicación como en BBDD, por lo que los siguientes campos
los incluiría en otras entidades

Una entidad nueva para estos campos, siendo cada uno de ellos un registro. De este modo no bloqueo la entidad principal cada vez que tenga que actualizar un contador.
Solo se bloqueará el registro del contador que estés actualizando.
Tercera, si añades un modulo nuevo que requiera de un contador, solo tienes que añadir un registro nuevo y no tendrás que andar modificando estructura de datos

Código SQL [-]
    NUMEROPRESUPUESTO              
    NUMEROPEDIDO                     
    NUMEROALBARAN                  
    NUMEROFACTURA                    
    NUMEROLOTE                       
    NUMEROCLIENTE                    
    NUMEROPROVEEDOR                 
    NUMEROAGENTE                     
    NUMEROALMACEN                  
    NUMEROALMACENPORDEFECTO

Lo mismo que antes, incluso añadiría un segundo campo boolean que indicará la serie por defecto que quiero usar. Si solo hay un registro pos esa.

Código SQL [-]
    
    SERIE                            
    SERIE2                          
    SERIE3                          
    USARSERIEYEAR

En esto también haría lo mismo, un registro por cada registro de LOPD

Código SQL [-]
    LDPD1                            MEMO /* MEMO = BLOB SUB_TYPE 1 SEGMENT SIZE 80 */,
    LDPD2                            MEMO /* MEMO = BLOB SUB_TYPE 1 SEGMENT SIZE 80 */,
    LDPD3                            MEMO /* MEMO = BLOB SUB_TYPE 1 SEGMENT SIZE 80 */,

Impuesto y recargos de equivalencia también los llevaría a una entidad aparte y cada tipo impuesto quedando algo así:

Código SQL [-]
  ID
  IMPUESTO,
  NOMBREIMPUESTO
  RECARGOEQUIVALENCIA
  DESCRIPCIONRECARGOEQUIVALENCIA
  FECHAVIGENCIA  /* Este campo te indicaría desde que fecha esta vigente el impuesto, de modo que ante cualquier cambio en la legislación , solo tendrías que crear un nuevo registro e indicar
la fecha en la que entra en vigor */

PD: Me gustan mucho las tablas :D de BBDD

Bueno, puestos a opinar yo opino.

En vez de limitar a X series el programa debería de haber un fichero de series tanto de compra como de venta con sus contadores y formatos de impresos independiente. Es habitual que en las empresas si hacen una factura en mostrador tenga un formato pequeño por ejemplo y que las facturas de crédito tengan un formato grande, que puedan querer tener distintos tipos de formatos de albaranes, valorados, sin valorar, etc.

Para eso yo crearía un fichero de series de venta en el que tendría un registro por cada una de las posibles series y que cada una de estas tuviera los impresos y contadores de los distintos tipos de documentos relacionados con las ventas, presupuestos, pedidos de clientes, etc. Por otro lado otro fichero de series de compra en el que estuvieran los contadores e impresos de pedidos a proveedores y compras.

Por otro lado debería de haber algún sitio donde se marcaran las series por defecto genéricas y en el fichero de clientes y proveedores un campo para la serie por si se quiere forzar la compra o venta a una serie determinada dependiendo del cliente o proveedor.

Adjunto un ejemplo de como lo tengo yo en mis programas.

P.D: Imagino que sabes en el jardín que te has metido, esto se te puede hacer eterno y tanta gente opinando puede ser contraproducente. :D:D

Saludos




Edito: ¿Alguien me dice una web para subir imágenes que no de muchos problemas?

Vamos por partes (que dijo Jack el destripador :D:D), la idea es hacer un programa de ejemplo, se que podemos crear una tabla de impuestos i poner los que nos da la gana, lo mismo con las series y demás, pero tener en cuenta que la inmensa mayoría de personas suelen trabajar con una única empresa y de esta manera esta más centralizado, en cuanto ala L.O.P.D. debe estar en configuración ya que como comente, si vamos a emitir un a factura, albarán o pedido, elegimos el texto por defecto LDPD1, en cambio si es un presupuesto recibo, etc, podemos elegir el LDPD2 o el LPD·, e incluso en el primer caso si el cliente es de contado, genérico, etc se puede elegir el LDPD2-3 según los textos el orden en el que lo introducimos y los que nos dicte el gestor de Protección de Datos. En cambio si lo ponemos en una tabla independiente, es más fácil perder el control de estos datos.

Así que tener en cuenta que no espero crear un super programa, sólo uno de gestión aceptable y que sirva de ejemplo y que incluya más apartados que el común.

De todas maneras con cuantas series soléis trabajar, y los numeradores son estáticos, sólo sirven para mantener el último número registrado y asir poder llevar el contador.

Nada si tengo que cambiar cambio el programa pero como ha dicho Javier


y que lo digas :D:D:D

prueba con www.casimages.es

En flickr, desde ayer te dan 1 giga gratis.

1 Terabyte.

Eso, un tera :)
Es que con un giga a mi me sobra :)

Me parece una gran idea José Luis.
Si la cosa prospera, creo que podemos organizarlo mejor, pero esperemos a ver cómo se desarrolla el proyecto.

^\||/

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

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

Código Delphi [-]
unit FConfi;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ExtCtrls, Grids, DBGrids, StdCtrls, Spin, Buttons, DB,
  NewPanelDB, DBCtrls, Mask, MyDbIbMemo, GroupboxJL, TDbIbchkbox, DBCBEXT,
  ExtDlgs, SPBBC, IBDatabase, Clipbrd, ShellAPI, jpeg, DBColorComboBox;

//[ 1]----------------[ Para poder tener tabs del page control en color]--------
Type
  TTabSheet = class(ComCtrls.TTabSheet)
  private
    FColor: TColor;
    procedure SetColor(Value: TColor);
    procedure WMEraseBkGnd(var Msg: TWMEraseBkGnd);
      message WM_ERASEBKGND;
  public
    constructor Create(aOwner: TComponent); override;
    property Color: TColor read FColor write SetColor;
   end;
//[ 1]--FIN SECCIÓN---[ Para poder tener tabs del page control en color]--------

type
  TUConfi = class(TForm)
    PanelBotonera: TNewPanelDB;
    SBBarraStatus: TStatusBar;
    Panel1: TPanel;
    Panel2: TPanel;
    PanelDatos: TNewPanelDB;
    PanelConfirmar: TNewPanelDB;
    DsPrincipal: TDataSource;
    SbNuevo: TSpeedButton;
    SbModificar: TSpeedButton;
    SbBorrar: TSpeedButton;
    SB_Salir: TSpeedButton;
    SBConfirmar: TSpeedButton;
    SBCancelar: TSpeedButton;
    Timer1: TTimer;
    PGC: TPageControl;
    Empresa: TTabSheet;
    Numeradores: TTabSheet;
    LOPD: TTabSheet;
    Label1: TLabel;
    DBEdit1: TDBEdit;
    Label2: TLabel;
    DBEdit2: TDBEdit;
    Label3: TLabel;
    DBEdit3: TDBEdit;
    Label4: TLabel;
    DBEdit4: TDBEdit;
    Label5: TLabel;
    DBEdit5: TDBEdit;
    Label6: TLabel;
    DBEdit6: TDBEdit;
    Label7: TLabel;
    DBEdit7: TDBEdit;
    Label8: TLabel;
    DBImage1: TDBImage;
    Label9: TLabel;
    DBEdit8: TDBEdit;
    Label10: TLabel;
    DBEdit9: TDBEdit;
    Label11: TLabel;
    DBEdit10: TDBEdit;
    Label12: TLabel;
    DBEdit11: TDBEdit;
    Label13: TLabel;
    DBEdit12: TDBEdit;
    Label14: TLabel;
    DBEdit13: TDBEdit;
    Label15: TLabel;
    GroupBoxJL1: TGroupBoxJL;
    DBIBMemo1: TDBIBMemo;
    GroupBoxJL2: TGroupBoxJL;
    Label16: TLabel;
    DBEdit14: TDBEdit;
    Label17: TLabel;
    DBEdit15: TDBEdit;
    Label18: TLabel;
    DBEdit16: TDBEdit;
    Label19: TLabel;
    DBEdit17: TDBEdit;
    Label20: TLabel;
    DBEdit18: TDBEdit;
    Label21: TLabel;
    DBEdit19: TDBEdit;
    Label22: TLabel;
    DBEdit20: TDBEdit;
    Label23: TLabel;
    DBEdit21: TDBEdit;
    Label24: TLabel;
    DBEdit22: TDBEdit;
    Label25: TLabel;
    DBEdit23: TDBEdit;
    Label26: TLabel;
    DBEdit24: TDBEdit;
    Label27: TLabel;
    DBEdit25: TDBEdit;
    GroupBoxJL8: TGroupBoxJL;
    Label28: TLabel;
    Label29: TLabel;
    Label30: TLabel;
    Label31: TLabel;
    GroupBoxJL9: TGroupBoxJL;
    Label32: TLabel;
    DBEdit30: TDBEdit;
    Label33: TLabel;
    DBEdit31: TDBEdit;
    Label34: TLabel;
    DBEdit32: TDBEdit;
    DBIBMemo2: TDBIBMemo;
    DBIBMemo3: TDBIBMemo;
    DBIBMemo4: TDBIBMemo;
    GroupBoxJL5: TGroupBoxJL;
    Label53: TLabel;
    GroupBoxJL6: TGroupBoxJL;
    Label54: TLabel;
    DBEdit52: TDBEdit;
    DBIBCheckbox1: TDBIBCheckbox;
    DbComboBoxExt1: TDbComboBoxExt;
    Label35: TLabel;
    Label55: TLabel;
    Label56: TLabel;
    SpeedButtonBC1: TSpeedButtonBC;
    SpeedButtonBC2: TSpeedButtonBC;
    OpenDialog1: TOpenDialog;
    OpenPictureDialog1: TOpenPictureDialog;
    SpeedButtonBC3: TSpeedButtonBC;
    SpeedButtonBC4: TSpeedButtonBC;
    SpeedButtonBC5: TSpeedButtonBC;
    SpeedButtonBC6: TSpeedButtonBC;
    SpeedButtonBC7: TSpeedButtonBC;
    SpeedButtonBC8: TSpeedButtonBC;
    SpeedButtonBC9: TSpeedButtonBC;
    SpeedButtonBC10: TSpeedButtonBC;
    SpeedButtonBC11: TSpeedButtonBC;
    SpeedButtonBC12: TSpeedButtonBC;
    Panel3: TPanel;
    SpeedButtonBC15: TSpeedButtonBC;
    SpeedButtonBC16: TSpeedButtonBC;
    DBColorBox1: TDBColorBox;
    DBColorBox2: TDBColorBox;
    DBColorBox3: TDBColorBox;
    DBColorBox4: TDBColorBox;
    GroupBoxJL3: TGroupBoxJL;
    Label36: TLabel;
    Label37: TLabel;
    Label38: TLabel;
    Label39: TLabel;
    Label40: TLabel;
    Label41: TLabel;
    Label42: TLabel;
    Label43: TLabel;
    Label44: TLabel;
    DBEdit26: TDBEdit;
    DBEdit27: TDBEdit;
    DBEdit28: TDBEdit;
    DBEdit29: TDBEdit;
    DBEdit33: TDBEdit;
    DBEdit34: TDBEdit;
    DBEdit35: TDBEdit;
    DBEdit36: TDBEdit;
    DBEdit37: TDBEdit;
    GroupBoxJL4: TGroupBoxJL;
    Label45: TLabel;
    Label46: TLabel;
    Label47: TLabel;
    Label48: TLabel;
    Label49: TLabel;
    Label50: TLabel;
    Label51: TLabel;
    Label52: TLabel;
    DBEdit38: TDBEdit;
    DBEdit39: TDBEdit;
    DBEdit40: TDBEdit;
    DBEdit41: TDBEdit;
    DBEdit42: TDBEdit;
    DBEdit43: TDBEdit;
    DBEdit44: TDBEdit;
    DBEdit45: TDBEdit;
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure SbNuevoClick(Sender: TObject);
    procedure SbModificarClick(Sender: TObject);
    procedure SbBorrarClick(Sender: TObject);
    procedure SB_SalirClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure SBCancelarClick(Sender: TObject);
    procedure SBConfirmarClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure PGCDrawTab(Control: TCustomTabControl; TabIndex: Integer;
      const Rect: TRect; Active: Boolean);
    procedure SpeedButtonBC1Click(Sender: TObject);
    procedure SpeedButtonBC2Click(Sender: TObject);
    procedure SpeedButtonBC3Click(Sender: TObject);
    procedure SpeedButtonBC4Click(Sender: TObject);
    procedure SpeedButtonBC10Click(Sender: TObject);
    procedure SpeedButtonBC6Click(Sender: TObject);
    procedure SpeedButtonBC12Click(Sender: TObject);
    procedure SpeedButtonBC5Click(Sender: TObject);
    procedure SpeedButtonBC11Click(Sender: TObject);
    procedure SpeedButtonBC16Click(Sender: TObject);
    procedure SpeedButtonBC15Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  UConfi: TUConfi;
  IBT:TIBTransaction;

implementation

{$R *.dfm}

uses UDM,  //Modulo de Datos       ç
     Fun_Errores, //Libreria paramshform errores
     UMENU,     //Menu del programa y donde se encuentran las variables principales
     Fun;  //Librería de funciones varias  *


//[ 2]----------------[ Para poder tener tabs del page control en color]--------
constructor TTabSheet.Create(aOwner: TComponent);
//------------------------------------------------------------------------------
//*************************************[ Crear nueva propiedad tabsheet ]*******
//------------------------------------------------------------------------------
begin
  inherited;
  FColor := clBtnFace;
end;
//[ 2]--FIN SECCIÓN---[ Para poder tener tabs del page control en color]--------

//[ 3]----------------[ Para poder tener tabs del page control en color]--------
procedure TTabSheet.SetColor(Value: TColor);
//------------------------------------------------------------------------------
//**************************************************[ Seleción de color ]*******
//------------------------------------------------------------------------------
begin
  if FColor <> Value then
  begin
    FColor := Value;
    Invalidate;
  end;
end;
//[ 3]--FIN SECCIÓN---[ Para poder tener tabs del page control en color]--------

//[ 4]----------------[ Para poder tener tabs del page control en color]--------
procedure TTabSheet.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
//------------------------------------------------------------------------------
//******************************************[ Dibujar en el pagecontrol ]*******
//------------------------------------------------------------------------------
begin
  if FColor = clBtnFace then
    inherited
  else
  begin
    Brush.Color := FColor;
    Windows.FillRect(Msg.dc, ClientRect, Brush.Handle);
    Msg.Result := 1;
  end;
end;
//[ 4]--FIN SECCIÓN---[ Para poder tener tabs del page control en color]--------

procedure TUConfi.FormActivate(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************[ Cuando se activa El form ]******
// Lo que queremos que haga nuestro Form Cuando se Actiba
//------------------------------------------------------------------------------
begin
    if Timer1.Enabled=false then Timer1.Enabled:=True;
    //Ponemos el Juego de colores de mis  NewPanelDB
    PanelBotonera.ColorNotActive:=COLORPANELACT;
    PanelBotonera.ActiveColor:=COLORPANELNOACT;
    PanelDatos.ActiveColor:=COLORPANELACT;
    PanelDatos.ColorNotActive:=COLORPANELNOACT;
    PanelConfirmar.ActiveColor:=COLORPANELACT;
    PanelConfirmar.ColorNotActive:=COLORPANELNOACT;
    //Ponemos el Juego de colores de mi  DbComboBoxExt
    DbComboBoxExt1.ColorA:=COLOR1GRID;
    DbComboBoxExt1.ColorB:=COLOR2GRID;
end;

procedure TUConfi.FormClose(Sender: TObject; var Action: TCloseAction);
//------------------------------------------------------------------------------
//*************************************************[ Al Cerrarse El Form ]******
// Cerramos todos los procesos para que no consuman memoria y posibles errores
//------------------------------------------------------------------------------
begin
   if Timer1.Enabled=true then  Timer1.Enabled:=False;
end;

procedure TUConfi.FormCreate(Sender: TObject);
//------------------------------------------------------------------------------
//***************************************************[ Al Crearse el Fom ]******
// Cosas que queremos que haga según se inicie el Form
//------------------------------------------------------------------------------
begin
    {Cosas que queremos que haga según se inicie el Form}
//[ 5]----------------------------[ Tabs de page control en color ]-------------

    Empresa.Color:=clMoneyGreen;      //verde pastel
    Numeradores.Color:=clSkyBlue;     //Azul Pastel
    LOPD.Color:=clInfoBk;            //Amarillo pastel
//[ 5]--FIN SECCIÓN---------------[ Tabs de page control en color ]-------------
    PGC.ActivePageIndex:=0;
end;

procedure TUConfi.FormKeyPress(Sender: TObject; var Key: Char);
//------------------------------------------------------------------------------
//************************************************[  Al pulsar una tecla ]******
// Al pulsar la tecla salta al foco del siguiente componente, si esta admitido
//------------------------------------------------------------------------------
begin
    if (Key = #13) then {Si se ha pulsado enter }
    if (ActiveControl is TEdit)
    or (ActiveControl is TDBEdit)
    or (ActiveControl is TDBComboBox) then
    begin
      Key := #0; { anula la puulsación }
      Perform(WM_NEXTDLGCTL, 0, 0); { mueve al próximo control }
    end
end;

procedure TUConfi.FormPaint(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************************[ Paint ]****
//  Para arregar un fallo en la fase de diseño
//------------------------------------------------------------------------------
begin
    //Me aseguro de que coja el color de l fondo, no se porque se desactiva en el componente,
    //Tambien podria igualarlo por el color directamente
    GroupBoxJL1.ParentBackground:=True;
    GroupBoxJL2.ParentBackground:=True;
    GroupBoxJL3.ParentBackground:=True;
    GroupBoxJL4.ParentBackground:=True;
    GroupBoxJL5.ParentBackground:=True;
    GroupBoxJL6.ParentBackground:=True;
    GroupBoxJL8.ParentBackground:=True;
    GroupBoxJL9.ParentBackground:=True;
end;

procedure TUConfi.PGCDrawTab(Control: TCustomTabControl; TabIndex: Integer;
  const Rect: TRect; Active: Boolean);
//------------------------------------------------------------------------------
//************************************************[ COLORES PAGECONTROL ]*******
//------------------------------------------------------------------------------
var
//[ 6]----------------[ Para poder tener tabs del page control en color]--------
  AText: string;
  APoint: TPoint;
//[ 6]--FIN SECCIÓN---[ Para poder tener tabs del page control en color]--------
begin

//[ 7]----------------[ Para poder tener tabs del page control en color]--------
  with (Control as TPageControl).Canvas do
  begin
    Brush.Color := ClGreen;
    FillRect(Rect);
    AText := TPageControl(Control).Pages[TabIndex].Caption;
    with Control.Canvas do
    begin
      APoint.x := (Rect.Right - Rect.Left) div 2 - TextWidth(AText) div 2;
      APoint.y := (Rect.Bottom - Rect.Top) div 2 - TextHeight(AText) div 2;
      TextRect(Rect, Rect.Left + APoint.x, Rect.Top + APoint.y, AText);
    end;
  end;
//[ 7]--FIN SECCIÓN---[ Para poder tener tabs del page control en color]--------
end;

procedure TUConfi.SbBorrarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Borrar el Actual Registro ]******
//------------------------------------------------------------------------------
var VarINumRegistros:Integer;
begin                                //Cambiar por el mensaje elegido
   if not DsPrincipal.DataSet.IsEmpty then
   begin
      VarINumRegistros:=DsPrincipal.DataSet.RecordCount;
      if VarINumRegistros>1 then
      begin
         if (MessageBox(0, '¿Esta seguro  de eliminar el registro actual?', 'Eliminar Registro', MB_ICONSTOP or MB_YESNO or MB_DEFBUTTON2) = ID_No) then abort
         else begin
           DSPrincipal.DataSet.Delete;
           ShowMessage('El registro ha sido eliminado');
           IBT.CommitRetaining;
         end;
      end else
      begin
         if (MessageBox(0, 'sólo existe el registro actual de configuración, ¿esta seguro de querer eliminarlo?', 'Eliminar Registro', MB_ICONSTOP or MB_YESNO or MB_DEFBUTTON2) = ID_No) then abort
         else begin
             DSPrincipal.DataSet.Delete;
             ShowMessage('El registro ha sido eliminado');
             IBT.CommitRetaining;
         end;
      end;
   end else ShowMessage('No hay registros que poder borrar');
end;

procedure TUConfi.SBCancelarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************[ Cancelar Proceso]******
//------------------------------------------------------------------------------
begin
  DSPrincipal.DataSet.Cancel;
end;

procedure TUConfi.SBConfirmarClick(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************************[ Grabar datos ]******
//------------------------------------------------------------------------------
begin
  try
    DSPrincipal.DataSet.Post;
    //Ajuastamos los colores de las variables
    COLOR1GRID:=StringToColor(DsPrincipal.DataSet.FieldByName('COLORA').AsString);
    COLOR2GRID:=StringToColor(DsPrincipal.DataSet.FieldByName('COLORB').AsString);
    COLORPANELACT:=StringToColor(DsPrincipal.DataSet.FieldByName('COLORACTIVO').AsString);
    COLORPANELNOACT:=StringToColor(DsPrincipal.DataSet.FieldByName('COLORNOACTIVO').AsString);
  except
    on E: Exception do
    begin
        MessageBeep(1000);
        ShowMessage('Se ha producido un error y el proceso no se ha podido terminar   Unidad:[ FConfi ]   Modulo:[ Grabar ]' + Chr(13) + Chr(13)
                  + 'Clase de error: ' + E.ClassName + Chr(13) + Chr(13)
                  + 'Mensaje del error:' + E.Message+Chr(13) + Chr(13)
                  + '    '+Chr(13) + Chr(13)
                  + 'El proceso ha quedado interrumpido');
        DSPrincipal.DataSet.Cancel;
    end;
  end;
end;

procedure TUConfi.SbModificarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Editar el actual registro ]******
//------------------------------------------------------------------------------
begin
   if DsPrincipal.DataSet.IsEmpty<>true then
   begin
      DSPrincipal.DataSet.Edit;
      DBEdit1.SetFocus;
   end else ShowMessage('No hay tregistros disponibles para editar')

end;

procedure TUConfi.SbNuevoClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Creamos un nuevo registro ]******
//------------------------------------------------------------------------------
begin
  DSPrincipal.DataSet.Insert;
  //Nos aseguramos de que los DBIMEMOS esten vacios
  DBIBMemo1.Lines.Clear;
  DBIBMemo2.Lines.Clear;
  DBIBMemo3.Lines.Clear;
  DBIBMemo4.Lines.Clear;
  DBEdit1.SetFocus;
end;

procedure TUConfi.SB_SalirClick(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************************[ Salir Del Form ]******
//------------------------------------------------------------------------------
begin
   UConfi.Close;
end;

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.

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.

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 :)

Gracias mamcx, vere los enlaces que de dices.

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

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.

Pero esas cosas no sirven para delphi, ¿no?

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.

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.

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)

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.

Ahora ale toca a la tabla bancos

Ahora toca a contactos

Ahora direcciones

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.

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.

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.

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.

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

Ahora el modulo que reúne las direcciones


Aquí la imagen




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