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 }