!**********************************************************************************
!*******************************(第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

http://lmlxt.spaces.live.com/

 

此主题相关图片如下：

和程序对应的对话框

http://lmlxt.spaces.live.com/

 

 

cvf不支持winapi编程的。
用vs＋ivf。

另：版主真强。

 

我猜跟cvf无关，而在于    
use IFwin
   use COMCTL32                                            必须具有的库文件


另：赞同 版主真强。

复兴汉服，还我中华衣冠，复我中华礼仪
http://www.tianhan.com.cn/bbs/index.asp
<img>http://memory.116.com.cn/uploadfiles/ttmovie/2005222154103.jpg</img>

 

http://lmlxt.spaces.live.com/

 

谢谢！对我颇有帮助

 

学习学习

 

程序倒是能运行，但是界面上什么也没有，咋回事？