Source Code
'Membuat Tipe Data Buatan (Structure)
Type Titik_2D
x As GLfloat
y As Single
End Type
Public P1 As Titik_2D, P2 As Titik_2D
Public p3 As Titik_2D, p4 As Titik_2D, p5 As Titik_2D, p6 As Titik_2D
Public P7 As Titik_2D, P8 As Titik_2D
Public Hasil As Titik_2D
Sub Geser_2D(Data As Titik_2D, m As Single, _
n As Single)
With Data
.x = .x + m
.y = .y + n
End With
End Sub
Sub Rotasi_Titik(Data As Titik_2D, Teta As Single)
Const Phi = 3.14159265358979
Dim Rad2Teta As Single
Rad2Teta = Teta * (Phi / 180)
With Data
Hasil.x = (.x * Cos(Rad2Teta)) + (.y * Sin(Rad2Teta))
Hasil.y = (-.x * Sin(Rad2Teta)) + (.y * Cos(Rad2Teta))
End With
End Sub
Sub Geser_Rotasi_Titik(Data As Titik_2D, Teta As Single, _
geser_x As Single, geser_y As Single)
Const Phi = 3.14159265358979
Dim Rad2Teta As Single
Rad2Teta = Teta * (Phi / 180)
With Data
Hasil.x = ((.x - geser_x) * Cos(Rad2Teta)) + _
((.y - geser_y) * Sin(Rad2Teta)) + geser_x
Hasil.y = (-(.x - geser_x) * Sin(Rad2Teta)) + _
((.y - geser_y) * Cos(Rad2Teta)) + geser_y
End With
End Sub
'Fungsi
Function Kali(x As Single, y As Single) As Double
Kali = x * y
End Function
'Procedure
Sub Jumlah(x As Single, y As Single, Hasil As Double)
Hasil = x + y
End Sub
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 PFD_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
ee: MsgBox "Nelze nastavit parametry pro zobrazení grafiky!"
End
End Sub
Sub DisableOpenGL()
wglMakeCurrent 0, 0
wglDeleteContext hrc
End Sub
'Dim s As Single
'Dim p As Single
Sub Inisialisasi()
Dim m As Integer
m = 6
EnableOpenGL Me.hDC
hrc = wglCreateContext(hDC)
wglMakeCurrent hDC, hrc
gluOrtho2D -m, m, -m, m
glClearColor 1, 1, 1, 1
glClear GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT
glMatrixMode GL_PROJECTION
glLoadIdentity
End Sub
Sub Tampilkan()
glFlush
SwapBuffers Me.hDC
End Sub
Private Sub Command2_Click()
End Sub
Private Sub Form_load()
Call Inisialisasi
'------ Membuat Garis -----------
'Sumbu X
Dim p1x As Single, p1y As Single
Dim p2x As Single, p2y As Single
p1x = -10
p1y = 0
p2x = 10
p2y = 0
glColor3f 0, 0, 1
glBegin bmLines
glVertex2f p1x, p1y
glVertex2f p2x, p2y
glEnd
'Sumbu X
Dim p3x As Single, p3y As Single
Dim p4x As Single, p4y As Single
p3x = 0
p3y = -10
p4x = 0
p4y = 10
glColor3f 1, 0, 0
glBegin bmLines
glVertex2f p3x, p3y
glVertex2f p4x, p4y
glEnd
Call Tampilkan
End Sub
'Private Sub Command2_Click()
'Dim d As Double
'd = InputBox("Masukkan Berapa derajat anda ingin merotasi?", "Ganti derajat")
'Text1.Text = d
'
'End Sub
Private Sub Command3_Click()
Timer1.Interval = 1000
End Sub
'
'Private Sub Form_load()
's = 0
'p = 0
'End Sub
Private Sub Text2_Change()
If Text2.Text >= 360 Then
Text2.Text = 0
End If
End Sub
Private Sub Text3_Change()
If Text3.Text >= 360 Then
Text3.Text = 0
End If
End Sub
Private Sub Timer1_Timer()
Call Inisialisasi
'---- titik 1 ------
P1.x = 4
P1.y = 4
Call Geser_Rotasi_Titik(P1, Val(Text2.Text), 0, 0)
glPointSize 15
glBegin bmLines
glVertex2f 0, 0
With Hasil
glVertex2f .x, .y
End With
P1.x = Hasil.x
P1.y = Hasil.y
glEnd
'---- titik 2 ------
P2.x = 4
P2.y = 1
Call Geser_Rotasi_Titik(P2, Val(Text3.Text), 0, 0)
glPointSize 15
glBegin bmLines
glVertex2f 0, 0
With Hasil
glVertex2f .x, .y
End With
P2.x = Hasil.x
P2.y = Hasil.y
glEnd
'---- titik 3 ------
p3.x = 1
p3.y = 1
Call Geser_Rotasi_Titik(p3, Val(Text3.Text), 0, 0)
glPointSize 15
glBegin bmLines
glVertex2f 0, 0
With Hasil
glVertex2f .x, .y
End With
p3.x = Hasil.x
p3.y = Hasil.y
glEnd
'---- titik 4 ------
p4.x = 1
p4.y = 4
Call Geser_Rotasi_Titik(p4, Val(Text3.Text), 0, 0)
glPointSize 15
glBegin bmLines
glVertex2f 0, 0
With Hasil
glVertex2f .x, .y
End With
p4.x = Hasil.x
p4.y = Hasil.y
glEnd
'---- titik 5 ------
p5.x = 3.5
p5.y = 3.5
Call Geser_Rotasi_Titik(p5, Val(Text3.Text), 0, 0)
glPointSize 15
glBegin bmLines
glVertex2f 0, 0
With Hasil
glVertex2f .x, .y
End With
p5.x = Hasil.x
p5.y = Hasil.y
glEnd
'---- titik 6 ------
p6.x = 3.5
p6.y = 1.5
Call Geser_Rotasi_Titik(p6, Val(Text3.Text), 0, 0)
glPointSize 15
glBegin bmLines
glVertex2f 0, 0
With Hasil
glVertex2f .x, .y
End With
p6.x = Hasil.x
p6.y = Hasil.y
glEnd
'---- titik 7 ------
P7.x = 1.5
P7.y = 1.5
Call Geser_Rotasi_Titik(P7, Val(Text3.Text), 0, 0)
glPointSize 15
glBegin bmLines
glVertex2f 0, 0
With Hasil
glVertex2f .x, .y
End With
P7.x = Hasil.x
P7.y = Hasil.y
glEnd
'---- titik 8 ------
P8.x = 1.5
P8.y = 3.5
Call Geser_Rotasi_Titik(P8, Val(Text3.Text), 0, 0)
glPointSize 15
glBegin bmLines
glVertex2f 0, 0
With Hasil
glVertex2f .x, .y
End With
P8.x = Hasil.x
P8.y = Hasil.y
glEnd
Text2.Text = Val(Text2.Text) + 20
Text3.Text = Val(Text3.Text) + 20
glColor3f 0, 0, 0
glBegin bmQuads
glVertex2f P1.x, P1.y
glVertex2f P2.x, P2.y
glVertex2f p3.x, p3.y
glVertex2f p4.x, p4.y
glEnd
glColor3f 0, 0, 1
glBegin bmQuads
glVertex2f p5.x, p5.y
glVertex2f p6.x, p6.y
glVertex2f P7.x, P7.y
glVertex2f P8.x, P8.y
glEnd
Call Tampilkan
If Option1.Value = False Then
Timer1.Interval = 0
End If
If Option2.Value = True Then
Timer1.Interval = 0
End If
End Sub
Download Disini
Tulisan By Munirmaestro
Selamat datang Di Blog Saya,Mohon LIKE atau Follow agar saling Kenal...Terimah kasih
Tidak ada komentar:
Posting Komentar