Author: junrue Date: Thu Apr 5 00:30:16 2007 New Revision: 464 Modified: trunk/NEWS.txt trunk/src/uitoolkit/system/system-constants.lisp trunk/src/uitoolkit/widgets/progress-bar.lisp trunk/src/uitoolkit/widgets/widget-classes.lisp Log: further implementation of progress-bar control Modified: trunk/NEWS.txt ============================================================================== --- trunk/NEWS.txt (original) +++ trunk/NEWS.txt Thu Apr 5 00:30:16 2007 @@ -6,10 +6,14 @@ . Upgraded to LispWorks 5.0.1 (note: 4.4.6 is no longer supported) -. Implemented simple-mode status bars, which have a single text field. +. Implemented GFW:STATUS-BAR which currently allow a single text field. Multi-part status bars, and nested widget support, will be added in a future release. +. Implemented GFW:PROGRESS-BAR, which provides visual progress feedback. This + control can be configured for horizontal or vertical orientation, and can + display a segmented or continuous indicator. + . Simplified the mechanism for specifying fixed, non-resizable windows by adding a new GFW:TOP-LEVEL style called :FIXED-SIZE and enhancing GFW:PACK to do the right thing if that style flag has been specified. Modified: trunk/src/uitoolkit/system/system-constants.lisp ============================================================================== --- trunk/src/uitoolkit/system/system-constants.lisp (original) +++ trunk/src/uitoolkit/system/system-constants.lisp Thu Apr 5 00:30:16 2007 @@ -869,6 +869,8 @@ (defconstant +pbm-setstate+ #x0410) ; (WM_USER+16) (defconstant +pbm-getstate+ #x0411) ; (WM_USER+17) +(defconstant +pbs-smooth+ #x01) +(defconstant +pbs-vertical+ #x04) (defconstant +pbs-marquee+ #x08) (defconstant +pbs-smoothreverse+ #x10) Modified: trunk/src/uitoolkit/widgets/progress-bar.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/progress-bar.lisp (original) +++ trunk/src/uitoolkit/widgets/progress-bar.lisp Thu Apr 5 00:30:16 2007 @@ -1,5 +1,5 @@ ;;;; -;;;; progressbar.lisp +;;;; progress-bar.lisp ;;;; ;;;; Copyright (C) 2007, Jack D. Unrue ;;;; All rights reserved. @@ -54,6 +54,10 @@ "Returns the step increment for a progress bar." (gfs::send-message (gfs:handle p-bar) gfs::+pbm-getstep+ 0 0)) +(declaim (inline pb-horz-flags)) +(defun pb-horz-flags (flags) + (logand flags (lognot gfs::+pbs-vertical+))) + (declaim (inline pb-set-pos-absolute)) (defun pb-set-pos-absolute (p-bar pos) "Sets the absolute position of a progress bar and redraws it; returns the previous position." @@ -78,7 +82,50 @@ "Sets the step increment for a progress bar; returns the previous increment." (gfs::send-message (gfs:handle p-bar) gfs::+pbm-setstep+ (logand increment #xFFFF) 0)) +(declaim (inline pb-smooth-flags)) +(defun pb-smooth-flags (flags) + (logior flags gfs::+pbs-smooth+)) + (declaim (inline pb-stepit)) (defun pb-stepit (p-bar) "Advances the progress bar's position by its step increment and redraws it; returns the previous position." (gfs::send-message (gfs:handle p-bar) gfs::+pbm-stepit+ 0 0)) + +(declaim (inline pb-vert-flags)) +(defun pb-vert-flags (flags) + (logior flags gfs::+pbs-vertical+)) + +;;; +;;; methods +;;; + +(defmethod compute-style-flags ((pbar progress-bar) &rest extra-data) + (declare (ignore extra-data)) + (let ((std-flags +default-child-style+) + (style (style-of pbar))) + (loop for sym in style + do (ecase sym + ;; primary progress-bar styles + ;; + (:horizontal (setf std-flags (pb-horz-flags std-flags))) + (:vertical (setf std-flags (pb-vert-flags std-flags))) + + ;; styles that can be combined + ;; + (:smooth (setf std-flags (pb-smooth-flags std-flags))))) + (values std-flags 0))) + +(defmethod initialize-instance :after ((pbar progress-bar) &key parent &allow-other-keys) + (create-control pbar parent "" gfs::+icc-win95-classes+)) + +(defmethod preferred-size ((pbar progress-bar) width-hint height-hint) + (let ((size (gfs:make-size :width width-hint :height height-hint)) + (b-width (* (border-width pbar) 2))) + (if (<= width-hint 0) + (setf (gfs:size-width size) +default-widget-width+)) + (incf (gfs:size-width size) b-width) + (if (<= height-hint 0) + (setf (gfs:size-height size) + (floor (* (gfs::get-system-metrics gfs::+sm-cyvscroll+) 3) 4))) + (incf (gfs:size-height size) b-width) + size)) Modified: trunk/src/uitoolkit/widgets/widget-classes.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-classes.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-classes.lisp Thu Apr 5 00:30:16 2007 @@ -218,7 +218,7 @@ (item-manager)) (define-control-class - progressbar + progress-bar "msctls_progress" 'event-select "This class represents controls that provide visual feedback for progress.")