diff --git a/aclpc/acl-class.lisp b/aclpc/acl-class.lisp index 19db9ce5349d0a52d594e7111220e5090911507c..fd7d136f3859ac4a65ff7bb1f7358c19d92fb7d0 100644 --- a/aclpc/acl-class.lisp +++ b/aclpc/acl-class.lisp @@ -223,21 +223,16 @@ ;; Process WM_DRAWITEM (defun ondrawitem (window msg wparam lparam) - (declare (ignore wparam msg window)) - ;; someone who knows how to use the pc ff interface should get - ;; rid of all these memrefs! (cim 10/4/96) - (let ((hwnd (ct:ccallocate win:hwnd)) - (hdc (ct:ccallocate win:hdc)) - (state (sys:memref-int lparam 0 16 :unsigned-long)) - (rect (+ lparam 28))) - (setf (ct:handle-value win:hwnd hwnd) - (sys:memref-int lparam 0 20 :unsigned-long)) - (setf (ct:handle-value win:hdc hdc) - (sys:memref-int lparam 0 24 :unsigned-long)) - (let ((sheet (mirror->sheet *acl-port* hwnd))) - (when sheet - (silica::draw-picture-button (mirror->sheet *acl-port* hwnd) - state hdc rect))))) + (declare (ignore wparam msg window) + (optimize (speed 3) (safety 0) (debug 0))) + (macrolet ((lp-slot (name) + `(ff:fslot-value-typed 'drawitemstruct :c lparam ',name)) + (lp-addr (name) + `(ff:fslot-address-typed 'drawitemstruct :c lparam ',name))) + (let* ((hwnd (lp-slot hwnditem)) + (sheet (mirror->sheet *acl-port* hwnd))) + (when sheet + (silica::draw-picture-button sheet (lp-slot itemstate) (lp-slot hdc) (lp-addr rcitem)))))) (defmethod isa-pushbutton ((object t)) nil) (defmethod isa-pushbutton ((object push-button)) t) diff --git a/aclpc/winwidgh.lisp b/aclpc/winwidgh.lisp index 9d49a78ea4e92014006bc04365e4a5241d00aa45..1354f28afd565a8ecab478d69f8b4d81577265f1 100644 --- a/aclpc/winwidgh.lisp +++ b/aclpc/winwidgh.lisp @@ -42,6 +42,17 @@ (deftype unsigned-nat () `(unsigned-byte #-64bit 32 #+64bit 64)) +(ff:def-foreign-type drawitemstruct + (:struct (ctltype win:uint) + (ctlid win:uint) + (itemid win:uint) + (itemaction win:uint) + (itemstate win:uint) + (hwnditem win:hwnd) + (hdc win:hdc) + (rcitem win:rect) + (itemdata (* :void)))) + (ff:def-foreign-type browseinfo (:struct (hwndOwner win:hwnd) (pidlRoot win:lpcitemidlist)