- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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
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
Link Copied
3 Replies
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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
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
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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
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
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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.

Reply
Topic Options
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page