Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.

Problem of DialogProc

csn1011
Beginner
660 Views
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
0 Kudos
3 Replies
anthonyrichards
New Contributor III
660 Views
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

0 Kudos
Les_Neilson
Valued Contributor II
660 Views
Quoting - anthonyrichards
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


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
0 Kudos
Yuan_C_Intel
Employee
660 Views
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.
0 Kudos
Reply