Tron, the directX tutorial
This is the four chapter,   Here we will learn howto activating Keyboard Direct Input with Directx , Is very inportan if your need a free movement in your 3D programs. In this example your can move with arrows key and pageup or pagedown.We dont activate the Exclusive mode ,you can activate it changing 
DirectTeclat.SetCooperativeLevel Form1.hWnd, DISCL_NONEXCLUSIVE Or DISCL_BACKGROUND
With
DirectTeclat.SetCooperativeLevel Form1.hWnd, DISCL_EXCLUSIVE Or DISCL_BACKGROUND

The new  functions are very easy to understand . 
In the example you can see a number on the screen . Is the keypresset key number. use this number to implemented your programs.
 
KeyPresset Number
Free movement

 

 

 
 
FORM1
Private Sub Form_Load()
IntHoritzontal = 800
IntVertical = 600
InicializarVideo IntHoritzontal, IntVertical
Inicizentorno 'call to Inicizentorno
Do While DoEvents
'infinite loop calling Accion function
Accion
Loop
End Sub
 
 

MODULE
Option Explicit
'last chapter definitions
Public IntHoritzontal As Integer
Public IntVertical As Integer
Public Direct As New DirectX7
Public Ddraw As DirectDraw4
Public Ddrm As Direct3DRM3
Public DDclipper As DirectDrawClipper
Public DDsurface As DirectDrawSurface4
Public DDsurfacesec As DirectDrawSurface4
Public DDSDsurface As DDSURFACEDESC2
Public DDSCAP As DDSCAPS2
Public RMDevice As Direct3DRMDevice3
Public RMViewport As Direct3DRMViewport2
 

Public Textureim As Direct3DRMLoadTextureCallback3
Public MeshCargar As Direct3DRMMeshBuilder3 
Public FramePrincipal As Direct3DRMFrame3 
Public Camara As Direct3DRMFrame3 
Public FrameCargar As Direct3DRMFrame3 
Public LuzAmbiental As Direct3DRMLight 
Public Luz1 As Direct3DRMLight 

'New definitions
Public DirecInput As DirectInput 'to activate Direct X
Public DirectTeclat As DirectInputDevice 'To activate Device
Public EstatTeclat As DIKEYBOARDSTATE ' to select Keyboar
Public StrText As String 'To write text
Public Bucle As Integer

'The INICIALIZARVIDEO commands are explainet in the first chapter tutorial
Public Function InicializarVideo(Horitzontal As Integer, Vertical As Integer)
Set Ddraw = Direct.DirectDraw4Create("")
Form1.Show
Ddraw.SetCooperativeLevel Form1.hWnd, DDSCL_FULLSCREEN Or DDSCL_EXCLUSIVE
Ddraw.SetDisplayMode Horitzontal, Vertical, 16, 0, DDSDM_DEFAULT
DDSDsurface.lFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
DDSDsurface.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_3DDEVICE Or DDSCAPS_COMPLEX Or DDSCAPS_FLIP
DDSDsurface.lBackBufferCount = 1
Set DDsurface = Ddraw.CreateSurface(DDSDsurface)
DDSCAP.lCaps = DDSCAPS_BACKBUFFER
Set DDsurfacesec = DDsurface.GetAttachedSurface(DDSCAP)
Set Ddrm = Direct.Direct3DRMCreate()
Set RMDevice = Ddrm.CreateDeviceFromSurface("IID_IDirect3DHALDevice", Ddraw, DDsurfacesec, D3DRMDEVICE_DEFAULT)
RMDevice.SetBufferCount 2
RMDevice.SetQuality D3DRMLIGHT_ON Or D3DRMFILL_SOLID Or D3DRMSHADE_GOURAUD Or D3DRMSHADE_MAX
RMDevice.SetTextureQuality D3DRMTEXTURE_MIPNEAREST
RMDevice.SetRenderMode D3DRMRENDERMODE_DEFAULT
End Function

Public Function Inicizentorno()
Set FramePrincipal = Ddrm.CreateFrame(Nothing) '
Set Camara = Ddrm.CreateFrame(FramePrincipal) 
Set RMViewport = Ddrm.CreateViewport(RMDevice, Camara, 0, 0, IntHoritzontal, IntVertical)
'

RMViewport.Clear D3DRMCLEAR_TARGET Or D3DRMCLEAR_ZBUFFER 
RMViewport.SetBack 5000
 

'DirecInput
'KEYBOARD
Set DirecInput = Direct.DirectInputCreate 'create a direct input
Set DirectTeclat = DirecInput.CreateDevice("GUID_SysKeyboard") 'assing direct input to keyboard
DirectTeclat.SetCommonDataFormat DIFORMAT_KEYBOARD 'prepare keyboad data
DirectTeclat.SetCooperativeLevel Form1.hWnd, DISCL_NONEXCLUSIVE Or DISCL_BACKGROUND 'select working mode
 
 
 
 
 
 

CargarX "/torre.x" 'call to CargarX function
FrameCargar.SetPosition FramePrincipal, 0, 0, 0 
'FrameCargar.SetRotation FramePrincipal, 0, 1, 0, 0.01 ' DELETE THIS LINE       DELETE THIS LINE         DELETE THIS LINE
Camara.SetPosition FramePrincipal, 0, 0, -300 
luzdirecciona 0.8, 0.8, 0.8 
LuzAmbiente 0.1, 0.1, 0.1 
End Function

Public Function Accion()
RMViewport.Clear D3DRMCLEAR_TARGET Or D3DRMCLEAR_ZBUFFER 
RMDevice.Update 
RMViewport.Render FramePrincipal 
Ddrm.Tick 1
 

KeyPresset 'Call Keypresset function 'New parameters
 

DDsurface.Flip Nothing, DDFLIP_WAIT
End Function

Public Function CargarX(StrNombreX As String)
Set FrameCargar = Ddrm.CreateFrame(FramePrincipal) 
Set MeshCargar = Ddrm.CreateMeshBuilder() 
MeshCargar.LoadFromFile App.Path & StrNombreX, 0, D3DRMLOAD_ASYNCHRONOUS, Textureim, Nothing

MeshCargar.SetPerspective D_TRUE
FrameCargar.AddVisual MeshCargar 
End Function

Public Function LuzAmbiente(rojo As Single, verde As Single, Blue As Single)
Set LuzAmbiental = Ddrm.CreateLightRGB(D3DRMLIGHT_AMBIENT, rojo, verde, Blue) 
FramePrincipal.AddLight LuzAmbiental 
End Function

Public Function luzdirecciona(rojo As Single, verde As Single, azul As Single)
Set Luz1 = Ddrm.CreateLightRGB(D3DRMLIGHT_POINT, rojo, verde, azul) 
Luz1.SetUmbra 0.0001 
Luz1.SetPenumbra 0.0001
Camara.AddLight Luz1
End Function
 

Public Function KeyPresset()
DirectTeclat.Acquire 'Get keyboard
DirectTeclat.GetDeviceStateKeyboard EstatTeclat 'Select the presset keys
If EstatTeclat.Key(1) <> 0 Then 'ESC to end program
Discharge
End If
'Keys Movemente ,arrow keys and pageup, pagedown
If EstatTeclat.Key(200) <> 0 Then
Camara.AddTranslation D3DRMCOMBINE_BEFORE, 0, 0, 2
End If

If EstatTeclat.Key(208) <> 0 Then
Camara.AddTranslation D3DRMCOMBINE_BEFORE, 0, 0, -2
End If

If EstatTeclat.Key(205) <> 0 Then
Camara.AddRotation D3DRMCOMBINE_BEFORE, 0, 1, 0, 0.01
End If

If EstatTeclat.Key(203) <> 0 Then
Camara.AddRotation D3DRMCOMBINE_BEFORE, 0, 1, 0, -0.01
End If

If EstatTeclat.Key(201) <> 0 Then 
Camara.AddRotation D3DRMCOMBINE_BEFORE, 1, 0, 0, -0.01
End If
 

If EstatTeclat.Key(209) <> 0 Then
Camara.AddRotation D3DRMCOMBINE_BEFORE, 1, 0, 0, 0.01
End If
 

'Write the presset key on screen
For Bucle = 0 To 255
If EstatTeclat.Key(Bucle) <> 0 Then
LettersWriter 100, 150, CStr(Bucle), 2500
End If
Next Bucle
End Function
 

Public Function LettersWriter(StrPosicioX As String, StrPosicioY As String, StrText As String, SngColor As Single)
'Write something  in the specified position

DDsurfacesec.SetForeColor SngColor
DDsurfacesec.DrawText StrPosicioX, StrPosicioY, StrText, False
End Function
 

Public Function Discharge()
'discharge DirectX
DirectTeclat.Unacquire 'Returns the keyboard control

Ddraw.RestoreAllSurfaces
Set DirecInput = Nothing
Set DirectTeclat = Nothing

Set FramePrincipal = Nothing
Set Camara = Nothing
Set DDclipper = Nothing
Set DDsurface = Nothing
Set DDsurfacesec = Nothing
Set RMDevice = Nothing
Set RMViewport = Nothing
Set Ddrm = Nothing
Set Ddraw = Nothing
Set Direct = Nothing
End
End Function
 
 
 
Free movement
Free movement

 

You can download a source code.
 

by Necro_
www.sorgonet.com