1 package require ibrowser
2 package require imagepp
4 catch { namespace import ibrowser::* }
5 catch { namespace import imagepp::* }
6 catch { namespace import blt::* }
8 namespace eval image_browser {
21 variable first_image -1
22 variable last_image -1
23 variable image_width -1
24 variable image_height -1
29 variable return_nothing 0
33 proc image_browser::reset { parent } {
35 # For programming facilities
36 upvar image_browser::widgets widgets
38 set widgets(base) "$parent"
39 set widgets(image_brw) "$parent\.images"
40 set widgets(bottom_brw) "$parent\.images.02"
41 set widgets(vert_split) "$parent\.images.03"
42 set widgets(right_brw) "$parent\.images.02.02"
43 set widgets(horz_split) "$parent\.images.02.03"
44 set widgets(type) "$parent\.images.02.02.type"
45 set widgets(ibrw) "$parent\.images.01"
46 set widgets(impp) "$parent\.images.02.01"
47 set widgets(btnSerie) "$parent\.images.02.02.type.btnSerie"
48 set widgets(btnMIP) "$parent\.images.02.02.type.btnMIP"
49 set widgets(lbl001) "$parent\.images.02.02.lbl001"
50 set widgets(sclSerie) "$parent\.images.02.02.sclSerie"
54 proc image_browser::create { parent id } {
56 # For programming facilities
57 upvar image_browser::widgets widgets
58 upvar image_browser::image_width image_width
59 upvar image_browser::image_height image_height
60 upvar image_browser::mip_raised mip_raised
61 upvar image_browser::local_id local_id
62 upvar image_browser::shown shown
65 image_browser::reset $parent
69 frame $widgets(image_brw) -height 1 -width 1
70 frame $widgets(bottom_brw) -borderwidth 1 -relief groove
71 frame $widgets(right_brw) -borderwidth 1 -relief groove
72 frame $widgets(type) -borderwidth 2 -height 75 -relief groove -width 125
73 frame $widgets(horz_split) -borderwidth 2 -relief raised
74 frame $widgets(vert_split) -borderwidth 2 -relief raised
78 radiobutton $widgets(btnSerie) -text $string_table::str_serie -variable var_type -value 1 -command "image_browser::cb_load_serie"
79 radiobutton $widgets(btnMIP) -text $string_table::str_mip -variable var_type -value 2 -command "image_browser::cb_load_mip"
82 label $widgets(lbl001) -borderwidth 0 -text $string_table::str_showtype
85 scale $widgets(sclSerie) -label $string_table::str_series -orient horizontal
88 bind $widgets(horz_split) <B1-Motion> {
89 set root [ split %W . ]
90 set nb [ llength $root ]
92 set root [ lreplace $root $nb $nb ]
93 set root [ join $root . ]
94 set width [ winfo width $root ].0
95 set val [ expr (%X - [winfo rootx $root]) /$width ]
96 if { $val >= 0 && $val <= 1.0 } {
97 place $root.01 -relwidth $val
98 place $root.03 -relx $val
99 place $root.02 -relwidth [ expr 1.0 - $val ]
102 bind $widgets(vert_split) <B1-Motion> {
103 set root [ split %W . ]
104 set nb [ llength $root ]
106 set root [ lreplace $root $nb $nb ]
107 set root [ join $root . ]
108 set height [ winfo height $root ].0
109 set val [ expr (%Y - [winfo rooty $root]) /$height ]
110 if { $val >= 0 && $val <= 1.0 } {
111 place $root.01 -relheight $val
112 place $root.03 -rely $val
113 place $root.02 -relheight [ expr 1.0 - $val ]
119 proc image_browser::positionate { } {
121 # For programming facilities
122 upvar image_browser::widgets widgets
123 upvar image_browser::image_width image_width
124 upvar image_browser::image_height image_height
125 upvar image_browser::mip_raised mip_raised
126 upvar image_browser::local_id local_id
127 upvar image_browser::shown shown
128 upvar image_browser::return_nothing return_nothing
132 set global_window::window_shown $local_id
134 pack $widgets(image_brw) -anchor n -expand 1 -fill both -side top
135 place $widgets(ibrw) -x 0 -y 0 -relwidth 1 -height -1 -relheight 0.25 -anchor nw -bordermode ignore
136 place $widgets(bottom_brw) -x 0 -y 0 -rely 1 -relwidth 1 -height -1 -relheight 0.75 -anchor sw -bordermode ignore
137 place $widgets(impp) -x 0 -y 0 -width -1 -relwidth 0.75 -relheight 1 -anchor nw -bordermode ignore
138 place $widgets(right_brw) -x 0 -relx 1 -y 0 -width -1 -relwidth 0.25 -relheight 1 -anchor ne -bordermode ignore
139 place $widgets(type) -x 15 -y 60 -width 110 -height 65 -anchor nw -bordermode ignore
140 place $widgets(btnSerie) -x 20 -y 10 -anchor nw -bordermode ignore
141 place $widgets(btnMIP) -x 20 -y 35 -anchor nw -bordermode ignore
142 place $widgets(lbl001) -x 20 -y 50 -anchor nw -bordermode ignore
143 place $widgets(sclSerie) -x 15 -y 130 -width 200 -anchor nw -bordermode ignore
144 place $widgets(horz_split) -x 0 -relx 0.75 -y 0 -rely 0.9 -width 10 -height 10 -anchor s -bordermode ignore
145 place $widgets(vert_split) -x 0 -relx 0.9 -y 0 -rely 0.25 -width 10 -height 10 -anchor e -bordermode ignore
147 image_browser::controls 0
151 proc image_browser::forget { } {
153 # For programming facilities
154 upvar image_browser::widgets widgets
155 upvar image_browser::image_width image_width
156 upvar image_browser::image_height image_height
157 upvar image_browser::mip_raised mip_raised
158 upvar image_browser::shown shown
162 place forget $widgets(vert_split)
163 place forget $widgets(horz_split)
164 place forget $widgets(sclSerie)
165 place forget $widgets(lbl001)
166 place forget $widgets(btnMIP)
167 place forget $widgets(btnSerie)
168 place forget $widgets(type)
169 place forget $widgets(right_brw)
170 catch { place forget $widgets(impp) }
171 place forget $widgets(bottom_brw)
172 catch { place forget $widgets(ibrw) }
173 pack forget $widgets(image_brw)
177 proc image_browser::set_data { } {
179 # For programming facilities
180 upvar image_browser::widgets widgets
181 upvar image_browser::local_id local_id
183 set global_window::data_loaded [ expr $global_window::data_loaded | $local_id ]
187 set data [ $widgets(ibrw) curselection ]
188 $widgets(ibrw) delete -tags "delete"
193 destroy $widgets(ibrw)
194 ibrowser $widgets(ibrw) \
201 -primarycolor #ff0000 \
203 -secondarycolor #00ff00 \
207 bind $widgets(ibrw) <<AfterSelectFirstImage>> "image_browser::select_image 0"
208 bind $widgets(ibrw) <<AfterSelectLastImage>> "image_browser::select_image 1"
211 destroy $widgets(impp)
212 imagepp $widgets(impp) \
215 -initialroi "10 10 100 100" \
219 bind $widgets(impp) <<AfterProfil>> "image_browser::do_profil"
221 array set ser_data [ serieData_dll $data_browser::sel_study $data_browser::sel_serie ]
222 global_window::set_window_title "$ser_data(ID_Patient_Name) - $data_browser::sel_study/$data_browser::sel_serie"
224 set n [ GetNumberOfImages_dll ]
226 for { set i 0 } { $i < $n } { incr i } { lappend tkNames [ image create photo ] }
227 set numbers [ GetImagesNumbers_dll ]
228 LoadTkImages_dll $tkNames
229 set image_browser::first_image -1
230 set image_browser::last_image -1
235 foreach number $numbers {
237 if { $i == 0 } { set fN $number }
239 set imgTK [ lindex $tkNames $i ]
242 -tags "id_$i delete" \
244 $widgets(impp) add -image $imgTK -id "id_$i"
250 set image_width [ image width $imgTK ]
251 set image_height [ image height $imgTK ]
253 $widgets(impp) configure -initialroi "[ expr $image_width * 0.3 ] [ expr $image_height * 0.3 ] [ expr $image_width * 0.7 ] [ expr $image_height * 0.7 ]"
254 $widgets(impp) resetroi
256 array set arr [ params_dll ]
258 $widgets(ibrw) select -tags "id_0"
259 set image_browser::first_image $fN
260 if { $arr(e_choose_all_slices_default) == 1 } {
262 $widgets(ibrw) select -tags "id_[ expr $i - 1 ]" -secondary
263 set image_browser::last_image $lN
267 $widgets(btnSerie) deselect
268 $widgets(btnMIP) deselect
270 if { $arr(e_calculate_mip_default) == 0 } { $widgets(btnSerie) invoke }
271 if { $arr(e_calculate_mip_default) == 1 } { $widgets(btnMIP) invoke }
273 $widgets(sclSerie) configure \
274 -label "$string_table::str_series : $ser_data(ID_Series_Number)" \
277 -command "image_browser::select_first_image" \
279 $widgets(sclSerie) set $fN
281 # bind $widgets(sclSerie) <ButtonRelease-1> "image_browser::select_first_image"
283 image_browser::controls 0
285 global_window::deselect_buttons
286 global_window::invoke_buttons [ expr \
287 $global_window::en_clear | \
288 $global_window::en_intensity \
293 proc image_browser::select_first_image { n } {
295 # For programming facilities
296 upvar image_browser::widgets widgets
298 # set n [ $widgets(sclSerie) get ]
299 set f [ $widgets(sclSerie) cget -from ]
300 set i [ expr $n - $f ]
301 set i [ lindex [ split $i . ] 0 ]
302 $widgets(impp) show -id "id_$i"
303 # $widgets(ibrw) select -tags "id_$i"
307 proc image_browser::cb_load_mip { } {
309 # For programming facilities
310 upvar image_browser::widgets widgets
311 upvar image_browser::mip_raised mip_raised
312 upvar image_browser::actual_image actual_image
315 set datas [ $widgets(ibrw) curselection ]
317 foreach data $datas { lappend images [ lindex [ lindex $data 2 ] 2 ] }
318 set mip [ loadMIPZ_dll $images ]
319 set actual_image $mip
320 set imgTK [ image create photo ]
321 loadTKimage_dll $mip $imgTK
322 $widgets(impp) add -image $imgTK -id mip
326 proc image_browser::cb_load_serie { } {
328 # For programming facilities
329 upvar image_browser::widgets widgets
330 upvar image_browser::mip_raised mip_raised
331 upvar image_browser::actual_image actual_image
333 # $sclSerie configure -state normal
335 set image [ $widgets(ibrw) lastimage ]
336 set actual_image [ lindex [ lindex $image 2 ] 2 ]
337 set id [ lindex $image 0 ]
338 $widgets(impp) show -id $id
342 proc image_browser::select_image { i } {
344 # For programming facilities
345 upvar image_browser::widgets widgets
346 upvar image_browser::mip_raised mip_raised
348 if { $mip_raised == 0 } { cb_load_serie }
349 if { $mip_raised == 1 } { cb_load_mip }
350 set image [ $widgets(ibrw) lastimage ]
351 set pos [ expr [ lindex [ split [ lindex [ lindex $image 2 ] 0 ] _ ] 1 ] + [ $widgets(sclSerie) cget -from ] ]
352 $widgets(sclSerie) set $pos
354 if { $i == 0 } { set image_browser::first_image $pos }
355 if { $i == 1 } { set image_browser::last_image $pos }
356 puts "$image_browser::first_image : $image_browser::last_image"
360 proc image_browser::set_data2 { } {
362 # For programming facilities
363 upvar image_browser::return_nothing return_nothing
369 proc image_browser::get_data { } {
371 # For programming facilities
372 upvar image_browser::widgets widgets
373 upvar image_browser::mip_raised mip_raised
374 upvar image_browser::return_nothing return_nothing
376 if { $return_nothing == 0 } {
378 set fr [ string trimleft [ $widgets(sclSerie) cget -from ] 0 ]
379 set f [ string trimleft $image_browser::first_image 0 ]
380 set l [ string trimleft $image_browser::last_image 0 ]
382 set f [ expr $f - $fr ]
383 set l [ expr $l - $fr ]
385 set f [ expr ( $f < $l )? $f: $l ]
386 set l [ expr ( $f > $l )? $f: $l ]
388 set data [ $widgets(ibrw) curselection ]
389 set roi [ $widgets(impp) roi ]
391 [ lindex [ split [ lindex $roi 0 ] . ] 0 ] \
392 [ lindex [ split [ lindex $roi 2 ] . ] 0 ] \
393 [ lindex [ split [ lindex $roi 1 ] . ] 0 ] \
394 [ lindex [ split [ lindex $roi 3 ] . ] 0 ] \
395 [ lindex [ split $f . ] 0 ] \
396 [ lindex [ split $l . ] 0 ] \
405 proc image_browser::set_mouse_left_events { mask } {
407 # For programming facilities
408 upvar image_browser::widgets widgets
410 if { [ expr ( $mask & 0x1 ) ] == 0x1 } { $widgets(impp) setnone }
414 proc image_browser::set_mouse_right_events { mask } {
416 # For programming facilities
417 upvar image_browser::widgets widgets
419 if { [ expr ( $mask & 0x1 ) ] == 0x1 } { catch { $widgets(impp) setarea } }
420 if { [ expr ( $mask & 0x2 ) ] == 0x2 } { catch { $widgets(impp) setlinear } }
424 proc image_browser::clear { } {
426 # For programming facilities
427 upvar image_browser::widgets widgets
429 catch { $widgets(impp) clean }
433 proc image_browser::do_profil { } {
435 # For programming facilities
436 upvar image_browser::widgets widgets
437 upvar image_browser::actual_image actual_image
439 set data [ $widgets(impp) getprofildata ]
441 if { [ lindex $data 0 ] == 1 } {
446 set n [ $widgets(sclSerie) get ]
447 set f [ $widgets(sclSerie) cget -from ]
448 set i [ expr $n - $f ]
449 set i [ lindex [ split $i . ] 0 ]
450 set avals [ GetProfilFromTotalVolume_dll [ lindex $data 1 ] [ lindex $data 2 ] $i [ lindex $data 3 ] [ lindex $data 4 ] $i ]
458 set size [ lindex $avals 4 ]
459 for { set i 0 } { $i < $size } { incr i } {
462 lappend yvals [ lindex $avals [ expr $i + 5 ] ]
466 catch { destroy "$widgets(impp)\.fnProfil" }
467 toplevel "$widgets(impp)\.fnProfil" -width 640 -height 480
469 graph $widgets(impp)\.fnProfil.gr \
480 pack $widgets(impp)\.fnProfil.gr -anchor center -expand 1 -fill both -side top
481 $widgets(impp)\.fnProfil.gr axis configure y -min 0.00
482 $widgets(impp)\.fnProfil.gr grid configure -hide no
483 $widgets(impp)\.fnProfil.gr legend configure -position bottom -font {Helvetica -14 bold}
485 $widgets(impp)\.fnProfil.gr element create "Profile" \
491 set x [ expr $size / 2 ]
492 set y [ expr [ lindex $avals 1 ] * 0.75 ]
493 set text "$string_table::str_min = [ lindex $avals 0 ]\n$string_table::str_max = [ lindex $avals 1 ]\n$string_table::str_avg = [ lindex $avals 2 ]\n$string_table::str_std = [ lindex $avals 3 ]\n$string_table::str_nro_pix = [ lindex $avals 4 ]"
494 $widgets(impp)\.fnProfil.gr marker create text -text $text \
495 -coords "$x $y" -font { Helvetica 20 }
500 } elseif { [ lindex $data 0 ] == 2 } {
504 set n [ $widgets(sclSerie) get ]
505 set f [ $widgets(sclSerie) cget -from ]
506 set i [ expr $n - $f ]
507 set i [ lindex [ split $i . ] 0 ]
508 set avals [ GetAreaValuesFromTotalVolume_dll [ lindex $data 1 ] [ lindex $data 2 ] $i [ lindex $data 3 ] [ lindex $data 4 ] $i ]
509 $widgets(impp) addtext "$string_table::str_min = [ lindex $avals 0 ]\n$string_table::str_max = [ lindex $avals 1 ]\n$string_table::str_avg = [ lindex $avals 2 ]\n$string_table::str_std = [ lindex $avals 3 ]\n$string_table::str_nro_pix = [ lindex $avals 4 ]" [ lindex $data 3 ] [ lindex $data 4 ]
513 } elseif { [ lindex $data 0 ] == 3 } {
515 set n [ $widgets(sclSerie) get ]
516 set f [ $widgets(sclSerie) cget -from ]
517 set i [ expr $n - $f ]
518 set i [ lindex [ split $i . ] 0 ]
519 set val [ GetImageIntensity_dll [ lindex $data 3 ] [ lindex $data 4 ] $i ]
520 $widgets(impp) addtext "$string_table::str_int = $val" [ lindex $data 3 ] [ lindex $data 4 ]
522 } elseif { [ lindex $data 0 ] == 4 } {
530 proc image_browser::back { } {
532 # For programming facilities
533 upvar image_browser::shown shown
542 proc image_browser::controls { { id -1 } } {
546 global_window::active_controls 0
552 global_window::active_controls [ \
554 $global_window::en_3D | \
555 $global_window::en_params | \
556 $global_window::en_save | \
557 $global_window::en_load | \
558 $global_window::en_open | \
559 $global_window::en_help | \
560 $global_window::en_clear | \
561 $global_window::en_intensity | \
562 $global_window::en_linear | \
563 $global_window::en_area | \
564 $global_window::en_back | \
568 } elseif { $id == 1 } {
570 global_window::active_controls [ \
572 $global_window::en_params | \
573 $global_window::en_save | \
574 $global_window::en_load | \
575 $global_window::en_open | \
576 $global_window::en_help | \
577 $global_window::en_clear | \
578 $global_window::en_intensity | \
579 $global_window::en_linear | \
580 $global_window::en_area | \
581 $global_window::en_back | \
591 # EOF - image_browser.tcl