[graphic-forms-cvs] r125 - in trunk/src: tests/uitoolkit uitoolkit/system uitoolkit/widgets

[junrue at common-lisp.net]

Author: junrue
Date: Wed May 10 22:49:06 2006
New Revision: 125

Modified:
   trunk/src/tests/uitoolkit/windlg.lisp
   trunk/src/uitoolkit/system/user32.lisp
   trunk/src/uitoolkit/widgets/widget.lisp
   trunk/src/uitoolkit/widgets/window.lisp
Log:
rewrote compute-outer-size in terms of AdjustWindowRectEx, which bases its calculation on window styles

Modified: trunk/src/tests/uitoolkit/windlg.lisp
==============================================================================
--- trunk/src/tests/uitoolkit/windlg.lisp	(original)
+++ trunk/src/tests/uitoolkit/windlg.lisp	Wed May 10 22:49:06 2006
@@ -122,7 +122,7 @@
 
 (defmethod gfw:preferred-size ((win dlg-test-panel) width-hint height-hint)
   (declare (ignore width-hint height-hint))
-  (gfs:make-size :width 180 :height 100))
+  (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))
@@ -137,7 +137,7 @@
                                         :layout (make-instance 'gfw:flow-layout
                                                                :margins 8
                                                                :spacing 4
-                                                               :style '(:vertical))
+                                                               :style '(:horizontal))
                                         :style '(:modal)))
          (panel (make-instance 'dlg-test-panel
                                :style '(:border)

Modified: trunk/src/uitoolkit/system/user32.lisp
==============================================================================
--- trunk/src/uitoolkit/system/user32.lisp	(original)
+++ trunk/src/uitoolkit/system/user32.lisp	Wed May 10 22:49:06 2006
@@ -39,6 +39,14 @@
 (load-foreign-library "user32.dll")
 
 (defcfun
+  ("AdjustWindowRectEx" adjust-window-rect)
+  BOOL
+  (rect LPTR)
+  (style LONG)
+  (menu BOOL)
+  (exstyle LONG))
+
+(defcfun
   ("BeginDeferWindowPos" begin-defer-window-pos)
   HANDLE
   (numwin INT))

Modified: trunk/src/uitoolkit/widgets/widget.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/widget.lisp	(original)
+++ trunk/src/uitoolkit/widgets/widget.lisp	Wed May 10 22:49:06 2006
@@ -86,10 +86,15 @@
 (defmethod border-width ((widget widget))
   (let* ((hwnd (gfs:handle widget))
          (bits (gfs::get-window-long hwnd gfs::+gwl-exstyle+)))
-    (when (logand bits gfs::+ws-ex-clientedge+)
-      (return-from border-width (gfs::get-system-metrics gfs::+sm-cxedge+)))
-    (when (logand bits gfs::+ws-ex-staticedge+)
-      (return-from border-width (gfs::get-system-metrics gfs::+sm-cxborder+)))
+    (cond
+      ((/= (logand bits gfs::+ws-ex-clientedge+) 0)
+        (return-from border-width (gfs::get-system-metrics gfs::+sm-cxedge+)))
+      ((/= (logand bits gfs::+ws-ex-dlgmodalframe+) 0)
+        (return-from border-width (gfs::get-system-metrics gfs::+sm-cxdlgframe+)))
+      ((/= (logand bits gfs::+ws-ex-staticedge+) 0)
+        (return-from border-width (gfs::get-system-metrics gfs::+sm-cxborder+)))
+      ((/= (logand bits gfs::+ws-ex-windowedge+) 0)
+        (return-from border-width (gfs::get-system-metrics gfs::+sm-cxdlgframe+))))
     (setf bits (gfs::get-window-long hwnd gfs::+gwl-style+))
     (when (logand bits gfs::+ws-border+)
       (return-from border-width (gfs::get-system-metrics gfs::+sm-cxborder+)))

Modified: trunk/src/uitoolkit/widgets/window.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/window.lisp	(original)
+++ trunk/src/uitoolkit/widgets/window.lisp	Wed May 10 22:49:06 2006
@@ -77,7 +77,6 @@
          (child (get-widget tc hwnd))
         (parent (get-widget tc (cffi:make-pointer lparam))))
     (unless (or (null child) (null parent))
-(format t "~a~%" child)
       (call-child-visitor-func tc parent child)))
   1)
 
@@ -168,17 +167,22 @@
     color))
 
 (defmethod compute-outer-size ((win window) desired-client-size)
-  ;; TODO: consider reimplementing this with AdjustWindowRect
-  ;;
-  (let ((client-sz (client-size win))
-        (outer-sz (size win))
-        (trim-sz (gfs:make-size :width (gfs:size-width desired-client-size)
-                                :height (gfs:size-height desired-client-size))))
-    (incf (gfs:size-width trim-sz) (- (gfs:size-width outer-sz)
-                                      (gfs:size-width client-sz)))
-    (incf (gfs:size-height trim-sz) (- (gfs:size-height outer-sz)
-                                       (gfs:size-height client-sz)))
-    trim-sz))
+  (let ((hwnd (gfs:handle win))
+        (new-size (gfs:make-size)))
+    (cffi:with-foreign-object (rect-ptr 'gfs::rect)
+      (cffi:with-foreign-slots ((gfs::left gfs::top gfs::right gfs::bottom) rect-ptr gfs::rect)
+        (setf gfs::left   0
+              gfs::top    0
+              gfs::right  (gfs:size-width desired-client-size)
+              gfs::bottom (gfs:size-height desired-client-size))
+        (if (zerop (gfs::adjust-window-rect rect-ptr
+                                            (gfs::get-window-long hwnd gfs::+gwl-style+)
+                                            (if (cffi:null-pointer-p (gfs::get-menu hwnd)) 0 1)
+                                            (gfs::get-window-long hwnd gfs::+gwl-exstyle+)))
+          (error 'gfs:toolkit-error :detail "adjust-window-rect failed"))
+        (setf (gfs:size-width new-size)  (- gfs::right gfs::left)
+              (gfs:size-height new-size) (- gfs::bottom gfs::top))))
+    new-size))
 
 (defmethod enable-layout :before ((win window) flag)
   (declare (ignore flag))