03e4452dba
- Agregado soporte de evaluación de propiedades desde archivo externo (props_*.txt) - Agregado soporte de evaluación de propiedades por clase - La propiedad Picture de una clase form se pierde y no muestra la imagen. No ocurre con la propiedad Picture de los controles (Fidel Charny) - Algunas opciones del optiongroup pierden el width cuando se subclasan de una clase con autosize=.T. (Miguel Duran)
225 lines
6.7 KiB
Plaintext
225 lines
6.7 KiB
Plaintext
* *********************************************************************
|
||
* *
|
||
* * 2013/12/09 FB2P_DBC.DBC 22:32:26
|
||
* *
|
||
* *********************************************************************
|
||
* *
|
||
* * Description:
|
||
* * This program was automatically generated by GenDBCX Version 1.1,
|
||
* * a modified version of Microsoft's utility GenDBC Version 2.26.67.
|
||
* *
|
||
* *********************************************************************
|
||
|
||
|
||
LPARAMETERS tcMethod
|
||
LOCAL oDBC
|
||
oDBC = CreateObject('GenDBCX')
|
||
IF TYPE('oDBC') != 'O'
|
||
RETURN
|
||
ENDIF
|
||
cExactSet = SET('EXACT')
|
||
SET EXACT ON
|
||
IF EMPTY(tcMethod)
|
||
=oDBC.GenerateAll()
|
||
ELSE
|
||
=EVALUATE('oDBC.' + tcMethod)
|
||
ENDIF
|
||
IF cExactSet = 'OFF'
|
||
SET EXACT OFF
|
||
ENDIF
|
||
|
||
|
||
DEFINE CLASS GenDBCX AS Custom
|
||
PROTECTED aTables[1]
|
||
PROTECTED nTables
|
||
|
||
PROCEDURE CustomProcess
|
||
*-- Your code goes here
|
||
ENDPROC
|
||
|
||
PROCEDURE Init
|
||
IF FILE('FB2P_DBC.DBC')
|
||
OPEN DATABASE FB2P_DBC.DBC
|
||
this.nTables = ADBOBJECTS(this.aTables, 'Table')
|
||
ENDIF
|
||
LOCAL ARRAY xx[1]
|
||
IF ADIR(xx,'*.DBC') > 0 OR ADIR(xx,'*.DBF') > 0
|
||
IF MessageBox('Warning! This program will overwrite your existing database and tables! Continue?', 308, 'GenDBCX Warning...') != 6
|
||
RETURN .F.
|
||
ENDIF
|
||
ENDIF
|
||
ENDPROC
|
||
|
||
PROCEDURE CreateDBC
|
||
*-- Create the Database Container
|
||
CLOSE DATA ALL
|
||
CREATE DATABASE 'FB2P_DBC.DBC'
|
||
|
||
********* Procedure Re-Creation *********
|
||
IF !FILE([FB2P_DBC.krt])
|
||
? [Warning! No Procedure File Found!]
|
||
ELSE
|
||
CLOSE DATABASE
|
||
USE 'FB2P_DBC.DBC'
|
||
g_SetSafety = SET('SAFETY')
|
||
SET SAFETY OFF
|
||
LOCATE FOR Objectname = 'StoredProceduresSource'
|
||
IF FOUND()
|
||
APPEND MEMO Code FROM [FB2P_DBC.krt] OVERWRITE
|
||
REPLACE Code WITH SUBSTR(Code, 70, 13140)
|
||
ENDIF
|
||
LOCATE FOR Objectname = 'StoredProceduresObject'
|
||
IF FOUND()
|
||
APPEND MEMO Code FROM [FB2P_DBC.krt] OVERWRITE
|
||
REPLACE Code WITH SUBSTR(Code, 13210)
|
||
ENDIF
|
||
IF UPPER(g_SetSafety) = 'ON'
|
||
SET SAFETY ON
|
||
ENDIF
|
||
USE
|
||
OPEN DATABASE [FB2P_DBC.DBC]
|
||
ENDIF
|
||
|
||
ENDPROC
|
||
|
||
|
||
**************************************************
|
||
** Table setup for NOMBRELARGODELDBF
|
||
**************************************************
|
||
PROCEDURE tbNOMBRELARGODELDBF
|
||
LPARAMETERS tnPassNumber
|
||
|
||
DO CASE
|
||
CASE tnPassNumber = 1
|
||
=this.RemoveTable('NOMBRELARGODELDBF', 'C:\DESA\FOXBIN2PRG\TESTS\DATOS_READONLY\FB2P_DBF.DBF')
|
||
|
||
CREATE TABLE 'FB2P_DBF.DBF' NAME 'NOMBRELARGODELDBF' ( ;
|
||
NOMBRE C(30) NOT NULL CHECK .NOT.EMPTY(nombre) ERROR "El nombre est<73> vac<61>o" DEFAULT ".", ;
|
||
EDAD N(3, 0) NOT NULL, ;
|
||
ID I NOT NULL, ;
|
||
BIGTEXT M NOT NULL, ;
|
||
DEPTO C(10) NOT NULL ;
|
||
)
|
||
***** Create each index for NOMBRELARGODELDBF *****
|
||
SET COLLATE TO 'MACHINE'
|
||
ALTER TABLE 'NOMBRELARGODELDBF' ADD PRIMARY KEY ID TAG ID
|
||
SET COLLATE TO 'GENERAL'
|
||
INDEX ON NOMBRE TAG I_NOMBRE
|
||
SET COLLATE TO 'MACHINE'
|
||
INDEX ON DEPTO TAG DEPTO
|
||
|
||
CASE tnPassNumber = 2
|
||
***** Change properties for NOMBRELARGODELDBF *****
|
||
DBSetProp('NOMBRELARGODELDBF.NOMBRE', 'Field', 'Caption', "'Nombre:'")
|
||
DBSetProp('NOMBRELARGODELDBF.NOMBRE', 'Field', 'Comment', "Comentario de 'Nombre'")
|
||
DBSetProp('NOMBRELARGODELDBF.NOMBRE', 'Field', 'InputMask', "!XXXXXXXXXXXXXXXXXXXXXXXXXXXXX")
|
||
DBSetProp('NOMBRELARGODELDBF.NOMBRE', 'Field', 'Format', "A")
|
||
DBSetProp('NOMBRELARGODELDBF', 'Table', 'Comment', "Comentario de la tabla 'fb2p_dbf'")
|
||
CREATE TRIGGER ON 'NOMBRELARGODELDBF' FOR DELETE AS del_trg()
|
||
CREATE TRIGGER ON 'NOMBRELARGODELDBF' FOR INSERT AS __ri_insert_nombrelargodeldbf().AND.(ins_trg())
|
||
CREATE TRIGGER ON 'NOMBRELARGODELDBF' FOR UPDATE AS __ri_update_nombrelargodeldbf().AND.(upd_trg())
|
||
ALTER TABLE 'NOMBRELARGODELDBF' SET CHECK edad>10 ERROR "Mensaje de error de la regla edad > 10"
|
||
ENDCASE
|
||
ENDPROC
|
||
|
||
|
||
**************************************************
|
||
** Table setup for FB2P_DEPTO
|
||
**************************************************
|
||
PROCEDURE tbFB2P_DEPTO
|
||
LPARAMETERS tnPassNumber
|
||
|
||
DO CASE
|
||
CASE tnPassNumber = 1
|
||
=this.RemoveTable('FB2P_DEPTO', 'C:\DESA\FOXBIN2PRG\TESTS\DATOS_READONLY\FB2P_DEPTO.DBF')
|
||
|
||
CREATE TABLE 'FB2P_DEPTO.DBF' NAME 'FB2P_DEPTO' ( ;
|
||
DEPTO C(10) NOT NULL, ;
|
||
DESCRIP C(50) NOT NULL ;
|
||
)
|
||
***** Create each index for FB2P_DEPTO *****
|
||
SET COLLATE TO 'MACHINE'
|
||
ALTER TABLE 'FB2P_DEPTO' ADD PRIMARY KEY DEPTO TAG DEPTO
|
||
|
||
CASE tnPassNumber = 2
|
||
***** Change properties for FB2P_DEPTO *****
|
||
DBSetProp('FB2P_DEPTO', 'Table', 'Comment', "Comentario de 'fb2p_depto'")
|
||
CREATE TRIGGER ON 'FB2P_DEPTO' FOR DELETE AS __ri_delete_fb2p_depto()
|
||
ENDCASE
|
||
ENDPROC
|
||
|
||
|
||
***** Relations Setup *****
|
||
PROCEDURE SetRelations
|
||
ALTER TABLE 'NOMBRELARGODELDBF' ADD FOREIGN KEY TAG DEPTO REFERENCES FB2P_DEPTO TAG DEPTO
|
||
ENDPROC
|
||
|
||
***** Referential Integrity Setup *****
|
||
PROCEDURE SetRI
|
||
CLOSE DATABASE
|
||
USE 'FB2P_DBC.DBC'
|
||
LOCATE FOR ObjectType = 'Table' AND UPPER(ALLTRIM(ObjectName)) == 'NOMBRELARGODELDBF'
|
||
IF FOUND()
|
||
nObjectID = ObjectID
|
||
LOCATE FOR ObjectType = 'Relation' AND 'depto'$Property AND 'fb2p_depto'$Property AND 'depto'$Property AND ParentID = nObjectID
|
||
IF FOUND()
|
||
REPLACE RiInfo WITH 'ICR '
|
||
ELSE
|
||
? "Could not set RI Information, line " + ltrim(str(lineno()))
|
||
ENDIF
|
||
ENDIF
|
||
USE
|
||
ENDPROC
|
||
|
||
FUNCTION RemoveTable(tcTable, tcFile)
|
||
LOCAL ARRAY laTables[1]
|
||
=ADBOBJECTS(laTables,'Table')
|
||
IF ASCAN(laTables,tcTable) = 0
|
||
*-- No such table in the current dbc, nothing to do!
|
||
RETURN .t.
|
||
ENDIF
|
||
IF !FILE(tcFile)
|
||
*-- If the file has been erased, REMOVE TABLE fails with a 'File does not
|
||
*-- exist' error, because it can't find the file to either remove its
|
||
*-- database reference or delete the file .
|
||
*-- We'll work around this problem by creating a phony file with the same
|
||
*-- name, and use REMOVE TABLE DELETE to both remove the table reference
|
||
*-- in the dbc, and erase the phony file.
|
||
LOCAL lhFile
|
||
lhFile = FCREATE(tcFile)
|
||
IF lhFile = -1
|
||
RETURN .f.
|
||
ENDIF
|
||
=FCLOSE(lhFile)
|
||
ENDIF
|
||
REMOVE TABLE (tcTable) DELETE
|
||
=ADBOBJECTS(laTables,'Table')
|
||
RETURN ASCAN(laTables,tcTable) = 0
|
||
ENDFUNC
|
||
|
||
|
||
PROCEDURE GenerateAll
|
||
=this.CreateDBC()
|
||
=this.CreateTables()
|
||
|
||
*-- Call custom method
|
||
=this.CustomProcess()
|
||
|
||
=this.RulesTriggersProperties()
|
||
=this.SetRelations()
|
||
=this.SetRI()
|
||
ENDPROC
|
||
|
||
PROCEDURE CreateTables
|
||
*-- Create Tables
|
||
=this.tbNOMBRELARGODELDBF(1)
|
||
=this.tbFB2P_DEPTO(1)
|
||
ENDPROC
|
||
|
||
PROCEDURE RulesTriggersProperties
|
||
*-- Finish Tables (add rules/triggers/properties)
|
||
=this.tbNOMBRELARGODELDBF(2)
|
||
=this.tbFB2P_DEPTO(2)
|
||
ENDPROC
|
||
ENDDEFINE
|