Growing Windows

I am having trouble saving and restoring the current window size to/from the
Registry. The restored window grows. See the code snippet below. The
problem area is likely in APP-DESTROY or possibly in RECT>REGISTRY,
RECT<REGISTRY.

I originally tried using GetClintRect with fixed-size corrections for the
title bar, etc. but that had the same problems and also seemed very klunky.
I thought that GetWindowRect returns the actual size of the entire window
(seems it aint so).

{ ========== PROBLEM CODE ========== }

CREATE APP-CLASS ,Z" Lissa"
CREATE APP-TITLE 64 ALLOT

: RECT>REGISTRY ( x y cx cy -- )
   GETREGKEY >R
   PAD !RECT
   PAD 4 CELLS APP-CLASS R@ WRITE-REG DROP
   R> RegCloseKey DROP ;

: RECT<REGISTRY ( -- x y cx cy )
   GETREGKEY >R
   PAD 4 CELLS APP-CLASS R@ READ-REG NIP IF
      10 10 600 600
   ELSE
      PAD @RECT
   THEN
   R> RegCloseKey DROP ;

: -APP ( - flag) 'MAIN @ [ 'MAIN @ ] LITERAL = ;

0 VALUE hAPP

: APP-DESTROY ( -- res )
    HWND PAD GetWindowRect DROP PAD @RECT RECT>REGISTRY
    0 TO hAPP -APP IF EXIT THEN 0 PostQuitMessage DROP 0 ;

: APP-CREATE ( -- res ) HWND 1 1000 0 SetTimer DROP 0 ;
: APP-CLOSE ( -- res )
        HWND 1 KillTimer DROP
          HWND DestroyWindow DROP 0 TO hAPP 0 ;

: APP-RESIZED ( - res)
        LPARAM HILO TO cxClient TO cyClient
        cxClient 2/ TO cxMid cyClient 2/ TO cyMid
        cxClient cyClient MIN 2/ 10 - 10 MAX TO LSIZE 0 ;

: REFRESH ( --) hAPP 0 1 InvalidateRect DROP ;

: RANDOM-RATIOS ( --)
   28 RND 1 MAX TO yRatio 28 RND 1 MAX TO xRatio ;

: APP-TIMER ( -- res)
   RANDOM-RATIOS
   xRatio yRatio = xRatio 1 = AND IF RANDOM-RATIOS THEN
   HWND GetDC DUP >R DRAWIT HWND R> ReleaseDC DROP
   REFRESH 0 ;

[SWITCH APP-MESSAGES DEFWINPROC ( msg -- res )
   WM_PAINT RUNS PAINTIT
   WM_TIMER RUNS APP-TIMER
   WM_DESTROY RUNS APP-DESTROY
   WM_CREATE RUNS APP-CREATE
   WM_CLOSE RUNS APP-CLOSE
   WM_SIZE RUNS APP-RESIZED
SWITCH]

:NONAME MSG LOWORD APP-MESSAGES ; 4 CB: WNDPROC

{
===========================================================================
                                  INITIALIZATION

===========================================================================
}

\ !!!!!!!!!!!! Version !!!!!!!!!!!!!!
S" LISSA Ver. 1.6 " APP-TITLE ZPLACE
\ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

CREATE AppName ,Z" rjn App"

: /APP-CLASS ( -- )
   256 R-ALLOC DUP >R
      [ 0
         CS_OWNDC OR
         CS_HREDRAW OR
         CS_VREDRAW OR
      ] LITERAL !+ \ class style
      WNDPROC !+ \ wndproc
      0 !+ \ class extra
      0 !+ \ window extra
      HINST !+ \ hinstance
      HINST 101 LoadIcon !+ \ Load Title Bar Icon
      NULL IDC_ARROW LoadCursor !+ \ arrow cursor
      WHITE_BRUSH GetStockObject !+ \ white background
      0 !+ \ no menu
      APP-CLASS !+ \ class name
   DROP R> RegisterClass DROP ;

WS_OVERLAPPEDWINDOW ( WS_VSCROLL OR)
CONSTANT APP-STYLE

: /APP-WINDOW ( cmdshow -- hwnd ) >R
      0 TO hAPP
      0 \ extended style
      APP-CLASS \ window class name
      APP-TITLE \ window caption
      APP-STYLE \ window style
      RECT<REGISTRY \ use position and size from
registry
\ 10 10 600 600 \ use fixed window position & size
      0 \ parent window handle
      0 \ window menu handle
      HINST \ program instance handle
      0 \ creation parameter
   CreateWindowEx ?DUP IF
      DUP TO hAPP
      DUP R> ShowWindow DROP
      DUP UpdateWindow DROP
   ELSE
      R> DROP
   THEN ;

( REMAINDER OF APPLICATION )
----------------------------------------------------------------------
sftalk_at_forth.com The SwiftForth programming discussion email list
To unsubscribe, send subject "unsubscribe sftalk" to listar_at_forth.com
For help with listar commands, send subject "help" to listar_at_forth.com
Archives are located at http://www.forth.com/sftalk -- check them out!
Search the archives! Visit http://www.forth.com/search for details.
Received on Wed Oct 23 2002 - 15:07:52 PDT