一个简单的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');"
}