Commit 9713e41d authored by luc.moulinier's avatar luc.moulinier
Browse files

update overview

parent 16c4fbf7
......@@ -6124,8 +6124,8 @@ proc CalculeOverview {Id} {
set fy [expr {1.* $Ovw(HeightOri)/$Thgt}]
if {$fx <= 1.} {set fx 1.0}
if {$fy <= 1.} {set fy 1.0}
set Ovw(O$Id,ScaOriX) $fx
set Ovw(O$Id,ScaOriY) $fy
set Ovw(O$Id,ScaOriX) [expr {int($fx * 100.)}]
set Ovw(O$Id,ScaOriY) [expr {int($fy * 100.)}]
$wc configure -height $Ovw(HeightOri) -width $Ovw(WidthOri)
......@@ -6147,32 +6147,16 @@ proc CalculeOverview {Id} {
lappend Data $l
}
}
puts "Tw $Twdt Th $Thgt"
puts "[llength $Data] [llength [split [lindex $Data 0]]]"
set imgOri [image create photo -height $Thgt -width $Twdt]
$imgOri put $Data
set img [image create photo -height $Thgt -width $Twdt]
$img put $Data
# subsample image
set img [image create photo]
#puts "fx $fx fy $fy"
#puts [Double2Fraction $fy]
#image% $imgOri [expr {int($fy*100)}]
#$img copy $imgOri -shrink -subsample [expr {int($fx * 100)}] [expr {int($fy * 100.)}]
set newWdt [expr {int($fx * $Ovw(WidthOri))}]
set newHgt [expr {int($fy * $Ovw(HeightOri))}]
package require ImageScale
imagescale::image_scale $imgOri $newWdt $newHgt $img
#LRI::imgtransform $img -scalex [set Ovw(O$Id,ScaOriX)] -scaley [set Ovw(O$Id,ScaOriY)]
# subsample image if necessary
LRI::imgtransform $img -scalex [expr {int($fx * 100)}] -scaley [expr {int($fy * 100.)}]
if {! [info exists Ovw(O$Id,ScaleTot)]} {
set Ovw(O$Id,ScaleTot) {}
} else {
set St [expr int(100*[join [set Ovw(O$Id,ScaleTot)] *])]
LRI::imgtransform $img -scale $St
set wdt [expr {int([$img width] * $St)}]
set hgt [expr {int([$img height] * $St)}]
set imgNew [image create photo -width $wdt -height $hgt]
imagescale::image_scale $img $wdt $hgt $imgNew
set img $imgNew
}
set TOri [$wc create image 0 0 \
......@@ -6196,7 +6180,7 @@ proc DessineFeatureSurOverview {Id w ft {Show 1} {DeBtn 0}} {
if {$DeBtn && ( [set Ovw(O$Id,Feat)] ne "automatic" ) } {
return
}
set wc [set Ovw(O$Id,w)]
set Ovft [set Ovw(O$Id,Feat)]
......@@ -6210,6 +6194,9 @@ proc DessineFeatureSurOverview {Id w ft {Show 1} {DeBtn 0}} {
return
}
}
if {! $DeBtn && $ft eq "automatic"} {
return
}
# Feature deja calculee, monte ou descend
if {[info exists Ovw(O$Id,$ft)]} {
......@@ -6225,18 +6212,17 @@ proc DessineFeatureSurOverview {Id w ft {Show 1} {DeBtn 0}} {
$wc raise [set Ovw(O$Id,TagCentre)]
$wc raise [set Ovw(O$Id,TagRegion)]
update idletasks
return
}
# Calcul image de la feature
set Wdt [set Ovw(O$Id,Width)]
set Hgt [set Ovw(O$Id,Height)]
# puts "WdO $Wdt HgO $Hgt | W [$wc cget -width] H [$wc cget -height]"
set img [image create photo]
$img blank
set LNoms $LNOrdali
set y -1
foreach n $LNoms {
incr y
......@@ -6262,7 +6248,9 @@ proc DessineFeatureSurOverview {Id w ft {Show 1} {DeBtn 0}} {
-tags [list FX_${ft} ImgFeature]]
lappend Ovw(O$Id,Images) $img
set Ovw(O$Id,$ft) $tag
if {$ft ne "automatic"} {set Ovw(O$Id,FeatAff) {} }
if {$ft ne "automatic"} {
set Ovw(O$Id,FeatAff) {}
}
lappend Ovw(O$Id,FeatAff) $ft
$wc raise [set Ovw(O$Id,TagCentre)]
......@@ -6285,9 +6273,8 @@ proc ChangeEchelleOverview {Id quoi} {
set Ch [expr {int([$wc cget -height]*$Scale)}]
set Cw [expr {int([$wc cget -width] *$Scale)}]
# taille minimale de la fenetre
if {$Cw < 300} {return}
if {$Cw <= 300} {return}
lappend Ovw(O$Id,ScaleTot) $Scale
set Ovw(O$Id,Scale) $Scale
......@@ -6375,6 +6362,7 @@ proc MetAJourOverview {n1 n2 n3 op} {
}
set Ovw(Groupes) $LNDG
FaireLaSuite
return
......@@ -6462,16 +6450,20 @@ proc AfficheFenetreOverview {Id} {
wm protocol $w WM_DELETE_WINDOW KillParLaCroix
wm resizable $w 0 0
grid columnconfig $w 0 -weight 1
grid rowconfig $w 0 -weight 1
set Ovw(O$Id,w) "$w.c"
set wc "$w.c"
canvas $w.c \
-height 300 \
-width 500 \
-background white
pack $w.c -side top -expand 1
set wc "$w.c"
frame $w.btn
pack $w.btn -expand 1 -fill x -side bottom -padx 5 -pady 10
grid $w.c -row 0 -column 0 -sticky news
grid $w.btn -row 1 -column 0 -sticky ew -pady 10
grid columnconfig $w.btn all -weight 0
ttk::combobox $w.btn.combo \
-background white \
-state readonly \
......@@ -6481,7 +6473,6 @@ proc AfficheFenetreOverview {Id} {
-width $Ovw(FeatWidth)
$w.btn.combo index 0
bind $w.btn.combo <<ComboboxSelected>> "MetAJourDessinOverview $Id %W"
pack $w.btn.combo -side left -expand 1
frame $w.btn.fpm
button $w.btn.fpm.btm \
-text "-" \
......@@ -6491,18 +6482,22 @@ proc AfficheFenetreOverview {Id} {
-text "+" \
-background cyan \
-command [list ChangeEchelleOverview $Id "plus"]
pack $w.btn.fpm.btm $w.btn.fpm.btp -side left
pack $w.btn.fpm -side left
grid $w.btn.fpm.btm -row 0 -column 0
grid $w.btn.fpm.btp -row 0 -column 1
button $w.btn.btprt \
-text "Print" \
-background yellow \
-command [list PrintCanvas $wc png]
pack $w.btn.btprt -side left -expand 1
button $w.btn.btclose \
-text "Close" \
-background green1 \
-command [list DetruitOverview $Id]
pack $w.btn.btclose -side left -expand 1
grid $w.btn.combo -row 0 -column 0
grid $w.btn.fpm -row 0 -column 1
grid $w.btn.btprt -row 0 -column 2
grid $w.btn.btclose -row 0 -column 3
grid columnconfig $w.btn all -weight 1
return $w
}
......@@ -8893,7 +8888,7 @@ proc ToggleFullScreen {} {
#set Defauts(FullScreen) [expr {! [set Defauts(FullScreen)]}]
set Etat [expr {! $Etat}]
if {$Etat} {
puts "Full Screen"
puts "switch to Full Screen"
set GeomNormal [wm geometry $top]
puts " GeomNormal $GeomNormal"
set xw [winfo screenwidth $top]
......@@ -8907,7 +8902,7 @@ proc ToggleFullScreen {} {
wm attributes $top -fullscreen 1
puts " New [wm geometry $top]"
} else {
puts "Normal"
puts "back to Normal"
set geom [string map [list + " " - " " x " "] $GeomNormal]
lassign [split $geom " "] w h x y
#wm overrideredirect $top 0
......
......@@ -112,7 +112,7 @@ proc ValsDesDefauts {} {
set Defauts(LogAtStartup) 0
set Defauts(OnlyTLog) 0
set Defauts(ShowFrame) 0
set Defauts(FullScreen) 1
set Defauts(FullScreen) 0
set Defauts(TypeAli) "pasdali"
set Defauts(LongNom) 30
set Defauts(NomsAffiches) "seqname"
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment