Many Windows Open at Same Time...a challenge!

[Dean.Hodgson]

Hi,

Here's a challenge which I have not yet been able to crack but I'm sure it can be.

I'd like to have a program that can open two, three or any number of windows at the same time (one example: main window open, open another, do something, close it, back to the main one). I would like to be able to close any of the open windows in any order and not have the program shut down until after the last window is closed. 'After' meaning that some data might need to be saved between the last window closing and before the program actually ends.

I've tried this with two windows but when I close one window, the other closes and the program shuts down. Question: does each open window require its own Wndproc, or is there a way to have one that is shared?

[MichaelW]

I think this basic method could be adapted to work with most windows:

Code: Select all

'==============================================================================
#include "windows.bi"
'==============================================================================

#define WINSTYLE WS_OVERLAPPED or WS_SYSMENU or WS_VISIBLE

#define IDC_BTN 1001

'---------------------------------------------
'' Use the same class for all of the windows.
'---------------------------------------------

dim shared as string g_className
g_className = "test_class"

'==============================================================================

function PushButton( byref caption as string, _
                     byval hParent as HWND, _
                     byval x as integer, _
                     byval y as integer, _
                     byval w as integer, _
                     byval h as integer, _
                     byval cid as integer, _
                     byval extraStyle as integer = 0 ) as HWND

    dim style as integer = WS_CHILD or _
                           WS_VISIBLE or _
                           WS_TABSTOP or _
                           BS_PUSHBUTTON or _
                           extraStyle

    return CreateWindowEx( 0, _
                           "BUTTON", _
                           caption, _
                           style, _
                           x, y, w, h, _
                           hParent, _
                           cast( HMENU, cid ), _
                           GetModuleHandle( null ), _
                           null )
end function

'==============================================================================


'-----------------------------------------------------
'' Sharing the window procedure is no problem because
'' the passed window handle identifies the window.
'-----------------------------------------------------

function WindowProc( byval hWnd as HWND,_
                     byval uMsg as uint,_
                     byval wParam as WPARAM,_
                     byval lParam as LPARAM ) as LRESULT

    static as integer count

    select case uMsg

        case WM_CREATE

            if count = 0 then
                PushButton( "New Window", _
                            hWnd, _
                            34, _
                            50, _
                            120, _
                            25, _
                            IDC_BTN )
            end if

            count += 1

        case WM_COMMAND

            select case wParam

                case IDC_BTN

                    '---------------------------------------------
                    '' We need the handle for the new window only
                    '' for the call to ShowWindow, so just reuse
                    '' the passed in handle to temporarily store
                    '' it.
                    '---------------------------------------------

                    hWnd = CreateWindowEx( WS_EX_OVERLAPPEDWINDOW, _
                                           strptr( g_className ), _
                                           "New " & str(count), _
                                           WINSTYLE, _
                                           CW_USEDEFAULT, _
                                           0, _
                                           200, _
                                           150, _
                                           null, _
                                           null, _
                                           GetModuleHandle( null ), _
                                           null )

                    ShowWindow( hWnd, SW_SHOWNORMAL )

                case IDCANCEL

                    '----------------------------------------------
                    '' This allows the user to close the window by
                    '' pressing the Escape key (works only if the
                    '' message loop usees IsDialogMessage).
                    '----------------------------------------------

                    DestroyWindow( hWnd )
                    count -= 1

            end select

        case WM_CLOSE

            DestroyWindow( hWnd )
            count -= 1

        case WM_DESTROY

            '----------------------------------------------
            '' Post a WM_QUIT message to the message queue
            '' only when the last window is destroyed.
            '----------------------------------------------

            if count = 1 then
                PostQuitMessage( null )
            end if

        case else

            return DefWindowProc( hWnd, uMsg, wParam, lParam )

    end select

    return 0

end function

'==============================================================================

dim as integer wx, wy, nWidth, nHeight
dim as WNDCLASSEX wcx
dim as HWND hWnd
dim as MSG wMsg

with wcx
    .cbSize = sizeof( WNDCLASSEX )
    .style = CS_HREDRAW or CS_VREDRAW or CS_BYTEALIGNWINDOW
    .lpfnWndProc = cast( WNDPROC, @WindowProc )
    .cbClsExtra = null
    .cbWndExtra = null
    .hInstance = GetModuleHandle( null )
    .hbrBackground = cast( HBRUSH,COLOR_WINDOW + 1 )
    .lpszMenuName = null
    .lpszClassName = strptr( g_className )
    .hIcon = LoadIcon( null, IDI_APPLICATION )
    .hCursor = LoadCursor ( null, IDC_ARROW )
    .hIconSm = 0
end with

RegisterClassEx( @wcx )

nWidth = 200
nHeight = 150
wx = (GetSystemMetrics( SM_CXSCREEN ) / 2) - nWidth / 2
wy = (GetSystemMetrics( SM_CYSCREEN ) / 2) - nHeight / 2

hWnd = CreateWindowEx( WS_EX_OVERLAPPEDWINDOW, _
                       strptr( g_className ), _
                       "Main", _
                       WINSTYLE, _
                       wx, _
                       wy, _
                       nWidth, _
                       nHeight, _
                       null, _
                       null, _
                       GetModuleHandle( null ), _
                       null )

ShowWindow( hWnd, SW_SHOWNORMAL )

'--------------------------------------------------------------
'' Using the window handle from the MSG structure (instead of
'' the handle returned by CreateWindowEx) allows us to use the
'' same message loop for all of the windows.
'--------------------------------------------------------------

do while GetMessage( @wMsg, null, 0, 0 ) <> 0
    if IsDialogMessage( wMsg.hwnd, @wMsg ) = 0 then
        TranslateMessage( @wMsg )
        DispatchMessage( @wMsg )
    end if
loop

'==============================================================================


[Dean.Hodgson]

Thank you Michael. That seems to work. I'll let you know how I go with it.

I am gradually working up my own GUI routines in FB.

Are you one of the developers of FB?

[Dean.Hodgson]

Almost but not quite...

The program exits when the last window closes. However, I would like the program to continue running after the last window closes, if possible, and then shut the program down when I'm ready. Example: after closing the last window I want to save some data to a file. Basically, I'd like to not put the code to end the program in WndProc but outside it. Something like this sequence:

open window
scan for messages
when close window message occurs, close window but do not shut down program
save data
end program

Am I right in assuming the PostMessage(null) command that shuts down the program must be contained within WindowProc?

[Sisophon2001]

The PostMessage(0) will work from anyplace as far as I am aware. In your case, why not insert a function call to your cleanup routine before the PostMessage(0)?

Garvan

[Dean.Hodgson]

I'm not sure that'll work. I tried putting the PostMessage(0) outside WndProc at the end of the program after the windows exited. The program appeared to quit but when I checked the Task Manager, it was still running. I'm trying to work out a solution right now. Getting there, slowly. What I'm trying to produce is a generic WndProc routine that I don't have to modify for each app.

[McLovin]

The best place to save your data would be in WM_DESTROY just prior to your PostQuitMessage. You could also have put it in WM_NCDESTROY.

Some people put cleanup code immediately following the main message loop but that is usually frowned upon especially if you are interacting with GUI elements that may not be valid after the message pump exits.

I'd stick to calling a save data routine from your WM_DESTROY message handler.

[Dean.Hodgson]

That's the conclusion I've been coming, to, that program termination has to occur within WndProc. I've seen plenty of other languages offer what I'm thinking but I'm not sure how they achieved it in FB. One other thing I'd like to do is intercept the user's click on the window's close control, not have the window close yet, pop open a password request dialog before that window actually closes if the correct password was entered. Then close the main window, save data, and end the program. I've been able to do this in several other Basic languages, I just can't figure it out for FB. Not clever enough.

[MichaelW]

That's the conclusion I've been coming, to, that program termination has to occur within WndProc.

Program termination is initiated in the window procedure, but for a normal application window it actually occurs after the message loop exits. For my example, the order of operations is roughly:

If the user clicks the Close button (at the right end of the title bar), or selects Close on the Window menu, or presses Alt+F4, a WM_CLOSE message is sent. If the user presses Escape, a WM_COMMAND message is sent with the high-order word of wParam set to the BN_CLICKED notification code (defined as zero) and the low-order word set to the special identifier IDCANCEL. In either case the handlers call DestroyWindow to destroy the current window.

DestroyWindow sends a WM_DESTROY message, and, for the last window only, the handler calls PostQuitMessage, which in turn posts a WM_QUIT message to the thread’s message queue. When GetMessage retrieves the WM_QUIT message it returns zero, and the message loop exits.

One essential component that you don’t see in the source is the termination code that the compiler adds at the end of the message loop:

Code: Select all

.Lt_0026:
push 0
push 0
push 0
lea eax, [ebp-100]
push eax
call _GetMessageA@16
test eax, eax
je .Lt_0027
lea eax, [ebp-100]
push eax
push dword ptr [ebp-100]
call _IsDialogMessageA@8
test eax, eax
jne .Lt_0029
lea eax, [ebp-100]
push eax
call _TranslateMessage@4
lea eax, [ebp-100]
push eax
call _DispatchMessageA@4
.Lt_0029:
.Lt_0028:
jmp .Lt_0026
.Lt_0027:
.Lt_0002:
push 0
call _fb_End@4
mov eax, dword ptr [ebp-4]
pop ebx
mov esp, ebp
pop ebp
ret


[Dean.Hodgson]

I think I did it. What I've done is produce a prototype of of some code that I want to more fully develop (see below). This code not only intercepts the WM_CLOSE events and allows for popup windows and other things, it also uses what I've called an event handling system. (Maybe there's a "proper name" for it? Likely.)

The core program boils down to:
OPENWIN to open a window and establish a sub for closing it
BUTTON to display a pushbutton control on the window and establish a sub that is called when it is clicked
SHOWWIN to display the window
EVENTS to wait for an event and then call the appropriate sub when that occurs

A lot of the work is done outside WindowProc inside the EVENTS routine. The idea is to set up subs that are called when required without having a complicated message handling loop. The main program can then be compact and easier to write (hopefully). This is the strt of what I hope will be a large number of general-purpose set of functions in an include file.

Thank you Michael and everyone else who have answere my queries here. They've all lead toward this.

Code: Select all

'Demo of Dean's event handling system

#Include Once "windows.bi"

'Global variables and arrays
DIM SHARED AS MSG wMsg
DIM SHARED As HWND wtrash,zhwnd
Dim SHARED AS INTEGER zmsg,zlparam,zwparam,eventid,windowcounter,zclosewin
Dim Shared As Integer zonmessages
Dim Shared As HWND zonmessagehandle(100)
Dim Shared As Integer zonmessagetype(100)
Dim Shared As Integer zonmessageaddress(100)
Dim Shared As Integer znevents
DIM SHARED As Integer zeventid(1000)
Dim Shared As HWND zeventparent(1000)
DIM SHARED As Integer zeventaddress(1000)

'=============================================================================

Declare Function WindowProc(BYVAL hWnd AS HWND,BYVAL wMsg AS UINT,BYVAL wParam AS WPARAM,BYVAL lParam AS LPARAM) AS LRESULT
Declare Sub ONMESSAGE(ByVal winid As HWND,ByVal message As Integer,ByVal procaddress As Integer)
Declare Sub ONCOMMAND(ByVal win AS HWND,ByVal id As Integer,ByVal procaddress AS Integer)
Declare Sub ONCLOSE(ByVal winid As HWND,ByVal procaddress As Integer)
Declare Sub EVENTS
Declare Sub SETUPWNDCLASS
Declare Sub OPENWIN(ByRef hwmd As HWND,ByVal caption As STRING,ByVal wx As Integer =CW_USEDEFAULT,ByVal wy As Integer =CW_USEDEFAULT,ByVal ww As Integer =CW_USEDEFAULT,ByVal wh As Integer =CW_USEDEFAULT,ByVal style As Integer =WS_SYSMENU OR WS_OVERLAPPEDWINDOW,ByVal exstyle As Integer =0,ByVal procaddress As Integer =0)
Declare Sub CLOSEWIN(ByVal hwmd AS HWND)
Declare Sub SHOWWIN(ByVal chandle As HWND)
Declare Sub BUTTON(BYVAL bhwnd As HWND,BYVAL bid As integer,ByVal btext As string,ByVal bx As integer,BYVAL by As Integer,BYVAL bw As Integer=75,ByVal bh As Integer=22,BYVAL bflag As Integer=WS_CHILD OR WS_VISIBLE OR WS_TABSTOP OR BS_PUSHBUTTON,BYVAL ex As Integer=0,ByVal procaddress As Integer=0)
Declare Sub STATICTEXT(ByVal thwnd As HWND,ByVal tid As Integer,ByVal ttext As String,ByVal tx As Integer,BYVAL ty As Integer,BYVAL tw As Integer,ByVal th As Integer,ByVal tflag As Integer=WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or SS_LEFT,ByVal ex As Integer=0)


Function WindowProc(BYVAL hWnd As HWND,BYVAL wMsg AS UINT,BYVAL wParam AS WPARAM,BYVAL lParam AS LPARAM) AS LRESULT
  FUNCTION = 0
  zlparam=lParam
  zwparam=LOBYTE(wParam)
  eventid=zwparam
  zmsg=wMsg
  zhwnd=hWnd
  Select Case wMsg
    Case WM_COMMAND
      Exit Function
    Case WM_CLOSE
      Exit Function
    Case WM_DESTROY
      If windowcounter<=1 Then PostQuitMessage(NULL)
    Case Else
      Function=DefWindowProc(hWnd,wMsg,wParam,lParam)
  End Select
End Function

Sub ONMESSAGE(ByVal winid As HWND,ByVal message As Integer,ByVal procaddress As Integer)
  zonmessages +=1
  zonmessagehandle(zonmessages)=winid
  zonmessagetype(zonmessages)=message
  zonmessageaddress(zonmessages)=procaddress
End Sub

Sub ONCOMMAND(ByVal win AS HWND,ByVal id As Integer,ByVal procaddress AS Integer)
  znevents=znevents+1
  zeventid(znevents)=id
  zeventparent(znevents)=win
  zeventaddress(znevents)=procaddress
End Sub

Sub ONCLOSE(ByVal winid As HWND,ByVal procaddress As Integer)
  ONMESSAGE winid,WM_CLOSE,procaddress
End Sub

Sub EVENTS
  Dim calleventproc AS Sub()
  DIM AS INTEGER i,j,k
  While GetMessage(@wMsg,NULL,0,0)<>0
    If IsDialogMessage(wMsg.hwnd,@wMsg)=0 Then
      TranslateMessage(@wMsg)
      DispatchMessage(@wMsg)
    End If
    If zonmessages>0 And zmsg<>WM_COMMAND Then
      For i=1 To zonmessages
        If zonmessagetype(i)>0 then
          If zonmessagetype(i)=zmsg And zonmessagehandle(i)=zhwnd Then
            calleventproc=zonmessageaddress(i)
            calleventproc()
            Exit For
          End If
        End If
      Next
    End If
    If zmsg=WM_COMMAND And znevents>0 Then
      For i=1 To znevents
        If zeventid(i)=eventid And zeventparent(i)=zhwnd Then
          calleventproc=zeventaddress(i)
          calleventproc()
          Exit For
        End If
      Next
    End If
  Wend
End Sub

'========================================

DIM Shared AS WNDCLASSEX wcx
'DIM SHARED AS MSG wMsg
SUB SETUPWNDCLASS
  With wcx
    .cbSize=SizeOf( WNDCLASSEX )
    .style=CS_HREDRAW OR CS_VREDRAW OR CS_BYTEALIGNWINDOW
    .lpfnWndProc=Cast(WNDPROC,@WindowProc)
    .cbClsExtra=NULL
    .cbWndExtra=NULL
    .hInstance=GetModuleHandle(NULL)
    .hIcon=LoadIcon(null,IDI_APPLICATION)
    .hCursor=LoadCursor(NULL,IDC_ARROW)
'  .hbrBackground=cast( HBRUSH,COLOR_WINDOW + 1 )
    .hbrBackground=GetSysColorBrush(COLOR_BTNFACE)
    .lpszMenuName=NULL
    .lpszClassName=@"zWindow"
    .hIconSm=0
  End With
  RegisterClassEx(@wcx)
End Sub

SUB OPENWIN (ByRef hwmd As HWND,_
                         ByVal caption As STRING,_
                         ByVal wx As Integer =CW_USEDEFAULT,_
                         ByVal wy As Integer =CW_USEDEFAULT,_
                         ByVal ww As Integer =CW_USEDEFAULT,_
                         ByVal wh As Integer =CW_USEDEFAULT,_
                         ByVal style As Integer =WS_SYSMENU OR WS_OVERLAPPEDWINDOW,_
                         ByVal exstyle As Integer =0,_
                         ByVal procaddress As Integer =0)
  Static As Integer OGLE
  If OGLE=0 Then SETUPWNDCLASS
  OGLE=1
  If wx=-1 And wy=-1 Then
    wx=(GetSystemMetrics(SM_CXSCREEN)/2)-ww/2
    wy=(GetSystemMetrics(SM_CYSCREEN)/2)-wh/2
  End If
  hwmd=CreateWindowEx(exstyle,@"zWindow",StrPtr(caption),style,wx,wy,ww,wh,NULL,NULL,GetModuleHandle(NULL),NULL)
  windowcounter +=1
  If procaddress>0 Then ONCLOSE hwmd,procaddress
End Sub

Sub CLOSEWIN(ByVal hwmd AS HWND)
  Dim As Integer i
  IF hwmd<1 THEN EXIT Sub
  DestroyWindow(hwmd)
  PostMessage(hwmd,WM_CLOSE,0,0)
  For i=1 To zonmessages
    If zonmessagetype(i)=WM_CLOSE And zonmessagehandle(i)=hwmd THEN
      zonmessagetype(i)=0
      zonmessagehandle(i)=0
      zonmessageaddress(i)=0
      Exit For
    End If
  Next
  zclosewin=TRUE
  windowcounter -=1
End Sub

Sub SHOWWIN(ByVal chandle As HWND)
  ShowWindow(chandle,SW_NORMAL)
  UpdateWindow(chandle)
End Sub

Sub BUTTON(BYVAL bhwnd As HWND,BYVAL bid As integer,ByVal btext As string,ByVal bx As integer,BYVAL by As Integer,BYVAL bw As Integer=75,ByVal bh As Integer=22,BYVAL bflag As Integer=WS_CHILD OR WS_VISIBLE OR WS_TABSTOP OR BS_PUSHBUTTON,BYVAL ex As Integer=0,ByVal procaddress As Integer=0)
  IF bflag=0 THEN bflag=WS_CHILD OR WS_VISIBLE OR WS_TABSTOP OR BS_PUSHBUTTON Or bflag
  CreateWindowEx(ex,@"BUTTON",StrPtr(btext),bflag,bx,by,bw,bh,bhwnd,cast(HMENU,bid),GetModuleHandle(NULL),NULL)
  If procaddress>0 Then ONCOMMAND bhwnd,bid,procaddress
End Sub

Sub STATICTEXT(ByVal thwnd As HWND,ByVal tid As Integer,ByVal ttext As String,ByVal tx As Integer,BYVAL ty As Integer,BYVAL tw As Integer,ByVal th As Integer,ByVal tflag As Integer=WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or SS_LEFT,ByVal ex As Integer=0)
  CreateWindowEx(ex,@"STATIC",StrPtr(ttext),tflag,tx,ty,tw,th,thwnd,Cast(HMENU,tid),GetModuleHandle(NULL),NULL)
END SUB


'==========================================================
'==========================================================
' Main Program
'==========================================================
'==========================================================

Dim Shared As HWND testwin,secondwin

Declare Function askforclose(ByVal win As HWND) As Integer
Declare Sub closetestwin
Declare Sub closepopup
Declare Sub testforclose
Declare Sub buttonclick


'main program
OPENWIN testwin,"Test Window",300,300,320,200,,,@testforclose
'ONCLOSE testwin,@testforclose      'can be used instead of the above
BUTTON testwin,100,"OK",20,20,,,,,@buttonclick
'ONCOMMAND testwin,100,@buttonclick   'could be used instead of above
SHOWWIN testwin
EVENTS
End


Function askforclose(ByVal win As HWND) As Integer
  Dim As Integer result
  result=MessageBox(win,@"Close all windows?","Alert",MB_YESNO)
  Function=result
End Function

Sub closetestwin
  CLOSEWIN testwin
End Sub

Sub closepopup
  CLOSEWIN secondwin
  closetestwin
End Sub

Sub testforclose
  Dim As Integer s
  s=askforclose(testwin)
  If s=IDYES Then closetestwin
End Sub

Sub buttonclick
  OPENWIN secondwin,"Test2",100,100,320,200,WS_SYSMENU OR WS_BORDER
  ONCLOSE secondwin,@closepopup
  STATICTEXT secondwin,110,"Close this window to close both windows.",20,20,200,40
  SHOWWIN secondwin
  EnableWindow(testwin,FALSE)
End Sub



[aurelVZAB]

Hi Dean!
It is cool demo!
But after testing program i recive some warnings like:

Code: Select all

DeanEvents.bas(196) warning 2(1): Passing pointer to scalar, at parameter 10 (procaddress) of BUTTON()
DeanEvents.bas(197) warning 2(1): Passing pointer to scalar, at parameter 3 (procaddress) of ONCOMMAND()
DeanEvents.bas(226) warning 2(1): Passing pointer to scalar, at parameter 2 (procaddress) of ONCLOSE()

Infact program work but this warnings is strange to me.[/code]

[Dean.Hodgson]

Hi.

Yes, it does generate some non-critical errors. I think it is because the variable type expected is not what is being passed. I have not worked out why, maybe someone here will. I'll send you an email.

D

[Zippy]

Hi.

Yes, it does generate some non-critical errors. I think it is because the variable type expected is not what is being passed. I have not worked out why, maybe someone here will. I'll send you an email.

D

I'll do the easy part (removing the warnings).. Make these changes to these lines (line numbers based on Dean's original code posting).

Code: Select all

'83 :
calleventproc=cast(any ptr,zonmessageaddress(i))

'93 :
calleventproc=cast(any ptr,zeventaddress(i))

'195:
OPENWIN testwin,"Test Window",300,300,320,200,,,cast(integer,@testforclose)

'197:
BUTTON testwin,100,"OK",20,20,,,,,cast(integer,@buttonclick)

'227:
ONCLOSE secondwin,cast(integer,@closepopup)


[Dean.Hodgson]

Got it but I'm not clear on the rules, however. Can you explain? Cast is still somewhat of a mystery to me.

[Zippy]

Got it but I'm not clear on the rules, however. Can you explain? Cast is still somewhat of a mystery to me.

I don't know that my explanation will be clear and helpful.

There are 2 types of warnings in the code.

1. The first type, the first 2 warnings by occurrence, are "Suspicious pointer assignment". This code line:
calleventproc=zonmessageaddress(i)

We see that calleventproc has been dimmed as a function pointer:
Dim calleventproc As Sub()

and

zonmessageaddress() is dimmed as an array of integers:
Dim Shared As Integer zonmessageaddress(100)

so the compiler is telling us that we are trying to assign an integer value type to a function ptr type. The simplest method to remove the warning is cast zonmessageaddress(n) as type Any Ptr to match the calleventproc type. FreeBASIC, internally, recognizes calleventproc as type FUNCTION PTR but has no external FUNCTION PTR type so we use Any Ptr which the compiler accepts silently (this may be confusing, sorry):
calleventproc=cast(any ptr,zonmessageaddress(i))

A more direct casting is:
calleventproc=cast(sub(),zonmessageaddress(i))

which is confusing and I think undocumented. I'd rather use Any Ptr.


2. The second type of warning, the last 3 warnings by occurrence, are parameter-type warnings. The compiler tells us that the types in a procedure (function or sub) declaration do not match the type(s) of the value we are attempting to pass to the procedure.

This line in the code:
ONCLOSE secondwin,@closepopup

generates this error at compile-time:
d1-org.bas(227) warning 2(1): Passing pointer to scalar, at parameter 2 (procaddress) of ONCLOSE()

We examine the declaration for ONCLOSE():
Declare Sub ONCLOSE(Byval winid As HWND,Byval procaddress As Integer)

procaddress is declared as type INTEGER so we mod the ONCLOSE call to pass @closepopup as an integer value:
ONCLOSE secondwin,cast(integer,@closepopup)

None of these 5 warnings are - they don't cause failure in the program. And/but it's a good thing to check and attempt to resolve all warnings as they may indicate failure points. Make procedure declaration parameter types match the parameter types actually passed.

This barely scratches the surface of casting.