\    File: WinBase.f
\  Author: Jeff Kelm
\ Created: 27-Aug-1998
\ Updated: 20-Nov-1998
\ Extensions and defines for Win32For



CR  .( Loading Extensions...)



\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\ Extensions to Win32For
\
: DEFAULTOF   \ defines a default condition for CASE structure (must be last!)
   POSTPONE DUP POSTPONE OF ; IMMEDIATE


\ conv. null-term. string to regular string (null not included in count)
: zCount ( szText -- a n)
   DUP 0 BEGIN  2DUP + C@  WHILE  1+  REPEAT  NIP ;


\ MAKELONG macro creates an unsigned 32-bit by concatenating two 16-bit values
: MAKELONG ( hi lo -- n)   SWAP word-join ;



\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\ Redefined ?WinError to give more debugging information
\
: (GetLastError) ( -- n)   Call GetLastError ;

: (FormatSystemMessage) ( error -- a n)
   >R  NULL  MAXSTRING  TEMP$ rel>abs  NULL  R>  NULL
      FORMAT_MESSAGE_FROM_SYSTEM  Call FormatMessage
   ?DUP IF  TEMP$ SWAP  ELSE  S" Error getting System Message"  THEN ;

: (?WinError) ( f)   \ show an error dialog box if f=FALSE/0
   0= IF  (GetLastError) (FormatSystemMessage)
          2DUP  2 - ( to drop CRLF pair)  CR TYPE CR  ( echo to console)
          DROP >R
          MB_OK MB_ICONWARNING OR  Z" Error" rel>abs
             R> rel>abs  NULL  Call MessageBox drop
    THEN ;


TRUE [IF]   \ add more debugging information to ?WinError

   : DefinedAbort,   \ compiles an ABORT" with the file name and line where defined
      STATE @ IF
        SAVE-INPUT  2DROP 2DROP ROT   \ get current file name and position
          IF  S" Defined in file: "  TEMP$ PLACE
              ROT COUNT              TEMP$ +PLACE
              S"  -- Line: "         TEMP$ +PLACE
              DROP (.)               TEMP$ +PLACE
              POSTPONE (ABORT")
              TEMP$ COUNT
              HERE >R DUP C,
              DUP ALLOT
              R@ 1+ SWAP MOVE
              0 C,
              ALIGN
              R> COUNT \N->CRLF
        ELSE  2DROP DROP
        THEN
      ELSE  POSTPONE DROP
      THEN ;

   : ?WinError ( f)
      STATE @ IF  POSTPONE DUP  POSTPONE (?WinError)  POSTPONE 0= DefinedAbort,
            ELSE  (?WinError)
            THEN ; IMMEDIATE

[ELSE]   \ just give messagebox as an alert, don't abort

   : ?WinError ( f)   (?WinError) ;

[THEN]



200 VALUE (NextID)
: CreateNewID ( -- id)   \ create a new id number (hopefully unique)
   (NextID) DUP 1+ TO (NextID) ;



WinLibrary COMCTL32.DLL   \ Add the advanced control library.
                          \ Needed for CreateToolbar, CreateStatusWindow, etc.



\ are we running on Win 3.x or WFW?
Win32s? [IF]   \ for Win32s

   \ defines not in Win32for WINCON.DLL
   NEEDS defines.f  \ WINCON.DLL doesn't give as many constants under win32s
                    \ so brute force define all I use

[ELSE]   \ for Win32

   \ defines not in Win32for WINCON.DLL
       TTN_GETDISPINFOA CONSTANT TTN_NEEDTEXT       \ ANSI version
     TBN_GETBUTTONINFOA CONSTANT TBN_GETBUTTONINFO  \ ANSI version
           TTM_ADDTOOLA CONSTANT TTM_ADDTOOL        \ ANSI version
            SB_SETTEXTA CONSTANT SB_SETTEXT         \ ANSI version
            SB_GETTEXTA CONSTANT SB_GETTEXT         \ ANSI version
     TTM_UPDATETIPTEXTA CONSTANT TTM_UPDATETIPTEXT  \ ANSI version
           TTM_GETTEXTA CONSTANT TTM_GETTEXT        \ ANSI version
         TTM_ENUMTOOLSA CONSTANT TTM_ENUMTOOLS      \ ANSI version

   \ Strings not defined in Win32for
   : STATUSCLASSNAME   Z" msctls_statusbar32" rel>abs ;
   : TOOLBARCLASSNAME  Z" ToolbarWindow32"    rel>abs ;
   : WC_TREEVIEW       Z" SysTreeView32"      rel>abs ;
   : TOOLTIPS_CLASS    Z" tooltips_class32"   rel>abs ;
   : PROGRESS_CLASS    Z" msctls_progress32"  rel>abs ;
   : TRACKBAR_CLASS    Z" msctls_trackbar32"  rel>abs ;
   : UPDOWN_CLASS      Z" msctls_updown32"    rel>abs ;

[THEN]



\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\ Load Resources
\
\ LR_LOADFROMFILE is not claimed to work on NT, but the documentation
\ appears to be out of date since it works on my NT machine.
\    For icons, the alternative would be:
\       0 Z" Toolbar.ico" rel>abs  appInst
\       Call ExtractIcon  DUP VALUE hIcon  ?WinError
\    Couldn't find a simple alternative for bitmaps and didn't look
\    for one for cursors.

\ a is a relative address of a zString for file name,
\ f is resource type (IMAGE_ICON, IMAGE_BITMAP, or IMAGE_CURSOR)
\ returns handle to resource
: GetResource ( a f -- handle)
   2>R  LR_LOADFROMFILE 0 0 R> R> rel>abs
   NULL  Call LoadImage  DUP ?WinError ;

\ create an icon resource from file
: GetIconResource ( a -- handle)
   IMAGE_ICON  GetResource ;

\ create a bitmap resource from file
: GetBmpResource ( a -- handle)
   IMAGE_BITMAP  GetResource ;

\ create a cursor resource from file
: GetCurResource ( a -- handle)
   IMAGE_CURSOR  GetResource ;