! 處理鼠標(biāo)事件的函數(shù)
module MouseEvent
use DFLIB
implicit none
Contains
  ! 鼠標(biāo)在窗口中每移動一次,就會調(diào)用這個函數(shù)
  subroutine ShowLocation(iunit, ievent, ikeystate, ixpos, iypos)
  implicit none
    integer :: iunit		! 鼠標(biāo)所在的窗口的unit值
	integer :: ievent		! 鼠標(biāo)發(fā)生的信息碼
	integer :: ikeystate	! 進(jìn)入這個函數(shù)時,其它控制鍵的狀態(tài)
	integer :: ixpos,iypos	! 鼠標(biāo)在窗口中的位置
    type(xycoord) :: t		 
	integer :: result		 
	character(len=15) :: output	! 設(shè)定輸出的字串

	result=SetActiveQQ(iunit)		! 把繪圖工作指向這個窗口
    write(output,100) ixpos,iypos	! 把鼠標(biāo)所在位置的信息寫入output
100 format("(X:",I4," Y:",I4,")")	!
    result=SetColorRGB(#1010FF)		 
    result=Rectangle($GFILLINTERIOR,0,0,120,18) ! 畫一個實心方形
    result=SetColorRGB(#FFFFFF) 
	call MoveTo( 4,2,t)	
	call OutGText(output)	! 顯示信息
	! 如果鼠標(biāo)在移動當(dāng)中, 左鍵同時被按下, 會順便畫出一個點.
	if ( ikeystate==MOUSE$KS_LBUTTON ) then
	  result=SetColorRGB(#0000FF)
	  result=SetPixel(ixpos,iypos)
	end if
	return
  end subroutine
  ! 鼠標(biāo)右鍵按下時, 會執(zhí)行這個函數(shù)
  subroutine MouseClearScreen(iunit, ievent, ikeystate, ixpos, iypos )
  implicit none
    integer :: iunit		! 鼠標(biāo)所在的窗口的unit值
	integer :: ievent		! 鼠標(biāo)發(fā)生的信息碼
	integer :: ikeystate	! 進(jìn)入這個函數(shù)時,其它控制鍵的狀態(tài)
	integer :: ixpos,iypos	! 鼠標(biāo)在窗口中的位置
    type(xycoord) :: t		 
	integer :: result		 

	result=SetActiveQQ(iunit)		! 把繪圖動作設(shè)定在鼠標(biāo)所在窗口上
    call ClearScreen($GCLEARSCREEN)	! 清除整個屏幕
    
	return
  end subroutine    
end module

program Mouse_Demo
use DFLIB
use MouseEvent
implicit none
  integer :: result
  integer :: event
  integer :: state,x,y

  result=AboutBoxQQ("Mouse Draw Demo\r By Perng 1997/09"C)
  ! 打開窗口
  open( unit=10, file='user', title='Mouse Demo', iofocus=.true. )
  ! 使用字形前, 一定要調(diào)用InitializeFonts
  result=InitializeFonts()
  ! 選用Courier New的字形在窗口中來輸出			
  result=setfont('t''Courier New''h14w8')
  call ClearScreen($GCLEARSCREEN)	! 先清除一下屏幕
  ! 設(shè)定鼠標(biāo)移動或按下左鍵時, 會調(diào)用ShowLocation
  event=ior(MOUSE$MOVE,MOUSE$LBUTTONDOWN)
  result=RegisterMouseEvent(10, event, ShowLocation)
  ! 設(shè)定鼠標(biāo)右鍵按下時, 會調(diào)用MouseClearScreen
  event=MOUSE$RBUTTONDOWN
  result=RegisterMouseEvent(10, event, MouseClearScreen )
  ! 把程序放入等待鼠標(biāo)輸入的狀態(tài)
  do while(.true.)
    result=WaitOnMouseEvent( MOUSE$MOVE .or. MOUSE$LBUTTONDOWN .or.&
  	MOUSE$RBUTTONDOWN, state, x, y )
  end do
end program