Screenshot
package require Tk
#network activity icon
# 2004-06-12 Steve Redler IV
set ::networkright [image create photo .networkright -data {
R0lGODlhEAAQAKUAALq6y4mmz3l5y5O2xoXP94/g/7Hn9Mb8/53c9ZHK7Z/o
/6Pq/5nl/47a+4zf/3HR/zg4XmfM/13H/zSz/1Sz9oSEzcXF2ZeX0G5uzFJf
ll1dnN7e37Cw1pOTzI+PwFR5qYmJ1GFhxsfH2+Dg4dnZ3c3N3bm5zJmZwJeX
wMDA4Ht7zIqKv1JghfPz8/Ly8sDA26CgzJKSwNLS262txYeJtf//////////
/////////////////////////////////yH5BAEKAD8ALAAAAAAQABAAAAZ6
wJ9wCCgCAkjBcPkbEAqGAyKhZAqdBcWC0aj+jMckg+F4eAeQtFoQaUfO6nVb
IoHHIYLJhEKxxwUVFV5Xd3gWFxgZSwMajY4CGxwdHkwfIJchIiMkJSYnTCgp
hyorKKYoLEsXLS4bLzAxVkMXJCMyJTM0skOnpru/u0EAOw==}]
set ::networkleft [image create photo .networkleft -data {
R0lGODlhEAAQAKUAALq6y4mmz3l5y5O2xjg4XoXP94/g/7Hn9Mb8/5zn/5HK
7Znl/4HZ/3rV/2fM/11dnGTK/4SEzUe8/07A/0q+/0Sx+cXF2ZeX0G5uzFJf
llSz9t7e37Cw1pOTzI+PwFR5qYmJ1GFhxsfH2+Dg4dnZ3c3N3bm5zJmZwJeX
wMDA4Ht7zIqKv1JghfPz8/Ly8sDA26CgzJKSwNLS262txYeJtf//////////
/////////////////////////////////yH5BAEKAD8ALAAAAAAQABAAAAZ+
wJ9wCCgCAkjBcPkbEJ5QJVPohD6lP+MxacUOCoYDIqEQdIdfw2JdMEfRBYa8
4RA87g+vY7+HCCIRWFQSEhMTFBUCFhcYGUsDGpGSAhscHR5MHyCbISIjJCUm
J0woKYsqKyiqKCxLFy0uGy8wMVNDFyQjMiUzNLZDq6q/w79BADs=}]
set ::networkon [image create photo .networkon -data {
R0lGODlhEAAQAKUAALq6y4mmz3l5y5O2xoXP94/g/7Hn9Mb8/53c9ZHK7Z/o
/6Pq/5nl/47a+4zf/3HR/5zn/2fM/13H/4HZ/3rV/zSz/1Sz9mTK/4SEzUe8
/07A/0q+/0Sx+cXF2ZeX0G5uzFJflt7e37Cw1pOTzI+PwFR5qYmJ1GFhxsfH
2+Dg4dnZ3c3N3bm5zJmZwJeXwMDA4Ht7zIqKv1JghfPz8/Ly8sDA26CgzJKS
wNLS262txYeJtf///////////////////yH5BAEKAD8ALAAAAAAQABAAAAaD
wJ9wCCgCAkjBcPkbEAqGAyKhZAqdBcWC0aj+jMckg+F4eLFRCDXCjpyfYwZB
wJZI3pM8xV2pWCxnbWwXAhgYXlcZGRoaGxwCHR4fIEsDf5eAISIjJEwlJqAn
KCkqKywtTC4vkTAxLq8uMkseMzQhNTY3VkMeKik4Kzk6u0Owr8TIxEEAOw==}]
set ::networkoff [image create photo .networkoff -data {
R0lGODlhEAAQAKUAALq6y4mmz3l5y5O2xjg4Xl1dnISEzcXF2ZeX0G5uzFJf
lt7e37Cw1pOTzI+PwFR5qYmJ1GFhxsfH2+Dg4dnZ3c3N3bm5zJmZwJeXwMDA
4Ht7zIqKv1JghfPz8/Ly8sDA26CgzJKSwNLS262txYeJtf//////////////
////////////////////////////////////////////////////////////
/////////////////////////////////yH5BAEKAD8ALAAAAAAQABAAAAZo
wJ9wCCgCAkjBcPkbEJ5QJVPohD6lP+MxacVWu93hNxqmWq+FdMF7JggMBqz5
LDggEorlQK0WLBgNDkwPEIUREhMUFRYXTBgZdhobGJQYHEsIHR4LHyAhU0MI
FBMiFSMkoEOVlKmtqUEAOw==}]
set ::networknc [image create photo .networknc -data {
R0lGODlhEAAQAKUAALq6y4mmz3l5y5O2xjg4Xv8CAtIOFrwUINF8iJWTuHom
P00yU4drtOgIDJAgNcM3W25Ti11dnNIpRYSEzaYaK9GaqZeX0G5uzFJfloBJ
evsbG7Cw1pOTzI+PwFR5qYmJ1OQgMMohQ8fH2+Dg4foaGuhcY7m5zJmZwJeX
wMDA4N5uefMSGYlttYqKv612lqKGq1JghfPz8/PX19treqCgzJKSwNnZ3dLS
283N3a2txYeJtf///////////////////yH5BAEKAD8ALAAAAAAQABAAAAaK
wJ9wCCgCAkjBcPkbEJ5QJbPQhBoOBOnPiCgkAgJFYZEdOp8HA4HRcDy1Z8Ki
oXio32YoQdEoQCKAcHoEBRITE1pCcQQUfRUWFxhLA4AREAUZDxobHB1MHh8f
ICEiIyQlJidMKCkqKywtKC4FLzBLFjEyGjM0NUIFVLc2Izc4OTpMqyjLKMnO
z0tBADs=}]
proc blinkoff {labelname dir} {
switch $dir {
tx {set ::txlight 0}
rx {set ::rxlight 0}
}
if {$::rxlight && $::txlight} {
$labelname configure -image $::networkon
return
}
if {$::rxlight && ! $::txlight} {
$labelname configure -image $::networkright
return
}
if {! $::rxlight && $::txlight} {
$labelname configure -image $::networkleft
return
}
$labelname configure -image $::networkoff
}
proc blinkon {labelname dir} {
switch $dir {
tx {if {$::txlight} {
return
} else {
set ::txlight 1
after 400 [list blinkoff $labelname tx]
}
}
rx {if {$::rxlight} {
return
} else {
set ::rxlight 1
after 400 [list blinkoff $labelname rx]
}
}
}
if {$::rxlight && $::txlight} {
$labelname configure -image $::networkon
return
}
if {$::rxlight && ! $::txlight} {
$labelname configure -image $::networkright
return
}
if {! $::rxlight && $::txlight} {
$labelname configure -image $::networkleft
return
}
$labelname configure -image $::networkoff
}
#start of demo code
set ::txlight 0
set ::rxlight 0
label .label1 -width 4 -borderwidth 1
label .label2 -text "Net Activity"
button .button1 -text "connect" -width 10 -command {set ::connected 1; backgroundprocess}
button .button2 -text "disconnect" -width 10 -command {set ::connected 0}
pack .button1 -fill x
pack .button2 -fill x
pack .label1 -side left -expand n -fill none
pack .label2 -side right -expand n -fill none
.label1 configure -image $::networknc -width 16 -height 16
wm geometry . 110x80
update
set ::connected 1
proc backgroundprocess {} {
if {! $::connected} {.label1 configure -image $::networknc; return}
after 10 [list blinkon .label1 rx]
after 1000 [list blinkon .label1 tx]
after 1500 [list blinkon .label1 rx]
after 1500 [list blinkon .label1 tx]
after 2000 [list backgroundprocess]
}