package require java
if {[info exists argv]} {
set DatabaseType [lindex $argv 0]
if {$DatabaseType == ""} {
set DatabaseType "drillholes"
}
} else {
set DatabaseType "drillholes"
}
GuidoApp check_db "CHECK DATABASE CONNECTED"
$check_db setParam "databasepurpose" "$DatabaseType"
set result [$check_db invoke]
set SessionType [$check_db getParam "databasesession"]
set dbHandle [$check_db getParam "databasehandle"]
$check_db destroy
set buffer [ GuidoExecServer "DoesStylesExist" [subst {databasetype = $SessionType}] ]
set HaveStyles [GuidoGetParamBufferValue $buffer StylesExist]
if {$result == "0" && $HaveStyles == "true" } {
set clientManager [java::call com.surpac.client.ClientManager getSharedInstance]
set progressFeedback [java::new com.surpac.gui.ProgressDialog [$clientManager getActiveFrame] ]
$progressFeedback setAbortEnabled false
$progressFeedback { add String int} "Form loading - Please Wait" 99999
proc endProgressFeedback { } {
global progressFeedback
$progressFeedback {remove int} 99999
}
proc disableTableMenus { tree } {
set rootNode [$tree getRootNode]
$rootNode setMenuEnabled false
set count [$rootNode getChildCount]
for {set idx 0} {$idx < $count} {incr idx} {
set child [$rootNode getChildAt $idx]
$child setMenuEnabled false
}
}
proc getDrillholePatternFilename { menuItem } {
set filename [GuidoSSIOption get "drill hole pattern file"]
$menuItem setLabel "Load $filename"
}
proc loadPlottingPatterns { patterns } {
set patternParams [GuidoExecServer "GetPatternNames" {}]
set count [GuidoGetParamBufferValue $patternParams num_values]
set patternList ""
for {set idx 0} {$idx < $count} {incr idx} {
append patternList "\""
append patternList "[GuidoGetParamBufferValue $patternParams value_$idx]"
append patternList "\" "
}
eval [concat {$patterns} {setValues} $patternList]
}
proc getStyleType { node } {
set style [$node getCurrentValue]
if {[string length $style] == 0} {
set node [$node getParent]
set style [$node getCurrentValue]
}
set idx [string first "StyleType=" $style]
if {$idx == -1} {
return ""
} else {
set posn [expr $idx + 10]
set idx [string first ";" $style]
if {$idx == -1} {
return "[string range $style $posn end]"
} else {
incr idx -1
return "[string range $style $posn $idx]"
}
}
}
proc isCharacterFld { node } {
if {[$node isLeaf]} {
set fieldNode [$node getParent]
set style "[getStyleType $fieldNode]"
if {"$style" == "Character"} {
return 1
}
} else {
set style "[getStyleType $node]"
if {"$style" == "Character"} {
return 1
}
}
return 0
}
proc getFromValue { node } {
set nodeLabel "[$node getLabelText]"
set idx [string first "  -  " $nodeLabel]
if {$idx == -1} {
return ""
} else {
incr idx -1
return "[string range $nodeLabel 0 $idx]"
}
}
proc getToValue { node } {
set nodeLabel "[$node getLabelText]"
set idx [string first "  -  " $nodeLabel]
if {$idx == -1} {
return ""
} else {
set posn [expr $idx + 5]
return "[string range $nodeLabel $posn end]"
}
}
proc getStyleAttribute { node style } {
set attributes [$node getCurrentValue]
append style "="
set idx [string first $style $attributes]
if {$idx == -1} {
if {"$style" == "GraphicsColour=" || "$style" == "PlottingColour="} {
return "periwinkle"
} elseif {"$style" == "GraphicsPattern="} {
return "solid"
} elseif {"$style" == "PlottingPattern="} {
return "solid"
} elseif {"$style" == "LineStyle="} {
return "line_colour~periwinkle!line_pattern~---!line_join~>!line_end~|!line_weight~1"
} elseif {"$style" == "MarkerStyle="} {
return "marker_symbol~/.\\!marker_size~0.5"
} else {
return ""
}
} else {
set offset [string length $style]
set start [expr $idx + $offset]
set attStr "[string range $attributes $start end]"
set idx [string first ";" $attStr]
incr idx -1
return "[string range $attStr 0 $idx]"
}
}
proc setStyleAttribute { node style value } {
set attributes [$node getCurrentValue]
append style "="
set idx [string first $style $attributes]
if {$idx != -1} {
set startStrEndPosn [expr $idx - 2]
set startStr [string range $attributes 0 $startStrEndPosn]
set endStr [string range $attributes $idx end]
set idx [string first ";" $endStr]
incr idx
set finalEndStr [string range $endStr $idx end]
if {"$startStr" != ""} {
$node setCurrentValue "$startStr;$style$value;$finalEndStr"
} else {
$node setCurrentValue "$style$value;$finalEndStr"
}
} else {
append newValue "$attributes" "$style$value;"
$node setCurrentValue "$newValue"
}
}
proc updateMenuOptions { tree fieldCodesItem minMaxItem loadDHStylesItem databaseType } {
set selectedNode [$tree getSelectedNode]
set rootNode [$tree getRootNode]
if {"$selectedNode" != ""} {
if {$rootNode == $selectedNode} {
$fieldCodesItem setInputAllowed false
$minMaxItem setInputAllowed false
$loadDHStylesItem setInputAllowed true
} elseif {[isCharacterFld $selectedNode]} {
$fieldCodesItem setInputAllowed true
$minMaxItem setInputAllowed false
$loadDHStylesItem setInputAllowed true
} else {
$fieldCodesItem setInputAllowed false
$minMaxItem setInputAllowed true
$loadDHStylesItem setInputAllowed false
}
if {$databaseType == "surveys"} {
$loadDHStylesItem setInputAllowed false
}
}
}
set lastSelectedNode ""
proc getCurrentStyles { databaseType tree tableName fieldName code fromValue toValue graphicsColour graphicsPattern plottingColour plottingPattern lineStyle markerStyle} {
global lastSelectedNode
if {"$lastSelectedNode" != "" && [$lastSelectedNode isLeaf]} {
if {"[$graphicsColour getCurrentValue]" == ""} {
$graphicsColour requestFocus
$tree setSelectedNode $lastSelectedNode
GuidoMessage message DB_NO_NULLS_ALLOWED "Graphics colour"
return 0
} else {
setStyleAttribute $lastSelectedNode "GraphicsColour" "[$graphicsColour getCurrentValue]"
}
if {"[$graphicsPattern getCurrentValue]" == ""} {
$graphicsPattern requestFocus
$tree setSelectedNode $lastSelectedNode
GuidoMessage message DB_NO_NULLS_ALLOWED "Graphics Pattern"
return 0
} else {
setStyleAttribute $lastSelectedNode "GraphicsPattern" "[$graphicsPattern getCurrentValue]"
}
if {"[$plottingColour getCurrentValue]" == ""} {
$graphicsColour requestFocus
$tree setSelectedNode $lastSelectedNode
GuidoMessage message DB_NO_NULLS_ALLOWED "Plotting colour"
return 0
} else {
setStyleAttribute $lastSelectedNode "PlottingColour" "[$plottingColour getCurrentValue]"
}
if {"[$plottingPattern getCurrentValue]" == ""} {
$plottingPattern requestFocus
$tree setSelectedNode $lastSelectedNode
GuidoMessage message DB_NO_NULLS_ALLOWED "Plotting Pattern"
return 0
} else {
setStyleAttribute $lastSelectedNode "PlottingPattern" "[$plottingPattern getCurrentValue]"
}
if {"[$lineStyle getCurrentValue]" == ""} {
$lineStyle requestFocus
$tree setSelectedNode $lastSelectedNode
GuidoMessage message DB_NO_NULLS_ALLOWED "Line style"
return 0
} else {
setStyleAttribute $lastSelectedNode "LineStyle" "[$lineStyle getCurrentValue]"
}
if {"[$markerStyle getCurrentValue]" == ""} {
$markerStyle requestFocus
$tree setSelectedNode $lastSelectedNode
GuidoMessage message DB_NO_NULLS_ALLOWED "Marker style"
return 0
} else {
setStyleAttribute $lastSelectedNode "MarkerStyle" "[$markerStyle getCurrentValue]"
}
}
set selectedNode [$tree getSelectedNode]
if {"$selectedNode" != ""} {
if {![$selectedNode isLeaf]} {
set parent [$selectedNode getParent]
if {"$parent" != ""} {
set table "[$parent getLabelText]"
set field "[$selectedNode getLabelText]"
if {[$selectedNode getChildCount] == 0} {
$tableName setLabel "$table"
$fieldName setCurrentValue "$field"
set fieldParam [GuidoExecServer "GetDrillholeStyleValues" [subst {databasetype = $databaseType Table = $table Field = $field} ]]
set count [GuidoGetParamBufferValue $fieldParam FieldCount]
$tree setRefreshEnabled false
for {set idx 0} {$idx < $count} {incr idx} {
set graphicsColour "[GuidoGetParamBufferValue $fieldParam GraphicsColour($idx)]"
set graphicsPattern "[GuidoGetParamBufferValue $fieldParam GraphicsPattern($idx)]"
set plottingColour "[GuidoGetParamBufferValue $fieldParam PlottingColour($idx)]"
set plottingPattern "[GuidoGetParamBufferValue $fieldParam PlottingPattern($idx)]"
set lineStyle "[GuidoGetParamBufferValue $fieldParam LineStyle($idx)]"
set markerStyle "[GuidoGetParamBufferValue $fieldParam MarkerStyle($idx)]"
set fieldName style_field_$idx
if {"[GuidoGetParamBufferValue $fieldParam StyleType($idx)]" == "character"} {
GuidoTreeLeaf "$fieldName" {
-default "GraphicsColour=$graphicsColour;GraphicsPattern=$graphicsPattern;PlottingColour=$plottingColour;PlottingPattern=$plottingPattern;LineStyle=$lineStyle;MarkerStyle=$markerStyle;"
-label "[GuidoGetParamBufferValue $fieldParam Code($idx)]"
-no_mlt
}
} else {
set from [GuidoGetParamBufferValue $fieldParam From($idx)]
set to [GuidoGetParamBufferValue $fieldParam To($idx)]
GuidoTreeLeaf "$fieldName" {
-default "GraphicsColour=$graphicsColour;GraphicsPattern=$graphicsPattern;PlottingColour=$plottingColour;PlottingPattern=$plottingPattern;LineStyle=$lineStyle;MarkerStyle=$markerStyle;"
-label "$from  -  $to"
-no_mlt
}
}
upvar 0 $fieldName styleNode
$selectedNode addChild $styleNode -1
}
$tree setRefreshEnabled true
}
} else {
$tableName setLabel ""
$fieldName setCurrentValue ""
}
} else {
if {[isCharacterFld $selectedNode]} {
$code setInputAllowed true
$code setCurrentValue "[$selectedNode getLabelText]"
$code requestFocus
$fromValue setInputAllowed false
$fromValue setCurrentValue ""
$toValue setInputAllowed false
$toValue setCurrentValue ""
} else {
$code setInputAllowed false
$code setCurrentValue ""
$fromValue setInputAllowed true
$fromValue setCurrentValue [getFromValue $selectedNode]
$fromValue requestFocus
$toValue setInputAllowed true
$toValue setCurrentValue [getToValue $selectedNode]
if {[getStyleType $selectedNode] == "Numeric"} {
$fromValue setFormat double
$toValue setFormat double
} elseif {[getStyleType $selectedNode] == "Datetime"} {
$fromValue setFormat datetime
$toValue setFormat datetime
} else {
$fromValue setFormat none
$toValue setFormat none
}
}
set parent [$selectedNode getParent]
set pparent [$parent getParent]
set table "[$pparent getLabelText]"
set field "[$parent getLabelText]"
$tableName setLabel "$table"
$fieldName setCurrentValue "$field"
$graphicsColour setCurrentValue "[getStyleAttribute $selectedNode GraphicsColour]"
$graphicsPattern setCurrentValue "[getStyleAttribute $selectedNode GraphicsPattern]"
$plottingColour setCurrentValue "[getStyleAttribute $selectedNode PlottingColour]"
$plottingPattern setCurrentValue "[getStyleAttribute $selectedNode PlottingPattern]"
$lineStyle setCurrentValue "[getStyleAttribute $selectedNode LineStyle]"
$markerStyle setCurrentValue "[getStyleAttribute $selectedNode MarkerStyle]"
}
set lastSelectedNode $selectedNode
}
return 1
}
proc updateCodeLabel { tree code } {
set selectedNode [$tree getSelectedNode]
if {"$selectedNode" != "" && [$selectedNode isLeaf]} {
$selectedNode setLabel "[$code getCurrentValue]"
}
}
proc updateFromToValueLabel { tree from to } {
set selectedNode [$tree getSelectedNode]
if {$selectedNode != ""} {
if {[$selectedNode isLeaf]} {
set fVal [$from getCurrentValue]
set tVal [$to getCurrentValue]
$selectedNode setLabel "$fVal  -  $tVal"
}
}
}
proc saveSelectedStyleAttributes { tree graphicsColour graphicsPattern plottingColour plottingPattern lineStyle markerStyle} {
set currentNodeSelected [$tree getSelectedNode]
if {"$currentNodeSelected" != "" && [$currentNodeSelected isLeaf]} {
setStyleAttribute $currentNodeSelected "GraphicsColour" "[$graphicsColour getCurrentValue]"
setStyleAttribute $currentNodeSelected "GraphicsPattern" "[$graphicsPattern getCurrentValue]"
setStyleAttribute $currentNodeSelected "PlottingColour" "[$plottingColour getCurrentValue]"
setStyleAttribute $currentNodeSelected "PlottingPattern" "[$plottingPattern getCurrentValue]"
setStyleAttribute $currentNodeSelected "LineStyle" "[$lineStyle getCurrentValue]"
setStyleAttribute $currentNodeSelected "MarkerStyle" "[$markerStyle getCurrentValue]"
}
return 1
}
proc numericRangeOverlap { from1 to1 from2 to2 } {
if {$from1 == $from2} {
return 1
}
if {$to1 == $to2} {
return 1
}
if {$from1 < $from2 && $to2 < $to1} {
return 1
}
if {$from2 < $from1 && $from1 < $to2 && $to2 < $to1} {
return 1
}
if {$from1 < $from2 && $from2 < $to1 && $to1 < $to2} {
return 1
}
if {$from2 < $from1 && $to1 < $to2} {
return 1
}
return 0
}
proc datetimeRangeOverlap { from1 to1 from2 to2 } {
set from1Buff [GuidoExecServer GetDateTimeAsNumber [subst {DateTime = "$from1"}]]
set from1Number [GuidoGetParamBufferValue $from1Buff DateTimeNumber]
set to1Buff [GuidoExecServer GetDateTimeAsNumber [subst {DateTime = "$to1"}]]
set to1Number [GuidoGetParamBufferValue $to1Buff DateTimeNumber]
set from2Buff [GuidoExecServer GetDateTimeAsNumber [subst {DateTime = "$from2"}]]
set from2Number [GuidoGetParamBufferValue $from2Buff DateTimeNumber]
set to2Buff [GuidoExecServer GetDateTimeAsNumber [subst {DateTime = "$to2"}]]
set to2Number [GuidoGetParamBufferValue $to2Buff DateTimeNumber]
return [numericRangeOverlap $from1Number $to1Number $from2Number $to2Number
}
proc checkNumericRanges { tree } {
set rootNode [$tree getRootNode]
set numTables [$rootNode getChildCount]
for {set idx 0} {$idx < $numTables} {incr idx} {
set table [$rootNode getChildAt $idx]
set numFields [$table getChildCount]
for {set idx2 0} {$idx2 < $numFields} {incr idx2} {
set field [$table getChildAt $idx2]
if {![isCharacterFld $field]} {
set styleType [getStyleType $field]]
set numStyles [$field getChildCount]
for {set idx3 0} {$idx3 <$numStyles} {incr idx3} {
set style [$field getChildAt $idx3]
set from1 [getFromValue $style]
set to1 [getToValue $style]
set i [expr $idx3 + 1]
for {set idx4 $i} {$idx4 < $numStyles} {incr idx4} {
set nextStyle [$field getChildAt $idx4]
set from2 [getFromValue $nextStyle]
set to2 [getToValue $nextStyle]
if {$styleType == "Numeric"} {
if {[numericRangeOverlap $from1 $to1 $from2 $to2]} {
GuidoMessage message DB_OVERLAPPING_STYLE_RANGE "[$field getLabelText]" "[$table getLabelText]" "$from1" "$to1" "$from2" "$to2"
return 0
}
} elseif {$styleType == "Datetime"} {
if {[datetimeRangeOverlap $from1 $to1 $from2 $to2]} {
GuidoMessage message DB_OVERLAPPING_STYLE_RANGE "[$field getLabelText]" "[$table getLabelText]" "$from1" "$to1" "$from2" "$to2"
return 0
}
}
}
}
}
}
}
return 1
}
proc addNewDHStyle { tree } {
set selectedNode [$tree getSelectedNode]
set fieldName [$selectedNode getLabelText]
set parent [$selectedNode getParent]
set tableName [$parent getLabelText]
set styleNumber [$selectedNode getChildCount]
if {[isCharacterFld $selectedNode]} {
set nodeLabel "new_code"
} else {
set nodeLabel "new_from  -  new_to "
}
append leafName $tableName "_" $fieldName "_" $styleNumber
GuidoTreeLeaf "$leafName" {
-label "$nodeLabel"
-default ""
-no_mlt
}
upvar 0 "$leafName" field
$selectedNode addChild $field -1
$tree setSelectedNode $field
return 1
}
proc getMinMaxValues { node type } {
set currentValue "[$node getCurrentValue]"
set searchType "$type="
set idx [string first $searchType $currentValue]
if {$idx == -1} {
return ""
} else {
set posn [expr $idx + 4]
set value "[string range $currentValue $posn end]"
set idx [string first ";" $value]
incr idx -1
return "[string range $value 0 $idx]"
}
}
proc setMinMaxValues { node type value } {
set currentValue "[$node getCurrentValue]"
append type "="
set idx [string first $type $currentValue]
if {$idx == -1} {
set delimiter [string last ";" $currentValue]
set lastPosn [string length $currentValue]
if {$delimiter != [expr $lastPosn - 1]} {
append currentValue ";"
}
append currentValue "$type$value;"
$node setCurrentValue "$currentValue"
} else {
set startStrEndPosn [expr $idx - 2]
set startStr [string range $currentValue 0 $startStrEndPosn]
set endStr [string range $currentValue $idx end]
set idx [string first ";" $endStr]
incr idx
set finalEndStr [string range $endStr $idx end]
if {"$startStr" != ""} {
$node setCurrentValue "$startStr;$type$value;$finalEndStr"
} else {
$node setCurrentValue "$type$value;$finalEndStr"
}
}
}
proc isCodeInTree { node code } {
set count [$node getChildCount]
for {set idx 0} {$idx < $count} {incr idx} {
set child [$node getChildAt $idx]
if {"[$child getLabelText]" == "$code"} {
return 1
}
}
return 0
}
proc getFieldValues { databaseType tree } {
set selectedNode [$tree getSelectedNode]
set fieldName [$selectedNode getLabelText]
set parent [$selectedNode getParent]
set tableName [$parent getLabelText]
if {[isCharacterFld $selectedNode]} {
set codesParam [GuidoExecServer "GetFieldCodes" [subst {databasetype = $databaseType TableName = "$tableName" FieldName = "$fieldName"}]]
set count [GuidoGetParamBufferValue $codesParam Count]
for {set idx 0} {$idx < $count} {incr idx} {
set code "[GuidoGetParamBufferValue $codesParam FieldCode($idx)]"
if {![isCodeInTree $selectedNode $code]} {
set styleNumber [$selectedNode getChildCount]
append leafName $tableName "_" $fieldName "_" $styleNumber
GuidoTreeLeaf  "$leafName" {
-default "GraphicsColour=periwinkle;GraphicsPattern=solid;PlottingColour=periwinkle;PlottingPattern=solid;LineStyle=line_colour~periwinkle!line_pattern~---!line_join~>!line_end~|!line_weight~1;MarkerStyle=marker_symbol~/.\\!marker_size~0.5;"
-label "$code"
-no_mlt
}
upvar 0 "$leafName" childNode
$selectedNode addChild $childNode -1
}
}
if {$count == 0} {
GuidoMessage message DB_NO_CODES_FOR_CHAR_FLD "$fieldName" "$tableName"
}
} else {
set min [getMinMaxValues $selectedNode "Min"]
set max [getMinMaxValues $selectedNode "Max"]
if {"$min" == "" && "$max" == ""} {
if {[getStyleType $selectedNode] == "Numeric"} {
set rangeParam [GuidoExecServer "GetMinMaxFieldValues" [subst {databasetype = $databaseType TableName = "$tableName" FieldName = "$fieldName"}]]
} else {
set rangeParam [GuidoExecServer "GetMinMaxDatetimeFieldValues" [subst {databasetype = $databaseType TableName = "$tableName" FieldName = "$fieldName"}]]
}
set min [GuidoGetParamBufferValue $rangeParam MinValue]
set max [GuidoGetParamBufferValue $rangeParam MaxValue]
}
set styleNumber [$selectedNode getChildCount]
append leafName $tableName "_" $fieldName "_" $styleNumber
GuidoTreeLeaf  "$leafName" {
-default "GraphicsColour=periwinkle;GraphicsPattern=solid;PlottingColour=periwinkle;PlottingPattern=solid;LineStyle=line_colour~periwinkle!line_pattern~---!line_join~>!line_end~|!line_weight~1;MarkerStyle=marker_symbol~/.\\!marker_size~0.5;"
-label "$min  -  $max"
-no_mlt
}
upvar 0 "$leafName" childNode
$selectedNode addChild $childNode -1
$tree setSelectedNode $childNode
setMinMaxValues $selectedNode "Min" $min
setMinMaxValues $selectedNode "Max" $max
}
return 1
}
proc getNodeHandle { branch nodeLabel } {
set count [$branch getChildCount]
for {set idx 0} {$idx < $count} {incr idx} {
set child [$branch getChildAt $idx]
if {"[$child getLabelText]" == "$nodeLabel"} {
return $child
}
}
return 0
}
proc loadDHStyles { tree } {
set selectedNode [$tree getSelectedNode]
set fieldName [$selectedNode getLabelText]
set parent [$selectedNode getParent]
set tableName [$parent getLabelText]
set codes ""
set count [$selectedNode getChildCount]
for {set idx 0} {$idx < $count} {incr idx} {
set child [$selectedNode getChildAt $idx]
if {"$codes" == ""} {
set codes "[$child getLabelText]"
} else {
append codes ";" "[$child getLabelText]"
}
}
set stylesParam [GuidoExecServer "LoadDHStyles" [subst {TableName = "$tableName" FieldName = "$fieldName" Codes = "$codes"}]]
set count [GuidoGetParamBufferValue $stylesParam Count]
for {set idx 0} {$idx < $count} {incr idx} {
set code "[GuidoGetParamBufferValue $stylesParam Code($idx)]"
set colour "[GuidoGetParamBufferValue $stylesParam Colour($idx)]"
if {"$colour" == ""} {
set colour "periwinkle"
}
set graphicsPattern "[GuidoGetParamBufferValue $stylesParam GraphicsPattern($idx)]"
if {"$graphicsPattern" == ""} {
set graphicsPattern "solid"
}
set lineStyle "[GuidoGetParamBufferValue $stylesParam LineStyle($idx)]"
if {"$lineStyle" == ""} {
set lineStyle "line_colour~periwinkle!line_pattern~---!line_join~>!line_end~|!line_weight~1"
}
set markerStyle "[GuidoGetParamBufferValue $stylesParam MarkerStyle($idx)]"
if {"$markerStyle" == ""} {
set markerStyle "marker_symbol~/.\\!marker_size~0.5"
}
set value "GraphicsColour=$colour;GraphicsPattern=$graphicsPattern;PlottingColour=$colour;PlottingPattern=solid;LineStyle=$lineStyle;MarkerStyle=markerStyle"
set node [getNodeHandle $selectedNode $code]
$node setCurrentValue "$value"
}
return 1
}
proc removeDHStyle { tree } {
set selectedNode [$tree getSelectedNode]
set parent [$selectedNode getParent]
$parent removeChild $selectedNode
if {[$parent getChildCount] == 0} {
set currentValue "[$parent getCurrentValue]"
append currentValue "DeleteAll;"
$parent setCurrentValue "$currentValue"
}
return 1
}
GuidoPopupMenu fieldOptionsMenu {
GuidoMenuItem addNewStyleItem {
-label "Add new style"
}
GuidoMenuItem getFieldCodesItem {
-label "Get field codes"
}
GuidoMenuItem getMinMaxRangeItem {
-label "Get min - max range"
}
GuidoMenuItem loadDHSSIItem {
}
}
GuidoPopupMenu styleOptionsMenu {
GuidoMenuItem removeItem {
-label "Remove style"
}
}
GuidoTree databaseTree {
-no_mlt
-enable_action dragSourceGestureRecognized
-label "Database Structure"
-database_handle $dbHandle
}
GuidoForm editAttributesForm {
-action initial {[endProgressFeedback]}
-default_buttons
-defaults_management false
-tip DB_SET_STYLES_TIP
-help_id 361
-label "Edit database display styles"
GuidoPanel infoPanel {
-layout BoxLayout Y_AXIS
GuidoPanel editAttributesPanel {
-layout BoxLayout X_AXIS
GuidoPanel treePanel {
-border etched true
-font_style bold
-label "Tables and fields"
-layout BoxLayout Y_AXIS
GuidoScrollPane databaseStructureScroll {
-height 25
-width 24
}
}
GuidoPanel attributesInfoPanel {
-border etched true
-font_style bold
-label "Display attributes"
-layout BoxLayout Y_AXIS
GuidoFiller filler5 {
-height 0.5
}
GuidoPanel outerFieldInfoPanel {
-layout BoxLayout X_AXIS
GuidoFiller filler2 {
-width 6
}
GuidoPanel fieldInfoPanel {
-layout CentreLineLayout
GuidoLabel tableNameLabel {
-font_style bold
-label "Table"
}
GuidoLabel tableNameFld {
-no_mlt
}
GuidoLabel fieldLabel {
-font_style bold
-label "Field"
}
GuidoLabel fieldNameFld {
-no_mlt
}
}
}
GuidoFiller filler3 {
-height 0.5
}
GuidoPanel attributesInfoPanel1 {
-border loweredBevel false
-layout BoxLayout Y_AXIS
GuidoFiller filler9 {
-height 0.2
}
GuidoPanel attributesPanel {
-layout CentreLineLayout
GuidoField codeFld {
-display_length 11
-label "Code"
-tip DB_SET_STYLES_CODE_TIP
}
GuidoField fromValueFld {
-display_length 11
-label "From Value"
-tip DB_SET_STYLES_FROM_TIP
}
GuidoField toValueFld {
-display_length 11
-label "To Value"
-tip DB_SET_STYLES_TO_TIP
}
GuidoFiller filler4a {
-height 0.4
}
GuidoFiller filler4b {}
GuidoColourBrowserField graphicsColourBrowserField {
-display_length 11
-exclusive false
-label "Graphics Colour"
-max_length 32
-tip DB_SET_STYLES_COLOUR_TIP
-null false
-format colour
-default "periwinkle"
}
GuidoComboBox graphicsPatternComboBox {
-label "Graphics Pattern"
-display_length 8.6
-exclusive true
-null false
-value_in solid "##" "||" "[][]" "//" "\\\\" "<><>" "::" "=="
-tip DB_SET_STYLES_GRAPHICS_PATTERN_TIP
-default "solid"
}
GuidoColourBrowserField plottingColourBrowserField {
-display_length 11
-exclusive false
-label "Plotting Colour"
-max_length 32
-tip DB_SET_STYLES_COLOUR_TIP
-null false
-format colour
-default "periwinkle"
}
GuidoPatternBrowserField plottingPatternComboBox {
-label "Plotting Pattern"
-action initial {[loadPlottingPatterns $plottingPatternComboBox]}
-display_length 11
-exclusive true
-null false
-tip DB_SET_STYLES_PLOTTING_PATTERN_TIP
-default "solid"
}
GuidoFiller filler4a {
-height 0.2
}
GuidoFiller filler4b {}
StringLineStyles lineStyle {
-label Line
-width 11
-tip STYLES_STRING_TIP
}
GuidoFiller filler5a {
-height 0.1
}
GuidoFiller filler6a {
-height 0.2
}
MarkerSymbols markerStyle {
-label "Marker"
-width 11
-tip STYLES_MARKER_TIP
}
GuidoFiller filler7a {
-height 0.1
}
GuidoFiller filler19 {
-height 0.2
}
}
}
}
}
}
}
if {$DatabaseType == "surveys"} {
$plottingPatternComboBox setInputAllowed false
$graphicsPatternComboBox setInputAllowed false
}
set buffer [ GuidoExecServer ServerGetSelectedLegendItem { } ]
set fullPath [GuidoGetParamBufferValue $buffer fullPath]
set path [GuidoGetParamBufferValue $buffer path]
if {$path > ""} {
$databaseTree expandPath $fullPath
}
$databaseTree installTreeLoader EditAttributesTreeStructure
if {$path > ""} {
getCurrentStyles $DatabaseType $databaseTree $tableNameFld $fieldNameFld $codeFld $fromValueFld $toValueFld $graphicsColourBrowserField $graphicsPatternComboBox $plottingColourBrowserField $plottingPatternComboBox $lineStyle $markerStyle
$databaseTree expandPath $fullPath
getCurrentStyles $DatabaseType $databaseTree $tableNameFld $fieldNameFld $codeFld $fromValueFld $toValueFld $graphicsColourBrowserField $graphicsPatternComboBox $plottingColourBrowserField $plottingPatternComboBox $lineStyle $markerStyle
}
$databaseTree setEditable false
$databaseTree setActionCallback valueChanged {[getCurrentStyles $DatabaseType $databaseTree $tableNameFld $fieldNameFld $codeFld $fromValueFld $toValueFld $graphicsColourBrowserField $graphicsPatternComboBox $plottingColourBrowserField $plottingPatternComboBox $lineStyle $markerStyle]}
$databaseTree setActionCallback mouseClicked {[updateMenuOptions $databaseTree $getFieldCodesItem $getMinMaxRangeItem $loadDHSSIItem $DatabaseType]}
$databaseTree setBranchMenu $fieldOptionsMenu
$databaseTree setLeafMenu $styleOptionsMenu
disableTableMenus $databaseTree
$databaseStructureScroll add [$databaseTree getObject]
$addNewStyleItem setActionCallback mouseReleased {[addNewDHStyle $databaseTree]}
$getFieldCodesItem setActionCallback mouseReleased {[getFieldValues $DatabaseType $databaseTree]}
$getMinMaxRangeItem setActionCallback mouseReleased {[getFieldValues $DatabaseType $databaseTree]}
getDrillholePatternFilename $loadDHSSIItem
$loadDHSSIItem setActionCallback mouseReleased {[loadDHStyles $databaseTree]}
$removeItem setActionCallback mouseReleased {[removeDHStyle $databaseTree]}
$codeFld setActionCallback keyReleased {[updateCodeLabel $databaseTree $codeFld]}
$fromValueFld setActionCallback keyReleased {[updateFromToValueLabel $databaseTree $fromValueFld $toValueFld]}
$toValueFld setActionCallback keyReleased {[updateFromToValueLabel $databaseTree $fromValueFld $toValueFld]}
while {1} {
set returnCode [$editAttributesForm interact]
if {"$returnCode" == "apply"} {
saveSelectedStyleAttributes $databaseTree $graphicsColourBrowserField $graphicsPatternComboBox $plottingColourBrowserField $plottingPatternComboBox $lineStyle $markerStyle
if {[checkNumericRanges $databaseTree]} {
set stylesTreeStr "[$databaseTree getDataBufferString]"
global DatabaseType
GuidoApp app "EDIT DATABASE STYLES"
$app setParam databasetype $DatabaseType
$app setParam StylesTree "$stylesTreeStr"
set return_code [$app invoke]
$app destroy
break
}
} elseif {"$returnCode" == "cancel"} {
break
}
}
$editAttributesForm destroy
} else {
if {$DatabaseType == "surveys"} {
GuidoMessage message DB_SRV_NEED_STYLES_TABLE
} else {
GuidoMessage message DB_NEED_STYLES_TABLE
}
}
