Membuat Bangun 3D OpenGL dengan Visual Basic

script pada modul :

 'VARIABEL Buatan
Public Type Titik3D
x As Single
y As Single
z As Single
End Type


Public Type Sisi
Sisi_Depan(1 To 4) As Titik3D
Sisi_Kanan(1 To 4) As Titik3D
Sisi_Belakang(1 To 4) As Titik3D
Sisi_Kiri(1 To 4) As Titik3D
Sisi_Atas(1 To 4) As Titik3D
Sisi_Bawah(1 To 4) As Titik3D


limas_depan(1 To 3) As Titik3D
limas_belakang(1 To 3) As Titik3D
limas_kanan(1 To 3) As Titik3D
limas_kiri(1 To 3) As Titik3D


End Type


Public Objek As Sisi, Limas As Sisi


Sub EnableOpenGL(ghDC As Long)
Dim pfd As PIXELFORMATDESCRIPTOR


ZeroMemory pfd, Len(pfd)
pfd.nSize = Len(pfd)
pfd.nVersion = 1
pfd.dwFlags = PFD_DRAW_TO_WINDOW Or FD_SUPPORT_OPENGL Or PFD_DOUBLEBUFFER
pfd.iPixelType = PFD_TYPE_RGBA
pfd.cColorBits = 24
pfd.cDepthBits = 32
pfd.iLayerType = PFD_MAIN_PLANE


PixFormat = ChoosePixelFormat(ghDC, pfd)
If PixFormat = 0 Then GoTo ee
SetPixelFormat ghDC, PixFormat, pfd
hrc = wglCreateContext(ghDC)
wglMakeCurrent ghDC, hrc


Exit Sub
End
End Sub


Sub DisableOpenGL()
wglMakeCurrent 0, 0
wglDeleteContext hrc
End Sub

Script pada Form :

Sub Inisialisasi_Awal()
'========== Inisialisasi ==========
EnableOpenGL Me.hDC

hrc = wglCreateContext(hDC)
wglMakeCurrent hDC, hrc

'Inisilisasi Koordinat Bidang Dimensi-3
xmin = -10: ymin = -10
xmax = 20: ymax = 20
zmin = 10: zmax = -10
glOrtho xmin, xmax, ymin, ymax, zmin, zmax

glClearColor 0.6, 0.6, 0.6, 0
glClear GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT

glClear clrColorBufferBit
glMatrixMode GL_PROJECTION
glLoadIdentity
End Sub

Sub Bersihkan_Layar()
glClearColor 0.6, 0.6, 0.6, 0
glClear GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT
End Sub

Sub Tampilkan_Gambar()
'Menampilkan Hasil
glFlush
SwapBuffers Me.hDC
End Sub

Sub Membuat_Titik()

'======LIMAS======

'titik 1 limas depan
Limas.limas_depan(1).x = 0
Limas.limas_depan(1).y = 7
Limas.limas_depan(1).z = 0

'titik 2 limas depan
With Limas.limas_depan(2)
.x = 7
.y = 7
.z = 0
End With

'titik 3 limas depan
With Limas.limas_depan(3)
.x = 3.5
.y = 18
.z = 3.5
End With

'titik 1 limas kanan
Limas.limas_kanan(1).x = 7
Limas.limas_kanan(1).y = 7
Limas.limas_kanan(1).z = 0

'titik 2 limas kanan
With Limas.limas_kanan(2)
.x = 7
.y = 7
.z = 7
End With

'titik 3 limas kanan
With Limas.limas_kanan(3)
.x = 3.5
.y = 18
.z = 3.5
End With

'titik 1 limas kiri
Limas.limas_kiri(1).x = 0
Limas.limas_kiri(1).y = 7
Limas.limas_kiri(1).z = 0

'titik 2 limas kiri
With Limas.limas_kiri(2)
.x = 0
.y = 7
.z = 7
End With

'titik 3 limas kiri
With Limas.limas_kiri(3)
.x = 3.5
.y = 18
.z = 3.5
End With

'titik 1 limas belakang
Limas.limas_belakang(1).x = 0
Limas.limas_belakang(1).y = 7
Limas.limas_belakang(1).z = 7

'titik 2 limas belakang
With Limas.limas_belakang(2)
.x = 7
.y = 7
.z = 7
End With

'titik 3 limas belakang
With Limas.limas_belakang(3)
.x = 3.5
.y = 18
.z = 3.5
End With


'=======KUBUS===========
'titik 1 bagian depan
Objek.Sisi_Depan(1).x = 0
Objek.Sisi_Depan(1).y = 0
Objek.Sisi_Depan(1).z = 0

'titik 2 bagian depan
Objek.Sisi_Depan(2).x = 7
Objek.Sisi_Depan(2).y = 0
Objek.Sisi_Depan(2).z = 0

'titik 3 bagian depan
With Objek.Sisi_Depan(3)
.x = 7
.y = 7
.z = 0
End With
'titik 4 bagian depan
With Objek.Sisi_Depan(4)
.x = 0
.y = 7
.z = 0
End With

'titik 1 bagian belakang
Objek.Sisi_Belakang(1).x = 0
Objek.Sisi_Belakang(1).y = 0
Objek.Sisi_Belakang(1).z = 7

'titik 2 bagian belakang
Objek.Sisi_Belakang(2).x = 7
Objek.Sisi_Belakang(2).y = 0
Objek.Sisi_Belakang(2).z = 7

'titik 3 bagian belakang
With Objek.Sisi_Belakang(3)
.x = 7
.y = 7
.z = 7
End With
'titik 4 bagian belakang
With Objek.Sisi_Belakang(4)
.x = 0
.y = 7
.z = 7
End With

'titik 1 bagian atas
Objek.Sisi_Atas(1).x = 0
Objek.Sisi_Atas(1).y = 7
Objek.Sisi_Atas(1).z = 0

'titik 2 bagian atas
Objek.Sisi_Atas(2).x = 7
Objek.Sisi_Atas(2).y = 7
Objek.Sisi_Atas(2).z = 0

'titik 3 bagian atas
With Objek.Sisi_Atas(3)
.x = 7
.y = 7
.z = 7
End With
'titik 4 bagian atas
With Objek.Sisi_Atas(4)
.x = 0
.y = 7
.z = 7
End With

'titik 1 bagian bawah
Objek.Sisi_Bawah(1).x = 0
Objek.Sisi_Bawah(1).y = 0
Objek.Sisi_Bawah(1).z = 0

'titik 2 bagian bawah
Objek.Sisi_Bawah(2).x = 7
Objek.Sisi_Bawah(2).y = 0
Objek.Sisi_Bawah(2).z = 0

'titik 3 bagian bawah
With Objek.Sisi_Bawah(3)
.x = 7
.y = 0
.z = 7
End With
'titik 4 bagian bawah
With Objek.Sisi_Bawah(4)
.x = 0
.y = 0
.z = 7
End With


'titik 1 bagian kanan
Objek.Sisi_Kanan(1).x = 7
Objek.Sisi_Kanan(1).y = 0
Objek.Sisi_Kanan(1).z = 0

'titik 2 bagian kanan
Objek.Sisi_Kanan(2).x = 7
Objek.Sisi_Kanan(2).y = 0
Objek.Sisi_Kanan(2).z = 7

'titik 3 bagian kanan
With Objek.Sisi_Kanan(3)
.x = 7
.y = 7
.z = 7
End With
'titik 4 bagian kanan
With Objek.Sisi_Kanan(4)
.x = 7
.y = 7
.z = 0
End With

'titik 1 bagian kiri
Objek.Sisi_Kiri(1).x = 0
Objek.Sisi_Kiri(1).y = 0
Objek.Sisi_Kiri(1).z = 0

'titik 2 bagian kiri
Objek.Sisi_Kiri(2).x = 0
Objek.Sisi_Kiri(2).y = 0
Objek.Sisi_Kiri(2).z = 7

'titik 3 bagian kiri
With Objek.Sisi_Kiri(3)
.x = 0
.y = 7
.z = 7
End With
'titik 4 bagian kiri
With Objek.Sisi_Kiri(4)
.x = 0
.y = 7
.z = 0
End With

End Sub

Private Sub Command1_Click()
Call Membuat_Titik
Call Inisialisasi_Awal

glRotatef -10, 20, 20, 1

glColor3f 1, 0.6, 0
glBegin bmPolygon
For ttk = 1 To 4
With Objek.Sisi_Kanan(ttk)
glVertex3f .x, .y, .z
End With
Next ttk
glEnd

glColor3f 0.7, 0, 0
glBegin bmPolygon
For ttk = 1 To 4
With Objek.Sisi_Belakang(ttk)
glVertex3f .x, .y, .z
End With
Next ttk
glEnd

glColor3f 1, 0.8, 0
glBegin bmPolygon
For ttk = 1 To 4
With Objek.Sisi_Bawah(ttk)
glVertex3f .x, .y, .z
End With
Next ttk
glEnd

glColor3f 1, 1, 0
glBegin bmPolygon
For ttk = 1 To 4
With Objek.Sisi_Kiri(ttk)
glVertex3f .x, .y, .z
End With
Next ttk
glEnd

glColor3f 1, 0, 0.3
glBegin bmPolygon
For ttk = 1 To 4
With Objek.Sisi_Atas(ttk)
glVertex3f .x, .y, .z
End With
Next ttk
glEnd

glColor3f 0, 1, 0.4
glBegin bmPolygon
For ttk = 1 To 4
With Objek.Sisi_Depan(ttk)
glVertex3f .x, .y, .z
End With
Next ttk
glEnd

'=============limas====

glColor3f 0, 0, 0.7
glBegin bmTriangles
For ttk = 1 To 3
With Limas.limas_belakang(ttk)
glVertex3f .x, .y, .z
End With
Next ttk
glEnd

glColor3f 0, 1, 1
glBegin bmTriangles
For ttk = 1 To 3
With Limas.limas_kanan(ttk)
glVertex3f .x, .y, .z
End With
Next ttk
glEnd

glColor3f 1, 0, 0.4
glBegin bmTriangles
For ttk = 1 To 3
With Limas.limas_depan(ttk)
glVertex3f .x, .y, .z
End With
Next ttk
glEnd


glColor3f 0, 0.2, 0
glBegin bmTriangles
For ttk = 1 To 3
With Limas.limas_kiri(ttk)
glVertex3f .x, .y, .z
End With
Next ttk
glEnd


Call Tampilkan_Gambar

End Sub

Hasil :