Home Page

R. T. RUSSELL

BBC BASIC for Windows

On Screen Keyboard



This program creates an On Screen Keyboard with which you can provide 'keyboard' input using the mouse. As it stands it is of limited practical usefulness, but the code could be enhanced and customised to provide additional facilities such as supporting cursor and function keys. UK and US layouts are provided as standard, but other layouts could easily be added.

Download OSKBBC.BBC Run OSKBBC.EXE

     REM On Screen Keyboard written in BBC BASIC for Windows
     REM (C) Richard T. Russell, http://www.rtrussell.co.uk/
     REM!Window 750,250,client,xpstyle,hidden

     
Version$ = "1.30"

     REM Ensure an error message is visible even if window is hidden:
     
ON ERROR SYS "MessageBox", @hwnd%, REPORT$, 0, 0 : QUIT

     
REM Install required libraries:
     
INSTALL @lib$+"WINLIB2A"
     INSTALL @lib$+"WINLIB5"

     REM!WC Windows Constants (automatically inserted by WinConsts utility):
     
BM_SETSTATE = &F3
     BS_DEFPUSHBUTTON = &1
     BS_MULTILINE = &2000
     CF_INITTOLOGFONTSTRUCT = &40
     CF_SCREENFONTS = &1
     CSIDL_APPDATA = &1A
     ES_NUMBER = &2000
     GWL_EXSTYLE = -20
     GWL_STYLE = -16
     HWND_NOTOPMOST = -2
     HWND_TOPMOST = -1
     IDCANCEL = 2
     IDOK = 1
     MB_ICONINFORMATION = &40
     MF_CHECKED = &8
     MF_POPUP = &10
     MF_UNCHECKED = &0
     SWP_NOMOVE = &2
     SWP_NOSIZE = &1
     SWP_NOZORDER = &4
     SW_SHOW = 5
     WM_SETFONT = &30
     WS_DISABLED = &8000000
     WS_EX_NOACTIVATE = &8000000
     WS_GROUP = &20000
     WS_MAXIMIZEBOX = &10000
     WS_THICKFRAME = &40000

     REM Disable the Escape key:
     
*ESC OFF

     REM Declare the required global structures and arrays:
     
DIM size{cx%,cy%}, rect{l%,t%,r%,b%}
     DIM lf{Height%, Width%, Escapement%, Orientation%, \
     
\      Weight%, Italic&, Underline&, StrikeOut&, \
     
\      CharSet&, OutPrecision&, ClipPrecision&, \
     
\      Quality&, PitchAndFamily&, FaceName&(30)}
     DIM ch$(4,13), w(4,13), h(4,13), hw%(4,13)

     REM Set the default font:
     
lf.FaceName&() = "Arial"
     lf.Height% = 26
     lf.Weight% = 600

     REM Read the settings:
     
IniFile$ = FNspecialfolder(CSIDL_APPDATA)+"oskbbc.ini"
     SYS "GetPrivateProfileInt", "settings", "ontop", 1, IniFile$ TO AlwaysOnTop%
     SYS "GetPrivateProfileInt", "settings", "delay", 50, IniFile$ TO AutoRepeatDelay%
     SYS "GetPrivateProfileInt", "settings", "speed", 10, IniFile$ TO AutoRepeatSpeed%
     SYS "GetPrivateProfileInt", "keyboard", "layout", 0, IniFile$ TO Layout%
     SYS "GetPrivateProfileStruct", "settings", "font", lf{}, DIM(lf{}), IniFile$

     REM Create the fonts and determine the key size:
     
SYS "CreateFontIndirect", lf{} TO hFontLarge%
     height% = lf.Height%
     lf.Height% *= 3/4
     SYS "CreateFontIndirect", lf{} TO hFontSmall%
     lf.Height% = height%
     SYS "SelectObject", @memhdc%, hFontLarge% TO oldfont%
     SYS "DeleteObject", oldfont%
     SYS "GetTextExtentPoint32", @memhdc%, "X", 1, size{}
     KeySize% = size.cy% * 2

     REM Create the menus:
     
SYS "CreatePopupMenu" TO hFile%
     SYS "AppendMenu", hFile%, 0, 11, "E&xit"

     SYS "CreatePopupMenu" TO hLayout%
     SYS "AppendMenu", hLayout%, 0, 20, "U&K"
     SYS "AppendMenu", hLayout%, 0, 21, "U&S"

     SYS "CreatePopupMenu" TO hSettings%
     SYS "AppendMenu", hSettings%, 0, 30, "&Always on top"
     SYS "AppendMenu", hSettings%, 0, 31, "&Typematic..."
     SYS "AppendMenu", hSettings%, 0, 32, "&Font and size..."

     SYS "CreatePopupMenu" TO hHelp%
     SYS "AppendMenu", hHelp%, 0, 41, "&About On Screen Keyboard..."

     SYS "CreateMenu" TO hMenu%
     SYS "AppendMenu", hMenu%, MF_POPUP, hFile%, "&File"
     SYS "AppendMenu", hMenu%, MF_POPUP, hLayout%, "&Layout"
     SYS "AppendMenu", hMenu%, MF_POPUP, hSettings%, "&Settings"
     SYS "AppendMenu", hMenu%, MF_POPUP, hHelp%, "&Help"
     SYS "SetMenu", @hwnd%, hMenu%
     SYS "DrawMenuBar", @hwnd%

     SYS "CheckMenuItem", hLayout%, 20+Layout%, MF_CHECKED

     REM Handle click events:
     
Click% = 0
     ON SYS Click% = @wparam% : RETURN

     
REM Set the window title:
     
SYS "SetWindowText", @hwnd%, "On Screen Keyboard - " + \
     
\   "Left Click: lowercase, Right Click: uppercase, Middle Click: control code"

     REM Inactivate the window (we don't want keyboard input to come here!):
     
SYS "GetWindowLong", @hwnd%, GWL_EXSTYLE TO exstyle%
     SYS "SetWindowLong", @hwnd%, GWL_EXSTYLE, exstyle% OR WS_EX_NOACTIVATE

     REM Disable resizing or maximizing:
     
SYS "GetWindowLong", @hwnd%, GWL_STYLE TO style%
     style% AND= NOT (WS_MAXIMIZEBOX OR WS_THICKFRAME)
     SYS "SetWindowLong", @hwnd%, GWL_STYLE, style%

     REM Initialise the window to the required size:
     
rect.r% = 15*KeySize%
     rect.b% = 5*KeySize%
     SYS "AdjustWindowRect", rect{}, style%, 1
     SYS "SetWindowPos", @hwnd%, 0,0,0, rect.r%-rect.l%, rect.b%-rect.t%, \
     
\                   SWP_NOMOVE OR SWP_NOZORDER

     REM Display the window and set it topmost if requested:
     
SYS "ShowWindow", @hwnd%, SW_SHOW
     IF AlwaysOnTop% THEN
       SYS
"SetWindowPos", @hwnd%, HWND_TOPMOST, 0, 0, 0, 0, \
       
\                                   SWP_NOMOVE OR SWP_NOSIZE
       SYS "CheckMenuItem", hSettings%, 30, MF_CHECKED
     ENDIF

     
REM Set background colour:
     
COLOUR 128+12
     VDU 26
     CLS

     
REM Create the template for the Typematic dialogue box:
     
Tdlg% = FN_newdialog("Typematic settings", 64, 51, 146, 60, 8, 500)
     PROC_pushbutton(Tdlg%, "OK", IDOK, 9, 40, 56, 14, WS_GROUP OR BS_DEFPUSHBUTTON)
     PROC_pushbutton(Tdlg%, "Cancel", IDCANCEL, 80, 40, 56, 14, WS_GROUP)
     PROC_static(Tdlg%, "Repeat delay (milliseconds):", 100, 10, 7, 96, 16, 0)
     PROC_static(Tdlg%, "Repeat rate (chars/second):", 101, 10, 24, 96, 16, 0)
     PROC_editbox(Tdlg%, "", 102, 106, 5, 29, 12, ES_NUMBER)
     PROC_editbox(Tdlg%, "", 103, 106, 22, 29, 12, ES_NUMBER)

     REM Set required keyboard layout:
     
CASE Layout% OF
       WHEN
0: REM UK
         
ch$() = "¬`","!1","""2","£3","$4","%5","^6","&7","*8","(9",")0","_-","+=","Backspace", \
         
\       "Tab","Q","W","E","R","T","Y","U","I","O","P","{[","}]","Enter", \
         
\       "Caps","A","S","D","F","G","H","J","K","L",":;","@'","~#","", \
         
\       "Shift","|\","Z","X","C","V","B","N","M","<,",">.","?/","Shift","", \
         
\       "Control","Alt","Space","Alt Gr","Control"
         REM relative widths:
         
w() = 1,1,1,1,1,1,1,1,1,1,1,1,1,2.0, \
         
\   1.5,1,1,1,1,1,1,1,1,1,1,1.15,1.15,1.2, \
         
\   1.8,1,1,1,1,1,1,1,1,1,1,1,1,1.0, \
         
\   1.3,1,1,1,1,1,1,1,1,1,1,1,2.7,0, \
         
\   2.0,2.0,7.0,2.0,2.0
         REM relative heights:
         
h() = 1 : h(1,13) = 2
       WHEN 1: REM US
         
ch$() = "~`","!1","@2","#3","$4","%5","^6","&7","*8","(9",")0","_-","+=","Backspace", \
         
\       "Tab","Q","W","E","R","T","Y","U","I","O","P","{[","}]","|\", \
         
\       "Caps","A","S","D","F","G","H","J","K","L",":;","""'","Enter", "", \
         
\       "Shift","","Z","X","C","V","B","N","M","<,",">.","?/","Shift","", \
         
\       "Control","Alt","Space","Alt Gr","Control"
         REM relative widths:
         
w() = 1,1,1,1,1,1,1,1,1,1,1,1,1,2.0, \
         
\   1.5,1,1,1,1,1,1,1,1,1,1,1.15,1.15,1.2, \
         
\   1.8,1,1,1,1,1,1,1,1,1,1,1,2.2,0, \
         
\   2.3,0,1,1,1,1,1,1,1,1,1,1,2.7,0, \
         
\   2.0,2.0,7.0,2.0,2.0
         REM relative heights:
         
h() = 1
     ENDCASE

     
REM Draw the 'keyboard':
     
Y = 0
     FOR R% = 0 TO DIM(ch$(),1)
       X = 0
       FOR C% = 0 TO DIM(ch$(),2)
         ch$ = ch$(R%,C%)
         IF ch$ <> "" THEN
           IF LEN
(ch$) = 2 ch$ = LEFT$(ch$) + CHR$(13) + RIGHT$(ch$)
           IF LEFT$(ch$,1) = "&" ch$ = "&" + ch$ : REM 'escape' the & symbol
           
style% = BS_MULTILINE
           CASE ch$ OF
             WHEN
"Shift","Control","Alt","Caps", "Alt Gr": style% OR= WS_DISABLED
           ENDCASE
           
hw%(R%,C%) = FN_button(ch$, X, Y, KeySize%*w(R%,C%), KeySize%*h(R%,C%), \
           
\                      0, style%)
           IF LEN(ch$) = 1 THEN
             SYS
"SendMessage", hw%(R%,C%), WM_SETFONT, hFontLarge%, 1
           ELSE
             SYS
"SendMessage", hw%(R%,C%), WM_SETFONT, hFontSmall%, 1
           ENDIF
         ENDIF
         
X += KeySize% * w(R%,C%)
       NEXT C%
       Y += KeySize%
     NEXT R%

     REM Main loop:
     
Restart% = FALSE
     
timeout% = AutoRepeatDelay%
     REPEAT
       WAIT
0

       REM Check for mouse clicks:
       
MOUSE X%,Y%,B%
       IF B% THEN
         PROC
click(B%,timeout%)
         timeout% = AutoRepeatSpeed%
       ELSE
         
timeout% = AutoRepeatDelay%
       ENDIF

       
REM Deactivate window if mouse over keyboard region:
       
IF X% > 0 IF (X%/2) < @vdu.tr% IF Y% > 0 IF (Y%/2) < @vdu.tb% THEN
         SYS
"GetWindowLong", @hwnd%, GWL_EXSTYLE TO exstyle%
         IF (exstyle% AND WS_EX_NOACTIVATE) = 0 THEN
           SYS
"SetWindowLong", @hwnd%, GWL_EXSTYLE, exstyle% OR WS_EX_NOACTIVATE
           SYS "ShowWindow", @hwnd%, SW_SHOW
         ENDIF
       ENDIF

       
REM Process menu selections:
       
click% = 0
       SWAP click%,Click%
       CASE click% OF
         WHEN
11: QUIT
         WHEN
20,21,22,23: PROClayout(click%)
         WHEN 30: PROContop
         WHEN 31: PROCtypematic
         WHEN 32: PROCchoosefont
         WHEN 41: PROCabout
       ENDCASE

       
REM Restart if necessary:
       
IF Restart% THEN PROCcleanup : RUN
     UNTIL FALSE
     END

     
REM Process mouse clicks:
     
DEF PROCclick(B%,T%)
     LOCAL pt{},C%,R%,X%,Y%,hw%,exstyle%,ch$
     PRIVATE oldhw%
     DIM pt{x%,y%}

     TIME = 0
     REM Find position of mouse, in Windows coordinates:
     
SYS "GetCursorPos", pt{}
     REM Find which window (if any) the mouse is over:
     
SYS "WindowFromPoint", pt.x%, pt.y% TO hw%
     REM If different key from last time, 'unpress' the old one:
     
IF oldhw% IF hw% <> oldhw% SYS "SendMessage", oldhw%, BM_SETSTATE, 0, 0
     REM Activate window if clicked on title or menu bar:
     
IF hw% = @hwnd% THEN
       SYS
"GetWindowLong", @hwnd%, GWL_EXSTYLE TO exstyle%
       SYS "SetWindowLong", @hwnd%, GWL_EXSTYLE, exstyle% AND NOT WS_EX_NOACTIVATE
       SYS "SetForegroundWindow", @hwnd%
     ENDIF

     
REM Check whether the user clicked one of our 'keys':
     
FOR R% = 0 TO DIM(hw%(),1)
       FOR C% = 0 TO DIM(hw%(),2)
         IF hw% = hw%(R%,C%) THEN
           SYS
"SendMessage", hw%, BM_SETSTATE, 1, 0

           ch$ = ch$(R%,C%)
           IF LEN(ch$) = 1 THEN
             
ch$ += CHR$(ASC(ch$)+32) : REM Add lower-case character
           
ENDIF
           CASE
ch$ OF
             WHEN
"Space":     ch$ = " "
             WHEN "Backspace": ch$ = CHR$(8)
             WHEN "Tab":       ch$ = CHR$(9)
             WHEN "Enter":     ch$ = CHR$(13)
           ENDCASE

           IF
B% AND 4 PROCfake(ASC(RIGHT$(ch$))) : REM Left click = 'normal'
           
IF B% AND 1 PROCfake(ASC(ch$))         : REM Right click = 'shift'
           
IF B% AND 2 PROCfake(ASC(ch$) AND 31)  : REM Middle click = "ctrl'

           REM Wait for mouse button to be released, or auto-repeat timeout:
           
REPEAT
             WAIT
0
             MOUSE X%,Y%,B%
           UNTIL B% = 0 OR TIME > T%
           IF B% = 0 SYS "SendMessage", hw%, BM_SETSTATE, 0, 0 : REM 'unpress' key
           
oldhw% = hw%
           ENDPROC
         ENDIF
       NEXT
     NEXT
R%
     oldhw% = 0
     ENDPROC

     
REM Change typematic settings:
     
DEF PROCtypematic
     LOCAL click%,temp%

     PROC_showdialog(Tdlg%)
     SYS "SetDlgItemInt", !Tdlg%, 102, 10*AutoRepeatDelay%
     SYS "SetDlgItemInt", !Tdlg%, 103, 100/AutoRepeatSpeed%

     REPEAT
       WAIT
1
       click% = 0
       SWAP click%,Click%
     UNTIL click% = IDOK OR click% = IDCANCEL OR !Tdlg% = 0

     IF click% = 1 THEN
       SYS
"GetDlgItemInt", !Tdlg%, 102 TO temp%
       AutoRepeatDelay% = temp%/10
       SYS "GetDlgItemInt", !Tdlg%, 103 TO temp%
       AutoRepeatSpeed% = 100/temp%
       SYS "WritePrivateProfileString", "settings", "delay", STR$(AutoRepeatDelay%), IniFile$
       SYS "WritePrivateProfileString", "settings", "speed", STR$(AutoRepeatSpeed%), IniFile$
     ENDIF
     PROC
_closedialog(Tdlg%)
     ENDPROC

     
REM Set font:
     
DEF PROCchoosefont
     LOCAL cf{}, result%
     DIM cf{lStructSize%, hwndOwner%, hdc%, lpLogFont%, \
     
\      iPointSize%, flags%, rgbColors%, lCustData%, \
     
\      lpfnHook%, lpTemplateName%, hInstance%, lpszStyle%, \
     
\      nFontType{l&,h&}, pad{l&,h&}, nSizeMin%, nSizeMax%}
     cf.lStructSize% = DIM(cf{})
     cf.hwndOwner% = @hwnd%
     cf.lpLogFont% = lf{}
     cf.flags% = CF_SCREENFONTS OR CF_INITTOLOGFONTSTRUCT
     SYS "ChooseFont", cf{} TO result%
     IF result% THEN
       SYS
"WritePrivateProfileStruct", "settings", "font", lf{}, DIM(lf{}), IniFile$
       Restart% = TRUE
     ENDIF
     ENDPROC

     
REM Toggle 'always on top' setting:
     
DEF PROContop
     AlwaysOnTop% = -(AlwaysOnTop% == 0)
     IF AlwaysOnTop% THEN
       SYS
"SetWindowPos", @hwnd%, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE OR SWP_NOSIZE
       SYS "CheckMenuItem", hSettings%, 30, MF_CHECKED
     ELSE
       SYS
"SetWindowPos", @hwnd%, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE OR SWP_NOSIZE
       SYS "CheckMenuItem", hSettings%, 30, MF_UNCHECKED
     ENDIF
     SYS
"WritePrivateProfileString", "settings", "ontop", STR$(AlwaysOnTop%), IniFile$
     ENDPROC

     
REM Set keyboard layout:
     
DEF PROClayout(id%)
     SYS "CheckMenuItem", hLayout%, 20+Layout%, MF_UNCHECKED
     Layout% = id%-20
     SYS "CheckMenuItem", hLayout%, 20+Layout%, MF_CHECKED
     SYS "WritePrivateProfileString", "keyboard", "layout", STR$(Layout%), IniFile$
     Restart% = TRUE
     ENDPROC

     
REM About box:
     
DEF PROCabout
     SYS "MessageBox", @hwnd%, "On Screen Keyboard version " + Version$ + CHR$13 + \
     
\   "written in BBC BASIC for Windows" + CHR$13 +  \
     
\   "by Richard Russell, October 2010" + CHR$13 + \
     
\   "see http://www.rtrussell.co.uk/", "OSKBBC", MB_ICONINFORMATION
     ENDPROC

     
REM Delete GDI and User objects:
     
DEF PROCcleanup
     ON SYS OFF
     FOR
R% = 0 TO DIM(hw%(),1)
       FOR C% = 0 TO DIM(hw%(),2)
         IF hw%(R%,C%) PROC_closewindow(hw%(R%,C%))
       NEXT
     NEXT
R%
     SYS "DeleteObject", hFontLarge%
     SYS "DeleteObject", hFontSmall%
     SYS "DestroyMenu", hMenu%
     SYS "DestroyMenu", hFile%
     SYS "DestroyMenu", hLayout%
     SYS "DestroyMenu", hSettings%
     SYS "DestroyMenu", hHelp%
     ENDPROC

     
REM From http://bb4w.wikispaces.com/Faking+keyboard+input
     
DEF PROCfake(C%) : LOCAL V%
     SYS "VkKeyScan", C% TO V%
     IF V% AND &100 SYS "keybd_event", 16, 0, 0, 0
     IF V% AND &200 SYS "keybd_event", 17, 0, 0, 0
     IF V% AND &400 SYS "keybd_event", 18, 0, 0, 0
     SYS "keybd_event", V% AND &FF, 0, 0, 0
     SYS "keybd_event", V% AND &FF, 0, 2, 0
     IF V% AND &400 SYS "keybd_event", 18, 0, 2, 0
     IF V% AND &200 SYS "keybd_event", 17, 0, 2, 0
     IF V% AND &100 SYS "keybd_event", 16, 0, 2, 0
     ENDPROC

     
REM From http://www.bbcbasic.co.uk/bbcwin/manual/bbcwine.html#specialfolders
     
DEF FNspecialfolder(id%)
     LOCAL ppidl%, folder%, malloc%
     DIM folder% LOCAL 255
     SYS "SHGetSpecialFolderLocation", @hwnd%, id%, ^ppidl%
     SYS "SHGetPathFromIDList", ppidl%, folder%
     SYS "SHGetMalloc", ^malloc%
     SYS !(!malloc%+20), malloc%, ppidl% : REM. IMalloc::Free
     
= $$folder% + "\"


Home - Products - Contact us

Best viewed with Any Browser Valid HTML 4.0!
© Richard Russell 2010