![[CodePhile]](../styles/cphile.gif)
This code including the compiled program can be downloaded from 42BBS or it's website http://www.fffnet.demon.co.uk/project1.zip
'PROJECT1.BAS
DEFINT a-z
'$include gemaes.bh
'$option yk20
'Setup some variables
LIBRARY "gemaes","gemvdi","speedo","falcon","menu"
DIM msg(7)
DIM fonts(6)
DIM handles(6)
'Check for SpeedoGDOS and assign fonts to windows as needed.
'People without SpeedoGDOS or NVDI will still be able to use 7 windows
'but they will all contain the system font
IF GETCOOKIE("FSMC",dum&) THEN
number_of_fonts=vst_load_fonts
IF number_of_fonts>7 THEN
FOR i=0 TO 6
fonts(i)=i+1
NEXT i
ELSE
FOR i=0 TO number_of_fonts-1
fonts(i)=i+1
NEXT i
FOR i=number_of_fonts TO 6
fonts(i)=1
NEXT i
END IF
ELSE
FOR i=0 TO 6
fonts(i)=1
NEXT i
END IF
'Now we can setup the window titles using the names of the fonts
FOR i=0 TO 6
dum=vqt_name(fonts(i),dum$)
NEXT i
'Setup the window Handles
'As the function available to programmers to find out such things as does
'the users AES support iconification is only available in AES version 4.1 as above,
'it is not currently very useful.
'Therefore, if your AES does not support iconify, you may want to remove the win_icon from the next line
'as some AES versions have a dislike of it and may crash
dum=wind_get(desk,wf_workxywh,x,y,w,h)
FOR i=0 TO 6
handles(i)=wind_create(win_name+win_close+win_move+win_icon,x,y,w,h)
NEXT i
'setup the menus
menu$="[ Robs Prog | About Robs Prog ]"
menu$=menu$+"[ File | Quit ]"
menu$=menu$+"[ Window | Open Another Window \ Close The Top Window \(-------------------------\ Close All The Windows ]"
menu_tree&=menu&(menu$)
'This uses the menu library and is useful if you are not using RSC files (as we are not in this project..)
'Now setup the constants for the menu bar to make refering to them easier
'Refer to the HiSoft Tech Manual (page 265-6) to find out how the numbering goes
'These constants are not added to the gemaes.bh file because they are made up just for this menu structure
CONST Prog_menu=3,File_menu=4,Window_menu=5
CONST Prog_About=8,File_Quit=17
CONST Window_Open=19
CONST Window_Close=20
CONST Window_close_all=22
'Now the dreaded function call...
'Well, actually, as we only want messages - menu messages, window messages, redraw messages ...
'we don't need EVNT_MULTI() (Yippy) and can make do with EVNT_MESAG()
DO
CALL evnt_mesag(VARPTR(msg(0)))
CALL process_message
LOOP
'Basically an infinite loop that hands CPU time over to the OS until a message is received
'by the OS for it. When a message is received, it is put in the msg() array and has to be decoded...
'This is done by the PROCESS_MESSAGE sub
SUB process_message
SHARED msg()
LOCAL dum,m0,i
m0=msg(0)
SELECT CASE m0
CASE mn_selected
CALL menu_control(msg(3),msg(4))
CASE wm_redraw
CALL redraw(msg(3))
CASE wm_topped
dum=wind_set(msg(3),wf_top,msg(3),0,0,0)
CASE wm_closed
dum=wind_close(msg(3))
CASE wm_moved
dum=wind_set(msg(3),wf_currxywh,msg(4),msg(5),msg(6),msg(7))
CASE wm_bottom
dum=wind_set(desk,wf_bottom,msg(3),0,0,0)
CASE wm_iconify
dum=wind_set(msg(3),wf_iconify,msg(4),msg(5),msg(6),msg(7))
CASE wm_uniconify
dum=wind_set(msg(3),wf_uniconify,msg(4),msg(5),msg(6),msg(7))
CASE wm_alliconify
CALL all_iconify
CASE ap_term
CALL shutdown
END SELECT
END SUB
'The sub that sorts out menu selection. The Menu_tnormal puts the menu title selected
'back to normal as it is highlighted when you choose an item from the menu bar (comment out to see
'what it does
'The Form_Alert is an easy way to package messages to the user. If you use Freedom, Let'm fly or a
'similar program, these are in windows.
'the first variable passed is the button to be used as default (if you just press return) and the second
'is a string constructed as follows:
' "[Icon_number][text (30 chrs per line, 5 lines max, | is a line seperator used to denote a new line)][
' text for button 1 | text for button 2 | text for button 3]"
'by not naming a button, it is not used eg if only button 1 is named, only one button appears.
'the total text length for the buttons is 30 chrs, 1 button 30 chrs long, 3 buttons 10 chrs long...
'The icons are from 0 to 5, icons 4 and 5 are only available in AES's>= 4.1
SUB menu_control(BYVAL title,BYVAL item)
SHARED handles(),menu_tree&
LOCAL dum,i,top_handle,w,h
dum=wind_update(beg_update)
CALL graf_mouse(m_off,0)
CALL menu_tnormal(menu_tree&,title,1)
CALL graf_mouse(m_on,0)
dum=wind_update(end_update)
SELECT CASE item
CASE prog_about
dum=form_alert(1,"[0][This program is brought to you|by Robert Goldsmith][Continue]")
dum=form_alert(1,"[1][Todays numbers are 3 and 7 and|the letter F][What!!!]")
CASE file_quit
CALL shutdown
CASE window_open
FOR i=0 TO 6
dum=wind_get(handles(i),wf_workxywh,0,0,w,h)
IF w+h=0 THEN
dum=wind_open(handles(i),100+(i*20),100+(i*10),200,100)
EXIT FOR
END IF
NEXT i
CASE window_close
dum=wind_get(desk,wf_top,top_handle,0,0,0)
dum=wind_close(top_handle)
CASE window_close_all
FOR i=0 TO 6
dum=wind_close(handles(i))
NEXT i
END SELECT
END SUB
SUB redraw( BYVAL handle)
SHARED handles(),fonts()
LOCAL dum,x,y,w,h,font_id,i,wx,wy,ww,wh,name$
dum=wind_get(handle,wf_workxywh,wx,wy,ww,wh)
dum=wind_get(handle,wf_firstxywh,x,y,w,h)
FOR i=0 TO 6
IF handles(i)=handle THEN font_id=vqt_name(fonts(i),name$):EXIT FOR
NEXT i
CALL vsf_color(8)
CALL vst_color(1)
CALL vst_font(font_id)
CALL vst_point(14)
dum=wind_update(beg_update)
CALL graf_mouse(m_off,0)
WHILE w>0 AND h>0
CALL vs_clip(1,x,y,x+w-1,y+h-1)
CALL vswr_mode(1)
CALL v_bar(x,y,x+w-1,y+h-1)
CALL vswr_mode(2)
CALL v_ftext(wx+10,wy+50,name$)
CALL vs_clip(0,0,0,0,0)
dum=wind_get(handle,wf_nextxywh,x,y,w,h)
WEND
CALL graf_mouse(m_on,0)
dum=wind_update(end_update)
END SUB
SUB all_iconify
END SUB
SUB shutdown
SHARED handles()
LOCAL i,dum
FOR i=0 TO 6
dum=wind_close(handles(i))
dum=wind_delete(handles(i))
NEXT i
SYSTEM
END SUB