-
1212121.png (7.3 KB, 下载次数: 186)
1212121.png (7.3 KB, 下载次数: 186)
2121212.png (9.78 KB, 下载次数: 185)
integer*4 function WinMain(hInstance,hPrevInstance,lpszCmdLine,nCmdShow )
use user32
use kernel32
use dfwin
use ChiGlo
use dflogm
implicit none
integer*4 hInstance
integer*4 hPrevInstance
integer*4 lpszCmdLine
integer*4 nCmdShow
include 'resource.fd'
include 'Chi.fi'
! Variables
type (T_WNDCLASS) wc
type (T_MSG) mesg
TYPE (T_RECT) rects
integer*4 ret,mwidth
logical*4 lret
integer haccel
character(SIZEOFAPPNAME) lpszClassName
character(SIZEOFAPPNAME) lpszLeftClassName
character(SIZEOFAPPNAME) lpszRightClassName
character(SIZEOFAPPNAME) lpszInputClassName
character(SIZEOFAPPNAME) lpszDisClassName
character(SIZEOFAPPNAME) lpszIconName
character(SIZEOFAPPNAME) lpszAppName
character(SIZEOFAPPNAME) lpszMenuName
character(SIZEOFAPPNAME) lpszAccelName
character(SIZEOFAPPNAME) lpszMDIClassName
character(SIZEOFAPPNAME) lpszMDITextClassName
character(SIZEOFAPPNAME) lpszMDIMenuName
!
external LeftDlgProcSub
external ChangeTabSub
external ContourSub
external cntrSelSub
external PhaseSpaceSub
external PhasSelSub
external VectorSub
external VectSelSub
external RangeSub
external RangSelSub
external ObserverSub
external ObseSelSub
external DisplaySub
external DispSelSub
external ButtonRunSub
external ButtonNextSub
external ButtonTileSub
external ButtonPauSub
external ButtonDevSub
external ButtonTmPlotSub
external ButtonStopSub
external ButtonGridSub
external ButtonObsLocSub
external ButtonRefeSub
external ObseComboSub
external CntrComboSub
external VectComboSub
external PhasComboSub
external RangComboSub
!
gBfcnt=0
gZoomRd=.FALSE.
gZoomIn=.FALSE.
ghInstance = hInstance
ghModule = GetModuleHandle(NULL)
ghwndMain = NULL
!
lpszClassName ="Chi"C
lpszLeftClassName ="ChiLeft"C
lpszRightClassName ="ChiRight"C
lpszInputClassName ="ChiInput"C
lpszDisClassName ="Chiis"C
!
lpszMDIClassName ="Chip"C
lpszMDITextClassName ="ChiText"C
lpszAppName ="CPic3dp"C
lpszIconName ="CP3DP"C
lpszMenuName ="Chipic3d"C
lpszAccelName ="Chipic3d"C
if (hPrevInstance .eq. 0) then
! Main window
wc%lpszClassName = LOC(lpszClassName)
wc%lpfnWndProc = LOC(MainWndProc)
wc%style = CS_OWNDC
wc%hInstance = hInstance
wc%hIcon = LoadIcon( hInstance, MAKEINTRESOURCE(IDI_ICONN)) !LoadIcon( hInstance, LOC(lpszIconName))
wc%hCursor = LoadCursor( NULL, IDC_ARROW )
wc%hbrBackground = ( COLOR_WINDOW+1 )
wc%lpszMenuName = NULL
wc%cbClsExtra = 0
wc%cbWndExtra = 4
if (RegisterClass(wc) == 0) goto 99999
! Open input dlg
wc%lpszClassName = LOC(lpszInputClassName)
wc%lpfnWndProc = LOC(InputDisOpen)
! input dis text
wc%lpszClassName = LOC(lpszDisClassName)
wc%lpfnWndProc = LOC(InputDisText)
! right Child window
wc%lpszClassName = LOC(lpszRightClassName)
wc%lpfnWndProc = LOC(RightWndProc)
if (RegisterClass(wc) == 0) goto 99999
! MDI Child window
wc%lpszClassName = LOC(lpszMDIClassName)
wc%lpfnWndProc = LOC(MDIWndProc)
if (RegisterClass(wc) == 0) goto 99999
! Text window (child of MDI Child window)
wc%lpszClassName = LOC(lpszMDITextClassName)
wc%lpfnWndProc = LOC(TextWndProc)
wc%style = IOR(CS_OWNDC, IOR(CS_HREDRAW, CS_VREDRAW))
wc%hIcon = NULL
wc%hbrBackground = ( COLOR_BTNSHADOW )
if (RegisterClass(wc) == 0) goto 99999
! Left Child window
wc%lpszClassName = LOC(lpszLeftClassName)
wc%lpfnWndProc = LOC(LeftWndProc)
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
! Load the child window's menu
!
lpszMDIMenuName = "ChiChild"C
ghChildMenu = LoadMenu(hInstance, LOC(lpszMDIMenuName))
if (ghMenu == 0) goto 99999
ghMenuWindow = GetSubMenu(ghMenu, 1)
ghChildMenuWindow = GetSubMenu(ghChildMenu, 2)
ghwndMain = CreateWindowEx( 0, lpszClassName,lpszAppName,IOR(WS_OVERLAPPED, IOR(WS_CAPTION, IOR(WS_BORDER, &
IOR(WS_THICKFRAME, IOR(WS_MAXIMIZEBOX, IOR(WS_MINIMIZEBOX,IOR(WS_CLIPCHILDREN, &
IOR(WS_VISIBLE, WS_SYSMENU)))))))),50,50,800,600,NULL,ghMenu,hInstance,NULL)
if (ghwndMain == 0) goto 99999
lret = ShowWindow( ghwndMain, SW_SHOWMAXIMIZED )
Lret = GetClientRect (ghwndMain, rects)
glleftpos=rects%left
gltoppos=rects%top
mwidth=rects%right-rects%left
glwidth=mwidth*0.155
glhight=abs(rects%top-rects%bottom)
!
ghwndLeft = CreateWindowEx( 0, lpszLeftClassName,lpszAppName,IOR(WS_CHILD, IOR(WS_BORDER,WS_VISIBLE)), &
glleftpos,gltoppos,glwidth,glhight,ghwndMain,NULL,hInstance,NULL)
if (ghwndLeft == 0) goto 99999
lret = DlgInit(IDD_LEFT_DLG, gdlg)
lret = DlgSetSub(gdlg, IDD_LEFT_DLG, LeftDlgProcSub)
lret = DlgSetSub(gdlg, IDC_TAB, ChangeTabSub)
! lret = DlgSetSub(gdlg, IDC_BUTRUN, ButtonRunSub)
! lret = DlgSetSub(gdlg, IDC_BUTSTOP, ButtonStopSub)
! lret = DlgSetSub(gdlg, IDC_BUTGRID, ButtonGridSub)
! lret = DlgSetSub(gdlg, IDC_BUTOBSLOC, ButtonObsLocSub)
lret = DlgSetSub(gdlg, IDC_BUTNEXT, ButtonNextSub)
lret = DlgSetSub(gdlg, IDC_BUTTONPPU, ButtonTileSub)
lret = DlgSetSub(gdlg, IDC_BUTTONREF, ButtonRefeSub)
!
!lret = DlgSetSub(gdlg, IDC_BUTPAUSE, ButtonPauSub)
lret = DlgSetSub(gdlg, IDC_BUTDEVICE, ButtonDevSub)
! lret = DlgSetSub(gdlg, IDC_BUTTMPLOT, ButtonTmPlotSub)
! Set initial tabs
lret = DlgSet(gdlg, IDC_TAB, 7)
lret = DlgSet(gdlg, IDC_TAB, "*****", 1)
lret = DlgSet(gdlg, IDC_TAB, "*****", 2)
lret = DlgSet(gdlg, IDC_TAB, "*****", 3)
lret = DlgSet(gdlg, IDC_TAB, "*****", 4)
lret = DlgSet(gdlg, IDC_TAB, "*****", 5)
lret = DlgSet(gdlg, IDC_TAB, "******", 6)
lret = DlgSet(gdlg, IDC_TAB, "******", 7)
!
lret = DlgSet(gdlg, IDC_TAB, IDD_OBSE_DLG, 1)
lret = DlgSet(gdlg, IDC_TAB, IDD_CNTR_DLG, 2)
lret = DlgSet(gdlg, IDC_TAB, IDD_PHAS_DLG, 3)
lret = DlgSet(gdlg, IDC_TAB, IDD_VECT_DLG, 4)
lret = DlgSet(gdlg, IDC_TAB, IDD_RANG_DLG, 5)
lret = DlgSet(gdlg, IDC_TAB, IDD_3DOB_DLG, 6)
lret = DlgSet(gdlg, IDC_TAB, IDD_DISP_DLG, 7)
! Initialize the tab dialog boxes
lret = DlgInit(IDD_OBSE_DLG, gdlg_tab1)
lret = DlgSetSub(gdlg_tab1, IDD_OBSE_DLG, ObserverSub)
lret = DlgSetSub(gdlg_tab1, IDC_OBSE_LIST, ObseSelSub)
lret = DlgInit(IDD_CNTR_DLG, gdlg_tab2)
lret = DlgSetSub(gdlg_tab2, IDD_CNTR_DLG, ContourSub)
lret = DlgSetSub(gdlg_tab2, IDC_CNTR_LIST, CntrSelSub)
lret = DlgInit(IDD_PHAS_DLG, gdlg_tab3)
lret = DlgSetSub(gdlg_tab3, IDD_PHAS_DLG, PhaseSpaceSub)
lret = DlgSetSub(gdlg_tab3, IDC_PHAS_LIST, PhasSelSub)
lret = DlgInit(IDD_VECT_DLG, gdlg_tab4)
lret = DlgSetSub(gdlg_tab4, IDD_VECT_DLG, VectorSub)
lret = DlgSetSub(gdlg_tab4, IDC_VECT_LIST, VectSelSub)
lret = DlgInit(IDD_RANG_DLG, gdlg_tab5)
lret = DlgSetSub(gdlg_tab5, IDD_RANG_DLG, RangeSub)
lret = DlgSetSub(gdlg_tab5, IDC_RANG_LIST, RangSelSub)
lret = DlgInit(IDD_3DOB_DLG, gdlg_tab6)
lret = DlgInit(IDD_DISP_DLG, gdlg_tab7)
lret = DlgSetSub(gdlg_tab7, IDD_DISP_DLG, DisplaySub)
lret = DlgSetSub(gdlg_tab7, IDC_DISP_LIST, DispSelSub)
lret = DlgSetSub(gdlg_tab1, IDC_COMBO_OBSE, ObseComboSub)
lret = DlgSetSub(gdlg_tab2, IDC_COMBO_CNTR, CntrComboSub)
lret = DlgSetSub(gdlg_tab3, IDC_COMBO_PHAS, PhasComboSub)
lret = DlgSetSub(gdlg_tab4, IDC_COMBO_VECT, VectComboSub)
lret = DlgSetSub(gdlg_tab5, IDC_COMBO_RANG, RangComboSub)
!
lret = DlgModeless(gdlg, nCmdShow)
hWndDlg=gdlg%HWND
lret = SetParent(hWndDlg,ghwndLeft)
!
grleftpos=glleftpos+glwidth+5
grtoppos=gltoppos
grwidth=mwidth-grleftpos
grhight=rects%bottom
ghwndRight = CreateWindowEx( 0, lpszRightClassName,lpszAppName,IOR(WS_CHILD, IOR(WS_BORDER,WS_VISIBLE)), &
grleftpos,grtoppos,grwidth, grhight,ghwndMain,NULL,hInstance,NULL)
if (ghwndRight == 0) goto 99999
lret=ENABLEWindow(ghwndMain,TRUE)
ret=EnableMenuItem(ghMenu,IDM_SAVEAS,TRUE)
lret=ENABLEWindow(ghwndRight,TRUE)
lret=ENABLEWindow(ghwndLeft,TRUE)
CALL ActiveMainWnd( )
CALL EnableLeftButton(4 )
do while( GetMessage (mesg, NULL, 0, 0) )
if((mesg%message.eq.WM_KEYDOWN).and.(hCtrlDlg.eq.0))THEN
call KeyBoardProc(mesg%wParam)
else if (( TranslateAccelerator (ghwndMain, haccel, mesg) == 0) &
.AND. (TranslateMDISysAccel( ghwndClient, mesg) .EQV. .FALSE.)) then
lret = TranslateMessage( mesg )
ret = DispatchMessage( mesg )
end if
end do
RET=DestroyIcon( LOC(lpszIconName))
WinMain = mesg.wParam
return
99999 &
ret = MessageBox(ghwndMain, "Error initializing application Chipic3d"C, "Error"C, MB_OK)
WinMain = 0
end
kyra 发表于 2018-6-11 18:25
需要给出更多的代码，比如 hInstance 的定义。
你也可以简化你的代码，把绝大多数不必要的去掉，能重现问题 ...
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 dfwin
use dflogm
implicit none
integer(SINT) :: WinMain
integer(HANDLE) hInstance
integer(HANDLE) hPrevInstance
integer(LPWSTR) lpszCmdLine
integer(SINT) nCmdShow
| 欢迎光临 Fortran Coder (http://bbs.fcode.cn/) | Powered by Discuz! X3.2 |
