[graphic-forms-cvs] r108 - in trunk: docs/manual src/tests/uitoolkit src/uitoolkit/graphics src/uitoolkit/system

[junrue at common-lisp.net]

Author: junrue
Date: Wed Apr 26 11:46:18 2006
New Revision: 108

Modified:
   trunk/docs/manual/api.texinfo
   trunk/src/tests/uitoolkit/drawing-tester.lisp
   trunk/src/uitoolkit/graphics/graphics-context.lisp
   trunk/src/uitoolkit/system/gdi32.lisp
   trunk/src/uitoolkit/system/system-constants.lisp
Log:
implemented :transparent style for text drawing

Modified: trunk/docs/manual/api.texinfo
==============================================================================
--- trunk/docs/manual/api.texinfo	(original)
+++ trunk/docs/manual/api.texinfo	Wed Apr 26 11:46:18 2006
@@ -1244,15 +1244,15 @@
 following text style keywords:
 @table @code
 @item :mnemonic
-underline the mnemonic character (specified in the original string
-by preceding the character with an ampersand @samp{&})
+Underline the mnemonic character (specified in the original string
+by preceding the character with an ampersand @samp{&}).
 @item :tab
-expand tabs when the string is rendered; by default the tab-width
+Expand tabs when the string is rendered; by default the tab-width
 is 8 characters, but the optional @code{tab-width} parameter may
-be used to specify a different width
+be used to specify a different width.
 @item :transparent
- at emph{This style is not yet implemented.} the background of the
-rectangular area where text is drawn will not be modified
+The background of the rectangular area where text is drawn will not be
+modified.
 @end table
 @end deffn
 

Modified: trunk/src/tests/uitoolkit/drawing-tester.lisp
==============================================================================
--- trunk/src/tests/uitoolkit/drawing-tester.lisp	(original)
+++ trunk/src/tests/uitoolkit/drawing-tester.lisp	Wed Apr 26 11:46:18 2006
@@ -306,15 +306,13 @@
     (setf pnt (draw-a-string gc pnt (format nil "tab~ctab~ctab" #\Tab #\Tab) "Verdana" 10 nil '(:tab)))
     (setf pnt (draw-a-string gc pnt (format nil "even~cmore~ctabs" #\Tab #\Tab) "Verdana" 10 nil '(:tab)))
     (setf pnt (draw-a-string gc pnt " " "Verdana" 10 nil nil))
-    (setf pnt (draw-a-string gc pnt "and a &mnemonic" "Verdana" 10 nil '(:mnemonic)))))
+    (setf pnt (draw-a-string gc pnt "and a &mnemonic" "Verdana" 10 nil '(:mnemonic)))
 
-#|
     (setf pnt (draw-a-string gc pnt " " "Arial" 18 nil nil))
     (draw-a-string gc pnt "transparent" "Arial" 18 '(:bold) nil)
     (incf (gfs:point-x pnt) 50)
     (setf (gfg:foreground-color gc) gfg:*color-red*)
-    (draw-a-string gc pnt "text" "Arial" 10 '(:bold) '(:transparent))
-|#
+    (draw-a-string gc pnt "text" "Arial" 12 nil '(:transparent))))
 
 (defun select-text (disp item time rect)
   (declare (ignore disp time rect))

Modified: trunk/src/uitoolkit/graphics/graphics-context.lisp
==============================================================================
--- trunk/src/uitoolkit/graphics/graphics-context.lisp	(original)
+++ trunk/src/uitoolkit/graphics/graphics-context.lisp	Wed Apr 26 11:46:18 2006
@@ -437,7 +437,10 @@
   (if (gfs:disposed-p self)
     (error 'gfs:disposed-error))
   (let ((flags (compute-draw-text-style style))
-        (tb-width (if (null tab-width) 0 tab-width)))
+        (tb-width (if (null tab-width) 0 tab-width))
+        (old-bk-mode (gfs::get-bk-mode (gfs:handle self))))
+    (if (find :transparent style)
+      (gfs::set-bk-mode (gfs:handle self) gfs::+transparent+))
     (cffi:with-foreign-object (dt-ptr 'gfs::drawtextparams)
       (cffi:with-foreign-slots ((gfs::cbsize gfs::tablength gfs::leftmargin gfs::rightmargin)
                                 dt-ptr gfs::drawtextparams)
@@ -461,7 +464,8 @@
                                (length text)
                                rect-ptr
                                flags
-                               dt-ptr)))))))
+                               dt-ptr)
+            (gfs::set-bk-mode (gfs:handle self) old-bk-mode)))))))
 
 (defmethod (setf font) ((font font) (self graphics-context))
   (if (gfs:disposed-p self)

Modified: trunk/src/uitoolkit/system/gdi32.lisp
==============================================================================
--- trunk/src/uitoolkit/system/gdi32.lisp	(original)
+++ trunk/src/uitoolkit/system/gdi32.lisp	Wed Apr 26 11:46:18 2006
@@ -207,6 +207,11 @@
   (hdc HANDLE))
 
 (defcfun
+  ("GetBkMode" get-bk-mode)
+  INT
+  (hdc HANDLE))
+
+(defcfun
   ("GetDCBrushColor" get-dc-brush-color)
   COLORREF
   (hdc HANDLE))
@@ -365,6 +370,12 @@
   (color COLORREF))
 
 (defcfun
+  ("SetBkMode" set-bk-mode)
+  INT
+  (hdc HANDLE)
+  (mode INT))
+
+(defcfun
   ("SetDCBrushColor" set-dc-brush-color)
   COLORREF
   (hdc HANDLE)

Modified: trunk/src/uitoolkit/system/system-constants.lisp
==============================================================================
--- trunk/src/uitoolkit/system/system-constants.lisp	(original)
+++ trunk/src/uitoolkit/system/system-constants.lisp	Wed Apr 26 11:46:18 2006
@@ -926,3 +926,9 @@
 (defconstant +bltalignment+                   119)
 (defconstant +shadeblendcaps+                 120)
 (defconstant +colormgmtcaps+                  121)
+
+;;;
+;;; Background modes (Get/SetBkMode)
+;;;
+(defconstant +transparent+                      1)
+(defconstant +opaque+                           2)