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 -@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)