You are here

Collapsable 프레임 위젯 패키지

admin의 아바타

아래의 이미지를 보시면 딱 아시겠죠?

아래의 패키지도 같은 기능을 합니다.

http://tcltk.co.kr/node/1438

############################################
#
# CollapsableFrame.tcl
# ------------------------
#
# Copyright (C) 2005 William J Giddings
# email: <a href="mailto:giddings@freeuk.com">giddings@freeuk.com</a>
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA  02111-1307, USA.
#
############################################
#
# Description:
# -----------
# Provide a collapsable labeled frame widget.
#
# Creation:
# --------
# CollapsableFrame pathName ?option value...?  
#
# Standard Options:
# ----------------  
# -text                  Text to dispay in frame.
# -width                 Width of frame.
# -borderwidth           Width of displayed frame border.
# -height                Maximum height of the frame.
#
# Widget Specific Options:
# -----------------------
# none
#
# Returns:            
# --------                      
# Pathname of the frame container.
#
# Widget Commands:
# --------
# pathName open          Open/expand frame to reveal contents.            
# pathName close         Close/collapse frame to hide contents.
# pathName toggle        Flip state.
# pathName getframe      Returns path to the widget container.
# pathName title string  Set title to new value.
#
# Bindings:
# -----------------------------------#
# Arrow                  Button-1    Open/Close frame.
#
# Example:
# -------
# This module includes a demo proceedure. Delete and/or comment out as required.
#
# Note:
# ----
# Work still in progress.
# As always, programming is an art. Like a painting, it is never finished.
# Good programmers and artists have one critical faculty in common: knowing when to stop!
#
# When adding new widgets to the container, ensure that the maximum height of the
# frame is sufficient to accomodate all items.
#
# Use the place geometry manager to explicitly position child widgets.
#  
# Future enhancements:
# -------------------
#
############################################

 #!/bin/sh \

 
 package require Tk
 package provide CollapsableFrame 1.0
 namespace eval CollapsableFrame {}
 proc CollapsableFrame {base args} {
    #-------

   # set some defaults
   #-------
    set text $base
    set height 47
    set width 125
    set borderwidt 2
    set labelheight 16
   #-------
   # parges args
   #-------
     foreach {arg val} $args {
         switch -- $arg {
             -text -
             -width -
             -borderwidth -
             -height { set [string trimleft $arg -] $val}
         }
     }  
   #-------
   # create button icons
   #-------
    image create photo im_Open -data R0lGODlhEAAQAKIAAP///9TQyICAgEBAQAAAAAAAAAAAAAAAACwAAAAAEAAQAAADNhi63BMgyinFAy0HC3Xj2EJoIEOM32WeaSeeqFK+say+2azUi+5ttx/QJeQIjshkcsBsOp/MBAA7
    image create photo im_Close -data R0lGODlhEAAQAKIAAP///9TQyICAgEBAQAAAAAAAAAAAAAAAACwAAAAAEAAQAAADMxi63BMgyinFAy0HC3XjmLeA4ngpRKoSZoeuDLmo38mwtVvKu93rIo5gSCwWB8ikcolMAAA7
   #-------
   # create container
   #-------
    frame $base \
        -height $height \
        -width $width
   #-------
   # visible frame
   #-------
    frame $base.fra1  \
        -borderwidth $borderwidt \
        -height $labelheight \
        -relief ridge \
        -width $width
    pack $base.fra1 \
        -in $base \
        -anchor center \
        -expand 1 \
        -fill x \
        -pady 7 \
        -side left
   #-------
   # toggle arrow
   #-------
    label $base.lab1  \
        -borderwidth 0 \
        -image im_Open \
        -relief raised \
        -text $height
    place $base.lab1  \
        -x 5 \
        -y -1 \
        -width 21 \
        -height 21 \
        -anchor nw \
        -bordermode ignore
   #-------
   # arrow bindings
   #-------
    bind $base.lab1 <Button-1> {
             set a [%W cget -image]
             if { $a == "im_Open" } {
                 %W configure -image im_Close
                 [winfo parent %W].fra1 configure -height [%W cget -text]
             } else {
                 %W configure -image im_Open
                 [winfo parent %W].fra1 configure -height 16
             }
    }
   #-------
   # frame title
   #-------
    label $base.lab2 \
        -anchor w \
        -borderwidth 1 \
        -text $text    
    place $base.lab2 \
        -x 23 \
         -y 3 \
        -height 12 \
        -anchor nw \
        -bordermode ignore
    #-------
    # Here comes the overloaded widget proc:
    #-------
     rename $base _$base      ;# keep the original widget command
     proc $base {cmd args} {
         set self [lindex [info level 0] 0] ;# get name I was called with
         switch -- $cmd {
             open     {eval CollapsableFrame::open $self $args}
             close    {eval CollapsableFrame::close $self $args}
             toggle   {eval CollapsableFrame::toggle $self $args}
             getframe {eval CollapsableFrame::getframe $self $args}
             default  {uplevel 1 _$self $cmd $args}
         }
     }  
    return $base.fra1
 }
#-------
# Check the current widget state then reverse it.
#-------
 proc CollapsableFrame::toggle {w} {
    set a [$w.lab1 cget -image]
         if { $a == "im_Open" } {
             $w.lab1 configure -image im_Close
             [winfo parent $w.lab1].fra1 configure -height [$w.lab1 cget -text]
         } else {
             $w.lab1 configure -image im_Open
             [winfo parent $w.lab1].fra1 configure -height 16
         }
 }
#-------
# Collapse the widget, display the 'can be opened' icon.
#-------
 proc CollapsableFrame::close {w} {
          $w.lab1 configure -image im_Open
          [winfo parent $w.lab1].fra1 configure -height 16
 }
#-----------------------------------------------------------
# Open the widget, display the 'can be closed' icon.
#-----------------------------------------------------------
 proc CollapsableFrame::open {w} {
           $w.lab1 configure -image im_Close
    [winfo parent $w.lab1].fra1 configure -height [$w.lab1 cget -text]
 }
#-------
# get path to display area
#-------
 proc CollapsableFrame::getframe {w} {
    return $w.fra1
 }
#-------
# demo block
#-------
 proc demo {} {
    CollapsableFrame .cf1 \
        -text "Frame1 " \
        -height 80
    pack .cf1 \
        -in [winfo parent .cf1] \
        -anchor center \
        -expand 0 \
        -fill x \
        -side top
    CollapsableFrame .cf2 \
        -text "Frame2 " \
        -height 80
    pack .cf2 \
        -in [winfo parent .cf2] \
        -anchor center \
        -expand 0 \
        -fill x \
        -side top
   #-------
   # place child widgets inside the container
   #-------
    place [button [.cf1 getframe].but1 -text BUTTON(A,1)] -x 10 -y 15
    place [button [.cf1 getframe].but2 -text BUTTON(A,2)] -x 10 -y 45
 
    place [button [.cf2 getframe].but1 -text BUTTON(B,1)] -x 10 -y 15
    place [button [.cf2 getframe].but2 -text BUTTON(B,2)] -x 10 -y 45
 }

demo