Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Varios
Actualizar esta página Programa de gestión desde 0
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Coloboración Paypal con ClubDelphi

Respuesta
Página 1 de 3 1 23 >
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 22-05-2013
Avatar de José Luis Garcí
[José Luis Garcí] José Luis Garcí is offline
Miembro Premium
  
Registrado: may 2003
Ubicación: Las Palmas de G.C.
Posts: 1.372
Poder: 23
José Luis Garcí Va camino a la fama
Lightbulb 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

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
__________________
Un saludo desde Canarias, "El abuelo Cebolleta"
Responder Con Cita
  #2  
Antiguo 22-05-2013
Avatar de José Luis Garcí
[José Luis Garcí] José Luis Garcí is offline
Miembro Premium
  
Registrado: may 2003
Ubicación: Las Palmas de G.C.
Posts: 1.372
Poder: 23
José Luis Garcí Va camino a la fama
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)
__________________
Un saludo desde Canarias, "El abuelo Cebolleta"
Responder Con Cita
  #3  
Antiguo 22-05-2013
Avatar de PepeLolo
PepeLolo PepeLolo is offline
Miembro
  
Registrado: jun 2003
Ubicación: Fuenlabrada - Madrid - Espagna
Posts: 265
Poder: 22
PepeLolo Va por buen camino
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
__________________
PepeLolo
El hombre el único virus que mide más de unas cuantas micras
Responder Con Cita
  #4  
Antiguo 22-05-2013
Avatar de Casimiro Notevi
Casimiro Notevi Casimiro Notevi is offline
Moderador
  
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.264
Poder: 10
Casimiro Notevi Tiene un aura espectacularCasimiro Notevi Tiene un aura espectacular
Cita:
Empezado por José Luis Garcí Ver Mensaje
Hola compañeros mi idea es montar un programa de gestión desde 0


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.
Responder Con Cita
  #5  
Antiguo 22-05-2013
Avatar de José Luis Garcí
[José Luis Garcí] José Luis Garcí is offline
Miembro Premium
  
Registrado: may 2003
Ubicación: Las Palmas de G.C.
Posts: 1.372
Poder: 23
José Luis Garcí Va camino a la fama
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.
__________________
Un saludo desde Canarias, "El abuelo Cebolleta"
Responder Con Cita
  #6  
Antiguo 22-05-2013
[maeyanes] maeyanes is offline
Capo de los Capos
  
Registrado: may 2003
Ubicación: Campeche, México
Posts: 2.732
Poder: 24
maeyanes Va por buen camino
Hola...

Aquí metiendo mi cuchara...

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...
__________________
Lee la Guía de Estilo antes que cualquier cosa. - Twitter
Responder Con Cita
  #7  
Antiguo 22-05-2013
Avatar de José Luis Garcí
[José Luis Garcí] José Luis Garcí is offline
Miembro Premium
  
Registrado: may 2003
Ubicación: Las Palmas de G.C.
Posts: 1.372
Poder: 23
José Luis Garcí Va camino a la fama
Gracias maeyanes, pero uso firebird 2. algo pero no es 2.5
__________________
Un saludo desde Canarias, "El abuelo Cebolleta"
Responder Con Cita
  #8  
Antiguo 22-05-2013
Avatar de mamcx
mamcx mamcx is offline
Moderador
  
Registrado: sep 2004
Ubicación: Medellín - Colombia
Posts: 3.927
Poder: 26
mamcx Tiene un aura espectacularmamcx Tiene un aura espectacularmamcx Tiene un aura espectacular
Muy buena la idea.

Cita:
Empezado por José Luis Garcí Ver Mensaje
XCP T10 /* T10 = VARCHAR(20) */, //Código Postal
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...
__________________
El malabarista.
Responder Con Cita
  #9  
Antiguo 22-05-2013
Avatar de Casimiro Notevi
Casimiro Notevi Casimiro Notevi is offline
Moderador
  
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.264
Poder: 10
Casimiro Notevi Tiene un aura espectacularCasimiro Notevi Tiene un aura espectacular
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)   
); 

...
Responder Con Cita
  #10  
Antiguo 22-05-2013
Avatar de José Luis Garcí
[José Luis Garcí] José Luis Garcí is offline
Miembro Premium
  
Registrado: may 2003
Ubicación: Las Palmas de G.C.
Posts: 1.372
Poder: 23
José Luis Garcí Va camino a la fama
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) */
);
__________________
Un saludo desde Canarias, "El abuelo Cebolleta"
Responder Con Cita
  #11  
Antiguo 22-05-2013
Avatar de PepeLolo
PepeLolo PepeLolo is offline
Miembro
  
Registrado: jun 2003
Ubicación: Fuenlabrada - Madrid - Espagna
Posts: 265
Poder: 22
PepeLolo Va por buen camino
Talking
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 de BBDD
__________________
PepeLolo
El hombre el único virus que mide más de unas cuantas micras
Responder Con Cita
  #12  
Antiguo 22-05-2013
Avatar de newtron
[newtron] newtron is offline
Membrillo Premium
  
Registrado: abr 2007
Ubicación: Motril, Granada
Posts: 3.595
Poder: 21
newtron Va camino a la fama
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.

Saludos




Edito: ¿Alguien me dice una web para subir imágenes que no de muchos problemas?
__________________
Be water my friend.
Última edición por newtron fecha: 22-05-2013 a las 21:16:28.
Responder Con Cita
  #13  
Antiguo 22-05-2013
Avatar de José Luis Garcí
[José Luis Garcí] José Luis Garcí is offline
Miembro Premium
  
Registrado: may 2003
Ubicación: Las Palmas de G.C.
Posts: 1.372
Poder: 23
José Luis Garcí Va camino a la fama
Vamos por partes (que dijo Jack el destripador ), 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


Cita:
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.
y que lo digas
__________________
Un saludo desde Canarias, "El abuelo Cebolleta"
Responder Con Cita
  #14  
Antiguo 22-05-2013
Avatar de José Luis Garcí
[José Luis Garcí] José Luis Garcí is offline
Miembro Premium
  
Registrado: may 2003
Ubicación: Las Palmas de G.C.
Posts: 1.372
Poder: 23
José Luis Garcí Va camino a la fama
Cita:
Edito: ¿Alguien me dice una web para subir imágenes que no de muchos problemas?
prueba con www.casimages.es
__________________
Un saludo desde Canarias, "El abuelo Cebolleta"
Responder Con Cita
  #15  
Antiguo 23-05-2013
Avatar de Neftali [Germán.Estévez]
Neftali [Germán.Estévez] Neftali [Germán.Estévez] is offline
[becario]
  
Registrado: jul 2004
Ubicación: Barcelona - España
Posts: 18.586
Poder: 10
Neftali [Germán.Estévez] Es un diamante en brutoNeftali [Germán.Estévez] Es un diamante en brutoNeftali [Germán.Estévez] Es un diamante en bruto
Cita:
Empezado por José Luis Garcí Ver Mensaje
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.
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.

__________________
Germán Estévez => Web/Blog
Guía de estilo, Guía alternativa
Utiliza TAG's en tus mensajes.
Contactar con el Clubdelphi

P.D: Más tiempo dedicado a la pregunta=Mejores respuestas.
Responder Con Cita
  #16  
Antiguo 23-05-2013
Avatar de José Luis Garcí
[José Luis Garcí] José Luis Garcí is offline
Miembro Premium
  
Registrado: may 2003
Ubicación: Las Palmas de G.C.
Posts: 1.372
Poder: 23
José Luis Garcí Va camino a la fama
Bueno aquí mi pantalla de configuración, por desgracia no soy muy bueno haciendo las pantallas vistosas

__________________
Un saludo desde Canarias, "El abuelo Cebolleta"
Responder Con Cita
  #17  
Antiguo 23-05-2013
Avatar de José Luis Garcí
[José Luis Garcí] José Luis Garcí is offline
Miembro Premium
  
Registrado: may 2003
Ubicación: Las Palmas de G.C.
Posts: 1.372
Poder: 23
José Luis Garcí Va camino a la fama
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;
__________________
Un saludo desde Canarias, "El abuelo Cebolleta"
Responder Con Cita
  #18  
Antiguo 23-05-2013
Avatar de José Luis Garcí
[José Luis Garcí] José Luis Garcí is offline
Miembro Premium
  
Registrado: may 2003
Ubicación: Las Palmas de G.C.
Posts: 1.372
Poder: 23
José Luis Garcí Va camino a la fama
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.
__________________
Un saludo desde Canarias, "El abuelo Cebolleta"
Responder Con Cita
  #19  
Antiguo 23-05-2013
Avatar de José Luis Garcí
[José Luis Garcí] José Luis Garcí is offline
Miembro Premium
  
Registrado: may 2003
Ubicación: Las Palmas de G.C.
Posts: 1.372
Poder: 23
José Luis Garcí Va camino a la fama
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.
__________________
Un saludo desde Canarias, "El abuelo Cebolleta"
Responder Con Cita
  #20  
Antiguo 23-05-2013
Avatar de Casimiro Notevi
Casimiro Notevi Casimiro Notevi is offline
Moderador
  
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.264
Poder: 10
Casimiro Notevi Tiene un aura espectacularCasimiro Notevi Tiene un aura espectacular
Cita:
Empezado por José Luis Garcí Ver Mensaje
Bueno aquí mi pantalla de configuración, por desgracia no soy muy bueno haciendo las pantallas vistosas
A mi me parecen bien, y a quien no le guste, que la cambie
Responder Con Cita
Respuesta
Página 1 de 3 1 23 >

« Tema Anterior | Próximo Tema »


Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes
El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
llamar un programa desde otro programa en un computador con dos monitores RONPABLO Varios 0 10-10-2011 19:20:51
Cargar tu programa desde otro programa rmendoza83 Varios 7 05-01-2009 20:51:33
Lanzar programa desde mi programa Pablo Carlos API de Windows 32 09-09-2004 14:56:26
Ejecutar un programa externo desde un programa de Delphi Roger_Fernandez Varios 3 02-09-2004 19:05:36
ISC ERROR CODE:335544344 I/O error for file "c:\gestion\gestion.gdb" eliasterrero Firebird e Interbase 2 28-06-2004 13:20:25


La franja horaria es GMT +2. Ahora son las 19:49:53.

Club Delphi - Archivo - Top

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi