!
! 使用菜單及對(duì)話窗的范例
! By Perng 1997/9/22
program Menu_Demo
use DFLIB
implicit none
  type(windowconfig) :: wc
  integer :: result  
  integer :: i,ix,iy

  wc.numxpixels=200 ! 窗口的寬
  wc.numypixels=200 ! 窗口的高
  ! -1代表讓程序自行去做決定
  wc.numtextcols=-1	! 每行容量的文字
  wc.numtextrows=-1	! 可以有幾列文字
  wc.numcolors=-1	! 使用多少顏色
  wc.title="Plot Area"C ! 窗口的標(biāo)題
  wc.fontsize=-1
  ! 根據(jù)wc中所定義的數(shù)據(jù)來重新設(shè)定窗口大小
  result=SetWindowConfig(wc)
  ! 把程序放入等待鼠標(biāo)信息的狀態(tài)
  do while (.TRUE.)
    i = waitonmouseevent(MOUSE$RBUTTONDOWN, i, ix, iy)
  end do
end program
!
! 程序會(huì)自動(dòng)執(zhí)行這個(gè)函數(shù), 它會(huì)設(shè)定窗口的模樣
!
logical(kind=4) function InitialSettings()
use DFLIB
implicit none
  logical(kind=4) :: result
  type(qwinfo) :: qw
  external PlotSin,PlotCos  
  external SetRange
  
  ! 設(shè)定整個(gè)窗口程序一開始出現(xiàn)的位置及大小
  qw.type=QWIN$SET
  qw.x=0
  qw.y=0
  qw.h=400
  qw.w=400
  result=SetWSizeQQ(QWIN$FRAMEWINDOW,qw) 
  
  ! 組織第一組菜單
  result=AppendMenuQQ(1,$MENUENABLED,'&File'C,NUL)		 
  result=AppendMenuQQ(1,$MENUENABLED,'&Save'C,WINSAVE)   
  result=AppendMenuQQ(1,$MENUENABLED,'&Print'C,WINPRINT) 
  result=AppendMenuQQ(1,$MENUENABLED,'&Exit'C,WINEXIT)  
  ! 組織第二組菜單
  result=AppendMenuQQ(2,$MENUENABLED,'&Plot'C,NUL)
  result=AppendMenuQQ(2,$MENUENABLED,'&sin(x)'C,PlotSin)
  result=AppendMenuQQ(2,$MENUENABLED,'&cos(x)'C,PlotCos)
  ! 組織第三組菜單
  result=AppendMenuQQ(3,$MENUENABLED,'&Range'C,SetRange)

  InitialSettings=.true.
  return
end function InitialSettings
!
! 記錄全局變量
!
module Global
implicit none
  real(kind=8) :: X_Start=-5.0  ! x軸最小范圍
  real(kind=8) :: X_End=5.0		! x軸最大范圍	
  real(kind=8) :: Y_Top=5.0		! y軸最大范圍 
  real(kind=8) :: Y_Buttom=-5.0	! y軸最小范圍
  integer      :: lines=500     ! 用多少線段來畫函數(shù)曲線
  integer	   :: Function_Num=0 ! 使用第幾號(hào)函數(shù)來畫圖
end module  
!
! 畫sin的子程序
!
subroutine PlotSin(check)
use DFLIB
use Global
implicit none
  logical(kind=4) :: check
  real(kind=8), external :: f1
  integer :: result
  check=.true.
  Function_Num=1
  ! 在第二組菜單的第一個(gè)選項(xiàng),也就是sin的前面打個(gè)勾
  result=ModifyMenuFlagsQQ(2,1,$MENUCHECKED)
  ! 把選項(xiàng)cos前的勾取消
  result=ModifyMenuFlagsQQ(2,2,$MENUUNCHECKED)
  call Draw_Func(f1)
  return
end subroutine
!
! 畫cos的子程序
!
subroutine PlotCos(check)
use DFLIB
use Global
implicit none
  logical(kind=4) :: check
  real(kind=8), external :: f2
  integer :: result
  check=.true.
  Function_Num=2
  ! 把選項(xiàng)sin前的勾取消
  result=ModifyMenuFlagsQQ(2,1,$MENUUNCHECKED)
  ! 在選項(xiàng)cos前打個(gè)勾
  result=ModifyMenuFlagsQQ(2,2,$MENUCHECKED)
  call Draw_Func(f2)
  return
end subroutine
!
! 按下Range時(shí),會(huì)執(zhí)行這個(gè)子程序
!
subroutine SetRange(check)
use Global
use Dialogm
implicit none
  logical(kind=4) :: check
  real(kind=8), external :: f1,f2
  external ReSetRange
  ! 因?yàn)橄朐趯?duì)話窗中保留上一次的設(shè)定結(jié)果,所以安排了下列的變量
  real(kind=8),save :: OX_Start=-5.0  ! x軸最小范圍
  real(kind=8),save :: OX_End=5.0	  ! x軸最大范圍	
  real(kind=8),save :: OY_Top=5.0	  ! y軸最大范圍 
  real(kind=8),save :: OY_Buttom=-5.0 ! y軸最小范圍
  integer     ,save :: Olines=500     ! 用多少線段來畫函數(shù)曲線
  include 'resource.fd'	! 對(duì)話窗的信息 
  type(dialog) :: dl	
  integer :: result		!
  character(len=20) :: str	

  check=.true.
  ! 聲明要使用代碼為IDD_INPUT的對(duì)話窗, 并把顯示這個(gè)對(duì)話窗的信息放
  ! 在dl中. 以后只要對(duì)dl來處理就等于對(duì)這個(gè)對(duì)話窗來工作
  result=DlgInit(IDD_INPUT, dl)
    
  ! 下面要對(duì)dl所代表的對(duì)話窗中ID值為IDC_X_MIN來設(shè)定初值
  ! 也就是設(shè)定IDD_INPUT中X min欄的內(nèi)容
  
  ! 因?yàn)镈lgSet無法使用read類型變量來設(shè)定,所以要先把它們轉(zhuǎn)換成字符串
  write(str,'(f6.2)') OX_Start
  result=DlgSet(dl,IDC_X_MIN,str)
  ! 設(shè)定X max欄的內(nèi)容
  write(str,'(f6.2)') OX_End
  result=DlgSet(dl,IDC_X_MAX,str)
  ! 設(shè)定Y min欄的內(nèi)容
  write(str,'(f6.2)') OY_Buttom
  result=DlgSet(dl,IDC_Y_MIN,str)
  ! 設(shè)定Y max欄的內(nèi)容
  write(str,'(f6.2)') OY_Top
  result=DlgSet(dl,IDC_Y_MAX,str)
  ! 設(shè)定Lines欄的內(nèi)容
  write(str,'(I5)') OLines
  result=DlgSet(dl,IDC_LINES,str)
  ! 設(shè)定按下Reset時(shí)會(huì)執(zhí)行的子程序
  result=DlgSetSub(dl,IDC_RESET, ReSetRange)
  ! 到此才真正秀出對(duì)話窗
  result=DlgModal(dl)
  
  if ( result==IDOK ) then
  ! 由字符串轉(zhuǎn)成數(shù)值
    result=DlgGet(dl,IDC_X_MIN,str)
    read(str,*) OX_Start
    result=DlgGet(dl,IDC_X_MAX,str)
	read(str,*) OX_End
    result=DlgGet(dl,IDC_Y_MIN,str)
	read(str,*) OY_Buttom
    result=DlgGet(dl,IDC_Y_MAX,str)
    read(str,*) OY_Top
    result=DlgGet(dl,IDC_LINES,str)
	read(str,*) OLines
  ! 設(shè)定全局變量的值, 繪圖時(shí)會(huì)取用這些數(shù)值
    X_Start=OX_Start
	X_End=OX_End
	Y_Top=OY_Top
	Y_Buttom=OY_Buttom
	Lines=OLines
  end if
  ! 由Function_Num的值來決定要畫出第幾個(gè)函數(shù)
  select case(Function_Num)
  case(0)
    ! Do Nothing
  case(1)
    call Draw_Func(f1) 
  case(2)
    call Draw_Func(f2)
  end select

  return
end subroutine
!
! 按下Reset會(huì)執(zhí)行這個(gè)子程序
! dlg,id,callback會(huì)自動(dòng)傳入
subroutine ReSetRange( dlg, id, callbacktype )
use DialogM
implicit none
  type(Dialog) :: dlg
  integer :: id,callbacktype
  integer :: t1,t2
  integer :: result
  include 'resource.fd'
  ! 下面這兩行沒什么用,只是如果沒有下面兩行,Compile時(shí)會(huì)有Warning.
  t1=id
  t2=callbacktype
  ! 重新設(shè)定對(duì)話窗中每個(gè)項(xiàng)的內(nèi)容
  result=DlgSet(dlg,IDC_X_MIN,'-5.00')
  result=DlgSet(dlg,IDC_X_MAX,' 5.00')
  result=DlgSet(dlg,IDC_Y_MIN,'-5.00')
  result=DlgSet(dlg,IDC_Y_MAX,' 5.00')
  result=DlgSet(dlg,IDC_LINES,'500')

  return
end subroutine  
!
! 畫出所傳入的函數(shù)圖形來
!
subroutine Draw_Func(func)
use DFLIB
use Global
implicit none
  integer :: result			! 取回繪圖函數(shù)運(yùn)行狀態(tài)
  integer(kind=2) :: color	! 設(shè)定顏色用
  real(kind=8) :: step		! 循環(huán)的增量
  real(kind=8) :: x,y		! 繪圖時(shí)使用,每條小線段都連接
  real(kind=8) :: NewX,NewY	! (x,y)及(NewX,NewY)
  real(kind=8), external :: func ! 待繪圖的函數(shù)
  type(wxycoord) :: wt		! 傳回上一次的邏輯坐標(biāo)位置

  call ClearScreen($GCLEARSCREEN) ! 清除屏幕
  ! 設(shè)定邏輯坐標(biāo)范圍大小	
  result=SetWindow( .true. , X_Start, Y_Top, X_End, Y_Buttom )

  ! 使用全彩RGB 0-255的256種色階來設(shè)定顏色
  color=RGBToInteger(255,0,0)		! 把控制RGB的三個(gè)值轉(zhuǎn)換到color中
  result=SetColorRGB(color)			! 利用color來設(shè)定顏色

  call MoveTo_W(X_Start,0.0_8,wt)	! 畫X軸
  result=LineTo_W(X_End,0.0_8)		! 
  call MoveTo_W(0.0_8,Y_Top,wt)		! 畫Y軸
  result=LineTo_W(0.0_8,Y_Buttom)	! 	

  step=(X_End-X_Start)/lines		! 計(jì)算小線段間的X間距
  ! 參數(shù)#FF0000是使用16進(jìn)制的方法來表示一個(gè)整數(shù)
  result=SetColorRGB(#FF0000)		 
  
  ! 開始繪制小線段們
  do x=X_Start,X_End-step,step
    y=func(x)		! 線段的左端點(diǎn)
	NewX=x+step		
	NewY=func(NewX)	! 線段的右端點(diǎn)
	call MoveTo_W(x,y,wt)
	result=LineTo_W(NewX,NewY)
  end do
  
  ! 設(shè)定程序結(jié)束后,窗口會(huì)繼續(xù)保留
  result=SetExitQQ(QWIN$EXITPERSIST)
end subroutine Draw_Func
!
! 所要繪圖的函數(shù)
!
real(kind=8) function f1(x)
implicit none
  real(kind=8) :: x
  f1=sin(x)
  return
end function f1

real(kind=8) function f2(x)
implicit none
  real(kind=8) :: x
  f2=cos(x)
  return
end function f2