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

  1. package require Tcl 8.5
  2. package require Tk 8.5
  3. package require sqlite3
  4.  
  5. namespace eval StationLogos {
  6.  
  7. variable logo_database
  8. variable load_logos_progress
  9.  
  10. variable SCRIPTDIR [file dirname [info script]]
  11.  
  12. source [file join $SCRIPTDIR Tools FastResize.tcl]
  13. source [file join $SCRIPTDIR StationLogos_ui.tcl]
  14.  
  15. array set logo_database {
  16.  
  17. path {C:\Users\piLL\AppData\Roaming\XBMC\userdata\Database\TV19.db}
  18. table {`channels`}
  19. station_name {`sChannelName`}
  20. logo_path {`sIconPath`}
  21. station_number {`idChannel`}
  22. station_numbers {}
  23. }
  24.  
  25. set logo_database(command) [namespace current]::StationLogosDb
  26. }
  27.  
  28. proc StationLogos::GetLogo {logo_path} {
  29.  
  30. set logo_thumb [image create photo -width 64 -height 64]
  31.  
  32. if {[file exists $logo_path]} {
  33.  
  34. set logo_image [image create photo -file $logo_path]
  35.  
  36. resize $logo_image 64 64 $logo_thumb
  37.  
  38. image delete $logo_image
  39. }
  40.  
  41. return $logo_thumb
  42. }
  43.  
  44. proc StationLogos::Init {root args} {
  45.  
  46. variable logo_database
  47.  
  48. if {$::argv0 == [info script]} {
  49.  
  50. wm title $root StationLogos
  51. wm geometry $root 740x540+30+30
  52.  
  53. sqlite3 $logo_database(command) $logo_database(path)
  54.  
  55. wm protocol $root WM_DELETE_WINDOW [namespace current]::DeInit
  56.  
  57. if {[catch { UserInterface $root } err]} {
  58.  
  59. StationLogosDb close
  60. # bgerror $err
  61. exit 1
  62. }
  63. }
  64. }
  65.  
  66. proc StationLogos::DeInit {} {
  67.  
  68. variable logo_database
  69.  
  70. $logo_database(command) close
  71.  
  72. namespace delete [namespace current]
  73.  
  74. exit 0
  75. }
  76.  
  77. StationLogos::Init .