End of the 80x25 Console

Michael Mattias replied

20 Oct 2008, 09:24 AM
I'm thinking of using the GRAPHIC WINDOW as a canvas for an almost Windows-free GUI Forms builder, for use by people who either don't know or won't know Windows (I respect the reasons for both). It also has to be very simple to use. And simple to develop.

Were I with PowerBASIC Inc, I might suggest using the PowerBASIC Compiler for Windows. This product is designed to create Windows GUI applications. They have this new thing called "Dynamic Dialog Tools" which eliminates most of the Windows API ("SDK-style") call requirements.

???
Leave a comment:
Guy Dombrowski replied

20 Oct 2008, 07:14 AM
Great minds think alike....

Chris,

I have been working toward that very goal.

So far, my code has been designed for my own needs but with help from a few of you hot programmers, we could end up with a new tool for the non Window guys.

The main problem with Console programming has always been the poor display but with the Graphic Console concept, I think it will be a lot more popular in the futur.

So, you can count me in
Leave a comment:
Rodney Hicks replied

20 Oct 2008, 04:47 AM
Run with this Chris. I know you can do it alone if you have to. It makes good sense. I'm too busy to offer anything but encouragement(aren't you lucky!). I would like to see this happen.
Leave a comment:
Chris Holbrook replied

20 Oct 2008, 04:07 AM
Continuing Guy's theme, I'm thinking of using the GRAPHIC WINDOW as a canvas for an almost Windows-free GUI Forms builder, for use by people who either don't know or won't know Windows (I respect the reasons for both). It also has to be very simple to use. And simple to develop.

There are two sides to it, writing the forms designer and writing the controls themselves. I've got a bit of experience in each of these.

Anyone care to join me in this? Thoughtful, communicative design input would be most welcome at this stage.
Leave a comment:
Guy Dombrowski replied

16 Oct 2008, 09:21 AM
Upgrade

Chris, you won't regret it
Leave a comment:
Chris Holbrook replied

15 Oct 2008, 06:05 PM
Guy, thanks for the example, my V5 upgrade order is in.
Leave a comment:
Guy Dombrowski replied

14 Oct 2008, 07:22 PM
Wide monitor

Here is the reason for those long code lines.
I have 2 of those side by side.
I usually park my program output on the left monitor so I can watch the new results as I change the code on the right one.
Sorry about all the side scrolling you have to to.
This screen is 800 by 600.

PowerBASIC

http://www.powerbasic.com/support/pbforums/attachment.php?attachmentid=740&stc=1&d=1224030131

Attached Files
Last edited by Guy Dombrowski; 15 Oct 2008, 07:25 AM.
Leave a comment:
Guy Dombrowski replied

14 Oct 2008, 07:01 PM
Another menu

Chris,

Here is what could be some of the other menus.
This will be used for storing Matrix Printers Escape codes.
The first 20 lines are your descriptions and the next 20 are the actual escape codes.
You can simply edit the file with NotePad for testing purpose.

I bet you Bob can find your missing number very quickly.

PowerBASIC

http://www.powerbasic.com/support/pbforums/attachment.php?attachmentid=739&stc=1&d=1224028827

Attached Files
Last edited by Guy Dombrowski; 14 Oct 2008, 07:03 PM.
Leave a comment:
Chris Holbrook replied

14 Oct 2008, 06:15 PM
Thanks Guy that works.

I think I should buy one. Now, where did I put the old licence number?
Leave a comment:
Guy Dombrowski replied

14 Oct 2008, 05:53 PM
Posting attachment

Sorry about that, it is the first time I have tried to post any attachment.
I uploaded my JPG picture but something must be missing in order for the attachment to be available ?

Trying to copy link location in "Manage Attachments"

PowerBASIC

http://www.powerbasic.com/support/pbforums/attachment.php?attachmentid=738&stc=1&d=1224024701

Attached Files
Leave a comment:
Chris Holbrook replied

14 Oct 2008, 04:15 PM
Nice try Guy but I don't have permission to read that link!
Leave a comment:
Guy Dombrowski replied

14 Oct 2008, 04:05 PM
Screenshot

Hi Chris,

Here is a JPG of my main menu.
The PBCC5 upgrade is well worth the $$$ asked.
It is a real pleasure to write code with it.

PowerBASIC

http://www.powerbasic.com/support/pbforums/newattachment.php?t=38632&poststarttime=1224018131&posthash=219681ece067208c5592e432fe6b8d82
Leave a comment:
Chris Holbrook replied

14 Oct 2008, 03:42 PM
Mr Dumbrowski,

for those of us who are thinking about buying PBCC V5 but have not yet made up their minds, please could you post screenshots?

Thanks!
Leave a comment:

Guy Dombrowski replied

13 Oct 2008, 10:15 PM

Graphic Console 2.0

Hi everybody,

Since this post was widely read I have been working hard to improve the concept and I think you will like the result !
I found a neat trick to ajust the console size the simplest possible way.
Just hit the (+) and (-) keys to increase or decrease the resolution from 800x600 to 1920x1200.
All text and graphic will scale properly.
Let me tell you that a full screen console of that size without caption heading and bottom taskbar is totally awsome.
I also added a little logo I have been using on my printed form.
Of course this is still a work in progress and I will be adding code for a while so stay tuned for my next iteration.
Also any suggestion will be appreciated.

Code:

'A new and better way of ajusting a Graphic Console
'Simply hit the (+) and (-) key to increase or decrease the console size. All fonts and graphics will scale.
'If you have a 1920 x 1200 monitor, you will have 10 differents size to try
'Position is also saved so if you have 2 monitors, you can park the graphic screen in either one.
'The buttons size and location will be ajusted automatically to the text length of F1$ to F7$
'Put your program names in P1$ to P6$.  May be used to call your old modules while writing the new ones.
'Full keyboard and mouse handling including the middle button and scroll wheel
'Bottom Heading will show resolution changes and maximum Desktop size
'The center will show the cursor row position change when using the mouse wheel
'The right one the number of Rows and Columns possible with the chosen font plus the caracter grid size
'Enter text and hit Return for next line or move anywhere with the arrows.  Clic F6 to clear page
'F7 is the start of a printer scrip. It will read 40 lines. The first 20 are the esc codes descriptions and the next 20 are the actual code
'You can edit DotMatrix.txt to add instructions and printer codes as needed.
'Home and End move at line beginning and end.  PgUp and PgDn scroll whole page.
'Click anywhere on screen to position cursor with left or right button and enter text.
'Mouse wheel will move cursor up or down anywhere
'Move mouse over top Buttons for MouseOver effect and click them to start the code associated to them
'Program will end with Exit button or closing window or F1 to F6 if no program exist to load or with the Esc key

#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

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_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
 DIM spec$(30),scrn$(30),s$(10)
 LOCAL hGraphicWindow AS LONG
 DESKTOP GET CLIENT TO DskX,DskY                        ' Find Desk resolution minus task bar if not hidden
 DESKTOP GET SIZE TO MonX,MonY                          ' Find Absolute monitor size
 TaskBar=MonY-DskY                                      ' Taskbar height ( if normal ? )
 CaptionH=TaskBar: IF CaptionH=0 THEN CaptionH=MonY/32  ' Aproximate height if TaskBar hidden

 drv$=LEFT$(CURDIR$,2): spec$=drv$+"specsys"            ' Lire spec Drive par default
 GOSUB LitSpec

Setting:REM read saved Screen Setting position and resolution and mix special colors that will be used in our menus
 rouge=RGB(255,200,200): rose=RGB(255,0,255): vert=RGB(200,255,200): bleu=RGB(100,200,255): jaune=RGB(255,255,170): orange=RGB(255,180,50): gris=RGB(220,220,220)
 x0=0: y0=0: pt=0: x1=0: y1=0: pt=0: x2=800:  y2=600:  pt0=9:  pt1=10: pt2=6:  pt3=49 ' Minimum setup
 OPEN "SetScreen.TXT" FOR INPUT AS #1: IF ERR>0 THEN ERR=0: GOTO StartWindow          ' First time with no setup data
 REDIM s$(2): IF EOF(1)=0 THEN LINE INPUT#1,z$: PARSE z$,s$(),","                     ' Read last saved position
 IF s$(0)<>"" THEN x0=VAL(s$(0)): y0=VAL(s$(1)): scr%=VAL(s$(2))                      ' Graphic Window position and resolution
 CLOSE #1: GOSUB ReadCaption

StartWindow:REM Start Graphic Window with variable resolution controled with the (+) and (-) key
 FONT NEW "Sylfaen",pt+pt0,0,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
 GRAPHIC SET FONT fnt2: GRAPHIC CHR SIZE TO CarW2!,CarH2! ' Find pixel width and height of fnt2 graphic font
 GRAPHIC SET FONT fnt1: GRAPHIC CHR SIZE TO CarW!,CarH!   ' Find pixel width and height of fnt1 graphic font
 GRAPHIC CLEAR %BLACK,%GREEN: GRAPHIC COLOR %GREEN,%BLACK ' Black background with Green text like old time
 MaxCol=x2/CarW!: MaxRow=y2/CarH!-3                       ' Maximums will depend on number of pixels on desktop
 GRAPHIC WIDTH 1: GRAPHIC REDRAW                          ' Show screen background instantly
 GOSUB ProgName: GOSUB ButtonText                         ' Assign programs and names to buttons
 GOSUB TopHeading: GRAPHIC COLOR %GREEN,%BLACK            ' Show Top Menu
 GOSUB BottomHeading: GRAPHIC COLOR %GREEN,%BLACK         ' Show Bottom Menu
 x=0: y=2: csr=-2                                         ' Cursor start position and style -2 is empty rectangle

KeyMouse:REM Keyboard and Mouse input
 GRAPHIC GET DC TO hwin: IF hwin=0 THEN END                                  ' Graphic Window has been closed
 GRAPHIC INKEY$ TO ink$: SLEEP 1: ink%=0: GOSUB CursorOn
   IF ink$=CHR$(27) THEN                                                     ' Esc key end Utility Menu or Main Program if in Main Menu
     IF fin% THEN GOSUB SavePos: GRAPHIC WINDOW END: END
     IF tool% THEN GOSUB ClearScrn: GOSUB ButtonText: GOSUB TopHeading: tool%=0
   END IF
'Mouse section
   IF lb AND my<CarH2!*2 THEN ' Clicking the F1 to f6 buttons with mouse Left button will start new program but will not end menu like the Function keys
     IF fin% THEN csr=-2: GOSUB CursorOff: x=mx/CarW!-1: y=my/CarH!-1: GOSUB CursorOn
     IF mx>CarW2! AND mx<CarW2!*(f1+1) AND fin% THEN SHELL p1$                 ' F1 Program
     IF mx>CarW2!*(f1+2) AND mx<CarW2!*(f2+2) AND fin% THEN SHELL p2$          ' F2 Program
     IF mx>CarW2!*(f2+3) AND mx<CarW2!*(f3+3) AND fin% THEN SHELL p3$          ' F3 Program
     IF mx>CarW2!*(f3+4) AND mx<CarW2!*(f4+4) AND fin% THEN SHELL p4$          ' F4 Program
     IF mx>CarW2!*(f4+5) AND mx<CarW2!*(f5+5) AND fin% THEN SHELL p5$          ' F5 Program
     IF mx>CarW2!*(f5+6) AND mx<CarW2!*(f6+6) AND fin% THEN GOSUB ClearScrn    ' F6 Wipe screen to try text and mouse
     IF mx>CarW2!*(f6+7) AND mx<CarW2!*(f7+7) AND fin% THEN GOSUB Utilitaires  ' F7 Code inside menu
       IF mx>x2-CarW2!*(f0+1) AND mo=1 THEN
         GOSUB ClearScrn
         IF fin% THEN GOSUB SavePos: fin%=0: END                      ' End button pressed in Main Menu  Program end
         IF tool% THEN GOSUB ButtonText: GOSUB TopHeading: tool%=0    ' End Button pressed in Utility menu back to main menu
       END IF
   END IF
'Show action Results
 IF lb OR rb THEN csr=-2: GOSUB CursorOff: x=mx/CarW!-1: y=my/CarH!-1: GOSUB CursorOn:            ' Show Cursor position when left or right button clicked
 IF wm THEN
   csr=-2: GOSUB CursorOff: y=y-wm: IF y<2 THEN BEEP: y=2 ELSE IF y>MaxRow THEN BEEP: y=MaxRow    ' Wheel mouse limit
   GOSUB CursorOn
 END IF
 IF lb OR rb OR mm OR wm OR mb THEN GOSUB prompt                                          ' Show mouse movements and where both button are clicked
 IF ink$="" THEN KeyMouse
'Keyboard special key section
 IF LEN(ink$)=2 THEN
   ink%=ASC(RIGHT$(ink$,1)): ink$="": csr=-2
   IF ink%=59 AND fin% THEN GRAPHIC WINDOW END: SHELL p1$  ' F1 key  The F keys will terminate the menu but the buttons will not
   IF ink%=60 AND fin% THEN GRAPHIC WINDOW END: SHELL p2$  ' F2 key
   IF ink%=61 AND fin% THEN GRAPHIC WINDOW END: SHELL p3$  ' F3 key
   IF ink%=62 AND fin% THEN GRAPHIC WINDOW END: SHELL p4$  ' F4 key
   IF ink%=63 AND fin% THEN GRAPHIC WINDOW END: SHELL p5$  ' F5 key
   IF ink%=64 AND fin% THEN GOSUB ClearScrn                ' F6 key Will simply wipe screen
   IF ink%=65 AND fin% THEN GOSUB Utilitaires              ' F7 Utility section with own menu
   IF ink%=71 THEN GOSUB CursorOff: x=0                                                   ' End
   IF ink%=72 THEN GOSUB CursorOff: IF y>2 THEN y=y-1 ELSE BEEP                           ' Up arrow
   IF ink%=75 THEN GOSUB CurSorOff: IF x>0 THEN x=x-1 ELSE BEEP                           ' Left arrow
   IF ink%=77 THEN GOSUB CurSorOff: IF x<MaxCol-1 THEN x=x+1 ELSE BEEP                    ' Right arrow
   IF ink%=80 THEN GOSUB CursorOff: IF y<MaxRow-1 THEN y=y+1 ELSE BEEP: y=MaxRow          ' Down arrow
   IF ink%=79 THEN GOSUB CursorOff: x=MaxCol-1                                            ' Home
'Keyboard scrolling section
  'Insert one space and move line right
   IF ink%=82 THEN GOSUB CursorOff: GRAPHIC COPY hGraphicWindow, 0,(x*CarW!,y*CarH!)-((MaxCol)*CarW!,y*CarH!+CarH!) TO ((x+1)*CarW!,y*CarH!): ink$=" ": GOSUB ScrnPrint
  'Delete one space and move line left
   IF ink%=83 THEN GOSUB CursorOff: GRAPHIC COPY hGraphicWindow, 0,(x*CarW!+CarW!,y*CarH!)-((MaxCol)*CarW!,y*CarH!+CarH!) TO (x*CarW!,y*CarH!): ink$=" ": x0=x: x=MaxCol-1: GOSUB ScrnPrint: x=x0
  'Scroll whole screen up
   IF ink%=73 THEN GOSUB CursorOff: GRAPHIC COPY hGraphicWindow, 0,(0,3*CarH!)-(MaxCol*CarW!,MaxRow*CarH!) TO (0,2*CarH!): ink$="": x=0: y=2: GOSUB ScrnPrint
  'Scrool whole screen down
   IF ink%=81 THEN GOSUB CursorOff: GRAPHIC COPY hGraphicWindow, 0,(0,2*CarH!)-(MaxCol*CarW!,MaxRow*CarH!) TO (0,3*CarH!): ink$=STRING$(MaxCol,32): x=0: y=2: GOSUB ScrnPrint
   GOTO KeyMouse
 END IF
'Keyboard regular key section
 IF ink$=CHR$(8) AND x>0 THEN ink$="": GOSUB CursorOff: x=x-1: csr=-2: GOSUB ScrnPrint
   IF ink$="+" THEN
     IF scr%<9 THEN scr%=scr%+1: GRAPHIC WINDOW END: GOSUB ReadCaption:  GOTO StartWindow ELSE BEEP       ' Restart graphic window with more resolution
   END IF
   IF ink$="-" THEN
      IF scr%>0 THEN scr%=scr%-1: x2=0: GRAPHIC WINDOW END: GOSUB ReadCaption: GOTO StartWindow  ELSE BEEP ' Restart graphic window with less resolution
   END IF
 IF ink$=CHR$(13) THEN csr=-2: GOSUB CursorOff: x=0: IF y<MaxRow THEN y=y+1 ELSE BEEP
 IF ink$>CHR$(31) THEN csr=-2: GOSUB CursorOff: GOSUB ScrnPrint: IF x<MaxCol-1 THEN x=x+1 ELSE BEEP
GOTO KeyMouse

ScrnPrint:REM Set position and print graphic caracters on screen with big font Fnt1
 GRAPHIC SET POS (x*CarW!,y*CarH!): GRAPHIC PRINT ink$: GRAPHIC REDRAW
RETURN

CursorOn:REM Simple non blinking empty cursor size of caracter box
 IF y>1 AND y<=MaxRow AND csr<>0 THEN GRAPHIC BOX (x*CarW!,y*CarH!)-(x*CarW!+CarW!,y*CarH!+CarH!),0,%WHITE,csr: csr=0: GRAPHIC REDRAW
RETURN

CursorOff:REM erase cursor at end of line CR or mouse click and redraw at next position
 IF y>1 AND y<=MaxRow THEN GRAPHIC BOX (x*CarW!,y*CarH!)-(x*CarW!+CarW!,y*CarH!+CarH!),0,%BLACK,csr: GRAPHIC REDRAW
RETURN

TopHeading:REM Top box to display menu Buttons will be sized automatically by their text length   0=no button
 GRAPHIC SET FONT fnt2
 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
 GOSUB Banner: GOSUB logo: GOSUB Welcome
'Dessiner les boutons du haut
 GRAPHIC SET FONT fnt2
 GRAPHIC BOX (0, 0)-(x2-1, CarH2!*2+2),25,%WHITE,%WHITE  ' Outer box Main Menu
 GRAPHIC BOX (2, 2)-(x2-3, CarH2!*2),25,%BLACK,%YELLOW   ' Inner box Main Menu
 IF fin% THEN r=0: g=255: b=0 ELSE r=255: g=170: b=0     ' Change Buttons background color for Utility Menu
 tint=RGB(r,g,b)
 IF f0 THEN GRAPHIC BOX (x2-CarW2!*(f0+1.4), 5)-(x2-6, CarH2!*2-3),25,%BLACK,tint            ' Esc End box
 IF f1 THEN GRAPHIC BOX (CarW2!*.6, 5)-(CarW2!*(f1+1.3), CarH2!*2-3),25,%BLACK,tint          ' F1 box
 IF f2 THEN GRAPHIC BOX (CarW2!*(f1+1.7), 5)-(CarW2!*(f2+2.3), CarH2!*2-3),25,%BLACK,tint    ' F2 box
 IF f3 THEN GRAPHIC BOX (CarW2!*(f2+2.7), 5)-(CarW2!*(f3+3.3), CarH2!*2-3),25,%BLACK,tint    ' F3 box
 IF f4 THEN GRAPHIC BOX (CarW2!*(f3+3.7), 5)-(CarW2!*(f4+4.3), CarH2!*2-3),25,%BLACK,tint    ' F4 box
 IF f5 THEN GRAPHIC BOX (CarW2!*(f4+4.7), 5)-(CarW2!*(f5+5.3), CarH2!*2-3),25,%BLACK,tint    ' F5 box
 IF f6 THEN GRAPHIC BOX (CarW2!*(f5+5.7), 5)-(CarW2!*(f6+6.3), CarH2!*2-3),25,%BLACK,tint    ' F6 box
 IF f7 THEN GRAPHIC BOX (CarW2!*(f6+6.7), 5)-(CarW2!*(f7+7.3), CarH2!*2-3),25,%BLACK,tint    ' F7 box
 IF f8 THEN GRAPHIC BOX (CarW2!*(f7+7.7), 5)-(CarW2!*(f8+8.3), CarH2!*2-3),25,%BLACK,tint    ' F8 box
 IF f9 THEN GRAPHIC BOX (CarW2!*(f8+8.7), 5)-(CarW2!*(f9+9.3), CarH2!*2-3),25,%BLACK,tint    ' F9 box
'Ajouter textes dans les boutons
 IF fin% THEN GRAPHIC COLOR %BLACK,%GREEN ELSE GRAPHIC COLOR %BLACK,tint
 IF f0 THEN GRAPHIC SET POS (x2-CarW2!*(f0+1), CarH2!*.6): GRAPHIC PRINT fin$                   ' Esc End Text
 IF f1 THEN GRAPHIC SET POS (CarW2!, CarH2!*.6): GRAPHIC PRINT f1$                              ' F1 text
 IF f2 THEN GRAPHIC SET POS (CarW2!*(f1+2), CarH2!*.6): GRAPHIC PRINT f2$                       ' F2 Text
 IF f3 THEN GRAPHIC SET POS (CarW2!*(f2+3), CarH2!*.6): GRAPHIC PRINT f3$                       ' F3 Text
 IF f4 THEN GRAPHIC SET POS (CarW2!*(f3+4), CarH2!*.6): GRAPHIC PRINT f4$                       ' F4 Text
 IF f5 THEN GRAPHIC SET POS (CarW2!*(f4+5), CarH2!*.6): GRAPHIC PRINT f5$                       ' F5 Text
 IF f6 THEN GRAPHIC SET POS (CarW2!*(f5+6), CarH2!*.6): GRAPHIC PRINT f6$                       ' F6 Text
 IF f7 THEN GRAPHIC SET POS (CarW2!*(f6+7), CarH2!*.6): GRAPHIC PRINT f7$                       ' F7 Text
 IF f8 THEN GRAPHIC SET POS (CarW2!*(f7+8), CarH2!*.6): GRAPHIC PRINT f8$                       ' F8 Text
 IF f9 THEN GRAPHIC SET POS (CarW2!*(f8+9), CarH2!*.6): GRAPHIC PRINT f9$                       ' F9 Text
 GRAPHIC REDRAW
 GRAPHIC SET FONT fnt1
RETURN

BottomHeading:REM Bottom box to display mouse results with small font
 GRAPHIC SET FONT fnt2
 GRAPHIC BOX (0, y2-CarH2!*2)-(x2-2, y2),25,%WHITE,%WHITE             ' Outer box
 GRAPHIC BOX (3, y2-CarH2!*2+3)-(x2-5, y2-3),25,%BLACK,%RED           ' Inner box
 GRAPHIC COLOR noir,jaune
 GRAPHIC SET POS (CarW2!, y2-CarH2!*1.5): GRAPHIC PRINT" Resolution ="+STR$(x2)+" x"+STR$(y2)+" "
 GRAPHIC SET POS (CarW2!*29, y2-CarH2!*1.5): GRAPHIC PRINT " DeskTop ="+STR$(DskX)+" x"+STR$(DskY)+" "

 GRAPHIC SET POS (x2-CarW2!*44, y2-CarH2!*1.5): GRAPHIC PRINT " MaxRow = "+LTRIM$(STR$(maxRow+3))+"  Column = "+LTRIM$(STR$(MaxCol))+" "
 GRAPHIC SET POS (x2-CarW2!*15, y2-CarH2!*1.5): GRAPHIC PRINT" Grid =" STR$(carw!)+"x"+LTRIM$(STR$(carh!))+" "  ' Show size of caracter box
 GRAPHIC REDRAW
 GRAPHIC SET FONT fnt1
RETURN

Prompt:REM Show mouse events on Bottom Heading with small font
 GRAPHIC SET FONT fnt2: GRAPHIC COLOR noir,jaune
'Show cursor position
 GRAPHIC SET POS (55*CarW2!, y2-CarH2!*1.5): GRAPHIC PRINT" Cursor is at "+STR$(x+1)+" x"+STR$(y+1)+" "
'Show mouse over effects
 IF mo=1 THEN mo=0: GOSUB MouseOver  ' All Buttons off
 IF mo=0 AND my<CarH2!*2 AND my>CarH2!/4 AND mx>CarW2!/4 AND mx<x2-CarW2!/2 THEN
   IF mx>CarW2! AND mx<CarW2!*(f1+1) THEN mo=1: mp!=CarW2!: mo$=f1$ '              F1
   IF mx>CarW2!*(f1+2) AND mx<CarW2!*(f2+2) THEN mo=1: mp!=CarW2!*(f1+2): mo$=f2$ 'F2
   IF mx>CarW2!*(f2+3) AND mx<CarW2!*(f3+3) THEN mo=1: mp!=CarW2!*(f2+3): mo$=f3$ 'F3
   IF mx>CarW2!*(f3+4) AND mx<CarW2!*(f4+4) THEN mo=1: mp!=CarW2!*(f3+4): mo$=f4$ 'F4
   IF mx>CarW2!*(f4+5) AND mx<CarW2!*(f5+5) THEN mo=1: mp!=CarW2!*(f4+5): mo$=f5$ 'F5
   IF mx>CarW2!*(f5+6) AND mx<CarW2!*(f6+6) THEN mo=1: mp!=CarW2!*(f5+6): mo$=f6$ 'F6
   IF mx>CarW2!*(f6+7) AND mx<CarW2!*(f7+7) THEN mo=1: mp!=CarW2!*(f6+7): mo$=f7$ 'F7
   IF mx>x2-CarW2!*(f0+1) THEN mo=1: mp!=x2-CarW2!*(f0+1): mo$=fin$
   GOSUB MouseOver
 END IF
 lb=0: 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
 GRAPHIC SET FONT fnt2
 IF mo=1 THEN
   IF fin% THEN GRAPHIC COLOR %WHITE,%RED ELSE GRAPHIC COLOR %YELLOW,%RED
 END IF
 IF mo=0 THEN
   IF fin% THEN GRAPHIC COLOR %BLACK,%GREEN ELSE GRAPHIC COLOR %BLACK,orange
 END IF
 GRAPHIC SET POS (mp!,CarH2!*.6): GRAPHIC PRINT mo$
 GRAPHIC SET FONT fnt1
RETURN

Utilitaires:REM Program set up
 F1$=" F1 Spécifications ": f2$=" F2 Ouverture ": f3$=" F3 Installation ": f4$=" F4 Imprimantes ": f5$=" F5 Back-Up ": f6$=" F6 Outils ": f7$=""
 mo$="": fin$=" Esc Menu ": fin%=0: tool%=1
 GOSUB TopHeading: GOSUB ClearScrn: GOSUB readLpt: GRAPHIC SET FONT fnt1
 x5!=INT((MaxCol-60)/4)*CarW!: y5!=(INT(bry/CarH!)*CarH!)                                 ' Utility Box Start position level with logo
 x6!=x5!+40*CarW!: y6!=y5!+21*CarH!+CarH!/2                                 ' Box size
 GRAPHIC BOX (x5!, y5!+CarH!/2)-(x6!, y6!),5,%WHITE,%WHITE          ' Outer box
 GRAPHIC BOX (x5!+3, y5!+3+CarH!/2)-(x6!-4, y6!-4),5,noir,bleu      ' Inner box
 x!=(x5!/CarW!)+1: y!=(y5!/CarH!)
 GRAPHIC COLOR noir,bleu
 FOR t=1 TO 20: GRAPHIC SET POS (x!*CarW!, y5!+CarH!*t): GRAPHIC PRINT t$(t+20): NEXT
 GRAPHIC COLOR %GREEN,%BLACK
 FOR t=1 TO 20: GRAPHIC SET POS ((x!+40)*CarW!, y5!+CarH!*t): GRAPHIC PRINT t$(t): NEXT
 'x=(x5!/CarW!)+41: y=(y6!/CarH!)
 mo=0: mp!=y

 GRAPHIC SET POS ((x!+40)*carW!, y5!+CarH!)
 GRAPHIC PRINT"***"

 x=(x!+40)*CarW!: y=y5!+CarH!
 GOSUB CursorOn
RETURN

ReadLpt:REM read LPT codes
 t%=0: REDIM t$(40)
 OPEN "DotMatrix.TXT" FOR INPUT AS #1
  IF ERR>0 THEN
    OPEN "DotMatrix.TXT" FOR OUTPUT AS #1: FOR t%=1 TO 14: t$(t%)=spec$(t%): PRINT #1,t$(t%): NEXT: t%=40
  END IF
 WHILE EOF(1)=0 AND t%<40:  t%=t%+1:LINE INPUT#1,t$(t%): WEND
 CLOSE #1
RETURN

ClearScrn:REM erase screen
 GRAPHIC BOX (0, CarH!*2-2)-(x2, y2-CarH!*2),0,%BLACK,%BLACK          ' Make solid black box
RETURN

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

ProgName:REM Assign programs names to P1$ to P6$
 p1$="\mg3\menu-mg3.exe": p2$="\mg3\factumg5.exe": p3$="\mg3\geinvmgi.exe": p4$="\mg3\gesprmgc.exe": p5$="\mg3\paie-mp4.exe": p6$="\mg3\edit-mg3.exe"
'Add more code if more buttons used to load other programs
RETURN

ButtonText:REM Assign names to F1 to F10 buttons
 f1$=" F1 Accounting ": f2$=" F2 Billing ": f3$=" F3 Inventory ": F4$=" F4 Projet ": f5$=" F5 Payroll ": f6$=" F6 Text ": f7$=" F7 Tools ": fin$=" Esc Exit "
 fin%=1 ' Flag for main menu to enable end of program
'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

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

Welcome:REM Banner showing Welcome at start of program
 GRAPHIC SET FONT fnt0: txt$="Welcome to the first PowerBasic Graphic Console": GOSUB StrSize
 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,rose           ' Inner box
 GRAPHIC COLOR %WHITE,rose
 GOSUB StrSize: GRAPHIC SET POS ((x2-tw)/2, bry+br+gh*1.5): GRAPHIC PRINT txt$
 txt$=" Simply hit the (+) and (-) keys to ajust screen sizes ": GRAPHIC SET POS ((x2-tw)/2, bry+br+gh*2.5): GRAPHIC PRINT txt$
RETURN

logo:REM Print a round logo in the graphic window Center
 Author$="Guy Dombrowski Inc": Program$="MacroGestion 6.0": logoName$="MG6"
 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 WIDTH 1
RETURN

ReadCaption:REM Check Screen Resolution  (+) increase (-) decrease  pt0=Banner pt1=Main pt2=Buttons pt3=Logo
 caption$="Graphic console.  Enter text and hit Return or Click Mouse to next input position or use MouseWheel"
 x1=x0: y1=y0
AjustScreen:REM Choose resolution and font size depending on scr%
 IF scr%=0 THEN x2=800:  y2=600:  pt0=9:  pt1=10: pt2=6:  pt3=49
 IF scr%=1 THEN x2=1024: y2=768:  pt0=11: pt1=12: pt2=8:  pt3=58
 IF scr%=2 THEN x2=1152: y2=864:  pt0=12: pt1=13: pt2=9:  pt3=68
 IF scr%=3 THEN x2=1280: y2=1024: pt0=14: pt1=15: pt2=10: pt3=82
 IF scr%=4 THEN x2=1440: y2=900:  pt0=14: pt1=16: pt2=11: pt3=76
 IF scr%=5 THEN x2=1600: y2=1024: pt0=15: pt1=16: pt2=12: pt3=85
 IF scr%=6 THEN x2=1600: y2=1200: pt0=16: pt1=19: pt2=12: pt3=88
 IF scr%=7 THEN x2=1680: y2=1050: pt0=17: pt1=19: pt2=13: pt3=88
 IF scr%=8 THEN x2=1920: y2=1200: pt0=20: pt1=22: pt2=14: pt3=95
 IF scr%=9 THEN caption$="": pt0=20: pt1=22: pt2=14: pt3=95: x1=0: y1=0      ' Max resolution Full Screen permanent no TaskBar no Caption
 IF x2>DskX THEN scr%=scr%-1: caption$="": GOTO AjustScreen                  ' Max resolution Full Screen reached for lesser monitors
 IF y2>DskY-Taskbar AND scr%<9 THEN y2=DskY-TaskBar                          ' Do not hide the TaskBar
 IF caption$<>"" AND y2=DskY THEN y2=y2-CaptionH                             ' Allow for Caption Height
 IF caption$="" THEN x2=MonX: y2=MonY: x1=0: y1=0                            ' Full screen if no caption
RETURN

litspec:REM Code to read custommer data
 nom$=" Your Custommer name "
 folder$=" C:\MG6\ABC06-08 "  ' Name and location of accounting files
 period$=" Période "+RIGHT$(DATE$,7)
 titre$=" Main accounting Menu "
RETURN

END FUNCTION

Last edited by Guy Dombrowski; 14 Oct 2008, 12:21 PM. Reason: Decrease CPU usage by not drawing cursor all the time

Leave a comment:

Guy Dombrowski replied

5 Oct 2008, 07:09 PM

Evolution of the Graphic Console

Hi everybody,

Here is my new Graphical Console demo. It will scale to any screen resolution.
I rewrote a lot of code and added many new features.
Most of the additions were with the Menu handling as the keyboard was pretty much complete.
But I added F1 to F10 functions for Mouseless operation.
The windows location will now be saved and it will start where it was terminated. ( as long as your resolution is better than 1024x768 ) All preferences will also be saved there in the future...

I am trying for something new with the menu bar on top.
Instead of unrolling a top to bottom menu, I use a horizontal menu using the same bar but with differents colors and numbers of buttons.

Try the F7 Button and give me your feedback.
The End button will end the Tools Menu and return control to the Main menu so you will need to click the F10 button twice to end the program.
Of course, the Tools menu does nothing for now.

Is it something intuitive or am I on the wrong track ? A console program has to be different ????

Code:

'Evolution of my first Graphic Console program with full mouse and keyboard handling + mouse wheel
'It will remenber its screen position ( as long as your resolution is more than 1024x768 ) if you end it with the END Button and not the X to shut down Windows
'Menu added to the top bar that can be accessed By clicking buttons or with the Functions Key F1 to F10
'The buttons size and location will be ajusted automatically to the text length of F1$ to F10$ text ( See ButtonText )
'Put your program names in P1$ to P6$.  May be used to call your old modules while writing the new ones.
'Try Tools Menu F7 to see new horizontal menu presentation with different color and change function key text for your own needs
'The F10 End key will end Tools Menu the first time and the Main Program the second time.  Look at the text button.
'Sorry again about the long code lines but if you have a 24" 1920x1200 Monitor, you will understand !  ( I have 2... Ha Ha )

#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

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_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
 DIM spec$(30),scrn$(30),s$(10)
 LOCAL hGraphicWindow AS LONG
 DESKTOP GET CLIENT TO PixW,PixH             ' Find screen resolution
 x1=0: y1=0: x2=1024: y2=768                 ' Initial window 1024x768   Set X2=PixW and Y2=PixH for full screen
 x2=1280: y2=1024
 x1=PixW-x2                                  ' Position initial window top right
 drv$=LEFT$(CURDIR$,2): spec$=drv$+"specsys" ' Lire spec Drive par default

 FONT NEW "Lucida Console",12,1,0,0,0 TO fnt1  ' 12=79x36 bold font  12=85x36 regular font
 FONT NEW "Lucida console",8,1,0,0,0 TO fnt2   ' 9=51x102 bold font  9=51x114 regular font
 caption$="Graphic console input test  Enter text and hit Return or Click Mouse to next input position or use MouseWheel "
 x=0: y=2: csr=-2                              ' Start position of Empty box cursor

Setting:REM read Screen Setting
 OPEN "SetScreen.CSV" FOR INPUT AS #1: IF ERR>0 THEN ERR=0: GOTO CloseTxt       ' First time with no setup data
 REDIM s$(2): IF EOF(1)=0 THEN LINE INPUT#1,scrn$(0): PARSE scrn$(0),s$(),","   ' Read last saved position
 IF s$(0)<>"" THEN x1=VAL(s$(0)): y1=VAL(s$(1)): GRAPHIC SET LOC x1,y1          ' Set Graphic Window position
'REDIM s$(10): IF EOF(1)=0 THEN LINE INPUT#1,scrn$(1): PARSE scrn$(z),s$(),","  ' Futur code to save date for Font #1
'REDIM s$(10): IF EOF(1)=0 THEN LINE INPUT#1,scrn$(2): PARSE scrn$(z),s$(),","  ' Futur code to save data for Font #2
CloseTxt:REM end of read
 CLOSE #1

 GRAPHIC WINDOW caption$,x1,y1,x2,y2 TO hGraphicWindow                ' Start Graphic Window
 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 FONT fnt2: GRAPHIC CHR SIZE TO CarW2!,CarH2! ' Find pixel width and height of fnt2 graphic font
 GRAPHIC SET FONT fnt1: GRAPHIC CHR SIZE TO CarW!,CarH!   ' Find pixel width and height of fnt1 graphic font
 GRAPHIC CLEAR %BLACK,%GREEN: GRAPHIC COLOR %GREEN,%BLACK ' Black background with Green text like old time
 MaxCol=x2/CarW!: MaxRow=y2/CarH!-3                       ' Maximums will depend on number of pixels on desktop
 GRAPHIC WIDTH 1
 GRAPHIC REDRAW                                           ' Show screen background instantly
 GOSUB ProgName: GOSUB ButtonText                         ' Assign programs and names to buttons
 GOSUB TopHeading: GRAPHIC COLOR %GREEN,%BLACK            ' Show Top Menu
 GOSUB BottomHeading: GRAPHIC COLOR %GREEN,%BLACK

KeyMouse:REM Keyboard and Mouse input
 GRAPHIC GET DC TO hwin: IF hwin=0 THEN END                                 ' Graphic Window has been closed
 GRAPHIC GET PIXEL (x!+1,y!+1) TO bg: GRAPHIC GET PIXEL (x!+1,y!+1) TO fg   ' Store previous colors
 GRAPHIC INKEY$ TO ink$: SLEEP 1: ink%=0: GOSUB CursorOn
'Mouse section
   IF lb AND my<CarH2!*2 THEN ' Clicking the F1 to f6 buttons with mouse Left button will start new program but will not end menu like the Function keys
     GOSUB CursorOff: x=mx/CarW!-1: y=my/CarH!-1: GOSUB CursorOn
     IF mx>CarW2! AND mx<CarW2!*(f1+1) AND fin% THEN SHELL p1$                 ' F1 Program
     IF mx>CarW2!*(f1+2) AND mx<CarW2!*(f2+2) AND fin% THEN SHELL p2$          ' F2 Program
     IF mx>CarW2!*(f2+3) AND mx<CarW2!*(f3+3) AND fin% THEN SHELL p3$          ' F3 Program
     IF mx>CarW2!*(f3+4) AND mx<CarW2!*(f4+4) AND fin% THEN SHELL p4$          ' F4 Program
     IF mx>CarW2!*(f4+5) AND mx<CarW2!*(f5+5) AND fin% THEN SHELL p5$          ' F5 Program
     IF mx>CarW2!*(f5+6) AND mx<CarW2!*(f6+6) AND fin% THEN SHELL p6$          ' F6 Program
     IF mx>CarW2!*(f6+7) AND mx<CarW2!*(f7+7) AND fin% THEN GOSUB Tools        ' F7 Program inside menu
       IF mx>x2-CarW2!*(f10+1) AND mo=1 THEN
         IF fin% THEN GOSUB SavePos: fin%=0: END                      ' End button pressed in Main Menu  Program end
         IF tool% THEN GOSUB ButtonText: GOSUB TopHeading: tool%=0    ' End Button pressed in Tools menu back to main menu
       END IF
   END IF
'Show action Results
 IF lb OR rb THEN GOSUB CursorOff: x=mx/CarW!-1: y=my/CarH!-1: GOSUB CursorOn:            ' Show Cursor position when left or right button clicked
 IF wm THEN
   GOSUB CursorOff: y=y-wm: IF y<2 THEN BEEP: y=2 ELSE IF y>MaxRow THEN BEEP: y=MaxRow    ' Wheel mouse limit
   GOSUB CursorOn
 END IF
 IF lb OR rb OR mm OR wm OR mb THEN GOSUB prompt                                          ' Show mouse movements and where both button are clicked
 IF ink$="" THEN KeyMouse
'Keyboard special key section
 IF LEN(ink$)=2 THEN
   ink%=ASC(RIGHT$(ink$,1)): ink$=""
   IF ink%=59 AND fin% THEN GRAPHIC WINDOW END: SHELL p1$  ' F1 key  The F keys will terminate the menu but the buttons will not
   IF ink%=60 AND fin% THEN GRAPHIC WINDOW END: SHELL p2$  ' F2 key
   IF ink%=61 AND fin% THEN GRAPHIC WINDOW END: SHELL p3$  ' F3 key
   IF ink%=62 AND fin% THEN GRAPHIC WINDOW END: SHELL p4$  ' F4 key
   IF ink%=63 AND fin% THEN GRAPHIC WINDOW END: SHELL p5$  ' F5 key
   IF ink%=64 AND fin% THEN GRAPHIC WINDOW END: SHELL p6$  ' F6 key
   IF ink%=65 AND fin% THEN GOSUB Tools                    ' F7 Tools section with own menu
     IF ink%=68 THEN                                       ' F10 key end Tools Menu or Main Program if in Main Menu
       IF fin% THEN GOSUB SavePos: GRAPHIC WINDOW END: END
       IF tool% THEN GOSUB ButtonText: GOSUB TopHeading: tool%=0
     END IF
   IF ink%=71 THEN GOSUB CursorOff: x=0                                                   ' End
   IF ink%=72 THEN GOSUB CursorOff: IF y>2 THEN y=y-1 ELSE BEEP                           ' Up arrow
   IF ink%=75 THEN GOSUB CurSorOff: IF x>0 THEN x=x-1 ELSE BEEP                           ' Left arrow
   IF ink%=77 THEN GOSUB CurSorOff: IF x<MaxCol-1 THEN x=x+1 ELSE BEEP                    ' Right arrow
   IF ink%=80 THEN GOSUB CursorOff: IF y<MaxRow-2 THEN y=y+1 ELSE BEEP: y=MaxRow          ' Down arrow
   IF ink%=79 THEN GOSUB CursorOff: x=MaxCol-1                                            ' Home
'Keyboard scrolling section
  'Insert one space and move line right
   IF ink%=82 THEN GOSUB CursorOff: GRAPHIC COPY hGraphicWindow, 0,(x*CarW!,y*CarH!)-((MaxCol)*CarW!,y*CarH!+CarH!) TO ((x+1)*CarW!,y*CarH!): ink$=" ": GOSUB ScrnPrint
  'Delete one space and move line left
   IF ink%=83 THEN GOSUB CursorOff: GRAPHIC COPY hGraphicWindow, 0,(x*CarW!+CarW!,y*CarH!)-((MaxCol)*CarW!,y*CarH!+CarH!) TO (x*CarW!,y*CarH!): ink$=" ": x0=x: x=MaxCol-1: GOSUB ScrnPrint: x=x0
  'Scroll whole screen up
   IF ink%=73 THEN GOSUB CursorOff: GRAPHIC COPY hGraphicWindow, 0,(0,3*CarH!)-(MaxCol*CarW!,MaxRow*CarH!) TO (0,2*CarH!): ink$="": x=0: y=2: GOSUB ScrnPrint
  'Scrool whole screen down
   IF ink%=81 THEN GOSUB CursorOff: GRAPHIC COPY hGraphicWindow, 0,(0,2*CarH!)-(MaxCol*CarW!,MaxRow*CarH!) TO (0,3*CarH!): ink$=STRING$(MaxCol,32): x=0: y=2: GOSUB ScrnPrint
   GOTO KeyMouse
 END IF
'Keyboard regular key section
 IF ink$=CHR$(8) AND x>0 THEN ink$=" ": GOSUB CursorOff: x=x-1: GOSUB ScrnPrint: ink$=""
 IF ink$=CHR$(13) THEN GOSUB CursorOff: x=0: IF y<MaxRow-1 THEN y=y+1 ELSE BEEP
 IF ink$>CHR$(31) THEN GOSUB CursorOff: GOSUB ScrnPrint: IF x<MaxCol-1 THEN x=x+1 ELSE BEEP
GOTO KeyMouse

ScrnPrint:REM Set position and print graphic caracters on screen with big font Fnt1
 GRAPHIC SET POS (x*CarW!,y*CarH!): GRAPHIC PRINT ink$: GRAPHIC REDRAW
RETURN

CursorOn:REM Simple non blinking empty cursor size of caracter box
 IF y>1 AND y<=MaxRow AND csr <>0 THEN GRAPHIC BOX (x*CarW!,y*CarH!)-(x*CarW!+CarW!,y*CarH!+CarH!),0,%WHITE,csr: csr=-2: GRAPHIC REDRAW
RETURN

CursorOff:REM erase cursor at end of line CR or mouse click and redraw at next position
 IF y>1 AND y<=MaxRow THEN GRAPHIC BOX (x*CarW!,y*CarH!)-(x*CarW!+CarW!,y*CarH!+CarH!),0,%BLACK,csr: GRAPHIC REDRAW
RETURN

TopHeading:REM Top box to display menu Buttons will be sized automatically by their text length   0=no button
 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=LEN(fin$): IF f7$="" THEN f7=0
 GRAPHIC SET FONT fnt2
 GRAPHIC BOX (0, 0)-(x2-2, CarH2!*2+3),25,%WHITE,%WHITE  ' Outer box
 GRAPHIC BOX (3, 3)-(x2-5, CarH2!*2),25,%BLACK,%YELLOW   ' Inner box main Menu
 IF fin% THEN r=0: g=255: b=0 ELSE r=0: g=255: b=255     ' Change Buttons background color for Tools Menu
 tint=RGB(r,g,b)
 IF f1 THEN GRAPHIC BOX (CarW2!*.6, 6)-(CarW2!*(f1+1.4), CarH2!*2-3),25,%BLACK,tint          ' F1 box
 IF f2 THEN GRAPHIC BOX (CarW2!*(f1+1.6), 6)-(CarW2!*(f2+2.4), CarH2!*2-3),25,%BLACK,tint    ' F2 box
 IF f3 THEN GRAPHIC BOX (CarW2!*(f2+2.6), 6)-(CarW2!*(f3+3.4), CarH2!*2-3),25,%BLACK,tint    ' F3 box
 IF f4 THEN GRAPHIC BOX (CarW2!*(f3+3.6), 6)-(CarW2!*(f4+4.4), CarH2!*2-3),25,%BLACK,tint    ' F4 box
 IF f5 THEN GRAPHIC BOX (CarW2!*(f4+4.6), 6)-(CarW2!*(f5+5.4), CarH2!*2-3),25,%BLACK,tint    ' F5 box
 IF f6 THEN GRAPHIC BOX (CarW2!*(f5+5.6), 6)-(CarW2!*(f6+6.4), CarH2!*2-3),25,%BLACK,tint    ' F6 box
 IF f7 THEN GRAPHIC BOX (CarW2!*(f6+6.6), 6)-(CarW2!*(f7+7.4), CarH2!*2-3),25,%BLACK,tint    ' F7 box
 IF f8 THEN GRAPHIC BOX (CarW2!*(f7+7.6), 6)-(CarW2!*(f8+8.4), CarH2!*2-3),25,%BLACK,tint    ' F8 box
 IF f9 THEN GRAPHIC BOX (CarW2!*(f8+8.6), 6)-(CarW2!*(f9+9.4), CarH2!*2-3),25,%BLACK,tint    ' F9 box
 IF f10 THEN GRAPHIC BOX (x2-CarW2!*(f10+1.4), 6)-(x2-8, CarH2!*2-3),25,%BLACK,tint          ' F10 End box

 IF fin% THEN GRAPHIC COLOR %BLACK,%GREEN ELSE GRAPHIC COLOR %BLACK,tint
 IF f1 THEN GRAPHIC SET POS (CarW2!, CarH2!*.6): GRAPHIC PRINT f1$                              ' F1 text
 IF f2 THEN GRAPHIC SET POS (CarW2!*(f1+2), CarH2!*.6): GRAPHIC PRINT f2$                       ' F2 Text
 IF f3 THEN GRAPHIC SET POS (CarW2!*(f2+3), CarH2!*.6): GRAPHIC PRINT f3$                       ' F3 Text
 IF f4 THEN GRAPHIC SET POS (CarW2!*(f3+4), CarH2!*.6): GRAPHIC PRINT f4$                       ' F4 Text
 IF f5 THEN GRAPHIC SET POS (CarW2!*(f4+5), CarH2!*.6): GRAPHIC PRINT f5$                       ' F5 Text
 IF f6 THEN GRAPHIC SET POS (CarW2!*(f5+6), CarH2!*.6): GRAPHIC PRINT f6$                       ' F6 Text
 IF f7 THEN GRAPHIC SET POS (CarW2!*(f6+7), CarH2!*.6): GRAPHIC PRINT f7$                       ' F7 Text
 IF f8 THEN GRAPHIC SET POS (CarW2!*(f7+8), CarH2!*.6): GRAPHIC PRINT f8$                       ' F8 Text
 IF f9 THEN GRAPHIC SET POS (CarW2!*(f8+9), CarH2!*.6): GRAPHIC PRINT f9$                       ' F9 Text
 IF f10 THEN GRAPHIC SET POS (x2-CarW2!*(f10+1), CarH2!*.6): GRAPHIC PRINT fin$                 ' F10 End Text
 GRAPHIC REDRAW
 GRAPHIC SET FONT fnt1
RETURN

BottomHeading:REM Bottom box to display mouse results with small font
 GRAPHIC SET FONT fnt2
 GRAPHIC BOX (0, y2-CarH2!*2)-(x2-2, y2),25,%WHITE,%WHITE                ' Outer box
 GRAPHIC BOX (3, y2-CarH2!*2+3)-(x2-5, y2-3),25,%BLACK,%YELLOW           ' Inner box
 GRAPHIC COLOR %BLACK,%GREEN
 GRAPHIC SET POS (x2-CarW2!*37, y2-CarH2!*2+8): GRAPHIC PRINT " Row= "+LTRIM$(STR$(maxRow+3))+"  Column= "+LTRIM$(STR$(MaxCol))+" "
 GRAPHIC SET POS (x2-CarW2!*14, y2-CarH2!*2+8): GRAPHIC PRINT" Grid=" STR$(carw!)+"x"+LTRIM$(STR$(carh!))+" "  ' Show size of caracter box
 GRAPHIC REDRAW
 GRAPHIC SET FONT fnt1
RETURN

Prompt:REM Show mouse events on Bottom Heading with small font
 GRAPHIC SET FONT fnt2: GRAPHIC COLOR %BLACK,%YELLOW
 IF mm THEN GRAPHIC SET POS (CarW2!, y2-CarH2!*2+8): GRAPHIC PRINT"Mouse move"+STR$(mx)+","+LTRIM$(STR$(my))+"     "
 IF wm=1 THEN GRAPHIC SET POS (CarW2!, y2-CarH2!*2+8): GRAPHIC PRINT"Wheel mouse up          "
 IF wm=-1 THEN GRAPHIC SET POS (CarW2!, y2-CarH2!*2+8): GRAPHIC PRINT"Wheel mouse down        "
 IF lb THEN GRAPHIC SET POS (CarW2!, y2-CarH2!*2+8): GRAPHIC PRINT"Left button clicked     "
 IF mb THEN GRAPHIC SET POS (CarW2!, y2-CarH2!*2+8): GRAPHIC PRINT"Middle button clicked   "
 IF rb THEN GRAPHIC SET POS (CarW2!, y2-CarH2!*2+8): GRAPHIC PRINT"Right button clicked    "
'Show cursor position
 GRAPHIC SET POS (30*CarW2!, y2-CarH2!*2+8): GRAPHIC PRINT" Cursor is at Row";: GRAPHIC PRINT USING$("###",y+1)
'Show mouse over effects
 IF mo=1 THEN mo=0: GOSUB MouseOver  ' All Buttons off
 IF mo=0 AND my<CarH2!*2 AND my>CarH2!/4 AND mx>CarW2!/4 AND mx<x2-CarW2!/2 THEN
   IF mx>CarW2! AND mx<CarW2!*(f1+1) THEN mo=1: mp!=CarW2!: mo$=f1$ '              F1
   IF mx>CarW2!*(f1+2) AND mx<CarW2!*(f2+2) THEN mo=1: mp!=CarW2!*(f1+2): mo$=f2$ 'F2
   IF mx>CarW2!*(f2+3) AND mx<CarW2!*(f3+3) THEN mo=1: mp!=CarW2!*(f2+3): mo$=f3$ 'F3
   IF mx>CarW2!*(f3+4) AND mx<CarW2!*(f4+4) THEN mo=1: mp!=CarW2!*(f3+4): mo$=f4$ 'F4
   IF mx>CarW2!*(f4+5) AND mx<CarW2!*(f5+5) THEN mo=1: mp!=CarW2!*(f4+5): mo$=f5$ 'F5
   IF mx>CarW2!*(f5+6) AND mx<CarW2!*(f6+6) THEN mo=1: mp!=CarW2!*(f5+6): mo$=f6$ 'F6
   IF mx>CarW2!*(f6+7) AND mx<CarW2!*(f7+7) THEN mo=1: mp!=CarW2!*(f6+7): mo$=f7$ 'F7
   IF mx>x2-CarW2!*(f10+1) THEN mo=1: mp!=x2-CarW2!*(f10+1): mo$=fin$
   GOSUB MouseOver
 END IF
 lb=0: 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
 GRAPHIC SET FONT fnt2
 IF mo=1 THEN
   IF fin% THEN GRAPHIC COLOR %WHITE,%RED ELSE GRAPHIC COLOR %YELLOW,%RED
 END IF
 IF mo=0 THEN
   IF fin% THEN GRAPHIC COLOR %BLACK,%GREEN ELSE GRAPHIC COLOR %BLACK,RGB(r,g,b)
 END IF
 GRAPHIC SET POS (mp!,CarH2!*.6): GRAPHIC PRINT mo$
 GRAPHIC SET FONT fnt1
RETURN

Tools:REM Put  Tools code here
 F1$=" F1 Title ": f2$=" F2 Resolution ": f3$=" F3 Font ": f4$=" F4 Point ": f5$=" F5 Style ": f6$=" F6 Color ": f7$=""
 GRAPHIC BOX (3, 3)-(x2-5, CarH2!*2),25,%BLACK,%YELLOW                              ' Inner box
 mo$="": fin$=" F10 Menu ": fin%=0: tool%=1: GOSUB TopHeading
RETURN

SavePos:REM Save graphic window position
 OPEN "SetScreen.CSV" FOR OUTPUT AS #1: GRAPHIC GET LOC TO x0,y0
 PRINT #1,STR$(x0)+","+STR$(y0)
'Futur code to save Tools data
 CLOSE #1
RETURN

ProgName:REM Assign programs names to P1$ to P6$  May be any old or new programs
 p1$="Program1"
 p2$="Program2"
 p3$="Program3"
 p4$="Program4"
 p5$="Program5"
 p6$="Program6"
'Add more code if more buttons used to load other programs
RETURN

ButtonText:REM Assign names to F1 to F10 buttons
 f1$=" F1 Accounting "
 f2$=" F2 Billing "
 f3$=" F3 Inventory "
 F4$=" F4 Projet "
 f5$=" F5 Payroll "
 f6$=" F6 Text "
 f7$=" F7 Tools "
'Add more code if more buttons needed     Fin%=1 is flag to show that main menu is running and we can shut the program
 fin$=" F10 Exit ": fin%=1
RETURN

END FUNCTION

Last edited by Guy Dombrowski; 5 Oct 2008, 09:43 PM.

Leave a comment:

Guy Dombrowski replied

29 Sep 2008, 08:52 PM

Menu

Here is my last addition as suggested by Rick.
I have added the start of a menu system to see what was involved in writing that code.
As it can call old Dos programs, it will be very useful if you are upgrading many old modules that have to be kept running while the new code is replacing the old ones.
The menu can be operated with the functions key in a full screen mode without any mouse.
Of course, the whole thing is still somewhat rough and need a bit of work to be a finished product but I like that concept of having a graphical console.

Code:

'A small Graphic 1024x768 input screen demo with #CONSOLE OFF to test the new GRAPHIC INKEY$ and GRAPHIC SET FONT
'A small menu has been added that can be accessed with the button at the top or with the Functions Key F1 to F5
'F2 through F4 are used to start other programs with SHELL ( Even old QB45  will work .... )
'F1 and F5 need more code as they show only that they have been called.
'Full keyboard and mouse handling including the middle button and scroll wheel
'Set X2 to PixW and Y2 to PixH for full screen window or any size wanted
'The left bottom Heading will show mouse clicks, positions and wheel move up or down.
'The center will show the cursor row position change when using the mouse wheel
'The right one the number of Rows and Columns possible with the chosen font plus the caracter grid size
'Enter text and hit Return for next line or move anywhere with the arrows.
'Home and End move at line beginning and end.  PgUp and PgDn scroll whole page.
'Click anywhere on screen to position cursor with left or right button and enter text
'Move mouse over top Button for MouseOver effect and click them to start the logic
'Program will end with Esc or Exit button or closing window or F2,F3,F4 if no program to load.

#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

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_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
 LOCAL hGraphicWindow AS LONG
 DESKTOP GET CLIENT TO PixW,PixH
 x=0: y=2: x1=0: y1=0: x2=1024: y2=768       ' Set X2=PixW and Y2=PixH for full screen
' x2=1280: y2=1024
 'x2=pixw: y2=pixh
 x1=PixW-x2
 FONT NEW "Lucida Console",12,1,0,0,0 TO f1  ' 12=79x36 bold font  12=85x36 regular font
 FONT NEW "Lucida console",9,1,0,0,0 TO f2   ' 9=51x102 bold font  9=51x114 regular font
 caption$="Graphic console input test  Enter text and hit Return or Click Mouse to next input position   Esc to end"

 GRAPHIC WINDOW caption$,x1,y1,x2,y2 TO hGraphicWindow                ' Start Graphic Window
 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 FONT f2: GRAPHIC CHR SIZE TO carw2!,carh2!   ' Find pixel width and height of f2 graphic font
 GRAPHIC SET FONT f1: GRAPHIC CHR SIZE TO carw!,carh!     ' Find pixel width and height of f1 graphic font
 GRAPHIC CLEAR %BLACK,%GREEN: GRAPHIC COLOR %GREEN,%BLACK ' Black background with Green text like old time
 MaxCol=x2/CarW!: MaxRow=y2/CarH!-3                       ' Maximums will depend on number of pixels on desktop
 GRAPHIC WIDTH 1
 GRAPHIC REDRAW                                           ' Show screen background instantly
 GOSUB TopHeading: GRAPHIC COLOR %GREEN,%BLACK            ' Show mouse result
 GOSUB BottomHeading: GRAPHIC COLOR %GREEN,%BLACK
 csr=-2 ' Empty box cursor not masking caracters

KeyMouse:REM Keyboard and Mouse input
 GRAPHIC GET DC TO hwin: IF hwin=0 THEN END                                                  ' Window has been closed by mouse
 GRAPHIC GET PIXEL (x!+1,y!+1) TO bg: GRAPHIC GET PIXEL (x!+1,y!+1) TO fg                    ' Store previous colors
 GRAPHIC INKEY$ TO ink$: SLEEP 1: ink%=0: GOSUB CursorOn                                     ' Place cursor at next input
'Mouse section
   IF lb THEN ' Left button click showing menus
     GOSUB CursorOff: x=mx/CarW!-1: y=my/CarH!-1: GOSUB CursorOn                             ' Left Button
     IF mx>CarW2! AND mx<CarW2!*18 AND my<CarH2!*2 THEN GOSUB Instruction                    ' Start Instruction Menu
     IF mx>CarW2!*20 AND mx<CarW2!*35 AND my<CarH2!*2 THEN GRAPHIC WINDOW END: SHELL f2$     ' Put Accounting program name in f2$
     IF mx>CarW2!*37 AND mx<CarW2!*51 AND my<CarH2!*2 THEN GRAPHIC WINDOW END: SHELL f3$     ' Put Inventory program name in f3$
     IF mx>CarW2!*53 AND mx<CarW2!*65 AND my<CarH2!*2 THEN GRAPHIC WINDOW END: SHELL f4$     ' Put Payroll program name in f4$
     IF mx>CarW2!*67 AND mx<CarW2!*77 AND my<CarH2!*2 THEN GOSUB Tools                       ' Start Tools menu
     IF mx>x2-CarW2!*7 AND my<CarH2!*2 AND mo=1 THEN END                                     ' Exit pressed
   END IF
 IF rb THEN GOSUB CursorOff: x=mx/CarW!-1: y=my/CarH!-1: GOSUB CursorOn:                     ' Right Button
 IF wm THEN
   GOSUB CursorOff: y=y-wm: IF y<2 THEN BEEP: y=2 ELSE IF y>MaxRow THEN BEEP: y=MaxRow       ' Wheel mouse limit
   GOSUB CursorOn
 END IF
 IF lb OR rb OR mm OR wm OR mb THEN GOSUB prompt                                             ' Show mouse movements and where both button are clicked
 IF ink$="" THEN KeyMouse
'Keyboard special key section
 IF LEN(ink$)=2 THEN
   ink%=ASC(RIGHT$(ink$,1)): ink$=""
   IF ink%=59 THEN GOSUB Instruction                                                      ' F1 key
   IF ink%=60 THEN GRAPHIC WINDOW END: SHELL f2$                                          ' F2 key
   IF ink%=61 THEN GRAPHIC WINDOW END: SHELL f3$                                          ' F3 key
   IF ink%=62 THEN GRAPHIC WINDOW END: SHELL f4$                                          ' F4 key
   IF ink%=71 THEN GOSUB CursorOff: x=0                                                   ' End
   IF ink%=72 THEN GOSUB CursorOff: IF y>2 THEN y=y-1 ELSE BEEP                           ' Up arrow
   IF ink%=75 THEN GOSUB CurSorOff: IF x>0 THEN x=x-1 ELSE BEEP                           ' Left arrow
   IF ink%=77 THEN GOSUB CurSorOff: IF x<MaxCol-1 THEN x=x+1 ELSE BEEP                    ' Right arrow
   IF ink%=80 THEN GOSUB CursorOff: IF y<MaxRow-2 THEN y=y+1 ELSE BEEP: y=MaxRow          ' Down arrow
   IF ink%=79 THEN GOSUB CursorOff: x=MaxCol-1                                            ' Home
'Keyboard scrolling section
  'Insert one space and move line right
   IF ink%=82 THEN GOSUB CursorOff: GRAPHIC COPY hGraphicWindow, 0,(x*CarW!,y*CarH!)-((MaxCol)*CarW!,y*CarH!+CarH!) TO ((x+1)*CarW!,y*CarH!): ink$=" ": GOSUB ScrnPrint
  'Delete one space and move line left
   IF ink%=83 THEN GOSUB CursorOff: GRAPHIC COPY hGraphicWindow, 0,(x*CarW!+CarW!,y*CarH!)-((MaxCol)*CarW!,y*CarH!+CarH!) TO (x*CarW!,y*CarH!): ink$=" ": x0=x: x=MaxCol-1: GOSUB ScrnPrint: x=x0
  'Scroll whole screen up
   IF ink%=73 THEN GOSUB CursorOff: GRAPHIC COPY hGraphicWindow, 0,(0,3*CarH!)-(MaxCol*CarW!,MaxRow*CarH!) TO (0,2*CarH!): ink$="": x=0: y=2: GOSUB ScrnPrint
  'Scrool whole screen down
   IF ink%=81 THEN GOSUB CursorOff: GRAPHIC COPY hGraphicWindow, 0,(0,2*CarH!)-(MaxCol*CarW!,MaxRow*CarH!) TO (0,3*CarH!): ink$=STRING$(MaxCol,32): x=0: y=2: GOSUB ScrnPrint
   GOTO KeyMouse
 END IF
'Keyboard regular key section
 IF ink$=CHR$(27) THEN END
 IF ink$=CHR$(8) AND x>0 THEN ink$=" ": GOSUB CursorOff: x=x-1: GOSUB ScrnPrint: ink$=""
 IF ink$=CHR$(13) THEN GOSUB CursorOff: x=0: IF y<MaxRow-1 THEN y=y+1 ELSE BEEP
 IF ink$>CHR$(31) THEN GOSUB CursorOff: GOSUB ScrnPrint: IF x<MaxCol-1 THEN x=x+1 ELSE BEEP
GOTO KeyMouse

ScrnPrint:REM Set position and print graphic caracters on screen winh big font F1
 GRAPHIC SET POS (x*CarW!,y*CarH!): GRAPHIC PRINT ink$: GRAPHIC REDRAW
RETURN

CursorOn:REM Simple non blinking empty cursor size of caracter box
 IF y>1 AND y<=MaxRow AND csr <>0 THEN GRAPHIC BOX (x*CarW!,y*CarH!)-(x*CarW!+CarW!,y*CarH!+CarH!),0,%WHITE,csr: csr=-2: GRAPHIC REDRAW
RETURN

CursorOff:REM erase cursor at end of line CR or mouse click and redraw at next position
 IF y>1 AND y<=MaxRow THEN GRAPHIC BOX (x*CarW!,y*CarH!)-(x*CarW!+CarW!,y*CarH!+CarH!),0,%BLACK,csr: GRAPHIC REDRAW
RETURN

TopHeading:REM Top box to display menu
 GRAPHIC SET FONT f2
 GRAPHIC BOX (0, y1)-(x2-2, CarH2!*2+3),25,%WHITE,%WHITE                     ' Outer box
 GRAPHIC BOX (3, y1+3)-(x2-5, CarH2!*2),25,%BLACK,%YELLOW                    ' Inner box
 GRAPHIC BOX (CarW2!*.6, y1+6)-(CarW2!*18.5, CarH2!*2-3),25,%BLACK,%GREEN    ' Instructions box
 GRAPHIC BOX (CarW2!*19.6, y1+6)-(CarW2!*35.5, CarH2!*2-3),25,%BLACK,%GREEN  ' Accounting box
 GRAPHIC BOX (CarW2!*36.6, y1+6)-(CarW2!*51.5, CarH2!*2-3),25,%BLACK,%GREEN  ' Inventory box
 GRAPHIC BOX (CarW2!*52.6, y1+6)-(CarW2!*65.5, CarH2!*2-3),25,%BLACK,%GREEN  ' Payroll box
 GRAPHIC BOX (CarW2!*66.6, y1+6)-(CarW2!*77.5, CarH2!*2-3),25,%BLACK,%GREEN  ' Tool box
 GRAPHIC BOX (x2-CarW2!*7.3, y1+6)-(x2-8, CarH2!*2-3),25,%BLACK,%GREEN       ' Exit box
 GRAPHIC COLOR %BLACK,%GREEN
 GRAPHIC SET POS (CarW2!, CarH2!*.6): GRAPHIC PRINT " F1 Instructions "
 GRAPHIC SET POS (CarW2!*20, CarH2!*.6): GRAPHIC PRINT " F2 Accounting "
 GRAPHIC SET POS (CarW2!*37, CarH2!*.6): GRAPHIC PRINT " F3 Inventory "
 GRAPHIC SET POS (CarW2!*53, CarH2!*.6): GRAPHIC PRINT " F4 Payroll "
 GRAPHIC SET POS (CarW2!*67, CarH2!*.6): GRAPHIC PRINT " F5 Tools "
 GRAPHIC SET POS (x2-CarW2!*7, CarH2!*.6): GRAPHIC PRINT " Exit "
 GRAPHIC REDRAW
 GRAPHIC SET FONT f1
RETURN

BottomHeading:REM Bottom box to display mouse results with small font
 GRAPHIC SET FONT f2
 GRAPHIC BOX (0, y2-CarH2!*2)-(x2-2, y2),25,%WHITE,%WHITE                ' Outer box
 GRAPHIC BOX (3, y2-CarH2!*2+3)-(x2-5, y2-3),25,%BLACK,%YELLOW           ' Inner box
' GRAPHIC BOX (x2-CarW!*6+5, y2-CarH2!*2+6)-(x2-8, y2-6),25,%BLACK,%GREEN ' Exit box
 GRAPHIC COLOR %BLACK,%GREEN
 GRAPHIC SET POS (x2-CarW2!*37, y2-CarH2!*2+8): GRAPHIC PRINT " Row= "+LTRIM$(STR$(maxRow+3))+"  Column= "+LTRIM$(STR$(MaxCol))+" "
' GRAPHIC SET POS (x2-CarW2!*7, y2-CarH2!*2+8): GRAPHIC PRINT" Exit "
 GRAPHIC SET POS (x2-CarW2!*14, y2-CarH2!*2+8): GRAPHIC PRINT" Grid=" STR$(carw!)+"x"+LTRIM$(STR$(carh!))+" "  ' Show size of caracter box
 GRAPHIC REDRAW
 GRAPHIC SET FONT f1
RETURN

Prompt:REM Show mouse events on Bottom Heading with small font
 GRAPHIC SET FONT f2: GRAPHIC COLOR %BLACK,%YELLOW
 IF mm THEN GRAPHIC SET POS (CarW2!, y2-CarH2!*2+8): GRAPHIC PRINT"Mouse move"+STR$(mx)+","+LTRIM$(STR$(my))+"     "
 IF wm=1 THEN GRAPHIC SET POS (CarW2!, y2-CarH2!*2+8): GRAPHIC PRINT"Wheel mouse up          "
 IF wm=-1 THEN GRAPHIC SET POS (CarW2!, y2-CarH2!*2+8): GRAPHIC PRINT"Wheel mouse down        "
 IF lb THEN GRAPHIC SET POS (CarW2!, y2-CarH2!*2+8): GRAPHIC PRINT"Left button clicked     "
 IF mb THEN GRAPHIC SET POS (CarW2!, y2-CarH2!*2+8): GRAPHIC PRINT"Middle button clicked   "
 IF rb THEN GRAPHIC SET POS (CarW2!, y2-CarH2!*2+8): GRAPHIC PRINT"Right button clicked    "
'Show cursor position
 GRAPHIC SET POS (30*CarW2!, y2-CarH2!*2+8): GRAPHIC PRINT" Cursor is at Row";: GRAPHIC PRINT USING$("###",y+1)
'Show mouse over effects
 IF mo=1 THEN mo=0: GOSUB MouseOver  ' All Buttons off
 IF mo=0 AND my<CarH2!*2 THEN
   f1=0: IF mx>CarW2! AND mx<CarW2!*18 THEN mo=1: mp!=CarW2!: mo$=" F1 Instructions "
   IF mx>CarW2!*20 AND mx<CarW2!*35 THEN mo=1: mp!=CarW2!*20: mo$=" F2 Accounting "
   IF mx>CarW2!*37 AND mx<CarW2!*51 THEN mo=1: mp!=CarW2!*37: mo$=" F3 Inventory "
   IF mx>CarW2!*53 AND mx<CarW2!*65 THEN mo=1: mp!=CarW2!*53: mo$=" F4 Payroll "
   IF mx>CarW2!*67 AND mx<CarW2!*77 THEN mo=1: mp!=CarW2!*67: mo$=" F4 Tools "
   IF mx>x2-CarW2!*7 THEN mo=1: mp!=x2-CarW2!*7: mo$=" Exit "
   GOSUB MouseOver
 END IF
 lb=0: rb=0: mm=0: mb=0: wm=0:  GRAPHIC REDRAW: GRAPHIC COLOR %GREEN,%BLACK: GRAPHIC SET FONT f1
RETURN

MouseOver:REM Show Mouse Over event with small font
 GRAPHIC SET FONT f2: IF mo=1 THEN GRAPHIC COLOR %WHITE,%RED ELSE GRAPHIC COLOR %BLACK,%GREEN
 GRAPHIC SET POS (mp!,CarH2!*.6): GRAPHIC PRINT mo$
 GRAPHIC SET FONT f1
RETURN

Instruction:REM Put Instruction Menu code here
 GRAPHIC SET FONT f2
 GRAPHIC SET POS (CarW2!, y2-CarH2!*2+8): GRAPHIC PRINT" Instruction Menu "
 GRAPHIC SET FONT f1
RETURN

Tools:REM Put  Tools code here
 GRAPHIC SET FONT f2
 GRAPHIC SET POS (CarW2!, y2-CarH2!*2+8): GRAPHIC PRINT" Tools Menu       "
 GRAPHIC SET FONT f1
RETURN

END FUNCTION

Announcement

Leave a comment:

Leave a comment:

Leave a comment:

Leave a comment:

Leave a comment:

Leave a comment:

Leave a comment:

Leave a comment:

Leave a comment:

Leave a comment:

Leave a comment:

Leave a comment:

Leave a comment:

Leave a comment:

Leave a comment:

Leave a comment:

Leave a comment:

Leave a comment:

Leave a comment:

Leave a comment: