home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / Images-in-196292162006.psc / Cube.frm < prev    next >
Text File  |  2006-01-05  |  12KB  |  403 lines
  1. VERSION 5.00
  2. Begin VB.Form frmMain 
  3.    BorderStyle     =   0  'None
  4.    ClientHeight    =   7995
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   7995
  8.    ControlBox      =   0   'False
  9.    Icon            =   "Cube.frx":0000
  10.    KeyPreview      =   -1  'True
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   533
  15.    ScaleMode       =   3  'Pixel
  16.    ScaleWidth      =   533
  17.    ShowInTaskbar   =   0   'False
  18.    StartUpPosition =   3  'Windows Default
  19. End
  20. Attribute VB_Name = "frmMain"
  21. Attribute VB_GlobalNameSpace = False
  22. Attribute VB_Creatable = False
  23. Attribute VB_PredeclaredId = True
  24. Attribute VB_Exposed = False
  25. Option Explicit
  26.  
  27. Private Type POINTAPI
  28.     X As Long
  29.     Y As Long
  30. End Type
  31. Private Declare Function SetCapture Lib "User32" (ByVal hwnd As Long) As Long
  32. Private Declare Function ReleaseCapture Lib "User32" () As Long
  33. Private Declare Function GetCursorPos Lib "User32" (lpPoint As POINTAPI) As Long
  34. Private Pt As POINTAPI
  35. Private xx As Long
  36. Private yy As Long
  37. Private capture As Integer
  38. Public Img1 As cTexture
  39. Public Img2 As cTexture
  40. Public Img3 As cTexture
  41. Public Img4 As cTexture
  42. Public Img5 As cTexture
  43. Public Img6 As cTexture
  44.  
  45. Public Function DrawGLScene() As Boolean
  46.  
  47.   Static xrot As GLfloat
  48.   Static yrot As GLfloat
  49.   Static zrot As GLfloat
  50.  
  51.     ' Clear the Img1buffer and the depth buffer
  52.     glClear clrColorBufferBit Or clrDepthBufferBit
  53.     ' Reset the modelview matrix
  54.     glLoadIdentity
  55.     
  56.     glTranslatef 0#, 0#, gflZ
  57.     ' Rotate the scene along the x and y axis
  58.     glRotatef xrot, 1#, 0#, 0#
  59.     glRotatef yrot, 0#, 1#, 0#
  60.         
  61.     ' Build a cube using quads
  62.     Img1.useTexture
  63.     
  64.     glBegin GL_QUADS
  65.     ' Img2 Face
  66.     glNormal3f 0#, 0#, 1#                              'Set the surface normal
  67.     glTexCoord2f 0#, 0#: glVertex3f -1#, -1#, 1#       'Bottom Left Of The Texture and Quad
  68.     glTexCoord2f 1#, 0#: glVertex3f 1#, -1#, 1#        'Bottom Right Of The Texture and Quad
  69.     glTexCoord2f 1#, 1#: glVertex3f 1#, 1#, 1#         'Top Right Of The Texture and Quad
  70.     glTexCoord2f 0#, 1#: glVertex3f -1#, 1#, 1#        'Top Left Of The Texture and Quad
  71.     
  72.     glEnd
  73.  
  74.     Img2.useTexture
  75.     
  76.     glBegin GL_QUADS
  77.     ' Img1 Face
  78.     glNormal3f 0#, 0#, -1#                             'Set the surface normal
  79.     glTexCoord2f 1#, 0#: glVertex3f -1#, -1#, -1#      'Bottom Right Of The Texture and Quad
  80.     glTexCoord2f 1#, 1#: glVertex3f -1#, 1#, -1#       'Top Right Of The Texture and Quad
  81.     glTexCoord2f 0#, 1#: glVertex3f 1#, 1#, -1#        'Top Left Of The Texture and Quad
  82.     glTexCoord2f 0#, 0#: glVertex3f 1#, -1#, -1#       'Bottom Left Of The Texture and Quad
  83.     
  84.     glEnd
  85.     
  86.     Img3.useTexture
  87.     
  88.     glBegin GL_QUADS
  89.     ' Top Face
  90.     glNormal3f 0#, 1#, 0#                              'Set the surface normal
  91.     glTexCoord2f 0#, 1#: glVertex3f -1#, 1#, -1#       'Top Left Of The Texture and Quad
  92.     glTexCoord2f 0#, 0#: glVertex3f -1#, 1#, 1#        'Bottom Left Of The Texture and Quad
  93.     glTexCoord2f 1#, 0#: glVertex3f 1#, 1#, 1#         'Bottom Right Of The Texture and Quad
  94.     glTexCoord2f 1#, 1#: glVertex3f 1#, 1#, -1#        'Top Right Of The Texture and Quad
  95.     
  96.     glEnd
  97.  
  98.     Img4.useTexture
  99.     
  100.     glBegin GL_QUADS
  101.     
  102.     ' Bottom Face
  103.     glNormal3f 0#, -1#, 0#                             'Set the surface normal
  104.     glTexCoord2f 1#, 1#: glVertex3f -1#, -1#, -1#      'Top Right Of The Texture and Quad
  105.     glTexCoord2f 0#, 1#: glVertex3f 1#, -1#, -1#       'Top Left Of The Texture and Quad
  106.     glTexCoord2f 0#, 0#: glVertex3f 1#, -1#, 1#        'Bottom Left Of The Texture and Quad
  107.     glTexCoord2f 1#, 0#: glVertex3f -1#, -1#, 1#       'Bottom Right Of The Texture and Quad
  108.     
  109.     glEnd
  110.  
  111.     Img5.useTexture
  112.     
  113.     glBegin GL_QUADS
  114.     ' Right face
  115.     glNormal3f 1#, 0#, 0#                              'Set the surface normal
  116.     glTexCoord2f 1#, 0#: glVertex3f 1#, -1#, -1#       'Bottom Right Of The Texture and Quad
  117.     glTexCoord2f 1#, 1#: glVertex3f 1#, 1#, -1#        'Top Right Of The Texture and Quad
  118.     glTexCoord2f 0#, 1#: glVertex3f 1#, 1#, 1#         'Top Left Of The Texture and Quad
  119.     glTexCoord2f 0#, 0#: glVertex3f 1#, -1#, 1#        'Bottom Left Of The Texture and Quad
  120.     
  121.     glEnd
  122.     
  123.     Img6.useTexture
  124.     
  125.     glBegin GL_QUADS
  126.         
  127.     ' Left Face
  128.     glNormal3f -1#, 0#, 0#                             'Set the surface normal
  129.     glTexCoord2f 0#, 0#: glVertex3f -1#, -1#, -1#      'Bottom Left Of The Texture and Quad
  130.     glTexCoord2f 1#, 0#: glVertex3f -1#, -1#, 1#       'Bottom Right Of The Texture and Quad
  131.     glTexCoord2f 1#, 1#: glVertex3f -1#, 1#, 1#        'Top Right Of The Texture and Quad
  132.     glTexCoord2f 0#, 1#: glVertex3f -1#, 1#, -1#       'Top Left Of The Texture and Quad
  133.     glEnd
  134.     
  135.     xrot = xrot + gflXSpeed
  136.     yrot = yrot + gflYSpeed
  137.     
  138.     DrawGLScene = True
  139.  
  140. End Function
  141.  
  142. Public Function InitGL() As Boolean
  143.  
  144.   Dim aflLightAmbient(4) As GLfloat
  145.   Dim aflLightDiffuse(4) As GLfloat
  146.   Dim aflLightPosition(4) As GLfloat
  147.     
  148.     ' Create new texture
  149.     Set Img1 = New cTexture
  150.     Set Img2 = New cTexture
  151.     Set Img3 = New cTexture
  152.     Set Img4 = New cTexture
  153.     Set Img5 = New cTexture
  154.     Set Img6 = New cTexture
  155.     
  156.     '    Img1.loadTexture App.Path & "\Data\Crate.tga", FILETYPE_TGA
  157.     Img1.loadTexture App.Path & "\Side 1.bmp", 0 'FILETYPE_TGA
  158.     Img2.loadTexture App.Path & "\Side 2.bmp", 0 'FILETYPE_TGA
  159.     Img3.loadTexture App.Path & "\Side 3.bmp", 0 'FILETYPE_TGA
  160.     Img4.loadTexture App.Path & "\Side 4.bmp", 0 'FILETYPE_TGA
  161.     Img5.loadTexture App.Path & "\Side 5.bmp", 0 'FILETYPE_TGA
  162.     Img6.loadTexture App.Path & "\Side 6.bmp", 0 'FILETYPE_TGA
  163.  
  164.     ' Enable texture mapping
  165.     glEnable glcTexture2D
  166.     ' Smooth shading
  167.     glShadeModel smSmooth
  168.     
  169.     ' Set the clear colour
  170.     glClearColor 0#, 0#, 0#, 0#
  171.     ' Set the clear depth
  172.     glClearDepth 1#
  173.     
  174.     ' Enable Z-buffer
  175.     glEnable glcDepthTest
  176.     ' Set test type
  177.     glDepthFunc cfLEqual
  178.     ' Best perspective correction
  179.     glHint htPerspectiveCorrectionHint, hmNicest
  180.       
  181.     ' Ambient light settings
  182.     aflLightAmbient(0) = 0.5
  183.     aflLightAmbient(1) = 0.5
  184.     aflLightAmbient(2) = 0.5
  185.     aflLightAmbient(3) = 1#
  186.     ' Diffuse light settings
  187.     aflLightDiffuse(0) = 1#
  188.     aflLightDiffuse(1) = 1#
  189.     aflLightDiffuse(2) = 1#
  190.     aflLightDiffuse(3) = 1#
  191.     ' Light position settings
  192.     aflLightPosition(0) = 0#
  193.     aflLightPosition(1) = 0#
  194.     aflLightPosition(2) = 2#
  195.     aflLightPosition(3) = 1#
  196.       
  197.     ' Set the light's ambient and diffuse levels and its position
  198.     glLightfv ltLight1, lpmAmbient, aflLightAmbient(0)
  199.     glLightfv ltLight1, lpmDiffuse, aflLightDiffuse(0)
  200.     glLightfv ltLight1, lpmPosition, aflLightPosition(0)
  201.     
  202.     ' Enable light1
  203.     glEnable glcLight1
  204.     
  205.     InitGL = True
  206.  
  207. End Function
  208.  
  209. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  210.  
  211.   ' Set the key to be pressed
  212.  
  213.     gbKeys(KeyCode) = True
  214.  
  215. End Sub
  216.  
  217. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
  218.  
  219.   ' Set the key to be not pressed
  220.  
  221.     gbKeys(KeyCode) = False
  222.  
  223. End Sub
  224.  
  225. Private Sub Form_Load()
  226.  
  227.   Dim bFullscreen As Boolean
  228.   Dim frm As frmMain
  229.   Dim bLightSwitched As Boolean
  230.   Dim bFilterSwitched As Boolean
  231.   Dim bLightOn As Boolean
  232.   Dim giCurrFilter As Integer
  233.   Dim ret As Long
  234.  
  235.     Erase gbKeys
  236.  
  237.     gflXSpeed = 0.05
  238.     gflYSpeed = 0.05
  239.  
  240.     ret = GetWindowLong(Me.hwnd, GWL_EXSTYLE)
  241.     ret = ret Or WS_EX_LAYERED
  242.     SetWindowLong Me.hwnd, GWL_EXSTYLE, ret
  243.     
  244.     SetLayeredWindowAttributes Me.hwnd, 0, 255, LWA_COLORKEY Or LWA_ALPHA
  245.  
  246.     ' Put us into fullscreen automatically
  247.     'bFullscreen = True
  248.     bLightSwitched = False
  249.     bFilterSwitched = False
  250.     bLightOn = False
  251.     gflZ = -7#
  252.  
  253.     ' Save the current display settings
  254.     SaveDisplaySettings
  255.  
  256.     ' Show this form
  257.     Me.Show
  258.     ' Attempt to create a compatible GL window and set the display mode
  259.     If (CreateGLWindow(Me, 640, 480, 32, bFullscreen) = False) Then
  260.         Unload Me
  261.     End If
  262.     ' Attempt to set up OpenGL
  263.     If (InitGL() = False) Then
  264.         Unload Me
  265.     End If
  266.   
  267.     ' Loop until the form is unloaded, process windows events every time we're not rendering
  268.     Do While DoEvents()
  269.         ' Render the scene, if it failed or the user has pressed the escape key then exit the program
  270.         If (DrawGLScene() = False) Or (gbKeys(vbKeyEscape)) Then
  271.             Exit Do '>---> Loop
  272.           Else 'NOT (DRAWGLSCENE()...
  273.             ' Swap the Img2 and Img1 buffers to display what we've just rendered
  274.             SwapBuffers Me.hDC
  275.       
  276.             ' Toggle lighting
  277.             If (gbKeys(vbKeyL)) And (bLightSwitched = False) Then
  278.                 bLightOn = Not (bLightOn)
  279.                 If (bLightOn) Then
  280.                     glEnable glcLighting
  281.                   Else '(BLIGHTON) = 0
  282.                     glDisable glcLighting
  283.                 End If
  284.               
  285.                 bLightSwitched = True
  286.             End If
  287.       
  288.             If (gbKeys(vbKeyL) = False) Then
  289.                 bLightSwitched = False
  290.             End If
  291.       
  292.             ' Toggle filtering
  293.             If (gbKeys(vbKeyF)) And (bFilterSwitched = False) Then
  294.                 giCurrFilter = Img1.getFilter
  295.                 giCurrFilter = giCurrFilter + 1
  296.                 If giCurrFilter > 2 Then
  297.                     giCurrFilter = 0
  298.                 End If
  299.                     
  300.                 Select Case giCurrFilter
  301.                   Case 0:
  302.                     Img1.setFilter FILTER_NEAREST
  303.                   Case 1:
  304.                     Img1.setFilter FILTER_LINEAR
  305.                   Case 2:
  306.                     Img1.setFilter FILTER_MIPMAPPED
  307.                 End Select
  308.             
  309.                 bFilterSwitched = True
  310.             End If
  311.       
  312.             If (gbKeys(vbKeyF) = False) Then
  313.                 bFilterSwitched = False
  314.             End If
  315.         
  316.             ' Zoom in and out
  317.             If (gbKeys(vbKeyPageUp)) Then
  318.                 gflZ = gflZ - 0.02
  319.                 
  320.             End If
  321.             
  322.             If (gbKeys(vbKeyPageDown)) Then
  323.                 gflZ = gflZ + 0.02
  324.                 If gflZ > -4.44 Then
  325.                     gflZ = -4.44
  326.                 End If
  327.             End If
  328.             
  329.             ' Increase / decrease cube's rotation amount
  330.             If gbKeys(vbKeyUp) Then
  331.                 gflXSpeed = gflXSpeed - 0.01
  332.             End If
  333.             
  334.             If gbKeys(vbKeyDown) Then
  335.                 gflXSpeed = gflXSpeed + 0.01
  336.             End If
  337.             
  338.             If gbKeys(vbKeyLeft) Then
  339.                 gflYSpeed = gflYSpeed - 0.01
  340.             End If
  341.             
  342.             If gbKeys(vbKeyRight) Then
  343.                 gflYSpeed = gflYSpeed + 0.01
  344.             End If
  345.             
  346.             ' Key escape has been pressed, so exit the program!
  347.             If gbKeys(vbKeyEscape) Then
  348.                 Exit Do '>---> Loop
  349.             End If
  350.         End If
  351.         DoEvents
  352.     Loop
  353.     
  354.     Terminou = True
  355.     
  356. End Sub
  357.  
  358. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  359.  
  360.     If Button = 1 Then
  361.         
  362.         xx = X * Screen.TwipsPerPixelX: yy = Y * Screen.TwipsPerPixelY
  363.         capture = True
  364.         ReleaseCapture
  365.         SetCapture Me.hwnd
  366.     End If
  367.  
  368. End Sub
  369.  
  370. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  371.  
  372.     If capture Then
  373.         GetCursorPos Pt
  374.         Move Pt.X * Screen.TwipsPerPixelX - xx, Pt.Y * Screen.TwipsPerPixelY - yy
  375.     End If
  376.  
  377. End Sub
  378.  
  379. Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  380.  
  381.     capture = False
  382.  
  383. End Sub
  384.  
  385. Private Sub Form_Resize()
  386.  
  387.   ' When the user resizes the form, tell OpenGL to update so that it renders to the right place!
  388.   ' Primarily used when in windowed mode
  389.  
  390.     ReSizeGLScene ScaleWidth, ScaleHeight
  391.  
  392. End Sub
  393.  
  394. Private Sub Form_Unload(Cancel As Integer)
  395.  
  396.   ' Shut down OpenGL
  397.  
  398.     KillGLWindow Me
  399.     
  400. End Sub
  401.  
  402.  
  403.