PDA

Ver la Versión Completa : Programa de gestión desde 0


Páginas : [1] 2

José Luis Garcí
22-05-2013, 12:59:59
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

http://nsae01.casimages.net/img/2013/05/22/130522121834468116.jpg (http://www.casimages.es/i/130522121834468116.jpg.html)

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:

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


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

José Luis Garcí
22-05-2013, 13:36:37
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

http://nsae01.casimages.net/img/2013/05/22/130522011917168576.jpg (http://www.casimages.es/i/130522011917168576.jpg.html)

Aquí el código

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)

PepeLolo
22-05-2013, 15:54:52
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

Casimiro Notevi
22-05-2013, 16:03:06
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.

José Luis Garcí
22-05-2013, 16:34:34
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.

maeyanes
22-05-2013, 16:51:47
Hola...

Aquí metiendo mi cuchara... :p

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



Saludos...

José Luis Garcí
22-05-2013, 17:01:30
Gracias maeyanes, pero uso firebird 2. algo pero no es 2.5

mamcx
22-05-2013, 17:38:04
Muy buena la idea.


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


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:


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

Casimiro Notevi
22-05-2013, 18:04:21
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 ():

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

...

José Luis Garcí
22-05-2013, 18:57:58
Cuando se tiene razón se da y aqui como queda ahora la base de datos
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) */
);

PepeLolo
22-05-2013, 19:50:33
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

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.

SERIE
SERIE2
SERIE3
USARSERIEYEAR


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

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

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


PD: Me gustan mucho las tablas :D de BBDD

newtron
22-05-2013, 20:09:40
Bueno, puestos a opinar yo opino.

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

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

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

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

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

Saludos

http://sia1.subirimagenes.net/img/2013/05/22/mini_130522080226443460.jpg (http://www.subirimagenes.net/i/130522080226443460.jpg)


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

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

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

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

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


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

José Luis Garcí
22-05-2013, 20:23:53
Edito: ¿Alguien me dice una web para subir imágenes que no de muchos problemas?

prueba con www.casimages.es

Casimiro Notevi
22-05-2013, 20:27:04
prueba con www.casimages.es (http://www.casimages.es)
En flickr, desde ayer te dan 1 giga gratis.

mamcx
22-05-2013, 20:57:31
En flickr, desde ayer te dan 1 giga gratis.


1 Terabyte.

Casimiro Notevi
22-05-2013, 21:41:59
1 Terabyte.
Eso, un tera :)
Es que con un giga a mi me sobra :)

Neftali [Germán.Estévez]
23-05-2013, 10:46:45
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.

^\||/

José Luis Garcí
23-05-2013, 20:01:39
Bueno aquí mi pantalla de configuración, por desgracia no soy muy bueno haciendo las pantallas vistosas

http://nsae01.casimages.net/img/2013/05/23/13052307341859474.jpg (http://www.casimages.es/i/13052307341859474.jpg.html)

José Luis Garcí
23-05-2013, 20:03:56
Aquí la 1º parte del código del archivo pas 682 lineas

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;

José Luis Garcí
23-05-2013, 20:05:42
Aquí la 2º parte del código del archivo pas 682 lineas


Aquí el código del archivo pas 682 lineas



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.clubdelphi.com/foros/showthread.php?t=57360
// Del compañero Gluglu, para pegar desde el portapapeles
// Añadir al Uses las unit Clipbrd, jpeg, ShellAPI
//------------------------------------------------------------------------------
var
f : TFileStream;
Jpg : TJpegImage;
Hand : THandle;
Buffer : Array [0..MAX_PATH] of Char;
numFiles : Integer;
File_Name : String;
Jpg_Bmp : String;
BitMap : TBitMap;
ImageAux : TImage;

begin

ImageAux := TImage.Create(Self);

if Clipboard.HasFormat(CF_HDROP) then begin

Clipboard.Open;
try
Hand := Clipboard.GetAsHandle(CF_HDROP);
If Hand <> 0 then begin
numFiles := DragQueryFile(Hand, $FFFFFFFF, nil, 0) ; //Unit ShellApi
if numFiles > 1 then begin
Clipboard.Close;
ImageAux.Free;
Errorx('Pegar-1','Ingredientes','Pegar','El Portapapeles contiene más de un único fichero. No es posible pegar','','',False,clSkyBlue,clNavy,500);
Exit;
end;
Buffer[0] := #0;
DragQueryFile( Hand, 0, buffer, sizeof(buffer)) ;
File_Name := buffer;
end;
finally
Clipboard.close;
end;

f := TFileStream.Create(File_Name, fmOpenRead);
Jpg := TJpegImage.Create;
Bitmap := TBitmap.Create;

// Check if Jpg File
try
Jpg.LoadFromStream(f);
ImageAux.Picture.Assign(Jpg);
Jpg_Bmp := 'JPG';
except
f.seek(0,soFromBeginning);
Jpg_Bmp := '';
end;

if Jpg_Bmp = '' then begin
try
Bitmap.LoadFromStream(f);
Jpg.Assign(Bitmap);
ImageAux.Picture.Assign(Jpg);
Jpg_Bmp := 'BMP';
except
Jpg_Bmp := '';
end;
end;

Jpg.Free;
Bitmap.Free;
f.Free;

if Jpg_Bmp = '' then begin
ImageAux.Free;
Errorx('Pegar-2','Ingredientes','Pegar','Fichero seleccionado no contiene ninguna Imagen del Tipo JPEG o BMP','','',False,clSkyBlue,clNavy,500);
Exit;
end;

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

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

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

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

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

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

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

end.

José Luis Garcí
23-05-2013, 20:06:34
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

unit DBColorComboBox;

interface

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

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

procedure Register;

implementation

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


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

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

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

procedure TDBColorBox.Change;
begin
inherited Change;
end;

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

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

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

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

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

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

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

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

procedure TDBColorBox.Loaded;
begin
inherited Loaded;
end;

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

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

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

end.

mamcx
23-05-2013, 20:16:26
Serie bueno que este tipo de cosas las pongan en un repositorio de codigo fuente. Un foro no es muy bueno pa mostar mas que unas cuantas lineas de codigo.

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

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

https://gist.github.com/

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

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

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

José Luis Garcí
23-05-2013, 20:25:00
Gracias mamcx, vere los enlaces que de dices.

Casimiro Notevi
23-05-2013, 20:59:14
Bueno aquí mi pantalla de configuración, por desgracia no soy muy bueno haciendo las pantallas vistosas
A mi me parecen bien, y a quien no le guste, que la cambie :)

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

http://graphicriver.net/search?utf8=%E2%9C%93&term=gui+pack

Y seguir las guis de buen diseño de apps, como la interface humana de Apple (https://developer.apple.com/library/mac/#documentation/UserExperience/Conceptual/AppleHIGuidelines/Intro/Intro.html) - que igual es aplicable a otras plataformas-.

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

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

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

Casimiro Notevi
23-05-2013, 21:20:04
Pero esas cosas no sirven para delphi, ¿no?

mamcx
23-05-2013, 22:17:04
Y porque no van a servir? Son solo graficos (pngs por ejemplo) e ideas para inspirarse. No es muy dificil de lograr una pantalla atractiva si se piensa en capas y se ajustan las cosas.

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

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

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

José Luis Garcí
01-06-2013, 15:35:33
Primero disculparme por el retraso, pero debido a un problema en el apartado de configuración de un programa y a los dos componentes que ya he puesto aquí (http://www.clubdelphi.com/foros/showthread.php?p=461639&posted=1#post461639), no he podido seguir adecuadamente con el programa, en primer lugar un cambio en Data Module, quedando el código al final de la siguiente manera;


//Primero añadimos las llamadas

procedure conectar;
procedure DataModuleCreate(Sender: TObject);

//y luego el código

implementation

{$R *.dfm}

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

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

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




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

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

José Luis Garcí
01-06-2013, 15:50:28
Primero explicar los * y el (1)

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

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

José Luis Garcí
01-06-2013, 15:54:44
Ahora ale toca a la tabla bancos

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

José Luis Garcí
01-06-2013, 15:59:16
Ahora toca a contactos

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

José Luis Garcí
01-06-2013, 16:01:04
Ahora direcciones

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

José Luis Garcí
01-06-2013, 16:07:10
y ya hoy por último

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

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

José Luis Garcí
02-06-2013, 10:39:02
Ahora voy a poner las funciones usadas

Archivo: FUN_DBGRID

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

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


Ahora pongo el módulo completo Fun_Errores:

unit Fun_Errores;

interface

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

function ErrorDetail(Error:string):string;

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

implementation
uses UErrores; //Modulo para mostrar el Error

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


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

end.

José Luis Garcí
02-06-2013, 10:42:50
Aquí la imagen del modulo necesario para la función ErrorX

http://nsae01.casimages.net/img/2013/06/02/130602101158631830.jpg (http://www.casimages.es/i/130602101158631830.jpg.html)

y el código del módulo

unit UErrores;

interface

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

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

var
FError: TFError;

implementation

{$R *.dfm}

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

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

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

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

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

end.

José Luis Garcí
02-06-2013, 10:50:13
Seguimos con las funciones

De mi archivo Fun.pas

//-----------------------------------------------------------------------------
//**********************************************************[ ActQuerry ]******
// 20/11/2010 JLGT Para modificar la sentencia de un querry
//-----------------------------------------------------------------------------
// Estudiando como poder hacer mi código mas corto se me ocurrio esta función
// para usar un los IBQerry, para mi base de datos Firebird.
// El tema es que cada vez que utilizo un querry y lo modifico tengo que
// escribir unas 20 lineas y mediante este sistema, logro reducirlo a una sola
// ya que es un, código repetitivo y soló varia el nombre del query y la
// sentencia Sql, cree esta función
//-----------------------------------------------------------------------------
// [QRY] Tibquery a actualizar
// [TxtSql] Cadena de texto con sentencia SQL
// [MostrarMEnsaje] Si muestra el mensaje de la Exception
// [RetornarMEnsaje] Si retorna la cadena Sql que da el Error
// [RetornarQuerry] Si retorna El querry a la cadena sql de antes del error
//-----------------------------------------------------------------------------
// Base de datos a usar CLIENTES
// if ActQuerry(IBQuerry1,'Select * form Clientex')=true then
// showmessage('Existe la base de datos')
// else showmessage('No existe la base de datos');
//-----------------------------------------------------------------------------
Function ActQuery(QRY:TIBQuery; TxtSql:string; MostrarMensaje:boolean=VMiLogico;Retornarmensaje:boolean=VMiLogico; RetornarQuerry:boolean=VMiLogico): Boolean;
var AntSql:string;
begin
try
try
AntSql:=QRY.SQL.Text;
QRY.Active:=false;
QRY.SQL.Clear;
QRY.SQL.Text:=TxtSql;
QRY.Active:=true;
Result:=true;
except
on E: Exception do
begin
if MostrarMensaje=true then
begin
ShowMessage('Se ha producido un error: ' + Chr(13) + Chr(13)
+ 'Clase de error: ' + E.ClassName + Chr(13) + Chr(13)
+ 'Mensaje del error: ' + E.Message+ Chr(13) + Chr(13)
+' '+ Chr(13) + Chr(13)
+'Se volvera al estado anterior');
end;
Result:=false;
end;
end;
finally
if Result=false then
begin
if Retornarmensaje=true then ShowMessage('Sentencia Sql que ha dado Error' + Chr(13) + Chr(13)+ QRY.SQL.Text);
if RetornarQuerry=true then
begin
QRY.Active:=false;
QRY.SQL.Clear;
QRY.SQL.Text:=AntSql;
QRY.Active:=true;
end;
end;
end;
end;

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

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


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



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

José Luis Garcí
02-06-2013, 10:54:44
Empezamos con el módulo clientes
Aquí os pongo la imagen

http://nsae01.casimages.net/img/2013/06/02/130602102220223975.jpg (http://www.casimages.es/i/130602102220223975.jpg.html)

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

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

José Luis Garcí
02-06-2013, 11:09:21
Ahora el modulo que reúne las direcciones


Aquí la imagen

http://nsae01.casimages.net/img/2013/06/02/130602103958634851.jpg (http://www.casimages.es/i/130602103958634851.jpg.html)


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

Casimiro Notevi
02-06-2013, 11:11:28
Este hilo se merece estar siempre arriba, así que ahí está, como tema importante.

José Luis Garcí
02-06-2013, 11:21:58
Aquí el módulo que reúne los contactos y que más adelante sus datos lo usaremos en la agenda

aquí la imagen
http://nsae01.casimages.net/img/2013/06/02/130602105059858240.jpg (http://www.casimages.es/i/130602105059858240.jpg.html)

Aquí una imagen espesificando este detalle

http://nsae01.casimages.net/img/2013/06/02/130602105152981318.jpg (http://www.casimages.es/i/130602105152981318.jpg.html)

y aquí el código

https://gist.github.com/anonymous/5693067

existe un pequeño error en el código el correcto es

procedure TFContactos.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;
ActIbdataset(DM.IBDContacto,'select * from CONTACTOS');
//Retornos al modulo de llamada
if VarSNomMod='CLIENTES' then FClientes.SpeedButtonBC7Click(sender); //antes ponía FClientes.SpeedButtonBC4Click(sender);
//Según se van creando los módulos de llamada ir añadiendo, ejmplo Proveedores, Agentes, Personal, etc
end;

José Luis Garcí
02-06-2013, 11:41:06
Aquí el módulo que reúne las personas de contacto

Aquí la imagen
http://nsae01.casimages.net/img/2013/06/02/130602110549106473.jpg (http://www.casimages.es/i/130602110549106473.jpg.html)

Aquí un detalle de datos de familia
http://nsae01.casimages.net/img/2013/06/02/130602110641678429.jpg (http://www.casimages.es/i/130602110641678429.jpg.html)

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

y por último las nuevas funciones usadas de mi fichero Fun.pas
//------------------------------------------------------------------------------
//****************************************************[ ImputFamiliaaMemo ]****
// Parte de la idea original de Felipe Monteiro del 25/05/2006
// bajada de http://www.planetadelphi.com.br/dica/5756/input-combo-(simulando-um-inputbox-com-combo)
//------------------------------------------------------------------------------
// J.L.G.T. 01/05/2013 Basando me en el código de Felipe Monteiro , lo adapte a
// mis necesidades, creando un imput de doble entrada en mi caso para insertar
// dos edit y grabarlo a a un memo
//------------------------------------------------------------------------------
// [Memo] TMemo Donde grabaremos los datos
// [Acaption] String Texto en la barra del caption
// [Aprompt] String Texto aclaratorio para el mensaje o petición
//------------------------------------------------------------------------------
//---EJEMPLO--------------------------------------------------------------------
// procedure TForm1.Button1Click(Sender: TObject);
// begin
// Label1.Caption:=ImputFamiliaaMemo(MEmo1,'Datos de familia','Nombre de la Esposa');
// end;
//------------------------------------------------------------------------------
function ImputFamiliaaMemo(Memo:TMemo;const ACaption, APrompt: string): string;
function GetCharSize(Canvas: TCanvas): TPoint;
var
I: Integer;
Buffer: array[0..51] of Char;
begin
for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
Result.X := Result.X div 52;
end;

var
Form: TForm;
Prompt: TLabel;
Combo: TSpinEdit;
Ed: TEdit;
NomH:TEdit;
Labelfec2: TLabel;
labelnh:Tlabel;
DialogUnits: TPoint;
ButtonTop, ButtonWidth, ButtonHeight: Integer;
R: TRect;
begin
Result := '';
Form := TForm.Create(Application);
with Form do
try
Canvas.Font := Font;
DialogUnits := GetCharSize(Canvas);
BorderStyle := bsDialog;
FormStyle :=fsStayOnTop;
Caption := ACaption;
ClientWidth := MulDiv(195, DialogUnits.X, 4);
Position := poScreenCenter;
Prompt := TLabel.Create(Form);
with Prompt do
begin
Parent := Form;
Caption := APrompt;
Left := MulDiv(8, DialogUnits.X, 4);
Top := MulDiv(8, DialogUnits.Y, 8);
Constraints.MaxWidth := MulDiv(180, DialogUnits.X, 4);
WordWrap := True;
end;
Ed:=TEdit.Create(Form);
with Ed do
begin
Parent := Form;
Left := Prompt.Left;
Top := Prompt.top+Prompt.Height+5;
Width := MulDiv(180, DialogUnits.X, 4);
Text :='';
end;
Labelfec2 := TLabel.Create(Form);
with Labelfec2 do
begin
Parent := Form;
Caption := 'Número de hijos';
Left := Prompt.Left;
Top := ED.top+ED.Height+5;
WordWrap := True;
end;
Combo := TSpinEdit.Create(Form);
with Combo do
begin
Parent := Form;
Left := Prompt.Left;
Value :=0;
Top := Labelfec2.top+Labelfec2.Height+5;
Width := MulDiv(178, DialogUnits.X, 4);
end;
labelnh := TLabel.Create(Form);
with labelnh do
begin
Parent := Form;
Caption := 'Nombre de los hijos';
Left := Prompt.Left;
Top := Combo.top+Combo.Height+5;
WordWrap := True;
end;
NomH := TEdit.Create(Form);
with NomH do
begin
Parent := Form;
Left := Prompt.Left;
Top := labelnh.top+labelnh.Height+5;
Width := MulDiv(180, DialogUnits.X, 4);
Text :='';
end;
ButtonTop := NomH.top+NomH.Height+10;;
ButtonWidth := MulDiv(50, DialogUnits.X, 4);
ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
with TButton.Create(Form) do
begin
Parent := Form;
Caption := 'OK';
ModalResult := mrOk;
default := True;
SetBounds(MulDiv(Prompt.Left-2, DialogUnits.X, 4), ButtonTop, ButtonWidth,
ButtonHeight);
end;
with TButton.Create(Form) do
begin
Parent := Form;
Caption := 'Cancelar';
ModalResult := mrCancel;
Cancel := True;
SetBounds(MulDiv(137, DialogUnits.X, 4), ButtonTop,ButtonWidth, ButtonHeight);
Form.ClientHeight :=ButtonTop+ButtonHeight+5; //Altura
end;
if ShowModal = mrOk then
begin
if Ed.Text<>'' then Memo.Lines.Add('Esposa:[ '+ed.Text+' ]');
if Combo.Value<>0 then
begin
Memo.Lines.Add('Nº de hijos:[ '+IntToStr(Combo.Value)+' ]');
if NomH.Text<>'' then Memo.Lines.Add('Nombre de los hijos:[ '+NomH.Text+' ]');
end;
end;
finally
Form.Free;
end;
end;

//------------------------------------------------------------------------------
//**********************************[ FECHA_DBEDIT_ENTER ]*******
// Nueva 24/11/2010 Se encarga de Asignar una fecha si el edit esta vació
// se pone en el evento OnEnter del Dbedit
//-----------Ejemplo-------------
// FECHA_DBEDIT(dbedit1,Fecha);
//------------------------------------------------------------------------------
//******************[ AÑADIR AL PRINCIPIO DEL unit de la función ]*******
// const
// VMiAutoFECHA='';
//-----------------------------------------------------------------------------
function FECHA_DBEDIT_ENTER(dbedit:tdbedit;Fecha:String=VMiautoFecha):Tdate;
begin
try
try
if dbedit.Text<>'' then dbedit.Text:=Fecha
else begin
Fecha:=DateToStr(now);
dbedit.Text:=fecha;
end;

StrToDate(fecha); //Para que se produzca una excepción si no es una fecha
except
on E: Exception do
begin
ShowMessage('Se ha producido un error: ' + Chr(13) + Chr(13)
+ 'Clase de error: ' + E.ClassName + Chr(13) + Chr(13)
+ 'Mensaje del error: ' + E.Message+Chr(13) + Chr(13)
+ ' '+Chr(13) + Chr(13)
+ 'Se anula la Fecha introducida y se asigna la del sistema');
dbedit.Text:=DateToStr(Now);
Fecha:=DateToStr(now);
end;
end;
finally
Result:=StrToDate(Fecha);
end;
end;

//------------------------------------------------------------------------------
//*******************************************************[ FECHA_DBEDIT ]*******
// Nueva 23/11/2010 Se encarga de que con las teclas Arriba/abajo aumentar
//reducir un día, se pone en el evento OnKeyDown del Dbedit
//-----------Ejemplo-------------
// FECHA_DBEDIT(dbedit1,Key);
//------------------------------------------------------------------------------
function FECHA_DBEDIT(dbedit:tdbedit; Tecla:Word):Boolean;
begin
if (Tecla=VK_UP) then DBEdit.text:=DateToStr(StrToDate(DBEdit.Text)+1); //Añadimos un día
if (Tecla=VK_DOWN) then DBEdit.Text:=DateToStr(StrToDate(DBEdit.Text)-1);//Disminuimos un día
end;

José Luis Garcí
02-06-2013, 11:55:22
Aquí el módulo que reúne los bancos

Aquí la imagen
http://nsae01.casimages.net/img/2013/06/02/130602112252653815.jpg (http://www.casimages.es/i/130602112252653815.jpg.html)


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

y nuevas funciones usadas de mi archivo Fun.pas

//------------------------------------------------------------------------------
//************************************************************[ EditLogico ]****
// JLGT 01052013 Modificada de un procedure para admitir sólo unos caracteres en un edit
// BAsado en el código de la página http://www.nochesdecode.com.ar/2012/11/edit-que-solo-admite-letras-en-delphi.html
//--Partes----------------------------------------------------------------------
//--Ejemplo---------------------------------------------------------------------
// procedure TFCLIENTES.DBEdit6Change(Sender: TObject);
// begin
// DBEdit6.text:=EditLogico(tedit(Dbedit6)); //sólo admitira 'S N s n'
// //O
// DBEdit6.text:=EditLogico(tedit(Dbedit6), '0123456789'); //sólo admitira '0 1 2 3 4 5 6 7 8 9'
// end;
//------------------------------------------------------------------------------
function EditLogico(edit:TEdit;Cadena:string='SNsn'):String;
var
i : integer;
aux,aux2: string;
begin
aux2:='';
with Edit do
begin
aux:=text;
for i:=1 to length(aux) do
if pos(aux[i],Cadena)>0 then aux2:=aux2+aux[i];
SelStart:=length(aux2);
end;
Result:=aux2;
end;

//------------------------------------------------------------------------------
//**************************************************************[ CalculaDC]****
// Parte de la idea original de ??? 15/05/2013
// bajada de http://www.delphiaccess.com/forum/index.php?action=showfaq;id=78
//------------------------------------------------------------------------------
// tal como estaba sin modificaciones por mi parte
//------------------------------------------------------------------------------
// [BancoOficina] String Banco más oficina de 4+4 usar la funcion ceros
// [Cuenta] String El nº de cuenta de 10 digitos usar la funcion ceros
//------------------------------------------------------------------------------
//---EJEMPLO--------------------------------------------------------------------
// procedure TForm1.Button1Click(Sender: TObject);
// begin
// Label1.Caption := IntToStr(CalculaDC('00851755','0000321764'));
// end;
//------------------------------------------------------------------------------
function CalculaDC(BancoOficina, Cuenta: string):integer;
const
Pesos: array[0..9] of integer=(6,3,7,9,10,5,8,4,2,1);
var
n: byte;
iTemp: integer;
begin
iTemp := 0;
for n := 0 to 7 do
iTemp := iTemp + StrToInt(Copy(BancoOficina, 8 - n, 1)) * Pesos[n];
Result := 11 - iTemp mod 11;
if (Result > 9) then Result := 1 - Result mod 10;
iTemp := 0;
for n := 0 to 9 do
iTemp := iTemp + StrToInt(Copy(Cuenta, 10 - n, 1)) * Pesos[n];
iTemp := 11 - iTemp mod 11;
if (iTemp > 9) then iTemp := 1 - iTemp mod 10;
Result := Result * 10 + iTemp;
end;

//**************************************************************[ CEROS ]*******
// Delvuelve unacadena reyena de ceros al frente
// Propia
// EJEMPLO
// a2:=ceros(inttostr(32),4);
// a2 = 0032
//------------------------------------------------------------------------------
function ceros(text:string;Cant:integer):string;
var
valor,x:integer;
dev,con:string;
begin
con:='';
valor:=length(text);
if valor<Cant then
begin
for x:=1 to (cant-valor) do
begin
con:=con+'0';
end;
dev:=con+text;
end
else
dev:=text;
result:=dev;
end;

José Luis Garcí
02-06-2013, 12:10:04
Gracias Casimiro, estaba tan metido en subir los datos que no me había fijado en que contestaste. Muchas gracias por considerarlo interesante

José Luis Garcí
06-06-2013, 11:54:41
Para que quede más claro el uso de la tabla clientes, con direcciones, contactos, personas de contacto y bancos os pongo un esquema, que acabo de hacer con un nuevo programa Free, que esta muy bien

http://nsae01.casimages.net/img/2013/06/06/130606102148223869.jpg (http://www.casimages.es/i/130606102148223869.jpg.html)

el programa se llama Ibeasy+ y lo podéis bajar de http://ibeasy.software.informer.com/.

Ahora que creo quede más claro mi idea de uso de las tablas modulares (no si sera correcto), paso a explicar un par de términos y su uso básico, para que luego al usarlos estén un pocos más claros.

Stock: Creo que es el más común y se refiere a la cantidad de mercancía que tenemos disponible

ADR: Se refiere al transporte de mercancía por carretera y una gran cantidad de países se han acogido al sistema, es obligatorio en los países de la comunidad europea y en todos los acogidos a este sistema. El llevar mercancías que necesitan ADR y no llevarlo conlleva severas multas al conductor y a la empresa, e incluso in movilización del vehículo y la mercancías. para más información

http://es.wikipedia.org/wiki/Acuerdo_europeo_relativo_al_transporte_internacional_de_mercanc%C3%ADas_peligrosas_por_carretera

Trazabilidad: Este es el punto más peliagudo, la mayor parte de la gente cree, que sólo es obligatorio a los productos comestibles, pero realmente hay que aplicarla a otros muchos sectores, como todos los derivados de los químicos, manufacturados, alimentación, agricultura, residuales, Nucleares y un largo etc.

Hay que tener en cuenta que la trazabilidad es desde la creación del producto (inclusive anterior de los proveedores) hasta el consumidor final (quedando exento en este punto supermercados, tiendas y pocos más al no tener un control exacto de a quién se le ha vendido la mercancía) la trazabilidad viene controlada por lo que se llaman seriales, lotes, etc e implica que toda una producción hecha o creada (Artificial o naturalmente) tenga un mismo número de registro, asignando el número de registro (lote) la cantidad/formato de producto sacado, aunque el (lote) no varia hay que especificar cantidad lote, pongo un ejemplo:

Hacemos 1000 Litros de lavavajillas lote 130001 y sacamos en los siguientes formatos
Lote................Cantidad.............Formato...............Total Litros
--------------------------------------------------------------
130001............20.....................Garrafas 25 L.........500 L.
130001............80.....................Garrafas 5 L...........400 L.
130001............100...................Botellas 1 L............100 L.

Esto obliga a tener controlado las ordenes de producción y al control de la trazabilidad de los 1000 Litros del lote 130001, mediante partes de rotura, utilización interna, en fabricación uso como materias primas o re conversión y por supuesto ventas (albaranes, facturas, etc.)

Hay que usar el sistema de recursividad, con la trazabilidad, al igual que con el Stock, es decir si eliminamos una factura, cambiamos la cantidad a menos o nos devuelven una mercancía. eta debe ser controlada tanto en el stock como en su control de lotes.

La trazabilidad permite a los organismos públicos, en contacto con las empresas a tener controlado todo el proceso de una mercancía, aunque se hay trasformado en otra, desde su origen al consumidor final (hipotéticamente), el responsable del problema pagará una multa, pero si alguna de las partes no tiene la trazabilidad, la multa puede ser mucho mayor y si se produjesen muertes o lesiones graves, puede llevar incluso a prisión, en caso de tenerla controlada, esto muy difícilmente ocurriría, salvo que seamos los responsables.

Y por último, es muy frecuente que tengamos que controlar junto con la trazabilidad la caducidad, ya que muchos productos, alimentarios, químicos, etc, tiene caducidad.

Para más información podéis dirigiros a http://es.wikipedia.org/wiki/Trazabilidad

Ley de Protección de Datos (LPD): Esta ley obliga a todas las empresas que controlen cual quier tipo de datos de clientes, proveedores, etc. a tener contratado una empresa gestora de dicha ley, esto obliga al texto que deben aparecer, en emails, facturas y demás documentos y aplicarla a nuestro programa es bastante simple, se trata de tener 2 o 3 memos, que su texto se pueda editar y guardar, para posibles cambios futuros y que aparezcan en nuestros documentos físicos como digitales. aparte de esto, obliga a que el cliente si así lo pide, no sea puesto en listados de ningún tipo, e incluso sea borrada su información, pero tener cuidado, por que hacienda esta por encima de esta Ley y si borráis, datos antes del cierre con hacienda y no aparecen los datos del cliente podéis tener un grabe problema. Las multas por no tener este sistema aplicado van desde los 6.000 euros a los 600.000 o el cierre de la empresa con posibilidad de prisión.

Para más información ir a http://noticias.juridicas.com/base_datos/Admin/lo15-1999.html

Lotes: Así es como voy a denominar el control identificativo de nuestra trazabilidad. Los lotes pueden tener derivados, pudiendo ser padres e hijos, o maestros y esclavos. Quiero decir que de un producto con un lote se puede vender en varios productos diferentes, si haber alteración, cada producto tendrá un lote pero tenemos que tener controlado de que lo te viene. Ejemplo:

Hacemos un Desengrasante base lote 130002 de este embotellamos una parte como limpia suelos desengrasante u otro artículo y a este último le asignarnos el lote 130003, quedando de la siguiente manera
Lote Padre <> Lote Hijo
130002...........130003 (este realmente es un derivado sin modificación del lote 130002 y cuando pidamos un informe del lote 130002 debe darnos la información del lote 130003, para tener la trazabilidad correcta e igualmente pero al revés si la solicitamos del 130003.

Ordenes de producción: Esto implica el proceso para la creación del lote con el producto fabricable (no confundir con el producto final), implica el operario, lote y formatos y cantidades.

Diferencias entre un producto fabricable y el producto final: El producto fabricable, es el producto que vamos a fabricar y el producto final es el producto ya en su formato. Ejemplo

Producto Fabricable: Lavavajillas producto finales, Lavavajillas 5L, Lavavajillas 25L, Lavavajillas 1L , Lavavajillas a granel, etc.

Estos conceptos deben quedar muy claros, ya que si no es fácil perderse más adelante, así que si tenéis dudas, preguntar ahora antes de seguir, y por supuesto, los que no sois de España, debéis informaros de las leyes en vuestro país. Pero la mayoría de programas no tiene estos conceptos que algunos de ellos son obligatorios hace más de una década.

José Luis Garcí
07-06-2013, 11:45:51
Empezamos ahora con artículos

Estructura de la base de datos

CREATE TABLE ARTICULOS (
ID INTEGER NOT NULL,
CODIGO T20 /* T20 = VARCHAR(20) */, //Código del artículo
PRODUCTO T80 /* T80 = VARCHAR(80) */, //Nombre del producto
COSTE POR /* POR = NUMERIC(15,4) */, //Coste del producto
CODIGOPROVEEDOR T20 /* T20 = VARCHAR(20) */, //Código del proveedor
PV1 POR /* POR = NUMERIC(15,4) */, //Precio de venta tarifa 1
PV2 POR /* POR = NUMERIC(15,4) */, //Precio de venta tarifa 2
PV3 POR /* POR = NUMERIC(15,4) */, //Precio de venta tarifa 3
PV4 POR /* POR = NUMERIC(15,4) */, //Precio de venta tarifa 4
PV5 POR /* POR = NUMERIC(15,4) */, //Precio de venta tarifa 5
DTO1 POR /* POR = NUMERIC(15,4) */, //Descuento de venta tarifa 1
DTO2 POR /* POR = NUMERIC(15,4) */, //Descuento de venta tarifa 2
DTO3 POR /* POR = NUMERIC(15,4) */, //Descuento de venta tarifa 3
DTO4 POR /* POR = NUMERIC(15,4) */, //Descuento de venta tarifa 4
DTO5 POR /* POR = NUMERIC(15,4) */, //Descuento de venta tarifa 5
FAMILIA T20 /* T20 = VARCHAR(20) */, //Familia del artículo
CODIGOBARRAS39 T20 /* T20 = VARCHAR(20) */, //Código de barras libre
CODIGOBARRASEAN13 T20 /* T20 = VARCHAR(20) */, //Códigos de barra estándar Ean 13
PESO POR /* POR = NUMERIC(15,4) */, //Peso del formato del producto
PROPIO LOG /* LOG = CHAR(1) */, //Si es un artículo de fabricación propia
TRAZABILIDAD LOG /* LOG = CHAR(1) */, //Si lleva trazabilidad
SERVICIO LOG /* LOG = CHAR(1) */, //Si es un servicio
CADUCO LOG /* LOG = CHAR(1) */, //Si el artículo es caduco (se lleva la caducidad con el lote
TIPOIMPUESTO INTEGER, //Tipo de aimpuesto aplicable (va con el nombre del impuesto en configuración)
COMISIONMAXIMA POR /* POR = NUMERIC(15,4) */, //Comisión máxima a pagar en este artículo, prevalece sobre la comisión en el agente
DTOMAXIMO POR /* POR = NUMERIC(15,4) */, //Descuento máximo del artículo (prevalece sobre los descuentos en clientes o aplicados en DTO1...DTO5)
RAPEL1 INTEGER, //Rapel de ventas en tarifa 1
RAPEL2 INTEGER, //Rapel de ventas en tarifa 2
RAPEL3 INTEGER, //Rapel de ventas en tarifa 3
RAPEL4 INTEGER, //Rapel de ventas en tarifa 4
RAPEL5 INTEGER, //Rapel de ventas en tarifa 5
ADR VARCHAR(150) CHARACTER SET NONE, //Descripción de la frase de adr
ADREXEPCION INTEGER, // formatos que estan exentos del adr según el propio ADR
ADRLIMITE INTEGER //Limite de mercancía a transportar por un conductor y vehículo sin el carnet y permiso de mercancías peligrosas
);

Rapel: Los clientes que se les hace descuento por rapel, deben hacerles albaranes, unificando a la hora de facturar, la mercancía por código, de manera que si el total de unidades vendidas es igual o superior al rapel de su tarifa se aplica el precio de esta tarifa, en caso contrario se aplica el PVP normal.

Escala de Rapel: Es cuando el cliente parte de un precio normal y según sus ventas finales a la hora de facturar se aplica la tarifa según el rapel alcanzado (no lo he usado nunca y nunca me lo han pedido)


Ahora la tabla NOTAS
CREATE TABLE NOTAS (
ID INTEGER NOT NULL,
NOMBREMODULO T20 /* T20 = VARCHAR(20) */, //Nombre del módulo
CODIGO T20 /* T20 = VARCHAR(20) */, //Código del módulo al que pertenece
DESCRIPCION T20 /* T20 = VARCHAR(20) */, //Descripción dentro del modulo, (Avisos, Notas, Alertas,etc.)
NOTAS MEMO /* MEMO = BLOB SUB_TYPE 1 SEGMENT SIZE 80 */ //Campo memo para notas
);

Y por último La tabla imágenes

CREATE TABLE IMAGENES (
ID INTEGER NOT NULL,
NOMBREMODULO T20 /* T20 = VARCHAR(20) */, //Nombre del módulo
CODIGO T20 /* T20 = VARCHAR(20) */, //Código del módulo al que pertenece
DESCRIPCION T20 /* T20 = VARCHAR(20) */, //Descripción dentro del modulo, (Foto, interior, exterior, detalle, etc.)
IMAGENES IMG /* IMG = BLOB SUB_TYPE 0 SEGMENT SIZE 80 */ //Imagen a mostrar
);

José Luis Garcí
07-06-2013, 18:16:23
Me gustaría saber si esta quedando claro lo que llevo explicado, o tengo que ser más claro.

Casimiro Notevi
07-06-2013, 22:31:34
Yo lo entiendo bien, y eso que soy bastante torpe :D

Gracias, muy completo, la verdad :)

José Luis Garcí
08-06-2013, 00:32:14
Hola compañero antes de seguir considero oportuno poner algunas imágenes del programa de facturación que hice para mi antigua empresa.

Primero veréis que hay datos tachados, por que lo que os muestro son con información real y hay que respetar la protección de datos, así que pido disculpas, aun así creo que queda bastante claro

Para empezar una imagen del tema de los lotes

http://nsae01.casimages.net/img/2013/06/07/130607114202666992.jpg (http://www.casimages.es/i/130607114202666992.jpg.html)

Como podéis ver marco en rojo el lote del producto que buscamos, en verde sería el maestro (en este caso es el mismo que hemos introducido) y en naranja el lote derivado que vemos que es el 120402, se puede dar el caso que el lote 120401, tenga el derivado que tenga, pero también tenga un maestro que pueda ser por ejemplo el 120399.

Ya que hablo de mi antiguo programa, que por cierto este que empiezo nuevo es por hacerlo más sencillo y eficaz, os pongo una imagen de un proceso que más abajo os explico.

http://nsae01.casimages.net/img/2013/06/08/130608120642801849.jpg (http://www.casimages.es/i/130608120642801849.jpg.html)

como podéis ver se trata de la edición de Facturas, con datos reales, os pongo imagen del menú, del visor de documentos (presupuestos, pedidos, albaranes y facturas), del editor de documentos y por último el editor de artículos, que contiene aparte de la información habitual, contiene lotes disponible (La única condición será que 1º el stock disponibles sea igual o superior a 1 y 2º que la fecha de caducidad sea inferior a la actual), por supuesto esto lo veis en el apartado llamado lotes y vencimientos, después del Stringrid hay una última linea que nos permite introducir un lote de forma manual (Se da en más de una ocasión, de que aun no hemos dado la entrada de la mercancía y tengamos que facturarla))
Por otro lado en el apartado precios veréis algo que es muy poco común, por un lado 5 tarifas de precios (esto es normal) y por otro precio especial del cliente, esto si os dais cuenta no esta en la estructura ni de clientes, ni en la de artículos, si no que esta en una tabla independiente y para que se muestre debe darse las siguientes condiciones el código del cliente y el del artículo, pero ya lo veremos mucho más adelante.

Por cierto algo que es muy posible que en breve sea obligatorio en la facturación y demás documentos de ventas, es que deben tener el peso por artículos, el total de la factura y una hoja de ruta detallando la factura, peso total de la misma y peso total de mercancía transportada. Pero aún no es obligatorio.

José Luis Garcí
08-06-2013, 11:33:47
Cambios a realizar en la unidad UBAncos de Bancos

debe quedar de la siguiente manera:
procedure TFBancos.DSPrincipalDataChange(Sender: TObject; Field: TField);
//------------------------------------------------------------------------------
//******************************************************[ Datasorce change ]****
//------------------------------------------------------------------------------
begin
if (not (DsPrincipal.DataSet.State in [dsEdit,dsInsert])) and (FBancos.Active) then
begin
Label12.Caption :=ceros(DBEdit5.Text,4)+'/'+ ceros(DBEdit6.Text,4)+'/'+ceros(DBEdit7.Text,2)+'/'+ceros(DBEdit8.Text,10);
end;
end;

y

procedure TFBancos.DBEdit5Change(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************************[ Change Dbedit5 ]****
// Comprueba el digíto de control
//------------------------------------------------------------------------------
begin
TDBEdit(Sender).Text:=EditLogico(tedit(TDBEdit(Sender)), '0123456789');
if (DBEdit5.Text<>'') and (DBEdit6.Text<>'') and (DBEdit8.Text<>'') and (FBancos.Active) then
begin
DBEdit7.Field.Value:=StrToInt( IntToStr(CalculaDC(ceros(DBEdit5.Text,4)+ ceros(DBEdit6.Text,4),ceros(DBEdit8.Text,10))));
end;
Label12.Caption :=ceros(DBEdit5.Text,4)+'/'+ ceros(DBEdit6.Text,4)+'/'+ceros(DBEdit7.Text,2)+'/'+ceros(DBEdit8.Text,10);
if (Length(DBEdit5.Text)>=4) and (Sender=DBEdit5) then DBEdit6.SetFocus;
if (Length(DBEdit6.Text)>=4) and (Sender=DBEdit6) then DBEdit8.SetFocus;
end;

Como podéis comprobar me faltaba en ambos casos and (FBancos.Active) para evitar que cargue datos sin estar activo

José Luis Garcí
09-06-2013, 15:47:08
Se que puede parecer un tostón este hilo, pero estamos hablando de miles de lineas y conceptos que no se pueden dejar de lados, aparte de eso, como creo que nos pasa a todos, vamos mejorando métodos y el código, o corrigiendo errores según vamos avanzando, así que no me queda otro remedio sino ir poniendo los diferentes cambios

Vamos ahora con artículos

Como siempre la imagen

http://nsae01.casimages.net/img/2013/06/09/13060903103020564.jpg (http://www.casimages.es/i/13060903103020564.jpg.html)

Como podéis ver no pongo la pestaña facturado, ya que aún no tenemos preparado la facturación y como en todos el código que llevo puesto, no pondré el código de impresión, por que al tener múltiples operadores a la hora de imprimir, que cada uno use y diseñe el que le gusta.

El código https://gist.github.com/anonymous/5743472

Funciones usada de mi archivo fun_dbgrid.pas


function GridImagen(Grid:TDBGrid; Campo:TField; Rect:TRect; Column:TColumn; State:TGridDrawState):Boolean;
begin
if Column.Field = Campo then
begin
if not (gdSelected in State) then // se não for a célula selecionada
Grid.Canvas.FillRect(Rect); // limpa a célula
with TPicture.Create do
begin
Assign(Campo);
Grid.Canvas.StretchDraw(Rect,Bitmap); // desenha imagem
Free;
end;
Result:=True;
end else Result:=False;
end;


function MemoGridB(Grid:TDBGrid; Campo:TField; Rect:TRect; Column:TColumn; State:TGridDrawState):Boolean;
var FixRect:TRect;
begin
fixRect:=Rect; // declara uma variável local fixRect : TRect
Dec(fixRect.Bottom,2);
if Column.Field=Campo then
begin
if not (gdSelected in State) then
Grid.Canvas.FillRect(Rect);
DrawText(Grid.Canvas.Handle,pchar(Campo.AsString), length(campo.AsString),fixRect,DT_WORDBREAK);
Result:=True;
end else Result:=False;
end;

José Luis Garcí
09-06-2013, 15:52:32
Ahora le toca al apartado de notas

http://nsae01.casimages.net/img/2013/06/09/130609031906986865.jpg (http://www.casimages.es/i/130609031906986865.jpg.html)

tengo un pequeño error en este módulo que aún no he encontrado, que es que no muestra las imágenes de los botones y no se si tendré que rehacerlo, pero la ida esta hay y los botones son los de siempre y el código no varia.

el código https://gist.github.com/anonymous/5743504

y de este apartado nada más

José Luis Garcí
09-06-2013, 16:04:22
Ahora a las imágenes

http://nsae01.casimages.net/img/2013/06/09/130609032428251065.jpg (http://www.casimages.es/i/130609032428251065.jpg.html)

el código https://gist.github.com/anonymous/5743525

Aquí si hay un cambio importante en el botón de cargar imagen, yo ya he hecho el cambio en el resto de los módulos, el código queda de la siguiente manera

procedure TFImagenes.SpeedButtonBC1Click(Sender: TObject);
//------------------------------------------------------------------------------
//*********************************************************[ Cargar imagen ]****
//------------------------------------------------------------------------------
begin
CargaIimagenADBImagen(OpenPictureDialog1,DBImage1);
end;

y la función es
//------------------------------------------------------------------------------
//*************************************************[ CargaIimagenADBImagen ]****
// Parte de la idea original de ??? 09/06/2013
// bajada de http://www.planetadelphi.com.br/dica/4381/inserindo-imagem-a-um-campo-blob
//------------------------------------------------------------------------------
// Pequeñas modificaciones y convertido a unción por mi permitiendo cargar varios
// tipos de imágenes diferentes
//------------------------------------------------------------------------------
// [Dialog] TOpenPictureDialog Dialogo de cargad de la imagen
// [Dbimage] TDBImage El nº de cuenta de 10 digitos usar la funcion ceros
//------------------------------------------------------------------------------
//---EJEMPLO--------------------------------------------------------------------
// CargaIimagenADBImagen:(OpenPictureDialog1,Dbimage1);
//------------------------------------------------------------------------------

function CargaIimagenADBImagen(Dialog:TOpenPictureDialog;Dbimage:TDBImage):Boolean;
var imagem : TPicture;
begin
if Dialog.Execute then
begin
try
imagem:=TPicture.Create;
imagem.LoadFromFile(Dialog.FileName);
Clipboard.Assign(imagem);
Dbimage.PasteFromClipboard;
imagem.Free;
Result:=True;
except on E: Exception do
Result:=False;
end;
end;
end;

También se realizaron cambios en mi módulo de datos (DM.pas) el código añadido es el siguiente



uses Fun;

....

procedure TDM.DataModuleDestroy(Sender: TObject);
//------------------------------------------------------------------------------
//*********************************************************[ Al destruirlo ]****
// Nos aseguramos de que no se nos queden Querys abiertos //Añadir el archivo Fun.Pas
//------------------------------------------------------------------------------
begin
QuerryOC(IBQIMAGENES);
QuerryOC(IBQNOTAS);
end;

y una imagen de como va quedando

http://nsae01.casimages.net/img/2013/06/09/130609033219499667.jpg (http://www.casimages.es/i/130609033219499667.jpg.html)


Como ya comente, el código y uno va evolucionando, así que seguirá habiendo cambios.

De momento que tal os va pareciendo, es muy pesado, esta claro?, es que como hay tan pocos comentarios, no se si estoy aburriendo al personal.

Casimiro Notevi
09-06-2013, 22:15:45
Un gran trabajo que servirá de referencia para muchos ^\||/
GRACIAS :)

José Luis Garcí
09-06-2013, 22:30:54
Muchas gracias Caimiro, estas siendo un grana poyo, la verdad que lo que doy no es ni comparado con lo que he recibido. Lo único, es que no se si es que lo estoy haciendo muy complejo, por que esperaba, más criticas o dudas.

Ni siquiera se si mi método es el más adecuado para un ejemplo, ya que estoy seguro, que otros compañeros serán capaces de hacerlo mucho más sencillo

Casimiro Notevi
10-06-2013, 00:31:05
A mí me parece que para los que quieran acercarse a ver un proyecto muy completo y no "de aficionado", van a tener un buena guía gracias a tu trabajo, y no sólo por el código en sí, sino también por los conceptos profesionales de lotes, protección de datos, trazabilidad, tratamiento de imágenes, etc.
No se podrán quejar :)

fjcg02
10-06-2013, 09:31:51
Es un lujo disponer de toda esta información.

Gracias José Luis

José Luis Garcí
10-06-2013, 09:47:49
A mí me parece que para los que quieran acercarse a ver un proyecto muy completo y no "de aficionado", van a tener un buena guía gracias a tu trabajo, y no sólo por el código en sí, sino también por los conceptos profesionales de lotes, protección de datos, trazabilidad, tratamiento de imágenes, etc.
No se podrán quejar :)

Gracias Casimiro, sólo espero estar haciéndolo bien

José Luis Garcí
10-06-2013, 09:54:21
Es un lujo disponer de toda esta información.

Gracias José Luis


Gracias Javier, no considero que sea un lujo, creo que es información que esta ahí, que por cuestiones de la vida me ha tocado empollarlas, por trabajar en un sector que las necesita y no me ha quedado más remedio que aprenderlas, pero la mayor parte de autodidacta, así que es posible que me puedan corregir, tanto en la definición de los conceptos, como en alguna parte del proceso.

Lo que no quiero es sonar como prepotente, cuando doy los conceptos o he dicho que la mayoría de los programas omiten estas partes, no es que todo el mundo lo haga, pero estuve buscando software para la que era mi empresa de Fabricación de productos de limpieza y sólo encontré un programa en español que se adaptara + o - y aún así le faltaban cosas.

José Luis Garcí
10-06-2013, 11:10:13
Antes de seguir comentaros que el tema de la Ley de Protección de Datos obliga a que nuestro programa tenga acceso con claves y nuestra base de datos también, en este caso estoy usando Firebird y para esta demo no lo haré, pero ademas uso unas funciones y encripto los nombres y documentos (NIF, DNI) dentro de la base de datos, desencriptandolas en los formas, ya que nos encargamos que al form sólo se accede si se tiene el nivel necesario.

Vamos con la estructura de las siguientes 6 tablas

Proveedores

CREATE TABLE PROVEEDORES (
ID INTEGER NOT NULL,
CODIGO T20 /* T20 = VARCHAR(20) */, //Código del proveedor
EMPRESA T80 /* T80 = VARCHAR(80) */, //Nombre de la empresa
LIBRE T80 /* T80 = VARCHAR(80) */, //Campo libre sin uso inicialmente
CIF T20 /* T20 = VARCHAR(20) */, //Número del CIF o documento identificativo
FECHAALTA DATE, //Fecha de alta
FORMAPAGO T40 /* T40 = VARCHAR(40) */, //Forma de pago
DIASPAGO T20 /* T20 = VARCHAR(20) */ //Los días de pago
);

Empleados incluye a los agentes

CREATE TABLE EMPLEADOS (
ID INTEGER NOT NULL,
CODIGO T20 /* T20 = VARCHAR(20) */, /Código del empleado
AGENTE LOG /* LOG = CHAR(1) */, //Es un agente/comercial
MEDIACOMISION NUMERIC(15,2), /Media de su comisión, se puede poner la más alta y el programa regulara sobre la comisión por producto
FECHAALTA DATE, //Fecha de alta
FECHABAJA DATE, //Fecha de su baja (Los datos de los empleados en ciertos sectores no se pueden borrar nunca, como en todas las empresas del sector químico
NUMEROSEGURIDADSOCIAL T40 /* T40 = VARCHAR(40) */, //Número de la seguridad social
NUMERODOCUMENTO T40 /* T40 = VARCHAR(40) */, //Número de documento identificativo, Nif, Dni, pasaporte, etc
COMISIONDTO1 NUMERIC(15,2), //Descuento a aplicar en la comisión si se aplica el Dto 1
COMISIONDTORAPEL2 NUMERIC(15,2), //Descuento a aplicar en la comisión si se aplica el Dto o rapel 2
COMISIONDTORAPEL3 NUMERIC(15,2), //Descuento a aplicar en la comisión si se aplica el Dto o rapel 2
COMISIONDTORAPEL4 NUMERIC(15,2), //Descuento a aplicar en la comisión si se aplica el Dto o rapel 3
COMISIONDTORAPEL5 NUMERIC(15,2), //Descuento a aplicar en la comisión si se aplica el Dto o rapel 5
PUESTO T20 /* T20 = VARCHAR(20) */, //Puesto que ocupa dentro de la empresa
NOMBRE T80 /* T80 = VARCHAR(80) */, //Nombre de la persona
SALARIO NUMERIC(15,2)// //Sueldo de la persona (este campo sólo lo dejaremos ver a los empleados de mayor nivel
);

Como podéis ver se aplica un descuento en las comisiones según el rapel o descuento que aplicamos entre el 2 y el 5 (rapel), pero no en el 1 ya que es el precio base, este descuento de la comisión se aplica si el descuento dentro del producto es diferente de 0, ó si se ha aplicado el rapel.

Fabricables
CREATE TABLE FABRICABLES (
ID INTEGER NOT NULL,
CODIGO T20 /* T20 = VARCHAR(20) */, //Código del fabricable
PRODUCTO T80 /* T80 = VARCHAR(80) */ //Nombre base del producto a fabricar
);

Formas de pago

CREATE TABLE FPAGOS (
ID INTEGER NOT NULL,
CODIGO T20 /* T20 = VARCHAR(20) */, //Código de la forma de pago (este campo es único)
FORMAPAGO T40 /* T40 = VARCHAR(40) */, //Formas de pago a establecer
DIASPRESENTACION T20 /* T20 = VARCHAR(20) */, //Días de presentación
DIASCOBRO T20 /* T20 = VARCHAR(20) */, //Dias de cobros
NUMERODEPAGOS INTEGER// Si tiene pago aplazado el numero de plazos
);

Pagos plazos

CREATE TABLE PAGOSPLAZOS (
ID INTEGER NOT NULL,
CODIGOFORMADEPAGO T20 /* T20 = VARCHAR(20) */, //Código de forma de pago a la que esta unida
NUMERODEDIAS INTEGER, //Número de días desde la emisión de la factura, dejar en blanco si no se quiere especificar
PORCENTAJEPAGO NUMERIC(15,2) //Porcentaje del total de la factura a cobrar en este plazo
);

Bueno en primer lugar decir que estas son las primeras tabla que están enlazada ( FPAGOS es el maestro y PAGOSPLAZOS el detalle), después sobre la tabla PAGOSPLAZOS
deciros que mi modo de uso es el siguiente pongo dos ejemplos

1º) Cliente pago a 30(40%),60(30%),90(30%) días factura 1000, fecha 30/06/2013 y días de pago del 20 al 25, quedarían los pagos de la siguiente manera

25/07/2013..Importe 400.00 euros [Pago lógico 30/07/2013] (como podemos ver no llega a los 30 días, pero hemos cogido el dato de sus fechas de pago, en caso contrario se iría a casi dos meses)
25/08/2013..Importe 300.00 euros [Pago lógico 29/08/2013]
25/09/2013..Importe 300.00 euros [Pago lógico 28/09/2013]

2º) Cliente paga a 50% y 50%, factura de 1000 euros, fecha 30/06/2013 y días de pago del 20 al 25, lo pagos serían
25/ (mes a designar entre el cliente y la empresa)/2013..Importe 500.00 euros
25/ (mes a designar entre el cliente y la empresa)/2013..Importe 500.00 euros
Al no poner el número de días sólo tenemos en cuenta el día de pago y no el número de días a transcurrir para cada uno de los plazos.

La tabla Lotes

CREATE TABLE LOTES (
ID INTEGER NOT NULL,
CODIGOPRODUCTOFABRICABLE T20 /* T20 = VARCHAR(20) */, //Código del producto Fabricable
CODIGOEMPLEADO T20 /* T20 = VARCHAR(20) */, //Código del empleado responsable
FECHA DATE, //Fecha en que se fabrico
LOTE T20 /* T20 = VARCHAR(20) */, //Lote asignado
CADUCIDAD DATE, //Si es caduco su fecha de caducidad
CANTIDAD NUMERIC(15,2), //Cantidad total fabricada (litros, kilos unidades)
ACTIVO LOG /* LOG = CHAR(1) */ //Si el producto esta activo
);

Sobre el campo ACTIVO, lo usamos para saber si es un lote que se puede vender (S) o no se puede vender (N), por que sea para trasformación, o sea un lote retirado del mercado.

Aunque nadie me ha preguntado, si os dais cuenta, en mi tabla artículos, no he puesto campos para tallas, colores, tamaños o si esta dividido en partes, si lo necesitáis sabéis que son campos que tienen que usarse con tablas auxiliares. yo en esta demo no las voy a poner, pero no esta demás comentarlo.

José Luis Garcí
10-06-2013, 15:07:57
Módulo de productos fabricables

http://nsae01.casimages.net/img/2013/06/10/13061002382967611.jpg (http://www.casimages.es/i/13061002382967611.jpg.html)

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

José Luis Garcí
19-06-2013, 10:20:52
Cambios importantes en los módulos auxiliares (Notas, Imágenes, Direcciones, Bancos, Contactos, Personas de contacto)

1º) se ha añadido un IBQuerry y su datasource el ModuleData (UDM en mi caso), para facilitar los datos a todos los modulos que lo llaman,, eliminando parte del código de control en cada uno de estos, el aspecto actual de mi UDM es el siguiente

http://nsae01.casimages.net/img/2013/06/19/130619094234288683.jpg (http://www.casimages.es/i/130619094234288683.jpg.html)

Los cambios en su código son los siguientes:


procedure TDM.conectar;
//------------------------------------------------------------------------------
//**************************************************************[ Conectar ]****
//Nos permite conectar las tablas, querrys + IBDatabase + IBTransaction
//------------------------------------------------------------------------------
begin
IBDatabase1.Connected:=True; //La base de datos
IBTransaction1.Active:=True; //Las Tansacciones
IBDCLIEN.Active:=True; //La tabla Clientes
IBDirecciones.Active:=True; //La tabla Direcciones
IBDPC.Active:=True; //La tabla Personas de Contacto
IBDContacto.Active:=True; //La Tabla de datos de contacto
IBDBcos.Active:=True; //La tabla de Bancos
IBDCONFI.Active:=True; //La tabla de Configuración
IBDUSUA.Active:=True; //La tabla de usuarios (permisos de acceso)
IBDNOTAS.Active:=True; //La tabla de notas
IBDIMAGENES.Active:=True; //La tabla de Imagenes
IBDPROVEEDORES.Active:=True; //La tabla de Proveedores
IBDLOTES.Active:=True; //La tabla de Lotes
IBDARTICULOS.Active:=True; //La tabla de Artículos
IBDFAMILIAS.Active:=True; //La tabla de Familias
IBDFABRICABLES.Active:=True; //La tabla de Fabricables
IBDSTOCK.Active:=True; //La tabla de Stock
end;


procedure TDM.DataModuleDestroy(Sender: TObject);
//------------------------------------------------------------------------------
//*********************************************************[ Al destruirlo ]****
// Nos aseguramos de que no se nos queden Querys abiertos //Añadir el archivo Fun.Pas
//------------------------------------------------------------------------------
begin
QuerryOC(IBQIMAGENES);
QuerryOC(IBQNOTAS);
QuerryOC(IBQDirecciones);
QuerryOC(IBQPersonasContacto);
QuerryOC(IBQContactos);
QuerryOC(IBQBancos);
end;


2º) en el FormClose de cada módulo auxiliar ponemos el siguiente código




















//////////He editado nuevamente este post cambiando lo que había puesto por lo siguiente y explico lo que he eliminado///////////








//Cambiar donde aparece XXX por lo que proceda (Nombre del MODULO, de la Tabla, de el IBDataSet, del IBQuerry, del módulo de llamada o del SpeedButtonBC)

procedure TFNotas.FXXXClose(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;
ActIbdataset(DM.IBDXXX,'select * from XXX');
//Retornos al modulo de llamada
if VarSNomMod='XXX' then FArticulos.SpeedButtonBCXXXClick(sender);
end;

he eliminado el siguiente código


if DM.IBQXXX.Active then //Nos aseguramos de refrescar los datos del querry, con los nuevos introducidos si los ha habido
begin //No uso refresh, ya que muchas veces no funciona y de esta manera es más efectivo el refresco de datos
DM.IBQXXX.Active:=False;
DM.IBQXXX.Active:=True;
end;


, al ya esta controlado en la lineas


if VarSNomMod='XXX' then FArticulos.SpeedButtonBCXXXClick(sender);


Que no había actualizado, con lo que el código anterior era redundante.

José Luis Garcí
19-06-2013, 11:36:50
Ahora le toca al modulo de proveedores

LA imagen

http://nsae01.casimages.net/img/2013/06/19/130619104850966697.jpg (http://www.casimages.es/i/130619104850966697.jpg.html)

he marcado algún olvido y lo que hacen algunos botones, ahora las pestañas

0º) Es la de los datos, vemos que realmente en la tabla proveedores tenemos que introducir pocos datos, pero que el conjunto de datos con las auxiliares la completa bastante

1º) Contactos. Recordar que esta tabla sera luego nuestra agenda, permitiendo, separarlo, por Clientes, proveedores, etc, ademas de todos, buscar por el nombre/empresa/etc y ponderemos un indice que nos permitirá ver clasificado por su inicio.

2º) Notas, como podemos ver en este caso tenemos dos notas y las hemos clasificado (campo descripción) como avisos y recordatorio, pero podríamos tener muchos más solo para este proveedor, aquí es donde se ve la potencia de este modo de programar, que aunque un poco más lioso nos da mucha más potencia.

3º) Las Imágenes, Como podemos ver también hemos puesto 2 la del logo y productos.

4º) Personas de contactos, , al tenerla en una tabla auxiliar, nos permite tener multitud de personas de contacto dentro del mismo registro

5º) Direcciones, al igual que la anterior tabla podríamos tener multitud de direcciones (Almacenes, oficinas, tiendas, etc).

6º) Bancos, sería más correcto decir cuentas, pero un cliente/proveedor/etc, puede trabajar con más de un banco o más de una cuenta corriente.

7º) Aquí ira nuestro modulo de compras a este proveedor, que aún no desarrollaremos.


No voy a entrar en algo que ya se ha hablado ampliamente en los foros, sobre las notas y las imágenes si guardarlas dentro de las tablas o sólo guardar su referencia en la tabla y guardarla físicamente en archivos en el disco duro.

También quiero explicar que poner en las pestañas los campos nombre del módulo y código de las tablas auxiliares, es para que quede más claro en el tutorial, normalmente, serían campos no visibles.

y el código podéis bajarlo de https://gist.github.com/anonymous/5812746

José Luis Garcí
19-06-2013, 11:50:47
El módulo de Formas de pago

http://nsae01.casimages.net/img/2013/06/19/130619111304729305.jpg (http://www.casimages.es/i/130619111304729305.jpg.html)

En este módulo hay cosas que cambian, al tratarse de usar una tabla maestro y otra detalle, como podemos ver tenemos 2 panales con botonera y debemos controlar ambas y aunque en la imagen no se ve tenemos un sólo juego de botenes de confirmación y cancelación, para que quede más claro hay que estudiar el código

podemos ver que hemos hecho la relación maestro detalle en el módulo UDM

http://nsae01.casimages.net/img/2013/06/19/130619111844532018.jpg (http://www.casimages.es/i/130619111844532018.jpg.html)


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

José Luis Garcí
19-06-2013, 11:57:43
Y por último en el día de hoy el modulo de búsqueda.

http://nsae01.casimages.net/img/2013/06/19/130619112133206106.jpg (http://www.casimages.es/i/130619112133206106.jpg.html)

como podemos ver un módulo sencillo de tan sólo 160 lineas actualmente, que ira creciendo según avancemos el proyecto, sólo tendremos que añadir el control de los módulos de llamada y su retorno, ya que este módulo sera llamado por varios módulos.

No usamos la función de coloración del grid, ya que al ser este variable, en número de campos nos daría un error, más adelante lo modificare y añadiré el código, para que se ajuste al resto del diseño.

El código aquí https://gist.github.com/anonymous/5812974

Casimiro Notevi
19-06-2013, 12:11:51
Gran trabajo ^\||/

José Luis Garcí
19-06-2013, 12:23:58
Muchas gracias Casimiro, viniendo de ti un gran maestro, se agradece mucho más, ya que yo soy un burrito, comparado con el nivel que hay en el club, la suerte o desgracia que he tenido que en los últimos veinte y pico años, es que he trabajado en sectores, que me han permitido hacer sus programas, Cupones tipo la ONCE, Taller, Empresa de Limpieza, Jardinería y Control de Plagas y La Fabrica de productos de limpieza.

La verdad es que pienso muchas veces que el tema parece que no interesa mucho, pero luego miro el número de visitas y veo que no es así, no espero que me estén felicitando todo el día, pero creí que habría un poco de polémica en algunos temas, correcciones, diferencias de opinión, consejos (que los ha habido y se agradecen sinceramente) o maneras diferentes de tratar algunos temas.

Otras veces pienso que o no estoy siendo muy claro, o es demasiada información y no esta siendo procesada.

En Fin, seguiré mientras pueda con el tema.

Casimiro Notevi
19-06-2013, 12:52:42
Por supuesto que interesa el tema, precisamente la mayoría de programas para delphi son de gestión para empresas.
La mayoría de nosotros es eso lo que hemos hecho y seguimos haciendo.
Por cierto, si tú eres un burrito, entonces yo soy un escarabajo :D

fjcg02
19-06-2013, 13:02:16
Hola José Luis,
lo que ocurre es que lo estás poniendo tan clarito que apenas quedan dudas. Aparte de la aplicación, que ya es bastante, para mí es tan importante o más la parte de gestión que estás explicando y cómo la resuelves.

No se te ocurra parar...

Gracias y un saludo

José Luis Garcí
19-06-2013, 15:47:32
Por supuesto que interesa el tema, precisamente la mayoría de programas para delphi son de gestión para empresas.
La mayoría de nosotros es eso lo que hemos hecho y seguimos haciendo.
Por cierto, si tú eres un burrito, entonces yo soy un escarabajo :D

Si Casimiro, pero en todo caso eres un Escarabajo Golia (http://www.ecured.cu/index.php/Escarabajo_Goliat)

ahora fuera de bromas, mi nivel es bastante bajo comparado con el tuyo y el de otros muchos compañeros.

Casimiro Notevi
19-06-2013, 16:30:09
Si Casimiro, pero en todo caso eres un Escarabajo Golia (http://www.ecured.cu/index.php/Escarabajo_Goliat) jajaja... menos mal que no has dicho que soy un escarabajo pelotero :D

José Luis Garcí
19-06-2013, 16:47:45
Hola José Luis,
lo que ocurre es que lo estás poniendo tan clarito que apenas quedan dudas. Aparte de la aplicación, que ya es bastante, para mí es tan importante o más la parte de gestión que estás explicando y cómo la resuelves.

No se te ocurra parar...

Gracias y un saludo



Gracias Javier, espero tengas razón y no sea por todo lo contrario.

En cuanto a parar, el tiempo dirá, en principio mi idea es terminar todas las tablas iniciales, como mucho a principio del mes que viene, luego empieza lo duro, la parte de facturación, explicare sólo esta, ya que con pocos cambios se pasan a los otros formatos, de hecho es más un aspecto más básico o técnico, según el caso, me explico,

En el caso más básico, el 90% de los campos de presupuestos, pedidos, albaranes y facturas, son iguales, de hecho se podría hacer una tabla maestra única para los cuatro formatos y una detalle igualmente, con lo que según el tipo de documento ocuparíamos unos campo o los dejaríamos en blanco.

En la más técnica (de hecho la que prefiero), podemos usar una tabla para cada tipo de formulario y puede ser una única en detalle, como una por cada cada tipo de formato (documento)

Ventajas de la primera el ahorro de tiempo y en teoría de consumo de recursos, la velocidad en principio no debería verse afectada si usamos sentencias SQL y un buen mantenimiento de la tabla. En la segunda los datos son mejor estructurados al estar en tablas independientes, lleva más tiempo de programación y es mucho más facil el seguimiento.

En mi caso he trabajado en los dos sistemas y prefiero el segundo, aunque creo que el primero es igual de válido.

Para que se entienda un poco mejor pongo un ejemplo de los campos de las más básica:

Tabla maestra
ID Integer //PRimarikey y autonumerador
DOCUMENTO varchar 20 //Nombre del documento (factura, pedido,etc)
SERIE Varchar 3 //Serie a usar
NUMERO Varchar 10 //Aquí uso una función que sólo deja los números, con lo cual la puedo pasar a integer y sumar 1, así controlo el numerador del tipo de documento
FECHA Date //Fecha de la creación del documento
MODIFICACIONES Integer // (*)
CODIGOCLIENTE Varchar 20 //Código del cliente
CODIGOCOMERCIAL Varchar 20 //Código del comercial
TOTALSUBTOTAL numeric 15-4 //Subtotal del documento, así no tengo que estar haciendo consultas sql, en ciertos casos
TOTALDTO numeric 15-4 //Total descuentos del documento, así no tengo que estar haciendo consultas sql, en ciertos casos
TOTALIMPUESTOS numeric 15-4 //Total impuestos del documento, así no tengo que estar haciendo consultas sql, en ciertos casos
TOTALCOMISIONES numeric 15-4 //Total comisiones del documento, así no tengo que estar haciendo consultas sql, en ciertos casos
PESO numeric 15-4 //Total del peso perteneciente a la factura (recuerdo que se quiere implantar obligatoriamente por la CE), que junto con la hoja de ruta (suma todos los documentos) nos dara el peso de mercancía que transportamos
NUMEROARTICULOS integer //Cantidad de unidades y no cajas transportadas
FORMAPAGO Varchar 20 //Código de la forma de pago
NUMEROALBARAN Varchar 20 // Serie más numerador si viene de un albarán (en Facturas)
NUMEROPEDIDO Varchar 20 //Serie más numerador si viene de un Pedido (en Albaranes)
NUMEROPRESUPUESTO Varchar 20 ////Serie más numerador si viene de un presupuesto (en pedidos)
COBRADA logico SN//LA factura ya ha sido cobrada va junto con la tabla cobros, donde especificamos como se cobro y el número de documento (talón, pagaré, etc) si existe
COMISIONESPAGADAS logico SN// ''Si la comisión ha sido pagada va junto con la tabla pagocomisiones, donde especificamos fecha, forma del pago, código del comercial y número de documento de pago
LIBRE Varchar 255 //(1)


* - Esto me lo pidió mi jefe hace más de 15 años y es algo que hago desde estoces, la primera vez que grabo la guardo con un 0 y añado +1 cada vez que se vuelve a grabar, a la vez grabo en una tabla de seguimiento, el usuario, la fecha, la hora y los cambios realizados, esta última tabla se borraban los datos con más de tres meses.Me pareció interesante y desde entonces lo mantengo

(1) - Aquí podemos grabar desde observaciones a pequeñas notas, la uso con una función y empieza siempre con [xxx]Donde xxx será el texto que aparece como descripción y después del corchete de cierre, el resto del texto


Esto lo pongo sólo para que entiendan la idea +-.

José Luis Garcí
19-06-2013, 16:49:11
jajaja... menos mal que no has dicho que soy un escarabajo pelotero :D

No hombre, para pelotero yo que en sus buenos días, llegue a pesar más de 150 kg.

Casimiro Notevi
19-06-2013, 17:27:11
No hombre, para pelotero yo que en sus buenos días, llegue a pesar más de 150 kg.
La vida del programador es muy dura, tantas horas sentado :confused:

José Luis Garcí
19-06-2013, 18:00:21
no sólo eso Casimiro, como se diría en Castellano antiguo "el buen manjar"

Casimiro Notevi
19-06-2013, 19:06:38
no sólo eso Casimiro, como se diría en Castellano antiguo "el buen manjar"
Es que es difícil resistirse a esa gastronomía canaria :rolleyes:

José Luis Garcí
19-06-2013, 21:17:15
De la época que te hablo, era de las islas , parte de la España, Madrid, Sevilla, Hueva, Málaga, Valencia, Elche, Murcia, Barcelona, Vigo y algo de Portugal, me pegue 7 años, que de 365 días al año, me pegaba 200-260 de viaje, llegue a ir a tres oficinas en el mismo día, Las Palmas, Fuerteventura y Lanzarote, comía fijo en bares y restaurantes, así que te puedes imaginar.

Y si pensáis que guay, de eso nada, mis horarios eran , salir temprano al aeropuerto, llegar al destino, alquilar coche o coger transporte, comer ir a la oficina, cerrábamos a a las 9 en la Península 8 en Canarias, ir al hotel y muy probablemente volver a salir temprano, para ir al aeropuerto y destino a casa o a otra provincia y repetir, si era a casa, era a la oficina y no a mi casa directamente, así que pararme a disfrutar no, no lo pude hacer.

Casimiro Notevi
19-06-2013, 22:26:47
Entonces lo que tenías era un descontrol total con las comidas, así es normal que se engorde, hay que tener cuidado y controlarse :)

Caren
20-06-2013, 03:34:09
Como esta al principio no cuesta hecharle un ojo, ademas como trabaja este señorazo.
Mi consulta es para el que ha hecho o esta haciendo este programa si tal cual esta funciona a pesar de que falten algunas cosas como el tema de facturacion y los componentes que se necesitan si siguen estando para bajar y con que nombre, encontre NewPAnelDb, SpeedButtonBC, GroupBoxJL pero no veo los DbComboBoxExt, DBIBCheckbox, DBIBMemo supongo que estaran con algun otro nombre.
Quiero dar las gracias a todos los que sabeis por poner vuestros trabajos para los que no tenemos ni idea vayamos aprendiendo un poquito.

beginner01
20-06-2013, 06:14:37
Muchas gracias Casimiro, viniendo de ti un gran maestro, se agradece mucho más, ya que yo soy un burrito, comparado con el nivel que hay en el club, la suerte o desgracia que he tenido que en los últimos veinte y pico años, es que he trabajado en sectores, que me han permitido hacer sus programas, Cupones tipo la ONCE, Taller, Empresa de Limpieza, Jardinería y Control de Plagas y La Fabrica de productos de limpieza.

La verdad es que pienso muchas veces que el tema parece que no interesa mucho, pero luego miro el número de visitas y veo que no es así, no espero que me estén felicitando todo el día, pero creí que habría un poco de polémica en algunos temas, correcciones, diferencias de opinión, consejos (que los ha habido y se agradecen sinceramente) o maneras diferentes de tratar algunos temas.

Otras veces pienso que o no estoy siendo muy claro, o es demasiada información y no esta siendo procesada.

En Fin, seguiré mientras pueda con el tema.

Pues la verdad es que sí interesa mucho el tema, esta bien y bien explicado y yo soy participe de que no hayan muchos comentarios
que no sean para mostrar algún error o aclarar algo para que no se salga del tema al menos hasta que hayas dado como completado el programa.

Es un gran aporte el que haces.

José Luis Garcí
20-06-2013, 10:22:14
Los componentes

NewPAnelDb se encuentran en http://terawiki.clubdelphi.com/Delphi/Componentes-Funciones/ con el nombre NewPanelDB.zip, también su código completo en http://www.clubdelphi.com/foros/showthread.php?t=72219&highlight=NewPAnelDb

SpeedButtonBC se encuentran en http://terawiki.clubdelphi.com/Delphi/Componentes-Funciones/ con el nombre SpeedbutonColor_y_Demo.rar, también su código completo en http://www.clubdelphi.com/foros/showthread.php?t=76437&highlight=Speedbutton

los DbComboBoxExt, DBIBCheckbox, DBIBMemo,GroupBoxJL se encuentran en http://terawiki.clubdelphi.com/Delphi/Componentes-Funciones/ con el nombre PACKJL.zip expuesto en el link http://www.clubdelphi.com/foros/showthread.php?t=83132&highlight=Speedbutton

Los TDBNewEditJL y TMyNewEditJL http://www.clubdelphi.com/foros/showthread.php?t=83280


Enlaces que pueden interesar

http://www.clubdelphi.com/foros/showthread.php?t=79416 para las copias de seguridad
http://www.clubdelphi.com/foros/showthread.php?t=83170 Módulos (ABM) Altas _Bajas y Modificaciones
http://www.delphiaccess.com/forum/firebird-4/como-usar-el-componente-ibupdatesql/msg35287/#msg35287 Sobre los IBDataSet
http://www.clubdelphi.com/foros/showthread.php?t=78207 Niveles de usuario
http://www.clubdelphi.com/foros/showthread.php?t=72450 Para crear modulos (ABM)
http://www.clubdelphi.com/foros/showthread.php?t=72563 Alguno de los temas tratados en el tutorial
http://www.clubdelphi.com/foros/showthread.php?t=69111 Iconos
http://www.clubdelphi.com/foros/showthread.php?t=68120 Todo el programa en una barra, interesante y lo he usado en algún programita pequeño
http://www.clubdelphi.com/foros/showthread.php?t=74475 Rutinas de programación
http://www.clubdelphi.com/foros/showthread.php?t=73826 Para los Hint de los programas
http://www.clubdelphi.com/foros/showthread.php?t=68708&highlight=firebird+tutorial Tutorial de Caral para empezar con Firebird
http://webs.satlink.com/usuarios/c/cybermac/bajarDelphi.htm Curso muy completo de Delphi

Y seguro encontraras muchísimos más

José Luis Garcí
20-06-2013, 10:27:47
Como esta al principio no cuesta hecharle un ojo, ademas como trabaja este señorazo.
Mi consulta es para el que ha hecho o esta haciendo este programa si tal cual esta funciona a pesar de que falten algunas cosas como el tema de facturacion y los componentes que se necesitan si siguen estando para bajar y con que nombre, encontre NewPAnelDb, SpeedButtonBC, GroupBoxJL pero no veo los DbComboBoxExt, DBIBCheckbox, DBIBMemo supongo que estaran con algun otro nombre.
Quiero dar las gracias a todos los que sabeis por poner vuestros trabajos para los que no tenemos ni idea vayamos aprendiendo un poquito.

Hola Caren, a que te refieres con lo de este señorazo al programa o ami, por que si es ami prefiero que me digas el señoritooo :D:D:D:D:D

José Luis Garcí
20-06-2013, 10:28:47
Caren a abierto un nuevo hilo (http://www.clubdelphi.com/foros/showthread.php?p=462510&posted=1#post462510) sobre el tema de los componentes usados en el programa, al que ya le he respondido, pero creo que lo más correcto, para los compañeros que le generen nuevas dudas, aquí pongo su consulta y mi respuesta

Como esta al principio no cuesta hecharle un ojo, ademas como trabaja este señorazo.
Mi consulta es para el que ha hecho o esta haciendo este programa si tal cual esta funciona a pesar de que falten algunas cosas como el tema de facturacion y los componentes que se necesitan si siguen estando para bajar y con que nombre, encontre NewPAnelDb, SpeedButtonBC, GroupBoxJL pero no veo los DbComboBoxExt, DBIBCheckbox, DBIBMemo supongo que estaran con algun otro nombre.
Quiero dar las gracias a todos los que sabeis por poner vuestros trabajos para los que no tenemos ni idea vayamos aprendiendo un poquito.

Los componentes

NewPAnelDb se encuentran en http://terawiki.clubdelphi.com/Delphi/Componentes-Funciones/ con el nombre NewPanelDB.zip, también su código completo en http://www.clubdelphi.com/foros/showthread.php?t=72219&highlight=NewPAnelDb

SpeedButtonBC se encuentran en http://terawiki.clubdelphi.com/Delphi/Componentes-Funciones/ con el nombre SpeedbutonColor_y_Demo.rar, también su código completo en http://www.clubdelphi.com/foros/showthread.php?t=76437&highlight=Speedbutton

los DbComboBoxExt, DBIBCheckbox, DBIBMemo,GroupBoxJL se encuentran en http://terawiki.clubdelphi.com/Delphi/Componentes-Funciones/ con el nombre PACKJL.zip expuesto en el link http://www.clubdelphi.com/foros/showthread.php?t=83132&highlight=Speedbutton

Los TDBNewEditJL y TMyNewEditJL http://www.clubdelphi.com/foros/showthread.php?t=83280


Enlaces que pueden interesar

http://www.clubdelphi.com/foros/showthread.php?t=79416 para las copias de seguridad
http://www.clubdelphi.com/foros/showthread.php?t=83170 Módulos (ABM) Altas _Bajas y Modificaciones
http://www.delphiaccess.com/forum/firebird-4/como-usar-el-componente-ibupdatesql/msg35287/#msg35287 Sobre los IBDataSet
http://www.clubdelphi.com/foros/showthread.php?t=78207 Niveles de usuario
http://www.clubdelphi.com/foros/showthread.php?t=72450 Para crear modulos (ABM)
http://www.clubdelphi.com/foros/showthread.php?t=72563 Alguno de los temas tratados en el tutorial
http://www.clubdelphi.com/foros/showthread.php?t=69111 Iconos
http://www.clubdelphi.com/foros/showthread.php?t=68120 Todo el programa en una barra, interesante y lo he usado en algún programita pequeño
http://www.clubdelphi.com/foros/showthread.php?t=74475 Rutinas de programación
http://www.clubdelphi.com/foros/showthread.php?t=73826 Para los Hint de los programas
http://www.clubdelphi.com/foros/showthread.php?t=68708&highlight=firebird+tutorial Tutorial de Caral para empezar con Firebird
http://webs.satlink.com/usuarios/c/cybermac/bajarDelphi.htm Curso muy completo de Delphi

Y seguro encontraras muchísimos más


Y recordar que todo lo que estoy usando en el tutorial es libre, exceptuando el Delphi claro.

Casimiro Notevi
20-06-2013, 11:30:47
Mi consulta es para el que ha hecho o esta haciendo este programa
He unido el hilo al tema principal, para que todo esté junto, así no nos perdemos ;)

Caren
20-06-2013, 15:51:30
Jose Luis espero no haberte molestado con señorazo, esperaba ser un gran halago tanto por ti como por todo lo que haces y colaboras en los foros.
Muchas gracias.

José Luis Garcí
20-06-2013, 20:03:35
Tranquilo me lo tome a coña y gracias a ti. Espero te sirvan los enlaces puestos

José Luis Garcí
21-06-2013, 15:33:51
Modificaciones en el módulo UPC,

http://nsae01.casimages.net/img/2013/06/21/130621025002610711.jpg (http://www.casimages.es/i/130621025002610711.jpg.html)

Como podéis ver hemos puesto un nuevo botón sobre un nuevo NewPanelDb, el datasource=DsPrincipal y el InverseAction=true. Este botón lo que hace es crear un nuevo registro con los datos de la Persona de contacto activa en ese momento, creando así el nuevo registro de manera automatizada.


El código añadido



procedure TFPC.FormActivate(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************[ Cuando se activa El form ]******
// Lo que queremos que haga nuestro Form Cuando se Actiba
//------------------------------------------------------------------------------
begin
. . .
//Se ha añadido las siguientes lineas
PanelAux.ColorNotActive:=COLORPANELACT;
PanelAux.ActiveColor:=COLORPANELNOACT;
end;

procedure TFPC.SpeedButtonBC4Click(Sender: TObject);
//------------------------------------------------------------------------------
//****************************************************[ Añadir a contactos ]****
// añadir al uses UContactos (Importante, para que funcione)
//------------------------------------------------------------------------------
begin
try //Cremoas en contactos uno con los mismos datos que persona de contacto
DSContactos.DataSet.Insert;
DSContactos.DataSet.FieldByName('MODULO').Value:=DsPrincipal.DataSet.FieldByName('MODULO').value;
DSContactos.DataSet.FieldByName('CODIGO').Value:=DsPrincipal.DataSet.FieldByName('CODIGO').value;
DSContactos.DataSet.FieldByName('NOMBRE').Value:=DsPrincipal.DataSet.FieldByName('NOMBRE').value;
DSContactos.DataSet.FieldByName('MOVIL').Value:=DsPrincipal.DataSet.FieldByName('MOVIL').value;
DSContactos.DataSet.FieldByName('MAIL').Value:=DsPrincipal.DataSet.FieldByName('EMAIL').value;
DSContactos.DataSet.Post;
IBT.CommitRetaining; //Donde IBT es el nombre de su Ibtrasaction, con ruta
ShowMessage('Se ha creado un nuevo contacto con los datos de la persona de contacto actual');
except
on E: Exception do
begin
MessageBeep(1000);
ShowMessage('Se ha producido un error y el proceso no se ha podido terminar Unidad:[ UPC ] Modulo:[ Grabar nuevo contacto]' + Chr(13) + Chr(13)
+ 'Clase de error: ' + E.ClassName + Chr(13) + Chr(13)
+ 'Mensaje del error:' + E.Message+Chr(13) + Chr(13)
+ ' '+Chr(13) + Chr(13)
+ 'El proceso ha quedado interrumpido');
if DSContactos.DataSet.State in [dsEdit, dsInsert] then DSPrincipal.DataSet.Cancel;
IBT.RollbackRetaining; //Donde IBT es el nombre de su Ibtrasaction, con ruta
end;
end;
end;


También se detecto un error en el código de proveedores, os pongo el procedure con la corrección

procedure TFProveedor.CambiarPagina(index: Integer; Sender: TObject);
//------------------------------------------------------------------------------
//********************************************************[ Cambiar Página ]****
// Al pulsar los botones para acceder a las pestañas
//------------------------------------------------------------------------------
var VarBActivar:Boolean;
VarISegundoPageControlIndex:Integer;
VarSModulo, VarSCodigo:string;
begin
. . .

case Tipo of

. . .

4:begin //personas de contacto

// Cambiar la linea ActQuery(DM.IBQContactos,'SELECT * FROM CONTACTOS WHERE (CONTACTOS.MODULO = '+QuotedStr(VarSModulo)+') AND (CONTACTOS.CODIGO = '+QuotedStr(VarSCodigo)+')');
// Por

ActQuery(DM.IBQPersonasContacto,'SELECT * FROM PC WHERE (PC.MODULO = '+QuotedStr(VarSModulo)+') AND (PC.CODIGO = '+QuotedStr(VarSCodigo)+')');
if not DM.IBQPersonasContacto.IsEmpty then
begin
DBNavigator1.DataSource:=DM.DSIBQPersonasContacto;
end else DM.IBQPersonasContacto.Active:=False;
VarISegundoPageControlIndex:=1;
end;

. . .

end;
end;

José Luis Garcí
21-06-2013, 15:48:35
Módulo empleados

http://nsae01.casimages.net/img/2013/06/21/130621031005515513.jpg (http://www.casimages.es/i/130621031005515513.jpg.html)

No seguiré comentando sobre las pestañas ya tratadas en post anteriores ya que son lo mismo

Mejoras que hacer en los otros módulos incorporadas a este, al Dsprincipal en su evento DSPrincipalDataChange, se ha añadido, para que las tablas auxiliares cambien cuando cambiamos de datos, siempre y cuando no este en edición o inserción.

Hay cosa nuevas como el modulo de registros de histórico y poco más.

como siempre el código completo en https://gist.github.com/anonymous/5831048

José Luis Garcí
22-06-2013, 09:51:31
Bien comenzaba con la gestión de lotes cuando me di cuenta de que me faltaba un campo en su tabla

Como estaba era de la siguiente manera


CREATE TABLE LOTES (
ID INTEGER NOT NULL,
CODIGOPRODUCTOFABRICABLE T20 /* T20 = VARCHAR(20) */, //Código del producto Fabricable
CODIGOEMPLEADO T20 /* T20 = VARCHAR(20) */, //Código del empleado responsable
FECHA DATE, //Fecha en que se fabrico
LOTE T20 /* T20 = VARCHAR(20) */, //Lote asignado
CADUCIDAD DATE, //Si es caduco su fecha de caducidad
CANTIDAD NUMERIC(15,2), //Cantidad total fabricada (litros, kilos unidades)
ACTIVO LOG /* LOG = CHAR(1) */ //Si el producto esta activo
);



La tabla completa queda así


CREATE TABLE LOTES (
ID INTEGER NOT NULL,
CODIGOPRODUCTOFABRICABLE T20 /* T20 = VARCHAR(20) */, //Código del producto Fabricable
CODIGOEMPLEADO T20 /* T20 = VARCHAR(20) */, //Código del empleado responsable
FECHA DATE, //Fecha en que se fabrico
LOTE T20 /* T20 = VARCHAR(20) */, //Lote asignado
CADUCIDAD DATE, //Si es caduco su fecha de caducidad
CANTIDAD NUMERIC(15,2), //Cantidad total fabricada (litros, kilos unidades)
ACTIVO LOG /* LOG = CHAR(1), */ //Si el producto esta activo
MAESTRO T20 /* T20 = VARCHAR(20) //Si viene de un lote maestro
);

Por cierto el Campo Cantidad no tiene nada que ver con el Stock, sólo dejarlo claro.

José Luis Garcí
22-06-2013, 11:23:46
Vamos con dos tablas auxiliares importantes

CREATE TABLE STOCK (
ID INTEGER NOT NULL,
CODIGOPRODUCTO T20 /* T20 = VARCHAR(20) */, //Código del producto
LOTE T20 /* T20 = VARCHAR(20) */, //Lote del producto
CANTIDADDEENTRADA INTEGER, //Cantidad de entrada, aquí se ira sumando según las entradas (1)
EXISTENCIAS INTEGER, //Las Existencias que quedan (2)
FECHAENTRADA DATE, //Fecha de la primera entrada , aunque luego sigan entrado más cantidades
CADUCIDAD DATE, //Fecha en la que se caduca el producto(3)
ACTIVO LOG /* LOG = CHAR(1) */ (4)
);


Es de suma importancia saber que en este caso el stock lo hacemos por Lote, con lo que saber el total de existencias reales, seria la suma de de todos los lotes que estén en activo y cuya EXISTENCIAS sean mayor o igual a 1, quiero decir que las existencias del 16-5 es todas las que estén en la tabla Stock con los siguientes datos

CODIGOPRODUCTO='16-5', ACTIVO='S' y EXISTENCIAS>=1

lo que nos puede dar varios registros.


(1) En ciertos tipos de fabricación, las mercancías no se sacan todas a la vez, por eso este campo, lo que hace es incrementar, según hagamos entradas

(2) Aquí debemos tener mucho ojo, es las Existencias (el verdadero Stock), debe indicarnos en todo momento la cantidad real de artículos que quedan , es importante esta cantidad normalmente disminuye, pero hay que tener en cuenta que si hemos echo un documento (albarán, Factura, Etc) que afecta al stock, debemos controlar sus modificamos
veamos diferentes ejemplos pongamos que inicialmente sacamos 10 vajillas

Primero tener en cuenta que si las existencias llegan a 0 debemos marcar como no activo (4)

Caso 1º Salida de 10 vajillas 5L código del producto 16-5 Lote 130001 Seria CODIGOPRODUCTO='16-5', LOTE=130001, EXISTENCIAS=EXISTENCIAS-10

Caso 2º Salida de 10 vajillas 5L código del producto 16-5 Lote 130001(6) y 130002(4) ya que del primer lote nos quedan solo 6, los cambios en la tabla stock serían

CODIGOPRODUCTO='16-5', LOTE=130001, EXISTENCIAS=EXISTENCIAS-6, ACTIVO='N'

Y

CODIGOPRODUCTO='16-5', LOTE=130002, EXISTENCIAS=EXISTENCIAS-4

Caso 3º Sobre el que teníamos con salida de 10 vajillas 5L código del producto 16-5 Lote 130001 lo modificamos y en vez de 10, subimos a 12 los cambios serían


CODIGOPRODUCTO='16-5', LOTE=130001, EXISTENCIAS=EXISTENCIAS-2 (ya que habíamos descontado anteriormente 10 por ello debemos controlar al editar la cantidad anterior siendo el cálculo resultante el siguiente CantiadaADescontar:=CantidadActual-CantidadAnterior; )

Caso 4º Sobre el que teníamos con salida de 10 vajillas 5L código del producto 16-5 Lote 130001 lo modificamos y en vez de 10, Bajamos a 8 los cambios serían

CODIGOPRODUCTO='16-5', LOTE=130001, EXISTENCIAS=EXISTENCIAS+2 (ya que habíamos descontado anteriormente 10 por ello debemos controlar al editar la cantidad anterior siendo el cálculo resultante el siguiente CantiadaADescontar:=CantidadActual-CantidadAnterior; en este caso cantidad actual sería mayor con los que nos daría -2 de resultado al ser el resultado negativo entonces sumamo)

Caso 5º Sobre el que teníamos con salida de 10 vajillas 5L código del producto 16-5 Lote 130001 lo modificamos Cambiamos el Lote por 130004 los cambios serían

CODIGOPRODUCTO='16-5', LOTE=130001, EXISTENCIAS=EXISTENCIAS+10
CODIGOPRODUCTO='16-5', LOTE=130004, EXISTENCIAS=EXISTENCIAS-10

Caso 6º Eliminamos el que teníamos con salida de 10 vajillas 5L código del producto 16-5 Lote 130001 lo cambios serían

CODIGOPRODUCTO='16-5', LOTE=130001, EXISTENCIAS=EXISTENCIAS+10
-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

Si existiesen varios lotes debemos tener Stringrid, dividiendo los lotes con sus cantidades y un edit por Row, para poder poner la nueva cantidad, su estructura seria más o menos como sigue

Lote, Fecha, Caducidad, Existencias, Activo (en caso de que sea 'N' no nos permitirá números positivos, pero si recuperar, si este fuese el caso debemos añadir a existencias y cambiar ACTIVO de 'N' a 'S')

(3) Si el producto es caduco aquí ira su Fecha de caducidad, como un lote sólo puede tener una única fecha de producción, sólo habrá una fecha de caducidad y repito a un número de lote asignado, es una única fabricación.

(4) El Campo ACTIVO tendrá los valores S o N y es de vital importancia, por defecto cuando damos una entrada, si no existe en la tabla STOCK, lo creamos con ACTIVO='S', salvo que indicamos lo contrario, el motivo para esta r en 'N' son los siguientes, que en la mayoría de los casos no tiene que ver con las Existencias

1º) Existencias a 0, en este caso no es lógico que cada vez que entramos en el artículo, o en uno de los documentos de venta siguiera apareciendo si no hay artículo de donde extraer.
2º) Un lote a retirar, podríamos detectar un problema en un lote y tener que retirarlo, para evitar que siga habiendo salidas, lo marcamos como no activo
3º) Es un producto de uso interno y por lo tanto no se vende, tato para uso del personal, como creado para usar en la fabricación/uso de otros productos

Siento el coñazo, pero es muy importante que este tema quede bien claro, para no tener problemas de trazabilidad y existencias reales. Si queda alguna duda, prefiero dedicarle más tiempo y aclararlo ahora que más adelante cuando el programa este más avanzado.

Espero no haberme dejado alguno de los casos posibles, si es así, por favor comunicármelo.

José Luis Garcí
22-06-2013, 11:30:10
La otra tabla

CREATE TABLE ENTRADAS (
ID INTEGER NOT NULL,
CODIGOPRODUCTO T20 /* T20 = VARCHAR(20) */, //Código del producto
LOTE T20 /* T20 = VARCHAR(20) */, //Lote asignado
FECHA DATE, //Fecha de la entrada y no del lote
CADUCIDAD DATE, //Fecha de la caducidad, esta si la recogemos de la tabla LOTES
CANTIDAD INTEGER, //Cantidad
CODIGOOPERARIO T20 /* T20 = VARCHAR(20) */ //Código del empleado
);;

Como podemos una tabla sencilla, que nos permite tener un buen control de las diferentes entradas.

José Luis Garcí
22-06-2013, 11:34:16
Se me olvidaba, por supuesto es importante que si el producto es caduco quiero decir con esto que tiene fecha de caducidad y no esta en blanco, debe controlar que la fecha actual es menor que la de la caducidad y como no si el caso es que la fecha es mayor que la de la caducidad debemos poner ACTIVO='N'

José Luis Garcí
22-06-2013, 14:38:02
Como estaba harto de que este componente me diese problemas con el tema de la negrita, lo he vuelto a modificar y aquí lo dejo ya corregido

{ ****************************************************************** }
{ }
{ VCL component TDBIBCheckbox }
{ }
{ Dbcheckbox para Firebird permitiendo Cambiae El Value según Check }
{ }
{ Code generated by Component Create for Delphi }
{ }
{ Generated from untitled component definition }
{ on 23 March 2012 at 15:59 }
{ }
{ Copyright © 2012 by J.L.G.T. }
{ }
{ ****************************************************************** }

unit TDbIbchkbox;

interface

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

type
TDBIBCheckbox = class(TCheckBox)
private
{ Private fields of TDBIBCheckbox }
FUpperCaseChk : Boolean;
FBoldCheck: Boolean;
FValueChecked : String;
FValueUnChecked : String;
{ Pointer to application's OnChange handler, if any }
FOnChange : TNotifyEvent;
FDataLink : TFieldDataLink;
FBoldfixed: Boolean;
{ Private methods of TDBIBCheckbox }
{ Method to set variable and property values and create objects }
procedure AutoInitialize;
{ Method to free any objects created by AutoInitialize }
procedure AutoDestroy;
function GetDataField : String;
procedure SetDataField(Value : String);
function GetDataSource : TDataSource;
procedure SetDataSource(Value : TDataSource);
procedure SetUppercaseChk(value:Boolean);
function GetUpperCaseChk : Boolean;
procedure SetValueChecked(value:string);
procedure SetValueUnChecked(value:string);
procedure ActiveChange(Sender : TObject);
procedure DataChange(Sender : TObject);
procedure EditingChange(Sender : TObject);
procedure UpdateData(Sender : TObject);
procedure SetBoldCheck(Value:Boolean);
procedure SetBoldfixed(Value:Boolean); //Permite que sea fija o no la negrita
protected
{ Protected fields of TDBIBCheckbox }

{ Protected methods of TDBIBCheckbox }
{ Method to generate OnChange event }
procedure Change(Sender : TObject); virtual;
procedure Click; override;
procedure KeyPress(var Key : Char); override;
procedure Loaded; override;

public
{ Public fields and properties of TDBIBCheckbox }
{ Public methods of TDBIBCheckbox }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;

published
{ Published properties of TDBIBCheckbox }
{ Cuando Cambia el Checked }
property OnChange : TNotifyEvent read FOnChange write FOnChange;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
{ Campo de la base de datos }
property DataField : String read GetDataField write SetDataField;
{ Datasource unido a la base de datos }
property DataSource : TDataSource read GetDataSource write SetDataSource;
{ Asegura que Se grave en mayusculas }
property UpperCaseChk : Boolean read GetUpperCaseChk write SetUppercaseChk default True;
{ Valor de cuando Esta Checked=true }
property ValueChecked : String read FValueChecked write SetValueChecked;
{ Valor de cuando no esta Checked (Checked=False) }
property ValueUnChecked : String read FValueUnChecked write SetValueUnChecked;
property BoldCheck:Boolean read FBoldCheck write SetBoldCheck default True;
property Boldfixed:Boolean read FBoldfixed write SetBoldfixed default True;

Procedure DBICHKNOT;
end;

procedure Register;

implementation


Function GetTipoCampo (DataSet :TDataSet; Index :Integer) :String;
Begin
Result := GetEnumName (TypeInfo (TFieldType),
Integer (DataSet.Fields [Index].DataType));
End;

procedure Register;
begin
RegisterComponents('InterBase', [TDBIBCheckbox]);
end;

{ Method to set variable and property values and create objects }
procedure TDBIBCheckbox.AutoInitialize;
begin
FDataLink := TFieldDataLink.Create;
FBoldCheck:=True;
FUpperCaseChk:=True;
FBoldfixed:=True;
with FDataLink do
begin
{ Assign handlers }
OnDataChange := DataChange;
OnUpdateData := UpdateData;
OnEditingChange := EditingChange;
OnActiveChange := ActiveChange;
end;
end; { of AutoInitialize }

{ Method to free any objects created by AutoInitialize }
procedure TDBIBCheckbox.AutoDestroy;
begin
FDataLink.Free;
end; { of AutoDestroy }

function TDBIBCheckbox.GetDataField : String;
begin { Return the FDataLink.FieldName property }
Result := FDataLink.FieldName;
end;

procedure TDBIBCheckbox.SetDataField(Value : String);
begin { Set the FDataLink.FieldName property }
FDataLink.FieldName := Value;
end;

function TDBIBCheckbox.GetDataSource : TDataSource;
begin { Return the FDataLink.DataSource property }
Result := FDataLink.DataSource;
end;

procedure TDBIBCheckbox.SetDataSource(Value : TDataSource);
begin { Set the FDataLink.DataSource property }
FDataLink.DataSource := Value;
end;

function TDBIBCheckbox.GetUpperCasechk : Boolean;
begin
Result := FUpperCaseChk;
end;

{ Method to generate OnChange event }
procedure TDBIBCheckbox.Change(Sender : TObject);
begin
if Assigned(FOnChange) then FOnChange(Sender);
end;

{ Override OnClick handler from TCheckBox }
procedure TDBIBCheckbox.Click;
begin { Call method of parent class }
if FDataLink.Editing then //Comprueba si se esta editando el registro
begin
FDataLink.Modified;
if fDataLink.field <> nil then
begin
if (Checked) then
begin
if FUpperCaseChk then fDataLink.field.Value := UPperCase(FValueChecked)
else fDataLink.field.Value := FValueChecked;
if (FBoldCheck) then
begin
if (fBoldfixed=False) then Self.Font.Style:=[fsBold]
else Self.Font.Style:=[];
end;
end else
begin
if FUpperCaseChk=False then fDataLink.field.Value := UpperCase(FValueChecked)
else fDataLink.field.Value := FValueUnChecked;
end;
end;
inherited Click;
// end;
end;
end;

{ Override OnKeyPress handler from TCheckBox }
procedure TDBIBCheckbox.KeyPress(var Key : Char);
begin { Call method of parent class }
inherited KeyPress(Key);
end;

constructor TDBIBCheckbox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
AutoInitialize;
FUpperCaseChk:=True;
FValueChecked:='SI';
FValueUnChecked:='NO';
{ Code to perform other tasks when the component is created }
end;

procedure TDBIBCheckbox.DataChange(Sender : TObject);
begin
if fDataLink.field <> nil then
begin
if FUpperCaseChk then
begin
if UpperCase(FDataLink.Field.AsString)=UpperCase(FValueChecked) then Checked:=true
else Checked:=False;
end else
begin
if FDataLink.Field.Value=FValueChecked then Checked:=true
else Checked:=False;
end;
if (Checked) then
begin
if (FBoldCheck) then
begin
if (fBoldfixed=False) then Self.Font.Style:=[fsBold]
else Self.Font.Style:=[];
end;
end;
if Assigned(FOnChange) then FOnChange(Sender);
end;
end;

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

procedure TDBIBCheckbox.EditingChange(Sender : TObject);
begin
//
end;

procedure TDBIBCheckbox.Loaded;
begin
inherited Loaded;
end;

procedure TDBIBCheckbox.ActiveChange(Sender : TObject);
const
IntFieldTypes = [ftSmallInt, ftInteger, ftWord];
begin
if DataField = '' then Exit;
end;

procedure TDBIBCheckbox.UpdateData(Sender : TObject);
begin
if fDataLink.field <> nil then
begin
if (Checked) then
begin
if FUpperCaseChk then fDataLink.field.Value := UPperCase(FValueChecked)
else fDataLink.field.Value := FValueChecked;
if (FBoldCheck) then
begin
if (fBoldfixed=False) then Self.Font.Style:=[fsBold]
else Self.Font.Style:=[];
end;
end else
begin
if FUpperCaseChk=False then fDataLink.field.Value := UpperCase(FValueChecked)
else fDataLink.field.Value := FValueUnChecked;
end;
end;
end;

procedure TDBIBCheckbox.SetUppercaseChk(value: Boolean);
begin
if value<>FUpperCaseChk then FUpperCaseChk:=value;
end;

procedure TDBIBCheckbox.SetValueChecked(value: string);
begin
if value<>FValueChecked then
begin
if FDataLink.Field<>nil then
begin
if Length(value)>FDataLink.Field.Size then ShowMessage('El ValueCheck [ '+Value+' ] contiene más caracteres de los '+#13+#10+
'permitidos, que es de [ '+IntToStr(FDataLink.Field.Size)+' ] caracteres')
else FValueChecked:=value;
end else FValueChecked:=value;
end;
end;
procedure TDBIBCheckbox.SetBoldCheck(Value: Boolean);
begin
if FBoldCheck<>value then FBoldCheck:=Value;

end;

procedure TDBIBCheckbox.SetBoldfixed(Value: Boolean);
begin
if FBoldfixed<>Value then FBoldfixed:=Value;
if FBoldfixed then Self.Font.Style:=[fsBold] else Self.Font.Style:=[]
end;

procedure TDBIBCheckbox.SetValueUnChecked(value: string);
begin
if value<>FValueUnChecked then
begin
if FDataLink.Field<>nil then
begin
if Length(value)>FDataLink.Field.Size then ShowMessage('El ValueUnCheck [ '+Value+' ] contiene más caracteres de los '+#13+#10+
'permitidos, que es de [ '+IntToStr(FDataLink.Field.Size)+' ] caracteres')
else FValueUnChecked:=value;
end else FValueUnChecked:=value;
end;
end;

Procedure TDBIBCheckbox.DBICHKNOT;
begin
if FDataLink.Editing=true then
begin
FDataLink.Field.Value:=FValueUnChecked;
end;
end;

end.

José Luis Garcí
23-06-2013, 14:37:34
El Módulo de Lotes

http://nsae01.casimages.net/img/2013/06/23/130623015626879285.jpg (http://www.casimages.es/i/130623015626879285.jpg.html)

Es importante darse cuenta que el nuevo número de lote siempre lo cogemos de configuración evitando de esta manera que se puedan duplicar los número de lotes

Tenemos que poner un apartado en el programa para cerrar el año, ya que este nos permite poner el contador de lotes y de otros si es necesario a 0

El código en https://gist.github.com/anonymous/5844768

Veamos un detalle de como va cambiando el módulo UbusquedaFP


procedure TFbusquedaFP.FormActivate(Sender: TObject);
//------------------------------------------------------------------------------
//********************[ Cargamos los Campos de la tabla en el ComboBox ]******
//------------------------------------------------------------------------------
begin
//Comprobamos si el combo esta vacio cargamos los datos
if Edbusqueda.Text='' then ActQuery(IBQBusqueda,'Select * From '+VarSTabla);
if IBQBusqueda.IsEmpty then
begin
ShowMessage('No hay datos para buscar o mostrar');
SB_SalirClick(Sender);
end else
begin
if comboCampos.Items.Count=0 then DataSource1.DataSet.GetFieldNames(comboCampos.items);
if VarSTabla='FPAGOS' then
begin
CarGarGrid(0,'ID',50,'ID');
CarGarGrid(1,'CODIGO',130,'Código');
CarGarGrid(2,'FORMAPAGO',260,'Forma de pago');
CarGarGrid(3,'DIASPRESENTACION',130,'Días de presentación');
CarGarGrid(4,'DIASCOBRO',130,'Días de cobro');
CarGarGrid(5,'NUMERODEPAGOS',130,'Número de pagos');
end;
if VarSTabla='FABRICABLES' then
begin
CarGarGrid(0,'ID',50,'ID');
CarGarGrid(1,'CODIGO',130,'Código');
CarGarGrid(2,'PRODUCTO',520,'Producto');
end;
if VarSTabla='EMPLEADOS' then
begin
CarGarGrid(0,'ID',50,'ID');
CarGarGrid(1,'CODIGO',130,'Código');
CarGarGrid(2,'NOMBRE',520,'Nombre');
CarGarGrid(3,'PUESTO',130,'Puesto de trabajo');
CarGarGrid(4,'AGENTE ',130,'Es Agente o comercial');
end;
end;
end;

procedure TFbusquedaFP.FormClose(Sender: TObject; var Action: TCloseAction);
//------------------------------------------------------------------------------
//****************************************************************[ Cerrar ]****
//------------------------------------------------------------------------------
begin
if (VarSNomMod='PROVEEDORES') and (FProveedor.DsPrincipal.DataSet.State in [dsEdit,dsInsert]) then
begin
FProveedor.DBNCodigoFormaPago.Field.Value:=IBQBusqueda.FieldByName('FORMAPAGO').AsString; //Ponemos la forma de pago elegida
FProveedor.DBNCodigoFormaPago.SetFocus; //Damos el foco nuevamente al campo
end;
if (VarSNomMod='LOTESF') and (FLotes.DsPrincipal.DataSet.State in [dsEdit,dsInsert]) then
begin
FLotes.DBNCodFabricable.Field.Value:=IBQBusqueda.FieldByName('CODIGO').AsString; //Ponemos el código elegido
FLotes.DBNCodFabricable.SetFocus; //Damos el foco nuevamente al campo
end;
if (VarSNomMod='LOTESE') and (FLotes.DsPrincipal.DataSet.State in [dsEdit,dsInsert]) then
begin
FLotes.DBNCodEmpleado.Field.Value:=IBQBusqueda.FieldByName('CODIGO').AsString; //Ponemos el código elegido
FLotes.DBNCodEmpleado.SetFocus; //Damos el foco nuevamente al campo
end;
Button3Click(Sender);
QuerryOC(IBQBusqueda);
comboCampos.Items.Clear;
end;

procedure TFbusquedaFP.FormShow(Sender: TObject);
//------------------------------------------------------------------------------
//****************************************************************[ OnShow ]****
// Adaptamos el título del form a la tabla que usamos
//------------------------------------------------------------------------------
begin
if VarSTabla='FPAGOS' then Caption:='Búsquedas en Fomas de pago'; //Caption del Form
if VarSTabla='EMPLEADOS' then Caption:='Búsquedas en Empleados'; //Caption del Form
if VarSTabla='FABRICABLES' then Caption:='Búsquedas en Fabricables'; //Caption del Form
end;



como podemos ver usamos el mismo módulo, para diferentes llamadas, e incluso cunado las llamadas son desde el mismo módulo, pero para diferente Tablas ('LOTESF' y 'LOTESE')

El próximo módulo es el de entradas, que tiene muchas similitudes con este pero también con el de Stock, realmente es el paso intermedio entre ambos.

Que paséis un buen Domingo.

José Luis Garcí
24-06-2013, 16:33:12
Bueno le toca al modulo de entradas

http://nsae01.casimages.net/img/2013/06/24/130624035729237977.jpg (http://www.casimages.es/i/130624035729237977.jpg.html)

y el código como siempre en https://gist.github.com/anonymous/5850255

Como se puede apreciar, se va complicando la cosa :eek:, os que yo soy muy complicado como prefierán :D:D:D

elrayo76
29-06-2013, 04:18:41
Un consejo por la experiencia de trabajar con distintos sistemas y clientes. En el diseño de los formularios no hagas demasiado grandes los botones porque eso le quita importancia las demas cosas del formulario y a los campos de ingreso de datos. Además intenta que los campos de ingreso de datos sean lo mas justo posibles con el tamaño de lo que puedne ingresar, o sea, que si en un campo pueden ingresar solamente 20 caracteres o dígitos que el campo de ingreso se ajuste a tener ese tamaño y no sobre espacio.

Otra cosas, tampoco pongas muchos colores al fondo de los formularios. Es conveniente que tengan un estilo mas similar al que tiene Windows XP/7.

Veo que todos generalmente opinan como debe ser la base de datos, pero lo que nadie dice es que intentes tener una base normalizada. Esto a largo plazo sera mas conveniente y te evitará grandes dolores de cabeza cuando el proyecto cresca.

Con respecto a los campos de la base lo que yo hago es poner 3 letra delante del nombre para identificar la tabla a la que pertenece. Con esto si algun campo como pueden ser los códigos si se necesitan hacer referencia en otra tabla es mas facil identificarlos

Ejemplo:

Tablas:
- Provincias
* prvCodigo
* prvDescripcion

- Clientes
* cliCodigo
* cliNombre
* cliDireccion
* prvCodigo <-- este hace referencia a un registro de otra tabla.
* cliNota

Por el momento creo que este es todo mi aporte.

Saludos,
El Rayo

José Luis Garcí
29-06-2013, 09:28:02
Gracias por los concejos, te comento, que yo era de los que diseñaba, lo más estándar posible a windows, pero varios clientes me hicieron hacer cambios y me dieron sus razones, en gran parte lógicas.

En un principio los monitores eran de 11 pulgadas, ahora el estándar es de 17 en adelante, por lo que el espacio a crecido, y muchos clientes quieren que su programa, sea lo único que se muestre en pantalla, en cuanto a los botones, tengo dos motivos, el primero que tendemos a lo táctil con lo que botones pequeños, es totalmente des aconsejable y en segundo lugar "nos hacemos mayores y el pulso y la vista no son lo que eran" fue la frase de un cliente con poco más que lo que tengo yo ahora y me la dijo hace ya varios años, normalmente suelo usar botones de 75x75 o 80x80, exceptuando los de la barra lateral, ya que quedan según mi opinión más estéticos de esta manera.

En cuanto a los colores, suelo usar básicamente 2, el clbtnfance, como estándar y clskyblue, para los paneles, identificando de esta manera cuales están activos, con respecto a una base de datos, luego uso diferentes colores en un borde bastante fino en los botones, diferenciado los grupos o tipos, suelo usar un color para indicar el edit activo, clinfobk o clmoneygreen para los edit de sólo lectura, dos colores para los grids y por último varios colores en las pestañas, perola mayoría de los parámetros los seleccionas en configuración, así que el cliente puede seleccionar poner todo en el mismo color. Uno de los que no puede cambiar es las pestañas, pero usando un pagecontrol, has visto lo difícil que se le puede hacer a una persona diferenciar en que página esta.

hay que tener en cuenta que estuve durante años trabajando con todo tipo de minusválido, por lo que aprendes a valorar, la opinión de otras personas y muchas necesitan contrastes, para estar posicionados en un formulario de ordenador.

Varias veces, se me ha "acusado" :D de que mis componentes buscan mucho el temas de los colores o la estética, pero podemos echar la vista a tras y decirme a parte de la funcionalidad y las mejoras (que también suelo añadir a mis componentes que es lo que ha ido mejorando con Microsoft Ms-dos, windows, windows 3.1, windows NT windows, 95, windows 98, windows Xp, windows vista, windows 7 (se que me dejo algunos, pero creo que ya se hacen una idea) y como no con Apple y Linux, todos evolucionan, con mayor número de colores, escritorios de mayor tamaños y componentes cada vez más grandes, por que, por estética, petición de los clientes, Accesibilidad y evolución a lo táctil.

Mi opinión, es que nosotros debemos valorar los mismos aspectos, y debemos dejar parámetros que pueda decidir el cliente y tener en cuenta que existen personas con dificultades físicas y psicológicas y también debemos programar para ellos.

En este curso sólo pretendo, aportar mis conocimientos en el área y mi código, que estoy seguro de que muchos compañeros mejoran, ya que no me considero un gran programador, la mayor parte de mi vida e sido autodidacta y en este club me han dado muchísimo, comparado con lo que yo he aportado, al que le pueda ser útil algo que lo aproveche y el que no pues es libre de expresar su opinión.

No creas que me he tomado tu comentario como un ataque, por lo que he puesto en estas lineas, es simplemente una defensa en general, por que nos solemos creer, que nuestros programas son lo más estándar posibles o los mejores diseñados y es increíble la cantidad de parámetros que dejamos en medio que afectan normalmente a un grupo de personas inicialmente y con la edad como nos vamos inclinando hacía este grupo, Problemas de vista, de coordinación, etc.

Con losa años he ido aprendiendo de compañeros y he ido modificando y adaptando según los consejos que me han ido dando, también lo e echo durante este tutorial y Dios me permita no ser orgulloso y prepotente y me permita seguir aprendiendo y mejorando, por que los palos que nos podemos llevar son muy grandes. Os pongo un ejemplo, hace muchos años en una revista de juegos, existía un anuncio de IBM en la que constaba de dos paginas, en la primera aparecía un señor bien vestido y se decía poco más o menos que era un ingeniero de software de alto nivel con poca competencia, en la siguiente página aparecía un bebe de mese y al pie ponía, Y este es su mayor enemigo. La realidad es así de dura, el ejemplo lo tengo en mi sobrino, le saco más de 24 años y en cambio, maneja actualmente más de 10 lenguajes de programación, fluidamente, es un monstruo en programación sobre webs, para que os hagáis una idea, viene a mi casa para que le explique delphi, estamos toda la mañana y toda la tarde, hasta la noche, explicando y desarrollando una pequeñísima aplicación, formularios, tablas, Maestro detalle, llamadas, excepciones, etc, bien la última hora estuvo programando el sólo sin ejecutar la aplicación, aplicando punteros, arrays, llamadas a objetos, funciones y demás, el iba programando y corrigiendo, ejecuto y funciono todo perfecto. Es verdad que ya conocía el C, mientras el hacia eso yo me dedique a coger una de mis agendas apuntar ideas y trozos de código, cosa que le llamo la atención y me pregunto por que tenia tantas agendas viejas y libretas en mi despacho, le comente que en los años que tenia que viajar tanto no tenia portátil, por le que hacía lo que me enseñaron en su día plasmar el código por escrito para luego aplicarlo en un ordenador, su comentario fue "Jo que antiguo, mi cabeza no es capas de esperar a que yo escriba en un boli, yo necesito el ordenador", le pregunte es acaso no has tenido una idea, en un trayecto o mientras duermes sin tener el ordenador cerca, como haces para no olvidarla, es fácíl me dijo, ya me vendrá nuevamente, y si no le comente, entonces es que no era tan buena idea:eek:

José Luis Garcí
29-06-2013, 09:39:29
No, no me he olvidado del tutorial, es que estoy ocupado preparando el material para un curso de fabricación que tengo que dar, antes de irme, pienso poner algo más del tutorial, después estaré como una semana, fuera y cuando vuelva reemprendere, pero mi actual trabajo será así, no se cuando estaré disponible.

Casimiro Notevi
29-06-2013, 10:26:55
En este curso sólo pretendo, aportar mis conocimientos en el área y mi código... , al que le pueda ser útil algo que lo aproveche y el que no pues es libre de expresar su opinión.

Y muy buen aporte que es ^\||/
Por cierto, yo también me he encontrado muchas veces con la pregunta: "¿me puedes poner las letras y los botones más grandes?, es que no los veo".

Por supuesto, como dice elrayo76 es muy importante la nomenclatura, la codificación, la notación usada, etc. pero creo que escapa al ámbito de este proyecto en particular, eso es algo que en este caso se deja para cada uno. Y además puede ser otro gran aporte a los foros, ¿quién se anima? :)

José Luis Garcí
29-06-2013, 12:09:07
Empezado por Casimiro
Por supuesto, como dice elrayo76 es muy importante la nomenclatura, la codificación, la notación usada, etc. pero creo que escapa al ámbito de este proyecto en particular, eso es algo que en este caso se deja para cada uno. Y además puede ser otro gran aporte a los foros, ¿quién se anima?

Muy buena idea Casimiro

José Luis Garcí
06-07-2013, 11:52:18
Primero que nada pedir disculpas por haberme atrasado, tanto en seguir, pero estoy preparando la documentación y el material de un curso para una nueva Fabrica de productos de limpieza (es a lo que me dedico ahora a montar fabricas de productos de limpieza por toda España y otros países) y claro me lleva bastante tiempo preparar un informe por producto, más todo lo demás.

Vamos con el módulo de Regulación de Stock, debería ser un módulo con doble nivel de acceso, el nivel de usuario, en mi caso un 8 y además solicito la clave de usuario nuevamente, aún así se debería al grabar los datos, grabar , en un log, ini, XLS o tabla, tanto el usuario, fecha, hora, cantidad anterior, nueva cantidad y motivo, ya que este apartado afectara seriamente a la trazabilidad, en el ejemplo pongo el resumen pero no lo hago pero creo importante este punto.

Dicho lo dicho aquí la imagen

http://nsae01.casimages.net/img/2013/07/06/130706105451839874.jpg (http://www.casimages.es/i/130706105451839874.jpg.html)

y aquí el código https://gist.github.com/anonymous/5939351

José Luis Garcí
06-07-2013, 12:11:06
Lo siguiente será empezar con nuestras tablas de documentos (para presupuestos, pedidos, albaranes y facturas), usare el sistema de 3 tablas, la maestro, la detalle y la de lotes, creando sólo las 3 para los cuatro tipos de documentos, la estructura ya os la pondré, pero será fundamental, que las tres tendrán tres campos comunes que ademas las hará maestro-detalle entre las 3, los campos serán Documento(Presupuesto, pedido, etc.), número del documento y serie.

El apartado de documentos lo haré una vez (Facturas, el más completo), y explicare los respectivos cambios aplicables a los otros formatos, pero como comprenderéis, es un apartado enorme, por lo que tendré que ir haciéndolo por partes, empezare, por la facturación tal cual, los lotes, , trazabilidad y regulación de stock, estarán incluidos en estas partes, gestión de comisiones, etc.

Según nos vayamos introduciendo, tendremos que ir creando otras tablas a las que haremos referencia y las iremos comentando, una vez terminado el proceso, nos quedara, los módulos de convención de documentos, rutas y cartas de porte, etc. y podremos dar por terminado el tutorial, salvo que queráis un poco más, tendríamos que verlo.

HE dicho que no pondré como hacer los informes (impresiones) ya que cada uno elegirá su método, pero creo que podre mostraros por lo menos dos, una factura y comentaros, que debe llevar y por que y una carta de portes.

Casimiro Notevi
06-07-2013, 12:14:00
Primero que nada pedir disculpas por haberme atrasado, tanto en seguir, pero estoy preparando la documentación y el material de un curso para una nueva Fabrica de productos de limpieza (es a lo que me dedico ahora a montar fabricas de productos de limpieza por toda España y otros países) y claro me lleva bastante tiempo preparar un informe por producto, más todo lo demás.

Faltaría más, tú haces el trabajo, lo regalas y... ¿pides disculpas por el atraso?, ¡¡¡un monumento tendríamos que hacerte por esta labor desinteresada!!! :)
Ojalá pudiésemos compensar a todos los que colaboran con clubdelphi :rolleyes:

Por cierto, tu nuevo trabajo parece interesante ^\||/
Saludos.

José Luis Garcí
06-07-2013, 12:17:50
Si no es molestia, podrían hacerme el favor de valorar el trabajo hasta este momento, lo más sinceramente posible, el motivo, es que como siempre he dicho y he mantenido, yo no soy un experto y necesito saber cuales son mis puntos fuertes, para intentar mejorar.

Me gustaría que lo valorarais de la siguiente manera, del 1 al 10, siendo 1 la menor valoración claro, cada una de las siguientes facetas, y si se os ocurre alguna, ya sabéis.

Explicaciones
Claridad
Código
Tablas
Descripciones
Diseño
Conceptos
forma de aplicar los conceptos
y utilidad

Esto me permitirá, en cuanto al tutorial, intentar corregir y mejorarlo , si puedo y ha nivel personal, seguir aprendiendo y como no autoestima, que me la podéis hundir más :D :D :D o nivelar :rolleyes:

José Luis Garcí
06-07-2013, 12:29:43
Faltaría más, tú haces el trabajo, lo regalas y... ¿pides disculpas por el atraso?, ¡¡¡un monumento tendríamos que hacerte por esta labor desinteresada!!! :)
Ojalá pudiésemos compensar a todos los que colaboran con clubdelphi :rolleyes:

Por cierto, tu nuevo trabajo parece interesante ^\||/
Saludos.

Gracias Casimiro, pero creo que si empiezo un tutorial, es por que tengo un compromiso con el club y como tal debo responder, lo mejor que pueda, claro y como supongo que hay gente siguiendo el tema, que menos que disculparme por los atrasos.

Si lo que pasa, es que la gente tiene miedo a montar empresas, te aseguro que es un sector con un margen de beneficio, mínimo de un 35% en 3 o cuatro productos y de más de 500% de beneficios en otros, la media es superior al 100% del coste de la mercancía, necesitas vender volumen, en unos casos y en otros ganas por beneficio, pero con una experiencia de más de diez años en la formulación y gestión de empresas de limpieza y cosmética, no se ha que otra cosa dedicarme, y por muy poco dinero (20.000'00 euros) se puede montar una fabrica de limpieza (no de cosmética) donde se incluye, el alquiler y fianza del local, constitución de la empresa, vehículo de segunda mano, materiales, materias primas, etc.) también incluye el curso que tengo que dar, +- 8-10 fórmulas, dependiendo cuales quieran y lo mejor es que no hay que tener preparación previa y son muy pocos requisitos legales.

José Luis Garcí
07-07-2013, 12:07:09
Empezamos con la tabla documentos, como es una tabla para nuestros tipos de documentos, usaremos los identificadores X=Presupuestos, P=Pedidos, A=Albaranes y F=Facturas para indicar en que documento lo usaremos.

CREATE TABLE DOCUMENTOS (
ID INTEGER NOT NULL,
TIPODOCUMENTO T20 NOT NULL /* T20 = VARCHAR(20) */, //......................tipo de documento (XPAF)
NUMERODOCUMENTO T20 NOT NULL /* T20 = VARCHAR(20) */, //.....................código del documento (XPAF)
SERIE T3 NOT NULL /* T3 = VARCHAR(3) */, //.....................Serie del documento (XPAF)
CODIGOCLIENTE T20 NOT NULL /* T20 = VARCHAR(20) */, //.....................Código del cliente (XPAF)
DESCRIPCIONCLIENTE T80 /* T80 = VARCHAR(80) */, //......................1 (XPAF)
IDDIRECCIONES INTEGER NOT NULL, //.....................el campo id de la tabla direcciones ya tratada, al tener la posibilidad de varias direcciones (XPAF)
CODIGOAGENTE T20 NOT NULL /* T20 = VARCHAR(20) */, //.....................código del agente o comercial (XPAF)
DESCRIPCIONAGENTE T80 /* T80 = VARCHAR(80) */, //.....................1 (XPAF)
FECHA DATE NOT NULL, //.....................Fecha de emisión de la factura (XPAF)
NUMERODECOBRO T20 /* T20 = VARCHAR(20) */, //.....................Numero (código) de tablas COBROS (Pendiente) donde registraremos la forma en que se nos ha pagado (F)
COBRADO LOG NOT NULL /* LOG = CHAR(1) */, //.....................(S/N) indica si la factura ya esta cobrada, al tener el campo NUMERODECOBRO podemos ver más detalles (F)
NUMERORUTA T20 /* T20 = VARCHAR(20) */, //.....................Numero (código) de tablas RUTAS (Pendiente) donde registraremos las rutas de entrega (PAF)
FECHAENTREGA DATE, //.....................Fecha de la entrega, si cambiamos la ruta, cambiara la fecha (2) (PAF)
FORMADEPAGO T20 NOT NULL /* T20 = VARCHAR(20) */, //.....................Código de la taba forma de pago (XPAF)
DESCRIPCIONFORMADEPAGO T80 /* T80 = VARCHAR(80) */, //...................../1 (XPAF)
NUMEROFINANCIADO T20 /* T20 = VARCHAR(20) */, //.....................Numero (código) de tablas FINANCIADO (Pendiente) donde registraremos las financiación de pagos (PAF)
TOTALFINANCIADO POR /* POR = NUMERIC(15,4) */, //.....................Total del dinero financiado, no tiene por que ser el total de la factura
NUMERORETENCIONES T20 /* T20 = VARCHAR(20) */, //...................../Numero (código) de tablas RETENCIONES (Pendiente) donde registraremos las retenciones hechas a clientes (PAF)
TOTALRETENCIONES POR /* POR = NUMERIC(15,4) */, //...................../Importe de las retenciones
PORCENTAJERETENCIONES POR /* POR = NUMERIC(15,4) */, //.....................porcentaje de retenciones aplicadas, puede variar a la que ya tiene aplicada el cliente (3) (F)
TOTALCOMISIONES POR NOT NULL /* POR = NUMERIC(15,4) */, //.....................Total de comisiones (XPAF). (4)
NUMEROPROTECCIONDATOS INTEGER NOT NULL //.....................Elegimos entre el 1 y el 3 de la tabla CONFIGURACION donde 1 =LDPD1 ... 3=LDPD3, que texto debemos poner (XPAF)
CAMPOLIBRE T80 /* T80 = VARCHAR(80) */, //.....................Campo libre ya que la ley va cambiando o podemos necesitar (XPAF)
MODIFICACIONES INTEGER NOT NULL, //.....................Número de veces que se ha modificado la factura, nos permite controlar si se ha alterado (5) (XPAF)
ESTADO T40 /* T40 = VARCHAR(40) */, //...................../Estado actual de la factura (Pendiente, cobrada, nula (5), etc) (XAPF)
NUMERORELACIONFACTURAS T20 /* T20 = VARCHAR(20) */, //...................../Numero (código) de tablas RELACIONFACTURAS (Pendiente) donde agruparemos facturas de un cliente (F)
SERIERELACIONFACTURAS T3 /* T3 = VARCHAR(3) */, //.....................Serie de la relación de facturas (F)
SUBTOTAL POR NOT NULL /* POR = NUMERIC(15,4) */, //.....................Subtotal del importe (XPAF)
TOTALDESCUENTOS POR NOT NULL /* POR = NUMERIC(15,4) */, //.....................Importe del total de descuentos (XPAF)
TOTALPESO POR NOT NULL /* POR = NUMERIC(15,4) */, //.....................Total del peso perteneciente al documento (XPAF)
TOTALIMPUESTOS POR NOT NULL /* POR = NUMERIC(15,4) */, //.....................Total de impuestos (XPAF)
TOTALIMPUESTO1 POR NOT NULL /* POR = NUMERIC(15,4) */, //.....................Total de impuestos tipo 1 (XPAF)
TOTALIMPUESTO2 POR NOT NULL /* POR = NUMERIC(15,4) */, //.....................Total de impuestos tipo 2 (XPAF)
TOTALIMPUESTO3 POR NOT NULL /* POR = NUMERIC(15,4) */, //.....................Total de impuestos tipo 3 (XPAF)
TOTALIMPUESTO4 POR NOT NULL /* POR = NUMERIC(15,4) */, //.....................Total de impuestos tipo 4 (XPAF)
MININOTA VARCHAR(150) //...................../Campo de 150 caracteres, ya que las notas las haremos a través de la tabla NOTAS (XPAF)
);


1) las descripciones es para posibles cambios sin tener que editar o crear un registro nuevo
ejemplo: Código cliente= 0 Descripción general 'Contado' campo DESCRIPCIONCLIENTE 'Contado - (trabajador taller Antonio)'

2) Si ponemos la ruta para hoy i por cualquier motivo no se puede entregar en la fecha prevista, la pondremos en la siguiente hoja de ruta, por lo que debemos controlar el cambio
de la fecha de entrega

3) El cliente puede solicitar que le aumentes o disminuyas el porcentaje de retenciones en una factura, únicamente. Estará presente en PAF, pero se puede variar y determina sólo
el de la factura, por defecto coge el del cliente, que es lo habitual.

4) Las comisiones irán a su tabla de comisiones, donde pondremos de que documento viene, de aquí podremos realizar el pago de comisiones, recordar que el pago de comisiones
hay que hacerle la retención para el pago de Hacienda.

5) Las Facturas no se pueden borrar, ya que afectan a varios departamentos y alteran la aplicación, no quiero decir que no se puedan, pero no se deben bajo ningún concepto,
ejemplo : tenemos la factura 120001, que es el mismo valor actual de nuestro numerador de facturas y nos damos cuenta al terminar, de que esta mal, claro que podríamos
borrarla y modificar el numerador, pero si el numerador ya va por el 120025, o otro cualquiera, borramos la factura y queda un salto en el registro de facturación, motivo de
auditoria en hacienda, si no queda bien explicado y suele pasar, cuando trabajamos todo el año con cientos o miles de facturas, quien se acuerda de una determinada, de hace
x meses.

---------------------------------------------------------------------------------------------------------------------------------------------------------


Como podemos ver se va complicando la cosa, es posible que se me olvide algún campo, así que ya iremos viendo.

José Luis Garcí
07-07-2013, 12:32:59
ahora la tabla detalle

CREATE TABLE DETALLE (
ID INTEGER NOT NULL,
IDENTIFICADOR INTEGER NOT NULL, //............................................. FOREIGN KEY con el id de documentos
TIPODOCUMENTO T20 NOT NULL /* T20 = VARCHAR(20) */, //............................................. tipo de documento (XPAF)
NUMERODOCUMENTO T20 NOT NULL /* T20 = VARCHAR(20) */, //............................................. código del documento (XPAF)
SERIE T3 NOT NULL /* T3 = VARCHAR(3) */, //............................................. Serie del documento (XPAF)
CODIGOARTICULO T20 NOT NULL /* T20 = VARCHAR(20) */, //............................................. Código del artículo (XPAF)
DESCRIPCIONARTICULO T80 /* T80 = VARCHAR(80) */, //............................................. 1 (ver en post anterior) (XPAF)
CANTIDAD INTEGER NOT NULL, //............................................. Cantidad o unidades del artículo (XPAF)
PRECIOUNIDAD POR NOT NULL /* POR = NUMERIC(15,4) */, //............................................. Precio de la unidad (XPAF)
IMPUESTO POR NOT NULL /* POR = NUMERIC(15,4) */, //............................................. Porcentaje del impuesto (XPAF)
DESCUENTO POR NOT NULL /* POR = NUMERIC(15,4) */, //............................................. Porcentaje del descuento (XPAF)
COMISION POR NOT NULL /* POR = NUMERIC(15,4) */, //............................................. Porcentaje de la comisión (XPAF)
PESOUNIDAD POR /* POR = NUMERIC(15,4) */, //............................................. peso de cada unidad (XPAF)
MININOTA VARCHAR(150), //............................................. Campo texto de 150 caracteres, para ampliar detalles (XPAF)
CAMPOLIBRE T80 /* T80 = VARCHAR(80) */, //............................................. Campo libre ya que la ley va cambiando o podemos necesitar (XPAF)
MODIFICADO INTEGER NOT NULL, //............................................. Número de veces que se ha modificado (XPAF)
SERVICIO LOG /* LOG = CHAR(1) */, //............................................. Es un servicio (XPAF)
IDPRECIOESPECIAL INTEGER, //............................................. Número del ID, si el precio tomado es precio especial para el cliente (1) (XPAF)
ALMACEN T20 /* T20 = VARCHAR(20) */, //............................................. Almacén del que sale la mercancía (XPAF)
NUMEROPRESUPUESTO T20 /* T20 = VARCHAR(20) */, //............................................. Número (Código) del presupuesto que viene (2) (PAF)
NUMEROPEDIDO T20 /* T20 = VARCHAR(20) */, //............................................. Número (Código) del pedido que viene (2) (AF)
FECHAPEDIDO DATE, //............................................. Fecha del pedido del que viene (2) (AF)
NUMEROALABARAN T20 /* T20 = VARCHAR(20) */, //............................................. Número (Código) del albarán que viene (2) (A)
FECHAALBARAN T20 /* T20 = VARCHAR(20) */ //............................................. Fecha del albarán del que viene (2) (A)
);

/******************************************************************************/
/* Foreign Keys */
/******************************************************************************/

// ALTER TABLE DETALLE ADD CONSTRAINT FK_DETALLE_1 FOREIGN KEY (IDENTIFICADOR) REFERENCES DOCUMENTOS (ID) ON DELETE CASCADE ON UPDATE CASCADE;



1) si tiene precio especial, no le afecta ni rapel, ni otros

2) El cliente normalmente quiere que en el documento de unión (albarán o factura) aparezca reflejado por documentos para el poder revisarlos y comprobar, por ello debemos crear un registro que
especifique según sea el caso de manera que si es un albarán sería 'Pedido 120001 fecha 07/072012' y si fuera una factura sería 'Albarán 120025 fecha 30/07/2012', detallando despues de
cada linea del pedido o albarán.
Este no sería el caso si el cliente tiene un rapel o escandallo con cierre final, ya que para ello debemos unir todos los campos con el mismo código de articulo, para obtener la cantidad de
unidades y ver que precio se le asigna, por lo que el precio del albarán o de la factura difieren, pero aún así debemos registrar de que albaranes o pedido bien, pero lo haríamos al pie del
documento dentro de sus notas.

José Luis Garcí
07-07-2013, 12:50:38
Ahora la última de las tres la tabla lotes de documentos (LOTESDOCUMENTOS)

CREATE TABLE LOTESDOCUMENTOS (
ID INTEGER NOT NULL,
IDENTIFICADOR INTEGER NOT NULL, //............................................. FOREIGN KEY con el id de documentos
TIPODOCUMENTO T20 NOT NULL /* T20 = VARCHAR(20) */, //............................................. tipo de documento
NUMERODOCUMETO T20 NOT NULL /* T20 = VARCHAR(20) */, //............................................. código del documento
SERIE T3 NOT NULL /* T3 = VARCHAR(3) */, //............................................. Serie del documento
LOTE T20 NOT NULL /* T20 = VARCHAR(20) */, //............................................. número de lote
CANTIDAD INTEGER NOT NULL, //............................................. Cantidad de este artículo con este lote
CODIGOARTICULO T20 NOT NULL /* T20 = VARCHAR(20) */, //............................................. código del artículo
ADR T80 /* T80 = VARCHAR(80) */, //............................................. Descripción y texto ADR
EXCEPCION INTEGER, //............................................. Cantidad exceptuada del ADR
LIMITE INTEGER, //............................................. limite de carga en vehículo con medidas mínimas según el ADR
CADUCIDAD DATE, //............................................. fecha de caducidad de este lote
CAMPOLIBRE T80 /* T80 = VARCHAR(80) */ //............................................. Campo libre ya que la ley va cambiando o podemos necesitar
);


//******************************************************************************/
//* Foreign Keys */
//******************************************************************************/

//ALTER TABLE LOTESDOCUMENTOS ADD CONSTRAINT FK_LOTESDOCUMENTOS_1 FOREIGN KEY (IDENTIFICADOR) REFERENCES DETALLE (ID) ON DELETE CASCADE ON UPDATE CASCADE;



Como podemos ver tenemos una relación entre las tablas siendo de la siguiente manera

DOCUMENTOS.ID------>DETALLES.IDENTIFICADOR y
DETALLES.ID ------------------ LOTESDOCUMENTOS.IDENTIFICADOR

También contamos con los campos TIPODOCUMENTO, NUMERODOCUMETO y SERIE, para poder hacer sus búsquedas y relaciones en SQL.

Podríamos hacerlo creando un juego de tablas por tipo de documentos, que sería la manera más simple y rápida de hacer, pero esta manera, nos permite reducir consumo de recursos, ya que muchos campos son repetitivo, e incluso eliminar la tabla de LOTESDOCUMENTOS y unir sus campos a los de DETALLES, pero de esta manera es más clara.

Como siempre espero este clara la explicación actual y si hay dudas, comentarios, o consejos, rectificaciones, etc, ya sabéis, aquí estoy.

José Luis Garcí
09-07-2013, 13:19:43
Para que valláis abriendo boca una imagen del visor de documentos, sin estar activo aún muchos campos

http://nsae01.casimages.net/img/2013/07/09/130709123006123781.jpg (http://www.casimages.es/i/130709123006123781.jpg.html)

en el apartado 1 veréis un DBtext, con el fondo en verde, realmente va en transparente, pero como no contiene datos aún, para controlar se u ancho

El código en https://gist.github.com/anonymous/5956364


Para que este sistema funcione debemos usar en su llamada el siguiente sistema

procedure TFMenu.act_V_FacturasExecute(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************************[ Facturas ]****
// Gestión de Proveedores apto desde nivel 6
//------------------------------------------------------------------------------
begin
VarSTipoDocumento:='FACTURA';
FXPAF.PC.ActivePageIndex:=0;
FXPAF.PC2.ActivePageIndex:=0;
Acceso(6,FXPAF);
end;

Y el procedimiento acceso
function TFMenu.Acceso(NivelAc:Integer;MForm:TForm):Boolean;
//------------------------------------------------------------------------------
//*****************************************************[ funcion de acceso ]****
//------------------------------------------------------------------------------
begin
if Nivel>=NivelAc then
begin
MForm.Show;
Result:=true;
end else
begin
ShowMessage('Debe tener nivel '+IntToStr(NivelAc)+' para poder acceder a este apartado');
Result:=False;
end;
end;

En algunos casos, deberemos confirmar con la clave de acceso al programa, la entrada en un apartado esto lo haremos de la siguiente manera

procedure TFMenu.ACT_Esp_RegularStockExecute(Sender: TObject);
//------------------------------------------------------------------------------
//*********************************************************[ REgular Stock ]****
// Regulación de Stock apto desde nivel 8 + clave de usuario
//------------------------------------------------------------------------------
begin
if Acceso(8,FRegulaStock) then
begin
FRegulaStock.Hide;
PostMessage(Handle, InputBoxMessage, 0, 0); // Para imputboxt con password chard
if InputBox('Comprobando seguridad', 'Por favor indroduzca su clave de usuario', '')= VarSClaveUSuario then
FRegulaStock.Show
else
begin
ShowMessage('La clave de seguridad no es la adecuada,' + #13 +
'no tiene permiso, para acceder a este apartado');
FRegulaStock.Close;
end;
end;
end;


Para ello necesitamos estos cambios en nuestro programa

procedure TFMenu.InputBoxSetPasswordChar(var Msg: TMessage);
// Para imputboxt con password chard
// ------------------------------------------------------------------------------
// *****************[ Para convertir los caracteres en * de un imput box]*******
// ------------------------------------------------------------------------------
var HInputForm, HEdit, HButton: HWND;
begin
HInputForm := Screen.Forms[0].Handle;
if (HInputForm <> 0) then
begin
HEdit := FindWindowEx(HInputForm, 0, 'TEdit', nil);
SendMessage(HEdit, EM_SETPASSWORDCHAR, Ord('*'), 0);
end;
// ------------------------------------------------------------------------------
// ****************************[ Otras partes importantes de este código ]*******
// {Despues del uses}
// const
// InputBoxMessage = WM_USER + 200; //Para imputboxt con password chard
// {En el Type}
// procedure InputBoxSetPasswordChar(var Msg: TMessage); message InputBoxMessage;
// {USO CON LAS DOS LINEAS}
// PostMessage(Handle, InputBoxMessage, 0, 0); //Para imputboxt con password chard
// if InputBox('Comprobando seguridad', 'Porfavor indroduzca su clave de usuario', '') = VarClaveUSusario then
// ------------------------------------------------------------------------------
end;

Espero os sea útil y como siempre espero vuestros comentarios.

Por cierto, que nadie se anima a valorar el trabajo, es una buena manera de saber, donde tengo que mejorar y todos podéis hacerlo, ni me ofende, ni me molesta y es un buen ejercicio, para ver con la perspectiva de los compañeros el trabajo que estoy realizando os recuerdo como pido que me valoréis el trabajo.

í Si no es molestia, podrían hacerme el favor de valorar el trabajo hasta este momento, lo más sinceramente posible, el motivo, es que como siempre he dicho y he mantenido, yo no soy un experto y necesito saber cuales son mis puntos fuertes, para intentar mejorar.

Me gustaría que lo valorarais de la siguiente manera, del 1 al 10, siendo 1 la menor valoración claro, cada una de las siguientes facetas, y si se os ocurre alguna, ya sabéis.

Explicaciones
Claridad
Código
Tablas
Descripciones
Diseño
Conceptos
forma de aplicar los conceptos
y utilidad

Esto me permitirá, en cuanto al tutorial, intentar corregir y mejorarlo , si puedo y ha nivel personal, seguir aprendiendo y como no autoestima, que me la podéis hundir más o nivelar

No se si es la época o qué, pero parece que los compañeros, no están muy animados a participar, como hace un par de años, claro esta es mi opinión, humildemente.

José Luis Garcí
09-07-2013, 13:37:50
Ya he explicado, esto en post anteriores, pero creo que es importante para el tutorial, así que nuevamente, expongo mi sistema de acceso a las diferentes partes del programa, si recordáis en la tabla usuarios (que por cierto, se me colo una S de más y se quedo como ususarios :p) tenemos la estructura

CREATE TABLE USUSARIOS (
ID INTEGER NOT NULL,
CLAVE T20 /* T20 = VARCHAR(20) */,
USUARIO T20 /* T20 = VARCHAR(20) */,
NIVEL INTEGER,
NOMBRE T80 /* T80 = VARCHAR(80) */
);

en ella existen dos apartados fundamentales, para el acceso, ojo todos son importantes, pero estos dos fundamentales, que son CLAVE y NIVEL, como es lógico, solicito el usuario y la clave, en un form de acceso, compruebo y si esta ok, cargo una serie de variables locales, con el usuario, la clave y el nivel, después la llamada a los diferentes apartados la hago con la función ACCESO, donde comprobamos e, nivel, con el que ponemos al apartado, todo desde un ActionList, para no tener que estar repitiendo código., si tenemos que volver a solicitar la clave uso un inputbox con la peculiaridad, de poner los caracteres como asteriscos, para ello uso las instrucciones que a parece en el procedure TFMenu.InputBoxSetPasswordChar(var Msg: TMessage);

De esta manera, si nos vamos a tomar un café y un compañero quiere acceder a un apartado, al que no tiene nivel y es delicado, aunque este activo el nivel de usuario, le solicitara la clave para acceder, con lo que se quedara con las ganas, creo que unas de las ventajas de este sistema es el ahorro de código, en apartados de seguridad.

Yo suelo usar el siguiente sistema para valorar el nivel de usuario

0...5 los valoro como acceso de visitante
6...7 Introductor de datos
8 Persona de mucha confianza
9 Acceso total

Claro esta que si tienes nivel 7 en vez de 6 puedes acceder a más apartados, o ver partes dentro de un apartado, que de otra manera no aparecen. Los apartados, que por tema de datos, o seguridad, siempre solicito clave de acceso e incluso en algún programa he usado la clave de acceso con un sistema de clave por fecha o clave diferencial.

Espero no haberos liado.

PepeLolo
09-07-2013, 15:38:34
Sólo puedo decir ¡Chapeau! Por el trabajo que estas realizando. Estoy siguiendo el desarrollo desde el principio y me parece fantástico. Es un ejemplo ejemplarizante de desarrollo de aplicación.
Componentes, Datamodulos, explicaciones, imágenes.

Es un trabajo que puede servir tanto para un nivel de programador bajo-medío-alto ya das un montón de aportes al mismo y das buenos ejemplos de resolución como son los componentes adaptados a las necesidades concretas.:D

José Luis Garcí
09-07-2013, 15:57:49
Sólo puedo decir ¡Chapeau! Por el trabajo que estas realizando. Estoy siguiendo el desarrollo desde el principio y me parece fantástico. Es un ejemplo ejemplarizante de desarrollo de aplicación.
Componentes, Datamodulos, explicaciones, imágenes.

Es un trabajo que puede servir tanto para un nivel de programador bajo-medío-alto ya das un montón de aportes al mismo y das buenos ejemplos de resolución como son los componentes adaptados a las necesidades concretas.:D

Gracias PepeLoto, por tu comentario, imagino que el tutorial a de ser útil, ya que cuando yo comencé con estos temas, no encontraba casi nada de información, es verdad que ahora existe bastante más, pero es difícil de digerir y aplicar algunas veces.
Una cosa que no me ha quedado clara a lo largo del tutorial, es el conocimiento real de los temas tratados por los compañeros, es por lo que digo muchas veces, que no se si interesa o es que estoy siendo muy espeso en el tema e incluso que alguno piense en que estoy siendo prepotente.

Vuelvo y te repito gracias por el comentario, pero podrias poner una evaluación como la pido, ya que me sería más útil, para saber realmente, en que tendría que mejorar.

José Luis Garcí
09-07-2013, 16:48:08
Además creo que mi sistema de trabajo no es el mejor, estoy seguro de que muchos compañeros, pueden hacer maravillas comparado con lo que yo hago, la única ventaja que yo puedo tener, es que suelo trabajar en las empresas para que hago los programas, ya que es la manera más eficaz de conocer las carencias y necesidades de una empresa. Por supuesto si te dedicas a la programación, esto es casi imposible, pero tampoco debemos quedarnos con lo que nos dice el jefe de una empresa, ya que suelen tener un ideal de la empresa, que muchas veces choca con la realidad, de la misma.

Normalmente suelo hablar de cosas que conozco, aunque sea un poco, hace ya cerca de 17-18 empece a trabajar para una empresa que vendía cupones, tipo a los de la once, el primer día me pusieron a trabajar, con un señor que llevaba unos cuantos años buenos trabajando para esta asociación de Madrid, empezó a explicarme el programa, claro, al final y al cabo se trata de un programa de gestión y yo programaba en clipper en esa época, que era el mismo lenguaje de la aplicación, al cabo de una hora y media, ya empece a trabajar con el programa y terminamos el día de trabajo, me preguntaron que que tal y le comente que no entendía, por que algunos procesos se hacían de determinada manera.
Al cabo de una semana, me presentaron a un señor, que me pregunto por las dudas, que tenia del programa, le comente y explique, el por que de mis dudas, me pregunto como lo haría yo, esquematizando le dije más o menos, mis ideas y planteamientos, al cabo de dos días volvió este señor, con otro mucho más joven, era la persona que había hecho el programa, tuve que volver a explicar mis dudas y decir mis planteamientos, esa misma tarde me sacaron de la oficina, para ir al hotel donde se quedaban, tenia una reunión, entre el gerente de zona, la persona que me enseño (era el tercero dentro de la asociación con más de 8 años en ella), el señor más mayor que me pregunto por mis dudas (resulto ser el Presidente de la Asociación, cosa que yo aun desconocía) y el programador), claro, como podéis imaginaros, estaba un poco acojonado, ya que había sido padre hacía pocos meses y estuve en el paro antes de este puesto cerca de 3 años, pensaba que me despedían, sinceramente.
Aquella reunión termino por la noche, me invitaron a cenar y me convocaron nuevamente, a la mañana siguiente en el hotel, durante esos dos días, se estuvo planteando y rebatiendo los diferentes puntos, tiradas, premiso, cierres, partes, etc. a la hora de comer, se presentan a un chaval joven, ante el delegado de zona y el señor que me enseñaba a mi, era mi sustituto, podéis imaginaros, se me cayo el alma a los pies, aún así, mantuve el tipo y calle, seguimos la reunión y al final del segundo día, me preguntaron, por que encontré con tanta facilidad, tantos puntos flacos, posibles errores y mejoras, mi respuesta fue sincera, por que estaban ahí, el presidente se rió y el informático cayo, estaba serio, muy serio, cuando el presidente se sereno, le pregunto al informático, que como era posible que un programa que estaba terminado hacia dos años, más un año terminarlo, no se hubiese dado cuenta de esos errores, mejoras y huecos de seguridad, el informático me miro, estaba triste, se le notaba que estaba enfadado imagine que consigo mismo (luego supe que así era), se hizo el silencio, yo me vire y le pregunte, algo que Jesús, el amigo que me enseño a programar en clipper me dijo al principio del todo, "oye Carlos (el nombre del informático), cuantas horas pasaste con el personal preguntándoles y viéndoles trabajar", me miro sorprendido y me dijo 0, fue el Presidente (no recuerdo su nombre), quien me dio las pautas, a el se le entregaba el programa y me comentaban los errores, me vire a este y le pregunte, cuantas horas paso usted con el programa, su respuesta fue tajante, yo no trabajo con eso se la doy a Fulanito (La persona que me enseño el primer día del cual no recuerdo el nombre) y el a su vez se lo da al personal el cual le dice los fallos, entonces tú (Carlos), no haz hablado nunca con nadie que trabajara directamente con el programa, me volvió a mirar, haciendo un esfuerzo por recordar y dijo no, nunca, dije, esta claro, ahí radica el problema, los usuarios finales, son los que detectan los fallos, si hay un jefe por medio, siempre se cohiben más que con un igual o alguien externo que este para solucionar los problemas, los dos me miraron, se miraron y me dijeron que volviera la hotel al día siguiente.

Regrese al día siguiente y me dijeron que no volvería a mi puesto de inspector (introductor), que me subían el sueldo (25.000 pesetas si no recuerdo mal) y que tendría que estar los próximos quince días yendo a trabajar a una casa que habían alquilado, con Carlos, que luego era probable, que tuviese que viajar a Madrid, cuando el programa estuviese en su fase final de pruebas, nunca fui, diez días despues, hubo un problema muy serio entre la persona que me había contratado y la asociación (el problema fue por parte de esta), no se bajaron del burro, así que mi jefe Jerónimo, decidió despues de preguntarme si yo era capaz de hacer un programa parecido como el que tenia la asociación, le dije que si, me dijo en 20 días, le dije, completo no, pero algunas partes si, acepto y rompió los acuerdos con la asociación, montando una nueva, dicho programa en terminarlo completo, tarde 6 meses, al cabo de otros tres años y medio, me pidió y pago que le hiciera una nuevo para windows, y que yo sepa a día de hoy lo signe usando, tiene fallos, debido a que fue echo en DBF y Delphi 3, hoy en día hubiese echo muchas cosas de manera diferente, pero me imagino que nos pasa a todos.

En cuanto a Carlos, estuve en contacto hasta el 2007, año en que por desgracia murió, durante muchos años, cuando venia a canarias, siempre nos veíamos, el programa lo corrigió siguiendo muchos de mis concejos y aplicando su técnica y forma de programar, pero fue siempre un buen amigo, a partir de aquel tercer día de conocernos.

Siento el coñazo, pero para que entandáis a que me refiero, se debe contar la historia completa.

Casimiro Notevi
09-07-2013, 17:36:20
jeje... me gustan las historias de los "abuelos" :D

Fdo. Otro abuelo ;)

José Luis Garcí
09-07-2013, 17:39:30
jeje... me gustan las historias de los "abuelos" :D

Fdo. Otro abuelo ;)

:D:D:D, ya no vamos para jovencitos, yo ya voy por tres pastillas al día y tú? :rolleyes:

Casimiro Notevi
09-07-2013, 17:43:03
:D:D:D, ya no vamos para jovencitos, yo ya voy por tres pastillas al día y tú? :rolleyes:

De momento, ninguna :cool:
Cuando muera, seré el más sano del cementerio :D

José Luis Garcí
09-07-2013, 17:47:35
Ninguna :eek:, pues ami me tocan dos de la diabetes y una del colesterol, aunque el último análisis decía que no tengo. al paso que vamos cualquier día nos dan las llaves del ambulatorio. Me pegaba años y años sin ir al médico y llevo menos de dos, con 2-3 visitas al médico mensuales, por la diabetes, revisiones, etc.

Casimiro Notevi
09-07-2013, 18:04:09
Vaya, yo por suerte, de momento, no tengo ningún problema de salud. Toco madera :)

fjcg02
09-07-2013, 23:10:58
Entre el "abuelo cebolleta" y Casimiro, en vez del ClubDelphi parece la editorial bruguera.

Saludos
PD: este comentario seguramente que sólo lo entendamos los "juveniles"

Casimiro Notevi
09-07-2013, 23:18:49
jeje... nos falta Zipi y Zape :)

José Luis Garcí
10-07-2013, 18:14:03
Después de unas cuantas horas buenas os pongo el código de dos componentes que se usaran en el módulo que estamos, son iguales, uno para integer y otro para double, son Spinedit para tablas

//Este componente deriva de los componentes NewDbedit,´JanbuttonEdit y DbSpinEdit y nuevas propiedades añadidas

unit NewDBSpinEdit;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, DBneweditjl , mask, DbTables, DB, DBCtrls;

type
TNewDBSpinEdit = class(TDBNewEditJL)
private
FButtonUp : TBitBtn;
FButtonDown : TBitBtn;
FWidthButton : Integer;
FCaptionUp : String;
FCaptionDown : String;
FProportional : Boolean;
FMinValue : LongInt;
FMaxValue : LongInt;
FIncrement : LongInt;
FEditorEnabled: Boolean;
FFontButtons : TFont;
procedure SetGlyph(const Value: TBitmap);
function GetGlyph:TBitmap;
procedure SetGlyphDown(const Value: TBitmap);
function GetGlyphDown:TBitmap;
procedure autofit;
procedure TextChanged(sender: TObject);
procedure setCaptionUp(const Value:String);
procedure setCaptionDown(const Value:String);
procedure setWidthButton(const Value:Integer);
procedure setProportional(const Value:Boolean);
function GetValue: LongInt;
procedure SetValue (NewValue: LongInt);
function CheckValue (NewValue: LongInt): LongInt;
procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure WMPaste(var Message: TWMPaste); message WM_PASTE;
procedure WMCut(var Message: TWMCut); message WM_CUT;
protected
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure CreateWnd;override;
function GetOnButtonUpClick: TNotifyEvent;
function GetOnButtonDownClick: TNotifyEvent;
procedure SetOnButtonUpClick(Value: TNotifyEvent);
procedure SetOnButtonDownClick(Value: TNotifyEvent);
procedure KeyPress(var Key: Char); override;
function IsValidChar(Key: Char): Boolean; virtual;
procedure UpClick (Sender: TObject); virtual;
procedure DownClick (Sender: TObject); virtual;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property OnButtonUpClick: TNotifyEvent read GetOnButtonUpClick write SetOnButtonUpClick;
property OnButtonDownClick: TNotifyEvent read GetOnButtonDownClick write SetOnButtonDownClick;
property GlyphUP :TBitmap read GetGlyph write SetGlyph;
property GlyphDown :TBitmap read GetGlyphDown write SetGlyphDown;
property CaptionUp :String read FCaptionUp write SetCaptionUp;
property CaptionDown :String read FCaptionDown write SetCaptionDown;
property WidthButton :Integer read FWidthButton write SetWidthButton default 15;
property Proportional :Boolean read FProportional write SetProportional default True;
property MaxValue :LongInt read FMaxValue write FMaxValue;
property MinValue :LongInt read FMinValue write FMinValue;
property Value :LongInt read GetValue write SetValue;
property Increment :LongInt read FIncrement write FIncrement default 1;
property FontButtons :TFont read FFontButtons write FFontButtons;
end;

procedure Register;

implementation

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

procedure TNewDBSpinEdit.WMCut(var Message: TWMCut);
begin
if not FEditorEnabled or ReadOnly then Exit;
inherited;
end;

procedure TNewDBSpinEdit.WMPaste(var Message: TWMPaste);
begin
if not FEditorEnabled or ReadOnly then Exit;
inherited;
end;

procedure TNewDBSpinEdit.WMSize(var Message: TWMSize);
begin
inherited;
autofit;
end;

function TNewDBSpinEdit.CheckValue(NewValue: Integer): LongInt;
begin
Result := NewValue;
if (FMaxValue <> FMinValue) then
begin
if NewValue < FMinValue then Result := FMinValue
else if NewValue > FMaxValue then Result := FMaxValue;
end;
end;

procedure TNewDBSpinEdit.CMEnter(var Message: TCMGotFocus);
begin
if AutoSelect and not (csLButtonDown in ControlState) then
SelectAll;
inherited;
end;

procedure TNewDBSpinEdit.CMExit(var Message: TCMExit);
begin
inherited;
if CheckValue (Value) <> Value then
SetValue (Value);
end;

constructor TNewDBSpinEdit.Create(AOwner: TComponent);
begin
inherited;
width :=121;
height :=24;
FCaptionDown :='q';
FCaptionUp :='p';
FWidthButton :=15;
FontButtons :=TFont.Create;
with FFontButtons do
begin
Name :='wingdings 3';
Size :=7;
end;
FButtonUP :=TBitbtn.Create (self);
with FButtonUP do
begin
width :=FWidthButton;
height :=15;
Font :=FFontButtons;
top :=1;
parent :=Self;
Caption :=FCaptionUp;
OnClick :=UpClick;
end;
FButtonDown :=TBitbtn.Create (self);
with FButtonDown do
begin
width :=FWidthButton;
height :=15;
Font :=FFontButtons;
top :=1;
parent :=Self;
Caption :=FCaptionDown;
OnClick :=DownClick;
end;
FProportional :=True;
ControlStyle := ControlStyle - [csSetCaption];
FIncrement := 1;
Text :='0';
end;

destructor TNewDBSpinEdit.Destroy;
begin
FButtonUP.Free;
FbuttonDown.Free;
inherited Destroy;
end;

procedure TNewDBSpinEdit.DownClick(Sender: TObject);
begin
if ReadOnly then MessageBeep(0) else Value := Value - FIncrement;
EditCanModify;
end;

procedure TNewDBSpinEdit.setCaptionDown(const Value: String);
begin
if FCaptionDown<>value then FCaptionDown:=Value;
FButtonDown.Caption:=FCaptionDown;
end;

procedure TNewDBSpinEdit.setCaptionUp(const Value: String);
begin
if FCaptionUp<>value then FCaptionUp:=Value;
FButtonUp.Caption:=FCaptionUp;
end;

procedure TNewDBSpinEdit.setProportional(const Value: Boolean);
begin
if FProportional<>value then FProportional:=Value;
end;

procedure TNewDBSpinEdit.SetValue(NewValue: Integer);
begin
Text := IntToStr (CheckValue (NewValue));
EditText := Text; { força update }
end;

procedure TNewDBSpinEdit.setWidthButton(const Value: Integer);
begin
if FWidthButton<>value then FWidthButton:=Value;
autofit;
end;

function TNewDBSpinEdit.GetOnButtonDownClick: TNotifyEvent;
begin
Result := FButtonDown.OnClick;
end;

function TNewDBSpinEdit.GetOnButtonUpClick: TNotifyEvent;
begin
Result := FButtonUP.OnClick;
end;

function TNewDBSpinEdit.GetValue: LongInt;
begin
try
Result := StrToInt (Text);
except
Result := FMinValue;
end;
end;

function TNewDBSpinEdit.IsValidChar(Key: Char): Boolean;
begin
Result := (Key in ['+', '-', '0'..'9']) or ((Key < #32) and (Key <> Chr(VK_RETURN)));
if not FEditorEnabled and Result and ((Key >= #32) or (Key = Char(VK_BACK)) or (Key = Char(VK_DELETE))) then Result := False;
end;

procedure TNewDBSpinEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
if Key = VK_UP then UpClick (Self) else if Key = VK_DOWN then DownClick (Self);
inherited KeyDown(Key, Shift);
end;

procedure TNewDBSpinEdit.KeyPress(var Key: Char);
begin
if not IsValidChar(Key) then
begin
Key := #0;
MessageBeep(0)
end;
if Key <> #0 then inherited KeyPress(Key);
end;

procedure TNewDBSpinEdit.SetOnButtonDownClick(Value: TNotifyEvent);
begin
FButtonDown.onClick := Value;
end;

procedure TNewDBSpinEdit.SetOnButtonUpClick(Value: TNotifyEvent);
begin
FButtonUP.onClick := Value;
end;

procedure TNewDBSpinEdit.SetGlyph(const Value: TBitmap);
begin
FButtonUp.Glyph.assign(Value);
end;

procedure TNewDBSpinEdit.SetGlyphDown(const Value: TBitmap);
begin
FButtonDown.Glyph.assign(Value);
end;

function TNewDBSpinEdit.GetGlyph: TBitmap;
begin
result:=FButtonUp.Glyph;
end;

function TNewDBSpinEdit.GetGlyphDown: TBitmap;
begin
result:=FButtonDown.Glyph;
end;

procedure TNewDBSpinEdit.CreateWnd;
begin
inherited;
autofit;
end;

procedure TNewDBSpinEdit.autofit;
begin
FbuttonUP.top:=1;
FbuttonUP.Height :=height-6;
FButtonUp.Font:=FFontButtons;
if FProportional then FButtonUp.Width:=FbuttonUP.Height
else FButtonUp.Width:=FWidthButton;
FbuttonUP.Left := Width-FButtonUP.width-5;
FbuttonDown.top:=1;
FButtonDown.Font:=FFontButtons;
FbuttonDown.Height :=height-6;
if FProportional then FButtonDown.Width:=FButtonDown.Height
else FButtonDown.Width:=FWidthButton;
FbuttonDown.Left := 1;
Self.Perform(EM_SETMARGINS,EC_LEFTMARGIN,(FButtonDown.Width+4));
Self.Perform(EM_SETMARGINS,EC_RIGHTMARGIN,(FButtonUP.Width+4)*$10000);
Self.Repaint;
end;

procedure TNewDBSpinEdit.TextChanged(sender: TObject);
begin
Autofit;
end;

procedure TNewDBSpinEdit.UpClick(Sender: TObject);
begin
if ReadOnly then MessageBeep(0) else
Value := Value + FIncrement;
EditCanModify;
end;

end.


El otro

//Este componente deriva de los componentes NewDbedit,´JanbuttonEdit y DbSpinEdit

unit NewDBSpinEditDouble;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, DBneweditjl , mask, DbTables, DB, DBCtrls;

type
TNewDBSpinEditDouble = class(TDBNewEditJL)
private
FButtonUp : TBitBtn;
FButtonDown : TBitBtn;
FWidthButton : Integer;
FCaptionUp : String;
FCaptionDown : String;
FProportional : Boolean;
FMinValue : Double;
FMaxValue : Double;
FIncrement : Double;
FEditorEnabled: Boolean;
FFontButtons : TFont;
FDecimals : Integer;
procedure SetGlyph(const Value: TBitmap);
function GetGlyph:TBitmap;
procedure SetGlyphDown(const Value: TBitmap);
function GetGlyphDown:TBitmap;
procedure autofit;
procedure TextChanged(sender: TObject);
procedure setCaptionUp(const Value:String);
procedure setCaptionDown(const Value:String);
procedure setWidthButton(const Value:Integer);
procedure setProportional(const Value:Boolean);
function GetValue: Double;
procedure SetValue (NewValue: Double);
function CheckValue (NewValue: Double): Double;
procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure WMPaste(var Message: TWMPaste); message WM_PASTE;
procedure WMCut(var Message: TWMCut); message WM_CUT;
procedure setDecimals(const Value:Integer);
protected
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure CreateWnd;override;
function GetOnButtonUpClick: TNotifyEvent;
function GetOnButtonDownClick: TNotifyEvent;
procedure SetOnButtonUpClick(Value: TNotifyEvent);
procedure SetOnButtonDownClick(Value: TNotifyEvent);
procedure KeyPress(var Key: Char); override;
function IsValidChar(Key: Char): Boolean; virtual;
procedure UpClick (Sender: TObject); virtual;
procedure DownClick (Sender: TObject); virtual;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property OnButtonUpClick: TNotifyEvent read GetOnButtonUpClick write SetOnButtonUpClick;
property OnButtonDownClick: TNotifyEvent read GetOnButtonDownClick write SetOnButtonDownClick;
property GlyphUP :TBitmap read GetGlyph write SetGlyph;
property GlyphDown :TBitmap read GetGlyphDown write SetGlyphDown;
property CaptionUp :String read FCaptionUp write SetCaptionUp;
property CaptionDown :String read FCaptionDown write SetCaptionDown;
property WidthButton :Integer read FWidthButton write SetWidthButton default 15;
property Proportional :Boolean read FProportional write SetProportional default True;
property MaxValue :Double read FMaxValue write FMaxValue;
property MinValue :Double read FMinValue write FMinValue;
property Value :Double read GetValue write SetValue;
property Increment :Double read FIncrement write FIncrement;
property FontButtons :TFont read FFontButtons write FFontButtons;
property Decimals :Integer read FDecimals write SetDecimals;
end;

procedure Register;

implementation

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

procedure TNewDBSpinEditDouble.WMCut(var Message: TWMCut);
begin
if not FEditorEnabled or ReadOnly then Exit;
inherited;
end;
//
procedure TNewDBSpinEditDouble.WMPaste(var Message: TWMPaste);
begin
if not FEditorEnabled or ReadOnly then Exit;
inherited;
end;
//
procedure TNewDBSpinEditDouble.WMSize(var Message: TWMSize);
begin
inherited;
autofit;
end;
//
function TNewDBSpinEditDouble.CheckValue(NewValue: Double): Double;
begin
Result := NewValue;
if (FMaxValue <> FMinValue) then
begin
if NewValue < FMinValue then Result := FMinValue
else if NewValue > FMaxValue then Result := FMaxValue;
end;
end;
//
procedure TNewDBSpinEditDouble.CMEnter(var Message: TCMGotFocus);
begin
if AutoSelect and not (csLButtonDown in ControlState) then
SelectAll;
inherited;
end;
//
procedure TNewDBSpinEditDouble.CMExit(var Message: TCMExit);
begin
inherited;
if CheckValue (Value) <> Value then
SetValue (Value);
end;

constructor TNewDBSpinEditDouble.Create(AOwner: TComponent);
begin
inherited;
width :=121;
height :=24;
FCaptionDown :='q';
FCaptionUp :='p';
FWidthButton :=15;
FontButtons :=TFont.Create;
with FFontButtons do
begin
Name :='wingdings 3';
Size :=7;
end;
FButtonUP :=TBitbtn.Create (self);
with FButtonUP do
begin
width :=FWidthButton;
height :=15;
Font :=FFontButtons;
top :=1;
parent :=Self;
Caption :=FCaptionUp;
OnClick :=UpClick;
end;
FButtonDown :=TBitbtn.Create (self);
with FButtonDown do
begin
width :=FWidthButton;
height :=15;
Font :=FFontButtons;
top :=1;
parent :=Self;
Caption :=FCaptionDown;
OnClick :=DownClick;
end;
FProportional :=True;
ControlStyle := ControlStyle - [csSetCaption];
FIncrement := 0.01;
Text :='0,00';
FDecimals :=2;
end;

destructor TNewDBSpinEditDouble.Destroy;
begin
FButtonUP.Free;
FbuttonDown.Free;
FFontButtons.Free;
inherited Destroy;
end;

procedure TNewDBSpinEditDouble.DownClick(Sender: TObject);
begin //para bd
if ReadOnly then MessageBeep(0)
else
Value := Value - FIncrement;
EditCanModify;
end;

procedure TNewDBSpinEditDouble.setCaptionDown(const Value: String);
begin
if FCaptionDown<>value then FCaptionDown:=Value;
FButtonDown.Caption:=FCaptionDown;
end;

procedure TNewDBSpinEditDouble.setCaptionUp(const Value: String);
begin
if FCaptionUp<>value then FCaptionUp:=Value;
FButtonUp.Caption:=FCaptionUp;
end;

procedure TNewDBSpinEditDouble.setDecimals(const Value: Integer);
begin
if (value>4) or (Value<0) then
begin
MessageBeep(1000);
ShowMessage('Los valores de este apartado estan entre 0 y 4 decimales');
end else if FDecimals<>value then FDecimals:=Value;
end;
//
procedure TNewDBSpinEditDouble.setProportional(const Value: Boolean);
begin
if FProportional<>value then FProportional:=Value;
end;
//
procedure TNewDBSpinEditDouble.SetValue(NewValue: Double);
begin
Text := FloatToStr (CheckValue (NewValue));
EditText := Text; { força update }
case FDecimals of
0:Self.Text:=FormatFloat('#0',Self.Value);
1:Self.Text:=FormatFloat('#0.0',Self.Value);
2:Self.Text:=FormatFloat('#0.#0',Self.Value);
3:Self.Text:=FormatFloat('#0.##0',Self.Value);
4:Self.Text:=FormatFloat('#0.###0',Self.Value);
end;
end;

procedure TNewDBSpinEditDouble.setWidthButton(const Value: Integer);
begin
if FWidthButton<>value then FWidthButton:=Value;
autofit;
end;

function TNewDBSpinEditDouble.GetOnButtonDownClick: TNotifyEvent;
begin
Result := FButtonDown.OnClick;
end;
//
function TNewDBSpinEditDouble.GetOnButtonUpClick: TNotifyEvent;
begin
Result := FButtonUP.OnClick;
end;
//
function TNewDBSpinEditDouble.GetValue: Double;
begin
try
Result := StrToFloat (Text);
except
Result := FMinValue;
end;
end;
//
function TNewDBSpinEditDouble.IsValidChar(Key: Char): Boolean;
begin
Result := (Key in [DecimalSeparator, '+', '-', '0'..'9']) or ((Key < #32) and (Key <> Chr(VK_RETURN)));
if not FEditorEnabled and Result and ((Key >= #32) or (Key = Char(VK_BACK)) or (Key = Char(VK_DELETE))) then Result := False;
end;
//
procedure TNewDBSpinEditDouble.KeyDown(var Key: Word; Shift: TShiftState);
begin
if Key = VK_UP then UpClick (Self) else if Key = VK_DOWN then DownClick (Self);
inherited KeyDown(Key, Shift);
end;
//
procedure TNewDBSpinEditDouble.KeyPress(var Key: Char);
begin
if not IsValidChar(Key) then
begin
Key := #0;
MessageBeep(0)
end;
if Key <> #0 then inherited KeyPress(Key);
end;
//
procedure TNewDBSpinEditDouble.SetOnButtonDownClick(Value: TNotifyEvent);
begin
FButtonDown.onClick := Value;
end;
//
procedure TNewDBSpinEditDouble.SetOnButtonUpClick(Value: TNotifyEvent);
begin
FButtonUP.onClick := Value;
end;
//
procedure TNewDBSpinEditDouble.SetGlyph(const Value: TBitmap);
begin
FButtonUp.Glyph.assign(Value);
end;
//
procedure TNewDBSpinEditDouble.SetGlyphDown(const Value: TBitmap);
begin
FButtonDown.Glyph.assign(Value);
end;
//
function TNewDBSpinEditDouble.GetGlyph: TBitmap;
begin
result:=FButtonUp.Glyph;
end;
//
function TNewDBSpinEditDouble.GetGlyphDown: TBitmap;
begin
result:=FButtonDown.Glyph;
end;
//
procedure TNewDBSpinEditDouble.CreateWnd;
begin
inherited;
autofit;
end;

procedure TNewDBSpinEditDouble.autofit;
begin
FbuttonUP.top:=1;
FbuttonUP.Height :=height-6;
FButtonUp.Font:=FFontButtons;
if FProportional then FButtonUp.Width:=FbuttonUP.Height
else FButtonUp.Width:=FWidthButton;
FbuttonUP.Left := Width-FButtonUP.width-5;
FbuttonDown.top:=1;
FButtonDown.Font:=FFontButtons;
FbuttonDown.Height :=height-6;
if FProportional then FButtonDown.Width:=FButtonDown.Height
else FButtonDown.Width:=FWidthButton;
FbuttonDown.Left := 1;
case FDecimals of
0:Self.Text:=FormatFloat('#0',Self.Value);
1:Self.Text:=FormatFloat('#0.0',Self.Value);
2:Self.Text:=FormatFloat('#0.#0',Self.Value);
3:Self.Text:=FormatFloat('#0.##0',Self.Value);
4:Self.Text:=FormatFloat('#0.###0',Self.Value);
end;
Self.Perform(EM_SETMARGINS,EC_LEFTMARGIN,(FButtonDown.Width+4));
Self.Perform(EM_SETMARGINS,EC_RIGHTMARGIN,(FButtonUP.Width+4)*$10000);
Self.Repaint;
end;

procedure TNewDBSpinEditDouble.TextChanged(sender: TObject);
begin
Autofit;
end;
//
procedure TNewDBSpinEditDouble.UpClick(Sender: TObject);
begin
if ReadOnly then MessageBeep(0) else
Value := Value + FIncrement;
EditCanModify;
end;

end.

Espero os sean de utilidad.

José Luis Garcí
16-07-2013, 09:18:26
Hola compañeros, estoy un poco liado y en breve se supone que saldré de viaje, intentare poneros algo más antes de irme, pero de momento aquí tenéis un cambio que hay que realizar en la tabla documentos, hay que añadir el campo

PORCENTAJEFINANCIADO POR /* POR = NUMERIC(15,4) */

Casimiro Notevi
16-07-2013, 09:57:29
El trabajo es lo primero, y más hoy en día ^\||/

José Luis Garcí
16-07-2013, 11:59:24
Aquí subo una pantalla de como va quedando la pantalla de documentos

http://nsae01.casimages.net/img/2013/07/16/130716112123834473.jpg (http://www.casimages.es/i/130716112123834473.jpg.html)

Como podéis ver me he basado, en la que utilizaba en mi anterior programa, pero esta ya empieza a tener sus diferencias y espero no llegar a las 3000 lineas de código como en la otra, se que pueden parecer muchas, pero hay que tener en cuenta todo lo que controlamos., no pondré el código, hasta que más o menos empiece a estar operativa, pero iré poniendo vistas de como va quedando y lo que empieza a tener operativo.

José Luis Garcí
18-07-2013, 11:08:00
Bueno comencemos describiendo y poniendo el código de diferentes partes, ya que el código entero no lo pondré hasta el final. Es muy probable que el código de una función o procedure vaya modificándose según avancemos, ya iré explicando por que. Lo ire haciendo en diferentes post, para que quede un poco más esquematizado.


Lo primero será la forma de llamarlo, ya hemos visto la function Acceso, que nos habré los form, según sea nuestro nivel de usuario, con lo que evitamos mayores controles de usuarios y tener que estar poniendo o quitando accesos y ademas gracias al nivel de usuario, también podemos ocultar o mostrar ciertos datos en nuestro form de una manera bastante simple.

Veamos la llamada a facturas

procedure TFMenu.act_V_FacturasExecute(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************************[ Facturas ]****
// Gestión de facturas apto desde nivel 6
//------------------------------------------------------------------------------
begin
VarSTipoDocumento:='FACTURA';
FXPAF.PC.ActivePageIndex:=0;
FXPAF.PC2.ActivePageIndex:=0;
Acceso(6,FXPAF);
end;

como podemos ver la linea

VarSTipoDocumento:='FACTURA';

llama a una variable del formulario FXPAF, especificando el tipo de documento que es, de esta manera especificamos que documento tenemos seleccionado, ya que como os recuerdo, dentro de la tabla manejaremos 4 tipos de documentos diferentes.

Ademas nos aseguramos de colocar los Pagecontrol en página general, ya que podemos haber cambiado de una página/documento a otra al salir y volver a entrar.

José Luis Garcí
18-07-2013, 11:30:51
Vamos ahora con el botón nuevo, este es el código
procedure TFXPAF.SbNuevoClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Creamos un nuevo registro ]******
//------------------------------------------------------------------------------

begin
PC.ActivePageIndex:=1;
DSPrincipal.DataSet.Insert;
NSESerie.Value:=1;
if DM.IBDCONFIUSARSERIEYEAR.Value='S' then
begin
NSESerie.Enabled:=False;
DBNSerie.Field.Value:=Copy(IntToStr(Ano(now)),3,4);
end else
begin
NSESerie.Enabled:=True;
DBNSerie.Field.Value:=DM.IBDCONFISERIE.AsString;
end;
DBNNumeroDocumento.Field.value:=VerNumeroDocumento(VarSTipoDocumento,DBNSerie.Text);
DBNSerie.SetFocus;
end;

Como podemos ver lo primero es activar el pagecontrol en datos, abrimos inserción de registro en la tabla, ponemos el TNewSpinEdit (NSESerie) en value a 1*, y pasamos a comprobar si en configuración hemos dicho de usar el año como serie, si es así cogemos los 2 últimos dígitos del año en curso, en caso contrario cogemos el valor de la serie por defecto que es la del campo Serie de la tabla de configuración, hecho esto pasamos a mostrar el número de documento perteneciente y pasamos el foco.

* este componente lo activamos o desactivamos ya que su uso es solo para poder elegir entre los tres seriales, por lo que si usamos el año como serie no nos es útil.

También hacemos un llamada a nuestra function VerNumeroDocumento, aquí su código.

function TFXPAF.VerNumeroDocumento(Tipo, Serie:string):string;
//------------------------------------------------------------------------------
//*****************************************************[ VerNumeroDocumento]****
// Funcion para este módulo
//------------------------------------------------------------------------------
var VarILargoSerie, VarINumero:Integer;
begin
VarILargoSerie:=Length(Serie);
if Tipo='FACTURA' then if DM.IBDCONFINUMEROFACTURA.Text='0' then VarINumero:=1 else VarINumero:=dm.IBDCONFINUMEROFACTURA.AsInteger+1;
if Tipo='ALBARAN' then if DM.IBDCONFINUMEROALBARAN.Text='0' then VarINumero:=1 else VarINumero:=dm.IBDCONFINUMEROALBARAN.AsInteger+1;
if Tipo='PEDIDO' then if DM.IBDCONFINUMEROPEDIDO.Text='0' then VarINumero:=1 else VarINumero:=dm.IBDCONFINUMEROPEDIDO.AsInteger+1;
if Tipo='PRESUPUESTO' then if DM.IBDCONFINUMEROPRESUPUESTO.Text='0' then VarINumero:=1 else VarINumero:=dm.IBDCONFINUMEROPRESUPUESTO.AsInteger+1;
Result:=ceros(IntToStr(VarINumero),dm.IBDCONFILAGONUMEROS.Value-VarILargoSerie)
end;


El primer parámetro que le pasamos es el valor de nuestra variable que nos indica el tipo de documento y que la cargamos al entrar desde el menú o otro lado al documento, el segundo es la serie. Esta function lo que hace es comprobar el numerador de cada tipo de documento, si es cero cargamos como 1, en caso contrario, sera el número actual más 1, al devolvernos el resultado, nos aseguramos que nos lo devuelva relleno de ceros a la izquierda, y descontamos los espacios que va a ocupar la serie.

José Luis Garcí
18-07-2013, 12:22:25
Pongo nueva mente la imagen del formulario para ir orientándonos

http://nsae01.casimages.net/img/2013/07/16/130716112123834473.jpg (http://www.casimages.es/i/130716112123834473.jpg.html)

Estamos en el campo serie, al lado esta el spinedit, que activamos o desactivamos, según nos es necesario, de aqui pasamos al número de documento que tiene los dos siguientes eventos,

procedure TFXPAF.DBNNumeroDocumentoChange(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************[ Cambia el nº de documento ]****
//------------------------------------------------------------------------------
begin
LAbel44.Caption:='[ '+Trim(DBNSerie.Text)+DBNNumeroDocumento.Text+' ]';
end;

procedure TFXPAF.DBNNumeroDocumentoExit(Sender: TObject);
// ------------------------------------------------------------------------------
// ***************************************************[ Salir del Núm. Doc. ]****
// Muestra el número de documento
// ------------------------------------------------------------------------------
begin
if not (DsPrincipal.DataSet.State in [dsEdit]) then
begin
ActQuery(IBQBuscarNumeroDocumento,'Select * From DOCUMENTOS where WHERE (DOCUMENTOS.TIPODOCUMENTO = '+QuotedStr(VarSTipoDocumento)+
') AND (DOCUMENTOS.NUMERODOCUMENTO = '+QuotedStr(DBNNumeroDocumento.Text) +
') AND (DOCUMENTOS.SERIE = '+QuotedStr(DBNSerie.Text)+')');
if not IBQBuscarNumeroDocumento.IsEmpty then
begin
ShowMessage('Este número de documento ya existe');
DBNNumeroDocumento.SetFocus;
end;
end;
end;


El 1º de los eventos, nuestra como queda el número de documento con la serie, el 2º evento crea una búsqueda en un querry para comprobar si el documento ya existe, para ello debemos comprobar, el tipo de documento, el número, asignado y la serie ala que pertenece, ya que recordemos, que es la misma tabla para varios documentos diferentes.
pasamos a la fecha, que al usar el componente DbNewEditJl y estar en Onlydate, controla que sea una fecha válida, nos permite que al entrar tenga la fecha actual y que podamos cambiar la fecha pulsando flecha arriba o abajo.

José Luis Garcí
18-07-2013, 13:16:53
Seguimos entrando en el código del cliente, que tiene los siguientes 3 eventos


procedure TFXPAF.DBNCodigoClienteChange(Sender: TObject);
// ------------------------------------------------------------------------------
// ********************************************************[ Change Cod Cli ]****
// Para posicionar en el cliente
// ------------------------------------------------------------------------------
begin
if FXPAF.Active then
begin
if DBNCodigoCliente.Text <> '' then
begin
ActQuery(IBQClientes, 'Select * from Clientes where Upper(CODIGO)=Upper(' + QuotedStr (DBNCodigoCliente.Text) + ')');
end;
end;
end;


procedure TFXPAF.DBNCodigoClienteEnter(Sender: TObject);
// ------------------------------------------------------------------------------
// ****************************************************[ entrar en clientes ]****
// ------------------------------------------------------------------------------
begin
SBClientesClick(Sender);
end;


procedure TFXPAF.DBNCodigoClienteExit(Sender: TObject);
// ------------------------------------------------------------------------------
// *************************************************[ Salir de cód. cliente ]****
// ------------------------------------------------------------------------------
begin
if DBNCodigoCliente.Text = '' then
begin
ShowMessage('Este campo no puede quedar vacio, por favor rellene l campo [Código de cliente]');
DBNCodigoCliente.SetFocus;
end else
begin
if UpperCase(DBNCodigoCliente.Text)='B' then SBBuscarClienteClick(Sender) else
begin
if IBQClientes.IsEmpty then
begin
Case Application.MessageBox(pchar( 'El cliente búscado no se encuntra, ¿desea crearlo?'),
pchar('No se encuentra el cliente'),4+32+0) of
6:SBNuevoClienteClick(Sender); //Si
7:DBNCodigoCliente.SetFocus; //No
end;
end else
begin
//Descripción del cliente
if DBNNombreCliente.Text='' then DBNNombreCliente.Field.Value:=IBQClientesNOMBRE.Value else
begin
if DBNNombreCliente.Text<>IBQClientesNOMBRE.AsString then
begin
Case Application.MessageBox( pchar( 'El nombre de este cliente y el que tiene puesto no coinciden, ¿desea cambiarlo por el nombre que tiene asignado este código?'),
pchar('Datos diferentes'),4+64+0) of
6:DBNNombreCliente.Field.Value:=IBQClientesNOMBRE.Value; //Si
end;
end;
end;
//Forma de pago
if DBNFormaPago.Text='' then DBNFormaPago.Field.Value:=IBQClientesFORMAPAGO.Value else
begin
if DBNFormaPago.Text<>IBQClientesFORMAPAGO.AsString then
begin
Case Application.MessageBox( pchar( 'La forma de pago de este cliente y el que tiene puesta no coinciden, ¿desea cambiarlo por la que tiene asignado este código?'),
pchar('Datos diferentes'),4+64+0) of
6:DBNFormaPago.Field.Value:=IBQClientesFORMAPAGO.Value; //Si
end;
end;
end;
end;
end;
end;
end;



En el 1º evento, comprobamos que el form este activo, para evitar errores y si el código del cliente no esta vació, creamos una búsqueda con un querry, esta nos permitirá tener otros datos a la vista del cliente, tanto en los siguientes campos, como en la pagecontrol de datos extendidos (PC3).
En el 2º evento, colocamos los datos visibles del cliente en el PC3.
y en el 3º evento, hacemos varias cosas, primero que no se quede vació, en caso contrario si hemos puesto una B únicamente llamamos al módulo de búsqueda para el cliente, en caso contrario al de la búsqueda, comprobamos si existe, si no es asi nos avisa y posiciona nuevamente, en caso de que exista, comprueba si ya tenemos relleno uina descripción o forma de pago del cliente, si no existe la pone y si existe comprueba si cuadra con la que tiene el cliente, en caso de ser diferentes, nos da la opción de modificarla por la que tiene el cliente o mantener la que ya tiene.

Pasaríamos al Nombre del cliente, este campo ha de ser editable y guardado independiente al del la tabla clientes, imaginemos el siguiente caso, tenemos el cliente código 0 (contado) y en un día de reparto tenemos 3 clientes con este código, en cambio podríamos editar en cada documento con Contado, Juan, Contado limpiadora Hotel XXXxxx, etc.

De aquí pasamos a la forma de pago que pasa con lo mismo que con el nombre del cliente, el caso típico es un cliente que tiene una forma de pago x y quiere en una factura determinada pagarla de contado.

En cuanto alos botones de nuevos y búsqueda, ya los veremos más adelante.

Creo que ya es bastante por hoy.

José Luis Garcí
18-07-2013, 13:25:54
Pequeñas correcciones en


procedure TFXPAF.DBNCodigoClienteExit(Sender: TObject);
//... Cambiar
ShowMessage('Este campo no puede quedar vacio, por favor rellene l campo [Código de cliente]');
//...por
ShowMessage('Este campo no puede quedar vacio, por favor rellene el campo [Código de cliente]');

y en

procedure TFXPAF.DBNNumeroDocumentoExit(Sender: TObject);

//...Cambiar
ActQuery(IBQBuscarNumeroDocumento,'Select * From DOCUMENTOS where WHERE (DOCUMENTOS.TIPODOCUMENTO = '+QuotedStr(VarSTipoDocumento)+
') AND (DOCUMENTOS.NUMERODOCUMENTO = '+QuotedStr(DBNNumeroDocumento.Text) +
') AND (DOCUMENTOS.SERIE = '+QuotedStr(DBNSerie.Text)+')');
//...por
ActQuery(IBQBuscarNumeroDocumento,'Select * From DOCUMENTOS WHERE (DOCUMENTOS.TIPODOCUMENTO = '+QuotedStr(VarSTipoDocumento)+
') AND (DOCUMENTOS.NUMERODOCUMENTO = '+QuotedStr(DBNNumeroDocumento.Text) +
') AND (DOCUMENTOS.SERIE = '+QuotedStr(DBNSerie.Text)+')');



Os pido disculpas pues he visto varias faltas de ortografía, pero es el corrector de texto, que no se que problema tiene pero ha incluido varias palabras en el diccionario y me las cambia automáticamente, ya por defecto escribo y suele comerme o poner alguna letra demás y se que cometo varias faltas ortográficas.

José Luis Garcí
18-07-2013, 17:20:39
Supongo va quedando todo claro, ya que no veo preguntas, ni a nadie con la antorcha corriendo detrás de mi :D:D:D:D.

Por cierto espero vuestras valoraciones

José Luis Garcí
20-07-2013, 13:13:50
Ahora seguimos con el comercial o agente, comenzamos con el código del comercial con los siguientes tres eventos



procedure TFXPAF.DBNCodigoComercialChange(Sender: TObject);
// ------------------------------------------------------------------------------
// **************************************************[ Change Cod Comercial ]****
// ------------------------------------------------------------------------------
begin

if FXPAF.Active then
begin
if DBNCodigoComercial.Text <> '' then
begin
ActQuery(IBQAgentes, 'Select * from EMPLEADOS where (EMPLEADOS.AGENTE = '+QuotedStr('S')+') AND (Upper(EMPLEADOS.CODIGO)=Upper('+
QuotedStr(DBNCodigoComercial.Text) + '))');
end;
end;
end;

procedure TFXPAF.DBNCodigoComercialEnter(Sender: TObject);
// ------------------------------------------------------------------------------
// *************************************************[ entrar en comerciales ]****
// ------------------------------------------------------------------------------
begin
SBComercialesClick(Sender);
end;

procedure TFXPAF.DBNCodigoComercialExit(Sender: TObject);
// ------------------------------------------------------------------------------
// ***********************************************[ Salir de cód. Comercial ]****
// ------------------------------------------------------------------------------
begin
if DBNCodigoComercial.Text = '' then
begin
ShowMessage('Este campo no puede quedar vacio, por favor rellene el campo [Código de ccomercial]');
DBNCodigoComercial.SetFocus;
end else
begin
if UpperCase(DBNCodigoComercial.Text)='B' then SBBuscarAgenteClick(Sender) else
begin
if IBQAgentes.IsEmpty then
begin
Case Application.MessageBox(pchar( 'El comercial buscado no se encuentra, ¿desea crearlo?'),
pchar('No se encuentra el comercial'),4+32+0) of
6:SBNuevoAgenteClick(Sender); //Si
7:DBNCodigoComercial.SetFocus; //No
end;
end else
begin //Descripción del c
if DBNNombreComercial.Text='' then DBNNombreComercial.Field.Value:=IBQAgentes.FieldByName('NOMBRE').Value else
begin
if DBNNombreComercial.Text<>IBQAgentes.FieldByName('NOMBRE').AsString then
begin
Case Application.MessageBox( pchar( 'El nombre de este comercial y el que tiene puesto no coinciden, ¿desea cambiarlo por el nombre que tiene asignado este código?'),
pchar('Datos diferentes'),4+64+0) of
6:DBNNombreComercial.Field.Value:=IBQagentes.FieldByName('NOMBRE').Value; //Si
end;
end;
end;
end;
end;
end;
end;



El 1º evento, como podemos ver el primero según escribimos, nos va buscando el agente, pero sólo si es un agente ya que esta en la misma tabla que el resto de empleados
El 2º evento, posiciona la pestaña de datos auxiliares en los datos del comercial
Y el 3º evento, comprueba a la salida , si no esta vacio, si debemos buscarlo y si no tiene datos el campo nombre lo rellena y si lo tiene pero es diferente, nos pregunta si deseamos cambiarlo.

José Luis Garcí
20-07-2013, 13:16:33
Ups!, se me olvidó en la tabla de empleados, el campo NIF, lo tendréis que añadir

NIF T20 /* T20 = VARCHAR(20) */

José Luis Garcí
20-07-2013, 15:19:15
Tenemos que cambiar un procedure, de los anteriores por este

procedure TFXPAF.DBNCodigoComercialChange(Sender: TObject);
// ------------------------------------------------------------------------------
// **************************************************[ Change Cod Comercial ]****
// ------------------------------------------------------------------------------
begin
if FXPAF.Active then
begin
if DBNCodigoComercial.Text <> '' then
begin
ActQuery(IBQAgentes, 'Select * from EMPLEADOS where (EMPLEADOS.AGENTE = '+QuotedStr('S')+') AND (Upper(EMPLEADOS.CODIGO)=Upper('+
QuotedStr(DBNCodigoComercial.Text) + '))');
if Not IBQAgentes.IsEmpty then ActQuery(IBQAgenteIMAGEN, 'Select * from PC where (PC.MODULO = '+QuotedStr('EMPLEADOS')+') AND (Upper(PC.CODIGO)=Upper('+
QuotedStr(DBNCodigoComercial.Text) + '))');
end;
end;
end;

ya que si no no podíamos mostrar la imagen del comercial

José Luis Garcí
20-07-2013, 15:44:16
Este es el evento para cuando cambiamos de ´numero de serie, al lado de la serie, se me había pasado

procedure TFXPAF.NSESerieChange(Sender: TObject);
//------------------------------------------------------------------------------
//***************************************************[ Cambiar la serie ]*******
//------------------------------------------------------------------------------
begin
case NSESerie.Value of
1:DBNSerie.Field.Value:=DM.IBDCONFISERIE.Value;
2:DBNSerie.Field.Value:=DM.IBDCONFISERIE2.Value;
3:DBNSerie.Field.Value:=DM.IBDCONFISERIE3.Value;
end;
end;

José Luis Garcí
20-07-2013, 16:25:58
Otra modificación esta vez en SbNuevoClick

procedure TFXPAF.SbNuevoClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Creamos un nuevo registro ]******
//------------------------------------------------------------------------------
begin
...
NDBSENumeroProteccionDatos.Field.Value:=1; //añadimos esta linea antes de
DBNNumeroDocumento.Field.value:=VerNumeroDocumento(VarSTipoDocumento,DBNSerie.Text);
DBNSerie.SetFocus;
end;

José Luis Garcí
20-07-2013, 16:43:32
Cambios en mis componentes spinedit en el create, dentro de la creación de lo botones añadimos a cada uno la siguiente linea

TabStop :=False;

Con esto evitamos que los botones UP y Down, reciban el foco.

Pongo el código del create de uno de ellos, sabéis lo que tenéis que hacer para cambiarlos en los demás



constructor TNewDBSpinEdit.Create(AOwner: TComponent);
begin
inherited;
width :=121;
height :=24;
FCaptionDown :='q';
FCaptionUp :='p';
FWidthButton :=15;
FontButtons :=TFont.Create;
with FFontButtons do
begin
Name :='wingdings 3';
Size :=7;
end;
FButtonUP :=TBitbtn.Create (self);
with FButtonUP do
begin
width :=FWidthButton;
height :=15;
Font :=FFontButtons;
top :=1;
parent :=Self;
Caption :=FCaptionUp;
OnClick :=UpClick;
OnKeyPress :=Self.OnKeyPress;
OnKeyDown :=Self.OnKeyDown;
TabStop :=False;
end;
FButtonDown :=TBitbtn.Create (self);
with FButtonDown do
begin
width :=FWidthButton;
height :=15;
Font :=FFontButtons;
top :=1;
parent :=Self;
Caption :=FCaptionDown;
OnClick :=DownClick;
OnKeyPress :=Self.OnKeyPress;
OnKeyDown :=Self.OnKeyDown;
TabStop :=False;
end;
FProportional :=True;
ControlStyle := ControlStyle - [csSetCaption];
FIncrement := 1;
Text :='0';
end;

José Luis Garcí
20-07-2013, 16:45:39
Claro esta también debemos adapta el evento KEypress de nuestro formulario

procedure TFXPAF.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 TDBNewEditJL)
or (ActiveControl is TNewDBSpinEdit)
or (ActiveControl is TNewDBSpinEditDouble)
or (ActiveControl is TDBComboBox) then
begin
Key := #0; { anula la puulsación }
Perform(WM_NEXTDLGCTL, 0, 0); { mueve al próximo control }
end;
end;

José Luis Garcí
20-07-2013, 16:46:57
y ya por último hoy el siguiente evento

procedure TFXPAF.NDBSENumeroProteccionDatosChange(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************************[ Cambia la LOPD ]****
// Cambiamos la ley de protección de datos.
//------------------------------------------------------------------------------
begin
if FXPAF.Active then
begin
if NDBSENumeroProteccionDatos.Text='' then NDBSENumeroProteccionDatos.Value:=1;
if not ((NDBSENumeroProteccionDatos.Value<1) or (NDBSENumeroProteccionDatos.Value>3)) then
begin
Memo1.Lines.Clear;
case NDBSENumeroProteccionDatos.Value of
1:Memo1.Lines.Text:=DM.IBDCONFILDPD1.AsString;
2:Memo1.Lines.Text:=DM.IBDCONFILDPD2.AsString;
3:Memo1.Lines.Text:=DM.IBDCONFILDPD3.AsString;
end;
end else
begin
if (DSPrincipal.DataSet.State in [dsEdit,dsInsert]) then
begin
ShowMessage('El rango sólo esta permitido entre 1 y 3');
NDBSENumeroProteccionDatos.SetFocus;
end;
end;
end;
end;

José Luis Garcí
20-07-2013, 16:48:28
Pido disculpas por tantas rectificaciones, pero es que según voy haciendo en caso lo voy subiendo, muchas veces sin haber probado el código primero :o

José Luis Garcí
21-07-2013, 12:11:03
Vamos a hora por el botón "Escribir nota" con el siguiente código

procedure TFXPAF.SBEscribirNotaClick(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************************************[ Nota ]****
//------------------------------------------------------------------------------
var VarSText:string;
begin
VarSText:=DBIBMemo2.Lines.Text;
DBIBMemo2.Lines.Text:=InputMemo('Nota','Escriba su nota',VarSText);
end;

y como no estoy seguro de si puse esta function aquí os la pongo

//------------------------------------------------------------------------------
//*************************************************************[ ImputMemo ]****
// Parte de la idea original de Felipe Monteiro del 25/05/2006
// bajada de http://www.planetadelphi.com.br/dica/5756/input-combo-(simulando-um-inputbox-com-combo)
//------------------------------------------------------------------------------
// J.L.G.T. 06/08/2012 Basando me en el código de Felipe Monteiro , lo adapte a
// mis necesidades, creando un imput para entradas en memo
//------------------------------------------------------------------------------
// [Acaption] String Texto en la barra del caption
// [Aprompt] String Texto aclaratorio para elmensaje o petición
// [Text] String Texto del MEmo
//------------------------------------------------------------------------------
//---EJEMPLO--------------------------------------------------------------------
// procedure TForm1.Button1Click(Sender: TObject);
// begin
// DBMEMO1.lines.text:=InputMemo('Comentario con fecha','Comentario');
// end;
//------------------------------------------------------------------------------
function InputMemo(const ACaption, APrompt: string; Text:String =''): string;
function GetCharSize(Canvas: TCanvas): TPoint;
var
I: Integer;
Buffer: array[0..51] of Char;
begin
for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
Result.X := Result.X div 52;
end;

var
Form: TForm;
Prompt: TLabel;
MEM: TMemo;
DialogUnits: TPoint;
ButtonTop, ButtonWidth, ButtonHeight: Integer;
R: TRect;
begin
Result := '';
Form := TForm.Create(Application);
with Form do
try
Canvas.Font := Font;
DialogUnits := GetCharSize(Canvas);
BorderStyle := bsDialog;
FormStyle :=fsStayOnTop;
Caption := ACaption;
ClientWidth := MulDiv(396, DialogUnits.X, 4);
Position := poScreenCenter;
Prompt := TLabel.Create(Form);
with Prompt do
begin
Parent := Form;
Caption := APrompt;
Left := MulDiv(8, DialogUnits.X, 4);
Top := MulDiv(8, DialogUnits.Y, 8);
Constraints.MaxWidth := MulDiv(180, DialogUnits.X, 4);
WordWrap := True;
end;
MEM := TMemo.Create(Form);
with MEM do
begin
Parent := Form;
Left := Prompt.Left;
Top := Prompt.top+Prompt.Height+5;
Height := 150;
Width := MulDiv(380, DialogUnits.X, 4);
Lines.Text := Text;
end;
ButtonTop := MEM.top+MEM.Height+10;;
ButtonWidth := MulDiv(50, DialogUnits.X, 4);
ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
with TButton.Create(Form) do
begin
Parent := Form;
Caption := 'OK';
ModalResult := mrOk;
default := True;
SetBounds(MulDiv(Prompt.Left-2, DialogUnits.X, 4), ButtonTop, ButtonWidth,
ButtonHeight);
end;
with TButton.Create(Form) do
begin
Parent := Form;
Caption := 'Cancelar';
ModalResult := mrCancel;
Cancel := True;
SetBounds(MulDiv(340, DialogUnits.X, 4), ButtonTop,ButtonWidth, ButtonHeight);
Form.ClientHeight := 220;
end;
MEM.Lines.Clear;
MEM.Lines.Add(Text);
if ShowModal = mrOk then Result:=MEM.Lines.Text
else Result:=Text; //Devuelve el original
finally
Form.Free;
end;
end;

Ahora pasamos al desglose de la factura, explicare la función de algunos botones, el resto son iguales a los de siempre

José Luis Garcí
21-07-2013, 13:22:04
Otra modificación

procedure TFXPAF.SbNuevoClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Creamos un nuevo registro ]******
//------------------------------------------------------------------------------

begin
...
Memo2.Lines.Clear;
DBNSerie.SetFocus;
end;

José Luis Garcí
21-07-2013, 13:23:13
y otra

procedure TFXPAF.SBEscribirNotaClick(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************************************[ Nota ]****
//------------------------------------------------------------------------------
var VarSText:string;
begin
VarSText:=Memo2.Lines.Text;
Memo2.Lines.Text:=InputMemo('Nota','Escriba su nota',VarSText);
end;

José Luis Garcí
21-07-2013, 14:51:45
más y más modificaciones

procedure TFXPAF.DBNCodigoClienteChange(Sender: TObject);
// ------------------------------------------------------------------------------
// ********************************************************[ Change Cod Cli ]****
// Para posicionar en el cliente
// ------------------------------------------------------------------------------
begin
if FXPAF.Active then
begin
if DBNCodigoCliente.Text <> '' then
begin
ActQuery(IBQClientes, 'Select * from Clientes where Upper(CODIGO)=Upper(' + QuotedStr (DBNCodigoCliente.Text) + ')');
if not IBQDirecciones.isempty then ActQuery(IBQDirecciones,'SELECT * FROM DIRECCIONES WHERE (DIRECCIONES.MODULO = '+
QuotedStr ('CLIENTES')+') AND (DIRECCIONES.CODIGO = '+QuotedStr (DBNCodigoCliente.Text)+')');
end;
end;
end;

procedure TFXPAF.SbNuevoClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Creamos un nuevo registro ]******
//------------------------------------------------------------------------------
begin
PC.ActivePageIndex:=1;
DSPrincipal.DataSet.Insert;
NSESerie.Value:=1;
if DM.IBDCONFIUSARSERIEYEAR.Value='S' then
begin
NSESerie.Enabled:=False;
DBNSerie.Field.Value:=Copy(IntToStr(Ano(now)),3,4);
end else
begin
NSESerie.Enabled:=True;
DBNSerie.Field.Value:=DM.IBDCONFISERIE.AsString;
end;
NDBSENumeroProteccionDatos.Field.Value:=1;
DBNNumeroDocumento.Field.value:=VerNumeroDocumento(VarSTipoDocumento,DBNSerie.Text);
DSPrincipal.DataSet.FieldByName('PORCENTAJEFINANCIADO').Value:=0;
DSPrincipal.DataSet.FieldByName('TIPODOCUMENTO').Value:=VarSTipoDocumento;
Memo2.Lines.Clear;
DBNSerie.SetFocus;
end;

kokorski
21-07-2013, 16:10:04
Gracias por tu esfuerzo que te aseguro seguimos muchos con interes

José Luis Garcí
22-07-2013, 09:29:22
Muchas gracias Kokorski, pero si quieres ayudarme haz una valoración del tutorial como solicito en post anteriores, esto me permitirá, junto con la valoración de otros compañeros, a mejorar mis puntos débiles como ya exprese en el siguiente post

Si no es molestia, podrían hacerme el favor de valorar el trabajo hasta este momento, lo más sinceramente posible, el motivo, es que como siempre he dicho y he mantenido, yo no soy un experto y necesito saber cuales son mis puntos fuertes, para intentar mejorar.

Me gustaría que lo valorarais de la siguiente manera, del 1 al 10, siendo 1 la menor valoración claro, cada una de las siguientes facetas, y si se os ocurre alguna, ya sabéis.

Explicaciones
Claridad
Código
Tablas
Descripciones
Diseño
Conceptos
forma de aplicar los conceptos
y utilidad

Esto me permitirá, en cuanto al tutorial, intentar corregir y mejorarlo , si puedo y ha nivel personal, seguir aprendiendo y como no autoestima, que me la podéis hundir más :D :D :D o nivelar :rolleyes:

En las empresas que he estado muchos años, siempre e hecho los programas, de hecho en algunas siguen usándolo, pero realmente no se si tengo nivel suficiente como para dedicarme a la venta de programas, al público en general, este cuestionario, sería un serio indicativo, de si es o no posible que me dedique a ello de manera esporádica.

kokorski
22-07-2013, 20:13:10
Muchas gracias Kokorski, pero si quieres ayudarme haz una valoración del tutorial como solicito en post anteriores, esto me permitirá, junto con la valoración de otros compañeros, a mejorar mis puntos débiles como ya exprese en el siguiente post



En las empresas que he estado muchos años, siempre e hecho los programas, de hecho en algunas siguen usándolo, pero realmente no se si tengo nivel suficiente como para dedicarme a la venta de programas, al público en general, este cuestionario, sería un serio indicativo, de si es o no posible que me dedique a ello de manera esporádica.

No me cabe duda de que estas sobradamente preparado para afrontar cualquier iniciativa, y mas si es dirigida al publlico en general, nada lo demuestra mejor que este aporte que nos estas haciendo a todos de forma desinteresada. No dudes de tu capacidad y adelante con todo....

Explicaciones....... 8
Claridad ........ 8
Código ....... 7
Tablas ...... 7
Descripciones ...... 8
Diseño ........ 5 (esto es muy personal jejeje)
Conceptos ......... 9
forma de aplicar los conceptos ........ 8
y utilidad ...... dependera de cada uno

Saludos

Casimiro Notevi
22-07-2013, 20:44:09
pero realmente no se si tengo nivel suficiente como para dedicarme a la venta de programas, al público en general, este cuestionario, sería un serio indicativo, de si es o no posible que me dedique a ello de manera esporádica.
A la venta, seguro que puedes dedicarte :)
Supongo que quieres decir "a crearlos para venderlos". Si es así, entonces sí que puedes, el usuario final sólo quiere que haga bien lo que tiene que hacer, que lo haga rápido y que sea fácil de hacerlo. Y si es barato, mejor :)
Ahora bien, si lo dices por entrar a formar parte de un equipo de programación, pienso que lo principal que tendrías que cambiar es a usar la nomenclatura que utilicen en ese sitio. En algunos sitios son más estrictos y en otros son más abiertos a que cada uno use su forma habitual.
Ya sabes, la nomenclatura, la notación para las variables, componentes, etc., la forma de escribir el código, incluso los espacios de tabulación para las sangrías del código. Pero todo eso es informarse y usarlo, nada más.
En cuanto a la estética, como siempre, te tienes que habituar a lo que usen en ese lugar, aunque también es normal que haya una persona encargada de "dar el toque" a las pantallas, así cada programador no tiene que esmerarse mucho en ese aspecto.
En general, claro que sí tienes nivel.
Si hacemos una división muy genérica de niveles, podría ser:

0. Gurú
1. Muy avanzado
2. Avanzado
3. Medio
4. Aficionado
5. NovatoQue cada uno se apunte al nivel que quiera :D
Puedes crear una encuesta y comparar según lo que contesten los demás :)

En cuanto a las explicaciones, es como siempre, alguien novato o aficionado puede que no lo entienda muy bien, es normal. Sin embargo, alguien medio o avanzado te entenderá perfectamente.

José Luis Garcí
23-07-2013, 09:25:34
No me cabe duda de que estas sobradamente preparado para afrontar cualquier iniciativa, y mas si es dirigida al publlico en general, nada lo demuestra mejor que este aporte que nos estas haciendo a todos de forma desinteresada. No dudes de tu capacidad y adelante con todo....

...


Saludos

Gracias kokorski, te agradezco tanto el comentario como la valoración.

A la venta, seguro que puedes dedicarte :)
Supongo que quieres decir "a crearlos para venderlos". Si es así, entonces sí que puedes, el usuario final sólo quiere que haga bien lo que tiene que hacer, que lo haga rápido y que sea fácil de hacerlo. Y si es barato, mejor :)
Ahora bien, si lo dices por entrar a formar parte de un equipo de programación, pienso que lo principal que tendrías que cambiar es a usar la nomenclatura que utilicen en ese sitio. En algunos sitios son más estrictos y en otros son más abiertos a que cada uno use su forma habitual.
Ya sabes, la nomenclatura, la notación para las variables, componentes, etc., la forma de escribir el código, incluso los espacios de tabulación para las sangrías del código. Pero todo eso es informarse y usarlo, nada más.
En cuanto a la estética, como siempre, te tienes que habituar a lo que usen en ese lugar, aunque también es normal que haya una persona encargada de "dar el toque" a las pantallas, así cada programador no tiene que esmerarse mucho en ese aspecto.
En general, claro que sí tienes nivel.
Si hacemos una división muy genérica de niveles, podría ser:

0. Gurú
1. Muy avanzado
2. Avanzado
3. Medio
4. Aficionado
5. NovatoQue cada uno se apunte al nivel que quiera :D
Puedes crear una encuesta y comparar según lo que contesten los demás :)

En cuanto a las explicaciones, es como siempre, alguien novato o aficionado puede que no lo entienda muy bien, es normal. Sin embargo, alguien medio o avanzado te entenderá perfectamente.

Muchas gracias Casimiro, de todas maneras, yo considero que soy más nivel Aficionado o medio, que otro, despues de tantos años creo que no puedo considerarme novato y aunque aun me pierdo con muchos conceptos ahí estoy, dando caña para intentar entenderlos.

En cuanto a mi aportación, debo decir que la mayor parte que aporto yo son los conceptos y la aplicación (a mi forma) de ellos al programa, pero no considero que en ningún momento este descubriendo la pólvora, en cuanto al código, ya que este en su mayor parte, es de compañeros del club de libros y de otras páginas en Internet, que mio propio, lo que si he hecho yo es interpretar este y adaptarlo a mis necesidades. Lo mismo pasa con mis componentes.

Claro Casimiro que las explicaciones, dependerán de quien las lea sean más claras o no y estoy seguro de que más del 90% le interesa más el concepto que el código en si, ya que lo piensan aplicar a su propio estilo, pero también considero, que tener un punto de partida, es fundamental. Ya esto lo he contado en el club, cuando comencé con Clipper compre un libro (Que aún conservo), para iniciarte en el mundo de este lenguaje, los primeros capítulos, eran conceptos, pero de ahí en adelante era una aplicación sencilla pero completa y debo decir, que me enseño muchísimo, cosa que hasta la fecha no he visto en Delphi.

y no no es que me vaya con un equipo de programación, me refiero a que si me sale la oportunidad de hacer algún programa que me soliciten, si creis que tengo suficiente nivel como para vender al público mis programas.

En cuanto al diseño, se que debo mejorarlo, pero espero a que alguno de los maestro, escriba alguna guía o tutorial, con los conceptos y reglas a respetar, de hecho puse el tema
http://www.clubdelphi.com/foros/showthread.php?t=83663, para intentar aprender de los compañeros y aún por desgracia no ha participado nadie.

Disculparme como siempre por la verborrea, pero para todos los años que llevo en el club no participo mucho.

José Luis Garcí
23-07-2013, 09:52:03
Siguiendo con el tutorial, lo siguiente es

procedure TFXPAF.SBDireccionesClick(Sender: TObject);
//------------------------------------------------------------------------------
//****************************************************[ Buscar direcciones ]****
//------------------------------------------------------------------------------
begin
if DBNCodigoCliente.Text<>'' then
begin
VarSTabla:='DIRECCIONES'; //Pertenece al formularios UFbusquedaFP
VarSNomMod:='XPAFD'; //Desde que modulo lo llamamos
FbusquedaFP.Show;
end else ShowMessage('Debe seleccionar primero el código del cliente');
end;

y estos son los cambios más significativos hechos en UFbusquedaFP



//------------------------------------------------------------------------------
//****************************************************[ Hace la búsqueda ]******
//------------------------------------------------------------------------------
begin // Usamos por defecto locate pero lo podemos cambiar por un Query y sus cláusulas
if comboCampos.Text<>'' then
begin
if VarSNomMod='XPAFD' then //Módulo de documentos (direcciones)
begin
if CheckBox1.Checked then ActQuery(IBQBusqueda,'Select * From '+VarSTabla+' WHERE (DIRECCIONES.MODULO = '+ QuotedStr('CLIENTES')+
') AND (DIRECCIONES.CODIGO = '+ QuotedStr(FXPAF.DBNCodigoCliente.Text)+
') AND (UPPER('+comboCampos.text+ ') LIKE UPPER('+QuotedStr('%'+Edbusqueda.Text+'%')+'))')
else ActQuery(IBQBusqueda,'Select * From '+VarSTabla+' WHERE (DIRECCIONES.MODULO = '+ QuotedStr('CLIENTES')+
') AND (DIRECCIONES.CODIGO = '+ QuotedStr(FXPAF.DBNCodigoCliente.Text)+
') AND (UPPER('+comboCampos.text+') WHERE UPPER('+QuotedStr(Edbusqueda.Text)+'))');
end else
begin
if CheckBox1.Checked then ActQuery(IBQBusqueda,'Select * From '+VarSTabla+' WHERE UPPER('+comboCampos.text+') LIKE UPPER('+QuotedStr('%'+Edbusqueda.Text+'%')+')')
else ActQuery(IBQBusqueda,'Select * From '+VarSTabla+' WHERE UPPER('+comboCampos.text+') WHERE UPPER('+QuotedStr(Edbusqueda.Text)+')');
end;
end else ShowMessage('Debe seleccionar el campo por el que buscar');
end;


procedure TFbusquedaFP.FormActivate(Sender: TObject);
//------------------------------------------------------------------------------
//********************[ Cargamos los Campos de la tabla en el ComboBox ]******
//------------------------------------------------------------------------------
begin //Comprobamos si el combo esta vacio cargamos los datos
if Edbusqueda.Text='' then
begin
if (VarSTabla='DIRECCIONES') AND (VarSNomMod='XPAFD') then
begin
if VarSTabla='DIRECCIONES' then Caption:='Búsquedas en direcciones'; //Caption del Form
ActQuery(IBQBusqueda,'Select * From '+VarSTabla+' WHERE (DIRECCIONES.MODULO = '+ QuotedStr('CLIENTES')+
') AND (DIRECCIONES.CODIGO = '+ QuotedStr(FXPAF.DBNCodigoCliente.Text)+ ')');
end else ActQuery(IBQBusqueda,'Select * From '+VarSTabla);
end;
if IBQBusqueda.IsEmpty then
begin
ShowMessage('No hay datos para buscar o mostrar');
SB_SalirClick(Sender);
end else
begin
if comboCampos.Items.Count=0 then DataSource1.DataSet.GetFieldNames(comboCampos.items);

...

if VarSTabla='DIRECCIONES' then
begin
CarGarGrid(0,'ID',50,'ID');
CarGarGrid(1,'CODIGO',130,'Código');
CarGarGrid(2,'DIRECCION',520,'Dirección');
CarGarGrid(3,'CP',65,'Dirección');
CarGarGrid(4,'POBLACION',520,'Población');
CarGarGrid(5,'PROVINCIA',520,'Provincía');
CarGarGrid(6,'PAIS',520,'País');
end;
end;
end;


procedure TFbusquedaFP.FormClose(Sender: TObject; var Action: TCloseAction);
//------------------------------------------------------------------------------
//****************************************************************[ Cerrar ]****
//------------------------------------------------------------------------------
begin

...

if (VarSNomMod='XPAFD') and (FXPAF.DsPrincipal.DataSet.State in [dsEdit,dsInsert]) then
begin
DM.IBDDocumentosIDDIRECCIONES.AsInteger:=IBQBusqueda.FieldByName('ID').AsInteger; //Ponemos el código elegido
FXPAF.Show;
end;
Button3Click(Sender);
QuerryOC(IBQBusqueda);
comboCampos.Items.Clear;
end;


procedure TFbusquedaFP.FormShow(Sender: TObject);
//------------------------------------------------------------------------------
//****************************************************************[ OnShow ]****
// Adaptamos el título del form a la tabla que usamos
//------------------------------------------------------------------------------
begin

...

if (VarSTabla='DIRECCIONES') AND (VarSNomMod='XPAFD') then
begin
if VarSTabla='DIRECCIONES' then Caption:='Búsquedas en direcciones'; //Caption del Form
ActQuery(IBQBusqueda,'Select * From '+VarSTabla+' WHERE (DIRECCIONES.MODULO = '+ QuotedStr('CLIENTES')+
') AND (DIRECCIONES.CODIGO = '+ QuotedStr(FXPAF.DBNCodigoCliente.Text)+ ')');
ShowMessage(IBQBusqueda.SQL.Text);
end;
end;



Como podéis ver al tratarse de una tabla auxiliar que va vinculada a los módulos y el código, el tratamiento es un poco diferente.

José Luis Garcí
23-07-2013, 10:07:49
Como va quedando el botón nuevo documento

procedure TFXPAF.SbNuevoClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Creamos un nuevo registro ]******
//------------------------------------------------------------------------------
begin
PC.ActivePageIndex:=1;
DSPrincipal.DataSet.Insert;
NSESerie.Value:=1;
if DM.IBDCONFIUSARSERIEYEAR.Value='S' then
begin
NSESerie.Enabled:=False;
DBNSerie.Field.Value:=Copy(IntToStr(Ano(now)),3,4);
end else
begin
NSESerie.Enabled:=True;
DBNSerie.Field.Value:=DM.IBDCONFISERIE.AsString;
end;
NDBSENumeroProteccionDatos.Field.Value:=1;
DBNNumeroDocumento.Field.value:=VerNumeroDocumento(VarSTipoDocumento,DBNSerie.Text);
//Campos que no pueden quedar nulos
DSPrincipal.DataSet.FieldByName('PORCENTAJEFINANCIADO').Value:=0;
DSPrincipal.DataSet.FieldByName('TIPODOCUMENTO').Value:=VarSTipoDocumento;
DSPrincipal.DataSet.FieldByName('COBRADO').Value:='N';
DSPrincipal.DataSet.FieldByName('TOTALCOMISIONES').Value:=0;
DSPrincipal.DataSet.FieldByName('MODIFICACIONES').Value:=0;
DSPrincipal.DataSet.FieldByName('SUBTOTAL').Value:=0;
DSPrincipal.DataSet.FieldByName('TOTALIMPUESTOS').Value:=0;
DSPrincipal.DataSet.FieldByName('TOTALIMPUESTO1').Value:=0;
DSPrincipal.DataSet.FieldByName('TOTALIMPUESTO2').Value:=0;
DSPrincipal.DataSet.FieldByName('TOTALIMPUESTO3').Value:=0;
DSPrincipal.DataSet.FieldByName('TOTALIMPUESTO4').Value:=0;
DSPrincipal.DataSet.FieldByName('TOTALPESO').Value:=0;
DSPrincipal.DataSet.FieldByName('TOTALDESCUENTOS').Value:=0;
Memo2.Lines.Clear;
DBNSerie.SetFocus;
end;

José Luis Garcí
23-07-2013, 10:26:40
Bueno empezamos con la botonera de detalles del documento, explicaremos algunos botones, los otros, son iguales a los anteriores

procedure TFXPAF.SBDetalleNuevoClick(Sender: TObject);
// ------------------------------------------------------------------------------
// *********************************************************[ Nuevo Detalle ]****
// ------------------------------------------------------------------------------
var I, varIPaso:Integer;
begin
varIPaso:=0; //Si sigue a 0 grabará y pasará al siguiente
if DsPrincipal.DataSet.State in [DsInsert] then
begin { Si esta en insercion, lo salvamos y editamos, para que acepte los cambios posteriores }
if DM.IBDDocumentosIDDIRECCIONES.IsNull then
begin
if IBQDirecciones.IsEmpty then DM.IBDDocumentosIDDIRECCIONES.Value:=0
else DM.IBDDocumentosIDDIRECCIONES.Value:=IBQDirecciones.FieldByName('IDDIRECCIONES').Value;
end;
DSPrincipal.DataSet.FieldByName('NUMERODOCUMENTO').Value:=DBNNumeroDocumento.Text;
DSPrincipal.DataSet.FieldByName('SERIE').Value:=DBNSerie.Text;
if DSPrincipal.DataSet.FieldByName('CODIGOCLIENTE').IsNull then varIPaso:=1;
if DSPrincipal.DataSet.FieldByName('CODIGOAGENTE').IsNull then varIPaso:=2;
if DSPrincipal.DataSet.FieldByName('FECHA').IsNull then varIPaso:=3;
if DSPrincipal.DataSet.FieldByName('FORMADEPAGO').IsNull then varIPaso:=4;
if DSPrincipal.DataSet.FieldByName('NUMEROPROTECCIONDATOS').IsNull then varIPaso:=5;
if varIPaso=0 then
begin
DsPrincipal.DataSet.Post;
DsPrincipal.DataSet.Edit;
end;
end;
if varIPaso=0 then
begin
DsDetalle.DataSet.Insert;
FExtPPAF.ListView1.Items.Clear;
for I := 1 to FExtPPAF.StringGrid1.RowCount - 1 do FExtPPAF.StringGrid1.Rows[i].Clear;
FExtPPAF.Show;
FExtPPAF.DBEdit1.SetFocus;
end else
begin
case varIPaso of
1:begin
ShowMessage('Falta por rellenar el código de cliente');
DBNCodigoCliente.SetFocus;
end;
2:begin
ShowMessage('Falta por rellenar el código de agente/comercial');
DBNCodigoComercial.SetFocus;
end;
3:begin
ShowMessage('Falta por rellenar la fecha');
DBNFecha.SetFocus;
end;
4:begin
ShowMessage('Falta por rellenar la forma de pago');
DBNFormaPago.SetFocus;
end;
5:begin
ShowMessage('Falta por rellenar el número de protección de datos');
NDBSENumeroProteccionDatos.SetFocus;
end;
end;
end;
end;

Se que el código cliente y otros, tienen control de salida, por lo que no permite quedarse vacio, pero puede pasar que el cliente con el ratón salte los pasos y lo coloque en otra posición dejando en blanco o nulos, campos que deben tener datos. Para evitarlo creamos la variable VarIPaso y la iniciamos a 0, si se mantiene a 0 todo va bien, en caso contrario según su valor nos indica donde se encuentra el error.

José Luis Garcí
23-07-2013, 10:33:02
Ahora los botones Modificar y borrar de detalle


procedure TFXPAF.SBDetalleModificarClick(Sender: TObject);
// ------------------------------------------------------------------------------
// *******************************************[ Editar el actual registro ]******
// ------------------------------------------------------------------------------
begin
if DsDetalle.DataSet.IsEmpty<>true then
begin
DsDetalle.DataSet.Edit;
FExtPPAF.Show;
FExtPPAF.DBEdit1.SetFocus;
end else ShowMessage('No existen datos para poder editar');
end;

procedure TFXPAF.SBDetalleBorrarClick(Sender: TObject);
// ------------------------------------------------------------------------------
// **********************************[ Borrar el Actual Registro Desgloce ]******
// ------------------------------------------------------------------------------
begin // Cambiar por el mensaje elegido
if not DsDetalle.DataSet.IsEmpty then
begin
if (MessageBox(0, '¿Esta seguro de eliminar el registro detalle?', // Aqui no se porque me manda la última comilla simple y la coma a la linea de abajo, por favor subir al final de la linea anterior
'Eliminar Registro', MB_ICONSTOP or MB_YESNO or MB_DEFBUTTON2) = ID_No) then
Abort
else
begin
DsDetalle.DataSet.Delete;
ShowMessage('El registro ha sido eliminado');
end;
end
else ShowMessage('No existen datos para eliminar');
end;

Casimiro Notevi
23-07-2013, 10:51:16
me refiero a que si me sale la oportunidad de hacer algún programa que me soliciten, si creis que tengo suficiente nivel como para vender al público mis programas.
Por supuesto que sí. No hay duda.

En cuanto al diseño, se que debo mejorarlo, pero espero a que alguno de los maestro, escriba alguna guía o tutorial, con los conceptos y reglas a respetar, de hecho puse el tema http://www.clubdelphi.com/foros/showthread.php?t=83663, para intentar aprender de los compañeros y aún por desgracia no ha participado nadie.
Es que es algo muy ambiguo, hoy puedes hacer la pantalla de una manera y la semana que viene la haces de otra distinta. Normalmente se procura hacer según un "estandar" que nos hemos creado nosotros mismos en ese programa. Al igual que con otro programa usamos una presentación totalmente distinta porque "nos ha parecido" que debe hacerse de otra manera.
De todas formas, hay información por internet y libros que hablan de ese tema, aunque no soy muy partidario de seguirlos "al dedillo" porque prefiero hacer las cosas a mi manera.

Por ahí tenemos un hilo, creo recordar que 2 hilos, que hablan sobre ese asunto y los foreros pusieron capturas de pantallas de sus programas, por si acaso te sirve de algo echarles un vistazo.
Por comentarte algo personal, prefiero ponerlo todo muy recogido, ocupando el menor espacio posible. Sin embargo eso va en contra de una pantalla táctil o de alguien que tenga algún defecto ocular y prefiera todo más grande. Creo que en estas cosas cada uno tiene sus gustos y pueden ser totalmente diferentes al del resto.

José Luis Garcí
23-07-2013, 10:55:13
Debido a que voy a usar este método más de una vez he modificado el código del botón nuevo y creado una nueva función para este módulo

procedure TFXPAF.SBDetalleNuevoClick(Sender: TObject);
// ------------------------------------------------------------------------------
// *********************************************************[ Nuevo Detalle ]****
// ------------------------------------------------------------------------------
var I:Integer;
begin
if CambiarEstado=0 then
begin
DsDetalle.DataSet.Insert;
FExtPPAF.ListView1.Items.Clear;
for I := 1 to FExtPPAF.StringGrid1.RowCount - 1 do FExtPPAF.StringGrid1.Rows[i].Clear;
FExtPPAF.Show;
FExtPPAF.DBEdit1.SetFocus;
end;
end;

Después del cambio es como queda este procedure y ahora la function

function TFXPAF.CambiarEstado: Integer;
//------------------------------------------------------------------------------
//*********************************************************[ CambiarEstado ]****
// Nos permite comprobar si los datos necesarios estan rellenos
//------------------------------------------------------------------------------
var varIPaso:Integer;
begin
varIPaso:=0; //Si sigue a 0 grabará y pasará al siguiente
if DsPrincipal.DataSet.State in [DsInsert] then
begin { Si esta en insercion, lo salvamos y editamos, para que acepte los cambios posteriores }
if DM.IBDDocumentosIDDIRECCIONES.IsNull then
begin
if IBQDirecciones.IsEmpty then DM.IBDDocumentosIDDIRECCIONES.Value:=0
else DM.IBDDocumentosIDDIRECCIONES.Value:=IBQDirecciones.FieldByName('IDDIRECCIONES').Value;
end;
DSPrincipal.DataSet.FieldByName('NUMERODOCUMENTO').Value:=DBNNumeroDocumento.Text;
DSPrincipal.DataSet.FieldByName('SERIE').Value:=DBNSerie.Text;
if DSPrincipal.DataSet.FieldByName('CODIGOCLIENTE').IsNull then varIPaso:=1;
if DSPrincipal.DataSet.FieldByName('CODIGOAGENTE').IsNull then varIPaso:=2;
if DSPrincipal.DataSet.FieldByName('FECHA').IsNull then varIPaso:=3;
if DSPrincipal.DataSet.FieldByName('FORMADEPAGO').IsNull then varIPaso:=4;
if DSPrincipal.DataSet.FieldByName('NUMEROPROTECCIONDATOS').IsNull then varIPaso:=5;
if varIPaso=0 then
begin
DsPrincipal.DataSet.Post;
DsPrincipal.DataSet.Edit;
end else
begin
case varIPaso of
1:begin
ShowMessage('Falta por rellenar el código de cliente');
DBNCodigoCliente.SetFocus;
end;
2:begin
ShowMessage('Falta por rellenar el código de agente/comercial');
DBNCodigoComercial.SetFocus;
end;
3:begin
ShowMessage('Falta por rellenar la fecha');
DBNFecha.SetFocus;
end;
4:begin
ShowMessage('Falta por rellenar la forma de pago');
DBNFormaPago.SetFocus;
end;
5:begin
ShowMessage('Falta por rellenar el número de protección de datos');
NDBSENumeroProteccionDatos.SetFocus;
end;
end;
end;
end;
if varIPaso=0 then Result:=0 else Result:=1; //0 = OK, 1 = problema
end;

José Luis Garcí
23-07-2013, 11:01:46
Por supuesto que sí. No hay duda.


Es que es algo muy ambiguo, hoy puedes hacer la pantalla de una manera y la semana que viene la haces de otra distinta. Normalmente se procura hacer según un "estandar" que nos hemos creado nosotros mismos en ese programa. Al igual que con otro programa usamos una presentación totalmente distinta porque "nos ha parecido" que debe hacerse de otra manera.
De todas formas, hay información por internet y libros que hablan de ese tema, aunque no soy muy partidario de seguirlos "al dedillo" porque prefiero hacer las cosas a mi manera.

Por ahí tenemos un hilo, creo recordar que 2 hilos, que hablan sobre ese asunto y los foreros pusieron capturas de pantallas de sus programas, por si acaso te sirve de algo echarles un vistazo.
Por comentarte algo personal, prefiero ponerlo todo muy recogido, ocupando el menor espacio posible. Sin embargo eso va en contra de una pantalla táctil o de alguien que tenga algún defecto ocular y prefiera todo más grande. Creo que en estas cosas cada uno tiene sus gustos y pueden ser totalmente diferentes al del resto.

Primero gracias Casimiro, en cuanto a "Por ahí tenemos un hilo, creo recordar que 2 hilos," creo que te refieres al color de nuestros programas (o un titulo parecido), me pareció muy interesante y lo seguí, diría yo que hasta la fecha, el problema es que no puedes hacer una verdadera comparación ya que cada programa es un mundo, por eso decía yo poniendo un formulario, sin muchas complicaciones de ver como los compañeros eran capaces de dejar el aspecto de dicha pantalla, lo que me serviría a mi y supongo que a otros muchos compañeros, de mucha utilidad, ya que veríamos como podemos mejorar visualmente un mismo diseño.

Casimiro Notevi
23-07-2013, 11:19:00
Te entiendo, José Luis, aunque lo que trataba de decirte es que ese diseño variará dependiendo de muchos factores, tanto personales como preferencias del cliente, técnicos, etc.
Es lo que te comentaba, yo prefiero hacer las pantallas muy reducidas, ajustadas, lo más pequeña posible, etc. pero si me dicen que el el programa es para usar en una pantalla táctil, entonces cambio mis preferencias y me adapto a esa cuestión técnica. O lo mismo si el cliente me dice que prefiere las letras grandes porque en su empresa están todos cegatos.
O sea, que hacer esa pantalla que indicas, si fuese para mí, creo que la reduciría tanto que entrarían 4 pantallas en el tamaño que ocupa solo una :D

José Luis Garcí
23-07-2013, 11:23:57
O sea, que hacer esa pantalla que indicas, si fuese para mí, creo que la reduciría tanto que entrarían 4 pantallas en el tamaño que ocupa solo una :D


Oye te vamos a cambiar el nick (Don Cicuta Supertacañon) y el avatar por este http://undostresweb.16mb.com/doncicutapeseta.jpg

A ver si adivinas por qué :D:D:D:D

José Luis Garcí
23-07-2013, 11:33:34
Ahora insertar un comentario

procedure TFXPAF.SBInsertarComentarioClick(Sender: TObject);
// ------------------------------------------------------------------------------
// ************************************************[ Insertar Comentario ]*******
// ------------------------------------------------------------------------------
var VarScadena: string;
begin
VarScadena := InputBox('Comentario a insertar', 'Su comentario', '');
if VarScadena <> '' then
begin
if CambiarEstado=0 then
begin
DsDetalle.DataSet.Insert;
DsDetalle.DataSet.FieldByName('CODIGOARTICULO').value:='COM.';
DsDetalle.DataSet.FieldByName('DESCRIPCIONARTICULO').value:=VarScadena;
DsDetalle.DataSet.FieldByName('CANTIDAD').value:=0;
DsDetalle.DataSet.FieldByName('PRECIOUNIDAD').value:=0;
DsDetalle.DataSet.FieldByName('IMPUESTO').value:=0;
DsDetalle.DataSet.FieldByName('DESCUENTO').value:=0;
DsDetalle.DataSet.FieldByName('COMISION').value:=0;
DsDetalle.DataSet.FieldByName('PESOUNIDAD').value:=0;
DsDetalle.DataSet.FieldByName('MODIFICADO').value:=0;
DsDetalle.DataSet.FieldByName('SERVICIO').value:='N';
end;
end;
end;

Casimiro Notevi
23-07-2013, 12:20:04
Oye te vamos a cambiar el nick (Don Cicuta Supertacañon) y el avatar por este
A ver si adivinas por qué :D
Sí, qué tiempos aquellos, era joven y tenía pelo para peinar :rolleyes:

José Luis Garcí
23-07-2013, 12:28:19
Sí, qué tiempos aquellos, era joven y tenía pelo para peinar :rolleyes:

:D:D:D:D:D

José Luis Garcí
23-07-2013, 13:33:44
Para el botón de muestras este es el código

procedure TFXPAF.SBInsertarMuestraClick(Sender: TObject);
// ------------------------------------------------------------------------------
// **************************************************[ Insertar Muestra ]*******
// ------------------------------------------------------------------------------
begin
if CambiarEstado=0 then FEntrMuestra.Show;
end;


Esta la imagen sin extender y extendido

http://nsae01.casimages.net/img/2013/07/23/13072312570770659.jpg (http://www.casimages.es/i/13072312570770659.jpg.html)


y aquí como siempre el código https://gist.github.com/anonymous/6061538

José Luis Garcí
23-07-2013, 13:45:33
Una pequeña modificación del código

En FXPAF -Nuevo -
procedure TFXPAF.desgloceBlanco;
//------------------------------------------------------------------------------
//********************************************************[ DesgloceBalnco ]****
// Deja el registro con valores a vacio, negatiovo o 0 para evitar errores
// Tabla detalles
//------------------------------------------------------------------------------
begin
DsDetalle.DataSet.FieldByName('CANTIDAD').value:=0;
DsDetalle.DataSet.FieldByName('PRECIOUNIDAD').value:=0;
DsDetalle.DataSet.FieldByName('IMPUESTO').value:=0;
DsDetalle.DataSet.FieldByName('DESCUENTO').value:=0;
DsDetalle.DataSet.FieldByName('COMISION').value:=0;
DsDetalle.DataSet.FieldByName('PESOUNIDAD').value:=0;
DsDetalle.DataSet.FieldByName('MODIFICADO').value:=0;
DsDetalle.DataSet.FieldByName('SERVICIO').value:='N';
end;




y modificar


procedure TFXPAF.SBInsertarComentarioClick(Sender: TObject);
// ------------------------------------------------------------------------------
// ************************************************[ Insertar Comentario ]*******
// ------------------------------------------------------------------------------
var VarScadena: string;
begin
VarScadena := InputBox('Comentario a insertar', 'Su comentario', '');
if VarScadena <> '' then
begin
if CambiarEstado=0 then
begin
DsDetalle.DataSet.Insert;
DsDetalle.DataSet.FieldByName('CODIGOARTICULO').value:='COM.';
DsDetalle.DataSet.FieldByName('DESCRIPCIONARTICULO').value:=VarScadena;
desgloceBlanco;
end;
end;
end;


y en UMuestraEntrega modificar

procedure TFEntrMuestra.SB_SalirClick(Sender: TObject);
//------------------------------------------------------------------------------
//****************************************************[ Salir y actualizar ]****
//------------------------------------------------------------------------------
var VarSTipoForm:string;
begin
case RadioGroup1.ItemIndex of
0:VarSTipoForm:='Ml.';
1:VarSTipoForm:='L.';
2:VarSTipoForm:='Gr.';
3:VarSTipoForm:='Kg.';
4:VarSTipoForm:='Ud.';
end;
if Edit1.Text<>'' then
begin
FXPAF.DsDetalle.dataset.insert;
FXPAF.desgloceBlanco;
FXPAF.DsDetalle.dataset.FieldByName('IDENTIFICADOR').Value:=FXPAF.DSPrincipal.DataSet.FieldByName('I D').Value;
FXPAF.DsDetalle.dataset.FieldByName('TIPODOCUMENTO').Value:=FXPAF.DSPrincipal.DataSet.FieldByName('T IPODOCUMENTO').Value;
FXPAF.DsDetalle.dataset.FieldByName('NUMERODOCUMENTO').Value:=FXPAF.DSPrincipal.DataSet.FieldByName( 'NUMERODOCUMENTO').Value;
FXPAF.DsDetalle.dataset.FieldByName('SERIE').Value:=FXPAF.DSPrincipal.DataSet.FieldByName('SERIE').V alue;
FXPAF.DsDetalle.dataset.FieldByName('CODIGOARTICULO').Value:='MU';
FXPAF.DsDetalle.dataset.FieldByName('DESCRIPCIONARTICULO').Value:='Muestra de '+Edit1.text+' ['+Edit2.Text+' '+VarSTipoForm+']';
FXPAF.DsDetalle.dataset.FieldByName('CANTIDAD').Value:=SpinEdit1.Value;
FXPAF.DSLoteDocumento.DataSet.Insert; // Grabamos los datos del lote
FXPAF.DSLoteDocumento.DataSet.FieldByName('TIPODOCUMENTO').Value:=FXPAF.DSPrincipal.DataSet.FieldByN ame('TIPODOCUMENTO').Value;
FXPAF.DSLoteDocumento.DataSet.FieldByName('NUMERODOCUMETO').Value:=FXPAF.DSPrincipal.DataSet.FieldBy Name('NUMERODOCUMENTO').Value;
FXPAF.DSLoteDocumento.DataSet.FieldByName('SERIE').Value:=FXPAF.DSPrincipal.DataSet.FieldByName('SER IE').Value;
FXPAF.DSLoteDocumento.DataSet.FieldByName('LOTE').Value:=Label5.Caption;
FXPAF.DSLoteDocumento.DataSet.FieldByName('CANTIDAD').Value:=SpinEdit1.Value;
FXPAF.DSLoteDocumento.DataSet.FieldByName('CODIGOARTICULO').Value:='MU';
FXPAF.SetFocus;
FEntrMuestra.Close;
end else ShowMessage('Debe rellenar los datos primeramente, si lo que desea es salir, pulse en cancelar');
end;

José Luis Garcí
23-07-2013, 13:54:23
y hoy por último el botón comentario con fecha

procedure TFXPAF.SBInstertarComentarioFechaClick(Sender: TObject);
// ------------------------------------------------------------------------------
// **************************************[ Insertar Comentario con fecha ]*******
// ------------------------------------------------------------------------------
var VarScadena: string;
begin
VarScadena := Inputdate('Comentario con fecha', 'Su comentario');
if VarScadena <> '' then
begin
if CambiarEstado=0 then
begin
DsDetalle.DataSet.Insert;
DsDetalle.DataSet.FieldByName('CODIGOARTICULO').value:='COM./FE.';
DsDetalle.DataSet.FieldByName('DESCRIPCIONARTICULO').value:=VarScadena;
desgloceBlanco;
end;
end;
end;

y la función a la que hace llamada

//------------------------------------------------------------------------------
//*************************************************************[ Imputdate ]****
// Parte de la idea original de Felipe Monteiro del 25/05/2006
// bajada de http://www.planetadelphi.com.br/dica/5756/input-combo-(simulando-um-inputbox-com-combo)
//------------------------------------------------------------------------------
// J.L.G.T. 05/08/2012 Basando me en el código de Felipe Monteiro , lo adapte a
// mis necesidades, creando un imput de doble entrada en mi caso para insertar
// Comentarios Con fecha
//------------------------------------------------------------------------------
// [Acaption] String Texto en la barra del caption
// [Aprompt] String Texto aclaratorio para elmensaje o petición
// [Separadores] Boolean Muestra la fecha entre separadores []
//------------------------------------------------------------------------------
//---EJEMPLO--------------------------------------------------------------------
// procedure TForm1.Button1Click(Sender: TObject);
// begin
// Label1.Caption:=Inputdate('Comentario con fecha','Comentario');
// end;
//------------------------------------------------------------------------------
function Inputdate(const ACaption, APrompt: string; Separadores:Boolean =true): string;
function GetCharSize(Canvas: TCanvas): TPoint;
var
I: Integer;
Buffer: array[0..51] of Char;
begin
for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
Result.X := Result.X div 52;
end;

var
Form: TForm;
Prompt: TLabel;
Combo: TDateTimePicker;
Ed: TEdit;
Labelfec2: TLabel;
DialogUnits: TPoint;
ButtonTop, ButtonWidth, ButtonHeight: Integer;
R: TRect;
begin
Result := '';
Form := TForm.Create(Application);
with Form do
try
Canvas.Font := Font;
DialogUnits := GetCharSize(Canvas);
BorderStyle := bsDialog;
FormStyle :=fsStayOnTop;
Caption := ACaption;
ClientWidth := MulDiv(195, DialogUnits.X, 4);
Position := poScreenCenter;
Prompt := TLabel.Create(Form);
with Prompt do
begin
Parent := Form;
Caption := APrompt;
Left := MulDiv(8, DialogUnits.X, 4);
Top := MulDiv(8, DialogUnits.Y, 8);
Constraints.MaxWidth := MulDiv(180, DialogUnits.X, 4);
WordWrap := True;
end;
Ed:=TEdit.Create(Form);
with Ed do
begin
Parent := Form;
Left := Prompt.Left;
Top := Prompt.top+Prompt.Height+5;
Width := MulDiv(180, DialogUnits.X, 4);
Text :='';
end;
Labelfec2 := TLabel.Create(Form);
with Labelfec2 do
begin
Parent := Form;
Caption := 'Fecha';
Left := Prompt.Left;
Top := ED.top+ED.Height+5;
WordWrap := True;
end;
Combo := TDateTimePicker.Create(Form);
with Combo do
begin
Parent := Form;
Left := Prompt.Left;
Top := Labelfec2.top+Labelfec2.Height+5;
Width := MulDiv(178, DialogUnits.X, 4);
end;
ButtonTop := combo.top+Combo.Height+10;;
ButtonWidth := MulDiv(50, DialogUnits.X, 4);
ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
with TButton.Create(Form) do
begin
Parent := Form;
Caption := 'OK';
ModalResult := mrOk;
default := True;
SetBounds(MulDiv(Prompt.Left-2, DialogUnits.X, 4), ButtonTop, ButtonWidth,
ButtonHeight);
end;
with TButton.Create(Form) do
begin
Parent := Form;
Caption := 'Cancelar';
ModalResult := mrCancel;
Cancel := True;
SetBounds(MulDiv(137, DialogUnits.X, 4), ButtonTop,ButtonWidth, ButtonHeight);
Form.ClientHeight := 140;
end;
if ShowModal = mrOk then
begin
if Separadores then Result:=Ed.Text+' [ '+DateToStr(Combo.Date)+' ]'
else Result:=Ed.Text+' '+DateToStr(Combo.Date);
end;
finally
Form.Free;
end;
end;

Como podéis ver estoy dejando para el final los botones cancelar y confirmar, tanto del detalle como del principal.
Ya va quedando menos, pero sigo diciendo que esta es la parte más complicada.

Lo próximo es meternos con la entrada de artículos, que la haremos por partes, primero meteremos el artículo en si, despues veremos el tema de los lotes y el ADR y por último, los cálculos y los botones de grabación y cancelar en cuanto al detalle.

En cuanto al principal, queda toda la gestión de cálculos, Comisiones, financiado, retenciones, impuestos, etc y sus botones claro.

José Luis Garcí
25-07-2013, 12:40:46
Buenos compañeros, aquí esta una parte fundamental del programa, la introducción de los artículos en nuestros documentos, en este móiulo, tenemos desde la gestión de trazabilidad (parte inicial Selección y creación), con sus vencimientos ADR, comisiones, etc.

Esta es la pantalla

http://nsae01.casimages.net/img/2013/07/25/130725120520776634.jpg (http://www.casimages.es/i/130725120520776634.jpg.html)

Como podéis ver debemos usar un formulario aparte, ya que a diferencia de una factura, de las que se han venido usando hasta la fecha, tenemos muchos datos más que manejar, pero muchos de ellos, solo los tendremos que usar inicialmente, ya después su uso es automático.

Como siempre el código aquí https://gist.github.com/anonymous/6078466

José Luis Garcí
25-07-2013, 13:10:54
Realmente este módulo podríamos decir que hace el 50% del trabajo en documentos, por eso vamos a detenernos y comentar sus partes, para ellos vamos a apoyarnos en la siguiente imagen numerada

http://nsae01.casimages.net/img/2013/07/25/130725121617925161.jpg (http://www.casimages.es/i/130725121617925161.jpg.html)

No vamos a comentar el código, que ya esta colocado en el post anterior, pero vamos a por los diferentes puntos.

0) Es el panel que contiene los datos, realmente de ellos directamente manejamos 2 o 3, siendo el principal el código del artículo, ya que el resto, se rellena más por clicks del ratón y otros apartados que directamente.

Al lado del código vemos un botón que abre el formulario de artículos.

1,2,3) son campos de lectura, el 1 y 2, además son informativos, ya que no es de esta manera como se guardara la información, pero es como la presentaremos en nuestro documento +-.

4) Los precios, como podemos ver ene este apartado, tenemos tanto los precios como el rapel y descuentos, en esta pantalla no se ve (ya que aún no lo hemos tratado), pero sobre este cliente, en este artículo si tiene un precio especial, aparecería en la parte baja como Precio Esp. Cliente (Linea 274 del código) y aparecería esta como seleccionada, también tenemos un check a la izquierda que indica el precio seleccionado, pero podemos cambiarlo en cualquier momento.

5) Este es un panel, que nos da información tanto del documento, cliente y comercial.

6) Esta es la madre del cordero, aquí nos muestra la información de todos los lotes de productos que hemos introducido, para este código de artículo, podemos ver que nos indica el lote, la fecha (de entrada), la cantidad de entrada, las unidades que hay disponibles (no aparecen las que estén a 0 o por debajo), y la fecha de caducidad (podemos ver que algunas no tienen datos en este apartado, es debido a las diferentes pruebas iniciales, pero realmente siempre aparecería este dato) y por último la cantidad de artículos que vamos a usar de cada lote.

Realmente el único elemento que vamos a usar es el último, si la cantidad que ponemos es mayor que la disponible para dicho lote, nos avisa y ajusta este al disponible del mismo.

7) Botón de salir y no pasar ninguno de estos datos.

8) Botón de salir y pasar todos estos datos.

9) Buscar, el de la derecha abre el dialogo "buscar por" según elijamos en Descripción o Código (la búsqueda es mediante un LOCATE) y el de la izquierda abre el dialogo de búsquedas ya usado anteriormente en varios módulos que hacemos mediante SQL. (este módulo, lo publicare nuevamente al terminar ya que sigue teniendo varios cambios según avanzamos, aunque la mayoría ya los hemos visto en partes anteriores)

10,12) Este botón abre una pequeña ventana, para introducir un lote manualmente y registrarlo, lo mismo que el apartado 12, pero es mucho más claro el 10 que el 12, este apartado lo veremos a continuación.

11) Botón que abre el módulo de entrada de productos/artículos, que ya hemos visto anteriormente

12) ya lo hemos tratado en el apartado 10


Como siempre si existe alguna duda, me tenéis a vuestra dispocición

José Luis Garcí
25-07-2013, 13:14:25
El módulo comentado en el post anterior

http://nsae01.casimages.net/img/2013/07/25/130725124529156144.jpg (http://www.casimages.es/i/130725124529156144.jpg.html)

y su código https://gist.github.com/anonymous/6078637

Como podéis ver su código es bastante reducido

José Luis Garcí
25-07-2013, 13:46:27
Como podéis ver hasta el momento no hemos usado en ningún momento un CommitRetaing, ni un Commit, para que los datos sean grabados fisícamentes, al finalizar el documento, pero claro esta si entramos en entradas o en artículos y creamos uno nuevo, se realizará un CommitRetaing (Lo estoy escribiendo todo de cabeza, así que perdonar si no esta bien), con lo cual los datos a los que pasemos con el post serán grabados, para evitar dentro de lo posible esto, me gusta poner un dialogo previo que avise de tal circunstancia, pero eso debéis seleccionarlo o solucionarlo vosotros a vuestra manera.

Me han preguntado por email, si el programa estará completo, os pongo mi respuesta al tema, depende para que lo uséis, como programa de gestión estándar si, para una empresa de lo mio (química cosmética y productos de limpieza), le faltan apartados, pero lo principal si lo estoy dando. Claro esta como ya he dicho en varias ocasiones, no voy a poner los módulos de impresión.

Otro tema que me ha puesto la misma persona, es el tema de por que doy tanta información, al parecer le molesta por el tema de que se dedica a vender programas y con la información que doy, le parece útil, ya que hay partes que el desconocía, pero que puedo crear una mayor competencia al preparar más personas para la venta de programas de gestión. Mi respuesta ha sido, que si realmente logro preparar, una sola persona, que gracias a este tutorial, sea capaz de crear y vender un programa de gestión, me hará sentir muy orgulloso y feliz de haber realizado este tutorial. En cuanto a la competencia, ya existe y creo que cada persona, deberá adaptar dicho tutorial, a su manera de trabajar, con lo que cada programa sera visualmente diferente y probablemente su código, también variará sustancialmente.

Pretendo dar unos conceptos y aplicación de los mismos al código y espero conseguirlo, no llevamos mucho más de dos meses con este tema y creo que se lleva un buen ritmo y hemos avanzado mucho, por lo menos eso espero, ya que tengo que compartir mi tiempo, entre hacer el programa y llevarlo al tutorial y explicarlo y por supuesto mi familia y trabajo.

Siento si hay gente que se molesta, pero es una aportación lo que hago, creo que debe tomarse como tal y considero, que es un poco egoísta la aptitud de este señor. de todas maneras, ya lo he comentado otras veces en el club, me han acusado, de plagiar y de otras muchas cosas, la verdad es que la mayoria de los compañeros, creo que saben que nunca ha sido mi intención ni plagiar, ni fastidiar a nadie.

De hecho llevo un montón de años (desde el 2003) y no suelo participar en temas que yo no he abierto, ya que temo meter la pata y por que estoy seguro de que muchos compañeros tienen mejores respuestas que las que yo doy, sin embargo, creo que he abierto algunos temas interesante y otros no, pero siempre he facilitado mi código y los componentes creados por mi, como no queráis la sangre también :cool:

La verdad es que es algo que me molesta, la aptitud de estos elementos, aún así, nunca he dado los nombres de dichos elementos ni sus emails y no voy hacerlo ahora, pero me gustaría que ciertas personas, se limitarán a exponer sus ideas y comentarios sobre dichos temas en los hilos abiertos sobre los que tratan y no sobre mi email.

José Luis Garcí
25-07-2013, 13:51:53
Por cierto, procuro ser claro y no cortar parte de mis explicaciones, por lo que mis post pueden ser pesados y molestos, en eso si estoy de acuerdo, con dicha persona y le pido disculpas si molesta a más compañeros, pero procuro ser educado, no como alguno.

Casimiro Notevi
25-07-2013, 14:26:36
No tengo ni la más mínima idea de quién puede decirte esas cosas, pero tú no le hagas ningún caso. Es absurdo ese pensamiento.
No vale la pena ni que gaste tiempo en explicarlo, pero basta decir que "cualquiera" puede usar uno de los muchos programas de gestión libres que hay a disposición de quien lo quiera.

Gracias por todo el trabajo y tiempo que te estás tomando ^\||/

fjcg02
25-07-2013, 15:03:42
José Luis,
Con tu tiempo, tu dinero y tu cuerpo puedes hacer lo que te dé la real gana.

Si a alguien no le gusta, que se lo haga mirar.

Un saludo y mucho ánimo, que estás enseñando lo que ningún libro dice

José Luis Garcí
25-07-2013, 15:23:33
No tengo ni la más mínima idea de quién puede decirte esas cosas, pero tú no le hagas ningún caso. Es absurdo ese pensamiento.
No vale la pena ni que gaste tiempo en explicarlo, pero basta decir que "cualquiera" puede usar uno de los muchos programas de gestión libres que hay a disposición de quien lo quiera.

Gracias por todo el trabajo y tiempo que te estás tomando ^\||/

No caso no es que le haga pero :confused:

José Luis,
Con tu tiempo, tu dinero y tu cuerpo puedes hacer lo que te dé la real gana.

Si a alguien no le gusta, que se lo haga mirar.

Un saludo y mucho ánimo, que estás enseñando lo que ningún libro dice

Gracias, compañero, y lo de que ningún libro dice, tal vez si juntas unos cuantos :D:D

Se que sueno al pupas, pero la verdad es que llevo unos años, pero bueno, cuando se acabe lo malo, vendrá lo mejor digo yo.

Es que, si algo me saca de mis casillas es que me acusen de cosas que considero, no soy culpable y necesito desahogarme y no es por nada pero el club me sale más barato que el psicólogo :D:D:D

Casimiro Notevi
25-07-2013, 16:07:46
No caso no es que le haga pero :confused:
Pero, nada, borras el mensaje sin leerlo, no vale la pena perder el tiempo.


Si yo te contara las de cosas que nos han pasado, tanto a mí como a otros foreros, por publicar SU código aquí...
Bueno, y lo de acusar por plagio, ya ni te digo.

Como sabes, en los foros tienes un menú en el perfil de cada usuario, una de las opciones es: "Agregar a xxxxxxx a tu Lista de Ignorados", le das y punto, ya no volverás a recibir nada de él.

José Luis Garcí
25-07-2013, 16:33:58
Pero, nada, borras el mensaje sin leerlo, no vale la pena perder el tiempo.


Si yo te contara las de cosas que nos han pasado, tanto a mí como a otros foreros, por publicar SU código aquí...
Bueno, y lo de acusar por plagio, ya ni te digo.

Como sabes, en los foros tienes un menú en el perfil de cada usuario, una de las opciones es: "Agregar a xxxxxxx a tu Lista de Ignorados", le das y punto, ya no volverás a recibir nada de él.

Tomo nota y gracias.

José Luis Garcí
27-07-2013, 12:51:27
Pongo una nueva función que me parece interesante y empezare a usar, en el tutorial, que por cierto me llevara unos días seguir publicando, ya que quiero terminar el módulo de documentos.

//------------------------------------------------------------------------------
//*************************************************[ CamposObligatorios ]****
// Parte de la idea original de Ricardo S. [27/07/2013]
// bajada de http://www.planetadelphi.com.br/dica/1281/fun%C3%A7%C3%A3o-que-informa-os-campos-obrigat%C3%B3rios-que-n%C3%A3o-foram-preenchidos,-boa
//------------------------------------------------------------------------------
// Pequeñas modificaciones y adaptado por mi permitiendo comprobar si hat Campos
// obligatorios pendientes de rellenar
//------------------------------------------------------------------------------
// [DS] TDataSource Originalmente era de un TQuerry
// [NoField] string Podemos elegir un campo para que lo omita por
// ejemplo 'ID', por defecto =''
//------------------------------------------------------------------------------
//---EJEMPLO--------------------------------------------------------------------
// if CamposObligatorios(DsDetalle,'ID')=true then DsDetalle.dataset.post;
//------------------------------------------------------------------------------
function CamposObligatorios(DS:TDataSource; NoField:string=''):Boolean;
var j:Byte;
Msg:String;
begin
Msg:='';
Result:=False;
with DS.DataSet do
begin
for j:=0 to FieldCount -1 do
if ((Fields[j].Required) and (Fields[j].AsString = '')) and (Fields[j].FieldName<>NoField) then
begin
if Msg <> '' then Msg:=Msg+' - ';
Msg:=Msg+Fields[j].FieldName;
end;
end;
if Msg <> '' then ShowMessage('Atención, el/los campo/s :'+ #13+Msg+' No contiene datos')
else Result:=True;
end;

Casimiro Notevi
27-07-2013, 13:07:18
Bonito avatar ;)

José Luis Garcí
27-07-2013, 13:11:00
Renovarse o morir :D:D:D

José Luis Garcí
28-07-2013, 10:55:05
Hola compañeros, estoy trabajando en el módulo de Documentos, que va bastante avanzado, pero como ya había dicho necesitaremos algunas tablas nuevas.

Aquí la primera

CREATE TABLE RETENCIONES (
ID INTEGER NOT NULL,
NUMERODOCUMENTO T20 NOT NULL /* T20 = VARCHAR(20) */, //Número del documento (siempre Factura)
SERIE T3 NOT NULL /* T3 = VARCHAR(3) */, //Serie de la factura
FECHA DATE NOT NULL, //Fecha de la factura
CODIGOCLIENTE T20 NOT NULL /* T20 = VARCHAR(20) */, //Código del cliente
SUBTOTAL POR NOT NULL /* POR = NUMERIC(15,4) */, //Subtotal de la factura
IMPUESTOS POR NOT NULL /* POR = NUMERIC(15,4) */, //Total de impuestos
NUMERORETENCION INTEGER NOT NULL, //Número asignado a esta retención (este campo es único)
PORCENTAJERETENCION POR NOT NULL /* POR = NUMERIC(15,4) */, //Porcentaje a retener el cliente de nuestra factura
TOTALRETENIDO POR NOT NULL /* POR = NUMERIC(15,4) */, //Importe de la retención echa por el cliente
CAMPOLIBRE T80 /* T80 = VARCHAR(80) */ //Campo libre para lo que nos haga falta
);

José Luis Garcí
28-07-2013, 11:05:07
Toca modificar la tabla de configuración y como más adelante tendríamos que modificarla para otros me anticipo y lo hago ahora, sólo añadimos nuevos numeradores

NUMERORETENCION T20 /* T20 = VARCHAR(20) */,
NUMEROFINANCIADO T20 /* T20 = VARCHAR(20) */,
NUMERORUTA T20 /* T20 = VARCHAR(20) */

José Luis Garcí
30-07-2013, 08:05:19
El turno de la tabla financiado


CREATE TABLE FINANCIADO (
ID INTEGER NOT NULL,
FECHA DATE, //Fecha de emisión de la financiación, sólo desde la factura
NUMERODOCUMENTO T20 NOT NULL /* T20 = VARCHAR(20) */, //Solo Facturas
IMPORTEFINANCIADO POR NOT NULL /* POR = NUMERIC(15,4) */, //Cantidad a financiar
CODIGOCLIENTE T20 NOT NULL /* T20 = VARCHAR(20) */, //Código del cliente
MININOTA VARCHAR(150), //Texto aclaratorio
INTERESESDEMORA POR /* POR = NUMERIC(15,4) */, //Porcentaje de intereses a cargar por demora en el pago mensual
TIPODOCUMENTO T20 NOT NULL /* T20 = VARCHAR(20) */, //Factura
SERIE T20 NOT NULL /* T20 = VARCHAR(20) */, //Serie del número de documento
NUMEROFINANCIADO T20 /* T20 = VARCHAR(20) */ //Número de de financiado
);

José Luis Garcí
30-07-2013, 08:09:36
Y ahora el detalle de financiado

CREATE TABLE FINANCIADODETALLE (
ID INTEGER NOT NULL,
IDENTIFICADOR INTEGER NOT NULL, //Es la clave foranea i conecta con el ID de financiado
FECCHAPAGO DATE, //Fecha prevista del pago a partir de la cual empieza a cobrar los intereses de demora
FORMAPAGO T80 /* T80 = VARCHAR(80) */, //Forma de pago establecida
IMPORTE POR /* POR = NUMERIC(15,4) */ //Importe de este pago
);

Por cierto en la tabla FINANCIADO el campo NUMEROFINANCIADO es único

José Luis Garcí
30-07-2013, 11:19:17
Primero una modificación más a la tabla confi, añadimos

NUMEROCOMISION T20 /* T20 = VARCHAR(20) */ //para documentos de pago de comisiones

y ahora la tabla de comisiones

CREATE TABLE COMISIONES (
ID INTEGER NOT NULL,
CODIGOEMPLEADO T20 /* T20 = VARCHAR(20) */, //Código del empleado que tiene que ser un agente
NUMERODOCUMENTO T20 /* T20 = VARCHAR(20) */, //Número del documento FACTURA
TIPODOCUMENTO T20 /* T20 = VARCHAR(20) */, //Tipo de documento FACTURA
SERIE T3 /* T3 = VARCHAR(3) */, //Serie de la FACTURA
COMISION POR /* POR = NUMERIC(15,4) */, //Porcentaje de la comisión
IMPORTECOMISION POR /* POR = NUMERIC(15,4) */, //Importe bruto de la comisión
MININOTA VARCHAR(150), //Para pequeñas notas en la comisión
PAGADAS LOG /* LOG = CHAR(1) */, //Si esta ya ha sido pagada
FECHAPAGO DATE, //Fecha en la que se realizo el pago
NUMEROPAGO T20 /* T20 = VARCHAR(20) */, //Número del documento de pago
FECHA DATE, //Fecha es la misma que de la factura
RETENCIONES POR /* POR = NUMERIC(15,4) */ //Porcentaje a retener (para HACIENDA) de las comisiones
);

José Luis Garcí
30-07-2013, 11:20:34
Para que quede un poco más claro pongo el estado actual de la tabla CONFI

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) */,
NUMERORETENCION T20 /* T20 = VARCHAR(20) */,
NUMEROFINANCIADO T20 /* T20 = VARCHAR(20) */,
NUMERORUTA T20 /* T20 = VARCHAR(20) */,
NUMEROCOMISION T20 /* T20 = VARCHAR(20) */
);

José Luis Garcí
05-08-2013, 09:55:55
Hola compañeros, un añadido a la tabla comisiones

IMPORTEDOCUMENTO POR /* POR = NUMERIC(15,4) */ //Importe del documento sobre el que se paga la comisión

se podría omitir este campo y hacer la búsqueda por SQL, en el momento necesario, pero es más practico, tenerla metida en la misma tabla, el consumo de recursos es mínimo, evitando el consumo de memoria por el motor de la BD para hacer la consulta

José Luis Garcí
07-08-2013, 07:08:07
Bueno aquí tenemos ya terminado el apartado de documentos

Su visor

http://nsae01.casimages.net/img/2013/08/07/130807063852434294.jpg (http://www.casimages.es/i/130807063852434294.jpg.html)

y el apartado de datos

http://nsae01.casimages.net/img/2013/08/07/130807064026725230.jpg (http://www.casimages.es/i/130807064026725230.jpg.html)

y como siempre el código en https://gist.github.com/anonymous/6171193

José Luis Garcí
07-08-2013, 07:23:34
El form de productos y trazabilidad, etc. auxiliar de documentos

http://nsae01.casimages.net/img/2013/08/07/13080706552566206.jpg (http://www.casimages.es/i/13080706552566206.jpg.html)

y su código

https://gist.github.com/anonymous/6171280

José Luis Garcí
07-08-2013, 07:27:42
El módulo de financiado

http://nsae01.casimages.net/img/2013/08/07/130807065947879876.jpg (http://www.casimages.es/i/130807065947879876.jpg.html)


y el código https://gist.github.com/anonymous/6171304

José Luis Garcí
07-08-2013, 07:33:13
y por último el dialogo de impresión de documentos

http://nsae01.casimages.net/img/2013/08/07/130807070514762131.jpg (http://www.casimages.es/i/130807070514762131.jpg.html)

y el código https://gist.github.com/anonymous/6171325

José Luis Garcí
07-08-2013, 07:37:12
Con esto debéis tener un 80-90 por ciento de la aplicación según mis cálculos, faltan módulos totalmente auxiliares, aparte de gestión de comisiones (incluye el pago) y rutas, como digo el resto es lo que queráis poner al programa, creo que daré 2 o 3 módulos más y daré por terminado el presente tutorial.

Casimiro Notevi
07-08-2013, 09:41:32
^\||/^\||/^\||/

José Luis Garcí
08-08-2013, 20:39:53
El módulo de agenda de contactos

http://nsae01.casimages.net/img/2013/08/08/130808080849160104.jpg (http://www.casimages.es/i/130808080849160104.jpg.html)

Aquí con una letra seleccionada

http://nsae01.casimages.net/img/2013/08/08/130808080946316969.jpg (http://www.casimages.es/i/130808080946316969.jpg.html)

El código en https://gist.github.com/anonymous/6187111

y la función ActQAgenda

//-----------------------------------------------------------------------------
//*********************************************************[ ActQAgenda ]******
// 14/06/2012 JLGT Para modificar la sentencia de un querry para agendas
//-----------------------------------------------------------------------------
// Estudiando como poder hacer mi código mas corto se me ocurrio esta función
// para usar un los IBQerry, para mi base de datos Firebird. para el uso de agendas
// El tema es que cada vez que utilizo un querry y lo modifico tengo que
// escribir unas 20 lineas y mediante este sistema, logro reducirlo a una sola
// ya que es un, código repetitivo y soló varia el nombre del query y la
// sentencia Sql, cree esta función
//-----------------------------------------------------------------------------
// [QRY] Tibquery a actualizar
// [TAB] El tabcontrol que lo llama
// [Campo] Nombre del Campo por el que funcionara el TabControl
// [TxtSql] Cadena de texto con sentencia SQL
// [MostrarMEnsaje] Si muestra el mensaje de la Exception
// [RetornarMEnsaje] Si retorna la cadena Sql que da el Error
// [RetornarQuerry] Si retorna El querry a la cadena sql de antes del error
//-----------------------------------------------------------------------------
// Base de datos a usar CLIENTES usar en el tabChage
// if ActQAgenda(IBQuerry1,Tabcontrol1,'Nombre','Select * form Clientes')=true then
// showmessage('Cambio OK') else showmessage('El cambio a fallado');
//- ---[DETALLE]---------------------------------------------------------------
// El grid al que este unido debe tener los campos fijados para evitar un error
//-----------------------------------------------------------------------------
Function ActQAgenda(QRY:TIBQuery; TAB:TTabControl;Campo:String;TxtSql:string; MostrarMensaje:boolean=VMiLogico;Retornarmensaje:boolean=VMiLogico; RetornarQuerry:boolean=VMiLogico): Boolean;
var AntSql:string;
Letraagenda: string;
begin // Cuando cambiamos en la agenda
try
try
Letraagenda := TAB.Tabs[TAB.TabIndex];
if TAB.TabIndex = 0 then
BEGIN
QRY.Active:=false;
QRY.SQL.Clear;
QRY.SQL.Text:=TxtSql;
QRY.Active:=true;
Result:=true;
END else
BEGIN
AntSql:=QRY.SQL.Text;
QRY.Active:=false;
QRY.SQL.Clear;
QRY.SQL.Text:=TxtSql+' where UPPER('+Campo+') Between :LDESDE and :LHASTA';
QRY.ParamByName('LDESDE').AsString := Letraagenda;
QRY.ParamByName('LHASTA').AsString := Letraagenda + '||Z';
QRY.Active:=true;
Result:=true;
END;
except
on E: Exception do
begin
if MostrarMensaje=true then
begin
ShowMessage('Se ha producido un error: ' + Chr(13) + Chr(13)
+ 'Clase de error: ' + E.ClassName + Chr(13) + Chr(13)
+ 'Mensaje del error: ' + E.Message+ Chr(13) + Chr(13)
+' '+ Chr(13) + Chr(13)
+'Se volvera al estado anterior');
end;
QRY.Active:=False;
Result:=false;
end;
end;
finally
if Result=false then
begin
if Retornarmensaje=true then ShowMessage('Sentencia Sql que ha dado Error' + Chr(13) + Chr(13)+ QRY.SQL.Text);
if RetornarQuerry=true then
begin
QRY.Active:=false;
QRY.SQL.Clear;
QRY.SQL.Text:=TxtSql;
QRY.Active:=true;
end;
end;
end;
end;

José Luis Garcí
08-08-2013, 20:42:38
El módulo ver ficha

http://nsae01.casimages.net/img/2013/08/08/130808081414649878.jpg (http://www.casimages.es/i/130808081414649878.jpg.html)

Y el código https://gist.github.com/anonymous/6187160

José Luis Garcí
09-08-2013, 09:21:06
Nos encaminamos ya al final del programa, quedando unos pocos módulos que dar y unas pocas tablas, de todas maneras, al final del mismo pondré tanto el código completo y la BD, por un lado y el ejecutable y la BD por otro. vamos con una de las últimas tablas a dar, la de vehículos, que nos hará falta para cartas de porte y rutas

CREATE TABLE VEHICULOS (
ID INTEGER NOT NULL,
MATRICULA T10 NOT NULL /* T10 = VARCHAR(20) */, //Matricula del vehículo
MARCA T20 NOT NULL /* T20 = VARCHAR(20) */, //Maraca del vehículo
TARA T10 /* T10 = VARCHAR(20) */, //tara de carga
SEGURO T40 /* T40 = VARCHAR(40) */, //Seguro del vehículo
NUMEROPOLIZA T40 /* T40 = VARCHAR(40) */, //Número de la póliza del seguro
TELEFONOSEGURO T20 /* T20 = VARCHAR(20) */, //Teléfono de la compañía de seguro
EMPRESA T80 /* T80 = VARCHAR(80) */ //Dueño del vehículo
);

José Luis Garcí
09-08-2013, 10:20:31
Bueno voy a usar varias pantallas de mi anterior programa para ahorrar tiempo adaptándolas al actual programa, así que la estética puede variar un poco.

Comenzamos con vehículos

http://nsae01.casimages.net/img/2013/08/09/130809095015712921.jpg (http://www.casimages.es/i/130809095015712921.jpg.html)

El código en https://gist.github.com/anonymous/6191865

José Luis Garcí
09-08-2013, 10:30:39
La Carta de portes

http://nsae01.casimages.net/img/2013/08/09/130809095430631225.jpg (http://www.casimages.es/i/130809095430631225.jpg.html)

Como podemos ver pongo la imagen con las dos pestañas abiertas, los botones de la derecha son independientes en cada pestaña y de los datos de la izquierda, tenemos (peso bultos y cantidad)

Peso, es el total del peso de esta mercancía que no podrá exceder el limite de la misma si tiene limite

Bultos, es el número de bultos, no confundir con la cantidad, ya que si llevamos garrafas de 5L por ejemplo y van en cajas (pongamos que 4 por caja) 5 cajas son 20 garrafas

Cantidad, se refiere al número de unidades, siguiendo con el ejemplo anterior 20 serían las unidades

Puede pasar que el número de bultos y unidades sean las mismas, tanto por que van sueltas como por el formato de la unidad, pero en ningún caso un palet es una unidad

El código en https://gist.github.com/anonymous/6191905

y por último la carta de portes en el word llamada desde el programa, por supuesto podéis usar otro sistema, tanto de report como de llamada

http://nsae01.casimages.net/img/2013/08/09/130809100312473637.jpg (http://www.casimages.es/i/130809100312473637.jpg.html)

José Luis Garcí
09-08-2013, 10:35:52
Que quede claro que esta es una carta de porte externa, ya que como hemos dicho adecuando correctamente nuestra factura o albarán nos puede servir de carta de portes, junto con la hoja de ruta, por eso la importancia de esta última, junto con el control del peso transportado.

Ya hemos hablado de estos apartados anteriormente, pero repito, que en muy breve será obligatoria la hoja de ruta, donde deberemos especificar, el conductor/conductores, el vehículo, los número de documentos, clientes, destinos y pesos, de cada documento a transportar (Factura, albarán, etc) y el total del peso de todo el transporte, en la misma se permitirá, añadir anotaciones y recogidas de mercancías.

José Luis Garcí
09-08-2013, 11:10:00
Para que os hagáis una idea de todos los módulos que puede tener este tipo de programa, os voy a ir poniendo los apartados del menú de mi anterior programa, explicándolos brevemente y poniendo los que ya hemos hecho y los que terminare, lo haré a ratos, pues ahora estoy algo ocupado y quiero dejar terminado este tutorial, también.

Menú Archivos
Almacén - La gestión de almacenes de nuestra empresa, es muy útil cuando tenemos más de 1 almacén, en el programa no lo he dado, pero básicamente esta incluido en las bases de datos, lo único que deberíamos controlar es cuando entra y sale la mercancía en que almacén se hace el stock.

Agentes Comerciales - Nosotros la hemos incluido en empleados.

Personal - ya esta en el módulo empleados.

Proveedores - Lo tenemos.

Grupos Materias Primas - Al ir mi programa sobre fabricación tenia identificado las materias primas según grupos

Materias/ Materias Primas - al no solo tener materias primas sino otros artículos, tenia que tener este otro apartado, para luego controlar en la gestión de productos, ya que muchos eran para uso interno y a la vez de venta directa.

Fórmula - Las Fórmulas de mis productos , tenia nivel de acceso 9 y repetir clave de acceso

Productos - En nuestro programa lo tenemos en Artículo ABM (ya lo viereis en el menú)

Auxiliares - Aquí van las tablas auxiliares, en nuestro programa tiene el hueco pero no las vamos a dar, de todas manera en mi anterior programa tenia las siguientes, Familias, Sectores y Bancos

Clientes - Ya lo tenemos

Gestión de usuarios - Ya lo tenemos

Cambio de usuario - Ya lo tenemos en el menú

Configuración - Ya lo tenemos

Salir - Ya lo tenemos en el menú

Casimiro Notevi
09-08-2013, 14:03:00
Ya te has ganado el sueldo ;)


G R A C I A S :)

fjcg02
09-08-2013, 17:21:21
Eres un crack !!
;-)

Saludos

José Luis Garcí
09-08-2013, 17:39:58
Ya te has ganado el sueldo ;)


G R A C I A S :)

Gracias Casimiro, pero no se por que, ni a que, ya dije que yo le debo más al Club, que lo que estoy aportando y que todo lo que pongo no es todo lo que hay :rolleyes:

José Luis Garcí
09-08-2013, 17:40:55
Eres un crack !!
;-)

Saludos


Si hombre lo que me faltaba ahora andar con esas porquerías :D:D:D:D

José Luis Garcí
09-08-2013, 17:44:30
He de decir que el sistema de agendas con el tabcontrol, siempre me ha gustado y creo que es super útil, seguramente hay varios apartados que se pueden mejorar, en este y otros apartados, pero aun así me siento bien con ellos.

José Luis Garcí
09-08-2013, 17:48:53
También e de decir que esperaba muchas más criticas de los expertos y compañeros, serán que no han visto el tema :eek:, que pasa olimpicamente :rolleyes: o que me dan por imposible :D

Casimiro Notevi
09-08-2013, 18:24:26
Seguro que lo han visto, es un trabajo muy grande el que has hecho, es una excelente base tanto para los novatos como para los que tienen experiencia, se puede consultar formas de hacer las cosas, tener presente detalles que se nos olvidan, etc. es realmente muy útil.
Y ahí queda, como "libro de consulta", y cuando alguien pregunte entonces se le envía a este hilo y se le dice: "lee, que ahí tienes la solución, so vago, no lo quieras todo hecho :p"
Saludos :)

José Luis Garcí
09-08-2013, 18:26:53
Seguro que lo han visto, es un trabajo muy grande el que has hecho, es una excelente base tanto para los novatos como para los que tienen experiencia, se puede consultar formas de hacer las cosas, tener presente detalles que se nos olvidan, etc. es realmente muy útil.
Y ahí queda, como "libro de consulta", y cuando alguien pregunte entonces se le envía a este hilo y se le dice: "lee, que ahí tienes la solución, so vago, no lo quieras todo hecho :p"
Saludos :)


Que entonces no pongo los fuentes como termine, 'pá' que no vagueen estos maleantes :D:D:D

Casimiro Notevi
09-08-2013, 18:37:44
Eso, eso, o los pones en un zip con clave y pides 100 euros a quien quiera la clave :D

José Luis Garcí
09-08-2013, 18:40:13
Eso, eso, o los pones en un zip con clave y pides 100 euros a quien quiera la clave :D

Oye chiquito negocio :rolleyes, habrá que hacer un plan de viabilidad, solicitar permisos al ayuntamiento, acordar costes y demás con hacienda el ayuntamiento, etc, al final voy a tener que poner dinero de mi bolsillo :p:D:D:D

Es que como ya se meten en todo.

De lo último que me he enterado, es que ahora hay que sacar una certificación para poder alquilar una casa o local, nada como una carrera o unos estudios para que el estado te ayude, a........ hundirte

Casimiro Notevi
09-08-2013, 19:02:49
De lo último que me he enterado, es que ahora hay que sacar una certificación para poder alquilar una casa o local, nada como una carrera o unos estudios para que el estado te ayude, a........ hundirte

Pues échale un vistazo al asunto de la energía solar. Lo último de esta semana aprobado por el gobierno que tanto nos quiere: un día decides poner tus propias placas solares porque estás harto de que te robe la empresa eléctrica y decides abastecerte únicamente de esas placas para electricidad. Pues bien, tienes que pagar a la compañía eléctrica la cantidad de electricidad que produzcan esas placas. Como lo oyes :mad:

José Luis Garcí
09-08-2013, 22:33:49
Pues échale un vistazo al asunto de la energía solar. Lo último de esta semana aprobado por el gobierno que tanto nos quiere: un día decides poner tus propias placas solares porque estás harto de que te robe la empresa eléctrica y decides abastecerte únicamente de esas placas para electricidad. Pues bien, tienes que pagar a la compañía eléctrica la cantidad de electricidad que produzcan esas placas. Como lo oyes :mad:

Ciento decírtelo Casimiro, pero eso no es nuevo, si me permites, te Aconsejo leer el libro "Vivir del Viento" de mi autor preferido, un canario de la isala vecina Tenerife, que lleva afincado en otra de nuestras maravillosas Islas Lanzarote, Alberto Vazquez Figueroa, es un libro que hace refleccionar mucho, como varios de el, pro suerte yo tengo más del 75% de su obra, me faltan alguno de los antiguos y puedo decir que he leído la mayor parte. Lo aconsejo sinceramente tanto la mayor parte de su obra como su biografía, que es apasionante, tanto o más que su obra en si.

Volviendo al tema de la electricidad, terminaremos como mucha gente en la india y otras zonas de extrema pobreza, http://www.youtube.com/watch?v=bhHKXxEN9Q0, o como se veia mucho hace ya varias decadas, pequeños arerogeneradores con dinamos de bicicleta y la llanta de la misma, pero no demos más pistas que seguro que viene el e estado y le mete mano.

Casimiro Notevi
09-08-2013, 22:43:31
Sí, claro, conozco a Vázquez Figueroa y he leido varias obras suyas. Estoy al tanto de su empresa para producir electricidad económica y ecológica, y de su desaladora, y del sistema de frenado automático para trenes de alta velocidad, etc.

Pero lo que te comentaba antes es que desde la semana pasada, si tú instalas en tu casa unas placas solares que producen, por ejemplo, 1000 W. entonces tendrás que pagar como si gastaras esos 1000 W a la compañía eléctrica, para que ellos no "pierdan", o sea, el gobierno les ha dado a las eléctricas (iberdrola, endesa, etc.) permiso para cobrarnos el Sol. Así de duro.

José Luis Garcí
09-08-2013, 22:45:28
Viva el desface eléctrico y todos los españoles a pagar, no importa la de millones de beneficios que tienen al año, a pringar todo el mundo.

José Luis Garcí
10-08-2013, 09:19:20
Seguimos con la siguiente tabla, creo que a esta altura ya no hace falta comentarla

CREATE TABLE RUTAS (
ID INTEGER NOT NULL,
CODIGOEMPLEADO T20 NOT NULL /* T20 = VARCHAR(20) */,
MATRICULA T10 NOT NULL /* T10 = VARCHAR(20) */,
NUMERORUTA T20 NOT NULL /* T20 = VARCHAR(20) */,
TIPODOCUMENTO T20 /* T20 = VARCHAR(20) */,
NUMERODOCUMENTO T20 /* T20 = VARCHAR(20) */,
SERIE T3 NOT NULL /* T3 = VARCHAR(3) */,
CODIGOCLIENTE T20 /* T20 = VARCHAR(20) */,
NOMBRECLIENTE T40 /* T40 = VARCHAR(40) */,
FECHA DATE NOT NULL,
NOTA T80 /* T80 = VARCHAR(80) */
);

José Luis Garcí
10-08-2013, 10:12:26
Me falto añadir el campo

PESO NUMERIC(15,2)

José Luis Garcí
10-08-2013, 14:36:19
Vamos con crear las rutas

http://nsae01.casimages.net/img/2013/08/10/130810020735709185.jpg (http://www.casimages.es/i/130810020735709185.jpg.html)

y como siempre el código https://gist.github.com/anonymous/6200188

José Luis Garcí
10-08-2013, 17:48:35
La gestión de rutas

http://nsae01.casimages.net/img/2013/08/10/130810051924770167.jpg (http://www.casimages.es/i/130810051924770167.jpg.html)

su código en https://gist.github.com/anonymous/6200819

José Luis Garcí
10-08-2013, 17:49:42
Un cambio en el modulo de crear rutas en el botón buscar

ActQuery(IbqbusDoc,'SELECT * FROM DOCUMENTOS WHERE (((NUMERORUTA < '+QuotedStr('1')+') AND (NUMERORUTA <> '+QuotedStr('-1')+')) OR (NUMERORUTA IS NULL)) AND (DOCUMENTOS.FECHA BETWEEN '+
QuotedStr(Cambiafecha(DateTimePicker1.Date))+' AND '+QuotedStr(Cambiafecha(DateTimePicker2.Date))+
') ORDER BY DOCUMENTOS.NUMERODOCUMENTO',True,True,False);

José Luis Garcí
10-08-2013, 17:51:49
Si no estoy equivocado, me quedan dos módulos, sobre las comisiones, el menú, que será muy básico y comentaros que otras opciones puse en mi programa y listo, tutorial terminado, no diremos que he tardado mucho ?

José Luis Garcí
11-08-2013, 09:49:11
Aquí sigo dando el coñazo, vamos con el módulo de pago de comisiones

http://nsae01.casimages.net/img/2013/08/11/130811091934387474.jpg (http://www.casimages.es/i/130811091934387474.jpg.html)

y como siempre el código en https://gist.github.com/anonymous/6203848

José Luis Garcí
11-08-2013, 10:32:04
Vamos con el módulo de gestión de comisiones

http://nsae01.casimages.net/img/2013/08/11/130811100309837255.jpg (http://www.casimages.es/i/130811100309837255.jpg.html)

y el código en https://gist.github.com/anonymous/6203945

José Luis Garcí
11-08-2013, 11:13:31
Y de los apartados el último, el menú

http://nsae01.casimages.net/img/2013/08/11/130811104144615100.jpg (http://www.casimages.es/i/130811104144615100.jpg.html)

El código en https://gist.github.com/anonymous/6204023

como podéis ver no hay un Splash, de entrada ni una petición de usuario inicial, pero si he puesto

http://nsae01.casimages.net/img/2013/08/11/130811104403496831.jpg (http://www.casimages.es/i/130811104403496831.jpg.html)

ya que en cuanto suba los archivos, no tendréis información para acceder, lo explico en el código de dicho botón

procedure TFMenu.SpeedButtonBC2Click(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************************[ ENTRADA DIRECTA ]****
// Este botón será desactivado al terminar el programa
//------------------------------------------------------------------------------
begin //Realmente lo uso cuando estoy haciendo un programa, para no tener que
//pasar por la ventana de usuarios, luego siempre lo elimino
Usuario:='José Luis';
Nivel:=9;
VarSClaveUSuario:='231068';
ALStatusBar1.Panels[1].Text:='Usuario [ '+Usuario+' ]-['+IntToStr(nivel)+']';
end;

José Luis Garcí
11-08-2013, 11:22:57
Realmente en los menús añado más cosas y los hago un poco diferentes, pero sin usar otros componentes y no liando más la cosa, de todas maneras os pongo una pantalla del programa que monte originalmente para que veáis de que hablo

http://nsae01.casimages.net/img/2013/08/11/130811105417430670.jpg (http://www.casimages.es/i/130811105417430670.jpg.html)

Seguro que en el presente tutorial hay bugs y alguna pantalla que no he mostrado o código que se me ha olvidado, todo ello lo encontrareis en los fuentes, que dentro de muy poco subire

José Luis Garcí
11-08-2013, 12:00:39
Bueno compañeros ya he subido los archivos los encontrareis en

http://terawiki.clubdelphi.com/Delphi/Ejemplos/Tutoriales_Demos/

son el de la base de datos, el ejecutable y otros y por último los fuentes todos empiezan por el que e y luego tienen Tutorial programa de gestion desde 0.zip

yo lo tenia montado en la unidad C en el directorio PGF2/FUENTES.

Nada espero que lo disfrutéis y como siempre espero vuestros comentarios y el haber podido ayudar a la comunidad. por cierto la mejor manera de agradecérmelo, es en este mismo foro con vuestras impresiones y comentarios y si hacéis algún arreglo, añadido, mejora, etc. y queréis compartirlo, sería ideal.

José Luis Garcí
11-08-2013, 12:02:22
De todas maneras comentare y haré la comparación con mi otro programa y pondré algunas imágenes de formularios para que os hagáis una idea de lo que hemos estado hablando

José Luis Garcí
11-08-2013, 12:31:41
Seguimos ahora con el menú Almacenes

Entradas con los siguientes apartados
> Entrada materias primas Entrada de materias primas con las que fabricamos

> entrada de productos Entrada de otros tipos de productos

> entrada de productos propios Como somos una fabrica, entrada del producto ya terminado, de aquí regulábamos el Stock

Salidas M.P./partes (sin registros en B.D.) Partes de rotura y uso interno

Regulación de Stock ya lo tenemos en especiales

Unir Stock en este programa permite entradas diversas o atempoorales por lo que podemos tener varias entradas diferentes de un mismo lote, aquí se podian unir

Listados con los siguientes apartados
> M.P. Detallado Listado de materias primas de manera detallada

> Inventario Con las siguientes dos opciones
>> Materias Primas Inventario de materias primas

>> Productos/Artículos Inventarios del resto de productos


(M.P. = Materias Primas)

José Luis Garcí
11-08-2013, 12:39:54
El menú Fabricaciones

Gestión de productos Fabricables ya lo tenemos

Gestión de lotes con los siguientes apartados

> Lotes ya lo tenemos

> Lotes salida Nos permitía dar salidas de manera manual a los lotes, por uso interno, personal reconvención etc.

Gestión de envasados con los siguientes apartados

> Envases Tipos de envases usados

> Envasado el envasado de los productos, los que nos permitía a su vez llevar el Stock de envases

José Luis Garcí
11-08-2013, 12:50:27
El menú de ventas

Presupuestos ya lo tenemos

Notas de entregas ya lo tenemos

Albaranes ya lo tenemos

Facturas ya lo tenemos

Pasar nota de entrega a albarán pasa una nota de entrega a un albarán

Facturar albaranes de clientespasa 1 o varios albaranes de un cliente a una factura

Copiar de otra factura Permite realizar una copia de una factura, al terminar nos solicita los lotes

Cambiar el estado de una factura Cambia el estado de una factura Ver ejemplo*

Cambiar en número de documento existente Cambia el numerador de documentos, para que continué el mismo, por ejemplo por haber borrado una factura(1)

* Imaginamos que tenemos una factura como incobrable y de la noche a la mañana el cliente nos la paga, tendríamos que cambiar el estado de incobrable a cobrada, para ello sólo solicita el documento (nº, tipo y serie) y el nuevo estado, si la marcamos como cobrada, ademas nos solicita forma del pago y fecha

(1) deberíamos cambiar el numerador por la factura borrada, crear una nueva, volver a cambiar el numerador por el que teníamos antes y seguir. Como podemos ver un coñazo, por eso es mejor no borrarlas y marcarlas como NULA. Os recuerdo que en los documentos de compra y venta debe existir una numeración continuada, en caso de no ser así, tendríamos problemas con Hacienda y seguramente una auditoria.

José Luis Garcí
11-08-2013, 13:01:24
Menú de gestión

Cobros con las siguientes opciones

> Gestión de cobros realiza la gestión de cobros de nuestras facturas (fecha, marca como cobrada, forma de pago, cantidad número de talón o pagare, etc)

> Cobros Usamos el formulario tipo a crear Ruta, seleccionando los documentos (Facturas) y con campos para rellenar los datos descritos en gestión de cobros

Relación de facturas con las siguientes opciones

> Crear relación de facturas Usamos el formulario tipo a crear Ruta, seleccionando los documentos (Facturas) y creamos una relación de facturas, con su propio número, fecha e importe de la suma de todas

> Gestión de relación de facturas para gestionar la relación de facturas

Comisiones con las siguientes opciones

> Pago de comisiones ya lo tenemos

> Gestión de comisiones ya lo tenemos

Rutas con las siguientes opciones

> Crear Ruta ya lo tenemos

> Gestión de rutas ya lo tenemos

Retenciones gestiona las retenciones de las Facturas e imprime un documento con la suma de estas

Financiado ya lo tenemos

Autorización bancaria Crea un documento que firmará el cliente para poder hacerle el cargo en cuenta de sus facturas

José Luis Garcí
11-08-2013, 14:37:07
Ahora el menú de listados

Listados de ventas y 347 Este módulo saca todo tipos de listados, 1, varios o todos los clientes, entre fechas, tiene gráficas y el 347*

Recibos de alquiler imprime recibos de alquiler

Carta de portes ya dado


* Os recuerdo que el 347 debe estar separado en totales trimestrales desde el año 2012 si no recuerdo mal


Podéis ver que en el programa hay muchos más listados, pero estos no estaba seguro de donde ubicarlos.

José Luis Garcí
11-08-2013, 14:51:08
ahora con el menú de Especial

Formulex coge una formula y mediante varios cálculos, saca los datos obligatorios de etiquetas, y F.T.S., ADR, Etc

Formulex manual Lo mismo que el anterior pero para hacerlo manual

Frases Frases obligatorias, en la industria química, según las características del producto

F.T.S./Planes de limpieza contiene los siguientes

> Tipos de F.T.S. o planes de limpieza gestiona los diferentes tipos de planes de limpiez y F.T.S.

> Entrega de F.T.S. o planes de limpieza gestiona los planes de limpieza y F.T.S. entregados y el documento a firmar por el cliente

Cierre del año y borrado de anteriores Cierra el año y abre uno nuevo también permite borrar los datos de años anteriores*

Ver datos de años cerrados Realmente es otra aplicación que permite ver los datos de años borrados]

Partes de fabricación (manual) Partes de fabricación para rellenarlos a mano, incluye trazabilidad manual

Cambiar impuesto a clientes Cambia el impuesto de uno o varios clientes (1)

Códigos de barras Imprime varias filas o toda la hoja adhesiva con códigos de barra

Mantenimiento (1) permite cambiar los numeradores

(1) cosas que me pidieron al vender la empresa, realmente se podían hacer desde otros apartados, pero los solicitaron.

*Realmente antes de borrar el año creamos una copia de la bd con la fecha, para poder consultar datos de años ya borrados

( F.T.S = Ficha técnica y de Seguridad)

José Luis Garcí
11-08-2013, 14:53:44
Ahora Contratos

Alquileres Gestión de alquileres

Contrato dosificadores Gestión de contrato de dosificadores y partes de reparación de los mismos

José Luis Garcí
11-08-2013, 14:55:43
El menú vehículos contiene sólo

Gestión de vehículos ya dado, lo que pasa que en este ademas tiene la gestión de reparaciones y talleres (un maestro Detail)

José Luis Garcí
11-08-2013, 15:00:40
Ahora el menú utilidades

Cambiar fecha y hora del Sistema llama a panel de control a Fecha y hora

Calculadora llama a la calculadora del sistema

Notas llama al Wordpad

Contactos ya dado es nuestra agenda

Copiar/Restaurar B.D. La copia de seguridad o restauración desde la misma, realmente es una aplicación en si misma a la que le hacemos una llamada

José Luis Garcí
11-08-2013, 15:03:57
El menú de contabilidad sólo contiene

Cajas Gestión para hacer la caja, se puede usar diariamente, lo que yo hacia era usarla mensualmente.

José Luis Garcí
11-08-2013, 15:05:24
Bueno con esto ya he dado todo los apartados que tenia en mi programa original, espero os sirva de algo, o por lo menos os pueda ayudar.

José Luis Garcí
11-08-2013, 17:00:46
Ahora pongo alguno de los documentos de mi anterior programa por si os valen de inspiración

http://nsae01.casimages.net/img/2013/08/11/130811043125633909.jpg (http://www.casimages.es/i/130811043125633909.jpg.html)

José Luis Garcí
11-08-2013, 17:12:54
La autorización bancaria

http://nsae01.casimages.net/img/2013/08/11/130811044514781133.jpg (http://www.casimages.es/i/130811044514781133.jpg.html)

José Luis Garcí
11-08-2013, 17:14:01
El contrato de dosificadores

http://nsae01.casimages.net/img/2013/08/11/130811044630937928.jpg (http://www.casimages.es/i/130811044630937928.jpg.html)

José Luis Garcí
11-08-2013, 17:16:06
La entrega de F.T.S. y planes de limpieza

http://nsae01.casimages.net/img/2013/08/11/130811044811156562.jpg (http://www.casimages.es/i/130811044811156562.jpg.html)

José Luis Garcí
11-08-2013, 17:18:16
un inventario

http://nsae01.casimages.net/img/2013/08/11/130811045042246625.jpg (http://www.casimages.es/i/130811045042246625.jpg.html)

José Luis Garcí
11-08-2013, 17:20:01
Las Retenciones

http://nsae01.casimages.net/img/2013/08/11/130811045225775.jpg (http://www.casimages.es/i/130811045225775.jpg.html)

José Luis Garcí
11-08-2013, 17:22:32
y después de este largo monologo, doy por terminado el tutorial, creo que para hacerse a ratos y usando en parte la base del otro programa (sobre todo al final) ha quedado decente, ahora falta vuestra parte, comentarios, aportes, criticas y demás. Así que si te ha servido lo más mínimo, deja tu comentario.

Casimiro Notevi
11-08-2013, 17:24:48
GRAN TRABAJO v:-)v

José Luis Garcí
11-08-2013, 17:38:00
GRAN TRABAJO v:-)v

Eso, lo de las piramides :D:D:D

Solo espero que realmente se a de utilidad y los comentarios, al igual que espero los de la demo del touch, pero parece que la crisis también ha llegado a los comentarios y criticas.

José Luis Garcí
21-08-2013, 10:33:11
Despúes de una semana y no hay comentarios, vagetes:D:D:D

kokorski
25-08-2013, 20:02:11
La vacaciones nos hacen vagos...

Enhorabuena por tu aportacion y gracias por la parte que me toca, porque estoy seguro que no solo a mi sino a muchos mas les habras aclarado un monton de conceptos


Gracias de nuevo por tu esfuerzo y por compartirlo....

José Luis Garcí
09-09-2013, 09:52:53
Que nadie ha probado la demo?
No existen comentarios?
Tan malo soy? :D:D:D

Neftali [Germán.Estévez]
09-09-2013, 09:56:32
Acabo de llegar, pero ya cuando me fui estabas con el tema.
coincido es que todo el tutorial en un gran trabajo.

Gracias por compartirlo.

José Luis Garcí
09-09-2013, 10:05:27
Acabo de llegar, pero ya cuando me fui estabas con el tema.
coincido es que todo el tutorial en un gran trabajo.

Gracias por compartirlo.

Una gota comparado con el mar de conocimientos que aporta otros compañeros incluido tu

fjcg02
09-09-2013, 13:21:12
Aupa Jose Luis,

la versión compilada del proyecto que está colgada en el ftp es la última ?

Saludos

José Luis Garcí
09-09-2013, 18:38:14
Si no la he podido tocar más, por?