Geser Kotak dengan OpenGL di VB6

 

Source Code

Public Type Titik_2D

   x As GLfloat
   y As Single
End Type

Public P1 As Titik_2D, P2 As Titik_2D
Public Garis_Lurus() As Titik_2D, Kotak() As Titik_2D

'===== Pergerseran =====
Sub Geser(Titik As Titik_2D, m As Single, n As Single)
   With Titik
      .x = .x + m
      .y = .y + n
   End With
End Sub

Sub kotakB(m As Integer, n As Integer, Hasil_Kotak() As Titik_2D)
   'Inisialisasi Titik Kotak
   With Hasil_Kotak(1)
      .x = m - 2.5
      .y = n - 2.5

   End With
   With Hasil_Kotak(2)
      .x = m + 2.5
      .y = n - 2.5
   End With
   With Hasil_Kotak(3)
      .x = m + 2.5
      .y = n + 2.5
   End With
   With Hasil_Kotak(4)
      .x = m - 2.5
      .y = n + 2.5
   End With
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
Private Sub Command1_Click()

''gambar Lurus biasa
Call Inisialisasi
  glColor3f 0, 0, 1
   glPointSize 2
   glBegin bmLines
      glVertex2f -3, 6
      glVertex2f 3, 6
   glEnd

'Membuat garis lurus sumbu x
Dim i As Integer
   ReDim Garis_Lurus(-20 To 20) As Titik_2D
   For i = -20 To 20 Step 10
      With Garis_Lurus(i)
         .x = i
         .y = 0
      End With
   Next i

'2. membuat kotak
   ReDim Kotak(1 To 4) As Titik_2D
  
   For i = -20 To 20 Step 10
   
      Call kotakB(i, 0, Kotak)
      'menggambar kotak
      glBegin bmLineLoop
         With Kotak(1)
            glVertex2f .x, .y
         End With
        
         glVertex2f Kotak(2).x, Kotak(2).y
         glVertex2f Kotak(3).x, Kotak(3).y
         glVertex2f Kotak(4).x, Kotak(4).y
      glEnd

   Next i
   Call Tampilkan
   Timer1.Interval = 100
   letak = -20
   ReDim Kotak(1 To 4) As Titik_2D
End Sub

Private Sub Timer1_Timer()
   '======  membersihkan layar ======
   glClearColor 1, 1, 1, 1
   glClear GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT
   Call kotakB(letak, 0, Kotak)
   'menggambar kotak
   glBegin bmLineLoop
      With Kotak(1)
         glVertex2f .x, .y
      End With
      glVertex2f Kotak(2).x, Kotak(2).y
      glVertex2f Kotak(3).x, Kotak(3).y
      glVertex2f Kotak(4).x, Kotak(4).y
   glEnd

   Call Tampilkan
  
   letak = letak + 1
   If letak = 20 Then
      letak = letak * -1
   End If
End Sub

     

                                                                     Download Disini

      

Communitas IT Bangil

Tulisan By Munirmaestro

Selamat datang Di Blog Saya,Mohon LIKE atau Follow agar saling Kenal...Terimah kasih