Some keys/images were not used because the corresponding key/image wasn't available.
Code: Select all
#Include "fbgfx.bi"
#If __FB_LANG__="fb"
Using FB
#EndIf
#Include "vbcompat.bi"
WindowTitle "Simple Key Test"
' All Images from the Xelu's Free Controllers & Keyboard Prompts Pack
' https://opengameart.org/content/free-keyboard-and-controllers-prompts-pack
' CC0 (Creative Commons Zero License
' Notes:
' PNG files converted to BMP using IrfanView
' Filenames changed from original using LupasRename
Declare Sub ShowMouse
Declare Sub LoadImages
Declare Sub ShowKey(Touch As String)
Declare Sub TransColor(tImage As FB.image ptr)
Declare Sub ShowText(xPos As Integer,yPos As Integer,Text As String)
ScreenRes 680,280,32
Line(0,0)-(679,279),RGB(255,255,255),BF
Type NewMouse
Status As Integer
xPos As Integer
yPos As Integer
Wheel As Integer
Buton As Integer
Clip As Integer
End Type
Dim Shared Rat As NewMouse
Type KeyImage
xPos As Integer
yPos As Integer
status As Integer
image As FB.Image Ptr
End Type
Dim Shared Buttons(4) As KeyImage
Dim Shared NumKeys(10) As KeyImage
Dim Shared ArrowKeys(4) As KeyImage
Dim Shared SpecKeys(22) As KeyImage
Dim Shared AlphaKeys(26) As KeyImage
Dim Shared FunctKeys(12) As KeyImage
Dim Shared OtherKeys(14) As KeyImage
LoadImages
ShowText 0,2,"Simple"
ShowText 0,80,"Keyboard"
ShowText 0,160,"Test"
Dim As String Touch
Dim As Integer QuiTest,tKey
While QuiTest=0
Line(580,170)-(680,270),RGB(255,255,255),BF
Touch=InKey
If Touch=Chr(255)+Chr(107) Then QuiTest=-1
If Touch<>"" Then
tKey=Asc(Left(Touch,1))
' Alphabet
If tKey>64 And tKey<91 Then Put(580,180),AlphaKeys(tKey-64).image,Trans
If tKey>96 And tKey<123 Then Put(580,180),AlphaKeys(tKey-64).image,Trans
' Numbers
If tKey>47 And tKey<58 Then Put(580,180),NumKeys(tKey-47).image,Trans
' ESC
If MultiKey(SC_Escape) Or tKey=27 Then
Put(580,180),SpecKeys(12).image,Trans
EndIf
If tKey=42 Then Put(580,180),OtherKeys(1).image,Trans
If tKey=32 Then Put(580,180),OtherKeys(13).image,Trans
If tKey=43 Or tKey=61 Then Put(580,180),OtherKeys(7).image,Trans
If tKey=44 Or tKey=60 Then Put(580,180),OtherKeys(4).image,Trans
If tKey=45 Or tKey=95 Then Put(580,180),OtherKeys(6).image,Trans
If tKey=46 Or tKey=62 Then Put(580,180),OtherKeys(5).image,Trans
If tKey=47 Or tKey=63 Then Put(580,180),OtherKeys(9).image,Trans
If tKey=34 Or tKey=39 Then Put(580,180),OtherKeys(10).image,Trans
If tKey=58 Or tKey=59 Then Put(580,180),OtherKeys(11).image,Trans
If tKey=91 Or tKey=123 Then Put(580,180),OtherKeys(2).image,Trans
If tKey=93 Or tKey=125 Then Put(580,180),OtherKeys(3).image,Trans
If tKey=92 Or tKey=124 Then Put(580,180),OtherKeys(12).image,Trans
If tKey=96 Or tKey=126 Then Put(580,180),OtherKeys(14).image,Trans
If tKey=9 Or MultiKey(SC_Tab) Then Put(580,180),SpecKeys(21).image,Trans
' Extended Characters
If tKey=255 Then
tKey=Asc(Right(touch,1))
' Function Keys (F1-F9)
' Note: Function Keys F11 and F12 work but F10 doesn't for INKEY
' See below for Keys F10-F12
If tKey>58 And tKey<68 Then Put(580,180),FunctKeys(tKey-58).image,Trans
EndIf
EndIf
' Arrow Keys
If MultiKey(SC_Up) Then Put(580,180),ArrowKeys(1).image,Trans
If MultiKey(SC_Down) Then Put(580,180),ArrowKeys(2).image,Trans
If MultiKey(SC_Left) Then Put(580,180),ArrowKeys(3).image,Trans
If MultiKey(SC_Right) Then Put(580,180),ArrowKeys(4).image,Trans
' Function Keys F10-F12
If MultiKey(SC_F10) Then Put(580,180),FunctKeys(10).image,Trans
If MultiKey(SC_F11) Then Put(580,180),FunctKeys(11).image,Trans
If MultiKey(SC_F12) Then Put(580,180),FunctKeys(12).image,Trans
' Special Keys
If MultiKey(SC_Alt) Then Put(580,180),SpecKeys(1).image,Trans
If MultiKey(SC_End) Then Put(580,180),SpecKeys(8).image,Trans
If MultiKey(SC_Home) Then Put(580,180),SpecKeys(13).image,Trans
If MultiKey(SC_Delete) Then Put(580,180),SpecKeys(7).image,Trans
If MultiKey(SC_Enter) Then Put(580,180),SpecKeys(10).image,Trans
If MultiKey(SC_Control) Then Put(580,180),SpecKeys(6).image,Trans
If MultiKey(SC_Insert) Then Put(580,180),SpecKeys(14).image,Trans
If MultiKey(SC_PageUp) Then Put(580,180),SpecKeys(17).image,Trans
If MultiKey(SC_CapsLock) Then Put(580,180),SpecKeys(4).image,Trans
If MultiKey(SC_NumLock) Then Put(580,180),SpecKeys(15).image,Trans
If MultiKey(SC_Backspace) Then Put(580,180),SpecKeys(3).image,Trans
If MultiKey(SC_PageDown) Then Put(580,180),SpecKeys(16).image,Trans
If MultiKey(SC_LShift) Or MultiKey(SC_RShift) Then
Put(580,180),SpecKeys(20).image,Trans
EndIf
If MultiKey(SC_LWin) Or MultiKey(SC_RWin) Then
Put(580,180),SpecKeys(22).image,Trans
EndIf
ShowMouse
Sleep 250
Wend
For DelKey As Integer=1 To 26
If DelKey<5 Then
ImageDestroy Buttons(DelKey).image
ImageDestroy ArrowKeys(DelKey).image
EndIf
If DelKey<11 Then ImageDestroy NumKeys(DelKey).image
If DelKey<13 Then ImageDestroy FunctKeys(DelKey).image
If DelKey<15 Then ImageDestroy OtherKeys(DelKey).image
If DelKey<23 Then ImageDestroy SpecKeys(DelKey).image
ImageDestroy AlphaKeys(DelKey).image
Next
End
Sub LoadImages
Dim As String LoadPath,LoadFile
For NewKey As Integer=1 To 26
If NewKey<5 Then
ArrowKeys(NewKey).image=ImageCreate(100,100)
Buttons(NewKey).image=ImageCreate(100,100)
End If
If NewKey<11 Then NumKeys(NewKey).image=ImageCreate(100,100)
If NewKey<13 Then FunctKeys(NewKey).image=ImageCreate(100,100)
If NewKey<15 Then OtherKeys(NewKey).image=ImageCreate(100,100)
If NewKey<23 Then SpecKeys(NewKey).image=ImageCreate(100,100)
AlphaKeys(NewKey).image=ImageCreate(100,100)
Next
' =-=-=-=-=-=-=-=-=-=-=
' Arrow Keys
' =-=-=-=-=-=-=-=-=-=-=
LoadPath=".\Keyboard & Mouse\Light\Arrows\"
LoadFile=LoadPath+"Up_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,ArrowKeys(1).image
LoadFile=LoadPath+"Down_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,ArrowKeys(2).image
LoadFile=LoadPath+"Left_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,ArrowKeys(3).image
LoadFile=LoadPath+"Right_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,ArrowKeys(4).image
' =-=-=-=-=-=-=-=-=-=-=
' Function Keys
' =-=-=-=-=-=-=-=-=-=-=
LoadPath=".\Keyboard & Mouse\Light\Functions\"
For LoadKey As Integer=1 To 12
LoadFile=LoadPath+"F"+Str(LoadKey)+"_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,FunctKeys(LoadKey).image
Next
' =-=-=-=-=-=-=-=-=-=-=
' Alphabet Keys
' =-=-=-=-=-=-=-=-=-=-=
LoadPath=".\Keyboard & Mouse\Light\Letters\"
For LoadKey As Integer=1 To 26
LoadFile=LoadPath+"Alpha_"+Chr(64+LoadKey)+"_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,AlphaKeys(LoadKey).image
Next
' =-=-=-=-=-=-=-=-=-=-=
' Mouse Buttons
' =-=-=-=-=-=-=-=-=-=-=
LoadPath=".\Keyboard & Mouse\Light\Mouse\"
LoadFile=LoadPath+"Mouse_Left_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,Buttons(1).image
LoadFile=LoadPath+"Mouse_Middle_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,Buttons(2).image
LoadFile=LoadPath+"Mouse_Right_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,Buttons(3).image
LoadFile=LoadPath+"Mouse_Simple_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,Buttons(4).image
' =-=-=-=-=-=-=-=-=-=-=
' Number Keys
' =-=-=-=-=-=-=-=-=-=-=
LoadPath=".\Keyboard & Mouse\Light\Numbers\"
For LoadKey As Integer=1 To 10
LoadFile=LoadPath+"N"+Str(LoadKey-1)+"_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,NumKeys(LoadKey).image
Next
' =-=-=-=-=-=-=-=-=-=-=
' Other Keys
' =-=-=-=-=-=-=-=-=-=-=
LoadPath=".\Keyboard & Mouse\Light\Others\"
LoadFile=LoadPath+"Asterisk_Light.png"
If FileExists(LoadFile) Then BLoad LoadFile,OtherKeys(1).image
LoadFile=LoadPath+"Bracket_Left_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,OtherKeys(2).image
LoadFile=LoadPath+"Bracket_Right_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,OtherKeys(3).image
LoadFile=LoadPath+"Mark_Left_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,OtherKeys(4).image
LoadFile=LoadPath+"Mark_Right_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,OtherKeys(5).image
LoadFile=LoadPath+"Minus_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,OtherKeys(6).image
LoadFile=LoadPath+"Plus_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,OtherKeys(7).image
LoadFile=LoadPath+"Plus_Tall_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,OtherKeys(8).image
LoadFile=LoadPath+"Question_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,OtherKeys(9).image
LoadFile=LoadPath+"Quote_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,OtherKeys(10).image
LoadFile=LoadPath+"Semicolon_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,OtherKeys(11).image
LoadFile=LoadPath+"Slash_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,OtherKeys(12).image
LoadFile=LoadPath+"Space_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,OtherKeys(13).image
LoadFile=LoadPath+"Tilda_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,OtherKeys(14).image
' =-=-=-=-=-=-=-=-=-=-=
' Special Keys
' =-=-=-=-=-=-=-=-=-=-=
LoadPath=".\Keyboard & Mouse\Light\Special\"
LoadFile=LoadPath+"Alt_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,SpecKeys(1).image
LoadFile=LoadPath+"Backspace_Alt_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,SpecKeys(2).image
LoadFile=LoadPath+"Backspace_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,SpecKeys(3).image
LoadFile=LoadPath+"Caps_Lock_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,SpecKeys(4).image
LoadFile=LoadPath+"Command_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,SpecKeys(5).image
LoadFile=LoadPath+"Ctrl_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,SpecKeys(6).image
LoadFile=LoadPath+"Del_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,SpecKeys(7).image
LoadFile=LoadPath+"End_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,SpecKeys(8).image
LoadFile=LoadPath+"Enter_Alt_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,SpecKeys(9).image
LoadFile=LoadPath+"Enter_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,SpecKeys(10).image
LoadFile=LoadPath+"Enter_Tall_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,SpecKeys(11).image
LoadFile=LoadPath+"Esc_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,SpecKeys(12).image
LoadFile=LoadPath+"Home_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,SpecKeys(13).image
LoadFile=LoadPath+"Insert_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,SpecKeys(14).image
LoadFile=LoadPath+"Num_Lock_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,SpecKeys(15).image
LoadFile=LoadPath+"Page_Down_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,SpecKeys(16).image
LoadFile=LoadPath+"Page_Up_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,SpecKeys(17).image
LoadFile=LoadPath+"Print_Screen_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,SpecKeys(18).image
LoadFile=LoadPath+"Shift_Alt_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,SpecKeys(19).image
LoadFile=LoadPath+"Shift_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,SpecKeys(20).image
LoadFile=LoadPath+"Tab_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,SpecKeys(21).image
LoadFile=LoadPath+"Win_Light.bmp"
If FileExists(LoadFile) Then BLoad LoadFile,SpecKeys(22).image
' Convert black background to the Transparency color
For ConvKey As Integer=1 To 26
If ConvKey<5 Then
TransColor Buttons(ConvKey).image
TransColor ArrowKeys(ConvKey).image
EndIf
If ConvKey<11 Then TransColor NumKeys(ConvKey).image
If ConvKey<13 Then TransColor FunctKeys(ConvKey).image
If ConvKey<15 Then TransColor OtherKeys(ConvKey).image
If ConvKey<23 Then TransColor SpecKeys(ConvKey).image
TransColor AlphaKeys(ConvKey).image
Next
End Sub
Sub ShowMouse
Dim tImage As FB.image Ptr
tImage=Buttons(4).image
Rat.Status=GetMouse(Rat.xPos,Rat.yPos,,Rat.Buton)
If Rat.Status=0 Then
If Rat.Buton And 1 Then tImage=Buttons(1).image
If Rat.Buton And 4 Then tImage=Buttons(2).image
If Rat.Buton And 2 Then tImage=Buttons(3).image
End If
Put(480,170),tImage,Trans
End Sub
Sub ShowText(xPos As Integer,yPos As Integer,Text As String)
Dim As Integer tAsc
For tView As Integer=1 To Len(Text)
tAsc=Asc(Mid(Text,tView,1))
If tAsc>64 And tAsc<91 Then tAsc-=64
If tAsc>96 And tAsc<123 Then tAsc-=96
Put(80*(tView-1)+xPos,yPos),AlphaKeys(tAsc).image,Trans
Next
End Sub
Sub TransColor(tImage As FB.image ptr)
For yPos As Integer=0 To 99
For xPos As Integer=0 To 99
If Point(xPos,yPos,tImage)=RGB(0,0,0) Then
PSet tImage,(xPos,yPos),RGB(255,0,255)
End If
Next
Next
End Sub
https://www.dropbox.com/s/0m8cht348wbry ... t.zip?dl=0