- Fortran中文网 (http://fortran.cn/bbs/index.asp)
-- Fortran语言开发经验交流 (http://fortran.cn/bbs/list.asp?boardid=3)
---- [原创]进度栏和状态栏的做法 (http://fortran.cn/bbs/dispbbs.asp?boardid=3&id=975)
-- 发布时间：2007/8/29 16:27:33
-- [原创]进度栏和状态栏的做法
!**********************************************************************************
!*******************************(第0部分)程序说明模块******************************
!**********************************************************************************
!★功能★:程序展示了进度栏和状态栏的做法
!**********************************************************************************
!****************************(第一部分)有用的数据模块******************************
!**********************************************************************************
!
module Constant
use IFwin
use COMCTL32
logical*4 results !存储函数的返回值
integer*4 hInst !存储当前实例句柄
integer*4 udWnd,pos !存储进度栏的句柄和位置
!菜单的ID及其代号
integer*4,parameter:: IDC_CURSOR1 =102
integer*4,parameter:: IDI_ICON1 =103
integer*4,parameter:: IDR_MENU1 =101
integer*4,parameter:: IDD_DIALOG1 =104
integer*4,parameter:: IDC_BUTTON1 =1001
integer*4,parameter:: IDC_PROGRESS1 =1000
integer*4,parameter:: IDC_STATUS =10
integer*4,parameter:: ID_40001 =40001
end module Constant
!
!**********************************************************************************
!****************************(第二部分)主函数部分**********************************
!**********************************************************************************
!
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
!定义函数的传递参数
integer*4 hInstance !定义当前实例句柄
integer*4 hPrevInstance !定义句柄，永远是NULL型
integer*4 nCmdShow !定义程序执行的时候窗口的显示方式
integer*4 lpszCmdLine !指向字符串的指针
integer*4 i
!==========================================================
!定义函数接口，注意这一段是必须的
interface
integer*4 function MainWndProc ( hwnd, message, 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 message
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=12 !用来改变窗口的背景颜色，从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
hInst = hInstance
!创建窗口
hWnd = CreateWindowEx( 0, & !扩展的窗口风格
lpszClassName, & !窗口类的名字
lpszAppName, & !窗口的标题
WS_OVERLAPPEDWINDOW, & !窗口的类型
CW_USEDEFAULT, & !窗口左上角的X坐标
0, & !窗口左上角的Y坐标
CW_USEDEFAULT, & !窗口的宽度
0, & !窗口的高度
NULL, & !父窗口的句柄
NULL, & !主菜单的句柄
hInstance, & !当前实例句柄
NULL & !附加信息的指针
)
!显示窗口
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
!
!**********************************************************************************
!****************************(第三部分)窗口处理函数********************************
!**********************************************************************************
!
integer function MainWndProc ( hWnd, message, 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
integer*4 hWnd !窗口的句柄
integer*4 message !消息类结构体
integer*4 wParam !消息相关的附加信息
integer*4 lParam !消息相关的附加信息
integer*4 hdc !存储设备描述表的句柄
integer*4 Status !存储状态栏的句柄
type (T_RECT) WinDim !定义矩形区域
integer*4 parts(4) !存储状态栏中各个分区的最右边位置，此程序中将状态栏分为四部分
integer*4 j
!*****************************************************************
!定义对话框函数接口，注意这一段是必须的
interface
logical function DialogFunc ( hdWnd, message, 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 message
integer*4 wParam
integer*4 lParam
end function
end interface
!******************************************************************
results=GetClientRect( hWnd,WinDim) !获取窗口的大小
do j=1,4
parts(j) = (WinDim%right/4.0)*j !计算状态栏中各个区域最右边的位置
enddo
!进行消息的处理
select case ( message )
case(WM_CREATE)
hdc=CreateStatusWindow( ior(WS_CHILD,WS_VISIBLE), & !状态栏的特征
0, & !状态栏中显示的文本
hWnd, & !状态栏父窗口的句柄
IDC_STATUS) !状态栏的代号
case(WM_SIZE)
Status=GetDlgItem(hWnd ,IDC_STATUS) !获取状态栏的句柄
hdc=SendMessage(Status,WM_SIZE,0, 0) !发送改变尺寸的消息
hdc=SendMessage(Status,SB_SETPARTS,4,loc( parts)) !将状态栏分区
hdc=SendMessage(Status,SB_SETTEXT,0,loc("第一部分")) !给状态栏的第一分区写文本
hdc=SendMessage(Status,SB_SETTEXT,1,loc("第二部分"))
hdc=SendMessage(Status,SB_SETTEXT,2,loc("第三部分"))
hdc=SendMessage(Status,SB_SETTEXT,3,loc("第四部分"))
case(WM_COMMAND)
select case(wParam)
case(ID_40001)
pos=0
hdc=DialogBox(hInst,IDD_DIALOG1,hWnd,LOC(DialogFunc)) !显示对话框
end select
case (WM_DESTROY) !如果关闭窗口，则退出应用程序
call PostQuitMessage( 0 )
case default !其他信息系统自己处理
MainWndProc = DefWindowProc( hWnd,message, wParam, lParam )
return
end select
return
end
!
!**********************************************************************************
!**************************(第四部分)对话框处理函数********************************
!**********************************************************************************
logical function DialogFunc( hdWnd, message, 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
integer*4 hdWnd
integer*4 message
integer*4 wParam
integer*4 lParam
integer*4 hdc
logical*4 F,T
F = .false.
T = .true.
select case (message)
case ( WM_INITDIALOG )
udWnd=GetDlgItem(hdWnd ,IDC_PROGRESS1) !获得进度栏的句柄
hdc=SendMessage(udWnd,PBM_SETRANGE,0,MAKELONG(0,50)) !设置进度栏的范围
hdc=SendMessage(udWnd,PBM_SETSTEP,5,0) !设置进度栏的步长
DialogFunc = T
return
case ( WM_COMMAND )
select case( wParam )
case( IDCANCEL )
results = EndDialog(hdWnd,0)
DialogFunc = T
return
case( IDC_BUTTON1 )
hdc=SendMessage(udWnd,PBM_STEPIT,0,0) !按步长推进进度栏
pos=pos+5
if(pos>50)then
results = EndDialog(hdWnd,0)
endif
DialogFunc = T
return
end select
end select
DialogFunc = F
return
end function DialogFunc
-- 发布时间：2007/8/29 16:53:37
--
上面为进度栏所在的对话框!
此主题相关图片如下：
.-- 发布时间：2017/9/16 13:41:56
--
ivf下编译出错。