Keyboard and Mouse Tests

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
NorbyDroid
Posts: 70
Joined: May 21, 2016 22:55

Keyboard and Mouse Tests

Post by NorbyDroid »

While looking around for images to use for a word game I will be making, I cam across a Controller and Keyboard Pack and made this program for testing keyboard and mouse inputs. I wanted to share in case it is good to learn from or someone will find the program useful.

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
You can get the archive with the source code and images here:
https://www.dropbox.com/s/0m8cht348wbry ... t.zip?dl=0
Top
sero
Posts: 59
Joined: Mar 06, 2018 13:26
Location: USA

Re: Keyboard and Mouse Tests

Post by sero »

This is neat! Kinda makes me think of a teaching to type game I used to play long ago. Some of the keys don't show up properly, though. For example, pressing "a" registers as "F6".
Top
Post Reply

Return to “Sources, Examples, Tips and Tricks”