home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / direct3a / frmmain.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-10-23  |  10.0 KB  |  287 lines
  1. VERSION 5.00
  2. Begin VB.Form frmMain 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "DirectX 7 for VB: Direct input (Keyboard)"
  5.    ClientHeight    =   3480
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   5880
  9.    Icon            =   "frmmain.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   232
  14.    ScaleMode       =   3  'Pixel
  15.    ScaleWidth      =   392
  16.    StartUpPosition =   3  'Windows Default
  17.    Begin VB.PictureBox picGame 
  18.       BackColor       =   &H00000000&
  19.       Height          =   2310
  20.       Left            =   3480
  21.       ScaleHeight     =   150
  22.       ScaleMode       =   3  'Pixel
  23.       ScaleWidth      =   150
  24.       TabIndex        =   2
  25.       Top             =   600
  26.       Width           =   2310
  27.       Begin VB.Shape Shape1 
  28.          BorderColor     =   &H000000FF&
  29.          FillColor       =   &H00FF0000&
  30.          FillStyle       =   7  'Diagonal Cross
  31.          Height          =   750
  32.          Left            =   750
  33.          Top             =   750
  34.          Width           =   750
  35.       End
  36.    End
  37.    Begin VB.Timer tmrKey 
  38.       Left            =   120
  39.       Top             =   1560
  40.    End
  41.    Begin VB.ListBox lstKeys 
  42.       Height          =   255
  43.       Left            =   120
  44.       TabIndex        =   0
  45.       Top             =   240
  46.       Width           =   5655
  47.    End
  48.    Begin VB.Label lblmisc 
  49.       AutoSize        =   -1  'True
  50.       BackStyle       =   0  'Transparent
  51.       Caption         =   "My Page, with game: HTTP://www.parkstonemot.freeserve.co.uk/indexFW.htm"
  52.       Height          =   195
  53.       Index           =   4
  54.       Left            =   120
  55.       TabIndex        =   6
  56.       Top             =   3240
  57.       Width           =   5685
  58.    End
  59.    Begin VB.Label lblmisc 
  60.       AutoSize        =   -1  'True
  61.       BackStyle       =   0  'Transparent
  62.       Caption         =   "EMail: JollyJeffers@GreenOnions.NetscapeOnline.Co.Uk"
  63.       Height          =   195
  64.       Index           =   3
  65.       Left            =   120
  66.       TabIndex        =   5
  67.       Top             =   3000
  68.       Width           =   4020
  69.    End
  70.    Begin VB.Label lblmisc 
  71.       AutoSize        =   -1  'True
  72.       BackStyle       =   0  'Transparent
  73.       Caption         =   "Try these Contacts:"
  74.       Height          =   195
  75.       Index           =   2
  76.       Left            =   120
  77.       TabIndex        =   4
  78.       Top             =   2760
  79.       Width           =   1380
  80.    End
  81.    Begin VB.Label lblmisc 
  82.       BackStyle       =   0  'Transparent
  83.       Caption         =   "The picturebox to the side responds to UP/DOWN/LEFT/RIGHT. It shows how you could create a simple game...."
  84.       Height          =   615
  85.       Index           =   1
  86.       Left            =   120
  87.       TabIndex        =   3
  88.       Top             =   600
  89.       Width           =   2775
  90.    End
  91.    Begin VB.Label lblmisc 
  92.       AutoSize        =   -1  'True
  93.       BackStyle       =   0  'Transparent
  94.       Caption         =   "Current Keys:"
  95.       Height          =   195
  96.       Index           =   0
  97.       Left            =   120
  98.       TabIndex        =   1
  99.       Top             =   0
  100.       Width           =   945
  101.    End
  102. Attribute VB_Name = "frmMain"
  103. Attribute VB_GlobalNameSpace = False
  104. Attribute VB_Creatable = False
  105. Attribute VB_PredeclaredId = True
  106. Attribute VB_Exposed = False
  107. Dim dx As New DirectX7  'the directX object.
  108. Dim di As DirectInput   'the directInput object.
  109. Dim diDEV As DirectInputDevice  'the sub device of DirectInput.
  110. Dim diState As DIKEYBOARDSTATE  'the key states.
  111. Dim iKeyCounter As Integer
  112. Dim aKeys(255) As String    'key names
  113. Private Sub Form_Load()
  114.     Set di = dx.DirectInputCreate() 'create the object, must be done before anything else
  115.     If Err.Number <> 0 Then 'if err=0 then there are no errors.
  116.         MsgBox "Error starting Direct Input, please make sure you have DirectX installed", vbApplicationModal
  117.         End
  118.     End If
  119.     Set diDEV = di.CreateDevice("GUID_SysKeyboard") 'Create a keyboard object off the Input object
  120.     diDEV.SetCommonDataFormat DIFORMAT_KEYBOARD 'specify it as a normal keyboard, not mouse or joystick
  121.     diDEV.SetCooperativeLevel Me.hWnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE
  122.     ' ^ set coop level. Defines how it interacts with other applications, whether it will share with other
  123.     ' apps. DISCL_NONEXCLUSIVE means that it's multi-tasking friendly
  124.     Me.Show 'show the form
  125.     diDEV.Acquire   'aquire the keystates.
  126.     tmrKey.Interval = 10    'sensitivity, in this case the repeat rate of the keyboard
  127.     tmrKey.Enabled = True   'enable the timer, this has the key detecting code in it
  128. End Sub
  129. Private Sub Form_Unload(Cancel As Integer)
  130.     diDEV.Unacquire
  131. End Sub
  132. Private Sub lstKeys_GotFocus()
  133. frmMain.SetFocus
  134. End Sub
  135. Private Sub lstKeys_Scroll()
  136. frmMain.SetFocus
  137. End Sub
  138. Private Sub tmrKey_Timer()
  139.     diDEV.GetDeviceStateKeyboard diState    'get all the key states.
  140.     For iKeyCounter = 0 To 255  ' goes through all the 255 differnet keys.
  141.         If diState.Key(iKeyCounter) <> 0 Then   'if it =0 then it's not pressed. Anything else means it is pressed
  142.         lstKeys.Clear
  143.             lstKeys.AddItem KeyNames(iKeyCounter), 0    'add an item to the top of the list
  144.         End If
  145.     Next
  146.     DoEvents    'doevents. Lets windows do anything it needs to do. Required
  147.     'otherwise you can get it doing more things than it's capable of.
  148. 'This stuff is for the little game window:
  149. '200=up
  150. '203=left
  151. '205=right
  152. '208=down
  153. If diState.Key(200) <> 0 Then
  154.     If Shape1.Top > 0 Then
  155.     Shape1.Top = Shape1.Top - 50
  156.     End If
  157. End If
  158. If diState.Key(208) <> 0 Then
  159.     If Shape1.Top < 100 Then
  160.     Shape1.Top = Shape1.Top + 50
  161.     End If
  162. End If
  163. If diState.Key(203) <> 0 Then
  164.     If Shape1.Left > 0 Then
  165.     Shape1.Left = Shape1.Left - 50
  166.     End If
  167. End If
  168. If diState.Key(205) <> 0 Then
  169.     If Shape1.Left < 100 Then
  170.     Shape1.Left = Shape1.Left + 50
  171.     End If
  172. End If
  173. End Sub
  174. Function KeyNames(iNum As Integer) As String
  175. 'DIK=DirectInputKey, just a prefix, not actually required.
  176. 'Each key has a number, like the "Keycode=VbKeyEnter or chr$(13)"
  177.     aKeys(1) = "DIK_ESCAPE"
  178.     aKeys(2) = "DIK_1  On main keyboard"
  179.     aKeys(3) = "DIK_2  On main keyboard"
  180.     aKeys(4) = "DIK_3  On main keyboard"
  181.     aKeys(5) = "DIK_4  On main keyboard"
  182.     aKeys(6) = "DIK_5  On main keyboard"
  183.     aKeys(7) = "DIK_6  On main keyboard"
  184.     aKeys(8) = "DIK_7  On main keyboard"
  185.     aKeys(9) = "DIK_8  On main keyboard"
  186.     aKeys(10) = "DIK_9  On main keyboard"
  187.     aKeys(11) = "DIK_0  On main keyboard"
  188.     aKeys(12) = "DIK_MINUS  On main keyboard"
  189.     aKeys(13) = "DIK_EQUALS  On main keyboard"
  190.     aKeys(14) = "DIK_BACK BACKSPACE"
  191.     aKeys(15) = "DIK_TAB"
  192.     aKeys(16) = "DIK_Q"
  193.     aKeys(17) = "DIK_W"
  194.     aKeys(18) = "DIK_E"
  195.     aKeys(19) = "DIK_R"
  196.     aKeys(20) = "DIK_T"
  197.     aKeys(21) = "DIK_Y"
  198.     aKeys(22) = "DIK_U"
  199.     aKeys(23) = "DIK_I"
  200.     aKeys(24) = "DIK_O"
  201.     aKeys(25) = "DIK_P"
  202.     aKeys(26) = "DIK_LBRACKET  ["
  203.     aKeys(27) = "DIK_RBRACKET  ]"
  204.     aKeys(28) = "DIK_RETURN  ENTER on main keyboard"
  205.     aKeys(29) = "DIK_LCONTROL  Left CTRL Key"
  206.     aKeys(30) = "DIK_A"
  207.     aKeys(31) = "DIK_S"
  208.     aKeys(32) = "DIK_D"
  209.     aKeys(33) = "DIK_F"
  210.     aKeys(34) = "DIK_G"
  211.     aKeys(35) = "DIK_H"
  212.     aKeys(36) = "DIK_J"
  213.     aKeys(37) = "DIK_K"
  214.     aKeys(38) = "DIK_L"
  215.     aKeys(39) = "DIK_SEMICOLON"
  216.     aKeys(40) = "DIK_APOSTROPHE"
  217.     aKeys(41) = "DIK_GRAVE  Grave accent (`)"
  218.     aKeys(42) = "DIK_LSHIFT  Left SHIFT"
  219.     aKeys(43) = "DIK_BACKSLASH"
  220.     aKeys(44) = "DIK_Z"
  221.     aKeys(45) = "DIK_X"
  222.     aKeys(46) = "DIK_C"
  223.     aKeys(47) = "DIK_V"
  224.     aKeys(48) = "DIK_B"
  225.     aKeys(49) = "DIK_N"
  226.     aKeys(50) = "DIK_M"
  227.     aKeys(51) = "DIK_COMMA"
  228.     aKeys(52) = "DIK_PERIOD  On main keyboard"
  229.     aKeys(53) = "DIK_SLASH  Forward slash (/)on main keyboard"
  230.     aKeys(54) = "DIK_RSHIFT  Right SHIFT"
  231.     aKeys(55) = "DIK_MULTIPLY  Asterisk on numeric keypad"
  232.     aKeys(56) = "DIK_LMENU  Left ALT"
  233.     aKeys(57) = "DIK_SPACE Spacebar"
  234.     aKeys(58) = "DIK_CAPITAL  CAPS LOCK"
  235.     aKeys(59) = "DIK_F1"
  236.     aKeys(60) = "DIK_F2"
  237.     aKeys(61) = "DIK_F3"
  238.     aKeys(62) = "DIK_F4"
  239.     aKeys(63) = "DIK_F5"
  240.     aKeys(64) = "DIK_F6"
  241.     aKeys(65) = "DIK_F7"
  242.     aKeys(66) = "DIK_F8"
  243.     aKeys(67) = "DIK_F9"
  244.     aKeys(68) = "DIK_F10"
  245.     aKeys(69) = "vDIK_NUMLOCK"
  246.     aKeys(70) = "DIK_SCROLL  SCROLL LOCK"
  247.     aKeys(71) = "DIK_NUMPAD7"
  248.     aKeys(72) = "DIK_NUMPAD8"
  249.     aKeys(73) = "DIK_NUMPAD9"
  250.     aKeys(74) = "DIK_SUBTRACT  Hyphen (minus sign) on numeric keypad"
  251.     aKeys(75) = "DIK_NUMPAD4"
  252.     aKeys(76) = "DIK_NUMPAD5"
  253.     aKeys(77) = "DIK_NUMPAD6"
  254.     aKeys(78) = "DIK_ADD  Plus sign on numeric keypad"
  255.     aKeys(79) = "DIK_NUMPAD1"
  256.     aKeys(80) = "DIK_NUMPAD2"
  257.     aKeys(81) = "DIK_NUMPAD3"
  258.     aKeys(82) = "DIK_NUMPAD0"
  259.     aKeys(83) = "DIK_DECIMAL  Period (decimal point) on numeric keypad"
  260.     aKeys(87) = "DIK_F11"
  261.     aKeys(88) = "DIK_F12"
  262.     aKeys(86) = "DIK_F13"
  263.     aKeys(84) = "DIK_F14"
  264.     aKeys(85) = "DIK_F15"
  265.     aKeys(156) = "DIK_NUMPADENTER"
  266.     aKeys(157) = "DIK_RCONTROL  Right CTRL key"
  267.     aKeys(91) = "DIK_NUMPADCOMMA Comma on NEC PC98 numeric keypad"
  268.     aKeys(181) = "DIK_DIVIDE  Forward slash (/)on numeric keypad"
  269.     aKeys(183) = "DIK_SYSRQ"
  270.     aKeys(184) = "DIK_RMENU  Right ALT"
  271.     aKeys(199) = "DIK_HOME"
  272.     aKeys(200) = "DIK_UP  Up arrow"
  273.     aKeys(201) = "DIK_PRIOR  PAGE UP"
  274.     aKeys(203) = "DIK_LEFT  Left arrow"
  275.     aKeys(205) = "DIK_RIGHT  Right arrow"
  276.     aKeys(207) = "DIK_END"
  277.     aKeys(208) = "DIK_DOWN  Down arrow"
  278.     aKeys(209) = "DIK_NEXT  PAGE DOWN"
  279.     aKeys(210) = "DIK_INSERT"
  280.     aKeys(211) = "DIK_DELETE"
  281.     aKeys(219) = "DIK_LWIN  Left Windows key"
  282.     aKeys(220) = "DIK_RWIN  Right Windows key"
  283.     aKeys(221) = "DIK_APPS  Application key"
  284.     aKeys(116) = "DIK_PAUSE"
  285.     KeyNames = aKeys(iNum)
  286. End Function
  287.