SimplelyFortan界面模块AppGraphics - Fortran Coder

[Fortran] 纯文本查看 复制代码
program main

    use appgraphics

    implicit none

    

    integer::myscreen,i,i1,i2,i3,i4,i5,i6

    character(1)::s

    

    myscreen = initwindow(800, 400, "整数加、减、乘法简单程序", closeflag=.TRUE.)!动画必须dbflag=.TRUE.

    call setcolor(WHITE) !前景色

    call setbkcolor(GREEN) !背景色

    call setmatchthemetextstyle()

    call settextstyle(SERIF_FONT, HORIZ_DIR, 25) !设置字体、文字方向、字号

    call settextjustify(CENTER_TEXT,CENTER_TEXT) !文本居中对齐

    call clearviewport()!清屏

    

    i1=createtextbox(100,200,50,25)!文本框

    call settextboxcontents(i1, "1")!初始值



    i2=createtextbox(200,200,50,25)!文本框

    call settextboxcontents(i2, "2")!初始值

    

    i3=createscrollbar (155, 185, 40, 56, SCROLL_VERTICAL, test) !垂直滚动条

    call setscrollrange(i3,1,3) !设置垂直滚动条档位范围

    call setscrollposition(i3,1) !设置垂直滚动条当前档位

    

    i4=createtextbox (155, 200, 40, 25)!文本框

    call settextboxcontents(i4, "+")!初始值

    

    i5=createtextbox(250, 200,50,25)!文本框

    call settextboxcontents(i5, "=")!初始值

    i6=createtextbox(300, 200,100,25)!文本框

    call settextboxcontents(i6, "3")!初始值

    

    i = createbutton(450, 200, 50, 25, "Run", start)!按钮

    i = createbutton(600, 200, 60, 25, "Close", quit)!按钮

    

    call loop()

    call closewindow(myscreen) !关闭窗口

contains

    subroutine Quit()

        call stopidle()

    end subroutine

    

    subroutine start()

        integer::i,j,k,m=0

        character(80)::s1,s2,s3

        

        i=gettextboxcontents(i1,s1) !i返回字符串长度 s1返回文本字符串

        j=gettextboxcontents(i2,s2) 

        read(s1,*)i !字符串转换为整数

        read(s2,*)j

        

        k=getscrollposition (i3)!返回滚动条当前位置



        select case(k)

        case(1)

            m=i+j

        case(2)

            m=i-j

        case(3)

            m=i*j

        end select

        

        write(s3,"(i0)")m !整数转换为字符串

        call settextboxcontents (i4, s)!设置文本框内容

        call settextboxcontents (i6, trim(adjustl(s3)))!设置文本框内容 

    end subroutine

    

    subroutine test(j) !j返回滚动条位置

        integer::j



        select case(j)

        case(1)

            s="+"

        case(2)

            s="-"

        case(3)

            s="*"

        end select

        

        call settextboxcontents (i4, s)!设置文本框内容

    End subroutine

end program main