Страница: 1 | 2 |
|
Вопрос: Игры на VBNet
|
Добавлено: 04.06.06 11:19
|
|
Автор вопроса: Nikolai
|
Вообще можно ли сделать какую нибудь игру на VBNet
Наподобии Героев 5 или от первого лица да плювать
хоть 2-х мерную для начала.
Ответить
|
Номер ответа: 1 Автор ответа: a
ICQ: 267-795-129
Вопросов: 2 Ответов: 5
|
Профиль | | #1
|
Добавлено: 04.06.06 12:26
|
Если у тебя много нервных клеток,собственный завод по производству пива,уйма свободного времени,ОГРОМНОЕ желание сделать игру тогда можно !
вот тебе для примера код. самолёт летит простое управление и нечего больше ! (между прочим скачено на этом сайте в разделе примеры)
Поверь в героях 5 операторов на мнооооооооооооооооооооооооооооооооооооооооооооооооооооого больше !!!
ТАК что вот так !
Private Sub Form_Load()
Me.Caption = "Инициализация DirectX..."
Me.Show
Running = True
Inits.InitDI
Select Case frmOpt.lstDevice.ListIndex
Case 0
rdev = "IID_IDirect3DHALDevice"
Case 1
rdev = "IID_IDirect3DRGBDevice"
Case 2
rdev = "IID_IDirect3DMMXDevice"
End Select
Select Case frmOpt.lstRes.ListIndex
Case 0
screenX = 320: screenY = 240: screenBPP = 16
Case 1
screenX = 320: screenY = 240: screenBPP = 32
Case 2
screenX = 640: screenY = 480: screenBPP = 16
Case 3
screenX = 640: screenY = 480: screenBPP = 32
Case 4
screenX = 800: screenY = 600: screenBPP = 16
Case 5
screenX = 800: screenY = 600: screenBPP = 32
Case 6
screenX = 1024: screenY = 768: screenBPP = 16
Case 7
screenX = 1024: screenY = 768: screenBPP = 32
End Select
Select Case frmOpt.Windowed.Value
Case 0
Inits.InitFullScreen Me.hWnd, screenX, screenY, screenBPP, rdev
Case 1
screenX = Me.ScaleWidth: screenY = Me.ScaleHeight
Inits.InitWindowed Me, rdev
End Select
5 Scenes.SetDefaults
Scenes.CreateObjects
Select Case frmOpt.lstShading.ListIndex
Case 0
Device.SetQuality D3DRMRENDER_FLAT
Case 1
Device.SetQuality D3DRMRENDER_GOURAUD
Case 2
Device.SetQuality D3DRMRENDER_PHONG
End Select
Select Case rdev
Case "IID_IDirect3DHALDevice"
dname = "irect3D HAL"
Case "IID_IDirect3DRGBDevice"
dname = "RGB Emulation"
Case "IID_IDirect3DMMXDevice"
dname = "MMX Driver"
End Select
Select Case frmOpt.Dither.Value
Case 0
Device.SetDither D_FALSE
Case 1
Device.SetDither D_TRUE
End Select
Me.Caption = "irect3DRM Engine"
Me.Caption = Me.Caption & " - " & dname & " - " & screenX & "x" & screenY
If frmOpt.Windowed.Value = 1 Then Unload frmOpt: RunWindowed Else Unload frmOpt: Run
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Running = False
End Sub
Sub Run()
Do While Running = True
 oEvents
Inits.GetFPS
Scene.Move 1
Inits.DX_input
Viewport.Clear D3DRMCLEAR_TARGET Or D3DRMCLEAR_ZBUFFER
 evice.Update
Viewport.Render Scene
dds4Primary.Flip Nothing, DDFLIP_WAIT
Loop
Inits.KillObjects
End
End Sub
Sub RunWindowed()
Do While Running = True
DoEvents
Inits.DX_input_windowed
d3drm.Tick 1
Loop
Inits.KillObjects
End
End Sub
форма опций
Private Sub Form_Load()
lstDevice.ListIndex = 0
lstRes.ListIndex = 2
lstShading.ListIndex = 1
Me.Caption = Me.Caption & " v. " & App.Major & "." & App.Minor & "." & App.Revision & " [Fligth Simulator]"
End Sub
Private Sub Windowed_Click()
Select Case Windowed.Value
Case 0
lstRes.Enabled = True
Case 1
lstRes.Enabled = False
End Select
End Sub
модуль 1
Option Explicit
Public dx As New DirectX7
Public dd7 As DirectDraw7
Public dd4 As DirectDraw4
Public d3drm As Direct3DRM3
Public ddsd As DDSURFACEDESC2
Public Caps As DDSCAPS2
Public Device As Direct3DRMDevice3
Public dds4Primary As DirectDrawSurface4
Public dds4Back As DirectDrawSurface4
Public Viewport As Direct3DRMViewport2
Public Clipper As DirectDrawClipper
Public Scene As Direct3DRMFrame3
Public Camera As Direct3DRMFrame3
Public DI As DirectInput
Public DIdevice As DirectInputDevice
Public DIState As DIKEYBOARDSTATE
Public dname As String
Public screenX As Long: Public screenY As Long: Public screenBPP As Long
Public rdev As String
Dim lastFPS As Long
Dim fps As Single
Public Running As Boolean
Public dAng: Public lAng: Public ZAng
Public ZPos: Public Pos: Public Pos2: Public Pos3
Sub Main()
frmOpt.Show
End Sub
Public Sub InitFullScreen(hWnd As Long, sX As Long, sY As Long, sBitDepth As Long, d As String)
Set dd4 = dx.DirectDraw4Create(""
Call dd4.SetCooperativeLevel(hWnd, DDSCL_EXCLUSIVE Or DDSCL_FULLSCREEN Or DDSCL_ALLOWREBOOT)
Call dd4.SetDisplayMode(sX, sY, sBitDepth, 0, DDSDM_DEFAULT)
ddsd.lFlags = DDSD_BACKBUFFERCOUNT Or DDSD_CAPS
ddsd.ddsCaps.lCaps = DDSCAPS_COMPLEX Or DDSCAPS_FLIP Or DDSCAPS_PRIMARYSURFACE Or DDSCAPS_3DDEVICE
ddsd.lBackBufferCount = 1
Set dds4Primary = dd4.CreateSurface(ddsd)
Caps.lCaps = DDSCAPS_BACKBUFFER Or DDSCAPS_3DDEVICE
Set dds4Back = dds4Primary.GetAttachedSurface(Caps)
'D3DRM
Set d3drm = dx.Direct3DRMCreate()
Set Scene = d3drm.CreateFrame(Nothing)
Set Camera = d3drm.CreateFrame(Scene)
Set Device = d3drm.CreateDeviceFromSurface(d, dd4, dds4Back, D3DRMDEVICE_DEFAULT)
Set Viewport = d3drm.CreateViewport(Device, Camera, 0, 0, sX, sY)
End Sub
Public Sub InitWindowed(Window As Form, d As String) 'Direct3D:RM в окне
Set dd7 = dx.DirectDrawCreate(""
Set Clipper = dd7.CreateClipper(0)
Clipper.SetHWnd Window.hWnd
'D3DRM
Set d3drm = dx.Direct3DRMCreate
Set Device = d3drm.CreateDeviceFromClipper(Clipper, d, Window.ScaleWidth, Window.ScaleHeight)
Set Scene = d3drm.CreateFrame(Nothing)
Set Camera = d3drm.CreateFrame(Scene)
Set Viewport = d3drm.CreateViewport(Device, Camera, 0, 0, Device.GetWidth, Device.GetHeight)
End Sub
Public Sub InitDI()
Set DI = dx.DirectInputCreate
Set DIdevice = DI.CreateDevice("GUID_SysKeyboard"
DIdevice.SetCommonDataFormat DIFORMAT_KEYBOARD
DIdevice.SetCooperativeLevel frmMain.hWnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE
DIdevice.Acquire
End Sub
Public Sub KillObjects()
Set Viewport = Nothing
Set Device = Nothing
Set d3drm = Nothing
Set dd4 = Nothing
Set dd7 = Nothing
DIdevice.Unacquire
End Sub
Public Sub DX_input()
DIdevice.GetDeviceStateKeyboard DIState
If DIState.Key(DIK_ESCAPE) <> 0 Then Running = False
If DIState.Key(DIK_R) <> 0 Then
dds4Primary.SetForeColor RGB(255, 255, 0)
dds4Primary.DrawText 10, 10, fps & " FPS" & " (" & screenX & "x" & screenY & "x" & screenBPP & " " & dname, False
End If
If DIState.Key(DIK_UP) <> 0 Then
dAng = dAng + 0.01
World.AddRotation D3DRMCOMBINE_REPLACE, 1, 0, 0, dAng
World.AddRotation D3DRMCOMBINE_BEFORE, 0, 0, 1, lAng
End If
If DIState.Key(DIK_DOWN) <> 0 Then
dAng = dAng - 0.01
World.AddRotation D3DRMCOMBINE_REPLACE, 1, 0, 0, dAng
World.AddRotation D3DRMCOMBINE_BEFORE, 0, 0, 1, lAng
End If
If DIState.Key(DIK_LEFT) <> 0 Then
lAng = lAng + 0.01
World.AddRotation D3DRMCOMBINE_REPLACE, 1, 0, 0, dAng
World.AddRotation D3DRMCOMBINE_BEFORE, 0, 0, 1, lAng
End If
If DIState.Key(DIK_RIGHT) <> 0 Then
lAng = lAng - 0.01
World.AddRotation D3DRMCOMBINE_REPLACE, 1, 0, 0, dAng
World.AddRotation D3DRMCOMBINE_BEFORE, 0, 0, 1, lAng
End If
If DIState.Key(DIK_Z) <> 0 Then ZPos = ZPos + 0.01
If DIState.Key(DIK_X) <> 0 Then ZPos = ZPos - 0.01
If ZPos < 0 Then ZPos = 0.5
If lAng > 1 Then lAng = 1
If lAng < -1 Then lAng = -1
Pos = Pos + ZPos
Pos2 = Pos2 + -(dAng)
Pos3 = Pos3 + -(lAng) / 3
World.SetPosition Nothing, Pos3, Pos2, Pos
Camera.SetPosition Nothing, Pos3, Pos2, Pos - 20
LFrame.SetPosition Nothing, Pos3 - 300, Pos2 + 300, Pos - 100
LFrame2.SetPosition Nothing, Pos3, Pos2 - 30, Pos - 100
End Sub
Public Sub DX_input_windowed()
DIdevice.GetDeviceStateKeyboard DIState
If DIState.Key(DIK_ESCAPE) <> 0 Then Running = False
End Sub
Public Sub GetFPS()
Dim t As Long
t = dx.TickCount
Static fcount As Long
fcount = fcount + 1
If fcount = 30 Then
t = dx.TickCount()
fps = 30000 / (t - lastFPS)
fcount = 0
lastFPS = t
End If
End Sub
модуль 2
Public World As Direct3DRMFrame3
Public MeshBuilder As Direct3DRMMeshBuilder3
Public Light As Direct3DRMLight
Public LFrame As Direct3DRMFrame3
Public LandScape As Direct3DRMFrame3
Public MeshBuilder2 As Direct3DRMMeshBuilder3
Public Light2 As Direct3DRMLight
Public Sky As Direct3DRMTexture3
Public LFrame2 As Direct3DRMFrame3
Public Land As Direct3DRMTexture3
Public Wrap As Direct3DRMWrap
Sub SetDefaults()
'Camera position
Camera.SetPosition Nothing, 0, 1, -20
Set World = d3drm.CreateFrame(Scene)
Set LandScape = d3drm.CreateFrame(Scene)
Set Sky = d3drm.LoadTexture(App.Path + "\TEXTURES\sky.bmp"
Set Land = d3drm.LoadTexture(App.Path + "\TEXTURES\land.bmp"
Set Wrap = d3drm.CreateWrap(D3DRMWRAP_FLAT, Nothing, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0.05, 0.05)
'World.SetRotation Nothing, 0, 0, 0, 0.01
World.SetPosition Nothing, 0, 0, 0
LandScape.SetPosition Nothing, 0, -40, -1
Scene.AddLight d3drm.CreateLight(D3DRMLIGHT_AMBIENT, dx.CreateColorRGB(0.8, 0.8, 0.8))
Set MeshBuilder = d3drm.CreateMeshBuilder
Set MeshBuilder2 = d3drm.CreateMeshBuilder
'Light
Set LFrame = d3drm.CreateFrame(Scene)
Set LFrame2 = d3drm.CreateFrame(Scene)
Set Light = d3drm.CreateLightRGB(D3DRMLIGHT_POINT, 1, 1, 1)
Set Light2 = d3drm.CreateLightRGB(D3DRMLIGHT_POINT, 1, 1, 1)
LFrame.AddLight Light
LFrame2.AddLight Light2
Device.SetTextureQuality D3DRMTEXTURE_LINEAR
Scene.SetSceneBackgroundImage Sky
Viewport.SetBack 300
ZPos = 0.5
End Sub
Sub CreateObjects()
MeshBuilder.LoadFromFile App.Path + "\MODELS\747.x", 0, D3DRMLOAD_FROMFILE, Nothing, Nothing
MeshBuilder2.LoadFromFile App.Path + "\MODELS\rectan.x", 0, D3DRMLOAD_FROMFILE, Nothing, Nothing
'MeshBuilder.SetColorRGB 0.6, 0.7, 0.8
MeshBuilder.ScaleMesh 0.07, 0.07, 0.07
World.AddVisual MeshBuilder
MeshBuilder2.ScaleMesh 10000, 10000, 10000
MeshBuilder2.SetColorRGB 1, 1, 1
MeshBuilder2.SetPerspective D_TRUE
'MeshBuilder2.SetColorRGB 0.1, 1, 0.2
Wrap.Apply MeshBuilder2
MeshBuilder2.SetTexture Land
LandScape.AddVisual MeshBuilder2
'Camera.LookAt World, Nothing, D3DRMCONSTRAIN_Z
'MeshBuilder.Translate 1, 3, -2
End Sub
Ответить
|
Страница: 1 | 2 |
Поиск по форуму