GraphicsContext.st
changeset 4430 f370586f73fd
parent 4396 bd626d040e1a
child 4777 7902dad96857
--- a/GraphicsContext.st	Fri Sep 30 18:34:26 2005 +0200
+++ b/GraphicsContext.st	Wed Oct 05 11:18:00 2005 +0200
@@ -2010,6 +2010,42 @@
     self fillArcX:x y:y width:w height:h from:startAngle angle:angle
 
     "Modified: 8.5.1996 / 08:47:52 / cg"
+!
+
+fillRoundRectangleX:left y:top width:width height:height wCorner:wCorn hCorner:hCorn
+    |right bottom wC hC wHalf hHalf|
+
+    right := left + width - 1.
+    bottom := top + height - 1.
+
+    wC := wCorn.
+    hC := hCorn.
+
+    wHalf := wC / 2.
+    hHalf := hC / 2.
+
+    "top left arc"
+    self fillArcX:left y:top width:wC height:hC from:90 angle:90.
+    "top right arc"
+    self fillArcX:(right - wC) y:top width:wC height:hC from:0 angle:90.
+    "bottom right arc"
+    self fillArcX:(right - wC - 1) y:(bottom - hC) width:wC height:hC from:270 angle:90.
+    "bottom left arc"
+    self fillArcX:left y:(bottom - hC + 1) width:wC height:hC from:180 angle:90.
+
+    "center rectangle"
+    self fillRectangleX:(left + wHalf) y:top width:(width - wHalf - wHalf) height:height.
+    "left partial rectangle"
+    self fillRectangleX:left y:top+hHalf width:wHalf height:(height-hHalf-hHalf).
+    "right partial rectangle"
+    self fillRectangleX:right-wHalf y:top+hHalf width:wHalf height:(height-hHalf-hHalf).
+
+    "
+     |v|
+
+     (v := View new) extent:200@200; openAndWait.
+     v fillRoundRectangleX:10 y:10 width:100 height:100 wCorner:20 hCorner:20
+    "
 ! !
 
 !GraphicsContext methodsFor:'drawing in device coordinates'!
@@ -2365,7 +2401,7 @@
 !GraphicsContext class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/GraphicsContext.st,v 1.110 2005-06-29 11:40:16 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview/GraphicsContext.st,v 1.111 2005-10-05 09:18:00 cg Exp $'
 ! !
 
 GraphicsContext initialize!