author | Claus Gittinger <cg@exept.de> |
Fri, 14 Feb 2003 00:43:09 +0100 | |
changeset 4559 | 6f586dd4661b |
parent 2727 | 7e0930ea0c01 |
child 4864 | d584b65842b8 |
permissions | -rw-r--r-- |
84 | 1 |
" |
2 |
COPYRIGHT (c) 1995 by Claus Gittinger |
|
92 | 3 |
All Rights Reserved |
84 | 4 |
|
5 |
This software is furnished under a license and may be used |
|
6 |
only in accordance with the terms of that license and with the |
|
7 |
inclusion of the above copyright notice. This software may not |
|
8 |
be provided or otherwise made available to, or used by, any |
|
9 |
other person. No title to or ownership of the software is |
|
10 |
hereby transferred. |
|
11 |
" |
|
12 |
||
2700 | 13 |
"{ Package: 'stx:libtool' }" |
14 |
||
84 | 15 |
InfoBox subclass:#AboutBox |
451
35d5ba59ee0e
added access method for background color
Claus Gittinger <cg@exept.de>
parents:
248
diff
changeset
|
16 |
instanceVariableNames:'' |
2727 | 17 |
classVariableNames:'CachedIcon DefaultGreen' |
451
35d5ba59ee0e
added access method for background color
Claus Gittinger <cg@exept.de>
parents:
248
diff
changeset
|
18 |
poolDictionaries:'' |
35d5ba59ee0e
added access method for background color
Claus Gittinger <cg@exept.de>
parents:
248
diff
changeset
|
19 |
category:'Views-DialogBoxes' |
84 | 20 |
! |
21 |
||
879 | 22 |
!AboutBox class methodsFor:'documentation'! |
84 | 23 |
|
198 | 24 |
copyright |
25 |
" |
|
26 |
COPYRIGHT (c) 1995 by Claus Gittinger |
|
27 |
All Rights Reserved |
|
28 |
||
29 |
This software is furnished under a license and may be used |
|
30 |
only in accordance with the terms of that license and with the |
|
31 |
inclusion of the above copyright notice. This software may not |
|
32 |
be provided or otherwise made available to, or used by, any |
|
33 |
other person. No title to or ownership of the software is |
|
34 |
hereby transferred. |
|
35 |
" |
|
84 | 36 |
! |
37 |
||
38 |
documentation |
|
39 |
" |
|
2700 | 40 |
A box specialized to show the ST/X about-information (also usable for Applications). |
498 | 41 |
As a speciality, this box automatically closes if left |
42 |
alone for a while. |
|
84 | 43 |
|
498 | 44 |
Can be subclasses for your own aboutBoxes; to do so, redefine |
45 |
#defaultIcon and #aboutText. |
|
92 | 46 |
|
498 | 47 |
examples: |
48 |
AboutBox new open |
|
49 |
||
50 |
AboutBox new showAtPointer |
|
84 | 51 |
" |
2700 | 52 |
! |
53 |
||
54 |
examples |
|
55 |
" |
|
56 |
[exBegin] |
|
57 |
|box| |
|
58 |
||
59 |
box := AboutBox new. |
|
60 |
box autoHideAfter:10 with:[]. |
|
61 |
box showAtCenter |
|
62 |
[exEnd] |
|
63 |
||
64 |
[exBegin] |
|
65 |
|box| |
|
66 |
||
67 |
box := AboutBox title:'About me'. |
|
68 |
box image:((Smalltalk bitmapFromFileNamed:'gifImages/claus.gif' inPackage:'stx:goodies') magnifiedTo:100@100). |
|
69 |
box label:'Example'. |
|
70 |
box autoHideAfter:10 with:[]. |
|
71 |
box showAtPointer. |
|
72 |
[exEnd] |
|
73 |
||
74 |
" |
|
84 | 75 |
! ! |
76 |
||
879 | 77 |
!AboutBox class methodsFor:'defaults'! |
84 | 78 |
|
92 | 79 |
aboutText |
498 | 80 |
"return a string to be shown in the box. |
81 |
Can be redefined in custom subclasses." |
|
125 | 82 |
|
1797 | 83 |
|distributor expiration machine info| |
179
f464e3c75104
if nonEmpty, display distributorString
Claus Gittinger <cg@exept.de>
parents:
165
diff
changeset
|
84 |
|
693 | 85 |
distributor := Smalltalk distributorString. |
86 |
distributor notEmpty ifTrue:[ |
|
708
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
87 |
distributor := 'Distributor ...... ', distributor |
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
88 |
]. |
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
89 |
expiration := Smalltalk expirationTime. |
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
90 |
expiration notNil ifTrue:[ |
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
91 |
expiration := 'Expires ........... ', expiration printString |
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
92 |
] ifFalse:[ |
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
93 |
expiration := ''. |
693 | 94 |
]. |
1797 | 95 |
machine := OperatingSystem getHostName. |
96 |
info := OperatingSystem getSystemInfo. |
|
97 |
(info includesKey:#machine) ifTrue:[ |
|
98 |
machine := machine , ' (' , (info at:#machine) , ')' |
|
99 |
]. |
|
179
f464e3c75104
if nonEmpty, display distributorString
Claus Gittinger <cg@exept.de>
parents:
165
diff
changeset
|
100 |
|
92 | 101 |
^ |
179
f464e3c75104
if nonEmpty, display distributorString
Claus Gittinger <cg@exept.de>
parents:
165
diff
changeset
|
102 |
'SmallTalk/X |
92 | 103 |
|
708
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
104 |
Version ......... ', Smalltalk versionString , '.' , Smalltalk releaseNr printString , |
498 | 105 |
' (' , Smalltalk versionDate printString , ') |
708
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
106 |
', distributor, ' |
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
107 |
', expiration , ' |
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
108 |
Release ID ...... ', Smalltalk releaseIdentification, ' |
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
109 |
Configuration ... ', Smalltalk configuration, ' |
1797 | 110 |
Running on ...... ', machine, ' |
92 | 111 |
|
179
f464e3c75104
if nonEmpty, display distributorString
Claus Gittinger <cg@exept.de>
parents:
165
diff
changeset
|
112 |
' , Smalltalk copyrightString , ' |
f464e3c75104
if nonEmpty, display distributorString
Claus Gittinger <cg@exept.de>
parents:
165
diff
changeset
|
113 |
|
693 | 114 |
' |
179
f464e3c75104
if nonEmpty, display distributorString
Claus Gittinger <cg@exept.de>
parents:
165
diff
changeset
|
115 |
|
1797 | 116 |
"Modified: / 6.9.1996 / 10:11:08 / stefan" |
117 |
"Modified: / 4.8.1998 / 02:28:29 / cg" |
|
198 | 118 |
! |
119 |
||
2727 | 120 |
defaultGreen |
121 |
"return the boxes default green color (eXept green)." |
|
122 |
||
123 |
DefaultGreen notNil ifTrue:[^ DefaultGreen]. |
|
124 |
^ Color red:0 green:80 blue:20 |
|
125 |
! |
|
126 |
||
198 | 127 |
defaultIcon |
498 | 128 |
"return a smalltalk/X icon. |
129 |
Can be redefined in custom subclasses." |
|
198 | 130 |
|
131 |
CachedIcon isNil ifTrue:[ |
|
2169 | 132 |
CachedIcon := Icon stxIcon. |
133 |
CachedIcon isNil ifTrue:[ |
|
2477 | 134 |
CachedIcon := Smalltalk imageFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libtool' |
2169 | 135 |
] |
198 | 136 |
]. |
137 |
^ CachedIcon |
|
498 | 138 |
|
2169 | 139 |
"Modified: / 25.5.1999 / 15:44:48 / cg" |
498 | 140 |
! |
141 |
||
142 |
defaultLabel |
|
143 |
"return the boxes default window title." |
|
144 |
||
145 |
^ 'About ...' |
|
146 |
||
147 |
"Modified: 23.4.1996 / 17:09:48 / cg" |
|
148 |
"Created: 23.4.1996 / 17:11:46 / cg" |
|
84 | 149 |
! ! |
150 |
||
151 |
!AboutBox methodsFor:'initialization'! |
|
152 |
||
498 | 153 |
initialize |
2727 | 154 |
"setup the box; change all of my components viewBackground to some darkish grey." |
498 | 155 |
|
107 | 156 |
|dark green lbl| |
84 | 157 |
|
158 |
super initialize. |
|
159 |
||
498 | 160 |
"/ self label:'About ...'. |
84 | 161 |
|
2727 | 162 |
green := self class defaultGreen. |
163 |
dark := Color grey:10. |
|
164 |
device hasColors ifFalse:[ |
|
165 |
device hasGrayscales ifTrue:[ |
|
166 |
green := Color brightness:(green brightness). |
|
167 |
dark := Color brightness:(dark brightness). |
|
168 |
] ifFalse:[ |
|
169 |
green := Color white. |
|
170 |
dark := Color black. |
|
171 |
] |
|
84 | 172 |
]. |
173 |
||
452
33ce1b3cd502
oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents:
451
diff
changeset
|
174 |
self withAllSubViewsDo:[:s | s viewBackground:dark]. |
248 | 175 |
|
452
33ce1b3cd502
oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents:
451
diff
changeset
|
176 |
self form:(self class defaultIcon). |
33ce1b3cd502
oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents:
451
diff
changeset
|
177 |
(lbl := self formLabel) viewBackground:dark. |
33ce1b3cd502
oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents:
451
diff
changeset
|
178 |
lbl foregroundColor:green backgroundColor:dark. |
33ce1b3cd502
oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents:
451
diff
changeset
|
179 |
(lbl := self textLabel) viewBackground:dark. |
33ce1b3cd502
oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents:
451
diff
changeset
|
180 |
lbl foregroundColor:White backgroundColor:dark. |
33ce1b3cd502
oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents:
451
diff
changeset
|
181 |
|
33ce1b3cd502
oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents:
451
diff
changeset
|
182 |
self title:(self class aboutText). |
1592 | 183 |
self okText:(resources string:'close'). |
452
33ce1b3cd502
oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents:
451
diff
changeset
|
184 |
|
1592 | 185 |
"Modified: / 12.6.1998 / 11:48:23 / cg" |
84 | 186 |
! ! |
187 |
||
188 |
!AboutBox methodsFor:'show / hide'! |
|
189 |
||
190 |
show |
|
498 | 191 |
"show the box. |
192 |
Redefined to automatically hide myself after some time" |
|
100 | 193 |
|
708
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
194 |
self autoHideAfter:15 with:[]. |
84 | 195 |
super showAtCenter. |
196 |
||
197 |
" |
|
198 |
AboutBox new show |
|
199 |
" |
|
498 | 200 |
|
201 |
"Modified: 23.4.1996 / 17:10:03 / cg" |
|
708
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
202 |
"Modified: 6.9.1996 / 09:47:10 / stefan" |
84 | 203 |
! ! |
204 |
||
879 | 205 |
!AboutBox class methodsFor:'documentation'! |
248 | 206 |
|
207 |
version |
|
2727 | 208 |
^ '$Header: /cvs/stx/stx/libtool/AboutBox.st,v 1.26 2000-08-22 11:09:31 cg Exp $' |
248 | 209 |
! ! |