%sh with vertical scrollbars within %ps

I have been using %ps to collate a number of individual sheets %sh, and this has proved to be a very useful approach for both data input and presenting results.

One of my data input sheets is getting too deep for a small monitor and for various reasons I don’t really want to split this across two sheets. Is it possible to add a vertical scroll bar to one sheet that is embedded in a property sheet?

All my attempts to find a way to do this have unfortunately failed. Any ideas or suggestions would be most welcome.

Ken

Ken

You can add %vx to the controls for a given sheet but it will need a callback function that manually repositions all other controls in the sheet when scrolling.

In other words, I think that it is possible but quite difficult to program.

Paul, Thanks, I think I will adopt plan b for the time being - a smaller font size (that might just be sufficient for the time being). Ken

Plan C evolved last night. Looks like a property sheet but it is not. I don't think I have ever used %aw before.

Posting this as others may find it helpful at some time.

module my_ps
use clrwin ; implicit none
integer control, wincontrol
real, parameter :: c = 0.75
contains
  integer function main_window()
  integer iw, cur_val
    iw = winio@('%mn[Exit]&','exit')
    iw = winio@('%bg&',rgb@(220,220,220))
    iw = winio@('%^tt[Caption for sheet 1]%^tt[Caption for sheet 2]&',sheet1_cb,sheet2_cb)
    iw = winio@('%ff%fr&',nint(c*CLEARWIN_INFO@('SCREEN_WIDTH')),nint(c*CLEARWIN_INFO@('SCREEN_DEPTH')))
    iw = winio@('%cv&',control)
    iw = winio@('%sc', sheet1_cb)   ! Display sheet 1 first
    main_window = 2
  end function main_window

  integer function close_current_sheet()
  logical, save :: first = .true.
    if(.not.first) then          ! Close current sheet
      wincontrol = 0
      call WINDOW_UPDATE@(wincontrol)
    else
      first = .FALSE.             ! Update not required first time round  ###was .TRUE. when first posted.
    end if
    close_current_sheet = 2
  end function close_current_sheet
  
  integer function sheet1_cb()
  integer    iw, i
  integer :: control_local = 1
    iw = close_current_sheet()
    iw = winio@('%sh&',control_local)
    ! Controls for sheet 1 go here
    iw = winio@('%2.1ob&')
    do i = 1, 80
      iw = winio@('%nlThis is sheet 1&')
    end do
    iw = winio@('%cb&')
    iw = winio@('%gr[blue]&',1600,400)
    iw = winio@('%cb&')
    iw = winio@(' ')
    ! 'Main' sub-window
    iw = winio@('%aw&',control)
    iw = winio@('%bg&',rgb@(220,220,220))
    iw = winio@('%sz&',NINT(c*CLEARWIN_INFO@('SCREEN_WIDTH')),NINT(c*CLEARWIN_INFO@('SCREEN_DEPTH')))
    iw = winio@('%ch[vscrollbar,hscrollbar]&',control_local)
    iw = winio@('%lw&',wincontrol)
    iw = winio@('%sc','maximise')
    sheet1_cb=2
  end function sheet1_cb

  integer function sheet2_cb()
  integer ::  control_local = 1
  integer iw, i
    iw = close_current_sheet()
    iw = winio@('%sh&',control_local)
    ! Controls for sheet 2 go here
    do i = 1, 80
    iw = winio@('This is sheet 2%nl&')
    end do
    iw = winio@(' ')
    ! 'Main' sub-window
    iw = winio@('%aw&',control)
    iw = winio@('%bg&',rgb@(220,220,220))
    iw = winio@('%sz&',NINT(c*CLEARWIN_INFO@('SCREEN_WIDTH')),NINT(c*CLEARWIN_INFO@('SCREEN_DEPTH')))
    iw = winio@('%ch[vscrollbar,hscrollbar]&',control_local)
    iw = winio@('%lw&',wincontrol)
    iw = winio@('%sc','maximise')
    sheet2_cb=1
  end function  sheet2_cb
end module my_ps
program demo
use my_ps
i = main_window()
end program demo

ERROR in function close_current_sheet() corrected above after first posting.

Ken's program is interesting. It is based on %fr which creates a MDI (multi-document interface). It also uses %tt for each tab heading.

In a different context (unrelated to what Ken has in mind), %ps can be used with %ps[frame] as described in cwplus.enh and item 414. This also creates a MDI but it can be used (for example) to create a multi-document editor. The following program combines %ps[frame] with sheets that use %eb (%re could be used instead of %eb).

winapp
module psmod
 use clrwin
 integer count
 character(256) fileName
contains

 integer function closeTab()
 integer(7) han
 integer ret
 ret = EditFileClosePrompt@(0_7,'Example','Save changes to %s before closing?')
 if(ret == 0) han = delete_tab@()
 closeTab = 2
 end function closeTab 
 
 integer function newTab()
 character(32) caption
 integer(7) hwnd
 if(fileName == '*')then
   count = count+1 
   write(caption,'(a4,i2)') 'Text',count
   hwnd = new_tab@(1,trim(caption))
   !Auto tooltip and/or new routine to set tooltip?
 else  
   hwnd = new_tab@(1,'')
   i = OpenEditFile@(hwnd,fileName)
   if(i == 0_7) hwnd = delete_tab@()
   fileName = '*'
 endif  
 newTab = 2
 end function newTab

 integer function saveTab()
 i = EditFileSave@(0_7)
 saveTab = 2
 end function saveTab 

 integer function saveTabAs()
 i = EditFileSaveAs@(0_7)
 saveTabAs = 2
 end function saveTabAs

 integer function controlClose()
 controlClose = EditFileClosePrompt@(-1_7,'Example','Save changes to %s before closing?')
 end function controlClose 

 integer function saveState()
 saveState = EditFileModified@(0_7)
 end function saveState
   
 integer function toolbarCB()
  toolbarCB = 2
 end function toolbarCB

end module psmod

program propsheet 
   use psmod
   integer,parameter::N=8
   integer i,ps
   INTEGER bstyle(N),bID(N)
   bID    = (/6,7,8,-1,0,1,2,3/)
   bstyle = 0
   bstyle(4) = 1
   count = 0
   fileName = '*'
   i=winio@('%sh&',ps)
   i=winio@('%*^mb[border]&', N, bID, bstyle, toolbarCB)
   i=winio@('%ft[Text files][*.txt]&')      
   i=winio@('%mn[File[New^Ctrl+N]]&',newTab) 
   i=winio@('%mn[[Open^Ctrl+O]]&','FILE_OPENR',fileName,newTab)
   i=winio@('%mn[[^Save]]&',saveState,saveTab) 
   i=winio@('%mn[[Save As]]&',saveTabAs) 
   i=winio@('%mn[[Close]]&',closeTab) 
   i=winio@('%bg[btnface]&')
   i=winio@('%if&')      
   i=winio@('%`bg&',RGB@(225,255,225))
   i=winio@('%fn[Courier New]&')
   i=winio@('%pv&') 
   i=winio@('%cm[Cut,Copy,Paste,Select all,Undo]&','Cut','Copy','Paste','Select_All','Edit_Undo')
   i=winio@('%60.20eb[hscrollbar,vscrollbar,undo]','*',0)
   
   i=winio@('%ww[no_border]&') 
   i=winio@('%ca[Text Editor]&')
   i=winio@('%*^mb[border]&', 2, bID, bstyle, toolbarCB)
   i=winio@('%ft[Text files][*.txt]&')      
   i=winio@('%mn[File[New^Ctrl+N]]&',newTab) 
   i=winio@('%mn[[Open^Ctrl+O]]&','FILE_OPENR',fileName,newTab) 
   i=winio@('%ac[Ctrl+X]&','Cut') 
   i=winio@('%ac[Ctrl+C]&','Copy') 
   i=winio@('%ac[Ctrl+V]&','Paste') 
   i=winio@('%ac[Ctrl+A]&','Select_All') 
   i=winio@('%ac[Ctrl+Z]&','Edit_Undo') 
   i=winio@('%rc&', 1, newTab) 
   i=winio@('%rc&', 2, 'FILE_OPENR',fileName,newTab) 
   i=winio@('%^rc&',3, saveState,saveTab) 
   i=winio@('%rc&', 5, 'Cut') 
   i=winio@('%rc&', 6, 'Copy') 
   i=winio@('%rc&', 7, 'Paste') 
   i=winio@('%rc&', 8, 'Edit_Undo') 
   i=winio@('%pv&') 
   i=winio@('%ps[frame,tooltips,hot_track]&',ps)
   i=winio@('%cc',controlClose) 
end program propsheet 

Below is a more compact version of my earlier code.

I have also discovered that an apparently minor change at line 25 breaks the code if immediately after the window is formed the user restores the displayed window to its normal size via the icon displayed top right.

Details of what I have observed:

If the user clicks on icon at top right of main window to restore size to 'normal' immediately after the display is created, an exception will occur and program hangs when bgcolour at line 25 is replaced by a call to rgb@(220,220,220).

If bgcolour is replaced by a local variable with the save attribute, set to the required rgb value immediately before this line the same exception is observed.

The response is stable if a standard colour is used eg %bg[red]

If line 25 uses rgb@(220,220,220) and the %sc call to sh1_cb in the function main_window is removed, no exception occurs when after selecting sheet 1 the user then clicks on the icon at top right of the main window.

This may indicate a problem somewhere in the dlls, however I do realise that what I’m doing here was probably never envisaged in the clearwin design philosophy. Definitely a case of 'Saturday devilry'.

module my_ps_mod
use clrwin ; implicit none
integer awcontrol, wincontrol
integer, parameter :: shcontrol = 1
real,    parameter :: c = 0.75
integer bgcolour
contains
  integer function main_window()
  integer iw
    bgcolour = rgb@(220,220,220)
    iw = winio@('%mn[Exit]&','exit')
    iw = winio@('%bg&',bgcolour)
    ! Add %tt buttons and call back for each sheet here
    iw = winio@('%^tt[Sheet 1]%^tt[Sheet 2]&',sh1_cb,sh2_cb)
    iw = winio@('%bx%ff%fr&',0.5d0,nint(c*CLEARWIN_INFO@('SCREEN_WIDTH')),nint(c*CLEARWIN_INFO@('SCREEN_DEPTH')))
    iw = winio@('%cv%sc',awcontrol,sh1_cb)
    main_window = 2
  end function main_window
  integer function sh1_cb()
  integer iw, i
  character(len=3) str
    iw = close_current_sheet()
    iw = winio@('%sh&',shcontrol)
    ! Controls for sheet 1 go here
        iw = winio@('%fn[Consolas]%bg&',bgcolour)     !### Changing this line breaks the code.
        iw = winio@('%2.1ob&')
        do i = 1, 80
          write(str,'(I3)') i ; iw = winio@('%nlLine'//str//'&')
        end do
        iw = winio@('%cb%gr[white]&',1400,400)
        iw = winio@('%cb')
    iw = main_sub_window()
    sh1_cb=2
  end function sh1_cb
  integer function sh2_cb()
  integer iw, i
  character(len=3) str
    iw = close_current_sheet()
    iw = winio@('%sh&',shcontrol)
    ! Controls for sheet 2 go here
        iw = winio@('%fn[Consolas]%bg&',bgcolour)
        do i = 1, 80
          write(str,'(I3)') i ; iw = winio@('Line'//str//'%nl&')
        end do
        iw = winio@('')
    iw = main_sub_window()
    sh2_cb=1
  end function  sh2_cb
  integer function main_sub_window()
  integer iw
    iw = winio@('%aw&',awcontrol)
    iw = winio@('%sz&',NINT(c*CLEARWIN_INFO@('SCREEN_WIDTH')),NINT(c*CLEARWIN_INFO@('SCREEN_DEPTH')))
    iw = winio@('%ch[vscrollbar,hscrollbar]%lw%sc',shcontrol,wincontrol,'maximise')
    main_sub_window = 2
  end function main_sub_window
  integer function close_current_sheet()
    wincontrol = 0 ; call WINDOW_UPDATE@(wincontrol) ; close_current_sheet = 2
  end function close_current_sheet
end module my_ps_mod
program demo
use my_ps_mod
i = main_window()
end program demo