[graphic-forms-cvs] r165 - in trunk/src: tests/uitoolkit uitoolkit/widgets
junrue at common-lisp.net
junrue at common-lisp.net
Wed Jun 28 03:22:46 UTC 2006
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+
More information about the Graphic-forms-cvs
mailing list