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

  • 相关阅读:
    CF446C [DZY loves Fibonacci]
    [BZOJ2286] 消耗战
    [CF Round #278] Tourists
    BZOJ2553 [BJWC2011]禁忌
    NOI2018D2T1 屠龙勇士
    BZOJ2333 棘手的操作
    bzoj4196: [Noi2015]软件包管理器(树链剖分)
    bzoj1833: [ZJOI2010]count 数字计数(数位DP)
    bzoj1026: [SCOI2009]windy数(数位DP)
    bzoj3631: [JLOI2014]松鼠的新家(树上差分)
  • 原文地址:https://www.cnblogs.com/kane1990/p/2293976.html
Copyright © 2020-2023  润新知