Posted to tcl by Meliorator at Wed Mar 28 17:12:26 GMT 2012view raw

  1. package require Tcl 8.5
  2. package require Tk 8.5
  3. package require tablelist
  4.  
  5. proc ContextMenu {w_table w_menu menu_x menu_y} {
  6.  
  7. $w_table finishediting
  8.  
  9. set w_window [lindex [wm stackorder .] end]
  10.  
  11. set mouse_x [expr {[winfo pointerx .] - [winfo rootx $w_window]}]
  12. set mouse_y [expr {[winfo pointery .] - [winfo rooty $w_window]}]
  13.  
  14. set cell_x [$w_table nearestcolumn $mouse_x]
  15. set cell_y [$w_table nearest $mouse_y]
  16.  
  17. $w_table selection clear 0 end
  18. $w_table selection set $cell_y $cell_y
  19.  
  20. $w_menu delete 1
  21. $w_menu delete 0
  22.  
  23. set browse_command [list [namespace current]::BrowseLogoPath $w_table $cell_y]
  24. set edit_command [list [namespace current]::EditLogoPath $w_table $cell_y]
  25.  
  26. $w_menu add command -label Browse -command $browse_command
  27. $w_menu add command -label Edit -command $edit_command
  28.  
  29. if {$cell_x == 1} {
  30.  
  31. tk_popup $w_menu $menu_x $menu_y
  32. }
  33. }
  34.  
  35. proc UpdateLogoPath {w_table cell_y logo_path} {
  36.  
  37. variable logo_database
  38.  
  39. $logo_database(command) eval "UPDATE $logo_database(table) SET $logo_database(logo_path) = '$logo_path' WHERE $logo_database(station_number) = '[lindex $logo_database(station_numbers) $cell_y]'"
  40.  
  41. if {[file exists $logo_path]} {
  42.  
  43. $w_table cellconfigure $cell_y,1 -image [GetLogo $logo_path]
  44. }
  45. }
  46.  
  47. proc BrowseLogoPath {w_table cell_y} {
  48.  
  49. set file_types {
  50. { {PNG Files} {.png} }
  51. { {All Files} {*} }
  52. }
  53.  
  54. set logo_path [tk_getOpenFile -filetypes $file_types]
  55.  
  56. if {[string length $logo_path]} {
  57.  
  58. $w_table cellconfigure $cell_y,1 -text $logo_path
  59.  
  60. UpdateLogoPath $w_table $cell_y $logo_path
  61. }
  62. }
  63.  
  64. proc EditedLogoPath {w_table cell_y cell_x logo_path} {
  65.  
  66. $w_table cellconfigure $cell_y,1 -editable false
  67.  
  68. UpdateLogoPath $w_table $cell_y $logo_path
  69.  
  70. return $logo_path
  71. }
  72.  
  73. proc EditLogoPath {w_table cell_y} {
  74.  
  75. $w_table cellconfigure $cell_y,1 -editable true
  76. $w_table editcell $cell_y,1
  77. $w_table selection set $cell_y $cell_y
  78. }
  79.  
  80. proc UserInterface {w_root} {
  81.  
  82. set w_base [expr {($w_root == ".") ? "" : $w_root}]
  83.  
  84. variable ROOT $w_root
  85. variable BASE $w_base
  86. variable SCRIPTDIR
  87.  
  88. variable logo_database
  89. variable load_logos_progress 0
  90.  
  91. set w_frame ${w_base}.frm
  92. set w_table ${w_frame}.tbl
  93. set w_vertical_scroll_bar ${w_frame}.vsb
  94. set w_horizontal_scroll_bar ${w_frame}.hsb
  95. set w_menu ${w_base}.mnu
  96. set w_progress_bar_label ${w_base}.pbl
  97. set w_progress_bar ${w_base}.pb
  98.  
  99. frame $w_frame
  100.  
  101. tablelist::tablelist $w_table \
  102. -columns {0 "Station Name" left
  103. 0 "Logo" left} \
  104. -yscrollcommand [list $w_vertical_scroll_bar set] \
  105. -width 1 \
  106. -stretch 2 \
  107. -stripebackground grey97 \
  108. -selectmode single \
  109. -editendcommand [namespace current]::EditedLogoPath
  110.  
  111. scrollbar $w_vertical_scroll_bar -orient vertical -command [list $w_table yview]
  112. scrollbar $w_horizontal_scroll_bar -orient horizontal -command [list $w_table xview]
  113.  
  114. set stations [$logo_database(command) eval "SELECT $logo_database(station_name), $logo_database(logo_path), $logo_database(station_number) FROM $logo_database(table)"]
  115.  
  116. set w_progress_bar_label [label $w_progress_bar_label -text "Loading logos..." -background white]
  117. set w_progress_bar [ttk::progressbar $w_progress_bar -orient horizontal -variable [namespace current]::load_logos_progress -maximum [expr { [llength $stations] / 3 }]]
  118.  
  119. pack $w_progress_bar_label -fill x
  120. pack $w_progress_bar -fill x
  121.  
  122. foreach {station_name logo_path station_number} $stations {
  123.  
  124. lappend logo_database(station_numbers) $station_number
  125.  
  126.  
  127. $w_table insert end [list $station_name $logo_path]
  128. $w_table rowconfigure end -selectbackground grey
  129. $w_table cellconfigure end,1 -image [GetLogo $logo_path]
  130.  
  131. incr load_logos_progress
  132. update
  133. }
  134.  
  135. unset stations
  136.  
  137. pack forget $w_progress_bar_label
  138. pack forget $w_progress_bar
  139.  
  140. menu $w_menu -tearoff 0
  141.  
  142. bind $w_root "<Button-3>" [list [namespace current]::ContextMenu $w_table $w_menu %X %Y]
  143. bind $w_root "<Button-1>" [list $w_table finishediting]
  144.  
  145. pack $w_frame -fill both -expand yes
  146. pack $w_horizontal_scroll_bar -side bottom -fill x -expand no
  147. pack $w_table -side left -fill both -expand yes
  148. pack $w_vertical_scroll_bar -side right -fill y -expand no
  149. }
  150.