author | Claus Gittinger <cg@exept.de> |
Sun, 19 Nov 2017 14:10:32 +0100 | |
changeset 17767 | 195cf7c7e58f |
parent 16942 | 4762e6c1295f |
child 17134 | c4cce8b7a95d |
child 18109 | 3238e993a075 |
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 |
" |
|
2700 | 12 |
"{ Package: 'stx:libtool' }" |
13 |
||
16026 | 14 |
"{ NameSpace: Smalltalk }" |
15 |
||
84 | 16 |
InfoBox subclass:#AboutBox |
451
35d5ba59ee0e
added access method for background color
Claus Gittinger <cg@exept.de>
parents:
248
diff
changeset
|
17 |
instanceVariableNames:'' |
9801 | 18 |
classVariableNames:'DefaultGreen' |
451
35d5ba59ee0e
added access method for background color
Claus Gittinger <cg@exept.de>
parents:
248
diff
changeset
|
19 |
poolDictionaries:'' |
35d5ba59ee0e
added access method for background color
Claus Gittinger <cg@exept.de>
parents:
248
diff
changeset
|
20 |
category:'Views-DialogBoxes' |
84 | 21 |
! |
22 |
||
879 | 23 |
!AboutBox class methodsFor:'documentation'! |
84 | 24 |
|
198 | 25 |
copyright |
26 |
" |
|
27 |
COPYRIGHT (c) 1995 by Claus Gittinger |
|
28 |
All Rights Reserved |
|
29 |
||
30 |
This software is furnished under a license and may be used |
|
31 |
only in accordance with the terms of that license and with the |
|
32 |
inclusion of the above copyright notice. This software may not |
|
33 |
be provided or otherwise made available to, or used by, any |
|
34 |
other person. No title to or ownership of the software is |
|
35 |
hereby transferred. |
|
36 |
" |
|
84 | 37 |
! |
38 |
||
39 |
documentation |
|
40 |
" |
|
2700 | 41 |
A box specialized to show the ST/X about-information (also usable for Applications). |
498 | 42 |
As a speciality, this box automatically closes if left |
43 |
alone for a while. |
|
84 | 44 |
|
498 | 45 |
Can be subclasses for your own aboutBoxes; to do so, redefine |
46 |
#defaultIcon and #aboutText. |
|
92 | 47 |
|
498 | 48 |
examples: |
49 |
AboutBox new open |
|
50 |
||
51 |
AboutBox new showAtPointer |
|
84 | 52 |
" |
2700 | 53 |
! |
54 |
||
55 |
examples |
|
56 |
" |
|
57 |
[exBegin] |
|
58 |
|box| |
|
59 |
||
60 |
box := AboutBox new. |
|
61 |
box autoHideAfter:10 with:[]. |
|
62 |
box showAtCenter |
|
63 |
[exEnd] |
|
64 |
||
65 |
[exBegin] |
|
66 |
|box| |
|
67 |
||
68 |
box := AboutBox title:'About me'. |
|
5333 | 69 |
box image:((Smalltalk |
70 |
bitmapFromFileNamed:'gifImages/claus.gif' |
|
71 |
inPackage:'stx:goodies') |
|
72 |
magnifiedTo:100@100). |
|
2700 | 73 |
box label:'Example'. |
74 |
box autoHideAfter:10 with:[]. |
|
75 |
box showAtPointer. |
|
76 |
[exEnd] |
|
77 |
" |
|
84 | 78 |
! ! |
79 |
||
879 | 80 |
!AboutBox class methodsFor:'defaults'! |
84 | 81 |
|
92 | 82 |
aboutText |
498 | 83 |
"return a string to be shown in the box. |
84 |
Can be redefined in custom subclasses." |
|
125 | 85 |
|
8701 | 86 |
|paddedLabelWith distributor expiration machine info resources| |
7795 | 87 |
|
88 |
resources := self classResources. |
|
179
f464e3c75104
if nonEmpty, display distributorString
Claus Gittinger <cg@exept.de>
parents:
165
diff
changeset
|
89 |
|
8701 | 90 |
paddedLabelWith := |
91 |
[:label :value | |
|
92 |
(((resources string:label) , ' ') paddedTo:20 with:$.) , ' ' , value |
|
93 |
]. |
|
94 |
||
693 | 95 |
distributor := Smalltalk distributorString. |
96 |
distributor notEmpty ifTrue:[ |
|
8701 | 97 |
distributor := paddedLabelWith value:'Distributor' value:distributor |
708
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
98 |
]. |
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
99 |
expiration := Smalltalk expirationTime. |
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
100 |
expiration notNil ifTrue:[ |
8701 | 101 |
expiration := paddedLabelWith value:'Expires' value:expiration |
708
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
102 |
] ifFalse:[ |
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
103 |
expiration := ''. |
693 | 104 |
]. |
1797 | 105 |
machine := OperatingSystem getHostName. |
106 |
info := OperatingSystem getSystemInfo. |
|
107 |
(info includesKey:#machine) ifTrue:[ |
|
108 |
machine := machine , ' (' , (info at:#machine) , ')' |
|
109 |
]. |
|
179
f464e3c75104
if nonEmpty, display distributorString
Claus Gittinger <cg@exept.de>
parents:
165
diff
changeset
|
110 |
|
92 | 111 |
^ |
7721 | 112 |
'Smalltalk/X |
92 | 113 |
|
16233 | 114 |
' , (paddedLabelWith value:'Version' value:Smalltalk versionString) , |
498 | 115 |
' (' , Smalltalk versionDate printString , ') |
708
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
116 |
', distributor, ' |
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
117 |
', expiration , ' |
8701 | 118 |
' , (paddedLabelWith value:'Release ID' value:Smalltalk releaseIdentification) , ' |
12559 | 119 |
' , (paddedLabelWith value:'Configuration' value:Smalltalk configuration) , ' (' , (ExternalAddress pointerSize * 8) printString,'bit) |
8701 | 120 |
' , (paddedLabelWith value:'Running on' value:machine) , ' |
121 |
' , (paddedLabelWith value:'Started at' value:Smalltalk imageStartTime printString) , ' |
|
92 | 122 |
|
179
f464e3c75104
if nonEmpty, display distributorString
Claus Gittinger <cg@exept.de>
parents:
165
diff
changeset
|
123 |
' , Smalltalk copyrightString , ' |
f464e3c75104
if nonEmpty, display distributorString
Claus Gittinger <cg@exept.de>
parents:
165
diff
changeset
|
124 |
|
693 | 125 |
' |
179
f464e3c75104
if nonEmpty, display distributorString
Claus Gittinger <cg@exept.de>
parents:
165
diff
changeset
|
126 |
|
7721 | 127 |
"Modified: / 06-09-1996 / 10:11:08 / stefan" |
7795 | 128 |
"Modified: / 16-04-2007 / 16:17:34 / cg" |
198 | 129 |
! |
130 |
||
2727 | 131 |
defaultGreen |
132 |
"return the boxes default green color (eXept green)." |
|
133 |
||
134 |
DefaultGreen notNil ifTrue:[^ DefaultGreen]. |
|
135 |
^ Color red:0 green:80 blue:20 |
|
136 |
! |
|
137 |
||
198 | 138 |
defaultIcon |
16942 | 139 |
"return a Smalltalk/X icon. |
498 | 140 |
Can be redefined in custom subclasses." |
198 | 141 |
|
9801 | 142 |
<resource: #programImage> |
498 | 143 |
|
9801 | 144 |
^ Icon stxIconTransparent3. |
498 | 145 |
! |
146 |
||
147 |
defaultLabel |
|
148 |
"return the boxes default window title." |
|
149 |
||
6625 | 150 |
^ 'About...' |
498 | 151 |
|
152 |
"Modified: 23.4.1996 / 17:09:48 / cg" |
|
153 |
"Created: 23.4.1996 / 17:11:46 / cg" |
|
84 | 154 |
! ! |
155 |
||
8988 | 156 |
!AboutBox class methodsFor:'image specs'! |
157 |
||
158 |
stxIconTemplate |
|
159 |
"This resource specification was automatically generated |
|
160 |
by the ImageEditor of ST/X." |
|
161 |
||
162 |
"Do not manually edit this!! If it is corrupted, |
|
163 |
the ImageEditor may not be able to read the specification." |
|
164 |
||
165 |
" |
|
166 |
self stxIconTemplate inspect |
|
167 |
ImageEditor openOnClass:self andSelector:#stxIconTemplate |
|
168 |
Icon flushCachedIcons |
|
169 |
" |
|
170 |
||
171 |
<resource: #image> |
|
172 |
||
173 |
^Icon |
|
174 |
constantNamed:'AboutBox class stxIconTemplate' |
|
16552 | 175 |
ifAbsentPut:[(Depth1Image width:48 height:48) bits:(ByteArray fromPackedString:' |
8988 | 176 |
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ |
177 |
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ |
|
178 |
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ |
|
16552 | 179 |
@@@@@@@@@@@@@@@@@@@@@@@@') |
180 |
colorMapFromArray:#[0 0 0] |
|
181 |
mask:((ImageMask width:48 height:48) bits:(ByteArray fromPackedString:' |
|
8988 | 182 |
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@G@@@A @@O @@C@@@O @@F@@@O @@L@@@O0@@\@@@O0@@8@@@G0@A0@@@G8@C @@@C8@G@@@@C<@N@@ |
183 |
@@A<@\@@@@A>@8@@@@@>A0@@@@@_C @@@@@_G @@@@@O/@@@@@@O>@@@@@@G<@@@@@@G8@@@@@@C8@@@@@@G8@@@@@@O<@@@@@@_<@@@@@@>^@@@@@A<N@@@ |
|
184 |
@@C8O@@@@@O0G @@@@_ C @@@@?@A0@@@A>@A0@@@C<@@8@@@O8@@\@@@_0@@L@@@? @@N@@@? @@F@@@?@@@C@@@^@@@A@@@@@@@@ @@@@@@@@@@@@@@@@@ |
|
16552 | 185 |
@@@@@@@@@@@@@@@@@@@@@@@@'); yourself); yourself] |
8988 | 186 |
! ! |
187 |
||
84 | 188 |
!AboutBox methodsFor:'initialization'! |
189 |
||
498 | 190 |
initialize |
2727 | 191 |
"setup the box; change all of my components viewBackground to some darkish grey." |
498 | 192 |
|
16245 | 193 |
|dark green lbl| |
84 | 194 |
|
195 |
super initialize. |
|
196 |
||
498 | 197 |
"/ self label:'About ...'. |
84 | 198 |
|
2727 | 199 |
green := self class defaultGreen. |
7961
f5545f9cf057
aboutToObenBoxNotification for aboutBox
Claus Gittinger <cg@exept.de>
parents:
7839
diff
changeset
|
200 |
dark := Color grey:20. |
16245 | 201 |
device hasColors ifFalse:[ |
202 |
device hasGrayscales ifTrue:[ |
|
2727 | 203 |
green := Color brightness:(green brightness). |
204 |
dark := Color brightness:(dark brightness). |
|
205 |
] ifFalse:[ |
|
13958 | 206 |
green := self whiteColor. |
207 |
dark := self blackColor. |
|
2727 | 208 |
] |
84 | 209 |
]. |
210 |
||
452
33ce1b3cd502
oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents:
451
diff
changeset
|
211 |
self withAllSubViewsDo:[:s | s viewBackground:dark]. |
248 | 212 |
|
5834
2a6457a7d2d7
Use #image: instead of obsolete #form:
Stefan Vogel <sv@exept.de>
parents:
5554
diff
changeset
|
213 |
self image:(self class defaultIcon). |
452
33ce1b3cd502
oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents:
451
diff
changeset
|
214 |
(lbl := self formLabel) viewBackground:dark. |
33ce1b3cd502
oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents:
451
diff
changeset
|
215 |
lbl foregroundColor:green backgroundColor:dark. |
33ce1b3cd502
oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents:
451
diff
changeset
|
216 |
(lbl := self textLabel) viewBackground:dark. |
16746 | 217 |
lbl foregroundColor:self whiteColor backgroundColor:dark. |
452
33ce1b3cd502
oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents:
451
diff
changeset
|
218 |
|
33ce1b3cd502
oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents:
451
diff
changeset
|
219 |
self title:(self class aboutText). |
6625 | 220 |
self okText:(resources string:'Close'). |
452
33ce1b3cd502
oops - the last one was wrong
Claus Gittinger <cg@exept.de>
parents:
451
diff
changeset
|
221 |
|
1592 | 222 |
"Modified: / 12.6.1998 / 11:48:23 / cg" |
84 | 223 |
! ! |
224 |
||
4864 | 225 |
!AboutBox methodsFor:'show & hide'! |
84 | 226 |
|
227 |
show |
|
498 | 228 |
"show the box. |
229 |
Redefined to automatically hide myself after some time" |
|
100 | 230 |
|
708
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
231 |
self autoHideAfter:15 with:[]. |
84 | 232 |
super showAtCenter. |
233 |
||
234 |
" |
|
235 |
AboutBox new show |
|
236 |
" |
|
498 | 237 |
|
238 |
"Modified: 23.4.1996 / 17:10:03 / cg" |
|
708
f89ff543ea18
Display expiration time, if apropriate.
Stefan Vogel <sv@exept.de>
parents:
693
diff
changeset
|
239 |
"Modified: 6.9.1996 / 09:47:10 / stefan" |
84 | 240 |
! ! |
241 |
||
879 | 242 |
!AboutBox class methodsFor:'documentation'! |
248 | 243 |
|
244 |
version |
|
16026 | 245 |
^ '$Header$' |
8988 | 246 |
! |
247 |
||
248 |
version_CVS |
|
16026 | 249 |
^ '$Header$' |
248 | 250 |
! ! |
12559 | 251 |