一个简单的tcl/tk程序，包含了几乎所有常用组件的基本用法，仅供自己参考
############################
# set the size of the vanvas
############################
set x 0
set y 1
set z 0.8
set p 0
set q 1
set l 0.8
set monkeyImage []
set glassesImage []
set beardImage []
set sheepImage []
set step1Image []
set top .top43
###################
# CREATING WIDGETS
###################
toplevel $top -class Toplevel \
-menu "$top.m63"
wm focusmodel $top passive
wm geometry $top 740x530+200+250; update
wm maxsize $top 1284 982
wm minsize $top 115 1
wm overrideredirect $top 0
wm resizable $top 1 1
wm deiconify $top
wm title $top "Sci_Digital_Makeup"
canvas $top.can44 \
-borderwidth 2 -closeenough 1.0 -height 142 -relief ridge -width 101
canvas $top.can45 \
-borderwidth 2 -closeenough 1.0 -height 142 -relief ridge -width 101
canvas $top.can46 \
-borderwidth 2 -closeenough 1.0 -height 142 -relief ridge -width 101
canvas $top.can47 \
-borderwidth 2 -closeenough 1.0 -height 142 -relief ridge -width 101
canvas $top.can48 \
-borderwidth 2 -closeenough 1.0 -height 142 -relief ridge -width 101
canvas $top.can49 \
-borderwidth 2 -closeenough 1.0 -height 142 -relief ridge -width 101
canvas $top.can50 \
-borderwidth 2 -closeenough 1.0 -height 142 -relief ridge -width 101
canvas $top.can51 \
-borderwidth 2 -closeenough 1.0 -height 142 -relief ridge -width 101
canvas $top.can52 \
-borderwidth 2 -closeenough 1.0 -height 142 -relief ridge -width 101
canvas $top.can53 \
-borderwidth 2 -closeenough 1.0 -height 142 -relief ridge -width 101
canvas $top.can54 \
-borderwidth 2 -closeenough 1.0 -height 142 -relief ridge -width 101
canvas $top.can1 \
-closeenough 1.0 -height 50 -relief ridge -width 50
canvas $top.can2 \
-closeenough 1.0 -height 50 -relief ridge -width 50
canvas $top.can3 \
-closeenough 1.0 -height 50 -relief ridge -width 50
canvas $top.can4 \
-closeenough 1.0 -height 50 -relief ridge -width 50
label $top.lab1 \
-text {}
label $top.lab2 \
-text {}
label $top.lab3 \
-text {}
#-yscrollcommand {$w.vs set} -xscrollcommand {$w.hs set}
#scrollbar $top.vs -command {$top.can yview}
#scrollbar $top.hs -command {$top.can xview} -orient horizontal
#grid $top.can44 $top.vs -sticky nsew
#grid $top.hs -sticky nsew
#grid rowconfigure $top 1 -weight 1
#grid columnconfigure $top 0 -weight 1
labelframe $top.lab45 \
-text {Choose Images} -height 75 -width 240
set site_3_0 $top.lab45
label $site_3_0.lab46 \
-text {Mask Image}
label $site_3_0.lab47 \
-text {Original Image}
button $site_3_0.but74 \
-pady 0 -takefocus 0 -text load -command {loadExample}
button $site_3_0.but75 \
-pady 0 -takefocus 0 -text load -command {loadSubject}
entry $site_3_0.ent77 \
-background white -takefocus 0
label $site_3_0.lab79 \
-text (1~10)
entry $site_3_0.ent80 \
-background white -takefocus 0
label $site_3_0.lab81 \
-text (1~10)
place $site_3_0.lab46 \
-in $site_3_0 -x 9 -y 49 -width 84 -height 18 -anchor nw \
-bordermode ignore
place $site_3_0.lab47 \
-in $site_3_0 -x 9 -y 21 -width 84 -height 18 -anchor nw \
-bordermode ignore
place $site_3_0.but74 \
-in $site_3_0 -x 180 -y 49 -width 51 -height 19 -anchor nw \
-bordermode ignore
place $site_3_0.but75 \
-in $site_3_0 -x 180 -y 21 -width 51 -height 19 -anchor nw \
-bordermode ignore
place $site_3_0.ent77 \
-in $site_3_0 -x 100 -y 53 -width 29 -height 16 -anchor nw \
-bordermode ignore
place $site_3_0.lab79 \
-in $site_3_0 -x 128 -y 25 -width 48 -height 18 -anchor nw \
-bordermode ignore
place $site_3_0.ent80 \
-in $site_3_0 -x 100 -y 25 -width 29 -height 16 -anchor nw \
-bordermode ignore
place $site_3_0.lab81 \
-in $site_3_0 -x 128 -y 53 -width 42 -height 18 -anchor nw \
-bordermode ignore
labelframe $top.lab51 \
-text Parameters -height 220 -width 240
set site_3_0 $top.lab51
labelframe $site_3_0.lab52 \
-text {Skin Detail Transfer} -height 110 -width 200
set site_4_0 $site_3_0.lab52
label $site_4_0.lab53 \
-text {Delta I}
label $site_4_0.lab54 \
-text {Delta E}
scale $site_4_0.sca83 \
-bigincrement 0.0 -from 0.0 -orient horizontal -resolution 0.05 \
-takefocus 0 -tickinterval 0.0 -to 1.0 -variable p -command onDeltaIChange
scale $site_4_0.sca84 \
-bigincrement 0.0 -from 0.0 -orient horizontal -resolution 0.05 \
-takefocus 0 -tickinterval 0.0 -to 1.0 -variable q -command onDeltaEChange
place $site_4_0.lab53 \
-in $site_4_0 -x 30 -y 30 -anchor nw -bordermode ignore
place $site_4_0.lab54 \
-in $site_4_0 -x 30 -y 75 -anchor nw -bordermode ignore
place $site_4_0.sca83 \
-in $site_4_0 -x 85 -y 13 -width 106 -height 39 -anchor nw \
-bordermode ignore
place $site_4_0.sca84 \
-in $site_4_0 -x 85 -y 56 -width 106 -height 39 -anchor nw \
-bordermode ignore
labelframe $site_3_0.lab59 \
-text {Color Transfer} -height 65 -width 200
set site_4_0 $site_3_0.lab59
label $site_4_0.lab60 \
-text gama
scale $site_4_0.sca85 \
-bigincrement 0.0 -from 0.0 -orient horizontal -resolution 0.05 \
-takefocus 0 -tickinterval 0.0 -to 1.0 -variable l -command onGamaChange
place $site_4_0.lab60 \
-in $site_4_0 -x 45 -y 30 -width 30 -height 18 -anchor nw \
-bordermode ignore
place $site_4_0.sca85 \
-in $site_4_0 -x 83 -y 13 -width 106 -height 39 -anchor nw \
-bordermode ignore
place $site_3_0.lab52 \
-in $site_3_0 -x 20 -y 25 -width 200 -height 110 -anchor nw \
-bordermode ignore
place $site_3_0.lab59 \
-in $site_3_0 -x 20 -y 140 -width 200 -height 65 -anchor nw \
-bordermode ignore
button $top.but62 \
-pady 0 -text {Make Up!} -command {Make_up}
button $top.but63 \
-pady 0 -text {ClearAll} -command {clearAll}
menu $top.m63 \
-activeborderwidth 1 -borderwidth 1 -tearoff 0
$top.m63 add cascade \
-menu "$top.m63.men64" -label Decomposition
set site_3_0 $top.m63
menu $site_3_0.men64 \
-activeborderwidth 1 -borderwidth 1 -tearoff 0
$site_3_0.men64 add command \
-command {showDecOriginal} -label {Original}
$site_3_0.men64 add command \
-command {showDecMask} -label {Mask}
$top.m63 add cascade \
-menu "$top.m63.men96" -label Funny_effects
set site_3_0 $top.m63
menu $site_3_0.men96 \
-activeborderwidth 1 -borderwidth 1 -tearoff 0
$site_3_0.men96 add command \
-command {showBeard} -label {Beard_Man}
$site_3_0.men96 add command \
-command {showSheep} -label {Sheep_Man}
$site_3_0.men96 add command \
-command {showMonkey} -label {Monkey_Man}
$site_3_0.men96 add command \
-command {showGlasses} -label {Glasses_Man}
$top.m63 add cascade \
-menu "$top.m63.men86" -label help
set site_3_0 $top.m63
menu $site_3_0.men86 \
-activeborderwidth 1 -borderwidth 1 -tearoff 0
$site_3_0.men86 add command \
-command {showHow} -label {How to use}
$site_3_0.men86 add command \
-command {showAboutUs} -label {About us}
$site_3_0.men86 add command \
-command {showLogo} -label {Our logo}
$site_3_0.men86 add command \
-command {showContact} -label {Contact Us}
###################
# SETTING GEOMETRY
###################
place $top.can44 \
-in $top -x 30 -y 20 -width 101 -height 142 -anchor nw \
-bordermode ignore
place $top.can1 \
-in $top -x 131 -y 76 -width 50 -height 50 -anchor nw \
-bordermode ignore
place $top.can45 \
-in $top -x 183 -y 20 -width 101 -height 142 -anchor nw \
-bordermode ignore
place $top.can2 \
-in $top -x 284 -y 76 -width 50 -height 50 -anchor nw \
-bordermode ignore
place $top.can46 \
-in $top -x 336 -y 20 -width 101 -height 142 -anchor nw \
-bordermode ignore
place $top.can47 \
-in $top -x 10 -y 200 -width 101 -height 142 -anchor nw \
-bordermode ignore
place $top.can3 \
-in $top -x 111 -y 236 -width 50 -height 50 -anchor nw \
-bordermode ignore
place $top.can48 \
-in $top -x 161 -y 200 -width 101 -height 142 -anchor nw \
-bordermode ignore
place $top.can49 \
-in $top -x 264 -y 200 -width 101 -height 142 -anchor nw \
-bordermode ignore
place $top.can50 \
-in $top -x 367 -y 200 -width 101 -height 142 -anchor nw \
-bordermode ignore
place $top.can51 \
-in $top -x 10 -y 350 -width 101 -height 142 -anchor nw \
-bordermode ignore
place $top.can4 \
-in $top -x 111 -y 396 -width 50 -height 50 -anchor nw \
-bordermode ignore
place $top.can52 \
-in $top -x 161 -y 350 -width 101 -height 142 -anchor nw \
-bordermode ignore
place $top.can53 \
-in $top -x 264 -y 350 -width 101 -height 142 -anchor nw \
-bordermode ignore
place $top.can54 \
-in $top -x 367 -y 350 -width 101 -height 142 -anchor nw \
-bordermode ignore
place $top.lab45 \
-in $top -x 485 -y 60 -width 240 -height 75 -anchor nw \
-bordermode ignore
place $top.lab51 \
-in $top -x 485 -y 187 -width 240 -height 220 -anchor nw \
-bordermode ignore
place $top.but62 \
-in $top -x 535 -y 442 -width 62 -height 24 -anchor nw \
-bordermode ignore
place $top.but63 \
-in $top -x 620 -y 442 -width 62 -height 24 -anchor nw \
-bordermode ignore
place $top.lab1 -x 170 -y 180 -width 84 -height 18
place $top.lab2 -x 272 -y 180 -width 84 -height 18
place $top.lab3 -x 375 -y 180 -width 84 -height 18
#showImage $AImage 44
#showImage $BImage 45
#showImage $whoImage 46
###################################################
# load the example image and show it on the canvas
# when you click the 'load' button
###################################################
proc loadExample {} {
global image_path
global ExampleImage
global ExampleImagePath
global EqImage
clearSome2
set ExampleImagePath [.top43.lab45.ent77 get]
if {$ExampleImagePath==""} {
ScilabEval "error 'you must choose a mask image first!'"
return ;
}
set temp_image_path $image_path
set ExampleImagePath [append temp_image_path $ExampleImagePath]
append ExampleImagePath 1.jpg
ScilabEval "temp=imread(TCL_GetVar('ExampleImagePath'));temp=Sci2TCLFormat(temp);TCL_SetVar('ExampleImage',temp);printf('Mask image loaded!\n\n');TCL_EvalFile(gui_path+'showExample.tcl')"
}
###################################################
# load the subject image and show it on the canvas
# when you click the 'load' button
###################################################
proc loadSubject {} {
global SubjectImagePath
global image_path
global SubjectImage
global plusImage
clearSome2
.top43.can45 delete item
.top43.can2 delete item
set SubjectImagePath [.top43.lab45.ent80 get]
if {$SubjectImagePath==""} {
ScilabEval "error 'you must choose a original image first!'"
return ;
}
set temp_image_path $image_path
set SubjectImagePath [append temp_image_path $SubjectImagePath]
append SubjectImagePath 2.jpg
ScilabEval "temp=imread(TCL_GetVar('SubjectImagePath'));temp=Sci2TCLFormat(temp);TCL_SetVar('SubjectImage',temp);printf('Original image loaded!\n\n');TCL_EvalFile(gui_path+'showSubject.tcl');"
}
############################
# Main process of digital
# makeup.It is defined in
# the 'make_up_tcl.sci' file
############################
proc Make_up {} {
global resultImage
wm title .top43 "Sci_Digital_Makeup—Digital Makeup is under processing.Please wait..."
ScilabEval "exec(core_path +'make_up_tcl.sci',-1);temp=Sci2TCLFormat(rgb);TCL_SetVar('resultImage',temp);TCL_EvalFile(gui_path+'showResult.tcl');"
}
##################################
# Show a image on the tcl canvas.
# The parameter 'imagedata' passes
# the data we want to show,and 'pos'
# refer to the index of the canvas
# to show the image on
##################################
proc showImage {imagedata pos} {
global canvaswidth
global canvasheight
global imagewidth
global imageheight
set canvas can
append canvas $pos
set tkimg tkimage
append tkimg $pos
#create image
image create photo $tkimg
#put image data to tkimage
$tkimg put $imagedata
.top43.$canvas delete item
.top43.$canvas create image 0 0 -tags item -image $tkimg -anchor nw
.top43.$canvas configure -scrollregion [.top43.can44 bbox all]
}
proc showDecOriginal {} {
global SubjectImage
global slargeScaleImage
global sskinImage
global RcaImage
global arrowImage
showImage $slargeScaleImage 48
showImage $sskinImage 49
showImage $RcaImage 50
showImage $SubjectImage 47
showImage $arrowImage 3
.top43.lab1 configure -text {Face Structure}
.top43.lab2 configure -text {Skin Detail}
.top43.lab3 configure -text {Color}
}
proc showDecMask {} {
global ExampleImage
global RdImage
global elargeScaleImage
global aeImage
global arrowImage
showImage $elargeScaleImage 52
showImage $RdImage 53
showImage $aeImage 54
showImage $ExampleImage 51
showImage $arrowImage 4
.top43.lab1 configure -text {Face Structure}
.top43.lab2 configure -text {Skin Detail}
.top43.lab3 configure -text {Color}
}
proc showMonkey {} {
global monkeyImage
clearAll
wm title .top43 "Sci_Digital_Makeup—The Monkey_Man is under processing.Please wait..."
if {$monkeyImage !=[]} { \
ScilabEval "TCL_EvalFile(gui_path+'showMonkey.tcl');" \
} \
else { \
ScilabEval "exec(core_path+'monkey.sce');TCL_EvalFile(gui_path+'showMonkey.tcl');" \
}
}
proc showGlasses {} {
global glassesImage
clearAll
wm title .top43 "Sci_Digital_Makeup—The Glasses_Man is under processing.Please wait..."
if {$glassesImage !=[]} { \
ScilabEval "TCL_EvalFile(gui_path+'showGlasses.tcl');" \
} \
else { \
ScilabEval "exec(core_path+'glasses.sce');TCL_EvalFile(gui_path+'showGlasses.tcl');" \
} \
}
proc showBeard {} {
global beardImage
clearAll
wm title .top43 "Sci_Digital_Makeup—The Beard_Man is under processing.Please wait..."
if {$beardImage !=[]} { \
ScilabEval "TCL_EvalFile(gui_path+'showBeard.tcl');" \
} \
else { \
ScilabEval "exec(core_path+'beard.sce');TCL_EvalFile(gui_path+'showBeard.tcl');" \
}
}
proc showSheep {} {
global sheepImage
clearAll
wm title .top43 "Sci_Digital_Makeup—The Sheep_Man is under processing.Please wait..."
if {$sheepImage !=[]} { \
ScilabEval "TCL_EvalFile(gui_path+'showSheep.tcl');" \
} \
else { \
ScilabEval "exec(core_path+'sheep.sce');TCL_EvalFile(gui_path+'showSheep.tcl');" \
}
}
proc clearSome1 {} {
.top43.can3 delete item
.top43.can4 delete item
.top43.can47 delete item
.top43.can48 delete item
.top43.can49 delete item
.top43.can50 delete item
.top43.can51 delete item
.top43.can52 delete item
.top43.can53 delete item
.top43.can54 delete item
}
proc clearSome2 {} {
.top43.can46 delete item
clearSome1
}
proc clearAll {} {
clearSome2
.top43.can1 delete item
.top43.can2 delete item
.top43.can44 delete item
.top43.can45 delete item
}
proc onDeltaIChange {value} {
global x
set x $value
ScilabEval "deltaI=str2num(TCL_GetVar('x'));"
}
proc onDeltaEChange {value} {
global y
set y $value
ScilabEval "deltaE=str2num(TCL_GetVar('y'));"
}
proc onGamaChange {value} {
global z
set z $value
ScilabEval "gama=str2num(TCL_GetVar('z'));"
}
proc showHow {} {
ScilabEval "loadSteps;TCL_EvalFile(gui_path+'steps\\step1.tcl');"
}
proc showLogo {} {
ScilabEval "imshow(logoImage)"
}
proc showAboutUs {} {
ScilabEval "imshow(aboutUsImage)";
}
proc showContact {} {
ScilabEval "TCL_EvalFile(gui_path+'showContact.tcl');"
}
posted on 2011-12-19 22:47 balabala已被注册 阅读(5071) 评论(2) 编辑 收藏 举报
