Posted to tcl by patthoyts at Fri Sep 22 12:04:47 GMT 2006view raw

  1. proc balloon::show {mx my} {
  2. variable balloon_showed
  3. variable balloon_remove
  4. variable max_bx
  5. variable screenwidth
  6. variable screenheight
  7.  
  8. if {[.balloon.text cget -text] == ""} {
  9. balloon::destroy
  10. return
  11. }
  12.  
  13. set balloon_showed 1
  14. set balloon_remove 0
  15.  
  16. set b_w [winfo reqwidth .balloon]
  17. set b_h [winfo reqheight .balloon]
  18.  
  19.  
  20. if {$::tcl_platform(platform) eq "windows"} {
  21.  
  22. #tk::PlaceWindow .balloon pointer
  23. set b_x [expr {$mx + 1}]
  24. set b_y [expr {$my + 1}]
  25.  
  26. } else {
  27.  
  28. set b_x [expr {$mx + 12}]
  29. set b_y [expr {$my + 15}]
  30.  
  31. set max_bx [expr {$screenwidth - $b_w}]
  32. set max_by [expr {$screenheight - $b_h}]
  33.  
  34. set b_x [max [min $b_x $max_bx] 0]
  35. set b_y [max [min $b_y $max_by] 0]
  36.  
  37. if {($mx >= $b_x) && ($mx <= $b_x+$b_w)} {
  38. if {($my >= $b_y) && ($my <= $b_y+$b_h)} {
  39. set b_y1 [expr {$my - 5 - $b_h}]
  40. if {$b_y1 >= 0} {
  41. set b_y $b_y1
  42. }
  43. }
  44. }
  45. }
  46. wm geometry .balloon +$b_x+$b_y
  47. wm deiconify .balloon
  48. # need the raise in case we're ballooning over a detached menu
  49. raise .balloon
  50. }