1 2package require QuickTimeTcl 3.1 3 4set myFile [tk_getOpenFile] 5if {$myFile == ""} { 6 return 7} 8 9# Get screen size. 10set swidth [winfo screenwidth .] 11set sheight [winfo screenheight .] 12 13set w .t 14toplevel $w -background black 15wm overrideredirect $w 1 16wm geometry $w ${swidth}x${sheight}+0+0 17bind $w <Command-q> exit 18bind $w <Command-.> exit 19bind $w <Escape> exit 20 21set m $w.m 22movie $m -file $myFile -controller 0 23foreach {mwidth mheight} [$m size] break 24array set timeArr [$m gettime] 25 26# Buttons. 27set dir [file dirname [info script]] 28set imquit [image create photo -file [file join $dir quit.gif]] 29set imstop [image create photo -file [file join $dir stop.gif]] 30set implay [image create photo -file [file join $dir start.gif]] 31set f [frame $w.f -bg black] 32label $f.ss -bg black -bd 0 -image $implay 33label $f.quit -bg black -bd 0 -image $imquit 34pack $f.ss $f.quit -side left -padx 12 -pady 6 35pack $f -side bottom 36bind $f.ss <Button-1> {Command play} 37bind $f.quit <Button-1> exit 38 39# Keep proportions. 40set rw [expr double($swidth)/$mwidth] 41set rh [expr double($sheight)/$mheight] 42if {$rw < $rh} { 43 set newwidth $swidth 44 set newheight [expr int($rw * $mheight)] 45 set side left 46} else { 47 set newheight $sheight 48 set newwidth [expr int($rh * $mwidth)] 49 set side top 50} 51proc End {token w mtime} { 52 exit 53} 54proc Command {what} { 55 global w implay imstop 56 57 $w.m $what 58 switch -- $what { 59 play { 60 bind $w.f.ss <Button-1> {Command stop} 61 $w.f.ss configure -image $imstop 62 } 63 stop { 64 bind $w.f.ss <Button-1> {Command play} 65 $w.f.ss configure -image $implay 66 } 67 } 68} 69if {[tk windowingsystem] eq "aqua"} { 70 quicktimetcl::systemui allhidden 71} 72$m configure -width $newwidth -height $newheight 73pack $m -side $side 74raise $w 75update 76Command play 77$m callback $timeArr(-movieduration) End 78 79 80