3
set dir [file dirname [info script]]
5
lappend auto_path "../"
6
lappend auto_path "utils/TkCximage/"
7
catch {package require TkCximage}
9
set ::tcl_interactive 1
11
proc CheckLoaded { } {
13
foreach lib [info loaded] {
14
if { [lindex $lib 1] == "Tkcximage" } {
20
proc chooseFileDialog { {title ""} {operation "open"} } {
23
set starting_dir $::start
25
set types {{ "Image file" {*.jpg *.gif *.png *.tga} } {"All Files" {*}}}
27
if { $operation == "open" } {
28
set selfile [tk_getOpenFile -filetypes $types -parent $parent -initialdir $starting_dir -initialfile $initialfile -title $title]
30
set selfile [tk_getSaveFile -filetypes $types -parent $parent -initialdir $starting_dir -initialfile $initialfile -title $title]
33
if { $selfile != "" } {
34
set ::start [file dirname $selfile]
40
proc msg_box { msg } {
42
label .error.l -text "$msg"
43
button .error.ok -text "Ok" -command "grab release .error; destroy .error"
44
pack .error.l .error.ok -side top
49
set file [chooseFileDialog "Open Image" "open"]
50
if { $file == "" } { return }
52
if { [catch {image create photo -file $file} img] != 0} {
53
msg_box "Error opening the file you selected : \n$img"
63
if { $::loaded == 0 } {
64
msg_box "You must first load an image before using this function"
69
radiobutton .format.gif -text "GIF File" -variable ::format -value "cxgif"
70
radiobutton .format.png -text "PNG File" -variable ::format -value "cxpng"
71
radiobutton .format.jpg -text "JPG File" -variable ::format -value "cxjpg"
72
radiobutton .format.tga -text "TGA File" -variable ::format -value "cxtga"
73
radiobutton .format.default -text "Choose from file extension" -variable ::format -value "cximage"
74
label .format.separator -text " "
75
button .format.ok -text "Save" -command "grab release .format; destroy .format; Save2"
76
pack .format.gif .format.png .format.jpg .format.tga .format.default .format.separator .format.ok -side top
82
set file [chooseFileDialog "Save Image" "save"]
83
if { $file == "" } { return }
85
if { [catch {$::loaded write $file -format $::format} file] != 0} {
86
msg_box "Error Saving to the file you requested : \n$file"
94
msg_box "Please load the image to convert"
98
set file1 [chooseFileDialog "Open Image" "open"]
99
if { $file1 == "" } { return }
101
msg_box "Please Choose the destination file (filetype is determined by file extension)"
105
set file2 [chooseFileDialog "Save Image" "save"]
106
if { $file2 == "" } { return }
108
if { [catch {::CxImage::Convert $file1 $file2} res] != 0} {
109
msg_box "Error opening the file you selected : \n$res"
116
if { $::loaded == 0 } {
117
msg_box "You must first load an image before using this function"
123
label .resize.f1.lw -text "Width : "
126
label .resize.f2.lh -text "Height : "
129
button .resize.f3.ok -text "Resize" -command "Resize2"
130
button .resize.f3.cancel -text "Cancel" -command "grab release .resize; destroy .resize"
132
pack .resize.f1.lw .resize.f1.w -side left
133
pack .resize.f2.lh .resize.f2.h -side left
134
pack .resize.f3.ok .resize.f3.cancel -side left
135
pack .resize.f1 .resize.f2 .resize.f3 -side top
140
set w [.resize.f1.w get]
141
set h [.resize.f2.h get]
145
::CxImage::Resize $::loaded $w $h
151
if { $::loaded == 0 } {
152
msg_box "You must first load an image before using this function"
157
label .thumb.f1.lw -text "Width : "
160
label .thumb.f2.lh -text "Height : "
164
label .thumb.f3.lc -text "Border Color : "
166
checkbutton .thumb.alpha -text "Enable Alpha on border" -variable ::alpha -onvalue 1 -offvalue 0
168
label .thumb.f4.la -text "Alpha opacity for border (between 0 and 255)"
172
button .thumb.f5.ok -text "Resize" -command "Thumbnail2"
173
button .thumb.f5.cancel -text "Cancel" -command "grab release .thumb; destroy .thumb"
175
pack .thumb.f1.lw .thumb.f1.w -side left
176
pack .thumb.f2.lh .thumb.f2.h -side left
177
pack .thumb.f3.lc .thumb.f3.c -side left
178
pack .thumb.f4.la .thumb.f4.a -side left
179
pack .thumb.f5.ok .thumb.f5.cancel -side left
181
pack .thumb.f1 .thumb.f2 .thumb.f3 .thumb.alpha .thumb.f4 .thumb.f5 -side top
186
proc Thumbnail2 { } {
187
set w [.thumb.f1.w get]
188
set h [.thumb.f2.h get]
189
set border [.thumb.f3.c get]
190
set alpha [.thumb.f4.a get]
194
if { $::alpha == 0 } {
195
if { [catch {::CxImage::Thumbnail $::loaded $w $h $border} res] != 0 } {
196
msg_box "Unable to create thumbnail\n$res"
199
if { [catch {::CxImage::Thumbnail $::loaded $w $h $border -alpha $alpha} res ] != 0 } {
200
msg_box "Unable to create thumbnail\n$res"
206
if { $::loaded == 0 } {
207
msg_box "You must first load an image before using this function"
212
label .cr.f1.lx -text "Starting X : "
215
label .cr.f2.ly -text "Starting Y : "
218
label .cr.f3.lx -text "Ending X : "
221
label .cr.f4.ly -text "Ending Y : "
225
button .cr.f5.ok -text "Crop" -command "Crop2"
226
button .cr.f5.cancel -text "Cancel" -command "grab release .cr; destroy .cr"
228
pack .cr.f1.lx .cr.f1.x1 -side left
229
pack .cr.f2.ly .cr.f2.y1 -side left
230
pack .cr.f3.lx .cr.f3.x2 -side left
231
pack .cr.f4.ly .cr.f4.y2 -side left
232
pack .cr.f5.ok .cr.f5.cancel -side left
234
pack .cr.f1 .cr.f2 .cr.f3 .cr.f4 .cr.f5 -side top
239
set x1 [.cr.f1.x1 get]
240
set y1 [.cr.f2.y1 get]
241
set x2 [.cr.f3.x2 get]
242
set y2 [.cr.f4.y2 get]
247
set temp [image create photo]
249
if { [catch {$temp copy $::loaded -from $x1 $y1 $x2 $y2} res ] != 0 } {
250
msg_box "Unable to crop image\n$res"
259
if { $::loaded == 0 } {
260
msg_box "You must first load an image before using this function"
266
label .color.f1.lc -text "Color : "
270
button .color.f2.ok -text "Colorize" -command "Colorize2"
271
button .color.f2.cancel -text "Cancel" -command "grab release .color; destroy .color"
273
pack .color.f1.lc .color.f1.c -side left
274
pack .color.f2.ok .color.f2.cancel -side left
276
pack .color.f1 .color.f2 -side top
282
set color [.color.f1.c get]
286
if { [catch {::CxImage::Colorize $::loaded $color} res ] != 0 } {
287
msg_box "Unable to create thumbnail\n$res"
291
proc ShowImage { img } {
293
if { $::loaded != 0 } {
294
image delete $::loaded
302
label .image.img -image $::loaded
309
catch {destroy .alpha}
311
msg_box "Please load an image that has Alpha blending enabled"
315
set file [chooseFileDialog "Open Image" "open"]
316
if { $file == "" } { return }
318
if { [catch {image create photo -file $file} img1] != 0} {
319
msg_box "Error opening the file you selected : \n$img1"
323
msg_box "Please load the background image"
327
set file2 [chooseFileDialog "Open Image" "open"]
328
if { $file2 == "" } { return }
330
if { [catch {image create photo -file $file2} img2] != 0} {
331
msg_box "Error opening the file you selected : \n$img2"
335
set w1 [image width $img1]
336
set h1 [image height $img1]
337
set w2 [image width $img2]
338
set h2 [image height $img2]
341
canvas .alpha.c -width [expr $w1 > $w2 ? $w1 : $w2] -height [expr $h1 > $h2 ? $h1 : $h2]
343
.alpha.c create image [expr $w2 / 2] [expr $h2 / 2] -image $img2
344
.alpha.c create image [expr $w1 / 2] [expr $h1 / 2] -image $img1
347
# bind .alpha <Destroy> "image delete $img1; image delete $img2"
353
if { [CheckLoaded] == 0 } {
354
catch {load ../TkCximage[info shared]}
355
catch {load ./TkCximage[info shared]}
356
if {[CheckLoaded] == 0 } {
357
puts "Can't find the extension, please type \"make\" to compile it before testing it"
366
set ::format "cximage"
369
wm title . "Commands"
370
button .load -text "Load" -command "Load"
371
button .save -text "Save" -command "Save"
372
button .play -text "Play" -command "::CxImage::EnableAnimated"
373
button .pause -text "Pause" -command "::CxImage::DisableAnimated"
374
button .convert -text "Convert" -command "Convert"
375
button .res -text "Resize" -command "Resize"
376
button .thumbnail -text "Thumbnail" -command "Thumbnail"
377
button .colorize -text "Colorize" -command "Colorize"
378
button .crop -text "Crop" -command "Crop"
379
button .blending -text "Test Alpha blending" -command "Blending"
380
button .exit -text "Exit" -command "exit"
382
pack .load .save .play .pause .convert .res .thumbnail .colorize .crop .blending .exit -side top
added
removed
utils/TkCximage/demos/demo.tcl
