[graphic-forms-cvs] r450 - branches/graphic-forms-newtypes/src/uitoolkit/widgets

[junrue at common-lisp.net]

Author: junrue
Date: Thu Mar 29 22:26:27 2007
New Revision: 450

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

Modified: branches/graphic-forms-newtypes/src/uitoolkit/widgets/event.lisp
==============================================================================
--- branches/graphic-forms-newtypes/src/uitoolkit/widgets/event.lisp	(original)
+++ branches/graphic-forms-newtypes/src/uitoolkit/widgets/event.lisp	Thu Mar 29 22:26:27 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
-      (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))
+  (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)))
+        (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))