• gEntry test


    class gEntry {

        inherit itk::Widget
        itk_option define -balloonhelp balloonHelp BalloonHelp ""
        private variable balloon_queue ""
        private variable destroy_queue ""
        public method enter
        public method leave
        public method balloon

        itk_option define -image image Image "" {
     if {$itk_option(-image) != ""} {
         $itk_component(icon) configure \
      -image $itk_option(-image) \
      -width [expr [image width $itk_option(-image)] + 4] \
      -height [expr [image height $itk_option(-image)] + 4]
     }
        }

        itk_option define -padxy padXY Pad 0 {
     $itk_component(padding) configure -borderwidth $itk_option(-padxy)
        }
        itk_option define -disabledbackground disabledBackground Background "#dcdcdc"
        itk_option define -disabledforeground disabledForeground DisabledForeground "#a9a9a9"
        itk_option define -foreground foreground Foreground "#000000" {
     if {$itk_option(-state) != "disabled"} {
         $itk_component(entry) configure -foreground $itk_option(-foreground)
     }
        }
        itk_option define -textbackground textBackground Background "#ffffff" {
     if {$itk_option(-state) != "disabled"} {
         $itk_component(entry) configure -background $itk_option(-textbackground)
         $itk_component(icon) configure -background $itk_option(-textbackground)
     }
     $itk_component(frame) configure -background $itk_option(-textbackground)
        }
        itk_option define -entryfont entryFont Font font_e {
     $itk_component(entry) configure -font $itk_option(-entryfont)
        }
        itk_option define -state state State "normal" {
     if {$itk_option(-state) == "disabled"} {
         $itk_component(entry) configure \
      -state disabled \
      -background $itk_option(-disabledbackground) \
      -foreground $itk_option(-disabledforeground)
         $itk_component(frame) configure \
      -background $itk_option(-disabledbackground)
         $itk_component(icon) configure \
      -background $itk_option(-disabledbackground)
     } else {
         $itk_component(entry) configure \
      -state normal \
      -background $itk_option(-textbackground) \
      -foreground $itk_option(-foreground)
         $itk_component(frame) configure \
      -background $itk_option(-textbackground)
         $itk_component(icon) configure \
      -background $itk_option(-textbackground)
     }
        }
        itk_option define -type type Type "string"
        itk_option define -defaultvalue defaultValue DefaultValue ""
        itk_option define -precision precision Precision "2"
        itk_option define -maximum maximum Maximum ""
        itk_option define -minimum minimum Minimum ""
        itk_option define -allowblank allowBlank AllowBlank "1"
        itk_option define -linkcommand linkCommand Command ""
        itk_option define -editcommand editCommand Command ""
        itk_option define -command command Command ""

        public method validate
        public method focusOut
        public method update
        public method query
        public method keystroke

        constructor { args } {
     bind $itk_component(hull) <Enter> [code $this enter]
     bind $itk_component(hull) <Leave> [code $this leave]

     itk_component add padding {
         frame $itk_interior.p \
      -relief flat \
         }
     pack $itk_component(padding) -fill x
     
     itk_component add frame {
         frame $itk_interior.p.f \
      -borderwidth 2 \
      -relief sunken
     } {
         usual
          keep -borderwidth
          keep -relief
     }
     pack $itk_component(frame) -fill x
     
     itk_component add icon {
         label $itk_interior.p.f.icon \
      -anchor c \
      -padx 0 \
      -pady 0 \
      -bd 0
     }
     pack $itk_component(icon) -side left

     itk_component add entry {
         entry $itk_interior.p.f.entry \
      -relief flat \
      -borderwidth 0 \
      -highlightthickness 0 \
      -selectborderwidth 0 \
      -validate all \
      -validatecommand [code $this validate %V %P]
         } {
      keep -insertbackground -insertborderwidth -insertwidth
      keep -insertontime -insertofftime
      keep -selectbackground -selectforeground
      keep -textvariable
      keep -width
      keep -justify
      keep -show
         }
     pack $itk_component(entry) -side right -fill x -expand true 
     bind $itk_component(entry) <FocusOut> [code $this focusOut]
     bind $itk_component(entry) <Return> [code $this focusOut]
     bind $itk_component(entry) <KeyPress> [code $this keystroke]
     eval itk_initialize $args
        }
    }

    body gEntry::query { } {
        return [$itk_component(entry) get]
    }

    body gEntry::update { a_value } {
        if {[validate "focusout" $a_value]} {
     $itk_component(entry) configure -state normal
     $itk_component(entry) delete 0 end
     $itk_component(entry) insert 0 $a_value
     $itk_component(entry) configure -state $itk_option(-state) 
     focusOut -nolink
        }
    }

    body gEntry::validate { reason new_string } {
        switch -- $reason {
     key {
         switch -- $itk_option(-type) {
      real {
          if {[regexp -- {^-?\d*\.?\d*$} $new_string]} {
       return 1
          } else {
       bell
       return 0
          }
      }
      int {
          if {[regexp -- {^-?\d*$} $new_string]} {
       return 1
          } else {
       bell
       return 0
          }
      }
      default {
          return 1
      }
         }
     }
     forced {
         # Trust myself to only force it to accept well-formed values
         return 1
     }
     focusout {
         switch -- $itk_option(-type) {
      real {
          if {[regexp -- {^-?\.?$} $new_string]} {set new_string ""}
          if {$new_string == ""} {
       if {$itk_option(-allowblank)} {
           return 1
       } elseif {$itk_option(-defaultvalue) != ""} {
           set new_string $itk_option(-defaultvalue)
       } else {
           set new_string 0
       }
          }
          if {$itk_option(-maximum) != ""} {
       if {$new_string > $itk_option(-maximum)} {
           set new_string $itk_option(-maximum)
       }
          }
          if {$itk_option(-minimum) != ""} {
       if {$new_string < $itk_option(-minimum)} {
           set new_string $itk_option(-minimum)
       }
          }
          $itk_component(entry) delete 0 end
          $itk_component(entry) insert 0 [format %.$itk_option(-precision)f $new_string]
          # Need to turn valistaion back on, as setting the entry content
          #  here will have turned it off.
          after idle [list $itk_component(entry) configure -validate all]
          return 1
      }
      int {
          if {[regexp -- {^-?$} $new_string]} {set new_string ""}
          if {$new_string == ""} {
       if {$itk_option(-allowblank)} {
           return 1
       } elseif {$itk_option(-defaultvalue) != ""} {
           set new_string $itk_option(-defaultvalue)
       } else {
           set new_string 0
       }
          }
          if {$itk_option(-maximum) != ""} {
       if {$new_string > $itk_option(-maximum)} {
           set new_string $itk_option(-maximum)
       }
          }
          if {$itk_option(-minimum) != ""} {
       if {$new_string < $itk_option(-minimum)} {
           set new_string $itk_option(-minimum)
       }
          }
          $itk_component(entry) delete 0 end
          $itk_component(entry) insert 0 $new_string
          # Need to turn validation back on, as setting the entry content
          #  here will have turned it off.
          after idle [list $itk_component(entry) configure -validate all]
          return 1
      }
      default {
          return 1
      }
         }
     }
     default {
         return 1
     }
        }
    }

    body gEntry::focusOut { { a_link "-link" } } {
        $itk_component(entry) selection clear
        if {$itk_option(-command) != ""} {
     uplevel #0 [list $itk_option(-command) "[$itk_component(entry) get]"]
        }
        if { $a_link != "-nolink" } {
     if {$itk_option(-linkcommand) != ""} {
         uplevel #0 $itk_option(-linkcommand)
     }
        }
    }

    body gEntry::keystroke { } {
        if  {$itk_option(-editcommand) != ""} {
     uplevel #0 $itk_option(-editcommand)
        }
    }


    body gEntry::enter { } {
        if {$balloon_queue != ""} {
     after cancel $balloon_queue
        }
        if {$itk_option(-balloonhelp) != ""} {
     set balloon_queue [after 750 [code $this balloon]]
        }
    }

    body gEntry::leave { } {
        if {$balloon_queue != ""} {
     after cancel $balloon_queue
        }
        set destroy_queue [after 100 {catch {destroy .balloon_help}}]
    }

    body gEntry::balloon { } {
        set t .balloon_help
        catch {destroy $t}
        toplevel $t
        wm overrideredirect $t 1

        if {[tk windowingsystem] == "aqua"} {
     #unsupported1 style $itk_component(hull) floating sideTitlebar
     ::tk::unsupported::MacWindowStyle style $t help none
        }

        label $t.l \
        -text " $itk_option(-balloonhelp) " \
     -relief solid \
     -bd 2 \
     -bg gold \
     -fg #000000 \
     -font font_b
        pack $t.l -fill both
        set x [expr [winfo pointerx $itk_component(hull)] + 8]
        set y [expr [winfo pointery $itk_component(hull)] + 20]
        if {[expr $x + [winfo reqwidth $t.l]] > [winfo screenwidth $t.l]} {
        set x [expr [winfo screenwidth $t.l] - [winfo reqwidth $t.l] - 2]
        }
        if {[expr $y + [winfo reqheight $t.l]] > [winfo screenheight $t.l]} {
        set y [expr $y - 20 - [winfo reqheight $t.l] - 2]
        }
        wm geometry $t +$x\+$y
        #bind $t <Enter> [list [after cancel $destroy_queue]]
        #bind $t <Leave> "catch {destroy .balloon_help}"
    }


    usual gEntry {
       #rename -disabledbackground -background background Background
       keep -textbackground -background
       keep -selectforeground -selectbackground
       keep -disabledbackground -disabledforeground
       keep -entryfont
       keep -padxy
    }

    # ###############################################################################
    # FILEENTRY
    # ###############################################################################

    gEntry .c \
     -image ::img::distance16x16 \
     -balloonhelp "Crystal to detector distance" \
     -type real \
     -precision 2 \
     -width 6 \
     -justify right

    pack .c

  • 相关阅读:
    分而治之应该把握哪些原则呢
    什么事SOA
    SOA架构设计的案例分析课后 学习
    关于分层架构的知识学习
    从小编程,到架构师,我们应该具备什么
    基于MVC架构实例分析以校园知网校内论坛功能为例
    服务架构设计及其应用
    《一线架构师实践指南》阅读笔记03
    《一线架构师实践指南》阅读笔记02
    Pre-Architecture 阶段阅读笔记
  • 原文地址:https://www.cnblogs.com/greencolor/p/2129761.html
Copyright © 2020-2023  润新知