Graphic Console Menu

[Guy Dombrowski]

Hi everybody,

Here is a nice menu for Rick Angell with full Mouse and Function keys controll.
I used it to learn some new techniques and try some Commands that I had never used before like TRY CATCH FINALLY END TRY and also adding Windows sounds to the program.
Feel free to use and modify it for your needs.
You will find it handy to call old programs as you work on replacing them with new codes.
This demo will only load some standard Windows Utilities but replace them with your own stuff.

Enjoy

'Menu-CC5.bas 10 Dec 2008 by Guy Dombrowski
'Use (+) and (-) to ajust Console size  Tab Key to change Directory
'Buttons size and position will be ajusted automatically to the text length of F1$ to F9$
'CsrSetup.txt used to save size and position of console
'Programme will use Windows sound instead of BEEP command   NpSnd%=1 to disable that feature
'I have renamed some Windows standard sounds and put them in my PowerBasic folder for eazy use.

#COMPILE EXE
#CONSOLE OFF
#INCLUDE "Win32Api.inc"
DEFLNG a-z
GLOBAL GrDialogProc AS LONG
GLOBAL GrStaticProc AS LONG
GLOBAL mx AS LONG,my AS LONG    ' Mouse x and y
GLOBAL lb AS LONG,rb AS LONG    ' Left and right mouse button
GLOBAL mm AS LONG               ' Detect mouse movements
GLOBAL bg AS LONG,fg AS LONG    ' Background and foreground colors
GLOBAL wm AS LONG,mb AS LONG    ' Wheel mouse and middle button
GLOBAL TabKey AS INTEGER        ' Detect Tab Key

FUNCTION GrDlgProc(BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
FUNCTION = CallWindowProc(GrDialogProc, hWnd, wMsg, wParam, lParam)
END FUNCTION

FUNCTION GrProc(BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
  LOCAL p AS pointapi
  SELECT CASE wMsg
    CASE %WM_CHAR
      car%=LO(WORD,wParam): IF car%=9 THEN TabKey%=9       ' Tab Key not caught by GRAPHIC INKEY$
    CASE %WM_MOUSEMOVE
      mm=1: mx=LO(WORD,lParam): my=HI(WORD,lParam)         ' Current Mouse X and Y Position in the graphic window
    CASE %WM_LBUTTONDOWN
      lb=1: FUNCTION=0: EXIT FUNCTION                      ' Left button pressed
    CASE %WM_RBUTTONDOWN
      rb=1: FUNCTION=0: EXIT FUNCTION                      ' Right button pressed
    CASE %WM_MBUTTONDOWN
      mb=1: FUNCTION=0: EXIT FUNCTION                      ' Middle button pressed
    CASE %WM_MOUSEWHEEL
      wm=HI(WORD,wParam): IF wm>32768 THEN wm=-1 ELSE wm=1 ' Wheel turned (+)=up (-)=down
      FUNCTION=0: EXIT FUNCTION
  END SELECT
 FUNCTION = CallWindowProc(GrStaticProc, hWnd, wMsg, wParam, lParam)
END FUNCTION

FUNCTION PBMAIN () AS LONG
 ON ERROR GOTO ErrHandling
 DIM frp AS FIELD, trs AS FIELD, des AS FIELD, aux AS FIELD, trsopen AS FIELD
 DIM numgl AS FIELD, agl AS FIELD, ouvpast AS FIELD, ouvpresent AS FIELD, past AS FIELD, present AS FIELD, budget AS FIELD
 DIM specgl AS FIELD, rate AS FIELD, passwrd AS FIELD
 DIM mgx AS FIELD
 DIM spec$(30),scrn$(30),s$(10),txt$(40),t$(40),d$(40),dat$(40),des$(40),prt$(40)
 LOCAL hGraphicWindow AS LONG
 DESKTOP GET CLIENT TO DskX,DskY                        ' Find Desk resolution minus task bar if not hidden
 DESKTOP GET SIZE TO WinX,WinY                          ' Find Absolute Windows desk size
 FrameWidth=GetSystemMetrics (%SM_CXDLGFRAME)           ' Width of windows perimeter frame
 CaptionHeight=GetSystemMetrics (%SM_CYCAPTION)         ' Height of Caption
 TaskBar=CaptionHeight+FrameWidth: CaptionH=TaskBar     ' Find TaskBar height
 drv$=LEFT$(CURDIR$,3): CurFolder$=MID$(CURDIR$,4)      ' Current Drive and Directory
 'specCC5$=drv$+"Spec-CC5.DAT"                           ' New CC5 spec
 jma$=MID$(DATE$,4,3)+LEFT$(DATE$,3)+RIGHT$(DATE$,2)    ' Day-Month-Year

Setting:REM Mix special colors that will be used in the menu
 rouge=RGB(255,100,00): rose=RGB(255,0,255): vert=RGB(200,255,200): bleu=RGB(100,200,255)
 jaune=RGB(255,255,170): beige=RGB(255,210,50): orange=RGB(255,150,0): brun=RGB(255,50,0)
 gris=RGB(220,220,220): blanc= RGB(225,225,225)
'Initial setup values for a 800x600 graphic console
 x0=0: y0=0: pt=0: x1=0: y1=0: pt=0: x2=800:  y2=600:  pt0=9:  pt1=10: pt2=6:  pt3=49
 NoSnd%=0 ' If no sound card NoSnd%=1 to use BEEP command instead of Windows sound
 
TRY
   REDIM s$(10): OPEN drv$+"ScrSetup.TXT" FOR INPUT AS #1             ' Read saved screen position and resolution
 CATCH
   GOSUB StartScreen: EXIT TRY                                        ' First time with no setup data
 FINALLY
   IF EOF(1)=0 THEN LINE INPUT#1,z$: PARSE z$,s$(),","
   IF s$(0)<>"" THEN x0=VAL(s$(0)): y0=VAL(s$(1)): scr%=VAL(s$(2))    ' Graphic Window position and resolution
   GOSUB StartScreen
 END TRY
CLOSE #1

'===============================================================================================
StartWindow:REM Start Graphic Window with variable resolution controled with the (+) and (-) key
'===============================================================================================
 FONT NEW "Sylfaen",pt+pt0,1,0,0 TO fnt0              ' Big font for banner heading no need to be monospace type
 FONT NEW "Lucida Console",pt+pt1,0,0,0,0 TO fnt1     ' Regular font for data entry must be monospace
 FONT NEW "Courier New",pt+pt2,1,0,0,0 TO fnt2        ' Smaller font for buttons and prompt must be monospace
 FONT NEW "sylfaen",pt+pt3,1,0,0,0 TO fnt3            ' Giant font for center Logo no need for monospace
 GRAPHIC WINDOW caption$,x1,y1,x2,y2 TO hGraphicWindow
 hStatic = GetWindow(hGraphicWindow, %GW_CHILD)                       ' Retrieve static handle of graphic window
 GrStaticProc = SetWindowLong(hStatic, %GWL_WNDPROC, CODEPTR(GrProc)) ' SubClasses Graphic control
 GRAPHIC ATTACH hGraphicWindow,0,REDRAW
 GRAPHIC SET LOC x1,y1                                           ' Set position of graphic window as last saved
 GRAPHIC SET FONT fnt1: GRAPHIC CHR SIZE TO CW1!,CH1!            ' Find pixel width and height of fnt1 graphic font
 GRAPHIC SET FONT fnt2: GRAPHIC CHR SIZE TO CW2!,CH2!            ' Find pixel width and height of fnt2 graphic font
 GRAPHIC CLEAR %BLACK,%GREEN: GRAPHIC COLOR %GREEN,%BLACK        ' Black background with Green text like old time
 MaxCol=x2/CW1!: MaxRow=y2/CH1!-3                                ' Maximums will depend on number of pixels on desktop
 GRAPHIC WIDTH 1: GRAPHIC REDRAW                                 ' Show screen background instantly
 GOSUB ButtonText                                                ' Assign programs and names to buttons

'===================================================================================
MainMenuStart: REM Initial welcome screen with top buttons and screen resize enabled
'===================================================================================
 nom$="Your Company Name": period$=" Period "+jma$: DataDir$=" Data Path Info ": folder$=CURDIR$
 GOSUB TopHeading: GOSUB Banner
 utxt$="Welcome to the first Graphical Console Menu"
 btxt$="Press the (+) or (-) keys to change resolution"
 bgrd=rose: GOSUB Welcome
 ltxt$="Work Directory "
 rtxt$="TAB key to change"
 InpBox%=1: bgrd=%RED: GOSUB BottomLine
 GOSUB logo

'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
MainMenuInput:REM Input loop enabling top buttons, Tab key, Function keys and (+) (-) for screen resize
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 MainMenu%=1: folder%=0: InpBox%=0: GOSUB TopHeading
 ink%=0: ink$="": kbx=0: kby=0: TabKey%=0: x=0: y=0: csr=0

 WHILE ink$=""
   GRAPHIC GET DC TO hwin: IF hwin=0 THEN END                                 ' Window closed by [x]   Position not saved
   IF TabKey THEN EXIT LOOP                                                   ' Tab key detected
   IF lb AND my>CH2!*1.75 OR my<CH2!/4 THEN lb=0                              ' Button was clicked outside Button area
   GRAPHIC INKEY$ TO ink$: SLEEP 1: IF ink$=CHR$(27) THEN GOSUB SavePos: END  ' Ended by esc key   Position saved
   IF mm AND (my<CH2!*1.75 OR my>CH2!/4) THEN SLEEP 1: GOSUB ButtonOn         ' Mouse movement detected in button area
   IF my<CH2!*1.75 AND my>CH2!/4 AND mo=1 AND lb THEN ink%=0: EXIT LOOP       ' Mouse left button clicked in button area
 WEND

 IF TabKey THEN ChooseFolder ' Had to exit loop first
 
 IF ink$="+" THEN ' + key pressed Increase resolution
   IF scr%<9 THEN INCR scr%: x0=0: y0=0: GRAPHIC WINDOW END: GOSUB StartScreen: GOTO StartWindow ELSE GOSUB ErrSound
 END IF

 IF ink$="-" THEN ' - key pressed Decrease screen resolution
   IF scr%>0 THEN DECR scr%: x0=0: y0=0: x2=0: GRAPHIC WINDOW END: GOSUB StartScreen: GOTO StartWindow  ELSE GOSUB ErrSound
 END IF

 ink%=0: IF LEN(ink$)=2 THEN ink%=ASC(RIGHT$(ink$,1)): ink$="": mx=0: my=0 ' Detect function keys

MainMenuButton:REM All buttons and function keys active Add GRAPHIC WINDOW END before SHELL to terminate Menu

 IF (lb AND my<CH2!*1.75 AND my>CH2!/4 AND mo=1) OR ink% THEN                                     ' Mouse buttons or Function keys
   IF (mx>CW2! AND mx<CW2!*(f1+1)) OR ink%=59 THEN ink%=0:        pid=SHELL ("NotePad.exe",1)     ' F1 program
   IF (mx>CW2!*(f1+2) AND mx<CW2!*(f2+2)) OR ink%=60 THEN ink%=0: pid=SHELL ("MsPaint.exe",1)     ' F2 program
   IF (mx>CW2!*(f2+3) AND mx<CW2!*(f3+3)) OR ink%=61 THEN ink%=0: pid=SHELL ("Calc.exe",1)        ' F3 program
   IF (mx>CW2!*(f3+4) AND mx<CW2!*(f4+4)) OR ink%=62 THEN ink%=0: pid=SHELL ("Explorer.exe",1)    ' F4 program
   IF (mx>CW2!*(f4+5) AND mx<CW2!*(f5+5)) OR ink%=63 THEN ink%=0: pid=SHELL ("iexplore.exe",1)    ' F5 program
   IF (mx>CW2!*(f5+6) AND mx<CW2!*(f6+6)) OR ink%=64 THEN ink%=0: pid=SHELL ("Charmap.exe",1)     ' F6 program
   IF (mx>CW2!*(f6+7) AND mx<CW2!*(f7+7)) OR ink%=65 THEN ink%=0: pid=SHELL ("SndVol32.exe",1)    ' F7 program
   IF (mx>CW2!*(f7+8) AND mx<CW2!*(f8+8)) OR ink%=66 THEN ink%=0: pid=SHELL ("freecell.exe",1)    ' F8 program
   IF (mx>CW2!*(f8+9) AND mx<CW2!*(f9+9)) OR ink%=67 THEN ink%=0: pid=SHELL ("mshearts.exe",1)    ' F9 program
   IF mx>x2-CW2!*(f0+1) THEN
     IF MainMenu% THEN GOSUB SavePos: GRAPHIC WINDOW END  ' EXIT Button  End of program
     lb=0: GOTO mainMenuStart
   END IF
   lb=0
 END IF
 
 IF Folder% THEN FolderInput ELSE mainMenuInput
 
'======================================================================================================
ChooseFolder:REM Tab Key in mainMenu Enable working folder change to switch between different companies
'======================================================================================================
 folder%=1: folder$="": TabKey=0: GOSUB TopHeading
 ink$="": kbx=0: kby=0: lmax%=25: FolderName$="": TabKey%=0
 InpBox%=1
 ltxt$="Directory name and path"                          ' Left text bottom prompt
 rtxt$="Hit Return to activate"                           ' Right text bottom prompt
 bgrd=%RED: GOSUB BottomLine: kx!=StartX: ky!=StartY      ' Show Bottom Prompt with red background
 utxt$="You can put your data in the Work Directory or"   ' Show upper Banner line
 btxt$="use a control file to locate it elsewhere"        ' Show bottom Banner line
 bgrd=rose: GOSUB Welcome: csr=-2: GOSUB CsrOn            ' Show Welcome Welcome with new text
 GRAPHIC SET FONT fnt1: GRAPHIC COLOR %GREEN,noir

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
FolderInput:REM Input loop for new drive and/or folder name.  No mouse or function key allowed
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 GRAPHIC GET DC TO hwin: IF hwin=0 THEN END

 IF mm OR lb THEN
   SLEEP 1: GOSUB ButtonOn
   IF lb THEN MainMenu%=0: GOTO MainMenuButton  ' Button pressed
 END IF

 GRAPHIC INKEY$ TO ink$: SLEEP 1: IF ink$="" THEN FolderInput
 IF ink$=CHR$(27) THEN GOSUB ErrSound: folder$=CURDIR$: GOTO MainMenuStart

 IF LEN(ink$)=2 THEN
   ink%=ASC(RIGHT$(ink$,1)): IF ink%>58 AND ink%<69 THEN MainMenu%=0: GOTO MainMenuButton  ' Function Key pressed
 END IF

 IF ink$=CHR$(13) THEN  ' Return key pressed
   IF FolderName$="" THEN GOSUB ErrSound: FolderName$=CURDIR$
   IF INSTR(FolderName$,"\")=0 THEN FolderName$=LEFT$(CURDIR$,3)+Foldername$ ' Complete path name
     TRY
       CHDIR FolderName$: GOSUB InsSound:' exit try
     CATCH
       GOSUB ErrSound: FolderName$=CURDIR$: GOSUB BottomLine: EXIT TRY
     END TRY
   GOTO mainMenuStart
 END IF
 
 IF ink$>CHR$(31) THEN  ' Normal key pressed
   GRAPHIC SET POS (kx!+kbx*CW1!, ky!): GRAPHIC PRINT ink$: GRAPHIC REDRAW
   IF kbx<lmax% THEN INCR kbx: csr=-2: GOSUB CsrOn  ELSE GOSUB ErrSound: csr=-2: GOSUB CsrOn: GOTO FolderInput
   FolderName$=FolderName$+ink$
 END IF

 IF ink$=CHR$(8) AND kbx>0 THEN  ' Backspace pressed
   ink$=" ": GOSUB CsrOff: DECR kbx: csr=-2: FolderName$=LEFT$(FolderName$,LEN(FolderName$)-1)
   GRAPHIC SET POS (kx!, ky!): GRAPHIC PRINT FolderName$+" ": GOSUB CsrOn: GRAPHIC REDRAW
 END IF

GOTO FolderInput

CsrOn:REM Simple non blinking solid cursor size of caracter box
 IF csr<>0 THEN GRAPHIC BOX (kx!+kbx*CW1!, ky!+(kby*CH1!))-(kx!+(kbx*CW1!)+CW1!, ky!+CH1!+(kby*CH1!)),0,%WHITE,csr: csr=0: GRAPHIC REDRAW
RETURN
CsrOff:REM erase cursor at end of line CR and redraw at next position
  GRAPHIC BOX (kx!+kbx*CW1!, ky!+(kby*CH1!))-(kx!+(kbx*CW1!)+CW1!,ky!+CH1!+(kby*CH1!)),0,%BLACK,csr: csr=0: GRAPHIC REDRAW
RETURN

StartScreen:REM Check Screen Resolution  (+) increase (-) decrease  pt0=Banner pt1=Main pt2=Buttons pt3=Logo
 caption$="Menu-CC5.EXE"
 CaptionH=GetSystemMetrics (%SM_CYCAPTION)
 mp!=0: x1=x0: y1=y0: IF x2>DskX THEN scr%=0
AjustScreen:REM Ajust resolution and font size depending on scr%         ' Number of columns and rows will depend on font size
 IF scr%=0 THEN x2=800:  y2=600:  pt0=9:  pt1=9: pt2=6:  pt3=49          ' 800x600   89 columns  40 rows
 IF scr%=1 THEN x2=1024: y2=768:  pt0=11: pt1=11: pt2=8:  pt3=58         ' 1024x768  93 columns  43 rows
 IF scr%=2 THEN x2=1152: y2=864:  pt0=12: pt1=12: pt2=9:  pt3=68         ' 1152x864  96 columns  43 rows
 IF scr%=3 THEN x2=1280: y2=1024: pt0=14: pt1=13: pt2=10: pt3=82         ' 1280x1024 98 columns  47 rows
 IF scr%=4 THEN x2=1440: y2=900:  pt0=14: pt1=15: pt2=11: pt3=76         ' 1440x900  96 columns  36 rows
 IF scr%=5 THEN x2=1600: y2=1024: pt0=15: pt1=17: pt2=12: pt3=85         ' 1600x1024 94 columns  37 rows
 IF scr%=6 THEN x2=1600: y2=1200: pt0=16: pt1=17: pt2=12: pt3=88         ' 1600x1200 94 columns  41 rows
 IF scr%=7 THEN x2=1680: y2=1050: pt0=17: pt1=18: pt2=13: pt3=88         ' 1680x1050 93 columns  35 rows
 IF scr%=8 THEN x2=1920: y2=1200: pt0=20: pt1=20: pt2=14: pt3=95         ' 1920x1200 96 columns  35 rows
 IF scr%=9 THEN caption$="": CaptionH=0: pt0=20: pt1=20: pt2=14: pt3=95  ' Max resolution Full Screen with no TaskBar and no Caption
 IF x2>DskX THEN DECR scr%: caption$="": GOTO AjustScreen                ' Max resolution Full Screen reached early for lesser monitors
 IF y2>DskY-Taskbar AND scr%<9 THEN y2=DskY-TaskBar                      ' Do not hide the TaskBar if present
 IF caption$<>"" AND y2=DskY THEN y2=y2-CaptionH                         ' Allow for Caption Height
 IF caption$="" THEN x2=WinX: y2=WinY: x1=0: y1=0                        ' Full screen if no caption   Screen not movable
RETURN

ClearScrn:REM erase screen
 GRAPHIC BOX (0, CH2!*2+3)-(x2, y2-(CH2!*2+3)),0,%BLACK, %BLACK: GRAPHIC REDRAW   ' Make solid black box to clear part of screen
RETURN

SavePos:REM Save graphic window position and resolution
 OPEN drv$+"ScrSetup.TXT" FOR OUTPUT AS #1: GRAPHIC GET LOC TO x0,y0
 PRINT #1,STR$(x0)+","+STR$(y0)+","+STR$(scr%)
 CLOSE #1: GOSUB ChiSound: SLEEP 500
RETURN

ButtonText:REM Assign names to F1 to F9 buttons
 f1$=" F1 NotePad ": f2$=" F2 Paint ": f3$=" F3 Calc ": F4$=" F4 Explorer ": f5$=" F5 Internet "
 f6$=" F6 CharMap ": f7$=" F7 Sound ": f8$=" F8 Freecell ": f9$=" F9 Hearts ": fin$=" Esc Exit "
'Add more code if more buttons needed
RETURN

StrSize:REM Find Pixel width and height size of text string.  Find Grid size per caracter
 txt$=" "+txt$+" ": GRAPHIC TEXT SIZE txt$ TO tw,th: GRAPHIC TEXT SIZE "Z" TO gw,gh
RETURN

TopHeading:REM Top box to display menu Buttons will be sized automatically by their text length   0=no button
 GRAPHIC SET FONT fnt2: titre$="Main Menu"
 f0=LEN(fin$): f1=LEN(f1$)
 f2=LEN(f1$+f2$): IF f2$="" THEN f2=0
 f3=f2+LEN(f3$): IF f3$="" THEN f3=0
 f4=f3+LEN(f4$): IF f4$="" THEN f4=0
 f5=f4+LEN(f5$): IF f5$="" THEN f5=0
 f6=f5+LEN(f6$): IF f6$="" THEN f6=0
 f7=f6+LEN(f7$): IF f7$="" THEN f7=0
 f8=f7+LEN(f8$): IF f8$="" THEN f8=0
 f9=f8+LEN(f9$): IF f9$="" THEN f9=0
 f10=f9+LEN(f10$): IF f10$="" THEN f10=0
'Draw top buttons
 GRAPHIC SET FONT fnt2
 GRAPHIC BOX (0, 0)-(x2-1, CH2!*2+2),25,%WHITE,%WHITE  ' Outer box Main Menu
 GRAPHIC BOX (2, 2)-(x2-3, CH2!*2),25,%BLACK,%YELLOW   ' Inner box Main Menu
 fgrd=noir: tint=%GREEN
 IF f0 THEN GRAPHIC BOX (x2-CW2!*(f0+1.4), 5)-(x2-6, CH2!*2-3),25,fgrd,tint          ' Esc End
 IF f1 THEN GRAPHIC BOX (CW2!*.6, 5)-(CW2!*(f1+1.3), CH2!*2-3),25,fgrd,tint          ' F1 box
 IF f2 THEN GRAPHIC BOX (CW2!*(f1+1.7), 5)-(CW2!*(f2+2.3), CH2!*2-3),25,fgrd,tint    ' F2 box
 IF f3 THEN GRAPHIC BOX (CW2!*(f2+2.7), 5)-(CW2!*(f3+3.3), CH2!*2-3),25,fgrd,tint    ' F3 box
 IF f4 THEN GRAPHIC BOX (CW2!*(f3+3.7), 5)-(CW2!*(f4+4.3), CH2!*2-3),25,fgrd,tint    ' F4 box
 IF f5 THEN GRAPHIC BOX (CW2!*(f4+4.7), 5)-(CW2!*(f5+5.3), CH2!*2-3),25,fgrd,tint    ' F5 box
 IF f6 THEN GRAPHIC BOX (CW2!*(f5+5.7), 5)-(CW2!*(f6+6.3), CH2!*2-3),25,fgrd,tint    ' F6 box
 IF f7 THEN GRAPHIC BOX (CW2!*(f6+6.7), 5)-(CW2!*(f7+7.3), CH2!*2-3),25,fgrd,tint    ' F7 box
 IF f8 THEN GRAPHIC BOX (CW2!*(f7+7.7), 5)-(CW2!*(f8+8.3), CH2!*2-3),25,fgrd,tint    ' F8 box
 IF f9 THEN GRAPHIC BOX (CW2!*(f8+8.7), 5)-(CW2!*(f9+9.3), CH2!*2-3),25,fgrd,tint    ' F9 box
'Add text inside buttons
 GRAPHIC COLOR fgrd,tint
 IF f0 THEN GRAPHIC SET POS (x2-CW2!*(f0+1), CH2!*.6): GRAPHIC PRINT fin$            ' Esc End
 IF f1 THEN GRAPHIC SET POS (CW2!, CH2!*.6): GRAPHIC PRINT f1$                       ' F1 text
 IF f2 THEN GRAPHIC SET POS (CW2!*(f1+2), CH2!*.6): GRAPHIC PRINT f2$                ' F2 Text
 IF f3 THEN GRAPHIC SET POS (CW2!*(f2+3), CH2!*.6): GRAPHIC PRINT f3$                ' F3 Text
 IF f4 THEN GRAPHIC SET POS (CW2!*(f3+4), CH2!*.6): GRAPHIC PRINT f4$                ' F4 Text
 IF f5 THEN GRAPHIC SET POS (CW2!*(f4+5), CH2!*.6): GRAPHIC PRINT f5$                ' F5 Text
 IF f6 THEN GRAPHIC SET POS (CW2!*(f5+6), CH2!*.6): GRAPHIC PRINT f6$                ' F6 Text
 IF f7 THEN GRAPHIC SET POS (CW2!*(f6+7), CH2!*.6): GRAPHIC PRINT f7$                ' F7 Text
 IF f8 THEN GRAPHIC SET POS (CW2!*(f7+8), CH2!*.6): GRAPHIC PRINT f8$                ' F8 Text
 IF f9 THEN GRAPHIC SET POS (CW2!*(f8+9), CH2!*.6): GRAPHIC PRINT f9$                ' F9 Text
 GRAPHIC REDRAW
RETURN

ButtonOn:REM find button that are under mouse
 IF mo=1 THEN mo=0: GOSUB MouseOver  ' All Buttons green
 IF my<CH2!*1.75 AND my>CH2!/4 AND mx>CW2!/4 AND mx<x2-CW2!/2 THEN
   IF mx>CW2! AND mx<CW2!*(f1+1) THEN mo=1: mp!=CW2!: mo$=f1$ '              F1
   IF mx>CW2!*(f1+2) AND mx<CW2!*(f2+2) THEN mo=1: mp!=CW2!*(f1+2): mo$=f2$ 'F2
   IF mx>CW2!*(f2+3) AND mx<CW2!*(f3+3) THEN mo=1: mp!=CW2!*(f2+3): mo$=f3$ 'F3
   IF mx>CW2!*(f3+4) AND mx<CW2!*(f4+4) THEN mo=1: mp!=CW2!*(f3+4): mo$=f4$ 'F4
   IF mx>CW2!*(f4+5) AND mx<CW2!*(f5+5) THEN mo=1: mp!=CW2!*(f4+5): mo$=f5$ 'F5
   IF mx>CW2!*(f5+6) AND mx<CW2!*(f6+6) THEN mo=1: mp!=CW2!*(f5+6): mo$=f6$ 'F6
   IF mx>CW2!*(f6+7) AND mx<CW2!*(f7+7) THEN mo=1: mp!=CW2!*(f6+7): mo$=f7$ 'F7
   IF mx>CW2!*(f7+8) AND mx<CW2!*(f8+8) THEN mo=1: mp!=CW2!*(f7+8): mo$=f8$ 'F8
   IF mx>CW2!*(f8+9) AND mx<CW2!*(f9+9) THEN mo=1: mp!=CW2!*(f8+9): mo$=f9$ 'F9
   IF mx>x2-CW2!*(f0+1) THEN mo=1: mp!=x2-CW2!*(f0+1): mo$=fin$
 END IF
 GOSUB MouseOver: rb=0: mm=0: mb=0: wm=0:  GRAPHIC REDRAW
 GRAPHIC COLOR %GREEN,%BLACK: GRAPHIC SET FONT fnt1
RETURN

MouseOver:REM Show Mouse Over event with small font and fill whole box red or green
 GRAPHIC SET FONT fnt2
   IF mo=1 THEN
     GRAPHIC COLOR %WHITE,%RED: GRAPHIC PAINT REPLACE (mp!,CH2!*.6), %RED,%GREEN
       ELSE
         GRAPHIC COLOR %BLACK,%GREEN: GRAPHIC PAINT REPLACE (mp!,CH2!*.6), %GREEN,%RED
   END IF
   IF mp!<>0 THEN GRAPHIC SET POS (mp!,CH2!*.6): GRAPHIC PRINT mo$
 GRAPHIC SET FONT fnt1
RETURN

Banner:REM Banner showing Name, Data folder Location, Accounting period and Menu name
 br=y2*9/16: brx=(x2-br)/2: bry=(y2-br)/2                                                     ' Size of box
 GRAPHIC SET FONT fnt0: txt$="Z": GOSUB StrSize
 GRAPHIC BOX (gw*11.5, CH2!*2.5)-(x2-gw*11.5, CH2!*3+gh*3.5),10,%WHITE,%WHITE                 ' Outer box
 GRAPHIC BOX (gw*11.5+4, CH2!*2.5+3)-(x2-(gw*11.5)-4, CH2!*3+gh*3.5-4),10,noir,orange         ' Inner box
 GRAPHIC COLOR noir,%WHITE
 IF NewName$<>"" THEN nom$=NewName$: NewName$=""
 txt$=nom$: GOSUB StrSize: GRAPHIC SET POS ((x2-tw)/2, CH2!*3): GRAPHIC PRINT txt$            ' Company name on top
 GRAPHIC SET POS (gw*12.5, CH2!*3+gh): GRAPHIC PRINT DataDir$                                 ' Data Folder on left
 txt$=period$: GOSUB StrSize: GRAPHIC SET POS (x2-tw-gw*12.5, CH2!*3+gh): GRAPHIC PRINT txt$  ' Period on right
 txt$=titre$: GOSUB StrSize: GRAPHIC SET POS ((x2-tw)/2, CH2!*3+gh*2): GRAPHIC PRINT txt$     ' Title at bottom
RETURN

logo:REM Print a round logo in graphic window Center
 Author$="Guy Dombrowski Inc": Program$="Graphic Console Menu": logoName$="GDI"
 GRAPHIC WIDTH 4 : GRAPHIC SET FONT fnt0
 br=y2*9/16: brx=(x2-br)/2: bry=(y2-br)/2                             ' Bounding Rectangle size = 9/16 of screen height and will always be centered
 ir=br*89/128: irx=brx+(br-ir)/2: iry=bry+(br-ir)/2                   ' Inner Rectangle size tied to Bounding Rectangle Circle
 GRAPHIC ELLIPSE (brx, bry)-(brx+br, bry+br),%WHITE,%GREEN            ' Outer Circle
 GRAPHIC ELLIPSE (brx+3, bry+3)-(brx+br-3, bry+br-3),%BLACK,%GREEN    ' Inner Circle
 GRAPHIC BOX (irx, iry)-(irx+ir, iry+ir),0,%BLACK,jaune               ' Draw center box
'Couleurs des arcs
 GRAPHIC PAINT REPLACE (irx+ir/2, (iry+(bry-iry)/4)), %YELLOW,%GREEN  ' top arc yellow
 GRAPHIC PAINT REPLACE (irx+ir/2, (bry+br-(br-ir)/4)), %RED,%GREEN    ' bottom arc red
 GRAPHIC PAINT REPLACE (irx+ir+(br-ir)/4, brx+(br-ir)/4),%CYAN,%GREEN ' right arc cyan
'Boites internes de texte
 GRAPHIC BOX (irx, iry)-(irx+ir, iry+th*2),0,%BLACK,orange            ' top text box orange
 GRAPHIC BOX (irx, iry+ir-th*2)-(irx+ir, iry+ir),0,%BLACK,orange      ' Bottom text box orange
 GRAPHIC COLOR noir,jaune
 txt$=Author$: GOSUB StrSize: GRAPHIC SET POS (irx+(ir-tw)/2, iry+th/2): GRAPHIC PRINT txt$          ' Author Name
 txt$=program$: GOSUB Strsize: GRAPHIC SET POS (irx+(ir-tw)/2, iry+ir-th*1.5 ): GRAPHIC PRINT txt$   ' Program Name
 GRAPHIC SET FONT fnt3
 txt$=LogoName$: GOSUB StrSize: GRAPHIC SET POS (irx+(ir-tw)/2, iry+(ir-th)/2-4): GRAPHIC PRINT txt$ ' Logo Name
 GRAPHIC SET FONT fnt2: GRAPHIC COLOR noir,%YELLOW
 txt$="Console"+STR$(x2)+" x"+STR$(y2): GOSUB StrSize: GRAPHIC SET POS (irx+(ir-tw)/2, iry-th*2): GRAPHIC PRINT txt$
 GRAPHIC COLOR %WHITE,%RED
 txt$="Windows"+STR$(WinX)+" x"+STR$(WinY): GOSUB StrSize: GRAPHIC SET POS (irx+(ir-tw)/2, iry+ir+th*1): GRAPHIC PRINT txt$
 GRAPHIC WIDTH 1
RETURN

Welcome:REM Banner showing Welcome at start of program and used for prompt later
 GRAPHIC SET FONT fnt0: txt$=utxt$: GOSUB StrSize                                                 ' Find size of line to ajust box width
 GRAPHIC BOX (0, bry+br+gh)-(x2, bry+br+gh*4),0,noir,noir                                         ' Clear preceding box
 GRAPHIC BOX ((x2-tw)/2-gw*2, bry+br+gh)-(x2-(x2-tw)/2+gw*2, bry+br+gh*4),10,%WHITE,%WHITE        ' Outer box
 GRAPHIC BOX ((x2-tw)/2-gw*2+3, bry+br+gh+3)-(x2-(x2-tw)/2+gw*2-3, bry+br+gh*4-3),10,noir,bgrd    ' Inner box
 GRAPHIC COLOR %WHITE,bgrd
 txt$=utxt$: GOSUB StrSize: GRAPHIC SET POS ((x2-tw)/2, bry+br+gh*1.5): GRAPHIC PRINT txt$        ' Line 1
 txt$=btxt$: GOSUB StrSize: GRAPHIC SET POS ((x2-tw)/2, bry+br+gh*2.5): GRAPHIC PRINT txt$        ' Line 2
 GRAPHIC REDRAW
RETURN

BottomLine:REM Bottom box to display operator prompt and show working folder
 GRAPHIC SET FONT fnt0
 GRAPHIC BOX (0, y2-CH2!*2)-(x2, y2),0,noir,noir                               ' Clear preceding box
 GRAPHIC BOX (CW2!*10, y2-CH2!*2)-(x2-CW2!*10, y2),25,%WHITE,%WHITE            ' Outer box
 GRAPHIC BOX (CW2!*10+3, y2-(CH2!*2-3))-(x2-CW2!*10-3, y2-3),25,%BLACK,bgrd    ' Inner box
 GRAPHIC COLOR %WHITE,bgrd
 txt$=ltxt$: GOSUB StrSize: twl=tw: GRAPHIC SET POS (CW2!*10.5, y2-CH2!*2+4): GRAPHIC PRINT txt$
 txt$=rtxt$: GOSUB StrSize: twr=tw: GRAPHIC SET POS (x2-tw-CW2!*10.5, y2-CH2!*2+4): GRAPHIC PRINT txt$

 IF InpBox%=1 THEN  ' Bottom line is also used as input box
   GRAPHIC BOX (CW2!*12+twl, y2-CH2!*2+3)-(x2-twr-(CW2!*11.5), y2-3),0,noir,noir ' Input box erased
   StartX=CW2!*13+twl: StartY=y2-CH2!*1.5
   GRAPHIC SET FONT fnt1
   GRAPHIC COLOR %GREEN,noir: GRAPHIC SET POS (StartX, StartY): GRAPHIC PRINT folder$
 END IF

GRAPHIC REDRAW: RETURN

accent: REM Convert DOS French accents to Windows accents
 FOR z% = 1 TO LEN(z$)
  i% = ASC(MID$(z$, z%, 1))
  IF i% = 130 THEN MID$(z$, z%, 1) = CHR$(233): ITERATE 'é ‚
  IF i% = 131 THEN MID$(z$, z%, 1) = CHR$(226): ITERATE 'â ƒ
  IF i% = 133 THEN MID$(z$, z%, 1) = CHR$(224): ITERATE 'à …                                             adding Windows sounds
  IF i% = 135 THEN MID$(z$, z%, 1) = CHR$(231): ITERATE 'ç ‡
  IF i% = 136 THEN MID$(z$, z%, 1) = CHR$(234): ITERATE 'ê ˆ
  IF i% = 137 THEN MID$(z$, z%, 1) = CHR$(235): ITERATE 'ë ‰
  IF i% = 138 THEN MID$(z$, z%, 1) = CHR$(232): ITERATE 'è Š
  IF i% = 140 THEN MID$(z$, z%, 1) = CHR$(238): ITERATE 'î Œ
  IF i% = 147 THEN MID$(z$, z%, 1) = CHR$(244): ITERATE 'ô “
  IF i% = 150 THEN MID$(z$, z%, 1) = CHR$(251): ITERATE 'û –
 NEXT
RETURN

ErrSound:REM make windows error sound instead of beep
 PlaySound "errors.wav",0,%SND_ASYNC: IF NoSnd% THEN BEEP
RETURN
InsSound:REM make windows install hardware sound
 PlaySound "insert.wav",0,%SND_ASYNC: IF NoSnd% THEN BEEP
RETURN
RemSound:REM make windows remove hardware sound
 PlaySound "remove.wav",0,%SND_ASYNC: IF NoSnd% THEN BEEP
RETURN
ChiSound:REM Play windows Chime sound
 PlaySound "chimes.wav",0,%SND_ASYNC: IF NoSnd% THEN BEEP
RETURN
StopSound:REM Play windows Stop sound
 PlaySound "stop.wav",0,%SND_ASYNC: IF NoSnd% THEN BEEP
RETURN
ChoSound:REM Play windows chords sound
 PlaySound "chords.wav",0,%SND_ASYNC: IF NoSnd% THEN BEEP
RETURN

ErrHandling: REM Error code
 GOSUB ErrSound: ltxt$="Error"+STR$(ERR)+"  Line"+STR$(ERL): rtxt$="Press any key"
 GRAPHIC SET FONT fnt0: txt$=ltxt$: GOSUB StrSize: kx!=CW2!*9+tw: bgrd=%RED
 IF ERR=53 THEN folder$="Program not found"
 InpBox%=1: GOSUB BottomLine: csr=-2: kx!=StartX: GOSUB CsrOn
 GRAPHIC WAITKEY$ TO z$: ERR=0: lb=0: folder$=CURDIR$: MainMenu%=1
RESUME MainMenuStart

END FUNCTION

[Arthur Gomide]

> Menu-CC5.bas

Does you could post the executable exe for those, like myself, who still do not have the new compiler?

TIA

[Michael Mattias]

Also, if it's intended to be Source Code for others to use, why not put it in the - yes - SOURCE CODE forum?

(!!! Where's the smiley for 'frustrated???!!!)

[Guy Dombrowski]

Source code

Friends, I stand corrected

I simply did not think that my humble try at a graphic programming menu was going to attract much attention as my other post "End of the 80x25 Console" got 2923 hits and this one had no reply at all until today.

So this is the first time for me to post in the Source Forum and I hope everything work as it should.

That post is not my last code as my software is in French and it is tied to my old QB45 data files so my new sources would need some external files to work properly.
But I can tell you I am having a lot of fun rewriting my old programs with the Graphic Console Technique.

I want to thank again all of you who helped me with my problems so far and if, in turn, if I can also help other members, I will do it gladly.

[Michael Mattias]

Good for you, posting in source code forum.

The search for source code is a lot more efficient when source code is found in the source code forum and has a meaningful subject line. I would not even want to guess how much useful code is here but lies untouched because it's buried on page three of a six-page thread with a subject line at best only touching on the purpose of the code.

Posting code is good, but give me a break: THREE (3) Habs are STARTERS in the All-Star Game? Including Carey Price?

Sheesh.

[Guy Dombrowski]

Hockey Fan ?

Michael, I am not a big hockey fan but I seem to remember that our Junior Hockey Team won the Gold for the 5th year in a row for the World Cup !

[Michael Mattias]

Well, Canada IS the home of hockey; you'd expect some good performance by Canadian teams.

But if you want to start a border war, we could always bring up the last time a Canadian team took home the Stanley Cup. Why, I do believe I still had hair when that last occurred..

..(he said on the last day of his fifty-eighth year)..


MCM

[Guy Dombrowski]

Well, most of your greatest players are Canadian so I would not brag too much.....
I Will be 69 this year but I still have a full head of hair ...

[Michael Mattias]

> Will be 69 this year but I still have a full head of hair ...

Well, the memory goes, too; but I do remember enough to know that what I want to say has something to do with the horse you rode in on.

[Guy Dombrowski]

Last day of my 58th year

Well, HAPPY 59th BIRTHDAY yong man
A little late but what the hell it is the intention that count !

[Michael Mattias]

It was only the fifty-ninth if you count the original "birth day" [two words], which I believe is done only in China.

All these years programming and you still make fencepost errors, huh?

[Guy Dombrowski]

Birth Day

Michael, Sorry about the misspelling,

My first language is not English so may I be forgiven for a small mistake but I have seen a lot of worse English Posts in that Forum.

If you try replying in French, I will not laugh at you.

A few month back, somebody you know well called you a "Curmudgeon"

What does "Curmudgeon" mean ?

[Michael Mattias]

>What does "Curmudgeon" mean ?

If it applied to me, I'm certain it means "wonderful human being."

[Guy Dombrowski]

Well,

Let us say that it will improve my English Language understanding.
Of course, Wikipedia has a different meaning....
What does "Cantakerous" mean ?