Ir al contenido



Foto

Programa de gestión desde 0


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

#1 Desart

Desart

    Advanced Member

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

Escrito 22 mayo 2013 - 04:33

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

Imagen Enviada

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:

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


Ahora iré detallando los campos

[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

[/DELPHI]

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

#2 Desart

Desart

    Advanced Member

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

Escrito 22 mayo 2013 - 05:12

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

Imagen Enviada

Aquí el 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.[/DELPHI]


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

#3 cadetill

cadetill

    Advanced Member

  • Moderadores
  • PipPipPip
  • 994 mensajes
  • LocationEspaña

Escrito 22 mayo 2013 - 07:43

Buenas Desart

Ante todo decirte que me parece genial la iniciativa y que miraré de aportar mi granito de arena en lo posible.

Ahora algunos detalles/preguntas

  • ¿Por qué la X delante de los campos? No entiendo el motivo que das. ¿Puedes poner un ejemplo?
  • Personalmente te recomendaría primero definir la base de datos (diagrama ER), te facilitará después el salto a la programación y podremos hacernos una idea del alcance del programa.
  • Estaría bien que explicaras también cómo será la aplicación técnicamente (C/S, monopuesto, 3 capas,....), cómo la quieres programar (herencia visual, bpls, exes en que quieres dividirla si fuera el caso,.....) y cómo será visualmente (SDI, MDI) y cualquier otra cosa que se te pueda ocurrir para ilustrarnos de cómo será.
  • Te recomiendo tener no menos de 2 conexiones a la base de datos, una para lectura y otra para escritura configuradas las dos debidamente (aunque suelo usar Read Commited para ambas).

Si va a ser un proyecto "público", podrías subirlo a code.google o a sourceforge e ir actualizándolo vía SVN, así todos los interesados podrían tener siempre la última versión :-)

Nos leemos
  • 0

#4 Desart

Desart

    Advanced Member

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

Escrito 22 mayo 2013 - 08:04

Hola cadetill intentare responderte a todo dentro de lo que pueda calro, no tengo el nivel de los maestros del club

1º) El motivo de poner la X es sólo por cuestiones personales, lo uso por que de esta manera echando un vistazo al código identifico más rápidamente los campos de la tabla configuración y muchas veces hace referencia a un campo de otra tabla que se llama igual.

2º) a pesar de los años que llevo programando que es un Diagrama ER, si te refieres a la representación gráfica de la conexión de las tablas, no tengo programa para ello, que yo sepa?

3º) la idea es mono puesto (aunque con poco seria multipuesto), para  una empresa (tampoco costaría en multiempresas), SDI (siempre trabajo en este formato me es más cómodo) y dependiendo del tamaño que adquiera suelo trabajar con un único exe y modulo a modulo (estoy trabajando en un componente contenedor de varios módulos estándar, excepciones, avisos, consultas, pero aún esta muy lejos de terminarlo)

4º) a que te refieres con 2 conexiones, suelo trabajar con una, nunca lo he hecho de otra manera.

Si te aclara un poco más las dudas estoy trabajando y por tanto aquí lo aplicare, sacando a tablas independientes los campos comunes usando para su control el campo MODULO y CODIGO, para que quede más claro, tenemos las tablas proveedores, clientes, empleados, etc que tienen campos comunes que se pueden exportar a otra tabla, ejemplo la tabla Persona de contacto, Direcciones, Contacto, Bancos y lo que pudiese surgir, de esta manera, podemos aplicar a un proveedor, varias direcciones por ejemplo


Te pongo la estructura de la tabla persona de contacto



delphi
  1. CREATE TABLE PC (
  2.     ID          INTEGER NOT NULL,
  3.     MODULO      T20 /* T20 = VARCHAR(20) */,      //Este seria al modulo al que pertenece (CLIENTES, PROVEEDORES,AGENTES, ETC)
  4.     CODIGO      T20 /* T20 = VARCHAR(20) */,      //Aquí el código que tiene en el modulo este (CLIENTE, PROVEEDOR, AGENTE, ETC)
  5.     NOMBRE      T80 /* T80 = VARCHAR(80) */,
  6.     MOVIL      T40 /* T40 = VARCHAR(40) */,
  7.     EMAIL      T80 /* T80 = VARCHAR(80) */,
  8.     CASADO      LOG /* LOG = CHAR(1) */,
  9.     HIJOS      LOG /* LOG = CHAR(1) */,
  10.     FECHANACIM  DATE,
  11.     PUESTO      T40 /* T40 = VARCHAR(40) */,
  12.     EXT        T10 /* T10 = VARCHAR(20) */,
  13.     NOTAS      MEMO /* MEMO = BLOB SUB_TYPE 1 SEGMENT SIZE 80 */,
  14.     FOTO        IMG /* IMG = BLOB SUB_TYPE 0 SEGMENT SIZE 80 */
  15. );



De esta manera puedo tener a todas las personas de contacto y mediante una consulta mostrar todas las personas de contacto de un cliente por ejemplo.
  • 0

#5 Rolphy Reyes

Rolphy Reyes

    Advanced Member

  • Moderadores
  • PipPipPip
  • 2.090 mensajes
  • LocationRepública Dominicana

Escrito 22 mayo 2013 - 09:06

Saludos.

@Desart, si utilizas el IbExpert tienes la posibilidad de crear el ER y sí, ER = Entidad Relación, se refiere justamente a eso que indicas.
  • 0

#6 Desart

Desart

    Advanced Member

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

Escrito 22 mayo 2013 - 09:16

Si no me equivoco te refieres al apartado Querry Builder, que no es operativo en la versión personal, en el creador Sql hay algo parecido, pero es para el montaje de consultas y no cabrían todas las tablas.
  • 0

#7 Rolphy Reyes

Rolphy Reyes

    Advanced Member

  • Moderadores
  • PipPipPip
  • 2.090 mensajes
  • LocationRepública Dominicana

Escrito 22 mayo 2013 - 09:33

Si no me equivoco te refieres al apartado Querry Builder, que no es operativo en la versión personal, en el creador Sql hay algo parecido, pero es para el montaje de consultas y no cabrían todas las tablas.


Saludos.

Revisa estos enlaces:
Info1
Info2
  • 0

#8 Desart

Desart

    Advanced Member

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

Escrito 22 mayo 2013 - 10:28

Hola Rolphy Reyes, puede que yo sea muy torpe, me he bajado la última versión personal del Ibexpert, pero no encuentro el  Reverse Engineering, si veo database designer, pero me dice que no es valido para la edición personal.  Estoy haciendo algo mal
  • 0

#9 Desart

Desart

    Advanced Member

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

Escrito 22 mayo 2013 - 10:31

Cambiado el nombre de los campos de la tabla, para que estén mucho más claros


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

#10 Desart

Desart

    Advanced Member

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

Escrito 23 mayo 2013 - 11:41

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

Imagen Enviada


Aquí el código del archivo pas  682 lineas

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

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.TabIndex<PGC.PageCount then 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.clubdelph...ead.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.[/DELPHI]

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

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

#11 Raymond J

Raymond J

    Member

  • Miembros
  • PipPip
  • 10 mensajes

Escrito 19 noviembre 2014 - 10:35

Muchas gracias por el tutorial, lo probaré  (y)
  • 0