00001 # TKE - Advanced Programmer's Editor
00002 # Copyright (C) 2014-2019 Trevor Williams (phase1geo@gmail.com)
00003 #
00004 # This program is free software; you can redistribute it and/or modify
00005 # it under the terms of the GNU General Public License as published by
00006 # the Free Software Foundation; either version 2 of the License, or
00007 # (at your option) any later version.
00008 #
00009 # This program is distributed in the hope that it will be useful,
00010 # but WITHOUT ANY WARRANTY; without even the implied warranty of
00011 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
00012 # GNU General Public License for more details.
00013 #
00014 # You should have received a copy of the GNU General Public License along
00015 # with this program; if not, write to the Free Software Foundation, Inc.,
00016 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
00017
00018 ######################################################################
00019 # Name: thumbnail.tcl
00020 # Author: Trevor Williams (phase1geo@gmail.com)
00021 # Date: 6/30/2017
00022 # Brief: Displays a thumbnail of a given image.
00023 ######################################################################
00024
00025 # Import the image_resize procedure from the image resizer
00026 source [file join $tke_dir lib ptwidgets1.2 common resize.tcl]
00027
00028 namespace eval thumbnail {
00029
00030 ######################################################################
00031 # Displays the thumbnail image. The value of x and y need to be the
00032 # root X/Y values.
00033 proc show {image_file x y} {
00034
00035 # Figure out if we can display the file based on extension
00036 if {[lsearch [list .gif .png] [file extension $image_file]] == -1} {
00037 return
00038 }
00039
00040 # Make it a windowless panel
00041 if {[tk windowingsystem] eq "aqua"} {
00042 toplevel .thumbwin; ::tk::unsupported::MacWindowStyle style .thumbwin help none
00043 set focus [focus]
00044 } else {
00045 toplevel .thumbwin
00046 wm overrideredirect .thumbwin 1
00047 }
00048
00049 wm attributes .thumbwin -topmost 1
00050 wm positionfrom .thumbwin program
00051 wm withdraw .thumbwin
00052
00053 # Create the thumbnail
00054 image create photo original -file $image_file
00055 image create photo thumbnail
00056
00057 # Perform the resize of the image
00058 ::image_scale original 64 64 thumbnail
00059
00060 # Delete the original image
00061 image delete original
00062
00063 # Add the image to the window
00064 pack [label .thumbwin.l -image thumbnail]
00065
00066 wm geometry .thumbwin +$x+[expr $y - 32]
00067 update idletasks
00068 wm deiconify .thumbwin
00069 raise .thumbwin
00070
00071 if {([tk windowingsystem] eq "aqua") && ($focus ne "")} {
00072 after idle [list focus -force $focus]
00073 }
00074
00075 }
00076
00077 ######################################################################
00078 # Hide the currently displayed thumbnail image.
00079 proc hide {} {
00080
00081 if {[winfo exists .thumbwin]} {
00082 destroy .thumbwin
00083 image delete thumbnail
00084 }
00085
00086 }
00087
00088 }
