added cursor #fromImage:
authorClaus Gittinger <cg@exept.de>
Tue, 04 Mar 1997 14:24:02 +0100
changeset 1414 492ba3d77d92
parent 1413 e1182f8efc7e
child 1415 040dcb4c8956
added cursor #fromImage:
Cursor.st
--- a/Cursor.st	Mon Mar 03 22:33:24 1997 +0100
+++ b/Cursor.st	Tue Mar 04 14:24:02 1997 +0100
@@ -297,6 +297,46 @@
     "Modified: 1.1.1970 / 13:57:27 / cg"
 !
 
+fromImage:anImage
+    "return a new cursor.
+     Source- and (optional) mask-Bits are taken from anImage;
+     hotSpot is center"
+
+    |mask sourceForm maskForm|
+
+    anImage depth ~~ 1 ifTrue:[
+        sourceForm := anImage asMonochromeFormOn:Screen current.
+    ] ifFalse:[
+        sourceForm := anImage asFormOn:Screen current.
+    ].
+    mask := anImage mask.
+    mask isNil ifTrue:[
+        maskForm := sourceForm 
+    ] ifFalse:[
+        mask depth ~~ 1 ifTrue:[
+            maskForm := mask asMonochromeFormOn:Screen current.
+        ] ifFalse:[
+            maskForm := mask asFormOn:Screen current
+        ]
+    ].
+    ^ self sourceForm:sourceForm
+             maskForm:maskForm
+                 hotX:(anImage width // 2)
+                 hotY:(anImage height // 2)
+
+    "
+     |i c|
+
+     i := Image fromFile:'bitmaps/xpmBitmaps/cursors/ul_br_arrow.xpm'.
+     c := Cursor fromImage:i.
+     WindowGroup activeGroup 
+         withCursor:c 
+         do:[(Delay forSeconds:5)wait]
+    "
+
+    "Modified: 4.3.1997 / 14:23:43 / cg"
+!
+
 imageArray:imageBits maskArray:maskBits
     "ST-80 compatible cursor creation - the extent is fixed to 16@16"
 
@@ -2006,6 +2046,6 @@
 !Cursor class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/Cursor.st,v 1.45 1997-01-16 17:12:37 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview/Cursor.st,v 1.46 1997-03-04 13:24:02 cg Exp $'
 ! !
 Cursor initialize!