Problem making a Dialog Box

For other topics related to the FreeBASIC project or its community.
James Klutho
Posts: 14
Joined: Nov 11, 2009 23:44

Problem making a Dialog Box

Postby James Klutho » Apr 23, 2017 17:57

I have been having problems making a simple dialog box appear. Similar code has worked for me before in another language. Can anyone spot what I am doing wrong? I also get a suspicious pointer warning which I can't track down in the DialogBoxIndirect call. Thanks. Jim

Code: Select all

#include once "windows.bi"

declare function        WinMain     ( byval hInstance as HINSTANCE, _
                                      byval hPrevInstance as HINSTANCE, _
                                      byval szCmdLine as zstring ptr, _
                                      byval iCmdShow as integer ) as integer
                                 
                                 
   end WinMain( GetModuleHandle( null ), null, Command( ), SW_NORMAL )


FUNCTION DlgProc (BYVAL hDlg AS HWND, BYVAL wMsg AS Uint, BYVAL wParam AS wParam, BYVAL lParam AS lParam) AS Integer

   SELECT CASE wMsg

      CASE WM_INITDIALOG
       
      CASE WM_COMMAND
         IF HIWORD(wParam) = BN_CLICKED THEN
            SELECT CASE LOWORD(wParam)
               CASE IDOK
                 
            END SELECT
         END IF

      CASE WM_CLOSE
         EndDialog hDlg, 0

   END SELECT
  function = 0 ' DefWindowProc( hDlg, wMsg, wParam, lParam )
END FUNCTION

function NewDialog( byval hParent as HWND, byval lpDialogProc as DLGPROC) as HWND
                             
  dim as HWND rval
  dim dt as DLGTEMPLATE
  dim strTitle as string
  dim lpdt as LPDLGTEMPLATE
 
 
  dt.style = WS_OVERLAPPEDWINDOW            'DS_MODALFRAME OR DS_CENTER OR WS_VISIBLE OR WS_OVERLAPPEDWINDOW
  dt.dwExtendedStyle = 0
  dt.cx = 170
  dt.cy = 200
  dt.cdit = 0
  dt.x = 50
  dt.y = 50
 
  lpdt = cast(LPDLGTEMPLATE,@dt)
  rval = DialogBoxIndirect(GetModuleHandle(null),lpdt,hParent,lpDialogProc)
                                                     

  return rval
 
end function

function WndProc ( byval hWnd as HWND, _
                   byval wMsg as UINT, _
                   byval wParam as WPARAM, _
                   byval lParam as LPARAM ) as LRESULT
   
    function = 0
   
    select case( wMsg )
        case WM_CREATE
                       
            exit function
           
        case WM_SIZE
           
            exit function
           
        case WM_COMMAND
           
             exit function

        case WM_PAINT
          dim rct as RECT
          dim pnt as PAINTSTRUCT
          dim hDC as HDC
         
            hDC = BeginPaint( hWnd, @pnt )
       
            EndPaint( hWnd, @pnt )
           
            exit function           
       
      case WM_KEYDOWN
   

       case WM_DESTROY
            PostQuitMessage( 0 )
            exit function
    end select
   
    function = DefWindowProc( hWnd, wMsg, wParam, lParam )   
   
end function

'':::::
function WinMain ( byval hInstance as HINSTANCE, _
                   byval hPrevInstance as HINSTANCE, _
                   byval szCmdLine as zstring ptr, _
                   byval iCmdShow as integer ) as integer   
     
    dim wMsg as MSG
    dim wcls as WNDCLASS     
    dim hWnd as HWND

    function = 0
     
    with wcls
       .style         = CS_HREDRAW or CS_VREDRAW
       .lpfnWndProc   = @WndProc
       .cbClsExtra    = 0
       .cbWndExtra    = 0
       .hInstance     = hInstance
       .hIcon         = LoadIcon( NULL, IDI_APPLICATION )
       .hCursor       = LoadCursor( NULL, IDC_ARROW )
       .hbrBackground = GetStockObject( WHITE_BRUSH )
       .lpszMenuName  = NULL
       .lpszClassName = @"Test"
    end with
         
    if( RegisterClass( @wcls ) = FALSE ) then
       MessageBox( null, "Failed to register wcls", "Error", MB_ICONERROR )
       exit function
    end if
   
    hWnd = CreateWindowEx( 0, _
                       @"Test", _
                           "The GRD Simple Demo", _
                           WS_OVERLAPPEDWINDOW, _
                           CW_USEDEFAULT, _
                           CW_USEDEFAULT, _
                           CW_USEDEFAULT, _
                           CW_USEDEFAULT, _
                           NULL, _
                           NULL, _
                           hInstance, _
                           NULL )
                                                 
    ShowWindow( hWnd, iCmdShow )
    UpdateWindow( hWnd )
   
     NewDialog(HWND,cast(DLGPROC,ProcPtr(DlgProc)))   
   
    while( GetMessage( @wMsg, NULL, 0, 0 ) <> FALSE )   
        TranslateMessage( @wMsg )
        DispatchMessage( @wMsg )
    wend
   
 
   
    function = wMsg.wParam

end function

dodicat
Posts: 6014
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Problem making a Dialog Box

Postby dodicat » Apr 23, 2017 20:16

The function Newdialog (tweaked to remove the warning)

Code: Select all

function NewDialog( byval hParent as HWND, byval lpDialogProc as DLGPROC) as HWND
                             
  'dim as HWND rval
  dim dt as DLGTEMPLATE
  dim strTitle as string
  dim lpdt as LPDLGTEMPLATE
 
 
  dt.style = WS_OVERLAPPEDWINDOW            'DS_MODALFRAME OR DS_CENTER OR WS_VISIBLE OR WS_OVERLAPPEDWINDOW
  dt.dwExtendedStyle = 0
  dt.cx = 170
  dt.cy = 200
  dt.cdit = 0
  dt.x = 50
  dt.y = 50
 
  lpdt = cast(LPDLGTEMPLATE,@dt)

 var rval = DialogBoxIndirect(GetModuleHandle(null),lpdt,hParent,lpDialogProc)
                                                     

  return cptr(any ptr,rval)
 
end function
Josep Roca
Posts: 449
Joined: Sep 27, 2016 18:20
Location: Valencia, Spain

Re: Problem making a Dialog Box

Postby Josep Roca » Apr 23, 2017 20:40

> I also get a suspicious pointer warning which I can't track down in the DialogBoxIndirect call.

This is because you have declared both the return value of the function and the rval parameter as HWND, when it should be INT_PTR. Change HWND to INT_PTR and the warning will disappear.
MrSwiss
Posts: 3307
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Problem making a Dialog Box

Postby MrSwiss » Apr 23, 2017 21:06

Josep Roca wrote:Change HWND to INT_PTR and the warning will disappear.
Nope, don't agree, a HWND is a Any Ptr, in FB. In C you'd call it a void Ptr.
(Btw: there is no INT_PTR in FB)
James Klutho
Posts: 14
Joined: Nov 11, 2009 23:44

Re: Problem making a Dialog Box

Postby James Klutho » Apr 23, 2017 21:24

The INT_PTR did solve the suspicious pointer warning. I should have looked at the declaration of DialogBoxIndirect closer. I got the dialog to run. My problem was that I should have passed the hInstance from my WinMain instead of using GetModuleHandle(NULL) in my DialogBoxIndirect call.

Thanks for all the replies. Jim
Josep Roca
Posts: 449
Joined: Sep 27, 2016 18:20
Location: Valencia, Spain

Re: Problem making a Dialog Box

Postby Josep Roca » Apr 23, 2017 21:25

The API function DialogBoxIndirect returns a INT_PTR value, not an HWND. See winuser.bi.

> (Btw: there is no INT_PTR in FB)

INT_PTR is defined as a longint in the FB Windows headers (basetsd.bi).
dodicat
Posts: 6014
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Problem making a Dialog Box

Postby dodicat » Apr 23, 2017 21:45

There is a bug here I think.
OK on 64 bit.

but on 32 bit, in the function NewDialog if
dim as long rval is written at the top of the function, no dialog box appears.
if it is written further down, a dialog box is seen.

Anyway, INT_PTR is ulongint in 64 bit and long on 32 bit.
Here is James Klutho's code to show the behaviour.

Code: Select all

#include once "windows.bi"

declare function        WinMain     ( byval hInstance as HINSTANCE, _
                                      byval hPrevInstance as HINSTANCE, _
                                      byval szCmdLine as zstring ptr, _
                                      byval iCmdShow as integer ) as integer
                                 
                                 
   end WinMain( GetModuleHandle( null ), null, Command( ), SW_NORMAL )


FUNCTION DlgProc (BYVAL hDlg AS HWND, BYVAL wMsg AS Uint, BYVAL wParam AS wParam, BYVAL lParam AS lParam) AS Integer

   SELECT CASE wMsg

      CASE WM_INITDIALOG
       
      CASE WM_COMMAND
         IF HIWORD(wParam) = BN_CLICKED THEN
            SELECT CASE LOWORD(wParam)
               CASE IDOK
                 
            END SELECT
         END IF

      CASE WM_CLOSE
         EndDialog hDlg, 0

   END SELECT
  function = 0 ' DefWindowProc( hDlg, wMsg, wParam, lParam )
END FUNCTION

function NewDialog( byval hParent as HWND, byval lpDialogProc as DLGPROC) as hwnd
                             
  'dim as long rval '============ NO GOOD HERE
 
  dim dt as DLGTEMPLATE
  dim strTitle as string
  dim lpdt as LPDLGTEMPLATE
 
 
  dt.style = WS_OVERLAPPEDWINDOW            'DS_MODALFRAME OR DS_CENTER OR WS_VISIBLE OR WS_OVERLAPPEDWINDOW
  dt.dwExtendedStyle = 0
  dt.cx = 170
  dt.cy = 200
  dt.cdit = 0
  dt.x = 50
  dt.y = 50
 
   dim as long rval '=============  OK HERE
   
  lpdt = cast(LPDLGTEMPLATE,@dt)
 
 
  rval = DialogBoxIndirect(GetModuleHandle(null),lpdt,hParent,lpDialogProc)
 #print typeof(rval)                                                   
#print typeof(INT_PTR) 
  return cast(any ptr,@rval)
 
end function

function WndProc ( byval hWnd as HWND, _
                   byval wMsg as UINT, _
                   byval wParam as WPARAM, _
                   byval lParam as LPARAM ) as LRESULT
   
    function = 0
   
    select case( wMsg )
        case WM_CREATE
                       
            exit function
           
        case WM_SIZE
           
            exit function
           
        case WM_COMMAND
           
             exit function

        case WM_PAINT
          dim rct as RECT
          dim pnt as PAINTSTRUCT
          dim hDC as HDC
         
            hDC = BeginPaint( hWnd, @pnt )
       
            EndPaint( hWnd, @pnt )
           
            exit function           
       
      case WM_KEYDOWN
   

       case WM_DESTROY
            PostQuitMessage( 0 )
            exit function
    end select
   
    function = DefWindowProc( hWnd, wMsg, wParam, lParam )   
   
end function

'':::::
function WinMain ( byval hInstance as HINSTANCE, _
                   byval hPrevInstance as HINSTANCE, _
                   byval szCmdLine as zstring ptr, _
                   byval iCmdShow as integer ) as integer   
     
    dim wMsg as MSG
    dim wcls as WNDCLASS     
    dim hWnd as HWND

    function = 0
     
    with wcls
       .style         = CS_HREDRAW or CS_VREDRAW
       .lpfnWndProc   = @WndProc
       .cbClsExtra    = 0
       .cbWndExtra    = 0
       .hInstance     = hInstance
       .hIcon         = LoadIcon( NULL, IDI_APPLICATION )
       .hCursor       = LoadCursor( NULL, IDC_ARROW )
       .hbrBackground = GetStockObject( WHITE_BRUSH )
       .lpszMenuName  = NULL
       .lpszClassName = @"Test"
    end with
         
    if( RegisterClass( @wcls ) = FALSE ) then
       MessageBox( null, "Failed to register wcls", "Error", MB_ICONERROR )
       exit function
    end if
   
    hWnd = CreateWindowEx( 0, _
                       @"Test", _
                           "The GRD Simple Demo", _
                           WS_OVERLAPPEDWINDOW, _
                           CW_USEDEFAULT, _
                           CW_USEDEFAULT, _
                           CW_USEDEFAULT, _
                           CW_USEDEFAULT, _
                           NULL, _
                           NULL, _
                           hInstance, _
                           NULL )
                                                 
    ShowWindow( hWnd, iCmdShow )
    UpdateWindow( hWnd )
   
     NewDialog(HWND,cast(DLGPROC,ProcPtr(DlgProc)))   
   
    while( GetMessage( @wMsg, NULL, 0, 0 ) <> FALSE )   
        TranslateMessage( @wMsg )
        DispatchMessage( @wMsg )
    wend
   
 
   
    function = wMsg.wParam

end function
 
James Klutho
Posts: 14
Joined: Nov 11, 2009 23:44

Re: Problem making a Dialog Box

Postby James Klutho » Apr 23, 2017 22:44

I see what you mean about a bug in the placement of rval. I can't get any combination of placements to compile in both 32 and 64 bit. A bit frustrating.
srvaldez
Posts: 2152
Joined: Sep 25, 2005 21:54

Re: Problem making a Dialog Box

Postby srvaldez » Apr 23, 2017 23:13

hello James
with 2 small changes it works for both 32 and 64 bit

Code: Select all

function NewDialog( byval hParent as HWND, byval lpDialogProc as DLGPROC) as INT_PTR '<<<
                             
  dim as INT_PTR rval '<<<
  dim dt as DLGTEMPLATE
  dim strTitle as string
  dim lpdt as LPDLGTEMPLATE
 
 
  dt.style = WS_OVERLAPPEDWINDOW            'DS_MODALFRAME OR DS_CENTER OR WS_VISIBLE OR WS_OVERLAPPEDWINDOW
  dt.dwExtendedStyle = 0
  dt.cx = 170
  dt.cy = 200
  dt.cdit = 0
  dt.x = 50
  dt.y = 50
 
  lpdt = cast(LPDLGTEMPLATE,@dt)
  rval = DialogBoxIndirect(null,lpdt,hParent,lpDialogProc) '<<< first arg
                                         

  return rval
 
end function
Josep Roca
Posts: 449
Joined: Sep 27, 2016 18:20
Location: Valencia, Spain

Re: Problem making a Dialog Box

Postby Josep Roca » Apr 23, 2017 23:22

> with 2 small changes it works for both 32 and 64 bit

This is what I said: "Change HWND to INT_PTR and the warning will disappear."

The two HWND (the variable type and the return value), of course.
srvaldez
Posts: 2152
Joined: Sep 25, 2005 21:54

Re: Problem making a Dialog Box

Postby srvaldez » Apr 23, 2017 23:32

sorry Jose, I should have said 3 changes: rval = DialogBoxIndirect(null,lpdt,hParent,lpDialogProc)
dodicat
Posts: 6014
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Problem making a Dialog Box

Postby dodicat » Apr 23, 2017 23:45

James Klutho wrote:I see what you mean about a bug in the placement of rval. I can't get any combination of placements to compile in both 32 and 64 bit. A bit frustrating.


The code I posted above works here with 32 bit and 64 bit.
No warnings and a dialog box showing.
The position of
dim as long rval
is important in 32 bit.
(I am using Win 10)
BUT
With -gen gcc 32 bit,I get a dialog box title ?A then ?B then ?C -- with each run a different title.
With 64 bit I get no title on the dialog box.
with -gen gas I get no title on the dialogbox.
I think the bug is manifesting itself in this behaviour once more.
James Klutho
Posts: 14
Joined: Nov 11, 2009 23:44

Re: Problem making a Dialog Box

Postby James Klutho » Apr 24, 2017 0:19

@dodicat

I have Win 7 on my laptop. Your changes work in 64 bit but the dialog won't show in 32 bit. I give up. This is too unreliable to use. I will go another route. Thanks for your replies - much appreciated. Jim
Josep Roca
Posts: 449
Joined: Sep 27, 2016 18:20
Location: Valencia, Spain

Re: Problem making a Dialog Box

Postby Josep Roca » Apr 24, 2017 1:43

Hi James,

It looks like you're ignoring what I and srvaldez have been posting and only paying attention to dodicat ???

This works both with 32 and 64-bit

Code: Select all

#include once "windows.bi"

declare function        WinMain     ( byval hInstance as HINSTANCE, _
                                      byval hPrevInstance as HINSTANCE, _
                                      byval szCmdLine as zstring ptr, _
                                      byval iCmdShow as integer ) as integer
                                 
                                 
   end WinMain( GetModuleHandle( null ), null, Command( ), SW_NORMAL )


FUNCTION DlgProc (BYVAL hDlg AS HWND, BYVAL wMsg AS Uint, BYVAL wParam AS wParam, BYVAL lParam AS lParam) AS Integer

   SELECT CASE wMsg

      CASE WM_INITDIALOG
       
      CASE WM_COMMAND
         IF HIWORD(wParam) = BN_CLICKED THEN
            SELECT CASE LOWORD(wParam)
               CASE IDOK
                 
            END SELECT
         END IF

      CASE WM_CLOSE
         EndDialog hDlg, 0

   END SELECT
  function = 0 ' DefWindowProc( hDlg, wMsg, wParam, lParam )
END FUNCTION

function NewDialog( byval hParent as HWND, BYVAL hInstance AS HINSTANCE, byval lpDialogProc as DLGPROC) as INT_PTR
                             
  dim as INT_PTR rval
  dim dt as DLGTEMPLATE
  dim strTitle as string
  dim lpdt as LPDLGTEMPLATE
 
 
  dt.style = WS_OVERLAPPEDWINDOW            'DS_MODALFRAME OR DS_CENTER OR WS_VISIBLE OR WS_OVERLAPPEDWINDOW
  dt.dwExtendedStyle = 0
  dt.cx = 170
  dt.cy = 200
  dt.cdit = 0
  dt.x = 50
  dt.y = 50
 
  lpdt = cast(LPDLGTEMPLATE,@dt)
  rval = DialogBoxIndirect(hInstance,lpdt,hParent,lpDialogProc)
                                                     

  return rval
 
end function

function WndProc ( byval hWnd as HWND, _
                   byval wMsg as UINT, _
                   byval wParam as WPARAM, _
                   byval lParam as LPARAM ) as LRESULT
   
    function = 0
   
    select case( wMsg )
        case WM_CREATE
                       
            exit function
           
        case WM_SIZE
           
            exit function
           
        case WM_COMMAND
           
             exit function

        case WM_PAINT
          dim rct as RECT
          dim pnt as PAINTSTRUCT
          dim hDC as HDC
         
            hDC = BeginPaint( hWnd, @pnt )
       
            EndPaint( hWnd, @pnt )
           
            exit function           
       
      case WM_KEYDOWN
   

       case WM_DESTROY
            PostQuitMessage( 0 )
            exit function
    end select
   
    function = DefWindowProc( hWnd, wMsg, wParam, lParam )   
   
end function

'':::::
function WinMain ( byval hInstance as HINSTANCE, _
                   byval hPrevInstance as HINSTANCE, _
                   byval szCmdLine as zstring ptr, _
                   byval iCmdShow as integer ) as integer   
     
    dim wMsg as MSG
    dim wcls as WNDCLASS     
    dim hWnd as HWND

    function = 0
     
    with wcls
       .style         = CS_HREDRAW or CS_VREDRAW
       .lpfnWndProc   = @WndProc
       .cbClsExtra    = 0
       .cbWndExtra    = 0
       .hInstance     = hInstance
       .hIcon         = LoadIcon( NULL, IDI_APPLICATION )
       .hCursor       = LoadCursor( NULL, IDC_ARROW )
       .hbrBackground = GetStockObject( WHITE_BRUSH )
       .lpszMenuName  = NULL
       .lpszClassName = @"Test"
    end with
         
    if( RegisterClass( @wcls ) = FALSE ) then
       MessageBox( null, "Failed to register wcls", "Error", MB_ICONERROR )
       exit function
    end if
   
    hWnd = CreateWindowEx( 0, _
                       @"Test", _
                           "The GRD Simple Demo", _
                           WS_OVERLAPPEDWINDOW, _
                           CW_USEDEFAULT, _
                           CW_USEDEFAULT, _
                           CW_USEDEFAULT, _
                           CW_USEDEFAULT, _
                           NULL, _
                           NULL, _
                           hInstance, _
                           NULL )
                                                 
    ShowWindow( hWnd, iCmdShow )
    UpdateWindow( hWnd )
   
     NewDialog(HWND, hInstance, cast(DLGPROC,ProcPtr(DlgProc)))   
   
    while( GetMessage( @wMsg, NULL, 0, 0 ) <> FALSE )   
        TranslateMessage( @wMsg )
        DispatchMessage( @wMsg )
    wend
   
 
   
    function = wMsg.wParam

end function
dodicat
Posts: 6014
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Problem making a Dialog Box

Postby dodicat » Apr 24, 2017 8:02

Hi Josep Roca.
Your code works with 64 bit, and 32 bit -gen gcc.
But not -gen gas. (No dialog box visible)
Win 10.

Return to “Community Discussion”

Who is online

Users browsing this forum: No registered users and 1 guest