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
PROCclick(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 https://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% + "\"
