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

[junrue at common-lisp.net]

Author: junrue
Date: Thu Mar 29 22:26:46 2007
New Revision: 451

Modified:
   trunk/src/uitoolkit/widgets/event.lisp
Log:
when processing WM_CTLCOLOR* messages, call the default wndproc rather than returning 0

Modified: trunk/src/uitoolkit/widgets/event.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/event.lisp	(original)
+++ trunk/src/uitoolkit/widgets/event.lisp	Thu Mar 29 22:26:46 2007
@@ -145,18 +145,17 @@
          0))))
 
 (defun process-ctlcolor-message (wparam lparam)
-  (let* ((widget (get-widget (thread-context) (cffi:make-pointer (logand #xFFFFFFFF lparam))))
-         (hdc (cffi:make-pointer wparam))
-         (bkgdcolor (brush-color-of widget))
-         (textcolor (text-color-of widget))
-         (ret-val 0))
-    (when widget
+  (let ((widget (get-widget (thread-context) (cffi:make-pointer (logand #xFFFFFFFF lparam))))
+        (hdc (cffi:make-pointer wparam)))
+    (if widget
+      (let ((bkgdcolor (brush-color-of widget))
+            (textcolor (text-color-of widget)))
       (if bkgdcolor
         (gfs::set-bk-color hdc (gfg:color->rgb bkgdcolor)))
       (if textcolor
         (gfs::set-text-color hdc (gfg:color->rgb textcolor)))
-      (setf ret-val (cffi:pointer-address (brush-handle-of widget))))
-    ret-val))
+        (cffi:pointer-address (brush-handle-of widget)))
+      0)))
 
 (defun dispatch-scroll-notification (widget axis wparam-lo)
   (let ((disp (dispatcher widget))
@@ -425,20 +424,28 @@
   0)
 
 (defmethod process-message (hwnd (msg (eql gfs::+wm-ctlcolorbtn+)) wparam lparam)
-  (declare (ignore hwnd))
-  (process-ctlcolor-message wparam lparam))
+  (let ((retval (process-ctlcolor-message wparam lparam)))
+    (if (zerop retval)
+      (gfs::def-window-proc hwnd msg wparam lparam)
+      retval)))
 
 (defmethod process-message (hwnd (msg (eql gfs::+wm-ctlcoloredit+)) wparam lparam)
-  (declare (ignore hwnd))
-  (process-ctlcolor-message wparam lparam))
+  (let ((retval (process-ctlcolor-message wparam lparam)))
+    (if (zerop retval)
+      (gfs::def-window-proc hwnd msg wparam lparam)
+      retval)))
 
 (defmethod process-message (hwnd (msg (eql gfs::+wm-ctlcolorlistbox+)) wparam lparam)
-  (declare (ignore hwnd))
-  (process-ctlcolor-message wparam lparam))
+  (let ((retval (process-ctlcolor-message wparam lparam)))
+    (if (zerop retval)
+      (gfs::def-window-proc hwnd msg wparam lparam)
+      retval)))
 
 (defmethod process-message (hwnd (msg (eql gfs::+wm-ctlcolorstatic+)) wparam lparam)
-  (declare (ignore hwnd))
-  (process-ctlcolor-message wparam lparam))
+  (let ((retval (process-ctlcolor-message wparam lparam)))
+    (if (zerop retval)
+      (gfs::def-window-proc hwnd msg wparam lparam)
+      retval)))
 
 (defmethod process-message (hwnd (msg (eql gfs::+wm-setcursor+)) wparam lparam)
   (let* ((widget (get-widget (thread-context) hwnd))