Author: junrue Date: Tue Jun 27 23:22:46 2006 New Revision: 165
Modified: trunk/src/tests/uitoolkit/windlg.lisp trunk/src/uitoolkit/widgets/button.lisp trunk/src/uitoolkit/widgets/edit.lisp trunk/src/uitoolkit/widgets/widget-utils.lisp Log: more edit control testing via windlg
Modified: trunk/src/tests/uitoolkit/windlg.lisp ============================================================================== --- trunk/src/tests/uitoolkit/windlg.lisp (original) +++ trunk/src/tests/uitoolkit/windlg.lisp Tue Jun 27 23:22:46 2006 @@ -118,19 +118,6 @@ :initial-directory #P"c:/") (print paths)))
-(defclass dlg-test-panel (gfw:panel) ()) - -(defmethod gfw:preferred-size ((win dlg-test-panel) width-hint height-hint) - (declare (ignore width-hint height-hint)) - (gfs:make-size :width 280 :height 200)) - -(defmethod gfw:event-paint ((self gfw:event-dispatcher) (panel dlg-test-panel) time gc rect) - (declare (ignore time rect)) - (let ((parent (gfw:parent panel))) - (setf (gfg:background-color gc) (gfg:background-color parent)) - (setf (gfg:foreground-color gc) (gfg:background-color parent)) - (gfg:draw-filled-rectangle gc (gfs:make-rectangle :size (gfw:size panel))))) - (defclass dialog-events (gfw:event-dispatcher) ())
(defmethod gfw:event-close ((disp dialog-events) (dlg gfw:dialog) time) @@ -144,13 +131,42 @@ :dispatcher (make-instance 'dialog-events) :layout (make-instance 'gfw:flow-layout :margins 8 - :spacing 4 + :spacing 8 :style '(:horizontal)) :style style :text title)) - (panel (make-instance 'dlg-test-panel - :style '(:border) - :parent dlg)) + (left-panel (make-instance 'gfw:panel + :layout (make-instance 'gfw:flow-layout + :spacing 4 + :style '(:vertical)) + :parent dlg)) + (name-label (make-instance 'gfw:label + :text "Name:" + :parent left-panel)) + (name-edit (make-instance 'gfw:edit + :text "WWWWWWWWWWWWWWWWWWWWWWWW" + :parent left-panel)) + (serial-label (make-instance 'gfw:label + :text "Serial Number:" + :parent left-panel)) + (serial-edit (make-instance 'gfw:edit + :style '(:read-only) + :text "323K DSKL3 DSKE23" + :parent left-panel)) + (pw-label (make-instance 'gfw:label + :text "Password:" + :parent left-panel)) + (pw-edit (make-instance 'gfw:edit + :style '(:mask-characters) + :text "WWWWWWWWWWWWWWWWWWWWWWWW" + :parent left-panel)) + (desc-label (make-instance 'gfw:label + :text "Description:" + :parent left-panel)) + (desc-edit (make-instance 'gfw:edit + :style '(:multi-line :auto-hscroll :auto-vscroll :vertical-scrollbar :want-return) + :text (format nil "WWWWWWWWWWWWWWWWWWWWWWWW~%W~%W~%W~%W~%W") + :parent left-panel)) (btn-panel (make-instance 'gfw:panel :layout (make-instance 'gfw:flow-layout :spacing 4 @@ -170,8 +186,11 @@ :style '(:cancel-button) :text "Cancel" :parent btn-panel))) - (declare (ignore panel ok-btn cancel-btn)) + (declare (ignore name-label serial-label serial-edit pw-label desc-label ok-btn cancel-btn)) (gfw:pack dlg) + (setf (gfw:text name-edit) "" + (gfw:text pw-edit) "" + (gfw:text desc-edit) "") (gfw:center-on-owner dlg) (gfw:show dlg t) dlg))
Modified: trunk/src/uitoolkit/widgets/button.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/button.lisp (original) +++ trunk/src/uitoolkit/widgets/button.lisp Tue Jun 27 23:22:46 2006 @@ -42,7 +42,7 @@
(defmethod compute-style-flags ((self button) &rest extra-data) (declare (ignore extra-data)) - (let ((std-flags +default-child-style+) + (let ((std-flags (logior +default-child-style+ gfs::+ws-tabstop+)) (style (style-of self))) (loop for sym in style do (cond
Modified: trunk/src/uitoolkit/widgets/edit.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/edit.lisp (original) +++ trunk/src/uitoolkit/widgets/edit.lisp Tue Jun 27 23:22:46 2006 @@ -42,22 +42,26 @@
(defmethod compute-style-flags ((self edit) &rest extra-data) (declare (ignore extra-data)) - (let ((std-flags +default-child-style+) + (let ((std-flags (logior +default-child-style+ gfs::+ws-tabstop+)) (style (style-of self))) (loop for sym in style do (ecase sym ;; primary edit styles ;; - (:multi-line (setf std-flags (logior +default-child-style+ - gfs::+es-multiline+))) + (:multi-line (setf std-flags (logior +default-child-style+ + gfs::+ws-tabstop+ + gfs::+es-multiline+))) ;; styles that can be combined ;; - (:auto-hscroll (setf std-flags (logior std-flags gfs::+es-autohscroll+))) - (:auto-vscroll (setf std-flags (logior std-flags gfs::+es-autovscroll+))) - (:mask-characters (setf std-flags (logior std-flags gfs::+es-password+))) - (:no-hide-selection (setf std-flags (logior std-flags gfs::+es-nohidesel+))) - (:read-only (setf std-flags (logior std-flags gfs::+es-readonly+))) - (:want-return (setf std-flags (logior std-flags gfs::+es-wantreturn+))))) + (:auto-hscroll (setf std-flags (logior std-flags gfs::+es-autohscroll+))) + (:auto-vscroll (setf std-flags (logior std-flags gfs::+es-autovscroll+))) + (:horizontal-scrollbar (setf std-flags (logior std-flags gfs::+ws-hscroll+))) + (:mask-characters (setf std-flags (logior std-flags gfs::+es-password+))) + (:no-border ) + (:no-hide-selection (setf std-flags (logior std-flags gfs::+es-nohidesel+))) + (:read-only (setf std-flags (logior std-flags gfs::+es-readonly+))) + (:vertical-scrollbar (setf std-flags (logior std-flags gfs::+ws-vscroll+))) + (:want-return (setf std-flags (logior std-flags gfs::+es-wantreturn+))))) (if (not (find :multi-line style)) (setf std-flags (logior std-flags gfs::+es-autohscroll+))) (values std-flags (if (find :no-border style) 0 gfs::+ws-ex-clientedge+))))
Modified: trunk/src/uitoolkit/widgets/widget-utils.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-utils.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-utils.lisp Tue Jun 27 23:22:46 2006 @@ -92,7 +92,7 @@ (let ((hwnd (gfs::create-window ex-style cname-ptr title-ptr - (if child-id (logior std-style gfs::+ws-tabstop+) std-style) + std-style gfs::+cw-usedefault+ gfs::+cw-usedefault+ gfs::+cw-usedefault+