Tk Library Source Code

Artifact 105a79c26859634a847342df842bc3a0d386235c:

Attachment "splashdlg.tcl" to ticket [1041229fff] added by petasis 2004-10-06 14:14:36.

---

# ----------------------------------------------------------------------------
#  splashdlg.tcl
#  This file is part of Unifix BWidget Toolkit
# ----------------------------------------------------------------------------
#  Index of commands:
#     - SplashDlg::create
# ----------------------------------------------------------------------------

namespace eval SplashDlg {
    Widget::define SplashDlg splashdlg ProgressBar

    Widget::bwinclude SplashDlg ProgressBar .frame.pb \
        remove {-orient -width -height}

    Widget::declare SplashDlg {
        {-modal        Enum    none 0 {none local global}}
        {-width        TkResource 25 0 label}
        {-height       TkResource 1  0 label}
        {-textvariable TkResource "" 0 label}
        {-font         TkResource "" 0 label}
        {-image        TkResource "" 0 label}
        {-text         TkResource "" 0 label}
    }

    Widget::addmap SplashDlg {} .frame.msg \
        {-width {} -height {} -textvariable {} -text {} -font {}
         -background {} -foreground {}}

    Widget::addmap SplashDlg {} .frame.image \
        {-image {} -background {}}
}

# ----------------------------------------------------------------------------
#  Command SplashDlg::create
# ----------------------------------------------------------------------------
proc SplashDlg::create { path args } {
    array set maps [list SplashDlg {} :cmd {} .frame.image {} \
                        .frame.msg {} .frame.pb {}]
    array set maps [Widget::parseArgs SplashDlg $args]
    
    toplevel $path -borderwidth 1 -relief raised \
        -highlightthickness 0 -class SplashDlg -width 100
    wm withdraw $path

    Widget::initFromODB SplashDlg $path $maps(SplashDlg)

    wm overrideredirect $path yes
    wm protocol $path WM_DELETE_WINDOW {;}
    if {[string equal $::tcl_platform(platform) "windows"]} {
      wm attributes $path -topmost 1
    } else {
      bind $path <Visibility> "raise $path"
    }

    set frame [frame $path.frame]
    bind $frame <Destroy> [list Widget::destroy $path]

    ## Image section...
    eval [list label $frame.image] $maps(.frame.image) \
        -relief flat -borderwidth 0 -highlightthickness 0 \
        -anchor center -justify center -padx 0
    pack $frame.image -padx 0 -pady 0 -side top -anchor n -fill x -expand no
    
    ## ProgressBar section...
    eval [list ProgressBar::create] $frame.pb $maps(.frame.pb) -width 100
    pack $frame.pb -side top -anchor w -padx 2 -fill x -expand no

    ## Label section...
    eval [list label $frame.msg] $maps(.frame.msg) \
        -relief flat -borderwidth 0 -highlightthickness 0 \
        -anchor c -justify c
    pack $frame.msg -side bottom -padx 0 -pady 0 -anchor nw -fill both \
        -expand yes

    pack $frame -padx 0 -pady 0 -fill both -expand true
    if { [set grab [Widget::cget $path -modal]] != "none" } {
      BWidget::grab $grab $path
    }
    BWidget::place $path 0 0 center
    wm deiconify $path
    update idletasks

    return [Widget::create SplashDlg $path]
}


# ----------------------------------------------------------------------------
#  Command SplashDlg::configure
# ----------------------------------------------------------------------------
proc SplashDlg::configure { path args } {
    return [Widget::configure "$path#SplashDlg" $args]
}


# ----------------------------------------------------------------------------
#  Command SplashDlg::cget
# ----------------------------------------------------------------------------
proc SplashDlg::cget { path option } {
    return [Widget::cget "$path#SplashDlg" $option]
}