Comment: In MATLAB with same situation - used "hold on". If loop() does it here I'm not sure how it works. Thx for looking!
program test
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! program resizing
use appgraphics
implicit none
integer::myscreen
integer::mybutton
integer::mybutton1
integer::mybutton2
integer::mybutton3
integer::mybutton4
integer, volatile::task
integer, parameter::task_quit=0
integer, parameter::task_open=1
integer, parameter::task_run=2
integer::run_item
!--------------Added-------------------------------------\/
integer, parameter::task_win=3
integer, parameter::task_close=4
integer :: root_menu, file_menu, item_temp, win_menu, itr
integer :: file_menu1, file_menu2
character(2) :: CRLF, title
character(512) :: cTxt
logical :: bClose
integer, dimension(256)::child_windows
!--- CRLF = C_CARRIAGE_RETURN // C_NEW_LINE
CRLF = Achar(13) // Achar(10)
!--------------------------------------------------------/\
child_windows = -1
myscreen = initwindow(820, 940, closeflag=.FALSE.)
! myscreen = initwindow(400, 100, title=title, dbflag=.FALSE., closeflag=.FALSE.)
call setbkcolor(systemcolor(COLOR_WINDOW_BKGD))
call setcolor(BLACK)
call settextstyle(WINDOWS_FONT, HORIZ_DIR, 10)
call setfillstyle(SOLID_FILL, RED)
root_menu = addmenu("", MENU_FOR_WINDOW)
file_menu = addmenu("File", root_menu);
file_menu1 = addmenu("Last Seven Days", root_menu);
file_menu2 = addmenu("Last Eight Days", root_menu);
item_temp = addmenuitem("Open another window...", file_menu, handle_winopen)
item_temp = addmenuitem("Close a window...", file_menu, handle_winclose)
item_temp = addmenuitem("Save Screenshot...", file_menu, savescreen)
item_temp = addmenuitem("Open", file_menu, handle_open)
run_item = addmenuitem("Run", file_menu, handle_run)
item_temp = addmenuitem("Quit", file_menu, quitwndo)
call setfillstyle(SOLID_FILL, WHITE);
call bar(0, 0, 820, 940);
mybutton1 = createbutton(70, 410, 120, 120, "Off Duty", handle_button1)
mybutton2 = createbutton(270, 410, 120, 120, "Sleeper", handle_button2)
mybutton = createbutton(470, 410, 120, 120, "Driving", handle_button3)
mybutton = createbutton(670, 410, 120, 120, "On Duty ", handle_button4)
do while(task .NE. task_quit)
call draw_window() ! draw_window
task = -1
call loop()
select case(task)
case (task_open)
call openfile()
case (task_run)
call longrun()
!--------------Added-------------------------------------\/
case (task_win)
itr = itr + 1
call openwin()
case (task_close)
call closewin()
!--------------------------------------------------------/\
end select
end do
! call closewindow(myscreen)
CONTAINS !--- SUBROUTINES
subroutine draw_window()
use appgraphics
implicit none
integer::w,h
integer::tw
character(100)::info
call setcurrentwindow(myscreen)
w = getmaxx()
h = getmaxy()
call setbuttonposition(mybutton, w-50, h-30, 40, 20)
write(info, '(A5,1X,I5,A1,I5)') "Size:", w, "x", h
call setviewport(0, 0, w, 40, .FALSE.)
call clearviewport()
tw = textwidth(trim(info))
call outtextxy( (w/2-tw/2), 5, trim(info))
end subroutine draw_window
subroutine handle_button1()
use appgraphics, only: stopidle
implicit none
task = task_quit
call stopidle()
end subroutine handle_button1
subroutine handle_button2()
use appgraphics, only: stopidle
implicit none
task = task_quit
call stopidle()
end subroutine handle_button2
subroutine handle_button3()
use appgraphics, only: stopidle
implicit none
task = task_quit
call stopidle()
end subroutine handle_button3
subroutine handle_button4()
use appgraphics, only: stopidle
implicit none
task = task_quit
call stopidle()
end subroutine handle_button4
subroutine handle_resize()
use appgraphics
implicit none
call stopidle()
end subroutine handle_resize
subroutine handle_open()
use appgraphics
implicit none
task = task_open
call stopidle()
end subroutine handle_open
!--------------Added-------------------------------------\/
subroutine handle_winopen()
use appgraphics
implicit none
task = task_win
call stopidle()
end subroutine handle_winopen
subroutine openwin()
USE appgraphics
implicit none
character(4) :: cItr
write( cItr, '(I3)' ) Itr
cTxt = 'Open window number '// cItr //CRLF// &
'with the closeflag = .FALSE. Let''s try and ' //CRLF// &
'select-> FILE/CLOSE A WINDOW.' //CRLF
bClose = .FALSE.
CALL SplashScreen( 'New Window', cTxt, 3, bClose )
end subroutine openwin
subroutine handle_winclose()
use appgraphics
implicit none
task = task_close
call stopidle()
end subroutine handle_winclose
subroutine closewin()
USE appgraphics
implicit none
integer::i
!--- Close the windows
! CALL closewindow (ALL_WINDOWS)
! CALL closewindow (NO_CURRENT_WINDOW)
! CALL closewindow()
do i=1,ubound(child_windows, 1)
if(child_windows(i) .GE. 0) then
call closewindow(child_windows(i))
child_windows(i) = -1
exit
end if
end do
end subroutine closewin
subroutine openfile()
USE appgraphics, ONLY: dlgopenfile
implicit none
CHARACTER(255) :: input_file_name
! Appgraphics function dlgopenfile (filename, maskdesc, mask, title)
input_file_name= repeat(' ', 255)
IF( dlgopenfile( &
input_file_name, 'Data', '*.raw', 'Enter data file') ) THEN
Print *, "You've selected "//trim(input_file_name)
ELSE
Print *, "No file was selected"
END IF
input_file_name = TRIM(input_file_name)
end subroutine openfile
subroutine savescreen()
use appgraphics, only: writeimagefile
implicit none
! This call will open a file dialog since we haven't
! specified a filename
call writeimagefile()
end subroutine savescreen
subroutine handle_run()
use appgraphics, only: stopidle
implicit none
task = task_run
call stopidle()
end subroutine handle_run
subroutine longrun()
implicit none
real::starttime, nowtime
call enablemenuitem(run_item, .FALSE.)
call cpu_time(starttime)
nowtime = starttime
do while(nowtime - starttime .LT. 0.01)
call cpu_time(nowtime)
WRITE( *,'(A1$)') , "."
end do
call enablemenuitem(run_item, .TRUE.)
end subroutine longrun
subroutine quitwndo()
use appgraphics, only: stopidle
implicit none
task = task_quit
call stopidle()
end subroutine quitwndo
!
!--------------------------------------------------------
Subroutine SplashScreen( cMenu, cTxt, nDelaysec, bClose )
! Parameters:
! cMenu: text used in the menu title bar
! cTxt: text narrative in the textbox
! nDelaysec: number seconds delayed
implicit none
character(*), intent(IN) :: cMenu
character(*), intent(IN) :: cTxt
integer, intent(IN) :: nDelaysec
logical, intent(IN) :: bClose
character(LEN(cTxt)) :: cTxt2
character(2) :: CRLF
integer :: textbox, timerscreen, myscreen
integer :: tw, w, wd, h, ht, nlen
integer::i
!--- CRLF = C_CARRIAGE_RETURN // C_NEW_LINE
CRLF = Achar(13) // Achar(10)
!--- Line width of text is 64 characters/line
nlen = LEN( TRIM(cTxt) ) ! lenstr(s)
cTxt2 = cTxt(1:nlen)
ht = 100
wd = 0
timerscreen = initwindow(400, ht, title=cMenu, &
left=300, top=200, closeflag=bClose)
do i=1, ubound(child_windows, 1)
if(child_windows(i) .EQ. -1) then
child_windows(i) = timerscreen
exit
end if
end do
call setcolor(BLACK)
call setbkcolor(WHITE)
call clearviewport()
w = getmaxx()
h = getmaxy()
call settextjustify(LEFT_TEXT, TOP_TEXT)
call settextstyle (SANS_SERIF_FONT, HORIZ_DIR, 16)
tw = textwidth(TRIM(cTxt2))
cTxt2 = TRIM(cTxt2)
call outtextxy( (w/2-tw/2+wd), h/2-h/5, TRIM(cTxt2) )
call startidle (nDelaysec*1000)
CALL stopidle( )
call refreshall( )
!--- Set the main menu window to the current window
CALL setcurrentwindow (myscreen)
IF ( bClose ) THEN
!--- Then close the second window
CALL closewindow(timerscreen)
ELSE
!--- Don't close the window.
ENDIF
RETURN
End Subroutine SplashScreen
Subroutine InitializeScreen() ! ============ InitializeScreen()
use appgraphics
character * 30 :: msg2
integer :: start_button
msg2 = "In InitializeScreen() "
myscreen = initwindow(400, 200, title="Controls Demo", closeflag=.TRUE.)
! call setbkcolor(systemcolor(COLOR_WINDOW_BKGD))
call setbkcolor(WHITE)
call clearviewport() ! to display the windows background color
call dlgmessage(DIALOG_INFO,msg2)
!call btnTest ! and it executes as expected but
! Comment out the above line and the build fails
start_button = createbutton(100, 200,120,50,"Button Test", handle_button1)
call enablebutton(start_button, .FALSE.)
End Subroutine InitializeScreen
!--------------------------------------------------------/\
!--------------------------------------------------------/\
end program test