Problem of DialogProc

csn1011 — Tue, 25 Aug 2009 18:02:16 GMT

Hello everyone!
I wrote some code below. But I have a Problem to run it. I defined a name MyConfigDlgProc for my DialogProc, the Problem is, when i change this name to AboutDlgProc , it can run without Problem. But with other names has it always Problem.

integer*4 function WinMain( hInstance, hPrevInstance, lpszCmdLine, nCmdShow )
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_WinMain@16' :: WinMain
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'WinMain' :: WinMain
!DEC$ ENDIF

use user32
use kernel32
use dialogGlobals

implicit none

integer*4 hInstance
integer*4 hPrevInstance
integer*4 lpszCmdLine
integer*4 nCmdShow

! Variables
type (T_WNDCLASS) wc
type (T_MSG) mesg
integer*4 ret
logical*4 lret
integer haccel

character(SIZEOFAPPNAME) lpszClassName
character(SIZEOFAPPNAME) lpszIconName
character(SIZEOFAPPNAME) lpszAppName
character(SIZEOFAPPNAME) lpszMenuName
character(SIZEOFAPPNAME) lpszAccelName
interface
integer*4 function MainWndProc ( hwnd, mesg, wParam, lParam )
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_MainWndProc@16' :: MainWndProc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'MainWndProc' :: MainWndProc
!DEC$ ENDIF
integer*4 hwnd
integer*4 mesg
integer*4 wParam
integer*4 lParam
end function
end interface

ghInstance = hInstance
ghModule = GetModuleHandle(NULL)
ghwndMain = NULL

lpszClassName ="test"C
lpszAppName ="test"C
lpszIconName ="test"C
lpszMenuName ="test"C
lpszAccelName ="test"C

! If this is the first instance of the application, register the
! window class(es)
if (hPrevInstance .eq. 0) then
! Main window
wc%lpszClassName = LOC(lpszClassName)
wc%lpfnWndProc = LOC(MainWndProc)
wc%style = IOR(CS_VREDRAW , CS_HREDRAW)
wc%hInstance = hInstance
wc%hIcon = LoadIcon( hInstance, LOC(lpszIconName))
wc%hCursor = LoadCursor( NULL, IDC_ARROW )
wc%hbrBackground = ( COLOR_WINDOW+1 )
wc%lpszMenuName = NULL
wc%cbClsExtra = 0
wc%cbWndExtra = 0
if (RegisterClass(wc) == 0) goto 99999
end if

! Load the window's menu and accelerators and create the window
!
ghMenu = LoadMenu(hInstance, LOC(lpszMenuName))
if (ghMenu == 0) goto 99999
haccel = LoadAccelerators(hInstance, LOC(lpszAccelName))
if (haccel == 0) goto 99999

ghwndMain = CreateWindowEx( 0, lpszClassName, &
lpszAppName, &
INT(WS_OVERLAPPEDWINDOW), &
CW_USEDEFAULT, &
0, &
CW_USEDEFAULT, &
0, &
NULL, &
ghMenu, &
hInstance, &
NULL &
)
if (ghwndMain == 0) goto 99999

lret = ShowWindow( ghwndMain, nCmdShow )

! Read and process messsages
do while( GetMessage (mesg, NULL, 0, 0) )
if ( TranslateAccelerator (mesg%hwnd, haccel, mesg) == 0) then
lret = TranslateMessage( mesg )
ret = DispatchMessage( mesg )
end if
end do

WinMain = mesg.wParam
return

99999 &

ret = MessageBox(ghwndMain, "Error initializing application dialog"C, &
"Error"C, MB_OK)
WinMain = 0

end

!****************************************************************************
!
! FUNCTION: MainWndProc ( hWnd, mesg, wParam, lParam )
!
! PURPOSE: Processes messages for the main window
!
! COMMENTS:
!
!****************************************************************************

integer function MainWndProc ( hWnd, mesg, wParam, lParam )
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_MainWndProc@16' :: MainWndProc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'MainWndProc' :: MainWndProc
!DEC$ ENDIF

use user32
use dialogGlobals
use dfwin
implicit none

integer*4 hWnd
integer*4 mesg
integer*4 wParam
integer*4 lParam

include 'resource.fd'

!interface
!integer*4 function AboutDlgProc( hwnd, mesg, wParam, lParam )

!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_AboutDlgProc@16' :: AboutDlgProc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'AboutDlgProc' :: AboutDlgProc
!DEC$ ENDIF

interface
integer*4 function MyConfigDlgProc( hwnd, mesg, wParam, lParam )

integer*4 hwnd
integer*4 mesg
integer*4 wParam
integer*4 lParam
end function
end interface

! Variables
integer*4 ret, fdlg
character(SIZEOFAPPNAME) lpszName, lpszHelpFileName, lpszContents, lpszMessage
character(SIZEOFAPPNAME) lpszHeader

select case ( mesg )

! WM_DESTROY: PostQuitMessage() is called
case (WM_DESTROY)
call PostQuitMessage( 0 )
MainWndProc = 0
return

! WM_COMMAND: user command
case (WM_COMMAND)
select case ( IAND(wParam, 16#ffff ) )

case (IDM_EXIT)
ret = SendMessage( hWnd, WM_CLOSE, 0, 0 )
MainWndProc = 0
return

case (IDM_Config)

fdlg = LOC(MyConfigDlgProc)
ret = DialogBoxParam (ghInstance,IDD_CONF,hWnd,&
fdlg,0)
MainWndProc = 0
return

! All of the other possible menu options are currently disabled

case DEFAULT
MainWndProc = DefWindowProc( hWnd, mesg, wParam, lParam )
return
end select

! Let the default window proc handle all other messages
case default
MainWndProc = DefWindowProc( hWnd, mesg, wParam, lParam )

end select

end

!****************************************************************************
!
! FUNCTION: CenterWindow (HWND, HWND)
!
! PURPOSE: Center one window over another
!
! COMMENTS: Dialog boxes take on the screen position that they were designed
! at, which is not always appropriate. Centering the dialog over a
! particular window usually results in a better position.
!
!****************************************************************************

subroutine CenterWindow (hwndChild, hwndParent)

use user32
use gdi32
use dialogGlobals

implicit none

integer hwndChild, hwndParent

include 'resource.fd'

! Variables
type (T_RECT) rChild, rParent
integer wChild, hChild, wParent, hParent
integer wScreen, hScreen, xNew, yNew
integer hdc
integer*4 retval

! Get the Height and Width of the child window
retval = GetWindowRect (hwndChild, rChild)
wChild = rChild.right - rChild.left
hChild = rChild.bottom - rChild.top

! Get the Height and Width of the parent window
retval = GetWindowRect (hwndParent, rParent)
wParent = rParent.right - rParent.left
hParent = rParent.bottom - rParent.top

! Get the display limits
hdc = GetDC (hwndChild)
wScreen = GetDeviceCaps (hdc, HORZRES)
hScreen = GetDeviceCaps (hdc, VERTRES)
retval = ReleaseDC (hwndChild, hdc)

! Calculate new X position, then adjust for screen
xNew = rParent.left + ((wParent - wChild) /2)
if (xNew .LT. 0) then
xNew = 0
else if ((xNew+wChild) .GT. wScreen) then
xNew = wScreen - wChild
end if

! Calculate new Y position, then adjust for screen
yNew = rParent.top + ((hParent - hChild) /2)
if (yNew .LT. 0) then
yNew = 0
else if ((yNew+hChild) .GT. hScreen) then
yNew = hScreen - hChild
end if

! Set it, and return
retval = SetWindowPos (hwndChild, NULL, xNew, yNew, 0, 0, &
IOR(SWP_NOSIZE , SWP_NOZORDER))
end

integer*4 function MyConfigDlgProc( hDlg, message, uParam, lParam )
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_AboutDlgProc@16' :: AboutDlgProc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'AboutDlgProc' :: AboutDlgProc
!DEC$ ENDIF

use kernel32
use user32
use gdi32
use dfwbase
use version
use dialogGlobals

implicit none

integer hDlg ! window handle of the dialog box
integer message ! type of message
integer uParam ! message-specific information
integer lParam

include 'resource.fd'

! Variables
integer*4 hfontDlg
save hfontDlg

integer dwVerHnd
integer dwVerInfoSize
integer uVersionLen
integer bRetCode
integer i
character*256 szFullPath
character*256 szResult
character*256 szGetName
character*256 lpversion

integer*4 lpstrVffInfo
integer*4 hMem
integer*4 ret

select case (message)
case (WM_INITDIALOG) ! message: initialize dialog box

! Center the dialog over the application window
call CenterWindow (hDlg, GetWindow (hDlg, GW_OWNER))

MyConfigDlgProc = 1
return
case (WM_COMMAND) ! message: received a command
if ((IAND(uParam,16#ffff) .EQ. IDOK) & !OK Selected?
.OR. (IAND(uParam,16#ffff) .EQ. IDCANCEL)) then ! Close command?
ret = EndDialog(hDlg, TRUE) ! Exit the dialog

MyConfigDlgProc = 1
return
end if
end select
MyConfigDlgProc = 0 ! Didn't process the message
return
end

Re: Problem of DialogProc

anthonyrichards — Wed, 26 Aug 2009 09:03:35 GMT

What is the 'problem' you get? What error messages? What happens?
Try replacing AboutDlgProc with MyConfigDlgProc in the following:

integer*4 function MyConfigDlgProc( hDlg, message, uParam, lParam )
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_AboutDlgProc@16' :: AboutDlgProc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'AboutDlgProc' :: AboutDlgProc
!DEC$ ENDIF

Otherwise attach a zipped archive of your project for further investigation

Re: Problem of DialogProc

Les_Neilson — Wed, 26 Aug 2009 09:42:12 GMT

Quoting - anthonyrichards

You could also replace all 5 !DEC$ lines with
!DEC$ ATTRIBUTES STDCALL, DECORATE, ALIAS :'MyConfigDlgProc'::MyConfigDlgProc
(similar for your WinMain function)

Note :
You should use integer(HANDLE) for hInstance and hPrevInstance (and others where appropriate)
similarly
integer(LPWSTR) lpszCmsLine
integer(SINT) nCmdShow

and so on.

Les

Re: Problem of DialogProc

Yuan_C_Intel — Wed, 26 Aug 2009 09:48:22 GMT

Quoting - csn1011

integer*4 function MyConfigDlgProc( hDlg, message, uParam, lParam )
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_AboutDlgProc@16' :: AboutDlgProc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'AboutDlgProc' :: AboutDlgProc
!DEC$ ENDIF

use kernel32
use user32
use gdi32
use dfwbase
use version
use dialogGlobals

Hi,
See from your code,the declared alias for "MyConfigDlgProc" is still "AboutDlgProc" which may causeyour problem.

topic Re: Problem of DialogProc in Intel® Fortran Compiler

Problem of DialogProc

Re: Problem of DialogProc

Re: Problem of DialogProc

Re: Problem of DialogProc