Hi Alex,
ich habe mal etwas daran herumgefummelt … Bin begeistert!
Ich habe jetzt eine 3D-Landschaft, Farbverläufe (unten dunkel oben hell) kann die drehen, kippen, nach rechts und links schieben und auch zoomen.
Auch bei Vollbild ist die Geschwindigleit in Ordnung … Perfekt!
Danke!
Da nun noch Werners Daten eintragen und eine echte Landschaft betrachten ist nun super einfach.
Gruß Rainer
Für Werner noch die Codeänderung, einfach wie von Alex verlinkt laden und damit überschreiben …
Form:
Private Sub Form\_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then
PrgRun = False
End If
Select Case KeyCode
Case Asc("L")
WX = WX + 1
Case Asc("R")
WX = WX - 1
Case Asc("U")
WY = WY + 1
Case Asc("D")
WY = WY - 1
Case Asc("F")
DY = DY + 0.1
Case Asc("B")
DY = DY - 0.1
Case 37
DX = DX - 0.1
Case 39
DX = DX + 0.1
Case 38
DZ = DZ + 0.1
Case 40
DZ = DZ - 0.1
End Select
End Sub
Private Sub Form\_Resize()
ReSizeGLScene ScaleWidth, ScaleHeight
End Sub
Modul:
Global PrgRun As Boolean 'Flag = Programm läuft
Public WX As Integer
Public WY As Integer
Public DX As Double
Public DY As Double
Public DZ As Double
Private hrc As Long
Public Sub Main()
Dim frm As Form
Dim cx As Double
Dim cy As Double
Dim h(200) As Double
Dim i As Integer
PrgRun = True
Set frm = New Form1
frm.ScaleMode = vbPixels
Randomize Timer
For i = 0 To 199
h(i) = Rnd(1)
Next
DX = -1
DY = -12
If CreateGLWindow(frm, 640, 480, 16) Then
Do
glClear clrColorBufferBit Or clrDepthBufferBit
glLoadIdentity
glTranslatef DX, DZ, DY
glRotatef WX, 0#, 1#, 0#
glRotatef WY, 1#, 0#, 0#
glBegin bmQuads
For cx = -5 To 5
For cy = -5 To 5
glColor3f h(cx + 5 + 10 \* (cy + 5)), h(cx + 5 + 10 \* (cy + 5)), h(cx + 5 + 10 \* (cy + 5))
glVertex3f cx, h(cx + 5 + 10 \* (cy + 5)), cy
glColor3f h(cx + 5 + 10 \* (cy + 5 + 1)), h(cx + 5 + 10 \* (cy + 5 + 1)), h(cx + 5 + 10 \* (cy + 5 + 1))
glVertex3f cx, h(cx + 5 + 10 \* (cy + 5 + 1)), cy + 1
glColor3f h(cx + 5 + 1 + 10 \* (cy + 5 + 1)), h(cx + 5 + 1 + 10 \* (cy + 5 + 1)), h(cx + 5 + 1 + 10 \* (cy + 5 + 1))
glVertex3f cx + 1, h(cx + 5 + 1 + 10 \* (cy + 5 + 1)), cy + 1
glColor3f h(cx + 5 + 1 + 10 \* (cy + 5)), h(cx + 5 + 1 + 10 \* (cy + 5)), h(cx + 5 + 1 + 10 \* (cy + 5))
glVertex3f cx + 1, h(cx + 5 + 1 + 10 \* (cy + 5)), cy
Next
Next
glEnd
SwapBuffers (frm.hDC)
DoEvents
Loop While PrgRun
If hrc 0 Then
wglMakeCurrent 0, 0
wglDeleteContext (hrc)
End If
Unload frm
Set frm = Nothing
End
End If
End Sub
Public Function CreateGLWindow(frm As Form, Width As Integer, Height As Integer, Bits As Integer) As Boolean
Dim pfd As PIXELFORMATDESCRIPTOR
Dim PixelFormat As GLuint
pfd.cColorBits = Bits
pfd.cDepthBits = 16
pfd.dwFlags = PFD\_DRAW\_TO\_WINDOW Or PFD\_SUPPORT\_OPENGL Or PFD\_DOUBLEBUFFER
pfd.iLayerType = PFD\_MAIN\_PLANE
pfd.iPixelType = PFD\_TYPE\_RGBA
pfd.nSize = Len(pfd)
pfd.nVersion = 1
PixelFormat = ChoosePixelFormat(frm.hDC, pfd)
If PixelFormat 0 Then
If SetPixelFormat(frm.hDC, PixelFormat, pfd) 0 Then
hrc = wglCreateContext(frm.hDC)
If hrc 0 Then
If wglMakeCurrent(frm.hDC, hrc) 0 Then
frm.Show
glShadeModel smSmooth
glClearColor 0#, 0#, 0#, 0#
glClearDepth 1#
glEnable glcDepthTest
glDepthFunc cfLEqual
glHint htPerspectiveCorrectionHint, hmNicest
CreateGLWindow = True
End If
End If
End If
End If
End Function
Public Sub ReSizeGLScene(ByVal Width As GLsizei, ByVal Height As GLsizei)
If Height = 0 Then
Height = 1
End If
glViewport 0, 0, Width, Height
glMatrixMode mmProjection
glLoadIdentity
gluPerspective 45#, Width / Height, 0.1, 100#
glMatrixMode mmModelView
glLoadIdentity
End Sub
Entweder bekommt man ein Gitter mit wenig Polygonen oder das ganze wird tränig langsam. Das dann noch mit ‚Würfelgraphik‘ in 600X400 … Da hält sich mein Interesse in Grenzen.