Announcement

Collapse
No announcement yet.

Graphic Console Menu

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Graphic Console Menu

    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

    Code:
    '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
    Old QB45 Programmer

  • #2
    > Menu-CC5.bas

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

    TIA
    Last edited by Arthur Gomide; 15 Jan 2009, 05:00 PM. Reason: my bad English ...
    "The trouble with quotes on the Internet is that you can never know if they are genuine." - Abraham Lincoln.

    Comment


    • #3
      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???!!!)
      Michael Mattias
      Tal Systems (retired)
      Port Washington WI USA
      [email protected]
      http://www.talsystems.com

      Comment


      • #4
        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.
        Old QB45 Programmer

        Comment


        • #5
          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.
          Michael Mattias
          Tal Systems (retired)
          Port Washington WI USA
          [email protected]
          http://www.talsystems.com

          Comment


          • #6
            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 !:tongue:
            Old QB45 Programmer

            Comment


            • #7
              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
              Michael Mattias
              Tal Systems (retired)
              Port Washington WI USA
              [email protected]
              http://www.talsystems.com

              Comment


              • #8
                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 ...
                Last edited by Guy Dombrowski; 16 Jan 2009, 07:14 PM.
                Old QB45 Programmer

                Comment


                • #9
                  > 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.
                  Michael Mattias
                  Tal Systems (retired)
                  Port Washington WI USA
                  [email protected]
                  http://www.talsystems.com

                  Comment


                  • #10
                    Last day of my 58th year

                    Well, HAPPY 59th BIRTHDAY yong man :wavey:
                    A little late but what the hell it is the intention that count !
                    Last edited by Guy Dombrowski; 17 Jan 2009, 04:31 PM.
                    Old QB45 Programmer

                    Comment


                    • #11
                      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?
                      Michael Mattias
                      Tal Systems (retired)
                      Port Washington WI USA
                      [email protected]
                      http://www.talsystems.com

                      Comment


                      • #12
                        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 ?
                        Last edited by Guy Dombrowski; 18 Jan 2009, 01:52 PM.
                        Old QB45 Programmer

                        Comment


                        • #13
                          >What does "Curmudgeon" mean ?

                          If it applied to me, I'm certain it means "wonderful human being."
                          Michael Mattias
                          Tal Systems (retired)
                          Port Washington WI USA
                          [email protected]
                          http://www.talsystems.com

                          Comment


                          • #14
                            Well,

                            Let us say that it will improve my English Language understanding.
                            Of course, Wikipedia has a different meaning....
                            What does "Cantakerous" mean ?
                            Last edited by Guy Dombrowski; 18 Jan 2009, 07:50 PM.
                            Old QB45 Programmer

                            Comment

                            Working...
                            X