Context Navigation

beditmaster.tcl @ bdc524a

1941-docker-image-to-testdevel

Last change on this file since bdc524a was bdc524a, checked in by Jorge Pérez <josp.jorge@…>, 18 years ago

svn:eol-style native

git-svn-id: https://www.tol-project.org/svn/tolp/trunk@154 be4846ae-f051-483a-831f-b64e7d08527f

Property mode set to 100644

File size: 85.9 KB

Line
1	#/////////////////////////////////////////////////////////////////////////////
2	# FILE : beditmaster.tcl
3	# PURPOSE : Bayes Editor Maestro. Editor de registros de tablas de una Base
4	# de datos. .ed
5	# TODO:
6	#
7	#/////////////////////////////////////////////////////////////////////////////
8	# includes
9
10	package require byscommon
11
12	#/////////////////////////////////////////////////////////////////////////////
13	#
14	# To use this source you must create a global variable containing the
15	# required information about the table and fields that will be shown.
16	# Take a look at the following information about each field:
17	#
18	#/////////////////////////////////////////////////////////////////////////////
19	# tablename
20	# regFields($index,TYPE): Structure to store all information regarding table
21	# columns (fields)
22	# Each one of the table fields has a unique index.
23	#
24	#/////////////////////////////////////////////////////////////////////////////
25	#
26	# The TYPE field is as follows:
27	#
28	# ptr -> The widget's name.
29	# label -> Description to print next to the widget.
30	# nameField -> The name of the database's field/s in a space separated list.
31	#
32	# typeField -> Type of the field "nameField" above in a space separated list.
33	# iskey -> It indicates if the field is PK, and therefore has influence in
34	# the rest of fields in the form. It can also give information about how
35	# many PK there are.
36	# masterTable -> Table name in case it is a child field. Otherwise DO NOT
37	# define this field.
38	# masterTableCode -> Master table code field's name. Same as masterTable field
39	# masterTableDesc -> Master table description field's name. Same as above.
40	#
41	#/////////////////////////////////////////////////////////////////////////////
42	#
43	# NOTE: The way RegBox is stored is not as a matrix, but as a simple
44	# array with the string "N,type" as each index. Therefore, the index "N, name"
45	# (with a space between both "indexes") will NOT work!
46	#
47	# The module that calls beditmaster must define this variables correctly
48	# BEFORE creating the widget (That is, before calling beditmaster).
49	#
50	#/////////////////////////////////////////////////////////////////////////////
51	# Do we need a fifth state? It would be "Duplicating" state: dup.
52	# status: Defines the state of the form (sel,edi,vis,ins):
53	# "sel" - Select
54	# "edi" - Edit
55	# "vis" - Visualization
56	# "ins" - Insert -> Will be duplicate too.
57	#
58	#/////////////////////////////////////////////////////////////////////////////
59	# Variables internas de BEditMaster
60	#/////////////////////////////////////////////////////////////////////////////
61	#
62	# fieldInfo($index,field,name) # nombre del campo
63	# fieldInfo($index,field,type) # tipo y tamaño, en formato lista
64	# fieldInfo($index,field,iskey) # indica si es clave
65	# fieldInfo($index,field,label) # texto a mostrar
66	# # (de no proporcinarse se iguala al name)
67	# fieldInfo($index,field,notnull) # indica si es obligatorio o no
68	# # (si es clave, es obligatorio)
69	# fieldInfo($index,field,fkMRes) # foreing key en la que mas restrictiva
70	# # del campo
71	# fieldInfo($index,field,edit) # Indica si el campo es editable o no
72	# fieldInfo($index,field,ptr) # path del objeto en el que se visualiza
73	# fieldInfo($index,field,links) # lista de enlaces a otros formularios ediMaestro
74	# # (se pasa el procedimiento Show)
75	# uno por enlace
76	# fieldInfo($index,field,$i,link) # procedimiento a llamar al pulsar el boton
77	# # del enlace
78	#
79	# informacion de los campos descriptivos sobre el campo
80	# fieldInfo($index,desc,table) # tabla en la que se encuentra la descripcion
81	# fieldInfo($index,desc,join) # nombre del campo de esta tabla al que hace
82	# # referencia, de no proporcionrse es igual a
83	# # $fieldInfo($index,field,name)
84	# fieldInfo($index,desc,show) # indica si el campo tiene descripcion
85	# fieldInfo($index,desc,lstfields) # lista completa con los campos a mostrar en la selecion
86	# fieldInfo($index,desc,lstshow) # lista de campos descripcion a mostrar
87	# fieldInfo($index,desc,lstselect) # lista de campos a mostrar en una seleccion +
88	# # fieldInfo($index,desc,lstshow)
89	#
90	# uno por campos a mostrar
91	# fieldInfo($index,desc,$i,name) # nombre del campo
92	# fieldInfo($index,desc,$i,edit) # indica si es editable
93	# fieldInfo($index,desc,$i,type) # tipo y tamaño, en formato lista
94	# fieldInfo($index,desc,$i,notnull) # indica si es obligatorio o no
95	# # (si es clave, es obligatorio)
96	# fieldInfo($index,desc,$i,ptr) # path del objeto en el que se visualiza
97	# # ?????????????? Hay que calcularle al
98	# # crear el bcomboboxplus
99	#
100	#
101	# informacion de las claves externas, solo se proporciona de existir
102	# fieldFkInfo($indexFk,table) # tabla a la que hace referencia
103	# fieldFkInfo($indexFk,indFie) # lista de campos a los que hace referencia
104	# fieldFkInfo($indexFk,fields) # nombre de los campos en la tabla referenciada
105	#
106	#
107	#/////////////////////////////////////////////////////////////////////////////
108	# Informacion proporcionada
109	#/////////////////////////////////////////////////////////////////////////////
110	#
111	# regFields($index,field,name) # nombre del campo (*)
112	# regFields($index,field,type) # tipo y tamaño, en formato lista (*)
113	# regFields($index,field,iskey) # indica si es clave (*)
114	# regFields($index,field,label) # texto a mostrar
115	# regFields($index,field,notnull) # indica si es obligatorio o no
116	# # (si es clave, es obligatorio)
117	# regFields($index,field,fkMRes) # foreing key en la que mas restrictiva
118	# # del campo
119	# regFields($index,field,links) # lista de enlaces a otros formularios ediMaestro
120	# # (se pasa el procedimiento Show)
121	#
122	## informacion de los campos descripcion sobre el campo, solo se proporciona de existir
123	# regFields($index,desc,table) # tabla en la que se encuentra la descripcion (*)
124	# regFields($index,desc,join) # nombre del campo de esta tabla al que
125	# # hace referencia
126	# regFields($index,desc,lstshow) # lista de campos descripcion a mostrar
127	# regFields($index,desc,lstselect) # lista de campos a mostrar en la seleccion +
128	# # regFields($index,desc,lstshow)
129	# regFields($index,desc,lstedit) # lista que indica si los campos de
130	# # "lstshow" son editables o no
131	# regFields($index,desc,lsttype) # si los campos son editables,
132	# # se especifica su tipo en formato lista de listas
133	# regFields($index,desc,lstnotnull) # si los campos son editables,
134	# # se especifica si son obligatorios o no en formato lista
135	#
136	# informacion de las claves externas, solo se proporciona de existir
137	# regFk($indexFk,table) # tabla a la que hace referencia (*)
138	# regFk($indexFk,indFie) # lista de campos a los que hace referencia (*)
139	# regFk($indexFk,fields) # nombre de los campos en la tabla referenciada (*)
140
141	#/////////////////////////////////////////////////////////////////////////////
142	::snit::widget beditmaster {
143	#
144	# PURPOSE: Definición de las funcionalidades de un BayesEditorMaster
145	#
146	#/////////////////////////////////////////////////////////////////////////////
147	#/////////////////////////////////////////////////////////////////////////////
148	# options:
149	# -table -> Primary table name.
150	# -parent -> Parent widget. Used to exit gently.
151	# -bodbcmodule -> Object of type bodbcmodule to obtain connection and
152	# -connection -> Name of connection to Data Base in TCL
153	# -prociscode -> Function get 'code' of table.
154	# Parameters: -table -> name of table
155	# -fields -> fields of table
156	# Return: index of fields that they fulfill the condition
157	# -procisdesc -> Function get 'description' of table.
158	# Parameters: -table -> name of table
159	# -fields -> fields of table
160	# Return: index of fields that they fulfill the condition
161	#
162	#/////////////////////////////////////////////////////////////////////////////
163	widgetclass BEditMaster
164
165	option -table ""
166	option -parent ""
167	option -bodbcmodule ""
168	#option -connection ""
169	#In the future, it will be possible to just give this information:
170	#(But that requires mysql, MSSQL, Oracle, postgree info query models)
171	option -regfields
172	option -regfk
173	option -maxfield
174	option -autoload false
175	option -prociscode {}
176	option -procisdesc {}
177
178	variable tablename
179	variable bodbcmodule
180	# Conexion tclodbc (se obtiene de bodbcmodule)
181	variable connection
182	# Gestor de BBDD: Ora (Oracle), Mic (SQLServer), Mys (MySQL)
183	# (se obtiene de bodbcmodule)
184	variable gestor
185	variable maxFields
186	variable fieldInfo
187	variable fieldFkInfo
188	variable status
189	variable widget
190	variable oldValues
191	variable prociscode
192	variable procisdesc
193	#Don't use it, but will in the future:
194	variable oldStatus
195
196	variable data
197	variable step 0
198
199	#///////////////////////////////////////////////////////////////////////////
200	typeconstructor {
201	#
202	# PURPOSE: beditmaster typeconstructor
203	#
204	#///////////////////////////////////////////////////////////////////////////
205	global tcl_platform
206	global toltk_options
207	if { [string equal $tcl_platform(platform) "windows"] } {
208	set toltk_options(colors,SystemButtonFace) SystemButtonFace
209	} else {
210	set toltk_options(colors,SystemButtonFace) #d4d4d4
211	}
212	}
213
214
215	#///////////////////////////////////////////////////////////////////////////
216	constructor {args} {
217	#
218	# PURPOSE: beditmaster constructor
219	#
220	# PARAMETERS:
221	# args ->
222	#
223	#///////////////////////////////////////////////////////////////////////////
224	#puts "BEditMaster: args : $args"
225	# CONSTANTES
226	# Tomamos como campo codigo aquel que tenga el nombre:
227	# 'code' o 'codigo'
228	set data(codes) {code codigo}
229	# Tomamos como campo descripcion aquel que tenga el nombre:
230	# 'description', 'descripcion', 'descricao'
231	set data(descritions) {description descripcion descricao name nombre}
232
233	# Apply all options passed at creation time.
234	$self configurelist $args
235
236	# cargamos valores
237	set tablename $options(-table)
238	set parent $options(-parent)
239	set autoload $options(-autoload)
240	#set connection $options(-connection)
241	set bodbcmodule $options(-bodbcmodule)
242	set connection [$bodbcmodule cget -connection]
243	set gestor [$bodbcmodule cget -gestor]
244	set prociscode $options(-prociscode)
245	set procisdesc $options(-procisdesc)
246	Tolcon_Trace "BODBCMODULE = $bodbcmodule, CONECTION = $connection, GESTOR = $gestor"
247	# autoload ?
248	if { $autoload } {
249	set lstInfo [$self InitTable]
250	if {[llength $lstInfo]} {
251	#puts "AutoLoad: $lstInfo"
252	array set fieldInfo [lindex $lstInfo 0]
253	array set fieldFkInfo [lindex $lstInfo 1]
254	set maxFields [lindex $lstInfo 2]
255	$self configure -maxfield $maxFields
256	$self configure -regfields [lindex $lstInfo 0]
257	$self configure -regfk [lindex $lstInfo 1]
258	} else {
259	tk_messageBox -icon error \
260	-message [mc "An error has taken place during the creation of the form, reason why this it could not be visualized"] \
261	-parent $parent \
262	-title [mc "Edit Master"] \
263	-type ok
264	return 0
265	}
266	} else {
267	array set fieldInfo $options(-regfields)
268	array set fieldFkInfo $options(-regfk)
269	set maxFields $options(-maxfield)
270	}
271
272
273	ScrolledWindow $self.sw -relief sunken -borderwidth 2
274	ScrollableFrame $self.sw.fr -constrainedwidth 1
275	$self.sw setwidget $self.sw.fr
276	set widget(frc) [$self.sw.fr getframe]
277
278	# Configuracion del formulario:
279	# 1.- datos del registro
280	set widget(tf,pk) [TitleFrame $widget(frc).pk -text [mc "Key Fields"]]
281	set widget(tf,pk,fr) [$widget(frc).pk getframe]
282	# -highlightthickness 2
283	# 2.- rejilla de datos
284	set widget(tf,data) [TitleFrame $widget(frc).data -text [mc "Non Key Fields"]]
285	set widget(tf,data,fr) [$widget(frc).data getframe]
286	# 3.- extra grid
287	set widget(fr,extra) [frame $widget(frc).extra]
288
289	#Now we create the form:
290	$self createForm $widget(tf,pk,fr) $widget(tf,data,fr)
291
292	# 3.- barra de botones
293	set widget(bbox) \
294	[ButtonBox $self.bb -orient horizontal -spacing 0 -padx 0 -pady 0 \
295	-homogeneous false]
296
297	set widget(bbox,inf) \
298	[ButtonBox $self.bbinf -orient horizontal -spacing 0 -padx 0 -pady 0 \
299	-homogeneous false]
300
301	set widget(bt,duplicate) \
302	[$widget(bbox) add -text [mc "Duplicate"] -relief link \
303	-state disable -command [list $self botdup] \
304	-helptext [mc "Duplicate"] -disabledforeground ""\
305	-image [::Bitmap::get duplicate] -compound left -padx 1 -pady 1]
306	set widget(bt,new) \
307	[$widget(bbox) add -text [mc "New"] -relief link \
308	-command [list $self botnew] \
309	-helptext [mc "New"] -disabledforeground ""\
310	-image [Bitmap::get MODFile] -compound left -padx 1 -pady 1]
311	set widget(bt,edit) \
312	[$widget(bbox) add -text [mc "Edit"] -relief link \
313	-state disable -command [list $self botedi] \
314	-helptext [mc "Edit current"] -disabledforeground ""\
315	-image [Bitmap::get edit] -compound left -padx 1 -pady 1]
316	set widget(bt,save) \
317	[$widget(bbox) add -text [mc "Save"] -relief link \
318	-state disable -command [list $self botgua] \
319	-helptext [mc "Save current"] -disabledforeground ""\
320	-image [Bitmap::get bsave] -compound left -padx 1 -pady 1]
321	set widget(bt,cancel) \
322	[$widget(bbox) add -text [mc "Cancel"] -relief link \
323	-state disable -command [list $self botcan] \
324	-helptext [mc "Cancel operation"] -disabledforeground ""\
325	-image [Bitmap::get cancelx] -compound left -padx 1 -pady 1]
326	set widget(bt,delete) \
327	[$widget(bbox,inf) add -text [mc "Delete"] -relief link \
328	-state disable -command [list $self boteli] \
329	-helptext [mc "Delete current"] -disabledforeground ""\
330	-image [Bitmap::get delete] -compound left -padx 1 -pady 1]
331	set widget(bt,clear) \
332	[$widget(bbox,inf) add -text [mc "Clear"] -relief link \
333	-command [list $self botlim ] \
334	-helptext [mc "Clear form"] -disabledforeground ""\
335	-image [Bitmap::get Clear] -compound left -padx 1 -pady 1]
336	set widget(bt,refresh) \
337	[$widget(bbox,inf) add -text [mc "Refresh"] -relief link \
338	-command [list $self botref ] \
339	-helptext [mc "Refresh form"] -disabledforeground ""\
340	-image [Bitmap::get refresh] -compound left -padx 1 -pady 1]
341	set widget(bt,open) \
342	[$widget(bbox,inf) add -text [mc "Open"] -relief link \
343	-command [list $self botabr] -state disabled \
344	-helptext [mc "Open table"] -disabledforeground ""\
345	-image [Bitmap::get opentable] -compound left -padx 1 -pady 1]
346	set widget(bt,exit) \
347	[$widget(bbox,inf) add -text [mc "Exit"] -relief link \
348	-command [list $self botsal $parent] \
349	-helptext [mc "Close window"] -disabledforeground ""\
350	-image [Bitmap::get exit] -compound left -padx 1 -pady 1]
351
352	# Empacar
353	pack $widget(bbox,inf) -side bottom -fill x -expand no
354	pack $widget(bbox) -side bottom -fill x -expand no
355
356	pack $self.sw -side top -fill both -expand yes
357
358	#set status "sel"
359	set status "sel"
360	$self setStatus "sel"
361	# Fill out the form with all database values:
362	# $self fillForm
363	# Show the form to the user:
364	$self showForm
365	}
366
367	#/////////////////////////////////////////////////////////////////////////////
368	onconfigure -regfields {value} {
369	#/////////////////////////////////////////////////////////////////////////////
370	array set fieldInfo $value
371	for {set x 1} {[expr $x <= [$self cget -maxfield]]} {incr x} {
372	# comprobamos label
373	if {![info exists fieldInfo($x,field,label)]} {
374	set fieldInfo($x,field,label) $fieldInfo($x,field,name)
375	}
376	# comprobamos los botones de edicion especificados
377	if {[info exists fieldInfo($x,field,links)]} {
378	for {set idx 0} {$idx < [llength $fieldInfo($x,field,links)]} {incr idx} {
379	set fieldInfo($x,link,[expr $idx+1],proc) [lindex $fieldInfo($x,field,links) $idx]
380	}
381	}
382	# comprobamos si el codigo es editable
383	if {![info exists fieldInfo($x,field,edit)]} {
384	if {[info exists fieldInfo($x,field,fkMRes)]} {
385	set fieldInfo($x,field,edit) false
386	} else {
387	set fieldInfo($x,field,edit) true
388	}
389	}
390	# comprobamos que exista descripcion
391	if {[info exists fieldInfo($x,desc,table)]} {
392	set lstfields {}
393	# comprobamos join
394	if {![info exists fieldInfo($x,desc,join)]} {
395	set fieldInfo($x,desc,join) $fieldInfo($x,field,name)
396	}
397	# lista de campos a mostar al seleccionar, primero es el codigo
398	lappend lstfields $fieldInfo($x,desc,join)
399	# indicamos que tiene descripcion
400	set fieldInfo($x,desc,show) true
401	# guardamos informacion sobre los campos descripcion a mostrar
402	# nombres
403	set i 1
404	# if {[info exists fieldInfo($x,desc,lstshow)]}
405	if {[info exists fieldInfo($x,desc,lstshow)] && \
406	[llength $fieldInfo($x,desc,lstshow)]} {
407	foreach n $fieldInfo($x,desc,lstshow) {
408	lappend lstfields $n
409	set fieldInfo($x,desc,$i,name) $n
410	# por defecto edit -> false
411	set fieldInfo($x,desc,$i,edit) false
412	incr i
413	}
414	} else {
415	set fieldInfo($x,desc,lstshow) {}
416	# comrpbamos que tenga valor 'true', si es asi lo dejamos con su valor
417	if {[info exists fieldInfo($x,desc,show)] && \
418	[string length $fieldInfo($x,desc,show)] && \
419	!($fieldInfo($x,desc,show))} {
420	set fieldInfo($x,desc,show) false
421	}
422	}
423	# edit
424	set i 1
425	if {[info exists fieldInfo($x,desc,lstedit)]} {
426	foreach e $fieldInfo($x,desc,lstedit) {
427	set fieldInfo($x,desc,$i,edit) $e
428	incr i
429	}
430	}
431	# tipo
432	if {[info exists fieldInfo($x,desc,lsttype)]} {
433	set i 1
434	foreach t $fieldInfo($x,desc,lsttype) {
435	set fieldInfo($x,desc,$i,type) $t
436	incr i
437	}
438	}
439	# notnull
440	if {[info exists fieldInfo($x,desc,lstnotnull)]} {
441	set i 1
442	foreach nn $fieldInfo($x,desc,lstnotnull) {
443	set fieldInfo($x,desc,$i,notnull) $nn
444	incr i
445	}
446	}
447	# lista de campos para la selecciona
448	if {[info exists fieldInfo($x,desc,lstselect)]} {
449	foreach n $fieldInfo($x,desc,lstselect) {
450	lappend lstfields $n
451	}
452	}
453	set fieldInfo($x,desc,lstfields) $lstfields
454	} else {
455	set fieldInfo($x,desc,show) false
456	}
457	}
458	}
459
460	#///////////////////////////////////////////////////////////////////////////
461	method createForm {fpk fdata} {
462	#
463	# PURPOSE: Create all widgets needed for the form.
464	# The widgets are created acording to the information given in fieldInfo:
465	# fieldInfo(X,iskey) -> BComboBox
466	# (!fieldInfo(X,iskey) AND fieldInfo(X,MasterTable)) -> BComboBox
467	# TODO:
468	# fieldInfo(X,typefield) = datetime ->
469	#::Objects::ChooseDateCreate ::TolConsole::tmpOpt(var,DefLast) $frame.cLD
470	# else -> Entry
471	#
472	# PARAMETERS:
473	# fpk : path del frame de las primary key
474	# fdata : path del frame de los valores
475	# RETURN:
476	#
477	#///////////////////////////////////////////////////////////////////////////
478	for {set x 1} {$x<=$maxFields} {incr x} {
479	if {$fieldInfo($x,field,iskey)} {
480	# campos claves
481	label $fpk.label$x -text $fieldInfo($x,field,label) -fg blue
482	set fieldInfo($x,field,ptr) $fpk.cb$x
483	set widget(ptr,[string tolower $fieldInfo($x,field,name)]) $fieldInfo($x,field,ptr)
484	$self CreateSelectFields $x
485	} else {
486	# campos NO claves
487	if {$fieldInfo($x,field,notnull)} {
488	set clr blue
489	} else {
490	set clr black
491	}
492	label $fdata.label$x -text $fieldInfo($x,field,label) -fg $clr
493	if {$fieldInfo($x,desc,show)} {
494	set fieldInfo($x,field,ptr) $fdata.cb$x
495	set widget(ptr,[string tolower $fieldInfo($x,field,name)]) \
496	$fieldInfo($x,field,ptr)
497	$self CreateSelectFields $x
498	} else {
499	set fieldInfo($x,field,ptr) [$self CreateWidget $fdata $x]
500	set widget(ptr,[string tolower $fieldInfo($x,field,name)]) \
501	$fieldInfo($x,field,ptr)
502	}
503	}
504	}
505	}
506
507	#///////////////////////////////////////////////////////////////////////////
508	method CreateSelectFields {x} {
509	# PURPOSE:
510	# PARAMETERS:
511	# RETURN:
512	#///////////////////////////////////////////////////////////////////////////
513	#Tolcon_Trace "SELFNS=$selfns"
514	lappend lst_help "$fieldInfo($x,field,name) ($fieldInfo($x,field,type))"
515	#Tolcon_Trace "CreateSelectFields $x"
516	for {set i 0} {$i < [llength $fieldInfo($x,desc,lstshow)]} {incr i} {
517	set nam [lindex $fieldInfo($x,desc,lstshow) $i]
518	if {[info exists fieldInfo($x,desc,lsttype)]} {
519	set typ " ([lindex $fieldInfo($x,desc,lsttype) $i])"
520	} else {
521	set typ ""
522	}
523	lappend lst_help "$nam $typ"
524	}
525
526	#Tolcon_Trace ""
527	#Tolcon_Trace "lst_help=$lst_help"
528	if {([string length $fieldInfo($x,desc,lstshow)] eq 0)} {
529	set fields [list $fieldInfo($x,field,name)]
530	} else {
531	set fields [list $fieldInfo($x,field,name) $fieldInfo($x,desc,lstshow)]
532	}
533	update
534	set combo \
535	"bcomboboxplus $fieldInfo($x,field,ptr) \
536	-cols \"$fieldInfo($x,field,name) $fieldInfo($x,desc,lstshow)\" \
537	-colslb \"$fieldInfo($x,desc,lstfields)\" \
538	-titles \"$fieldInfo($x,desc,lstfields)\" \
539	-postcommand [list [list $self GetValuesShow $x]] \
540	-modifycmd [list [list $self botsel $x]] \
541	-helptexts [list $lst_help] \
542	-showlabels 0 \
543	-widthlb 600 \
544	-font {Arial 9} \
545	-nrows 15 \
546	-keypress true \
547	-colkeypress $fieldInfo($x,field,name)"
548	switch [string tolower [lindex $fieldInfo($x,field,type) 0]] {
549	# datetime y smalldatetime
550	"date" -
551	"datetime" -
552	"smalldatetime" {
553	set combo "$combo -keydate 1"
554	}
555	}
556	eval $combo
557	# guardamos los nombres de los objetos de las descripciones
558	if {$fieldInfo($x,desc,show)} {
559	set i 1
560	set allObj [$fieldInfo($x,field,ptr) getwidget]
561	if {$fieldInfo($x,field,edit)} {
562	#Tolcon_Trace "CreateSelectFields: configurando [lindex $allObj 0]"
563	[lindex $allObj 0] configure -validate key -vcmd \
564	[list SqlValidateData %P $fieldInfo($x,field,type)]
565	}
566	set objs [lrange $allObj 1 end]
567	foreach o $objs {
568	set fieldInfo($x,desc,$i,ptr) $o
569	# comprobamos si es editable, de serlo le activamos el control del
570	# texto introducido
571	if {[info exists fieldInfo($x,desc,$i,edit)] && \
572	[info exists fieldInfo($x,desc,$i,type)]} {
573	if {$fieldInfo($x,desc,$i,edit)} {
574	$o configure -validate key -vcmd \
575	[list SqlValidateData %P $fieldInfo($x,desc,$i,type)]
576	}
577	}
578	incr i
579	}
580	}
581	}
582
583	#///////////////////////////////////////////////////////////////////////////
584	method CreateWidget {path index} {
585	# PURPOSE:
586	# PARAMETERS:
587	# RETURN:
588	#///////////////////////////////////////////////////////////////////////////
589	global toltk_options
590	#TODO: controlar el tipo de objeto que hay que empacar
591	set typeField [string tolower [lindex $fieldInfo($index,field,type) 0]]
592	set ptr $path.entry$index
593	#set tbl $tablename
594	set lab $fieldInfo($index,field,name)
595	set typ $fieldInfo($index,field,type)
596
597	switch $typeField {
598	# datetime y smalldatetime
599	"date" -
600	"datetime" -
601	"smalldatetime" {
602	bentrydate $ptr
603	}
604	"bit" {
605	checkbutton $ptr -variable [string map {. ""} ::${ptr}var]
606	}
607	default {
608	set longVar [lindex $fieldInfo($index,field,type) 1]
609	set fc [string first , $longVar]
610	if {[expr $fc ne -1]} {
611	set longVar [string range $longVar 0 [expr $fc-1]]
612	}
613	if { ![string length $longVar] \|\| [expr $longVar <= 255] } {
614	Entry $ptr -editable false \
615	-helptext "$lab ($typ)" -validate key \
616	-background $toltk_options(colors,SystemButtonFace) \
617	-vcmd [list SqlValidateData %P $fieldInfo($index,field,type)]
618	} else {
619	text $ptr -yscrollcommand "${ptr}sb set" -height 4 \
620	-background $toltk_options(colors,SystemButtonFace)
621	scrollbar ${ptr}sb -command "${ptr} yview"
622	}
623	}
624	}
625	return $ptr
626	}
627
628
629	#///////////////////////////////////////////////////////////////////////////
630	method botsel {args} {
631	#
632	# PURPOSE: Method to call when selecting a new value in any widget.
633	#
634	# PARAMETERS:
635	# current_index -> Index to the RegComboBox "matrix".
636	#
637	#///////////////////////////////////////////////////////////////////////////
638	set current_index [lindex $args 0]
639	# si estamos en visualizacion
640	if {$status=="sel" \|\| $status=="vis"} {
641	if {[$self FillFieldKey]} {
642	# construimos sentencia
643	set select "select [join [$self GetLstFieldsTable] ,]"
644	set from "from $tablename"
645	set where "where [$self GetSqlWhere {}]"
646	set txtSql "$select \n $from \n $where"
647	#obtener los valores de statement, estan en info
648	# set values [$connection $txtSql]
649	# $connection statement info $txtSql
650	# mostramos valores en el formulario
651	$self SetValuesFields $txtSql
652	# mostramos descripciones de los campos
653	$self SetValuesFieldsDesc
654	# cambiamos de estado
655	$self setStatus "vis"
656	}
657	} elseif {$status=="ins" \|\| $status=="edi"} {
658	#TODO: comprobar si en este estado hay que hacer algo
659	}
660	}
661
662	#///////////////////////////////////////////////////////////////////////////
663	method GetValuesShow {index} {
664	# PURPUSE: funcion a previa a ejecutar al mostrar la lista de valores de un
665	# bcomboboxplus
666	# PARAMETERS: index -> registro activo
667	#
668	#///////////////////////////////////////////////////////////////////////////
669	# para visualizacion de datos de la propia tabla
670	if {$status=="sel" \|\| $status=="vis"} {
671	set where ""
672	set whe [$self GetSqlWhere ori. $index]
673	if {[string length $whe]} {
674	set where "where $whe \n"
675	}
676	if {[string equal $tablename $fieldInfo($index,desc,table)]} {
677	#Tolcon_Trace "GetValuesShow (1)"
678	# informacion de la misma tabla
679	set txtSql \
680	"select distinct [join $fieldInfo($index,desc,lstfields) ,] \n\
681	from $tablename ori \n\
682	$where \
683	order by [lindex $fieldInfo($index,desc,lstfields) 0]"
684	} else {
685	# informacion de la tabla referenciada
686	foreach f $fieldInfo($index,desc,lstfields) {
687	lappend fie "des.$f"
688	}
689	# unimos las tablas pro sus foreing key y campos descripcion
690	set wheJoin [$self GetJoin $index \
691	$fieldInfo($index,desc,table) \
692	ori. \
693	des.]
694
695	if {[string length $wheJoin]} {
696	set where "where $wheJoin \n"
697	}
698
699	if {[string length $whe]} {
700	if {[string length $where]} {
701	#concat $where " and $whe \n"
702	set where "$where \n and $whe \n"
703	} else {
704	set where "where $whe \n"
705	}
706	}
707	#Tolcon_Trace "GetValuesShow (2)"
708	set txtSql \
709	"select distinct [join $fie ,] \n\
710	from $fieldInfo($index,desc,table) des, $tablename ori \n\
711	$where \
712	order by des.[lindex $fieldInfo($index,desc,lstfields) 0]"
713	}
714	} elseif {$status=="edi" \|\| $status=="ins"} {
715	# valores de las tablas realcionadas
716	#Tolcon_Trace "GetValuesShow (3)"
717	set txtSql [$self GetSelectFk $index]
718	}
719	# asignamos valor al bselectfield correspondiente
720	#Tolcon_Trace "GetValuesShow: Consulta:\n $txtSql"
721	set lst [DBQuery $bodbcmodule $txtSql]
722	$fieldInfo($index,field,ptr) configure -values $lst
723	}
724
725	#///////////////////////////////////////////////////////////////////////////
726	method GetJoin {index tableDes prefOri prefDes} {
727	#
728	# PURPOSE:
729	#
730	# PARAMETERS:
731	#
732	# RETURN:
733	#
734	#///////////////////////////////////////////////////////////////////////////
735	set wheJoin {}
736	set ok 0
737	if {[info exists fieldInfo($index,field,fkMRes)]} {
738	set fkMRes $fieldInfo($index,field,fkMRes)
739	if {[string equal $tableDes $fieldFkInfo($fkMRes,table)]} {
740	set i 0
741	foreach id $fieldFkInfo($fkMRes,indFie) {
742	lappend wheJoin "$prefOri$fieldInfo($id,field,name) = \
743	$prefDes[lindex $fieldFkInfo($fkMRes,fields) $i]"
744	incr i
745	}
746	} else {
747	set ok 1
748	}
749	} else {
750	set ok 1
751	}
752	if {$ok} {
753	lappend wheJoin "$prefOri$fieldInfo($index,field,name) = \
754	$prefDes$fieldInfo($index,desc,join)"
755	}
756	return [join $wheJoin { and }]
757	}
758
759
760	#///////////////////////////////////////////////////////////////////////////
761	method setStatus {new} {
762	#
763	# PURPOSE: Change button state by the status value
764	#
765	# PARAMETERS: new -> New state.
766	#
767	# COMMENTS: A bit confusing to debug. Now it uses the new function
768	# ActivateWidget, and is much more readable.
769	#
770	#///////////////////////////////////////////////////////////////////////////
771	#Set widget status:
772	switch $status {
773	"sel" {
774	switch $new {
775	"sel" {
776	#Gets this on every launch:
777	#Tolcon_Trace "SetStatus: Change from select to select status."
778	# solo se pueden seleccionar los campos con lista de la primary key
779	for {set x 1} {$x<=$maxFields} {incr x} {
780	$self ActivateWidget $x $new
781	}
782	}
783	"edi" {
784	Tolcon_Trace "SetStatus: Change from select to edit status."
785	}
786	"vis" {
787	#Only change the buttons state.
788	}
789	"ins" {
790	#(Pushed new or duplicate button)
791	#set editable keys combos
792	#enable entries
793	for {set x 1} {$x<=$maxFields} {incr x} {
794	$self ActivateWidget $x $new
795	}
796	}
797	"old" {
798	}
799	}
800	}
801	"vis" {
802	switch $new {
803	"sel" {
804	}
805	"vis" {
806	}
807	"edi" {
808	#disable keys combos
809	#enable entries
810	for {set x 1} {$x<=$maxFields} {incr x} {
811	$self ActivateWidget $x $new
812	}
813	}
814	"ins" {
815	#set editable keys combos
816	#enable entries
817	for {set x 1} {$x<=$maxFields} {incr x} {
818	$self ActivateWidget $x $new
819	}
820	}
821	"old" {
822	}
823	}
824	}
825	"edi" {
826	switch $new {
827	"sel" {
828	focus -force $self
829	for {set x 1} {$x<=$maxFields} {incr x} {
830	$self ActivateWidget $x $new
831	}
832	}
833	"vis" {
834	#enable keys combos
835	#disable entries
836	focus -force $self
837	for {set x 1} {$x<=$maxFields} {incr x} {
838	$self ActivateWidget $x $new
839	}
840	}
841	"edi" {
842	}
843	"ins" {
844	}
845	"old" {
846	}
847	}
848	}
849	"ins" {
850	switch $new {
851	"sel" {
852	focus -force $self
853	for {set x 1} {$x<=$maxFields} {incr x} {
854	$self ActivateWidget $x $new
855	}
856	}
857	"vis" {
858	focus -force $self
859	#"select" keys combos
860	#disable entries (set to readonly)
861	for {set x 1} {$x<=$maxFields} {incr x} {
862	$self ActivateWidget $x $new
863	}
864	}
865	"edi" {
866	}
867	"ins" {
868	}
869	"old" {
870	}
871	}
872	}
873	}
874	#Set status:
875	if { $new == "old" } {
876	set status $oldStatus
877	} else {
878	set oldStatus $status
879	set status $new
880	}
881	#Tolcon_Trace "setStatus: NEW Status: $status"
882	#Change buttons according to old and new status:
883	#
884	switch $status {
885	"sel" {
886	$widget(bt,duplicate) configure -state disable
887	$widget(bt,new) configure -state normal
888	$widget(bt,edit) configure -state disable
889	$widget(bt,save) configure -state disable
890	$widget(bt,cancel) configure -state normal
891	$widget(bt,cancel) configure -state disable
892	$widget(bt,delete) configure -state disable
893	$widget(bt,clear) configure -state normal
894	$widget(bt,refresh) configure -state normal
895	$widget(bt,open) configure -state normal
896	}
897	"vis" {
898	$widget(bt,duplicate) configure -state normal
899	$widget(bt,new) configure -state normal
900	$widget(bt,edit) configure -state normal
901	$widget(bt,save) configure -state disable
902	$widget(bt,cancel) configure -state normal
903	$widget(bt,cancel) configure -state disable
904	$widget(bt,delete) configure -state normal
905	$widget(bt,clear) configure -state normal
906	$widget(bt,refresh) configure -state normal
907	$widget(bt,open) configure -state normal
908	}
909	"edi" {
910	$widget(bt,duplicate) configure -state normal
911	$widget(bt,new) configure -state disable
912	$widget(bt,edit) configure -state disable
913	$widget(bt,save) configure -state normal
914	$widget(bt,cancel) configure -state normal
915	$widget(bt,delete) configure -state disable
916	$widget(bt,clear) configure -state disable
917	$widget(bt,refresh) configure -state disable
918	$widget(bt,open) configure -state normal
919	}
920	"ins" {
921	$widget(bt,duplicate) configure -state normal
922	$widget(bt,new) configure -state disable
923	$widget(bt,edit) configure -state normal
924	$widget(bt,save) configure -state normal
925	$widget(bt,cancel) configure -state normal
926	$widget(bt,cancel) configure -state normal
927	$widget(bt,delete) configure -state normal
928	$widget(bt,clear) configure -state normal
929	$widget(bt,refresh) configure -state normal
930	$widget(bt,open) configure -state normal
931	}
932	}
933	}
934
935	#///////////////////////////////////////////////////////////////////////////
936	method showForm {} {
937	#
938	# PURPOSE: Show the form.
939	#
940	#///////////////////////////////////////////////////////////////////////////
941	# grid of objects
942	for {set x 1} {$x<=$maxFields} {incr x} {
943	switch [lindex $fieldInfo($x,field,type) 0] {
944	"bit" {
945	grid $fieldInfo($x,field,ptr) -sticky nw -row $x -column 1 -pady 2
946	}
947	"text" -
948	"varchar" {
949	grid $fieldInfo($x,field,ptr) -sticky new -row $x -column 1 -pady 2
950	if { [ expr [lindex $fieldInfo($x,field,type) 1] > 255] } {
951	grid $fieldInfo($x,field,ptr)sb -sticky nse -row $x -column 2 -pady 2
952	}
953	}
954	default {
955	grid $fieldInfo($x,field,ptr) -sticky new -row $x -column 1 -pady 2
956	}
957	}
958
959	if {$fieldInfo($x,field,iskey)} {
960	set path pk
961	} else {
962	set path data
963	}
964	grid $widget(tf,$path,fr).label$x -sticky nw -row $x -column 0 -pady 2
965	# buttons for links to other editmasters
966	if [info exists ${selfns}::fieldInfo($x,field,links)] {
967	for {set idx 1} {$idx <= [llength $fieldInfo($x,field,links)]} {incr idx} {
968	button $widget(tf,$path,fr).b${x}_${idx} \
969	-command $fieldInfo($x,link,$idx,proc) \
970	-image [::Bitmap::get "tools"]
971	grid $widget(tf,$path,fr).b${x}_${idx} -sticky nw\
972	-row $x -column [expr 2+$idx] -pady 2
973	}
974	}
975	}
976
977	grid columnconfigure $widget(tf,pk,fr) 1 -weight 1
978	grid rowconfigure $widget(tf,pk,fr) 1000 -weight 1
979
980	grid columnconfigure $widget(tf,data,fr) 1 -weight 1
981	grid rowconfigure $widget(tf,data,fr) 1000 -weight 1
982
983	pack $widget(tf,pk) -fill x -expand yes
984	pack $widget(tf,data) -fill x -expand yes
985	pack $widget(fr,extra) -fill x -expand yes
986
987	}
988
989	#///////////////////////////////////////////////////////////////////////////
990	method getExtraFrame { } {
991	#
992	# PURPOSE: Return the path of an extra frame between the title frame of
993	# data and the button box
994	#
995	#
996	#///////////////////////////////////////////////////////////////////////////
997	return $widget(fr,extra)
998	}
999
1000	#///////////////////////////////////////////////////////////////////////////
1001	method botsal {parent} {
1002	#
1003	# PURPOSE: Manages the use of the "exit" button.
1004	#
1005	# PARAMETERS: parent -> (self's parent)
1006	#
1007	#///////////////////////////////////////////////////////////////////////////
1008	destroy $parent
1009	}
1010
1011	#///////////////////////////////////////////////////////////////////////////
1012	method GetSqlWhere {prefTable {index -1}} {
1013	# PURPUSE: Construct the WHERE clause
1014	# PARAMETERS: index -> indice a excluir de la seleccion
1015	# prefTable -> nombre de la tabla a concatenar al campo
1016	# RETURN:
1017	#
1018	#///////////////////////////////////////////////////////////////////////////
1019	#$fieldInfo($x,field,ptr)
1020	set where {}
1021	for {set x 1} {$x<=$maxFields} {incr x} {
1022	if {$fieldInfo($x,field,iskey)} {
1023
1024	if {([info exists fieldInfo($x,field,ptr)])} {
1025	if {[set code [$fieldInfo($x,field,ptr) key get]] != "" && $x != $index} {
1026	lappend where "$prefTable$fieldInfo($x,field,name) = \
1027	[SqlFormatField $code $fieldInfo($x,field,type) $gestor]\n"
1028	}
1029	}
1030	}
1031	}
1032	return [join $where { and }]
1033	}
1034
1035	#///////////////////////////////////////////////////////////////////////////
1036	method GetSelectFk {index} {
1037	# PURPUSE:
1038	# PARAMETERS: index -> indice selecionado
1039	# RETURN: la sentencia sql a ejecutar para obtener los resultados a mostrar
1040	#
1041	#///////////////////////////////////////////////////////////////////////////
1042	set txtSql ""
1043	# control de foreing key existente
1044	if {[info exists fieldInfo($index,field,fkMRes)]} {
1045	set inxFk $fieldInfo($index,field,fkMRes)
1046	# control de foreing key a la tabla de la descripcion
1047	if {[string equal $fieldInfo($index,desc,table) $fieldFkInfo($inxFk,table)]} {
1048	set where [$self GetSqlWhereFk $index ""]
1049	if {[string length $where]} {
1050	set where "\n where $where"
1051	}
1052	set txtSql \
1053	"select distinct [join $fieldInfo($index,desc,lstfields) ,] \n\
1054	from $fieldFkInfo($inxFk,table) \
1055	$where \
1056	order by [lindex $fieldInfo($index,desc,lstfields) 0]"
1057	} else {
1058	set where {}
1059	# informacion de la tabla referenciada
1060	foreach f $fieldInfo($index,desc,lstfields) {
1061	lappend fie "des.$f"
1062	}
1063	# claupsula where
1064	set join {}
1065	set lon [llength $fieldFkInfo($inxFk,indFie)]
1066	for {set x 0} {$x<$lon} {incr x} {
1067	if {[lindex $fieldFkInfo($inxFk,indFie) $x]==$index} {
1068	set join "des.$fieldInfo($index,desc,join) = \
1069	ori.[lindex $fieldFkInfo($inxFk,fields) $x]"
1070	}
1071	}
1072	if {[string length $join]} {
1073	set where "\n where $join"
1074	}
1075	set whe {}
1076	set whe [$self GetSqlWhereFk des. $index]
1077	if {[string length $whe]} {
1078	if {[string length $where]} {
1079	set where "\n where $whe"
1080	} else {
1081	set where "\n and $whe"
1082	}
1083	}
1084	# sentencia
1085	set txtSql \
1086	"select distinct [join $fie ,]\n\
1087	from $fieldInfo($index,desc,table) des, \
1088	$fieldFkInfo($inxFk,table) ori \
1089	$where \
1090	order by [lindex $fie 0]"
1091	}
1092	} else {
1093	# no esta asociado a ninguna tabla, no se muestra lista
1094	}
1095	# result
1096	return $txtSql
1097	}
1098
1099	#///////////////////////////////////////////////////////////////////////////
1100	method GetSqlWhereFk {index prefTable {opeLog and}} {
1101	# PURPUSE: Construye una sentenia where para la seleccion mediante la tabla
1102	# relaccinada
1103	# PARAMETERS: index -> indice selecionado
1104	# prefTable -> prefijo de la tabla, ha de incluir el punto
1105	# opeLog -> operador logico entre las expresiones del where.
1106	# Por defecto "and"
1107	# RETURN: la sentencia where
1108	#
1109	#///////////////////////////////////////////////////////////////////////////
1110	set where {}
1111	if {[info exists fieldInfo($index,field,fkMRes)]} {
1112	set lstId $fieldFkInfo($fieldInfo($index,field,fkMRes),indFie)
1113	if {[llength $lstId]>1} {
1114	set i 0
1115	foreach id $lstId {
1116	#Tolcon_Trace "GetSqlWhereFk: If $id <> $index"
1117	if {[expr $id != $index] && \
1118	[string length [set code [$fieldInfo($id,field,ptr) key get]]]} {
1119	#Tolcon_Trace "GetSqlWhereFk: I: $i"
1120	#Tolcon_Trace "Lista de campos referenciados:\
1121	$fieldFkInfo($fieldInfo($index,field,fkMRes),fields)"
1122	lappend where \
1123	"$prefTable\
1124	[lindex $fieldFkInfo($fieldInfo($index,field,fkMRes),fields) $i] = \
1125	[SqlFormatField $code $fieldInfo($id,field,type) $gestor] \n"
1126	#Tolcon_Trace "GetSqlWhereFk: Campo en el where: [lindex $fieldFkInfo($fieldInfo($index,field,fkMRes),fields) $i]";#"
1127	}
1128	incr i
1129	}
1130	}
1131	}
1132	return [join $where " $opeLog "]
1133	}
1134
1135	#///////////////////////////////////////////////////////////////////////////
1136	method FillFieldKey {} {
1137	# PURPUSE: comprobamos que esten rellenos todos los campos clave
1138	#
1139	# RETURN: true -> SI, false -> NO
1140	#
1141	#///////////////////////////////////////////////////////////////////////////
1142	set fill true
1143	set x 1
1144	while {$fill && [expr $x <=$maxFields]} {
1145	if {$fieldInfo($x,field,iskey)} {
1146	#Tolcon_Trace "FillFieldKey $fieldInfo($x,field,ptr) = [$fieldInfo($x,field,ptr) key get]"
1147	if {[string equal [$fieldInfo($x,field,ptr) key get] ""]} {
1148	set fill false
1149	#Tolcon_Trace "FillFieldKey: Por rellenar el campo: $fieldInfo($x,field,name)"
1150	}
1151	}
1152	incr x
1153	}
1154	return $fill
1155	}
1156
1157	#///////////////////////////////////////////////////////////////////////////
1158	method FillFieldNotNull {} {
1159	# PURPUSE: comprobamos que esten rellenos todos los campos obligatorios
1160	#
1161	# RETURN: true -> SI, false -> NO
1162	#
1163	#///////////////////////////////////////////////////////////////////////////
1164	#Tolcon_Trace "FillFieldNotNull ..."
1165	set fill true
1166	set x 1
1167	while {$fill && [expr $x<=$maxFields]} {
1168	if {$fieldInfo($x,field,notnull)} {
1169	if {$fieldInfo($x,desc,show)} {
1170	for {set i 1} {$i<=[llength $fieldInfo($x,desc,lstshow)]} {incr i} {
1171	if {[info exists fieldInfo($x,desc,$i,notnull)] && \
1172	$fieldInfo($x,desc,$i,notnull)} {
1173	set txt [BfoGetText $fieldInfo($x,desc,$i,ptr)]
1174	if {![string length $txt]} {
1175	set fill false
1176	}
1177	}
1178	}
1179	} else {
1180	set txt [BfoGetText $fieldInfo($x,field,ptr)]
1181	if {![string length $txt]} {
1182	set fill false
1183	}
1184	}
1185	}
1186	incr x
1187	}
1188	return $fill
1189	}
1190
1191	#///////////////////////////////////////////////////////////////////////////
1192	method GetLstFieldsTable {} {
1193	# PURPUSE:
1194	#
1195	# RETURN:
1196	#
1197	#///////////////////////////////////////////////////////////////////////////
1198	#Tolcon_Trace "GetLstFieldsTable ..."
1199	set lst {}
1200	for {set x 1} {$x<=$maxFields} {incr x} {
1201	lappend lst $fieldInfo($x,field,name)
1202	if {$fieldInfo($x,desc,show)} {
1203	for {set i 1} {$i<=[llength $fieldInfo($x,desc,lstshow)]} {incr i} {
1204	if {$fieldInfo($x,desc,$i,edit)} {
1205	lappend lst $fieldInfo($x,desc,$i,name)
1206	}
1207	}
1208	}
1209	}
1210	return $lst
1211	}
1212
1213	#///////////////////////////////////////////////////////////////////////////
1214	method SetValuesFields {txtSql} {
1215	# PURPUSE: Rellenamos los objetos del formulario con sus valores
1216	#
1217	# PARAMETERS:
1218	#
1219	#///////////////////////////////////////////////////////////////////////////
1220	global tcl_platform
1221	#Tolcon_Trace "SetValuesFields: Consulta: $txtSql"
1222	set values [DBQuery $bodbcmodule $txtSql]
1223	$connection statement infor $txtSql
1224	if { [string equal $::tcl_platform(platform) "unix"] } {
1225	infor
1226	$connection commit
1227	}
1228	#Loop for every field:
1229	set nameColums [infor columns]
1230	set c -1
1231	foreach nc $nameColums {
1232	incr c
1233	# obtenemos el indice de la columna
1234	set index [$self GetIndexArray field,name $nc]
1235	if {[expr $index != -1]} {
1236	if {!$fieldInfo($index,field,iskey)} {
1237	set val [lindex [lindex $values 0] $c]
1238	$self SetValue $fieldInfo($index,field,ptr) $val
1239	}
1240	}
1241	}
1242	# $self setStatus "vis"
1243	}
1244
1245	#///////////////////////////////////////////////////////////////////////////
1246	method SetValue {ptr value} {
1247	# PURPUSE: Rellenamos los objetos del formulario con sus valores
1248	#
1249	# PARAMETERS:
1250	#
1251	#///////////////////////////////////////////////////////////////////////////
1252	#Tolcon_Trace "SetValue ptr=$ptr, value=$value"
1253	set type [winfo class $ptr]
1254	#Tolcon_Trace "SetValue type=$type"
1255	switch $type {
1256	"BSelectFields" {
1257	$ptr SetValueView [list $value]
1258	}
1259	"Bcomboboxplus" {
1260	$ptr SetValueView [list $value]
1261	}
1262	"Entry" {
1263	set current [$ptr cget -state]
1264	$ptr configure -state normal
1265	$ptr configure -text $value
1266	$ptr configure -state $current
1267	}
1268	"BEntryDate" {
1269	$ptr configure -btext $value
1270	}
1271	"LabelEntry" {
1272	set current [$ptr cget -state]
1273	$ptr configure -state normal
1274	$ptr configure -text $value
1275	$ptr configure -state $current
1276	}
1277	"Text" {
1278	set current [$ptr cget -state]
1279	$ptr configure -state normal
1280	$ptr delete 0.0 end
1281	$ptr insert 0.0 $value
1282	$ptr configure -state $current
1283	}
1284	"Checkbutton" {
1285	set current [$ptr cget -state]
1286	$ptr configure -state normal
1287	if { $value == 1} {
1288	$ptr select
1289	} else {
1290	$ptr deselect
1291	}
1292	$ptr configure -state $current
1293	}
1294	default {
1295	Tolcon_Trace "SetValue: Widget not recognized: $type"
1296	}
1297	}
1298	}
1299
1300	#///////////////////////////////////////////////////////////////////////////
1301	method SetValuesFieldsDesc {} {
1302	# PURPUSE:
1303	#
1304	#///////////////////////////////////////////////////////////////////////////
1305	#Tolcon_Trace "SetValuesFieldsDesc ..."
1306	for {set x 1} {$x<=$maxFields} {incr x} {
1307	# si no es clave y tiene descripcion
1308	#Tolcon_Trace "SetValuesFieldsDesc Show: $fieldInfo($x,desc,show)"
1309	if {$fieldInfo($x,desc,show)} {
1310	#Tolcon_Trace "SetValuesFieldsDesc lstshow$x: $fieldInfo($x,desc,lstshow)"
1311	if {[llength $fieldInfo($x,desc,lstshow)]} {
1312	# if {!$fieldInfo($x,field,iskey) && $fieldInfo($x,desc,show)}
1313	set txt [BfoGetText $fieldInfo($x,field,ptr)]
1314	#Tolcon_Trace "SetValuesFieldsDesc Table: $fieldInfo($x,desc,table)"
1315	#Tolcon_Trace "SetValuesFieldsDesc txt: $txt"
1316	if {[string length $txt]} {
1317	# construimos sentencia
1318	set txtSql \
1319	"select [join $fieldInfo($x,desc,lstshow) ,] \n\
1320	from $fieldInfo($x,desc,table) \n\
1321	where $fieldInfo($x,desc,join) = \
1322	[SqlFormatField $txt $fieldInfo($x,field,type) $gestor]"
1323	# ejecutamos sentencia
1324	#Tolcon_Trace "SetValuesFieldsDesc: Consulta:\n $txtSql"
1325	set values [DBQuery $bodbcmodule $txtSql]
1326	# rellenamos valores
1327	for {set i 1} {$i<=[llength $fieldInfo($x,desc,lstshow)]} {incr i} {
1328	$self SetValue $fieldInfo($x,desc,[expr $i +1],ptr) \
1329	[lindex [lindex $values 0] [expr $i-1]]
1330	}
1331	}
1332	}
1333	}
1334	#Tolcon_Trace "SetValuesFieldsDesc. ---Acabo para el campo $x ---"
1335	}
1336	}
1337
1338	#///////////////////////////////////////////////////////////////////////////
1339	method GetIndexArray {key value} {
1340	# PURPUSE: Obtenemos la posicon dentro del array para una calve y un valor
1341	#
1342	# PARAMETERS: key
1343	# value
1344	# RETURN: la posicion dentro del array, de no existir devuelve -1
1345	#
1346	#///////////////////////////////////////////////////////////////////////////
1347	#Tolcon_Trace "GetIndexArray. key: $key value: $value "
1348	set index -1
1349	set x 1
1350	while {[expr $index == -1] && [expr $x <= $maxFields]} {
1351	if {[info exists fieldInfo($x,$key)]} {
1352	if {[string equal [string toupper $fieldInfo($x,$key)] [string toupper $value]]} {
1353	set index $x
1354	}
1355	}
1356	incr x
1357	}
1358	#Tolcon_Trace "GetIndexArray. result: $index"
1359	return $index
1360	}
1361
1362	#///////////////////////////////////////////////////////////////////////////
1363	method boteli {} {
1364	#
1365	# PURPOSE: Ask for confirmation and delete form data from the database
1366	#
1367	#///////////////////////////////////////////////////////////////////////////
1368	#First, ask the user:
1369	global toltk_options
1370	# New dialog with two buttons: Acept and Cancel
1371	set rq [tk_messageBox -type yesno -icon question -title [mc "Delete"] \
1372	-parent $self -message [mc askDeleteField]]
1373	if {[string equal $rq yes]} {
1374	# borramos el registro
1375	#Look for every PK field and collect its value and field name:
1376	if {[$self FillFieldKey]} {
1377	set where [$self GetSqlWhere ""]
1378	set txtSql "delete from $tablename \n\
1379	where $where"
1380	#Tolcon_Trace "boteli: Sentencia de borrado: $txtSql"
1381	#TODO: comprobamos el valor de OK
1382	set ok [DBQuery $bodbcmodule $txtSql]
1383	#call cancel:
1384	$self botcan
1385	}
1386	}
1387	}
1388
1389	#///////////////////////////////////////////////////////////////////////////
1390	method botedi {} {
1391	# PURPOSE:
1392	#///////////////////////////////////////////////////////////////////////////
1393	# Guardamos los valores previos a modificaciones
1394	$self SetOldValues
1395	$self setStatus "edi"
1396	}
1397
1398	#///////////////////////////////////////////////////////////////////////////
1399	method botcan {} {
1400	# PURPOSE:
1401	#///////////////////////////////////////////////////////////////////////////
1402	#Simply clean up and return to "select" status.
1403	BfoCleanPath $widget(tf,pk)
1404	BfoCleanPath $widget(tf,data)
1405	# load old data
1406	$self SetDataFromOldValues
1407	$self SetValuesFieldsDesc
1408	# load old values
1409	$self setStatus "sel"
1410	$self botsel
1411	}
1412
1413	#///////////////////////////////////////////////////////////////////////////
1414	method botnew {} {
1415	#
1416	# PURPOSE: Actions to do when the "New" button is pressed.
1417	#
1418	#///////////////////////////////////////////////////////////////////////////
1419	$self SetOldValues
1420	#Clear the form:
1421	BfoCleanPath $widget(tf,pk)
1422	BfoCleanPath $widget(tf,data)
1423	#Change status:
1424	$self setStatus "ins"
1425	}
1426
1427	#///////////////////////////////////////////////////////////////////////////
1428	method botgua {} {
1429	# PURPOSE:
1430	#///////////////////////////////////////////////////////////////////////////
1431	if {$status=="edi" \|\| $status=="ins"} {
1432	set ok 1
1433	# comprobamos rellenos todos los campos key y notnull
1434	if {[$self FillFieldKey]} {
1435	if {![$self FillFieldNotNull]} {
1436	set ok 0
1437	tk_messageBox -type ok -icon warning -title [mc "Atention"] \
1438	-parent $self -message [mc notFillNotNull]
1439	}
1440	} else {
1441	set ok 0
1442	tk_messageBox -type ok -icon warning -title [mc "Atention"] \
1443	-parent $self -message [mc notFillKey]
1444	}
1445	if {$ok} {
1446	# construimos consultas de grabado
1447	switch $status {
1448	"ins" {
1449	set txtSql [$self GetSqlInsert]
1450	}
1451	"edi" {
1452	set txtSql [$self GetSqlUpdate]
1453	}
1454	}
1455
1456	# ejecutamos sentencia
1457	set result 0
1458	if {[string length $txtSql]} {
1459	#Tolcon_Trace "botgua: Sentencia de insercion o actualizacion:\n $txtSql"
1460	set result [DBQuery $bodbcmodule $txtSql]
1461	}
1462	# check result ?
1463	if {$result>=0} {
1464	$self setStatus "vis"
1465	} else {
1466	#TODO: mensaje de error
1467	}
1468	}
1469	}
1470	}
1471
1472	#///////////////////////////////////////////////////////////////////////////
1473	method GetInsertData {} {
1474	# PURPOSE: Obtain the list of values that would be inserted or updated in the
1475	# table.
1476	#
1477	# RETURN: Sentencia de insercion
1478	#///////////////////////////////////////////////////////////////////////////
1479	# NOTA: Da los datos en el formato adecuado a SQL
1480	set lstField {}
1481	set lstValues {}
1482	#Read each combo and text value, and add it to the query:
1483	for {set x 1} {$x<=$maxFields} {incr x} {
1484	lappend lstField $fieldInfo($x,field,name)
1485	set txt [BfoGetText $fieldInfo($x,field,ptr)]
1486	if {[string length $txt]} {
1487	set txt [StringReplace $txt ' '']
1488	} else {
1489	set txt null
1490	}
1491	lappend lstValues [SqlFormatField $txt $fieldInfo($x,field,type) $gestor]
1492	if {$fieldInfo($x,desc,show)} {
1493	for {set i 1} {$i<=[llength $fieldInfo($x,desc,lstshow)]} {incr i} {
1494	if {$fieldInfo($x,desc,$i,edit)} {
1495	lappend lstField $fieldInfo($x,desc,$i,name)
1496	set obj $fieldInfo($x,desc,$i,ptr)
1497	set txt [BfoGetText $obj]
1498	if {![string length $txt]} {
1499	set txt null
1500	}
1501	lappend lstValues [SqlFormatField $txt $fieldInfo($x,desc,$i,type) $gestor]
1502	}
1503	}
1504	}
1505	}
1506	set regFields(lstValues) $lstValues
1507	return $lstValues
1508	}
1509
1510
1511	#///////////////////////////////////////////////////////////////////////////
1512	method GetSqlInsert {} {
1513	# PURPOSE: construimos la sentencia de insercion
1514	# RETURN: Sentencia de insercion
1515	#///////////////////////////////////////////////////////////////////////////
1516	set lstField {}
1517	set lstValues {}
1518	#Read each combo and text value, and add it to the query:
1519	for {set x 1} {$x<=$maxFields} {incr x} {
1520	lappend lstField $fieldInfo($x,field,name)
1521	set txt [BfoGetText $fieldInfo($x,field,ptr)]
1522	if {[string length $txt]} {
1523	set txt [StringReplace $txt ' '']
1524	} else {
1525	set txt null
1526	}
1527	lappend lstValues [SqlFormatField $txt $fieldInfo($x,field,type) $gestor]
1528	if {$fieldInfo($x,desc,show)} {
1529	for {set i 1} {$i<=[llength $fieldInfo($x,desc,lstshow)]} {incr i} {
1530	if {$fieldInfo($x,desc,$i,edit)} {
1531	lappend lstField $fieldInfo($x,desc,$i,name)
1532	set obj $fieldInfo($x,desc,$i,ptr)
1533	set txt [BfoGetText $obj]
1534	if {![string length $txt]} {
1535	set txt null
1536	}
1537	lappend lstValues [SqlFormatField $txt $fieldInfo($x,desc,$i,type) $gestor]
1538	}
1539	}
1540	}
1541	}
1542	# construir sentencia sql
1543	set txtSql \
1544	"insert into $tablename \n\
1545	([join $lstField ,]) \n\
1546	values \n\
1547	([join $lstValues ,])"
1548	return $txtSql
1549	}
1550
1551	#///////////////////////////////////////////////////////////////////////////
1552	method GetSqlUpdate_ {} {
1553	# PURPOSE: Construimos la sentencia de actualizacion del registro activo
1554	# RETURN: Sentencia de actualizacion
1555	#///////////////////////////////////////////////////////////////////////////
1556	set lstValues {}
1557	update
1558	# sentencia where
1559	set where {}
1560	for {set x 1} {$x<=$oldValues(numReg)} {incr x} {
1561	lappend where "$oldValues($x,name) = \
1562	[SqlFormatField $oldValues($x,value) $oldValues($x,type) $gestor]"
1563	}
1564	set where [join $where { and }]
1565
1566	#Read each combo and text value, and add it to the query:
1567	for {set x 1} {$x<=$maxFields} {incr x} {
1568	set txt [BfoGetText $fieldInfo($x,field,ptr)]
1569	if {[string length $txt]} {
1570	set txt [StringReplace $txt ' '']
1571	} else {
1572	set txt null
1573	}
1574	lappend lstValues "$fieldInfo($x,field,name) = \
1575	[SqlFormatField $txt $fieldInfo($x,field,type) $gestor]"
1576	if {$fieldInfo($x,desc,show)} {
1577	for {set i 1} {$i<=[llength $fieldInfo($x,desc,lstshow)]} {incr i} {
1578	if {$fieldInfo($x,desc,$i,edit)} {
1579	set obj $fieldInfo($x,desc,$i,ptr)
1580	set txt [BfoGetText $obj]
1581	if {![string length $txt]} {
1582	set txt null
1583	}
1584	lappend lstValues "$fieldInfo($x,desc,$i,name) = \
1585	[SqlFormatField $txt $fieldInfo($x,desc,$i,type) $gestor]"
1586	}
1587	}
1588	}
1589	}
1590	# construir sentencia sql
1591	set txtSql \
1592	"update $tablename set \n\
1593	[join $lstValues ,] \n\
1594	where $where"
1595	return $txtSql
1596	}
1597
1598
1599	#///////////////////////////////////////////////////////////////////////////
1600	method GetSqlUpdate {} {
1601	# PURPOSE: Construimos la sentencia de actualizacion del registro activo
1602	# RETURN: Sentencia de actualizacion
1603	#///////////////////////////////////////////////////////////////////////////
1604	set lstValues {}
1605	update
1606	# sentencia where
1607	set where {}
1608	for {set x 1} {$x<=$oldValues(numReg)} {incr x} {
1609	if {$oldValues($x,iskey)} {
1610	lappend where "$oldValues($x,name) = \
1611	[SqlFormatField $oldValues($x,value) $oldValues($x,type) $gestor]"
1612	}
1613	}
1614	set where [join $where { and }]
1615
1616	#Read each combo and text value, and add it to the query:
1617	for {set x 1} {$x<=$maxFields} {incr x} {
1618	set txt [BfoGetText $fieldInfo($x,field,ptr)]
1619	# modified ?
1620	if {![string eq $txt $oldValues($x,value)]} {
1621	if {[string length $txt]} {
1622	set txt [StringReplace $txt ' '']
1623	} else {
1624	set txt null
1625	}
1626	lappend lstValues "$fieldInfo($x,field,name) = \
1627	[SqlFormatField $txt $fieldInfo($x,field,type) $gestor]"
1628	if {$fieldInfo($x,desc,show)} {
1629	for {set i 1} {$i<=[llength $fieldInfo($x,desc,lstshow)]} {incr i} {
1630	if {$fieldInfo($x,desc,$i,edit)} {
1631	set obj $fieldInfo($x,desc,$i,ptr)
1632	set txt [BfoGetText $obj]
1633	if {![string length $txt]} {
1634	set txt null
1635	}
1636	lappend lstValues "$fieldInfo($x,desc,$i,name) = \
1637	[SqlFormatField $txt $fieldInfo($x,desc,$i,type) $gestor]"
1638	}
1639	}
1640	}
1641	}
1642	}
1643	# construir sentencia sql
1644	if {[llength $lstValues]} {
1645	set txtSql \
1646	"update $tablename set \n\
1647	[join $lstValues ,] \n\
1648	where $where"
1649	} else {
1650	# no se va a modificar nada
1651	set txtSql ""
1652	}
1653	return $txtSql
1654	}
1655
1656
1657	#///////////////////////////////////////////////////////////////////////////
1658	method SetOldValues_ {} {
1659	# PURPUSE: Almacenamos en una variable los valores actuales, antes de
1660	# modificarlos
1661	#
1662	#///////////////////////////////////////////////////////////////////////////
1663	set n 0
1664	for {set x 1} {$x<=$maxFields} {incr x} {
1665	if {$fieldInfo($x,field,iskey)} {
1666	incr n
1667	set oldValues($n,name) $fieldInfo($x,field,name)
1668	set oldValues($n,type) $fieldInfo($x,field,type)
1669	set oldValues($n,value) [BfoGetText $fieldInfo($x,field,ptr)]
1670	}
1671	}
1672	set oldValues(numReg) $n
1673	}
1674
1675
1676	#///////////////////////////////////////////////////////////////////////////
1677	method SetOldValues {} {
1678	# PURPUSE: Almacenamos en una variable los valores actuales, antes de
1679	# modificarlos
1680	#
1681	#///////////////////////////////////////////////////////////////////////////
1682	for {set x 1} {$x<=$maxFields} {incr x} {
1683	set oldValues($x,name) $fieldInfo($x,field,name)
1684	set oldValues($x,type) $fieldInfo($x,field,type)
1685	set oldValues($x,iskey) $fieldInfo($x,field,iskey)
1686	set oldValues($x,value) [BfoGetText $fieldInfo($x,field,ptr)]
1687	}
1688	set oldValues(numReg) $maxFields
1689	}
1690
1691
1692	#///////////////////////////////////////////////////////////////////////////
1693	method SetDataFomOldValues_ {} {
1694	#
1695	# PURPOSE: Carga los campos calve con los valores antigüos y ejecuta la
1696	# función para rellenar el resto.
1697	#
1698	#///////////////////////////////////////////////////////////////////////////
1699	#
1700	for {set i 1} {[expr $i <= $oldValues(numReg)]} {incr i} {
1701	$self SetValue [$self getpathfield $oldValues($i,name)] \
1702	$oldValues($i,value)
1703	}
1704	}
1705
1706	#///////////////////////////////////////////////////////////////////////////
1707	method SetDataFromOldValues {} {
1708	#
1709	# PURPOSE: Carga los campos calve con los valores antigüos y ejecuta la
1710	# función para rellenar el resto.
1711	#
1712	#///////////////////////////////////////////////////////////////////////////
1713	# exists old values ?
1714	if {[info exists oldValues(numReg)]} {
1715	for {set i 1} {[expr $i <= $oldValues(numReg)]} {incr i} {
1716	if {$oldValues($i,iskey)} {
1717	$self SetValue \
1718	[$self getpathfield $oldValues($i,name)] $oldValues($i,value)
1719	}
1720	}
1721	}
1722	}
1723
1724
1725	#///////////////////////////////////////////////////////////////////////////
1726	method ActivateWidget {index state} {
1727	#
1728	# PURPOSE: Activa o desactiva los widgets según el estado que se lea,
1729	# en base a las directrices de los estados de BEditMaster.
1730	#
1731	# PARAMETERS:
1732	# widget -> objeto a activar/desactivar
1733	# state -> Estado.
1734	#
1735	#///////////////////////////////////////////////////////////////////////////
1736	global toltk_options
1737	set w $fieldInfo($index,field,ptr)
1738	set type [winfo class $w]
1739
1740	switch $type {
1741	"BSelectFields" {
1742	switch $state {
1743	"sel" -
1744	"vis" {
1745	if {$fieldInfo($index,field,iskey)} {
1746	set stt "select"
1747	} else {
1748	set stt "notactive"
1749	}
1750	$w Activate $stt
1751	}
1752	"edi" -
1753	"ins" {
1754	#TODO: entiendo que es igual. Hay que decidir si en edicion se puede cambiar
1755	# el code de un campo (este es el codigo que se especifica en la tabla)
1756	# En estos momentos se pueden aztualizar todos los campos
1757	if {$fieldInfo($index,field,iskey)} {
1758	if {$fieldInfo($index,field,edit)} {
1759	set stt "normal"
1760	} else {
1761	set stt "select"
1762	}
1763	$w Activate $stt
1764	if {$fieldInfo($index,desc,show)} {
1765	for {set i 1} {$i<=[llength $fieldInfo($index,desc,lstshow)]} {incr i} {
1766	if {$fieldInfo($index,desc,$i,edit)} {
1767	set stt "active"
1768	BfoActivateWidget $fieldInfo($index,desc,$i,ptr) $stt
1769	}
1770	}
1771	}
1772	} else {
1773	set stt "select"
1774	$w Activate $stt
1775	}
1776	}
1777	}
1778	}
1779	"Bcomboboxplus"
1780	{
1781	switch $state {
1782	"sel" -
1783	"vis" {
1784	if {$fieldInfo($index,field,iskey)} {
1785	set stt "select"
1786	} else {
1787	set stt "notactive"
1788	}
1789	$w activate $stt
1790	}
1791	"edi" -
1792	"ins" {
1793	if {$fieldInfo($index,field,iskey)} {
1794	if {$fieldInfo($index,field,edit)} {
1795	set stt "normal"
1796	} else {
1797	set stt "select"
1798	}
1799	$w activate $stt
1800	if {$fieldInfo($index,desc,show)} {
1801	for {set i 1} {$i<=[llength $fieldInfo($index,desc,lstshow)]} {incr i} {
1802	if {$fieldInfo($index,desc,$i,edit)} {
1803	set stt "active"
1804	BfoActivateWidget $fieldInfo($index,desc,$i,ptr) $stt
1805	}
1806	}
1807	}
1808	} else {
1809	set stt "select"
1810	$w activate $stt
1811	}
1812	}
1813	}
1814	}
1815	"LabelEntry"
1816	{
1817	switch $state {
1818	"sel" -
1819	"vis" {
1820	set stt "false"
1821	}
1822	"edi" -
1823	"ins" {
1824	set stt "true"
1825	}
1826	}
1827	$w configure -editable $stt
1828	}
1829	"Mclistbox"
1830	{
1831	#TODO
1832	}
1833	"ComboBox"
1834	{
1835	#TODO
1836	}
1837	"Entry"
1838	{
1839	switch $state {
1840	"sel" -
1841	"vis" {
1842	set stt "false"
1843	$w configure -background $toltk_options(colors,SystemButtonFace)
1844	}
1845	"edi" -
1846	"ins" {
1847	set stt "true"
1848	$w configure -background white
1849	}
1850	}
1851	$w configure -editable $stt
1852	}
1853	"BEntryDate" {
1854	switch $state {
1855	"sel" -
1856	"vis" {
1857	set stt "disabled"
1858	}
1859	"edi" -
1860	"ins" {
1861	set stt "normal"
1862	}
1863	}
1864	$w configure -bstate $stt
1865	}
1866	"Listbox"
1867	{
1868	#TODO
1869	}
1870	"Checkbutton"
1871	{
1872	switch $state {
1873	"sel" -
1874	"vis" {
1875	set stt "disabled"
1876	}
1877	"edi" -
1878	"ins" {
1879	set stt "normal"
1880	}
1881	}
1882	$w configure -state $stt
1883	}
1884	"Text"
1885	{
1886	#Tolcon_Trace "prueba nueva ActivateWidget TEXT"
1887	switch $state {
1888	"sel" -
1889	"vis" {
1890	set stt "disabled"
1891	$w configure -background $toltk_options(colors,SystemButtonFace) \
1892	-foreground darkgray
1893	}
1894	"edi" -
1895	"ins" {
1896	set stt "normal"
1897	$w configure -background white -foreground black
1898	}
1899	}
1900	$w configure -state $stt
1901	}
1902	default
1903	{
1904	Tolcon_Trace "ActivateWidget: Widget type not recognized: $type"
1905	}
1906	}
1907	}
1908
1909	#///////////////////////////////////////////////////////////////////////////
1910	method botdup {} {
1911	#
1912	# PURPOSE:
1913	#
1914	#///////////////////////////////////////////////////////////////////////////
1915	#duplicar
1916	#set status "edi"
1917	$self setStatus "ins"
1918	}
1919
1920	#///////////////////////////////////////////////////////////////////////////
1921	method botlim {} {
1922	#
1923	# PURPOSE:
1924	#
1925	#///////////////////////////////////////////////////////////////////////////
1926	#Istead of having a status control, we force it by disabling New and Edit
1927	#buttons.
1928	#$componente.f3.butdup configure -state disable
1929	#$componente.f3.butedit configure -state disable
1930	BfoCleanPath $widget(tf,pk)
1931	BfoCleanPath $widget(tf,data)
1932	$self setStatus "sel"
1933	}
1934
1935	#///////////////////////////////////////////////////////////////////////////
1936	method botref {} {
1937	#
1938	# PURPOSE:
1939	#
1940	#///////////////////////////////////////////////////////////////////////////
1941	#TODO: decidir que hace esta opcion, de momento limpiamos todos los valores
1942	# introducidos
1943	BfoCleanPath $widget(tf,pk)
1944	BfoCleanPath $widget(tf,data)
1945
1946	# $self fillForm
1947	#When pushing the Refresh button, no real action is taken but
1948	#filling up all widgets with the data. Therefore, we don't change status.
1949	#$self setStatus "sel"
1950	}
1951
1952	#///////////////////////////////////////////////////////////////////////////
1953	method botabr {} {
1954	#
1955	# PURPOSE: Shows table
1956	#
1957	#///////////////////////////////////////////////////////////////////////////
1958	set table [$self cget -table]
1959	set db [[$self cget -bodbcmodule] cget -connection]
1960	$db statement stmt "select * from $table"
1961
1962	set tl [::project::CreateForm \
1963	-title "[mc "SQL table"]: $table" \
1964	-iniconfig SQLTable \
1965	-type Tables -helpkey "Tb4Edt"
1966	]
1967	set tlf [$tl getframe]
1968	# config
1969	btable $tlf.t -parent $tl \
1970	-posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \
1971	-iniconfig btable
1972	$tlf.t fillSQL stmt
1973	pack $tlf.t -fill both -expand yes
1974	$tl bind <Control-F4> [list $tl kill]
1975	update
1976	}
1977
1978	#///////////////////////////////////////////////////////////////////////////
1979	method GetWidget { x } {
1980	#
1981	# PURPOSE:Gets widget path for field indexed by x
1982	#
1983	#///////////////////////////////////////////////////////////////////////////
1984	# comprobar q la entrada es un nombre y no un mumero -> GetLstFieldsTable
1985	if { [string is integer $x] } {
1986	return $fieldInfo($x,field,ptr)
1987	} else {
1988	set inx [lsearch -exact [$self GetLstFieldsTable] $x]
1989	if { $inx != -1 } {
1990	incr inx
1991	return $fieldInfo($inx,field,ptr)
1992	}
1993	}
1994	}
1995
1996	#///////////////////////////////////////////////////////////////////////////
1997	method getpathfield { field } {
1998	#
1999	# PURPOSE: Gets path for field
2000	# PARAMETERS: field: name of field
2001	# RETURN: path of widget
2002	#
2003	#///////////////////////////////////////////////////////////////////////////
2004	# find
2005	set infPtr [array get widget ptr,[string tolower $field]]
2006	return [lindex $infPtr 1]
2007	}
2008
2009	#///////////////////////////////////////////////////////////////////////////
2010	method showvalue { args } {
2011	#
2012	# PURPOSE: Loads the form with the indicated values
2013	# PARAMETERS:
2014	# args:
2015	# -status: [sel \| edi \| vis \| ins]
2016	# sel -> mode visualization
2017	# vis -> visualizes the proportionate information
2018	# edi -> mode edition, first clean, then edit
2019	# ins -> mode insertion
2020	# -values: pair of values {field value}
2021	#
2022	#///////////////////////////////////////////////////////////////////////////
2023	# values default
2024	array set opts [list \
2025	-status sel \
2026	-values {} \
2027	]
2028	array set opts $args
2029
2030	# status initial
2031	$self botedi
2032	$self botcan
2033	$self botref
2034	set ok true
2035	switch $opts(-status) {
2036	sel -
2037	vis { }
2038	edi { $self botedi }
2039	ins { $self botnew }
2040	default { set ok false }
2041	}
2042	# ok ?
2043	if { $ok } {
2044	# fill values
2045	foreach inf $opts(-values) {
2046	set path [$self getpathfield [lindex $inf 0]]
2047	if {[string length $path]} {
2048	$self SetValue $path [lindex $inf 1]
2049	}
2050	}
2051	# show desc
2052	$self SetValuesFieldsDesc
2053
2054	# status end
2055	set ok true
2056	switch $opts(-status) {
2057	sel { $self botsel }
2058	vis { }
2059	edi { }
2060	ins { }
2061	default { }
2062	}
2063	}
2064	}
2065
2066	#///////////////////////////////////////////////////////////////////////////
2067	method get { var} {
2068	#
2069	# PURPOSE: Obtain the value of a variable
2070	# PARAMETERS: var -> name of variable
2071	# RETURN: value of variable
2072	#
2073	#///////////////////////////////////////////////////////////////////////////
2074	return [subst $[subst "$var"]]
2075	}
2076
2077	proc IsTextType {type} {
2078	regexp {^char\|varchar\|varchar2\|text\|nchar\|ntext$} $type
2079	}
2080
2081	#///////////////////////////////////////////////////////////////////////////
2082	method InitTable {} {
2083	#
2084	# PURPUSE: Rellena la estructura inicial para invocar un Editor Mestro de
2085	# tablas a partir de una tabla dada
2086	#
2087	# PARAMETERS:
2088	# table : nombre de la tabla
2089	# connection: nombre de la conexion a usar
2090	#
2091	# RETURN: Obtenemos una lista con estructura de array con la informacion
2092	# necesaria para invocar un EditMaster.
2093	# 1 elemento -> informacion sobre los campos
2094	# 2 elemento -> informacion sobre las claves ajenas
2095	# 3 elemento -> numero de campos de la tabla
2096	#
2097	#///////////////////////////////////////////////////////////////////////////
2098	set table $tablename
2099	set tolGes [SqlGetTolGestor $gestor]
2100
2101	# Obtenemos informacion de los campos
2102	set infoColumns [GetGlobalUniqueName __infoColumns[clock second]]
2103	set cmdIC infoColums[clock clicks]
2104
2105	#set cmdTIC "Set $infoColumns = SqlInfoColumns(\"$table\", $tolGes);"
2106	set cmdTIC "Set $infoColumns = StdLib::SqlEngine::SqlInfoColumns(\"$table\", $tolGes);"
2107
2108	::tol::console eval $cmdTIC
2109	# check exists variable
2110	if {![TclInfoExists Set $infoColumns]} {
2111	# ERROR
2112	puts "Error al ejecutar: $cmdTIC"
2113	return {}
2114	}
2115	::tol::tableset create $cmdIC $infoColumns
2116
2117	# Obtenemos informacion de las foregn keys
2118	set infoForeignKeys [GetGlobalUniqueName __infoForeignKeys[clock second]]
2119	set cmdIF infoForeignKeys[clock clicks]
2120	#set cmdTIF "Set $infoForeignKeys = SqlInfoForeign(\"$table\", $tolGes);"
2121	set cmdTIF "Set $infoForeignKeys = StdLib::SqlEngine::SqlInfoForeign(\"$table\", $tolGes);"
2122
2123	::tol::console eval $cmdTIF
2124	# check exists variable
2125	if {![TclInfoExists Set $infoForeignKeys]} {
2126	# ERROR
2127	error "Error al ejecutar: $cmdTIF"
2128	return {}
2129	}
2130	# comprobamos que tenemos valores
2131	set nRegFk [lindex [TclGetFromSet Set $infoForeignKeys] 0]
2132	if {[expr $nRegFk > 0]} {
2133	::tol::tableset create $cmdIF $infoForeignKeys
2134	}
2135	#Tolcon_Trace "EditMasterUtils::InitTable. nRegFk: $nRegFk"
2136
2137	# Rellenamos informacion de los campos
2138	set index 0
2139	set nRegC [$cmdIC info datarows]
2140	for {set fila 0} {[expr $fila < $nRegC]} {incr fila} {
2141	incr index
2142	set regFields($index,field,name) \
2143	[string trim [$cmdIC data get $fila 1] \"] ;#"
2144	set regFields($index,field,label) [mc "$regFields($index,field,name)"]
2145
2146	set type [string trim [$cmdIC data get $fila 2] \"];#"
2147
2148	# Longitud. Si el campo "Precision" es igual a "?" nos quedamos con el
2149	# valor del campo "Length"
2150	set length [$cmdIC data get $fila 4]
2151	if {[IsTextType $type] \|\| [string eq $length ?]} {
2152	set length [$cmdIC data get $fila 3]
2153	}
2154
2155	set scale [$cmdIC data get $fila 5]
2156
2157	if {[IsTextType $type] \|\| [string equal $scale ?] \|\| ![string length $scale]} {
2158	set typeCol [list $type $length]
2159	} else {
2160	set typeCol [list $type $length,$scale]
2161	}
2162	set regFields($index,field,type) $typeCol
2163	set regFields($index,field,iskey) [$cmdIC data get $fila 7]
2164
2165	set regFields($index,field,notnull) [expr ![$cmdIC data get $fila 6]]
2166
2167	# Informacion por defecto para campos clave
2168	if {$regFields($index,field,iskey)} {
2169	set regFields($index,desc,table) $table
2170	set regFields($index,desc,lstshow) {}
2171	}
2172	}
2173
2174	# Pasamos el array a lista y nos quedamos con los pares
2175	# Para obtener el nombre del array multiplicaremos por dos el
2176	# indice resultado y quitamos las etiquetas
2177	set lstInfTab [array get regFields]
2178	#Tolcon_Trace "\nlstInfTab = $lstInfTab"
2179	set lstIdxLab [lsearch -all -regexp [string tolower $lstInfTab] \
2180	",field,label"]
2181	#Tolcon_Trace "\nlstIdxLab = $lstIdxLab"
2182	for {set j [expr [llength $lstIdxLab] - 1]} {[expr $j >= 0]} {incr j -1} {
2183	set ini [lindex $lstIdxLab $j]
2184	set end [expr $ini + 1]
2185	set lstInfTab [lreplace $lstInfTab $ini $end]
2186	}
2187	#Tolcon_Trace "\nlstInfTab = $lstInfTab"
2188	set lstInfTabFil [lfilter $lstInfTab 1 1]
2189	#Tolcon_Trace "\nlstInfTabFil = $lstInfTabFil"
2190	# Rellenamos informacion sobre los campos codigo de la tabla
2191	if {[string length $prociscode]} {
2192	#puts "ProcIsCode 1"
2193	set lstIdx [eval $prociscode -table $table -fields [list $lstInfTabFil]]
2194	} else {
2195	set lstIdx [lsearch -all -regexp [string tolower $lstInfTabFil] \
2196	"[join $data(codes) \|]"]
2197	}
2198	if {[expr [llength $lstIdx] == 1]} {
2199	# buscamos el indice del campo codigo
2200	set indCode \
2201	[lindex [split [lindex $lstInfTab [expr [lindex $lstIdx 0] * 2]] ,] 0]
2202	set regFields($indCode,desc,table) $table
2203
2204	# buscamos el indice del campo descripcion
2205	if {[string length $procisdesc]} {
2206	#puts "ProcIsDesc 1"
2207	set lstDes [eval $procisdesc -table $table -fields [list $lstInfTabFil]]
2208	} else {
2209	set lstDes [lsearch -all -regexp [string tolower $lstInfTabFil] \
2210	"[join $data(descritions) \|]"]
2211	}
2212	#Tolcon_Trace "EditMasterUtils::InitTable. lstDes: $lstDes"
2213	# NOTA: Opcion si queremos solo un campo informativo del codigo
2214	if {[expr [llength $lstDes] >= 1]} {
2215	set auxDescCode {}
2216	foreach des $lstDes {
2217	lappend auxDescCode [lindex $lstInfTabFil $des]
2218	}
2219	set regFields($indCode,desc,lstselect) $auxDescCode
2220	set data(field,description) $regFields($indCode,desc,lstselect)
2221	#Tolcon_Trace "EditMasterUtils::InitTable. regFields($indCode,desc,lstselect) : $regFields($indCode,desc,lstselect)"
2222	}
2223	} else {
2224	Tolcon_Trace "La tabla $table no tiene codigo"
2225	}
2226
2227	# Informacion sobre las claves ajenas
2228	#Tolcon_Trace "Informacion sobre las claves ajenas nRegFk = $nRegFk ..."
2229	if {[expr $nRegFk > 0]} {
2230	#Tolcon_Trace "Informacion sobre las claves ajenas nRegFk = $nRegFk ..."
2231	set index 0
2232	for {set fila 0} {[expr $fila < $nRegFk]} {incr fila} {
2233	incr index
2234
2235	set namCA [string trim [$cmdIF data get $fila 2] \"];#"
2236	# buscamos el campo en la tabla
2237	set indCol [lsearch $lstInfTabFil $namCA]
2238	set rowCol \
2239	[lindex [split [lindex $lstInfTab [expr $indCol * 2]] ,] 0]
2240	#Tolcon_Trace "EditMasterUtils::InitTable. rowCol: $rowCol"
2241	# Informacion de la tabla de los campos ajenos
2242	set regFields($rowCol,field,fkMRes) 1
2243
2244	set namTab [string trim [$cmdIF data get $fila 3] \"];#"
2245	set regFields($rowCol,field,links) [$self GetLinks $table $namTab]
2246
2247	#OJO. AÑADIMOS INFORMACION SOBRE LOS CAMPOS EXTERNOS DE LA TABLA, QUE NO SON
2248	#CLAVES EXTERNAS DE PRIMER NIVEL
2249	set lstTableFieldForeing \
2250	[$self _GetTableParent $namTab [string trim [$cmdIF data get $fila 5] \"]];#"
2251	set regFields($rowCol,desc,table) [lindex [lindex $lstTableFieldForeing 0] 0]
2252	set regFields($rowCol,desc,join) [lindex [lindex $lstTableFieldForeing 0] 1]
2253	#Tolcon_Trace "EditMasterUtils::InitTable. lstTableFieldForeing: $lstTableFieldForeing"
2254
2255	set regFields($rowCol,desc,show) true
2256	set regFields($rowCol,desc,lstshow) \
2257	[$self GetFieldDescForeignKey \
2258	$table \
2259	$regFields($rowCol,desc,table) \
2260	$regFields($rowCol,desc,join)]
2261	}
2262	}
2263
2264	#Tolcon_Trace "valor dado a regFields(4,desc,lstshow): $regFields(4,desc,lstshow)"
2265
2266	# construimos las referencias externas
2267	if {[expr $nRegFk > 0]} {
2268	# valores iniciales
2269	set fila 0
2270	set index 0
2271	# lectura adelantada
2272	set namFk [string trim [$cmdIF data get $fila 1] \"];#"
2273	set namFkFij {}
2274	while {[expr $fila < $nRegFk]} {
2275	if {![string eq [string tolower $namFk] [string tolower $namFkFij]]} {
2276	incr index
2277	# introducimos tabla
2278	set regFk($index,table) [string trim [$cmdIF data get $fila 3] \"];#"
2279	set namFkFij $namFk
2280	}
2281	# buscamos el indice del campo al que asociar esta restricion
2282	set valFie [string trim [$cmdIF data get $fila 2] \"];#"
2283	set id [lsearch $lstInfTabFil $valFie]
2284	if {[expr $id > -1]} {
2285	# buscamos el indice del campo codigo
2286	set inx [lindex [split [lindex $lstInfTab [expr $id * 2]] ,] 0]
2287	lappend regFk($index,indFie) $inx
2288	set regFields($inx,field,fkMRes) $index
2289	}
2290	# guardamos valores
2291	lappend regFk($index,fields) \
2292	[string trim [$cmdIF data get $fila 5] \"];#"
2293
2294	# preparamos siguiente paso
2295	incr fila
2296	if {[expr $fila < $nRegFk]} {
2297	set namFk [string trim [$cmdIF data get $fila 1] \"];#"
2298	}
2299	}
2300	#Tolcon_Trace "\n\nEditMasterUtils::InitTable.\n RegFk: [array get regFk]\n\n"
2301	}
2302
2303	# destruimos todas las variables creadas internamente
2304	::tol::tableset destroy $cmdIC
2305	if {[expr $nRegFk > 0]} {
2306	::tol::tableset destroy $cmdIF
2307	}
2308	::tol::console stack release $infoColumns
2309	::tol::console stack release $infoForeignKeys
2310	#Tolcon_Trace"valor dado a regFields(4,desc,lstshow): $regFields(4,desc,lstshow)"
2311	# return
2312	if {[array exists regFk]} {
2313	return [list [array get regFields] [array get regFk] $nRegC]
2314	} else {
2315	return [list [array get regFields] {} $nRegC]
2316	}
2317	}
2318
2319
2320	#///////////////////////////////////////////////////////////////////////////
2321	method GetFieldDescForeignKey {table tableFk fieldFk} {
2322	#
2323	# PURPUSE: Para una clave externa obtenemos un campo de información sobre
2324	# el campo indicado
2325	#
2326	# PARAMETERS:
2327	# table : Nombre de la tabla principal
2328	# tableFk: Nombre de la tabla de la relacion
2329	# fieldFk: Nombre del campo de la relacion
2330	#
2331	# RETURN: Deveulve la lista de campos descripcion seleccionados para una
2332	# tabla
2333	#
2334	#/////////////////////////////////////////////////////////////////////////////
2335	set tolGes [SqlGetTolGestor $gestor]
2336	set result {}
2337
2338	# Comprobamos que la tabla sea la misma
2339	if {[string eq [string tolower $table] [string tolower $tableFk]]} {
2340	set result $data(field,description)
2341	} else {
2342	incr step
2343	# informacion de la tabla ajena
2344	set infoColumns [GetGlobalUniqueName __infoColumns$step[clock second]]
2345	set cmdIC infoColums$step[clock clicks]
2346	#set cmdTIC "Set $infoColumns = SqlInfoColumns(\"$tableFk\", $tolGes);"+
2347	set cmdTIC "Set $infoColumns = StdLib::SqlEngine::SqlInfoColumns(\"$tableFk\", $tolGes);"
2348
2349	::tol::console eval $cmdTIC
2350	# check exists variable
2351	if {![TclInfoExists Set $infoColumns]} {
2352	# ERROR
2353	error "Error al ejecutar: $cmdTIC"
2354	return {}
2355	}
2356	::tol::tableset create $cmdIC $infoColumns
2357
2358	# recorremos la tabla en busca de un valor coincidente
2359	set ok 0
2360	set fila 0
2361	set nRegC [$cmdIC info datarows]
2362	while {([expr $fila < $nRegC]) && (!$ok)} {
2363	set valFie [string trim [$cmdIC data get $fila 1] {"}] ;#"
2364	if {[string length $procisdesc]} {
2365	#puts "ProcIsDesc 2"
2366	set id [lindex [eval $procisdesc -table $tableFk -fields $valFie] 0]
2367	} else {
2368	set id [lsearch [string tolower $data(descritions)] \
2369	[string tolower $valFie]]
2370	}
2371	if {([llength $id] && [expr $id >= 0])} {
2372	set ok 1
2373	set result $valFie
2374	}
2375	incr fila
2376	}
2377
2378	# destruimos todas las variables creadas internamente
2379	::tol::tableset destroy $cmdIC
2380	::tol::console stack release $infoColumns
2381	}
2382
2383	#Tolcon_Trace "GetFieldDescForeignKey. result: $result"
2384	return $result
2385	}
2386
2387	#///////////////////////////////////////////////////////////////////////////
2388	method GetLinks {table tableFk } {
2389	#
2390	# PURPUSE: Obtenemos la función a ejecutar en las claves externas. Buscamos
2391	# si existe un 'namespace' para la tabla relacionada. Para ello
2392	# comparamos el nombre de la tabla con los nombres de los
2393	# namespaces existentes. En caso de que coincida alguno,
2394	# comprobamos si existe la funcion 'Show' para ese namespace
2395	#
2396	# PARAMETERS:
2397	# table : Nombre de la tabla principal
2398	# tableFk : Nombre de la tabla de la relacion
2399	# connection: Nombre de la conexion a usar
2400	#
2401	# RETURN: Deveulve la lista de campos descripcion seleccionados para una
2402	# tabla
2403	#
2404	#/////////////////////////////////////////////////////////////////////////////
2405	# inizialization
2406	set links [list "::edTableGeneric::Show -table $tableFk -bodbcmodule $bodbcmodule"]
2407	set prefNam {::ed}
2408	set lenPref [string length $prefNam]
2409	# check table ?
2410	if {[string eq [string tolower $table] [string tolower $tableFk]]} {
2411	set links {}
2412	} else {
2413	# check exists document ?
2414	set lstNam [namespace children ::]
2415	set lstIdx [lsearch -all -regexp $lstNam ${prefNam}*]
2416	#Tolcon_Trace "GetLinks. lstNam: $lstNam \n rlstIdx: $lstIdx"
2417	# recorremos los distintos namespaces
2418	foreach idx $lstIdx {
2419	set rNam [string range [lindex $lstNam $idx] $lenPref end]
2420	set rTab [string range $tableFk \
2421	[expr [string length $tableFk] - [string length $rNam]] end]
2422	#Tolcon_Trace "GetLinks. rNam: $rNam \n rTab: $rTab"
2423	# namespace equal table ?
2424	if {([string eq [string tolower $rNam] [string tolower $rTab]]) && \
2425	([expr ([string length $table] - [string length $rTab]) <= 3])} {
2426	# exists namespace
2427	#Tolcon_Trace "GetLinks. namespace: ::${prefNam}${rNam}::Show"
2428	if {[string length [info commands ${prefNam}${rNam}::Show]]} {
2429	set links "${prefNam}${rNam}::Show"
2430	}
2431	}
2432	}
2433	}
2434	#Tolcon_Trace "GetLinks. links: $links"
2435	# return
2436	return $links
2437	}
2438
2439	#///////////////////////////////////////////////////////////////////////////
2440	method _GetTableParent {table field} {
2441	#
2442	# PURPUSE: Obtenemos para una tabla y un campo, la tabla en la que se crea
2443	# ese campo y el nombre del campo que hace referencia.
2444	#
2445	# PARAMETERS:
2446	# table : Nombre de la tabla
2447	# field : Nombre del campo
2448	# connection: Nombre de la conexion a usar
2449	#
2450	# RETURN: Deveulve una lista con el nombre de la tabla y el del campo
2451	#
2452	#/////////////////////////////////////////////////////////////////////////////
2453	set tolGes [SqlGetTolGestor $gestor]
2454	# name of Text TOL
2455	set namTabFie [GetGlobalUniqueName __nameTabFie__]
2456	set cmd "Text $namTabFie = TxtListTcl(SqlGetTableParent(\"${table}\", \"${field}\", $tolGes));"
2457	# run
2458	::tol::console eval $cmd
2459	set lst [string trim [TclGetVar Text $namTabFie] {"}];#"
2460	if {[string length $lst]} { eval set lst $lst }
2461	# destroy
2462	::tol::console stack release $namTabFie
2463	# retunr
2464	return $lst
2465	}
2466	}
2467	#snit::widget
2468
2469	package provide beditmaster 1.0

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: tol/tolbase/lib/byswidget/beditmaster/beditmaster.tcl @ bdc524a

Download in other formats: