Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compile Exe "gbkeyboard.exe"
#Dim All
%Unicode = 1
#Include "Win32API.inc"
$Ver = "1.1"
#Resource Icon logo, "_icons\logo.ico"
Enum Equates Singular
IDC_Graphic = 500
IDM_Zoom100
End Enum
Type KeyType
x As Long
y As Long
w As Long
h As Long
s As StringZ * 20 'text on key
r As Rect 'rect
high As Long 'highlighting status
smallfont As Long 'keys which need the smaller font
color As Long
End Type
Global hDlg,hGraphic As Dword, Keys() As KeyType
Global MultiColor, FullKeyBoard, KeyBorder, LineColor, BGColor As Long
Function PBMain() As Long
Dialog New Pixels, 0, "gbKeyBoard v" + $Ver,,,1250,700, %WS_OverlappedWindow To hDlg
Dialog Set Icon hDlg, "logo"
Control Add Graphic, hDlg, %IDC_Graphic,"",0,0,100,100, %SS_Notify
Control Handle hDlg, %IDC_Graphic To hGraphic
Graphic Attach hDlg, %IDC_Graphic, ReDraw
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Local i,x,y,w,h As Long, pt As Point, rc As Rect
Select Case Cb.Msg
Case %WM_InitDialog
ReDim Keys(96)
MultiColor = 0
FullKeyBoard = 0
KeyBorder = 2
LineColor = %Black ' %rgb_LightGray
BGColor = %rgb_LightYellow
Case %WM_Command
Select Case Cb.Ctl
Case %IDC_Graphic
Select Case Cb.CtlMsg
Case %STN_Clicked
GetCursorPos pt : ScreentoClient hGraphic, pt
For i = 1 To UBound(Keys)
If PtInRect(Keys(i).r,pt) Then WinBeep(250,300) : Dialog Set Text hDlg, "gbKeyBoard v" + $Ver + " Key: " + Keys(i).s : Exit For
Next i
End Select
End Select
Case %WM_ContextMenu
GetCursorPos pt
GetWindowRect hGraphic, rc
If PtInRect(rc,pt) Then
FullKeyBoard Xor=1
InitializeKeys MultiColor, FullKeyboard, KeyBorder, LineColor, BGColor
End If
Case %WM_Size
Dialog Get Client hDlg To w,h
Control Set Loc hDlg, %IDC_Graphic, w/2, 0
Control Set Size hDlg, %IDC_Graphic, w/2, h/2
InitializeKeys MultiColor, FullKeyboard, KeyBorder, LineColor, BGColor
End Select
End Function
Sub InitializeKeys(MultiColor As Long, FullKeyBoard As Long, KeyBorder As Long, LineColor As Long, BGColor As Long)
Local i,sw,sh,w,h,kw,kh,wmax,x,y,wNew,hNew,edge,gap As Long, ScaleFactor As Single
Local d16,d32,d68,d86,d100,d118,d126,d154,d344, FontSize As Long
Local Zoom, AR As Single, kbh, kbw, x1,x2,y1,y2, Zoom100 As Long
Local hFontSmall, hFontBig As Dword
Data "ESC","","F1","F2","F3","F4","","F5","F6","F7","F8","","F9","F10","F11","F12","","PrtS","SLck","Paus"
Data "`","1","2","3","4","5","6","7","8","9","0","-","=","BkSp","","Ins","Hme","PgU"
Data "Tab","Q","W","E","R","T","Y","U","I","O","P","[","]","\","","Del","End","PgD
Data "Caps","A","S","D","F","G","H","J","K","L",";","'","Enter"
Data "Shift","Z","X","C","V","B","N","M",",",".","/","Shift","","","^"
Data "Ctrl","Win","Alt","Space","Alt","Win","Menu","Ctrl","","<-","Dn","->"
kbh = 374
kbw = IIf(FullKeyboard,1022,854)
Graphic Get Client To w,h
Zoom = Min(w/kbw,h/kbh)
If Zoom100 Then Zoom = 1
'all of thse settings are a bit arbitrary - used an onscreen ruler to get a baseline set of values
edge = 10 * Zoom
gap = 30 * Zoom
kw = 54 * Zoom
kh = 54 * Zoom
d16 = 16 * Zoom
d32 = 32 * Zoom
d68 = 68 * Zoom
d86 = 86 * Zoom
d100 = 100 * Zoom
d118 = 118 * Zoom
d126 = 126 * Zoom
d154 = 154 * Zoom
d344 = 344 * Zoom
'get size of largest 2:1 aspect ratio rectangle that will fit in image of size w,h
AR = kbw/kbh
wNew = AR / Max(AR / w, 1 / h) * 1.0
hNew = 1 / Max(AR / w, 1 / h) * 1.0
'center that rectangle in w,h (get the top/left/right/bottom coordinates)
x1 = (w-wNew)/2 : x2 = w - x1
y1 = (h-hNew)/2 : y2 = h - y1
'all keys w and h
For i = 1 To UBound(Keys) : Keys(i).w = kw : Keys(i).h = kh : Next i
'special width keys
Keys(2).w = kw : Keys(7).w = d32 : Keys(12).w = d32 : Keys(17).w = d16 'Row1
Keys(34).w = d118 : Keys(35).w = d16 'Row2
Keys(39).w = d86 : Keys(52).w = d86 : Keys(53).w = d16 'Row3
Keys(57).w = d100 : Keys(69).w = d126 'Row4
Keys(70).w = d126 : Keys(81).w = d154 : Keys(82).w = d16 'Row5
For i = 85 To 92 : Keys(i).w = d68 : Next i 'Row6
Keys(88).w = d344 : Keys(93).w = d16 'Row6
'y location
For i = 1 To 20 : Keys(i).y = edge : Next i 'Row1
For i = 21 To 38 : Keys(i).y = edge + gap + 1*kh : Next i 'Row2
For i = 39 To 56 : Keys(i).y = edge + gap + 2*kh : Next i 'Row3
For i = 57 To 69 : Keys(i).y = edge + gap + 3*kh : Next i 'Row4
For i = 70 To 84 : Keys(i).y = edge + gap + 4*kh : Next i 'Row5
For i = 85 To 96 : Keys(i).y = edge + gap + 5*kh : Next i 'Row6
'x location
Keys(1).x = edge
Keys(21).x = edge
Keys(39).x = edge
Keys(57).x = edge
Keys(70).x = edge
Keys(85).x = edge
'set x values
For i = 2 To 20 : Keys(i).x = Keys(i-1).x + Keys(i-1).w : Next i
For i = 22 To 38 : Keys(i).x = Keys(i-1).x + Keys(i-1).w : Next i
For i = 40 To 56 : Keys(i).x = Keys(i-1).x + Keys(i-1).w : Next i
For i = 58 To 69 : Keys(i).x = Keys(i-1).x + Keys(i-1).w : Next i
For i = 71 To 84 : Keys(i).x = Keys(i-1).x + Keys(i-1).w : Next i
For i = 86 To 96 : Keys(i).x = Keys(i-1).x + Keys(i-1).w : Next i
'short row sizes
Dim Rows(6) As Long
For i = 1 To 16 : Rows(1) += Keys(i).w : Next i '+ IIf(FullKeyBoard,3*kw,0): Next i
For i = 21 To 34 : Rows(2) += Keys(i).w : Next i '+ IIf(FullKeyboard,3*kw,0): Next i
For i = 39 To 52 : Rows(3) += Keys(i).w : Next i '+ IIf(FullKeyboard,3*kw,0): Next i
For i = 57 To 69 : Rows(4) += Keys(i).w : Next i ': Next i
For i = 70 To 81 : Rows(5) += Keys(i).w : Next i '+ IIf(FullKeyboard,2*kw,0): Next i
For i = 85 To 92 : Rows(6) += Keys(i).w : Next i '+ IIf(FullKeyboard,3*kw,0): Next i
Rows(0) = 6 * kw + gap 'keyboard height
For i = 0 To 6 : Rows(i) += 2*edge : Next i
'key size adjustment
wMax = Max(Rows(1),Rows(2),Rows(3),Rows(4),Rows(5),Rows(6))
Keys(2).w += wMax-Rows(1)
Keys(34).w += wMax-Rows(2)
Keys(52).w += wMax-Rows(3)
Keys(69).w += wMax-Rows(4)
Keys(81).w += wMax-Rows(5)
Keys(88).w += wMax-Rows(6)
'Repeat with adjusted width
For i = 2 To 20 : Keys(i).x = Keys(i-1).x + Keys(i-1).w : Next i
For i = 22 To 38 : Keys(i).x = Keys(i-1).x + Keys(i-1).w : Next i
For i = 40 To 56 : Keys(i).x = Keys(i-1).x + Keys(i-1).w : Next i
For i = 58 To 69 : Keys(i).x = Keys(i-1).x + Keys(i-1).w : Next i
For i = 71 To 84 : Keys(i).x = Keys(i-1).x + Keys(i-1).w : Next i
For i = 86 To 96 : Keys(i).x = Keys(i-1).x + Keys(i-1).w : Next i
'Assign Strings
For i = 1 To 96 : Keys(i).s = Read$(i) : Next i
'Assign colors
For i = 1 To UBound(Keys)
Keys(i).color = BGColor
Next i
If MultiColor Then
For i = 1 To UBound(Keys)
Select Case i
Case 1 To 20, 85 To 92 : Keys(i).color = %rgb_LightGray
Case 21,22,39,40,57,58,70,71,85,86,87,3 : Keys(i).color = %rgb_LightCoral
Case 23,41,59,72,4 : Keys(i).color = %rgb_SkyBlue
Case 24,42,60,73,5 : Keys(i).color = %rgb_LightGreen
Case 25,26,43,44,61,62,74,75,6 : Keys(i).color = %rgb_Moccasin
Case 27,28,45,46,63,64,76,77,7 : Keys(i).color = %rgb_DarkSeaGreen
Case 29,47,65,78,8 : Keys(i).color = %rgb_Thistle
Case 30,48,66,79,89,9 : Keys(i).color = %rgb_PaleGreen
Case 31 To 38,49 To 56, 67 To 69,80,81,84,90 To 92,94 To 96,10 To 20 : Keys(i).color = %rgb_PeachPuff
Case 88 : Keys(i).color = %rgb_LightGray
End Select
Next i
Else
For i = 1 To UBound(Keys)
Keys(i).color = BGColor
Next i
End If
'small font key assignments
For i = 1 To UBound(Keys)
Select Case i
Case 1,2 To 20,85 To 87,89 To 92,36 To 38,54 To 56,95 : Keys(i).SmallFont = 1
End Select
Next i
' 'Create 2 font sizes
ScaleFactor = 0.8 : w = Keys(91).w : h = Keys(91).h
Graphic Font "Tahoma", 1000, 1
Graphic Text Size "Menu" To x,y
FontSize = 1000/IIf( x/w > y/h , x/(w*scalefactor) , y/(h*scalefactor) )
Font New "Tahoma", FontSize, 1 To hFontSmall
ScaleFactor = 0.8 : w = Keys(41).w : h = Keys(41).h
Graphic Font "Tahoma", 1000, 1
Graphic Text Size "W" To x,y
FontSize = 1000/IIf( x/w > y/h , x/(w*scalefactor) , y/(h*scalefactor) )
Font New "Tahoma", FontSize, 1 To hFontBig
Graphic Set Font hFontSmall
'reposition
Graphic Get Client To w,h
For i = 1 To UBound(Keys)
Keys(i).x += (w-x2+x1)/2
Keys(i).y += (h-y2+y1)/2
Next i
'create rect elements
For i = 1 To UBound(Keys)
Keys(i).r.nleft = Keys(i).x
Keys(i).r.nright = Keys(i).x + Keys(i).w
Keys(i).r.ntop = Keys(i).y
Keys(i).r.nbottom = Keys(i).y + Keys(i).h
Next i
'draw the keys
Graphic Clear RGB(240,240,240)
Graphic Color %Black, -2
Graphic Width 3
If FullKeyBoard Then
For i = 1 To UBound(Keys)
Select Case i
Case 2,7,12,17,35,53,82,83,93 'do not draw
Case Else
'If Keys(i).smallFont Then Graphic Set Font hFontSmall Else Graphic Set Font hFontBig
If MultiColor = 1 Then Graphic Box (Keys(i).x+KeyBorder,Keys(i).y+KeyBorder)-(Keys(i).x+KeyBorder + Keys(i).w -2*KeyBorder,Keys(i).y+KeyBorder + Keys(i).h - 2*KeyBorder),,Keys(i).color, Keys(i).color
If MultiColor = 0 Then Graphic Box (Keys(i).x+KeyBorder,Keys(i).y+KeyBorder)-(Keys(i).x+KeyBorder + Keys(i).w -2*KeyBorder,Keys(i).y+KeyBorder + Keys(i).h - 2*KeyBorder),,LineColor, BGColor
Graphic Text Size Keys(i).s To sw,sh
Graphic Set Pos(Keys(i).x + (Keys(i).w-sw)/2,Keys(i).y + (Keys(i).h-sh)/2)
Graphic Color %Black, -2
Graphic Print Keys(i).s
End Select
Next i
Else
For i = 1 To UBound(Keys)
Select Case i
Case 2,7,12,17 To 20,35 To 38,53 To 56,82 To 84,93 To 96 'do not draw
Case Else
'If Keys(i).smallFont Then Graphic Set Font hFontSmall Else Graphic Set Font hFontBig
If MultiColor = 1 Then Graphic Box (Keys(i).x+KeyBorder,Keys(i).y+KeyBorder)-(Keys(i).x+KeyBorder + Keys(i).w -2*KeyBorder,Keys(i).y+KeyBorder + Keys(i).h - 2*KeyBorder),,Keys(i).color, Keys(i).color
If MultiColor = 0 Then Graphic Box (Keys(i).x+KeyBorder,Keys(i).y+KeyBorder)-(Keys(i).x+KeyBorder + Keys(i).w -2*KeyBorder,Keys(i).y+KeyBorder + Keys(i).h - 2*KeyBorder),,LineColor, BGColor
Graphic Text Size Keys(i).s To sw,sh
Graphic Set Pos(Keys(i).x + (Keys(i).w-sw)/2,Keys(i).y + (Keys(i).h-sh)/2)
Graphic Color %Black, -2
Graphic Print Keys(i).s
End Select
Next i
End If
'Graphic Box (x1,y1)-(x2,y2),,%Red
Graphic ReDraw
End Sub
http://www.garybeene.com/sw/gbsnippets.htm