Silverfrost Forums

Welcome to our forums

meue selection

16 Dec 2010 12:06 #7253

Hello, below see a simple menue, that works fine. My questions:

  1. Is there a possibility for additional line selections by a simple left mouse click

  2. Is there a possibility for additional line selections by pressing a underlined or collored char

  3. When the first line is highlighted and you press the 'cursor up' key the highlighted line does not change to the last line. When the last line is highlighted and you press the 'cursor down' key the highlighted line does not change to the first line. Is there a possibility to change this?

    winapp 0,0 program ms

    implicit none include<windows.ins>
    integer*4 i external cb_func,ienter_monitor

    character zeile(4)*80

    data zeile( 1) /' Neueingabe oder Änderung von Positionen '/ data zeile( 2) /' Ausdruck der Profiltabelle (ohne Stabnummern) '/ data zeile( 3) /' Ausdruck der Profiltabelle (mit Stabnummern) '/ data zeile( 4) /' Programm beenden '/

    i=winio@('%ww[casts_shaddow]%ca[A u s w a h l m e n u e]&') i=winio@('%ww%bg[grey]&') i=winio@('%ac[Enter]&', ienter_monitor) i=winio@('%70.12^ls',zeile,4L,1,cb_func) stop end

    integer*4 function cb_func() include <windows.ins> cb_func=1 end

    integer*4 function ienter_monitor() include <windows.ins> ienter_monitor=0 end

16 Dec 2010 12:53 #7254

You have given a constant value of 1 for the selected item in the list, use a variable instead and put that in a common block to make it available to the callback routine. You can change the selection by changing the value by another function and call window_update@. For multiple selections, use %ms and change iselect to an array. Regards Ian

winapp 0,0 
program ms 
      
implicit none 
include<windows.ins>        
integer*4 i , iselect 
external cb_func,ienter_monitor 

character zeile(4)*80 

common/list_selection/iselect
      
data zeile( 1) /' Neueingabe oder Änderung von Positionen                        '/ 
data zeile( 2) /' Ausdruck der Profiltabelle (ohne Stabnummern)                  '/ 
data zeile( 3) /' Ausdruck der Profiltabelle (mit  Stabnummern)                  '/ 
data zeile( 4) /' Programm beenden                                               '/ 

iselect = 1

i=winio@('%ww[casts_shaddow]%ca[A u s w a h l m e n u e]&') 
i=winio@('%ww%bg[grey]&') 
i=winio@('%ac[Enter]&', ienter_monitor) 
i=winio@('%70.12^ls',zeile,4L,iselect ,cb_func) 
stop 
end 

integer*4 function cb_func() 
include <windows.ins> 
integer*4 i , iselect 
common/list_selection/iselect
cb_func=1 
end 

integer*4 function ienter_monitor() 
include <windows.ins> 
ienter_monitor=0 
end 
17 Dec 2010 8:40 #7256

Dear Ian, thank you very much for your prompt help, now I understand it and the code below works fine. But still 2 questions:

  • is it possible to youse a no_border function, the %co[no_data_border] does'nt work?
  • is it possible to center the box in the outer border?

Thank you very much.

winapp 0,0
      program ms
      
      implicit none
      include<windows.ins>       
      integer*4 i
      integer*4 sel(4),selmax
      common/isel/sel,selmax
      
      character*8 cline(4)
	external cb_func,ienter_monitor,idown_monitor,iup_monitor
      external left_monitor,right_monitor,home_monitor,end_monitor,iesc_monitor
      
data cline( 1)  /'1  alpha'/
      data cline( 2)  /'2  beta '/
      data cline( 3)  /'3  gamma'/
      data cline( 4)  /'4  delta'/
      
      selmax = 4
      sel(1) = 1
      do 5 i = 2,selmax
  5  sel(i) = 0
           
      i=winio@('%ac[Enter]&',ienter_monitor)
      i=winio@('%ac[DOWN]&', idown_monitor)
      i=winio@('%ac[UP]&  ', iup_monitor)
      i=winio@('%ac[LEFT]&', left_monitor)
      i=winio@('%ac[RIGHT]&',right_monitor)
      i=winio@('%ac[Tab]&' , right_monitor)
      i=winio@('%ac[HOME]&', home_monitor)
      i=winio@('%ac[PgUp]&', home_monitor)
      i=winio@('%ac[END]&' , end_monitor)
      i=winio@('%ac[PgDn]&', end_monitor)
      i=winio@('%ac[ESC]&' , iesc_monitor)
      i=winio@('Select a greek: %^`8.4ms',cline,4L,sel,cb_func)

      write(*,*)sel
      end

!-----------------------------------------
	integer*4 function cb_func()
!-----------------------------------------
      include <windows.ins>
      cb_func = 0
!      call window_update@
      end

!-----------------------------------------
      integer*4 function ienter_monitor()
!-----------------------------------------
      include <windows.ins> 
      ienter_monitor=0
      end

!-----------------------------------------
      integer*4 function idown_monitor()
!-----------------------------------------
      include <windows.ins> 
      integer*4 sel(4),selmax
      common/isel/sel,selmax
      
      if(sel(4).eq.1)then
      sel(4)= 0
      sel(1)= 1
      go to 20
      endif
        
      do 10 k = 1,3
	if(sel(k).eq.1)then
      sel(k) = 0
      sel(k+1) = 1
      go to 20
      endif
  10 continue
  20 continue

      idown_monitor=1
      end
      
!-----------------------------------------
      integer*4 function iup_monitor()
!-----------------------------------------
      include <windows.ins> 
      integer*4 sel(4),selmax
      common/isel/sel,selmax
      
      if(sel(1).eq.1)then
      sel(1)= 0
      sel(4)= 1
      go to 20
      endif
        
      do 10 k = 4,2,-1
      if(sel(k).eq.1)then
      sel(k) = 0
      sel(k-1) = 1
      go to 20
      endif
  10 continue
  20 continue

       iup_monitor=1
       end

!-----------------------------------------
      integer*4 function left_monitor()
!-----------------------------------------
      include <windows.ins> 
      left_monitor=1
      end
      
!-----------------------------------------
      integer*4 function right_monitor()
!-----------------------------------------
      include <windows.ins> 
      right_monitor=1
      end

!-----------------------------------------
      integer*4 function home_monitor()
!-----------------------------------------
      include <windows.ins> 
      integer*4 sel(4),selmax
      common/isel/sel,selmax
      home_monitor=1
      do 50 k = 1,selmax
  50 sel(k) = 0
      sel(1) = 1
      end

!-----------------------------------------
      integer*4 function end_monitor()
!-----------------------------------------
      include <windows.ins>
      integer*4 sel(4),selmax
      common/isel/sel,selmax
      end_monitor=1
      do 60 k = 1,selmax
  60 sel(k) = 0
      sel(selmax) = 1 
      end

!-----------------------------------------
      integer*4 function iesc_monitor()
!-----------------------------------------
      include <windows.ins>
      integer*4 sel(4),selmax
      common/isel/sel,selmax
      iesc_monitor=0
      do 70 k = 1,selmax
  70 sel(k) = 0
      end
17 Dec 2010 1:30 #7257

No - that only seems to apply to %rd, %rf, %rs, %re, %el Centring - yes see below plus some tidy-up of the code arrays may be initialised without a do loop, window caption added, background set to users current windows default. The use of the cursor keys seems to partially defeat the use of a %ms, a %ls would be satisfactory and sel would be a single value, in which case the cursor control would be better as: cursor down sel = mod(sel,selmax)+1 cursor up sel = mod(sel-selmax-1,selmax)+selmax

Regards Ian

      winapp  
      program ms 

      implicit none 
      include<windows.ins> 
      integer*4 i 
      integer*4 sel(4),selmax 
      common/isel/sel,selmax 

      character*8 cline(4) 
      external cb_func,ienter_monitor,idown_monitor,iup_monitor 
      external left_monitor,right_monitor,home_monitor,end_monitor,
     &         iesc_monitor 

      data cline( 1) /'1 alpha'/ 
      data cline( 2) /'2 beta '/ 
      data cline( 3) /'3 gamma'/ 
      data cline( 4) /'4 delta'/ 

      selmax = 4 
      sel = 0 
      sel(1) = 1 

      i=winio@('%ca[Window caption]%bg[btnface]&')
      i=winio@('%ac[Enter]&',ienter_monitor) 
      i=winio@('%ac[DOWN]&', idown_monitor) 
      i=winio@('%ac[UP]& ', iup_monitor) 
      i=winio@('%ac[LEFT]&', left_monitor) 
      i=winio@('%ac[RIGHT]&',right_monitor) 
      i=winio@('%ac[Tab]&' , right_monitor) 
      i=winio@('%ac[HOME]&', home_monitor) 
      i=winio@('%ac[PgUp]&', home_monitor) 
      i=winio@('%ac[END]&' , end_monitor) 
      i=winio@('%ac[PgDn]&', end_monitor) 
      i=winio@('%ac[ESC]&' , iesc_monitor)
! list is centred with 'Select a greek' to the left
      i=winio@('Select a greek:%cn%`bg[white]%^`8.4ms',
     &          cline,4L,sel,cb_func) 
! list is centred with 'Select a greek' above
!      i=winio@('Select a greek:%ff%cn%`bg[white]%^`8.4ms',
!     &          cline,4L,sel,cb_func) 

      write(*,*)sel 
      end 

!----------------------------------------- 
      integer*4 function cb_func() 
!----------------------------------------- 
      include <windows.ins> 
      cb_func = 1 
! call window_update@ 
      end 

continued...

17 Dec 2010 1:30 #7258
!----------------------------------------- 
      integer*4 function ienter_monitor() 
!----------------------------------------- 
      include <windows.ins> 
      ienter_monitor=0 
      end 

!----------------------------------------- 
      integer*4 function idown_monitor() 
!----------------------------------------- 
      include <windows.ins> 
      integer*4 sel(4),selmax 
      common/isel/sel,selmax 
      idown_monitor=1 

      if(sel(selmax).eq.1)then 
        sel(selmax)= 0 
        sel(1)= 1 
        return 
      endif 

      do k = 1,selmax-1 
        if(sel(k).eq.1)then 
          sel(k) = 0 
          sel(k+1) = 1 
          exit
        endif 
      enddo 

      end 

!----------------------------------------- 
      integer*4 function iup_monitor() 
!----------------------------------------- 
      include <windows.ins> 
      integer*4 sel(4),selmax 
      common/isel/sel,selmax 
      iup_monitor=1 

      if(sel(1).eq.1)then 
        sel(1)= 0 
        sel(selmax)= 1 
        return
      endif 

      do k = selmax,2,-1 
        if(sel(k).eq.1)then 
        sel(k) = 0 
        sel(k-1) = 1 
        exit
      endif 
      enddo

      end 

!----------------------------------------- 
      integer*4 function left_monitor() 
!----------------------------------------- 
      include <windows.ins> 
      left_monitor=1 
      end 

!----------------------------------------- 
      integer*4 function right_monitor() 
!----------------------------------------- 
      include <windows.ins> 
      right_monitor=1 
      end 

!----------------------------------------- 
      integer*4 function home_monitor() 
!----------------------------------------- 
      include <windows.ins> 
      integer*4 sel(4),selmax
      common/isel/sel,selmax 
      sel = 0
      sel(1) = 1 
      home_monitor = 1
      end
!----------------------------------------- 
      integer*4 function end_monitor() 
!----------------------------------------- 
      include <windows.ins> 
      integer*4 sel(4),selmax
      common/isel/sel,selmax 
      end_monitor=1 
      sel = 0
      sel(selmax) = 1 
      end 
!----------------------------------------- 
      integer*4 function iesc_monitor() 
!----------------------------------------- 
      include <windows.ins> 
      iesc_monitor=0 
      end
17 Dec 2010 3:20 #7259

Dear Ian, thank you very much for your help. It's only a pity that the no_border or no_frame option does'nt work.

Best Regards Bartl

18 Dec 2010 9:33 #7260

Yes, you are right. It seems a shame that Clearwin+ does not implement this function on all controls which have an outline for consistency and completeness. Ian

31 Dec 2010 5:28 #7323

My question is not directly related to the original one above. However, I would like to ask something on the value (or status) of the variable sel. I slightly adapted the example and think you could help me. My question: 1.) is the value of sel automatically updated after a selection in the combo box or 2.) are the some cases where I explicitly have to inquire for it?

When is it necessary to use the LISTBOX_ITEM_SELECTED parameter in clearwin_info@).

      winapp
      program ms
      implicit none
      include<windows.ins>
      integer*4 i
      integer*4 sel(4),selmax
      common/isel/sel,selmax
      character*8 cline(4)
      external cb_func,cb_but
      data cline( 1) /'alpha'/
      data cline( 2) /'beta '/
      data cline( 3) /'gamma'/
      data cline( 4) /'delta'/

      selmax = 4
      sel = 0
      sel(1) = 1
      i=winio@('%ca[Value of a combo box]%bg[btnface]&')
! list is centred with 'Select a greek' to the left
      i=winio@('Select a greek:%cn%`bg[white]%^`8.4ms&',
     &          cline,4L,sel,cb_func)
! Open a box with a clear win window
      i=winio@('%nl%ob[raised]&')
      i=winio@('Value of sel %ff%nl&')
      i=winio@('%ob[depressed]%30.5cw[vscroll]%cb&',0)
      i=winio@('%lw%cb&',-1)
      i=winio@('%ff%nl%^bt[Clear]',cb_but)
      write(*,'(6X,4I3)') sel
      end

      integer*4 function cb_func()
      implicit none
      include <windows.ins>
      integer i
      integer*4 sel(4),selmax
      common/isel/sel,selmax
      if (sel(1)==1) then
        write(*,'(A6,4I3)') 'alpha',sel
      elseif (sel(2)==1) then
        write(*,'(A6,4I3)') 'beta',sel
      elseif (sel(3)==1) then
        write(*,'(A6,4I3)') 'gamma',sel
      elseif (sel(4)==1) then
        write(*,'(A6,4I3)') 'delta',sel
      endif
      cb_func = 1
      end

      integer*4 function cb_but()
      implicit none
      include <windows.ins>
      call clear_window@(0)
      cb_but = 1
      end
2 Jan 2011 5:01 #7340

According to the documentation:

LISTBOX_ITEM_SELECTED Used in a call-back function for a list box. Returns 1 if the item was “selected” by double clicking on an item in the extended list; returns zero if the item was “moved to” by using a single click.

So this will give a value for a double click only, else it will be zero - your callback can ignore zero values. The value of sel will always be the selected one whether single or double clicked. To detect a double click without this function and using the value of sel, the 'Callback_reason' would need to be checked using CLEARWIN_STRING@. Regards Ian

Please login to reply.