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