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

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

 

上面为进度栏所在的对话框!
此主题相关图片如下：
.

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

 

ivf下编译出错。