Add new procedures ADJUST-WINDOW-RECT, GET-CLIENT-RECT,

WIN32-SCREEN-WIDTH, and WIN32-SCREEN-HEIGHT.  Fix bug in
GET-DEVICE-CAPS.

diff --git a/v7/src/win32/clipbrd.scm b/v7/src/win32/clipbrd.scm
index 3046c676366496b5500468f698954c3fac72955b..381353a666f943cd235e553fb6163385a9ddc00a 100644 (file)
--- a/v7/src/win32/clipbrd.scm
+++ b/v7/src/win32/clipbrd.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: clipbrd.scm,v 1.1 1996/02/28 16:29:56 adams Exp $
+;;;    $Id: clipbrd.scm,v 1.2 1996/10/07 18:17:17 cph Exp $
 ;;;
 ;;;    Copyright (c) 1995-96 Massachusetts Institute of Technology
 ;;;
@@ -41,9 +41,8 @@
 ;;; the GNU GENERAL PUBLIC LICENSE may apply to these parts.  A copy
 ;;; of that license should have been included along with this file.
 
-;;;; Clipboard access
-
-
+;;;; Miscellaneous Win32 Facilities
+\f
 (define (win32-clipboard-write-text s)
   (let ((clip? (open-clipboard 0)))
     (and clip?
@@ -75,4 +74,10 @@
                 (close-clipboard)
                 (let ((end (vector-8b-find-next-char s 0 maxlen 0)))
                   (set-string-length! s end))
-                s))))))
\ No newline at end of file
+                s))))))
+
+(define (win32-screen-width)
+  (get-system-metrics SM_CXSCREEN))
+
+(define (win32-screen-height)
+  (get-system-metrics SM_CYSCREEN))
\ No newline at end of file

diff --git a/v7/src/win32/wf_user.scm b/v7/src/win32/wf_user.scm
index ddce5b74a724353b00e28e588b57f6e6c6bde314..fd19aa2c303dc6dd7070606915f99697a1f26568 100644 (file)
--- a/v7/src/win32/wf_user.scm
+++ b/v7/src/win32/wf_user.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: wf_user.scm,v 1.6 1996/03/21 16:44:57 adams Exp $
+$Id: wf_user.scm,v 1.7 1996/10/07 18:17:03 cph Exp $
 
 Copyright (c) 1993-96 Massachusetts Institute of Technology
 
@@ -36,8 +36,8 @@ MIT in each case. |#
 ;;; package: (win32)
 
 (declare (usual-integrations))
-
-
+\f
+(define  adjust-window-rect)
 (define  append-menu)
 (define  arc)
 (define  begin-paint)
@@ -64,6 +64,7 @@ MIT in each case. |#
 (define  ellipse)
 (define  enable-menu-item)
 (define  end-paint)
+(define  get-client-rect)
 (define  get-clipboard-data)
 (define  get-dc)
 (define  get-device-caps)
@@ -128,13 +129,13 @@ MIT in each case. |#
 (define  track-popup-menu)
 (define  update-colors)
 (define  update-window)
-
-   
+\f
 (define (init-wf_user!)
 
   (set!  arc
     (windows-procedure
-       (Arc (hdc hdc) (leftrect int) (toprect int) (rightrect int) (bottomrect int)
+       (Arc (hdc hdc)
+            (leftrect int) (toprect int) (rightrect int) (bottomrect int)
             (xstartarc int) (ystartarc int) (xendarc int) (yendarc int))
       bool gdi32.dll "Arc"))
 
@@ -238,7 +239,7 @@ MIT in each case. |#
 
   (set!  get-device-caps
     (windows-procedure (get-device-caps (hdc hdc) (index int))
-      int user32.dll "GetDeviceCaps"))
+      int gdi32.dll "GetDeviceCaps"))
 
   (set!  get-focus
     (windows-procedure (get-focus) hwnd user32.dll "SetFocus"))
@@ -297,6 +298,16 @@ MIT in each case. |#
     (windows-procedure (get-system-metrics (index int))
       int user32.dll "GetSystemMetrics"))
 
+  (set!  adjust-window-rect
+    (windows-procedure (adjust-window-rect (rect rect)
+                                          (style dword)
+                                          (menu? bool))
+      bool user32.dll "AdjustWindowRect"))
+
+  (set!  get-client-rect
+    (windows-procedure (get-client-rect (window hwnd) (rect rect))
+      bool user32.dll "GetClientRect"))
+
   (set!  get-window-rect
     (windows-procedure (get-window-rect (window hwnd) (rect rect))
       bool user32.dll "GetWindowRect"))

diff --git a/v7/src/win32/win32.pkg b/v7/src/win32/win32.pkg
index c7aa4e327d2c35248efffa8a1d44bf217ff4aa8f..590b7baa397f57620903b6d6afeb716dcb2baa3c 100644 (file)
--- a/v7/src/win32/win32.pkg
+++ b/v7/src/win32/win32.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: win32.pkg,v 1.8 1996/03/21 16:44:43 adams Exp $
+$Id: win32.pkg,v 1.9 1996/10/07 18:17:08 cph Exp $
 
 Copyright (c) 1993-96 Massachusetts Institute of Technology
 
@@ -61,7 +61,9 @@ MIT in each case. |#
          module-entry/attempt-linkage
           start-message-polling-thread
          win32-clipboard-read-text
-         win32-clipboard-write-text)
+         win32-clipboard-write-text
+         win32-screen-height
+         win32-screen-width)
   (initialization (initialize-package!))
 )