Re: snipped: PROCESS>HWND - more reliable version.

\ The existing >PROCESS word takes an executable and returns its
\ process handle.
\ -----
\ PROCESS>HWND translates a _Window_ process handle to its HWND.

Function: GetProcessId ( handle -- id )
Function: GetWindowThreadProcessId ( hWnd lpdwProcessId -- thread-id )

variable (hwnd-id)

:noname ( -- continue? )
    cell r-alloc >r
    _param_0 r@ GetWindowThreadProcessId drop
    r> @ _param_1 <> dup ?EXIT
    _param_0 (hwnd-id) ! ; 2 CB: (Find-Proc)

: PROCESS>HWND ( ph -- hwndMain )
    \ Waits until the given process is waiting for user input.
    dup 2000 WaitForInputIdle IF drop 0 EXIT THEN
    \ Translate the given process handle to process id.
    GetProcessId dup -EXIT
    \ Translates the process handle to its window handle.
    (hwnd-id) off
    (Find-Proc) swap EnumWindows drop
    (hwnd-id) @ ;

\ ================ test ================
\ Automate Notepad

Function: GetWindowTextLength ( hWnd -- nChar )

: RUN-NOTEPAD ( -- hEdit )
    z" NOTEPAD.EXE" >PROCESS dup -EXIT
    PROCESS>HWND dup -EXIT GW_CHILD GetWindow ;

: >NOTEPAD ( zStr hNotepad -- )
    dup GetWindowTextLength locals| len hNotepad text |
    hNotepad EM_SETSEL -1 len SendMessage drop
    hNotepad EM_REPLACESEL 0 text SendMessage drop ;

: <ZCRLF> ( addr -- ) <CRLF> char+ ;

: TEST ( -- )
    RUN-NOTEPAD dup -EXIT
    100 0 DO
        z" This is a text line." over >NOTEPAD
        <ZCRLF> over >NOTEPAD
    LOOP
    drop ;

\ EOF

----------------------------------------------------------------------
sftalk_at_forth.com The SwiftForth programming discussion email list
To unsubscribe, send subject "unsubscribe" to sftalk-request_at_forth.com
For list command help, send subject "help" to sftalk-request_at_forth.com
Message archives are located at http://www.forth.com/archive/sftalk
----------------------------------------------------------------------
This list is a forum for SwiftForth users. For product support and bug
reports, please send email to support_at_forth.com
----------------------------------------------------------------------
Received on Wed Aug 16 2006 - 10:02:50 PDT