home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD14675282001.psc / Dec.bas < prev   
Encoding:
BASIC Source File  |  2001-01-27  |  8.9 KB  |  247 lines
  1. Attribute VB_Name = "Declares"
  2. Public walkinganim
  3. Public anim(50)
  4. Public NPCno
  5. Public NPC(50, 500)
  6. Public mapplx
  7. Public mapply
  8. Public Stam As Boolean
  9. Public sit As Boolean
  10. Public characterdata(50, 10, 4, 6) As Integer
  11. Public characterdataname(50)
  12. Public feetrect As RECT
  13. Public mouseov As Integer
  14. Public plonline
  15. Public connected As Boolean
  16. Public oppdetail(50, 25)
  17. Public transcoltemp
  18. Public walkstartx
  19. Public walkstarty
  20. Public Dir
  21. Public walkx1
  22. Public walky1
  23. Public edit As Boolean
  24. Public Keymov(4) As Boolean
  25. Public coll As Boolean
  26. Public amenu As Boolean
  27. Public smenu As Boolean
  28. Public dmenu As Boolean
  29. Public quitmenu As Boolean
  30. Public DDfont As New StdFont
  31. Public bInit As Boolean
  32. Public Tempfile As String
  33. Public kPress(5) As Boolean
  34. Public r1 As RECT
  35. Public r2 As RECT
  36. Public Imgx As Integer
  37. Public Imgy As Integer
  38. Public plx
  39. Public ply
  40. Public map(300, 300, 3)
  41. Public maplink(50, 7)
  42. Public ddmapsize As RECT
  43. Public linkno As Integer
  44.  
  45. Public noguisurface As Integer
  46. Public guinumber As Integer
  47. Public GUI(50, 20)
  48. Public DDGUI(50) As DirectDrawSurface7
  49. Public DX As New DirectX7
  50. Public DD As DirectDraw7
  51. Public DS As DirectSound
  52. Public DSSound(100) As DirectSoundBuffer
  53. Public DDMLoad As DirectMusicLoader
  54. Public DDMPerf As DirectMusicPerformance
  55. Public DDMSeg As DirectMusicSegment
  56. Public DDPrimSurf As DirectDrawSurface7
  57. Public DDOppbuffer As DirectDrawSurface7
  58. Public DDOpphead(50) As DirectDrawSurface7
  59. Public DDOpponents(50) As DirectDrawSurface7
  60. Public DDMap As DirectDrawSurface7
  61. Public DDHead As DirectDrawSurface7
  62. Public DDmapbuffer As DirectDrawSurface7
  63. Public DDGrass As DirectDrawSurface7
  64. Public DDFeet As DirectDrawSurface7
  65. Public DDTorso As DirectDrawSurface7
  66. Public DDHands As DirectDrawSurface7
  67. Public DDlegs As DirectDrawSurface7
  68. Public DDarms As DirectDrawSurface7
  69. Public DDbelt As DirectDrawSurface7
  70. Public DDCharacter As DirectDrawSurface7
  71. Public DDGetReady As DirectDrawSurface7
  72. Public DDTop As DirectDrawSurface7
  73. Public DDBackround As DirectDrawSurface7
  74. Public DDWeapons As DirectDrawSurface7
  75. Public ddClipper As DirectDrawClipper
  76. Public DDNPC As DirectDrawSurface7
  77. Public DDNPCtemp(50) As DirectDrawSurface7
  78.  
  79. Public RedShiftLeft As Long
  80. Public RedShiftRight As Long
  81. Public GreenShiftLeft As Long
  82. Public GreenShiftRight As Long
  83. Public BlueShiftLeft As Long
  84. Public BlueShiftRight As Long
  85. Private hdesktopwnd
  86. Private hdccaps
  87. Private Declare Function GetDC Lib "User32" (ByVal hwnd As Long) As Long
  88. Private Declare Function ReleaseDC Lib "User32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
  89. Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
  90. Global colourdisplay As Integer
  91. Global soundinit As Boolean
  92. Global Is16bitc As Boolean
  93. Global musicinit As Boolean
  94. Global Playerdetails(20)
  95. 'playerdetails(0) = nickname
  96. 'playerdetails(1) = saying
  97. 'playerdetails(2) = health
  98. 'playerdetails(3) = money
  99. 'playerdetails(4) = left
  100. 'playerdetails(5) = right
  101. 'playerdetails(6) = bag
  102. 'playerdetails(7) = stamina
  103. 'playerdetails(8) = feet
  104. 'playerdetails(9) = legs
  105. 'playerdetails(10) = torso
  106. 'playerdetails(11) = belt
  107. 'playerdetails(12) = arms
  108. 'playerdetails(13) = hands
  109. 'playerdetails(14) = head
  110. 'playerdetails(15) = map
  111. Dim DownloadedText As String, Downloading As Boolean
  112. Global startx: Global starty
  113. Global X1: Global Y1
  114. Global rWin As RECT
  115. Private Const SRCCOPY = &HCC0020
  116. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  117. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  118. Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
  119. Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  120.  
  121. Public Function CreateSurfaceFromFile(DirectDraw As DirectDraw7, ByVal Filename As String, SurfaceDesc As DDSURFACEDESC2) As DirectDrawSurface7
  122.     Dim Picture As StdPicture
  123.     Dim Width As Long
  124.     Dim Height As Long
  125.     Dim Surface As DirectDrawSurface7
  126.     Dim hdcPicture As Long
  127.     Dim hdcSurface As Long
  128.     'If filetype = "GIF" Then
  129.     Set Picture = LoadPicture(Filename)
  130.     
  131.     Width = CLng((Picture.Width * 0.001) * 567 / Screen.TwipsPerPixelX)
  132.     Height = CLng((Picture.Height * 0.001) * 567 / Screen.TwipsPerPixelY)
  133.     With SurfaceDesc
  134.         If .lFlags = 0 Then .lFlags = DDSD_CAPS
  135.         .lFlags = .lFlags Or DDSD_WIDTH Or DDSD_HEIGHT
  136.         If .ddsCaps.lCaps = 0 Then .ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
  137.         If .lWidth = 0 Then .lWidth = Width
  138.         If .lHeight = 0 Then .lHeight = Height
  139.     End With
  140.     Set Surface = DirectDraw.CreateSurface(SurfaceDesc)
  141.     hdcPicture = CreateCompatibleDC(0)
  142.     SelectObject hdcPicture, Picture.Handle
  143.         hdcSurface = Surface.GetDC
  144.     StretchBlt hdcSurface, 0, 0, SurfaceDesc.lWidth, SurfaceDesc.lHeight, hdcPicture, 0, 0, Width, Height, SRCCOPY
  145.     Surface.ReleaseDC hdcSurface
  146.     
  147.     'GetGifInfo (Filename)
  148.     'If GifInfo.Transparent = True Then
  149.     Dim ddtrans1 As DDCOLORKEY
  150.         If colourdisplay = 16 Then
  151.     coltran = DDColor(RGB(255, 0, 255))
  152.     Else
  153.     coltran = RGB(255, 0, 255)
  154.     End If
  155.     ddtrans1.low = coltran
  156.     ddtrans1.high = coltran
  157.     Surface.SetColorKey DDCKEY_SRCBLT, ddtrans1
  158.     
  159.     'ElseIf filetype = "PNG" Then
  160.     'LoadPNG Filename, Img
  161.     'Width = Img.ImageWidth
  162.     'Height = Img.ImageHeight
  163.     'With SurfaceDesc
  164.     '    If .lFlags = 0 Then .lFlags = DDSD_CAPS
  165.     '    .lFlags = .lFlags Or DDSD_WIDTH Or DDSD_HEIGHT
  166.     '    If .ddsCaps.lCaps = 0 Then .ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
  167.     '    If .lWidth = 0 Then .lWidth = Width
  168.     '    If .lHeight = 0 Then .lHeight = Height
  169.     'End With
  170.     'Set Surface = DirectDraw.CreateSurface(SurfaceDesc)
  171.     'hdcPicture = CreateCompatibleDC(0)
  172.     'SelectObject hdcPicture, Img.Handle
  173.     'hdcSurface = Surface.GetDC
  174.     'StretchBlt hdcSurface, 0, 0, SurfaceDesc.lWidth, SurfaceDesc.lHeight, hdcPicture, 0, 0, Width, Height, SRCCOPY
  175.     'Surface.ReleaseDC hdcSurface
  176.     'ElseIf filetype = "" Then Exit Function
  177.     'End If
  178.     
  179.         DeleteDC hdcPicture
  180.     Set Picture = Nothing
  181.     Set CreateSurfaceFromFile = Surface
  182.     Set Surface = Nothing
  183. End Function
  184. Public Sub Getwindowcolours()
  185. Dim DisplayBits
  186. Dim RetVal
  187. hdccaps = GetDC(hdesktopwnd)
  188. DisplayBits = GetDeviceCaps(hdccaps, 12)
  189. RetVal = ReleaseDC(hdesktopwnd, hdccaps)
  190. colourdisplay = DisplayBits
  191. If colourdisplay = 24 Then Let colourdisplay = 32
  192. If colourdisplay <> 16 And colourdisplay <> 32 Then MsgBox "You must have 16/24 or 32 bit colour to run this program"
  193. End Sub
  194. Public Function DDRGB(red As Long, green As Long, blue As Long) As Long
  195. DDRGB = (red \ RedShiftRight) * RedShiftLeft + (green \ GreenShiftRight) * GreenShiftLeft + (blue \ BlueShiftRight) * BlueShiftLeft
  196. End Function
  197.  
  198. Public Sub GetRGBfromColor(ByVal Color As Long, ByRef red As Long, ByRef green As Long, ByRef blue As Long)
  199. Dim HexadecimalValue As String
  200.     HexadecimalValue = Hex(Val(Color))
  201.     
  202.     If Len(HexadecimalValue) < 6 Then
  203.         HexadecimalValue = String(6 - Len(HexadecimalValue), "0") + HexadecimalValue
  204.     End If
  205.     blue = CLng("&H" + Mid(HexadecimalValue, 1, 2))
  206.     green = CLng("&H" + Mid(HexadecimalValue, 3, 2))
  207.     red = CLng("&H" + Mid(HexadecimalValue, 5, 2))
  208. End Sub
  209.  
  210.  
  211. Public Function DDColor(RGBColor As Long) As Long
  212.     Dim RedVal As Long
  213.     Dim GreenVal As Long
  214.     Dim BlueVal As Long
  215.     GetRGBfromColor RGBColor, RedVal, GreenVal, BlueVal
  216.     DDColor = DDRGB(RedVal, GreenVal, BlueVal)
  217.     End Function
  218.  
  219. Public Function Loaddirectxsurface(DirectDrawSurface As DirectDrawSurface7, ByVal Filename As String, Optional Width As Long, Optional Height As Long) As DirectDrawSurface7
  220. Dim ddsd1 As DDSURFACEDESC2
  221. 'Checkfiletype (Filename)
  222. 'If filetype = "GIF" Then
  223.     GameForm.OpenPict.Picture = LoadPicture(Filename)
  224. '    ElseIf filetype = "PNG" Then
  225. '    LoadPNG Filename, Img
  226. '    GameForm.OpenPict.Width = Img.ImageWidth + (GameForm.OpenPict.Width - GameForm.OpenPict.ScaleWidth)
  227. '    GameForm.OpenPict.Height = Img.ImageHeight + (GameForm.OpenPict.Height - GameForm.OpenPict.ScaleHeight)
  228. '    DrawImage GameForm.OpenPict.hdc, Img
  229. '    ElseIf filetype = "" Then Exit Function
  230. '    End If
  231. If Width <> 0 Then
  232.     Tempfile = Filename
  233.     ddsd1.lFlags = DDSD_CAPS
  234.     ddsd1.lHeight = Height
  235.     ddsd1.lWidth = Width
  236.     Set DirectDrawSurface = CreateSurfaceFromFile(DD, Tempfile, ddsd1)
  237.     Else
  238.     Tempfile = Filename
  239. '    GameForm.OpenPict.Picture = LoadPicture(Tempfile)
  240.     ddsd1.lFlags = DDSD_CAPS
  241.     ddsd1.lHeight = GameForm.OpenPict.Height
  242.     ddsd1.lWidth = GameForm.OpenPict.Width
  243.     Set DirectDrawSurface = CreateSurfaceFromFile(DD, Tempfile, ddsd1)
  244. End If
  245.     DoEvents
  246. End Function
  247.