?? setcolor.f90
字號:
!
! 對話窗的示范之二
! By Perng 1997/09/26
program main
use DFLIB
implicit none
integer :: i,ix,iy
call ClearScreen($GCLEARSCREEN)
do while(.true.)
i = waitonmouseevent(MOUSE$LBUTTONDOWN, i, ix, iy)
end do
end program
!
! 記錄全局變量
!
module Global
implicit none
integer, save :: red=0
integer, save :: green=0
integer, save :: blue=0
end module
!
! 自定義菜單
!
logical(kind=4) function InitialSettings()
use DFLIB
implicit none
logical(kind=4) result
external FileOpen,FileSave
external SetColorDialog
result=AppendMenuQQ(1,$MENUENABLED,'File'C,NUL)
result=AppendMenuQQ(1,$MENUENABLED,'&Open'C,FileOpen)
result=AppendMenuQQ(1,$MENUENABLED,'&Save'C,FileSave)
result=AppendMenuQQ(1,$MENUENABLED,'&Exit'C,WINEXIT)
result=AppendMenuQQ(2,$MENUENABLED,'&SetColor',SetColorDialog)
InitialSettings=result
return
end function
!
! 處理Open
!
subroutine FileOpen(check)
use Global
implicit none
logical :: check
check=.true.
! 打開一個空白字符的文件, 會出現一個文件選擇的對話窗來給使用者選擇文件
open(unit=10, file=' ')
read(10,*) red
read(10,*) green
read(10,*) blue
close(10)
call DrawObject()
return
end subroutine
!
! 處理Save
!
subroutine FileSave(check)
use Global
implicit none
logical :: check
check=.true.
! 使用文件選擇的對話窗
open(unit=20, file=' ')
write(20,*) red
write(20,*) green
write(20,*) blue
close(20)
return
end subroutine
!
! 按下SetColor時會執行這個函數
!
subroutine SetColorDialog(check)
use Global
use DFLIB
use dialogm
implicit none
logical :: check
integer :: result
include 'resource.fd'
type(dialog) :: dlg
external ShowColor
character(len=10) output
check=.true.
result=DlgInit(IDD_SETCOLOR, dlg) ! 初始對話窗
! 設定滾動條可以滾動的范圍
result=DlgSet( dlg, IDC_SCROLLBAR1, 256, dlg_range )
result=DlgSet( dlg, IDC_SCROLLBAR2, 256, dlg_range )
result=DlgSet( dlg, IDC_SCROLLBAR3, 256, dlg_range )
! 設定滾動條目前的位置
result=DlgSet( dlg, IDC_SCROLLBAR1, red, dlg_position )
result=DlgSet( dlg, IDC_SCROLLBAR2, green, dlg_position )
result=DlgSet( dlg, IDC_SCROLLBAR3, blue, dlg_position )
! 上面有比較奇怪的用法, dlg_range代表現在是要設定滾動條控件的范圍值
! dlg_position代表是要設定滾動條控件的位置. 讀者可以想像當類型為dialog
! 的dlg被聲明時, 編譯器會自動幫我們聲明出dlg_range, dlg_position等等
! 的變量并設定好它們的數值.
! 寫出紅,綠,藍三色光的強度數值
write(output,"(I3)") red
result=DlgSet( dlg, IDC_VALUE_RED, output )
write(output,"(I3)") green
result=DlgSet( dlg, IDC_VALUE_GREEN, output )
write(output,"(I3)") blue
result=DlgSet( dlg, IDC_VALUE_BLUE, output )
! 設定拉動滾動條時會執行的函數
result=DlgSetSub( dlg, IDC_SCROLLBAR1, ShowColor )
result=DlgSetSub( dlg, IDC_SCROLLBAR2, ShowColor )
result=DlgSetSub( dlg, IDC_SCROLLBAR3, ShowColor )
! 彈出對話窗
result=DlgModal(dlg)
return
end subroutine
!
! 取出三色光的設定并繪出一個實心方形
!
subroutine ShowColor(dlg,id,callbacktype)
use Global
use DFLIB
use dialogm
implicit none
type(dialog) :: dlg
integer :: id, callbacktype
integer :: result
character(len=10) :: output
include 'resource.fd'
! 取出滾動條的位置
result=DlgGet( dlg, IDC_SCROLLBAR1, red, dlg_position )
result=DlgGet( dlg, IDC_SCROLLBAR2, green, dlg_position )
result=DlgGet( dlg, IDC_SCROLLBAR3, blue, dlg_position )
! 因為顏色的變化范圍是0-255, 而滾動條的范圍是1-256, 所以要減1
red=red-1
green=green-1
blue=blue-1
select case(id)
case(IDC_SCROLLBAR1) ! 第一個滾動條設定紅色光強度
write(output,"(I3)") red
result=DlgSet( dlg, IDC_VALUE_RED, output )
case(IDC_SCROLLBAR2) ! 第二個滾動條設定綠色光強度
write(output,"(I3)") green
result=DlgSet( dlg, IDC_VALUE_GREEN, output )
case(IDC_SCROLLBAR3) ! 第三個滾動條設定藍色光強度
write(output,"(I3)") blue
result=DlgSet( dlg, IDC_VALUE_BLUE, output )
end select
call DrawObject()
return
end subroutine
!
! 以設定的顏色畫出實心方形
!
subroutine DrawObject()
use Global
use DFLIB
implicit none
integer :: result
integer :: color
color=RGBToInteger(red,green,blue)
result=SetColorRGB(color)
result=Rectangle($GFILLINTERIOR,10,10,50,50)
return
end subroutine
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -