bitmap.tcl

bitmap.tcl
This file is part of Unifix BWidget Toolkit
$Id: bitmap.tcl,v 1.2 1999/11/05 03:38:54 ericm Exp $
Index of commands:
- Bitmap::get
- Bitmap::_init


Bitmap
Comments  
Arguments  
Used by  
Uses  
    variable path
    variable _bmp
    variable _types {
        photo  .gif
        photo  .ppm
        bitmap .xbm
        photo  .xpm
    }

    proc use {} {}
}


Bitmap::_init
Comments Command Bitmap::_init
Arguments  
Used by  
Uses  
proc Bitmap::_init { } {
    global   env
    variable path
    variable _bmp
    variable _types

    set path [list "." [file join $::BWIDGET::LIBRARY images]]
    set supp [image types]
    foreach {type ext} $_types {
        if { [lsearch $supp $type] != -1} {
            set _bmp($ext) $type
        }
    }
}


Bitmap::get
Comments Command Bitmap::get
Arguments name
Used by SelectColor::menu
DragSite::_init_drag
SelectFont::create
ProgressDlg::create
PasswdDlg::create
MessageDlg::create
Uses xpm-to-image
proc Bitmap::get { name } {
    variable path
    variable _bmp
    variable _types

    if {[info exists _bmp($name)]} {
        return $_bmp($name)
    }

    # --- Nom de fichier avec extension ------------------------------------------------------
    set ext [file extension $name]
    if { $ext != "" } {
        if { ![info exists _bmp($ext)] } {
            error "$ext not supported"
        }

        if { [file exists $name] } {
            if {![string compare $ext ".xpm"]} {
                set _bmp($name) [xpm-to-image $name]
                return $_bmp($name)
            }
            if {![catch {set _bmp($name) [image create $_bmp($ext) -file $name]}]} {
                return $_bmp($name)
            }
        }
    }

    foreach dir $path {
        foreach {type ext} $_types {
            if { [file exists [file join $dir $name$ext]] } {
                if {![string compare $ext ".xpm"]} {
                    set _bmp($name) [xpm-to-image [file join $dir $name$ext]]
                    return $_bmp($name)
                } else {
                    if {![catch {set _bmp($name) [image create $type -file [file join $dir $name$ext]]}]} {
                        return $_bmp($name)
                    }
                }
            }
        }
    }

    return -code error "$name not found"
}
generated by zdoc.tcl on 2003-03-06 00:21:53