[graphic-forms-cvs] r141 - trunk/src/uitoolkit/widgets

junrue at common-lisp.net junrue at common-lisp.net
Tue May 23 04:23:19 UTC 2006


Author: junrue
Date: Tue May 23 00:23:19 2006
New Revision: 141

Modified:
   trunk/src/uitoolkit/widgets/button.lisp
   trunk/src/uitoolkit/widgets/label.lisp
Log:
implemented text-baseline for buttons

Modified: trunk/src/uitoolkit/widgets/button.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/button.lisp	(original)
+++ trunk/src/uitoolkit/widgets/button.lisp	Tue May 23 00:23:19 2006
@@ -101,3 +101,8 @@
 
 (defmethod (setf text) (str (self button))
   (set-widget-text self str))
+
+(defmethod text-baseline ((self button))
+  (let ((font (gfg:font self))
+        (gc (make-instance 'gfg:graphics-context :widget self)))
+    (+ +vertical-button-text-margin+ (gfg:ascent (gfg:metrics gc font)))))

Modified: trunk/src/uitoolkit/widgets/label.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/label.lisp	(original)
+++ trunk/src/uitoolkit/widgets/label.lisp	Tue May 23 00:23:19 2006
@@ -217,7 +217,7 @@
       (if image
         (gfs:size-height (gfg:size image))
         0))
-    (let* ((font (font self))
-           (gc (make-instance 'gfg:graphics-context :widget self))
-           (b-width (border-width self)))
+    (let ((font (gfg:font self))
+          (gc (make-instance 'gfg:graphics-context :widget self))
+          (b-width (border-width self)))
       (+ b-width (gfg:ascent (gfg:metrics gc font))))))



More information about the Graphic-forms-cvs mailing list