!**********************************************************************************
!*******************************(第0部分)程序说明模块******************************
!**********************************************************************************
!这是用fortran语言开发的一个windows窗口程序
!★功能★:程序展示了对话框中按钮、列表框、编辑框、复选框、单选框的用法，
! 同时复选框和单选框具有记忆功能！
!下表是Win32和Fortran数据类型的等价关系:
!┏━━━━━━━━━━━━━━┳━━━━━━━━━━━━━━━━━┓
!│ Win32 Data Type │ Equivalent Fortran Data Type │
!│ BOOL, BOOLEAN │ LOGICAL(4) │
!│ BYTE │ BYTE │
!│ CHAR, CCHAR, UCHAR │ CHARACTER │
!│ COLORREF │ INTEGER(4) │
!│ DWORD, INT, LONG, ULONG│ INTEGER(4) │
!│ SHORT, USHORT, WORD │ INTEGER(2) │
!│ FLOAT │ REAL(4) │
!│ All Handles │ INTEGER(4) │
!│ All Pointers (LP*, P*) │ INTEGER(4) (Integer Pointers)│
!┗━━━━━━━━━━━━━━┻━━━━━━━━━━━━━━━━━┛
! !**********************************************************************************
!****************************(第一部分)有用的数据模块******************************
!**********************************************************************************
module Constant
use IFwin
use COMCTL32 !必须具有的库文件
integer*4 hInst !存储对话框的句柄
integer*4 cbstatus1 !存储第一个复选框的状态
integer*4 cbstatus2 !存储第二个复选框的状态
integer*4 rbstatus1 !存储第一个单选框的状态
integer*4 rbstatus2 !存储第一个单选框的状态
character*200 string
logical*4 results !存储函数的返回值
integer*4,parameter:: NumButton = 5 !工具条上按纽的数目
type( T_TBBUTTON ), DIMENSION(*) :: tbrButtons( NumButton ) !定义按纽所需的结构体数组
end module Constant
module Toolbar !非常重要，将所有的资源形成这个数据块，这样在程序中容易引用
integer*4,parameter:: IDC_CURSOR1 =101
integer*4,parameter:: IDI_ICON1 =102
integer*4,parameter:: IDR_MENU1 =103
integer*4,parameter:: IDB_BITMAP1 =106
integer*4,parameter:: IDD_DIALOG1 =107
integer*4,parameter:: IDC_BUTTON1 =1000
integer*4,parameter:: IDC_LIST1 =1001
integer*4,parameter:: IDC_EDIT1 =1003
integer*4,parameter:: IDC_CHECK1 =1004
integer*4,parameter:: IDC_CHECK2 =1005
integer*4,parameter:: IDC_RADIO1 =1006
integer*4,parameter:: IDC_RADIO2 =1007
integer*4,parameter:: ID_40001 =40001
integer*4,parameter:: ID_40002 =40002
integer*4,parameter:: ID_40003 =40003
integer*4,parameter:: ID_40004 =40004
integer*4,parameter:: ID_40009 =40009
end module Toolbar
! !**********************************************************************************
!****************************(第二部分)主函数部分**********************************
!**********************************************************************************
integer 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 Constant
use Toolbar
!定义函数的传递参数
integer*4 hInstance !定义当前实例句柄
integer*4 hPrevInstance !定义句柄，永远是NULL型
integer*4 nCmdShow !定义程序执行的时候窗口的显示方式
integer*4 lpszCmdLine !指向字符串的指针
integer*4 i
!==============================================================
!定义函数接口，注意这一段是必须的
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
!==============================================================
type ( T_WNDCLASS ) wc !定义窗口的结构体类数据，确定窗口的特征
type ( T_MSG ) mesg !定义消息的结构体类数据
integer*4 hWnd !定义程序窗口的句柄
integer*4 COLOR !定义窗口的背景颜色
character*100 lpszClassName !定义窗口类的名字
character*100 lpszAppName !定义窗口的名字，即窗口的标题
COLOR=9 !用来改变窗口的背景颜色，从1-20颜色会变化
lpszClassName ="Generic"C
lpszAppName ="WINDOWS程序的框架"C
!指定窗口的特征
if(hPrevInstance .eq. 0) then
wc%lpszClassName = LOC( lpszClassName ) !指定窗口类的名字
wc%lpfnWndProc = LOC( MainWndProc ) !指定窗口函数的地址
wc%style = 0 !指定窗口的类型
wc%hInstance = hInstance !指定当前实例句柄
wc%hIcon = LoadIcon( hInstance, IDI_ICON1) !指定窗口的图标
wc%hCursor = LoadCursor( hInstance, IDC_CURSOR1 ) !指定鼠标光标
wc%hbrBackground = ( COLOR_WINDOW+COLOR ) !指定窗口的背景颜色
wc%lpszMenuName = IDR_MENU1 !指定窗口主菜单的名字
wc%cbClsExtra = 0 !没有额外的信息提供
wc%cbWndExtra = 0 !没有额外的信息提供
i = RegisterClass( wc ) !让系统注册窗口，即告知系统窗口的特征是什么样的
end if
!创建窗口
hWnd = CreateWindowEx( 0, & !扩展的窗口风格
lpszClassName, & !窗口类的名字
lpszAppName, & !窗口的标题
INT( WS_OVERLAPPEDWINDOW ), & !窗口的类型
CW_USEDEFAULT, & !窗口左上角的X坐标
0, & !窗口左上角的Y坐标
CW_USEDEFAULT, & !窗口的宽度
0, & !窗口的高度
NULL, & !父窗口的句柄
NULL, & !主菜单的句柄
hInstance, & !当前实例句柄
NULL & !附加信息的指针
)
!=============初始化工具条======================================
call InitCommonControls()
call InitToolBar()
i = CreateToolbarEx( hwnd, &
WS_VISIBLE.OR.WS_CHILD.OR.WS_BORDER, &
IDB_BITMAP1, &
NumButton, &
hInstance, &
IDB_BITMAP1, &
tbrButtons, &
NumButton, &
16,16,16,16, &
sizeof(tbrButtons(1)) ) !非常重要的一句话
!==============================================================
hInst=hInstance !将实例句柄传给程序开始的全局变量
!显示窗口
i = ShowWindow( hWnd, SW_MAXIMIZE )
i = UpdateWindow( hWnd )
!进入消息循环
do while( GetMessage (mesg, NULL, 0, 0) .NEQV. .FALSE.)
i = TranslateMessage( mesg )
i = DispatchMessage( mesg )
end do
WinMain = mesg%wParam
return
end function WinMain
! !**********************************************************************************
!****************************(第三部分)窗口处理函数********************************
!**********************************************************************************
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
use Constant
use Toolbar
integer*4 hWnd !窗口的句柄
integer*4 mesg !消息类结构体
integer*4 wParam !消息相关的附加信息
integer*4 lParam !消息相关的附加信息
!====================================================
!定义对话框函数接口，注意这一段是必须的
interface
logical function DialogFunc ( hdWnd, mesg, wParam, lParam )
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_DialogFunc@16' :: DialogFunc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'DialogFunc' :: DialogFunc
!DEC$ ENDIF
integer*4 hdWnd
integer*4 mesg
integer*4 wParam
integer*4 lParam
end function
end interface
!====================================================
integer*4 hdc !存储设备描述表的句柄
!进行消息的处理
select case ( mesg )
case( WM_COMMAND ) !处理菜单选项
select case( wParam )
case( ID_40001 )
hdc=MessageBox(hWnd,"new","new",MB_OK)
case( ID_40002 )
hdc=DialogBox(hInst,IDD_DIALOG1,hWnd,LOC(DialogFunc)) !显示对话框
case( ID_40003 )
hdc=MessageBox(hWnd,"save","save",MB_OK)
case( ID_40004 )
call PostQuitMessage( 0 )
end select
case ( WM_DESTROY ) !如果关闭窗口，则退出应用程序
call PostQuitMessage( 0 )
case default !其他信息系统自己处理
MainWndProc = DefWindowProc( hWnd, mesg, wParam, lParam )
end select
return
end function MainWndProc
! !**********************************************************************************
!**************************(第四部分)对话框处理函数********************************
!**********************************************************************************
logical function DialogFunc( hdWnd, mesg, wParam, lParam )
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_DialogFunc@16' :: DialogFunc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'DialogFunc' :: DialogFunc
!DEC$ ENDIF
use Constant
use Toolbar
integer*4 hdWnd
integer*4 mesg
integer*4 wParam
integer*4 lParam
integer*4 i
logical*4 F,T
F=.false.
T=.true.
select case (mesg)
case ( WM_COMMAND )
select case( wParam )
case( IDC_LIST1 )
if( HIWORD(wParam)==LBN_DBLCLK )THEN
i=SendDlgItemMessage(hdWnd,IDC_LIST1,LB_GETCURSEL,0,0)
write(string,"('你选择了第',I1,'项！')")i+1
i=MessageBox(hdWnd,string,"提示框",MB_OK)
endif
DialogFunc = T
case( IDC_BUTTON1 )
i=SendDlgItemMessage(hdWnd,IDC_LIST1,LB_GETCURSEL,0,0)
if(i==LB_ERR)THEN
write(string,"('你没有作出选择！')")
else
write(string,"('你选择了第',I1,'项！')")i+1
endif
i=MessageBox(hdWnd,string,"提示框",MB_OK)
DialogFunc = T
case( IDC_CHECK1 ) !处理第一个复选框
if(SendDlgItemMessage(hdWnd,IDC_CHECK1,BM_GETCHECK,0,0)==BST_UNCHECKED)then
i=MessageBox(hdWnd,"很遗憾！" , "没有选中",MB_OK)
else
i=MessageBox(hdWnd,"您是老师？" , "选中",MB_OK)
endif
DialogFunc = T
case( IDC_CHECK2 ) !处理第二个复选框
if(SendDlgItemMessage(hdWnd,IDC_CHECK2,BM_GETCHECK,0,0)==BST_UNCHECKED)then
i=MessageBox(hdWnd,"很遗憾！" , "没有选中",MB_OK)
else
i=MessageBox(hdWnd,"您是学生？" , "选中",MB_OK)
endif
DialogFunc = T
case( IDC_RADIO1 ) !处理第一个单选框
if(SendDlgItemMessage(hdWnd,IDC_RADIO1,BM_GETCHECK,0,0)==BST_CHECKED)then
i=MessageBox(hdWnd,"先生，您好！" , "选中",MB_OK)
endif
DialogFunc=T
case( IDC_RADIO2 ) !处理第二个单选框
if(SendDlgItemMessage(hdWnd,IDC_RADIO2,BM_GETCHECK,0,0)==BST_CHECKED)then
i=MessageBox(hdWnd,"小姐，您好！" , "选中",MB_OK)
endif
DialogFunc=T
case( IDOK )
!将复选框的状态发送给对话框
cbstatus1=SendDlgItemMessage(hdWnd,IDC_CHECK1,BM_GETCHECK,0,0)
cbstatus2=SendDlgItemMessage(hdWnd,IDC_CHECK2,BM_GETCHECK,0,0)
!将单选框的状态发送给对话框
rbstatus1=SendDlgItemMessage(hdWnd,IDC_RADIO1,BM_GETCHECK,0,0)
rbstatus2=SendDlgItemMessage(hdWnd,IDC_RADIO2,BM_GETCHECK,0,0)
!提取编辑框中的内容
i=GetDlgItemText(hdWnd,IDC_EDIT1,string,200)
i=MessageBox(hdWnd,string,"你选择的课程为：",MB_OK)
i=EndDialog(hdWnd,.FALSE.)
DialogFunc = T
case( IDCANCEL )
results = EndDialog(hdWnd,1)
DialogFunc = T
end select
case ( WM_INITDIALOG )
!初始化复选框的状态
i=SendDlgItemMessage(hdWnd,IDC_CHECK1,BM_SETCHECK,cbstatus1,0)
i=SendDlgItemMessage(hdWnd,IDC_CHECK2,BM_SETCHECK,cbstatus2,0)
!初始化单选框的状态
i=SendDlgItemMessage(hdWnd,IDC_RADIO1,BM_SETCHECK,rbstatus1,0)
i=SendDlgItemMessage(hdWnd,IDC_RADIO2,BM_SETCHECK,rbstatus2,0)
!注意:一定将list box的sort设为“false”的时候，才会按你的顺序排列！
i=SendDlgItemMessage(hdWnd,IDC_LIST1,LB_ADDSTRING,0,LOC("计 算"C))
i=SendDlgItemMessage(hdWnd,IDC_LIST1,LB_ADDSTRING,0,LOC("物 理"C))
i=SendDlgItemMessage(hdWnd,IDC_LIST1,LB_ADDSTRING,0,LOC("数 学"C))
i=SendDlgItemMessage(hdWnd,IDC_LIST1,LB_ADDSTRING,0,LOC("语 文"C))
i=SendDlgItemMessage(hdWnd,IDC_LIST1,LB_ADDSTRING,0,LOC("英 语"C))
i=SendDlgItemMessage(hdWnd,IDC_LIST1,LB_ADDSTRING,0,LOC("历 史"C))
i=SendDlgItemMessage(hdWnd,IDC_LIST1,LB_ADDSTRING,0,LOC("地 理"C))
i=SendDlgItemMessage(hdWnd,IDC_LIST1,LB_ADDSTRING,0,LOC("生 物"C))
DialogFunc = T
end select
DialogFunc = F
return
end function DialogFunc
! !**********************************************************************************
!**************************(第五部分)工具条初始化函数******************************
!**********************************************************************************
subroutine InitToolBar( )
use Constant
use Toolbar
tbrButtons(1)%iBitmap = 0
tbrButtons(1)%idCommand = ID_40001
tbrButtons(1)%fsState = TBSTATE_ENABLED
tbrButtons(1)%fsStyle = TBSTYLE_BUTTON
tbrButtons(1)%dwData = 0
tbrButtons(1)%iString = 0
tbrButtons(2)%iBitmap = 1
tbrButtons(2)%idCommand = ID_40002
tbrButtons(2)%fsState = TBSTATE_ENABLED
tbrButtons(2)%fsStyle = TBSTYLE_BUTTON
tbrButtons(2)%dwData = 0
tbrButtons(2)%iString = 0
tbrButtons(3)%iBitmap = 2
tbrButtons(3)%idCommand = ID_40003
tbrButtons(3)%fsState = TBSTATE_ENABLED
tbrButtons(3)%fsStyle = TBSTYLE_BUTTON
tbrButtons(3)%dwData = 0
tbrButtons(3)%iString = 0
tbrButtons(4)%iBitmap = 3
tbrButtons(4)%idCommand = ID_40004
tbrButtons(4)%fsState = TBSTATE_ENABLED
tbrButtons(4)%fsStyle = TBSTYLE_BUTTON
tbrButtons(4)%dwData = 0
tbrButtons(4)%iString = 0
tbrButtons(5)%iBitmap = 4
tbrButtons(5)%idCommand = ID_40009
tbrButtons(5)%fsState = TBSTATE_ENABLED
tbrButtons(5)%fsStyle = TBSTYLE_BUTTON
tbrButtons(5)%dwData = 0
tbrButtons(5)%iString = 0
return
end subroutine InitToolBar
!*******************************(第0部分)程序说明模块******************************
!**********************************************************************************
!这是用fortran语言开发的一个windows窗口程序
!★功能★:程序展示了对话框中按钮、列表框、编辑框、复选框、单选框的用法，
! 同时复选框和单选框具有记忆功能！
!下表是Win32和Fortran数据类型的等价关系:
!┏━━━━━━━━━━━━━━┳━━━━━━━━━━━━━━━━━┓
!│ Win32 Data Type │ Equivalent Fortran Data Type │
!│ BOOL, BOOLEAN │ LOGICAL(4) │
!│ BYTE │ BYTE │
!│ CHAR, CCHAR, UCHAR │ CHARACTER │
!│ COLORREF │ INTEGER(4) │
!│ DWORD, INT, LONG, ULONG│ INTEGER(4) │
!│ SHORT, USHORT, WORD │ INTEGER(2) │
!│ FLOAT │ REAL(4) │
!│ All Handles │ INTEGER(4) │
!│ All Pointers (LP*, P*) │ INTEGER(4) (Integer Pointers)│
!┗━━━━━━━━━━━━━━┻━━━━━━━━━━━━━━━━━┛
! !**********************************************************************************
!****************************(第一部分)有用的数据模块******************************
!**********************************************************************************
module Constant
use IFwin
use COMCTL32 !必须具有的库文件
integer*4 hInst !存储对话框的句柄
integer*4 cbstatus1 !存储第一个复选框的状态
integer*4 cbstatus2 !存储第二个复选框的状态
integer*4 rbstatus1 !存储第一个单选框的状态
integer*4 rbstatus2 !存储第一个单选框的状态
character*200 string
logical*4 results !存储函数的返回值
integer*4,parameter:: NumButton = 5 !工具条上按纽的数目
type( T_TBBUTTON ), DIMENSION(*) :: tbrButtons( NumButton ) !定义按纽所需的结构体数组
end module Constant
module Toolbar !非常重要，将所有的资源形成这个数据块，这样在程序中容易引用
integer*4,parameter:: IDC_CURSOR1 =101
integer*4,parameter:: IDI_ICON1 =102
integer*4,parameter:: IDR_MENU1 =103
integer*4,parameter:: IDB_BITMAP1 =106
integer*4,parameter:: IDD_DIALOG1 =107
integer*4,parameter:: IDC_BUTTON1 =1000
integer*4,parameter:: IDC_LIST1 =1001
integer*4,parameter:: IDC_EDIT1 =1003
integer*4,parameter:: IDC_CHECK1 =1004
integer*4,parameter:: IDC_CHECK2 =1005
integer*4,parameter:: IDC_RADIO1 =1006
integer*4,parameter:: IDC_RADIO2 =1007
integer*4,parameter:: ID_40001 =40001
integer*4,parameter:: ID_40002 =40002
integer*4,parameter:: ID_40003 =40003
integer*4,parameter:: ID_40004 =40004
integer*4,parameter:: ID_40009 =40009
end module Toolbar
! !**********************************************************************************
!****************************(第二部分)主函数部分**********************************
!**********************************************************************************
integer 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 Constant
use Toolbar
!定义函数的传递参数
integer*4 hInstance !定义当前实例句柄
integer*4 hPrevInstance !定义句柄，永远是NULL型
integer*4 nCmdShow !定义程序执行的时候窗口的显示方式
integer*4 lpszCmdLine !指向字符串的指针
integer*4 i
!==============================================================
!定义函数接口，注意这一段是必须的
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
!==============================================================
type ( T_WNDCLASS ) wc !定义窗口的结构体类数据，确定窗口的特征
type ( T_MSG ) mesg !定义消息的结构体类数据
integer*4 hWnd !定义程序窗口的句柄
integer*4 COLOR !定义窗口的背景颜色
character*100 lpszClassName !定义窗口类的名字
character*100 lpszAppName !定义窗口的名字，即窗口的标题
COLOR=9 !用来改变窗口的背景颜色，从1-20颜色会变化
lpszClassName ="Generic"C
lpszAppName ="WINDOWS程序的框架"C
!指定窗口的特征
if(hPrevInstance .eq. 0) then
wc%lpszClassName = LOC( lpszClassName ) !指定窗口类的名字
wc%lpfnWndProc = LOC( MainWndProc ) !指定窗口函数的地址
wc%style = 0 !指定窗口的类型
wc%hInstance = hInstance !指定当前实例句柄
wc%hIcon = LoadIcon( hInstance, IDI_ICON1) !指定窗口的图标
wc%hCursor = LoadCursor( hInstance, IDC_CURSOR1 ) !指定鼠标光标
wc%hbrBackground = ( COLOR_WINDOW+COLOR ) !指定窗口的背景颜色
wc%lpszMenuName = IDR_MENU1 !指定窗口主菜单的名字
wc%cbClsExtra = 0 !没有额外的信息提供
wc%cbWndExtra = 0 !没有额外的信息提供
i = RegisterClass( wc ) !让系统注册窗口，即告知系统窗口的特征是什么样的
end if
!创建窗口
hWnd = CreateWindowEx( 0, & !扩展的窗口风格
lpszClassName, & !窗口类的名字
lpszAppName, & !窗口的标题
INT( WS_OVERLAPPEDWINDOW ), & !窗口的类型
CW_USEDEFAULT, & !窗口左上角的X坐标
0, & !窗口左上角的Y坐标
CW_USEDEFAULT, & !窗口的宽度
0, & !窗口的高度
NULL, & !父窗口的句柄
NULL, & !主菜单的句柄
hInstance, & !当前实例句柄
NULL & !附加信息的指针
)
!=============初始化工具条======================================
call InitCommonControls()
call InitToolBar()
i = CreateToolbarEx( hwnd, &
WS_VISIBLE.OR.WS_CHILD.OR.WS_BORDER, &
IDB_BITMAP1, &
NumButton, &
hInstance, &
IDB_BITMAP1, &
tbrButtons, &
NumButton, &
16,16,16,16, &
sizeof(tbrButtons(1)) ) !非常重要的一句话
!==============================================================
hInst=hInstance !将实例句柄传给程序开始的全局变量
!显示窗口
i = ShowWindow( hWnd, SW_MAXIMIZE )
i = UpdateWindow( hWnd )
!进入消息循环
do while( GetMessage (mesg, NULL, 0, 0) .NEQV. .FALSE.)
i = TranslateMessage( mesg )
i = DispatchMessage( mesg )
end do
WinMain = mesg%wParam
return
end function WinMain
! !**********************************************************************************
!****************************(第三部分)窗口处理函数********************************
!**********************************************************************************
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
use Constant
use Toolbar
integer*4 hWnd !窗口的句柄
integer*4 mesg !消息类结构体
integer*4 wParam !消息相关的附加信息
integer*4 lParam !消息相关的附加信息
!====================================================
!定义对话框函数接口，注意这一段是必须的
interface
logical function DialogFunc ( hdWnd, mesg, wParam, lParam )
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_DialogFunc@16' :: DialogFunc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'DialogFunc' :: DialogFunc
!DEC$ ENDIF
integer*4 hdWnd
integer*4 mesg
integer*4 wParam
integer*4 lParam
end function
end interface
!====================================================
integer*4 hdc !存储设备描述表的句柄
!进行消息的处理
select case ( mesg )
case( WM_COMMAND ) !处理菜单选项
select case( wParam )
case( ID_40001 )
hdc=MessageBox(hWnd,"new","new",MB_OK)
case( ID_40002 )
hdc=DialogBox(hInst,IDD_DIALOG1,hWnd,LOC(DialogFunc)) !显示对话框
case( ID_40003 )
hdc=MessageBox(hWnd,"save","save",MB_OK)
case( ID_40004 )
call PostQuitMessage( 0 )
end select
case ( WM_DESTROY ) !如果关闭窗口，则退出应用程序
call PostQuitMessage( 0 )
case default !其他信息系统自己处理
MainWndProc = DefWindowProc( hWnd, mesg, wParam, lParam )
end select
return
end function MainWndProc
! !**********************************************************************************
!**************************(第四部分)对话框处理函数********************************
!**********************************************************************************
logical function DialogFunc( hdWnd, mesg, wParam, lParam )
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_DialogFunc@16' :: DialogFunc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'DialogFunc' :: DialogFunc
!DEC$ ENDIF
use Constant
use Toolbar
integer*4 hdWnd
integer*4 mesg
integer*4 wParam
integer*4 lParam
integer*4 i
logical*4 F,T
F=.false.
T=.true.
select case (mesg)
case ( WM_COMMAND )
select case( wParam )
case( IDC_LIST1 )
if( HIWORD(wParam)==LBN_DBLCLK )THEN
i=SendDlgItemMessage(hdWnd,IDC_LIST1,LB_GETCURSEL,0,0)
write(string,"('你选择了第',I1,'项！')")i+1
i=MessageBox(hdWnd,string,"提示框",MB_OK)
endif
DialogFunc = T
case( IDC_BUTTON1 )
i=SendDlgItemMessage(hdWnd,IDC_LIST1,LB_GETCURSEL,0,0)
if(i==LB_ERR)THEN
write(string,"('你没有作出选择！')")
else
write(string,"('你选择了第',I1,'项！')")i+1
endif
i=MessageBox(hdWnd,string,"提示框",MB_OK)
DialogFunc = T
case( IDC_CHECK1 ) !处理第一个复选框
if(SendDlgItemMessage(hdWnd,IDC_CHECK1,BM_GETCHECK,0,0)==BST_UNCHECKED)then
i=MessageBox(hdWnd,"很遗憾！" , "没有选中",MB_OK)
else
i=MessageBox(hdWnd,"您是老师？" , "选中",MB_OK)
endif
DialogFunc = T
case( IDC_CHECK2 ) !处理第二个复选框
if(SendDlgItemMessage(hdWnd,IDC_CHECK2,BM_GETCHECK,0,0)==BST_UNCHECKED)then
i=MessageBox(hdWnd,"很遗憾！" , "没有选中",MB_OK)
else
i=MessageBox(hdWnd,"您是学生？" , "选中",MB_OK)
endif
DialogFunc = T
case( IDC_RADIO1 ) !处理第一个单选框
if(SendDlgItemMessage(hdWnd,IDC_RADIO1,BM_GETCHECK,0,0)==BST_CHECKED)then
i=MessageBox(hdWnd,"先生，您好！" , "选中",MB_OK)
endif
DialogFunc=T
case( IDC_RADIO2 ) !处理第二个单选框
if(SendDlgItemMessage(hdWnd,IDC_RADIO2,BM_GETCHECK,0,0)==BST_CHECKED)then
i=MessageBox(hdWnd,"小姐，您好！" , "选中",MB_OK)
endif
DialogFunc=T
case( IDOK )
!将复选框的状态发送给对话框
cbstatus1=SendDlgItemMessage(hdWnd,IDC_CHECK1,BM_GETCHECK,0,0)
cbstatus2=SendDlgItemMessage(hdWnd,IDC_CHECK2,BM_GETCHECK,0,0)
!将单选框的状态发送给对话框
rbstatus1=SendDlgItemMessage(hdWnd,IDC_RADIO1,BM_GETCHECK,0,0)
rbstatus2=SendDlgItemMessage(hdWnd,IDC_RADIO2,BM_GETCHECK,0,0)
!提取编辑框中的内容
i=GetDlgItemText(hdWnd,IDC_EDIT1,string,200)
i=MessageBox(hdWnd,string,"你选择的课程为：",MB_OK)
i=EndDialog(hdWnd,.FALSE.)
DialogFunc = T
case( IDCANCEL )
results = EndDialog(hdWnd,1)
DialogFunc = T
end select
case ( WM_INITDIALOG )
!初始化复选框的状态
i=SendDlgItemMessage(hdWnd,IDC_CHECK1,BM_SETCHECK,cbstatus1,0)
i=SendDlgItemMessage(hdWnd,IDC_CHECK2,BM_SETCHECK,cbstatus2,0)
!初始化单选框的状态
i=SendDlgItemMessage(hdWnd,IDC_RADIO1,BM_SETCHECK,rbstatus1,0)
i=SendDlgItemMessage(hdWnd,IDC_RADIO2,BM_SETCHECK,rbstatus2,0)
!注意:一定将list box的sort设为“false”的时候，才会按你的顺序排列！
i=SendDlgItemMessage(hdWnd,IDC_LIST1,LB_ADDSTRING,0,LOC("计 算"C))
i=SendDlgItemMessage(hdWnd,IDC_LIST1,LB_ADDSTRING,0,LOC("物 理"C))
i=SendDlgItemMessage(hdWnd,IDC_LIST1,LB_ADDSTRING,0,LOC("数 学"C))
i=SendDlgItemMessage(hdWnd,IDC_LIST1,LB_ADDSTRING,0,LOC("语 文"C))
i=SendDlgItemMessage(hdWnd,IDC_LIST1,LB_ADDSTRING,0,LOC("英 语"C))
i=SendDlgItemMessage(hdWnd,IDC_LIST1,LB_ADDSTRING,0,LOC("历 史"C))
i=SendDlgItemMessage(hdWnd,IDC_LIST1,LB_ADDSTRING,0,LOC("地 理"C))
i=SendDlgItemMessage(hdWnd,IDC_LIST1,LB_ADDSTRING,0,LOC("生 物"C))
DialogFunc = T
end select
DialogFunc = F
return
end function DialogFunc
! !**********************************************************************************
!**************************(第五部分)工具条初始化函数******************************
!**********************************************************************************
subroutine InitToolBar( )
use Constant
use Toolbar
tbrButtons(1)%iBitmap = 0
tbrButtons(1)%idCommand = ID_40001
tbrButtons(1)%fsState = TBSTATE_ENABLED
tbrButtons(1)%fsStyle = TBSTYLE_BUTTON
tbrButtons(1)%dwData = 0
tbrButtons(1)%iString = 0
tbrButtons(2)%iBitmap = 1
tbrButtons(2)%idCommand = ID_40002
tbrButtons(2)%fsState = TBSTATE_ENABLED
tbrButtons(2)%fsStyle = TBSTYLE_BUTTON
tbrButtons(2)%dwData = 0
tbrButtons(2)%iString = 0
tbrButtons(3)%iBitmap = 2
tbrButtons(3)%idCommand = ID_40003
tbrButtons(3)%fsState = TBSTATE_ENABLED
tbrButtons(3)%fsStyle = TBSTYLE_BUTTON
tbrButtons(3)%dwData = 0
tbrButtons(3)%iString = 0
tbrButtons(4)%iBitmap = 3
tbrButtons(4)%idCommand = ID_40004
tbrButtons(4)%fsState = TBSTATE_ENABLED
tbrButtons(4)%fsStyle = TBSTYLE_BUTTON
tbrButtons(4)%dwData = 0
tbrButtons(4)%iString = 0
tbrButtons(5)%iBitmap = 4
tbrButtons(5)%idCommand = ID_40009
tbrButtons(5)%fsState = TBSTATE_ENABLED
tbrButtons(5)%fsStyle = TBSTYLE_BUTTON
tbrButtons(5)%dwData = 0
tbrButtons(5)%iString = 0
return
end subroutine InitToolBar
