[原创]最简单的windows框架源程序[Fortran中文网]

楼主

[原创]最简单的windows框架源程序

!******************************************************************************
!这是用fortran语言开发的一个最简单的windows程序
!程序用来显示一个具有windows特征的窗口
!******************************************************************************
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 user32
!定义函数的传递参数
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( NULL, IDI_WINLOGO)    !指定窗口的图标
     wc%hCursor = LoadCursor( NULL, IDC_CROSS ) !指定鼠标光标
     wc%hbrBackground = ( COLOR_WINDOW+COLOR )  !指定窗口的背景颜色
     wc%lpszMenuName = 0                        !指定窗口主菜单的名字
     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                        &  !附加信息的指针
                        )

!显示窗口
i = ShowWindow( hWnd, SW_SHOWNORMAL)
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
!*********************************以下是窗口处理函数***************************
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
integer*4 hWnd      !窗口的句柄
integer*4 mesg      !消息类结构体
integer*4 wParam    !消息相关的附加信息
integer*4 lParam    !消息相关的附加信息
!进行消息的处理
select case ( mesg )
         case (WM_DESTROY)       !如果关闭窗口，则退出应用程序
               call PostQuitMessage( 0 )
         case default           !其他信息系统自己处理
               MainWndProc = DefWindowProc( hWnd, mesg, wParam, lParam )
end select
return
end
程序在CVF或者IVF中都可以运行.
在这个框架下面,可以加入自己想要的一部分,使自己的程序具有简单的界面!

[此贴子已经被作者于2007-4-21 15:26:48编辑过]

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