home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / RPG_Engine768744282002.psc / Form1.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2002-04-28  |  6.6 KB  |  253 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    BackColor       =   &H00808080&
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "Form1"
  6.    ClientHeight    =   7425
  7.    ClientLeft      =   45
  8.    ClientTop       =   330
  9.    ClientWidth     =   9840
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   495
  14.    ScaleMode       =   3  'Pixel
  15.    ScaleWidth      =   656
  16.    StartUpPosition =   3  'Windows Default
  17.    Begin VB.PictureBox Picture1 
  18.       BackColor       =   &H00FFFFFF&
  19.       BorderStyle     =   0  'None
  20.       Height          =   7200
  21.       Left            =   120
  22.       ScaleHeight     =   480
  23.       ScaleMode       =   3  'Pixel
  24.       ScaleWidth      =   640
  25.       TabIndex        =   0
  26.       Top             =   120
  27.       Width           =   9600
  28.       Begin VB.Timer Timer1 
  29.          Interval        =   1000
  30.          Left            =   7320
  31.          Top             =   1080
  32.       End
  33.    End
  34. Attribute VB_Name = "Form1"
  35. Attribute VB_GlobalNameSpace = False
  36. Attribute VB_Creatable = False
  37. Attribute VB_PredeclaredId = True
  38. Attribute VB_Exposed = False
  39. Const DELAY_TIME = 20
  40. 'set height width as big as your map
  41. Const MAP_WIDTH = 40 * 32
  42. Const MAP_HEIGHT = 40 * 32
  43. Dim Char As MoB
  44. Dim Running As Boolean
  45. Dim CharDC As Long
  46. Dim CharSpriteDC As Long
  47. Dim TempDC As Long
  48. Dim bmpProperties As BITMAP
  49. Dim FPS As Long
  50. Dim LastCheck As Long
  51. Dim AnimCount As Single
  52. Dim Map(MAP_WIDTH / 32, MAP_HEIGHT / 32, 1) As Integer
  53. Dim PicDC As Long
  54. Dim StageDC As Long
  55. Dim BmpOld As Long
  56. Dim TileSet As Long
  57. Dim Retval As Long
  58. Dim Xt As Integer
  59. Dim Yt As Integer
  60. Dim Xz As Integer
  61. Dim Yz As Integer
  62. Dim PosX As Long
  63. Dim PosY As Long
  64. Dim Xr As Long
  65. Dim Yr As Long
  66. Private Sub Form_Load()
  67. Char.x = 320
  68. Char.y = 240
  69. Char.OldX = 320
  70. Char.OldY = 240
  71. Char.Direction = 1
  72. Running = True
  73. Me.Visible = True
  74. Char.Movement = 3
  75. MainLoop
  76. End Sub
  77. Function MainLoop()
  78. 'load bitmaps into memory DC's
  79. CharDC = GenerateDC(App.Path & "\cecil.bmp", bmpProperties)
  80. CharSpriteDC = GenerateDC(App.Path & "\cecilsprite.bmp", bmpProperties)
  81. TempDC = GenerateDC(App.Path & "\Image2.bmp", bmpProperties)
  82. TileSet = GenerateDC(App.Path & "\tiles1.bmp", bmpProperties)
  83. 'make a *buffer* to *store* stuff...
  84. StageDC = NewDC(Picture1.hdc, 640, 480)
  85. 'StageDC = CreateCompatibleDC(Picture1.hdc)
  86. 'Retval = SelectObject(StageDC, Picture1)
  87. 'Randomize GetTickCount
  88. 'For Xt = 0 To MAP_WIDTH / 32
  89. 'For Yt = 0 To MAP_HEIGHT / 32
  90. 'Map(Xt, Yt, 0) = (Int(Rnd * 1.05) + 1) * 32
  91. 'Next
  92. 'Next
  93. Dim T As String
  94. Open App.Path & "/map.txt" For Input As 1
  95. For Yt = 0 To MAP_HEIGHT / 32 - 1
  96. Input #1, T
  97. For Xt = 0 To (MAP_WIDTH / 32) - 1
  98. Map(Xt, Yt, 0) = Mid(T, Xt + 1, 1) * 32
  99. If Map(Xt, Yt, 0) = 0 Then
  100. Map(Xt, Yt, 1) = 1
  101. Map(Xt, Yt, 1) = 0
  102. End If
  103. Do While Running = True
  104. 'limit frames to 50 fps
  105. If Not GetTickCount - LastCheck >= DELAY_TIME Then
  106. GoTo Nada
  107. End If
  108. LastCheck = GetTickCount
  109. MoveChar
  110. DrawStage
  111. 'copy buffer to screen
  112. BitBlt Picture1.hdc, 0, 0, Picture1.Width, Picture1.Height, StageDC, 0, 0, SRCCOPY
  113. FPS = FPS + 1
  114. Nada:
  115. DoEvents
  116. DeleteDC (CharDC)
  117. DeleteDC (TempDC)
  118. DeleteDC (StageDC)
  119. DeleteDC (TileSet)
  120. DeleteDC (CharSpriteDC)
  121. End Function
  122. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  123. On Error Resume Next
  124. DeleteDC (CharDC)
  125. DeleteDC (TempDC)
  126. DeleteDC (StageDC)
  127. DeleteDC (CharSpriteDC)
  128. End Sub
  129. Private Sub Timer1_Timer()
  130. Form1.Caption = FPS & " - FPS"
  131. FPS = 0
  132. End Sub
  133. Private Sub MoveChar()
  134. Dim Xd As Long
  135. Dim Yd As Long
  136. Char.Movement = 4
  137. Char.Moved = False
  138. If GetAsyncKeyState(vbKeyA) Then
  139. Char.Movement = 15
  140. End If
  141. If GetAsyncKeyState(vbKeyS) Then
  142. Char.Movement = 1
  143. End If
  144. If GetAsyncKeyState(GM_ESCAPE) Then
  145. Running = False
  146. End If
  147. If GetAsyncKeyState(GM_LEFT) Then
  148. Char.OldX = Char.x
  149. Char.OldY = Char.y
  150. Char.x = Char.x - Char.Movement
  151. Char.Direction = 3
  152. Char.Moved = True
  153. GoTo Moved
  154. End If
  155. If GetAsyncKeyState(GM_UP) Then
  156. Char.OldY = Char.y
  157. Char.OldX = Char.x
  158. Char.y = Char.y - Char.Movement
  159. Char.Direction = 0
  160. Char.Moved = True
  161. GoTo Moved
  162. End If
  163. If GetAsyncKeyState(GM_RIGHT) Then
  164. Char.OldX = Char.x
  165. Char.OldY = Char.y
  166. Char.x = Char.x + Char.Movement
  167. Char.Direction = 1
  168. Char.Moved = True
  169. GoTo Moved
  170. End If
  171. If GetAsyncKeyState(GM_DOWN) Then
  172. Char.OldY = Char.y
  173. Char.OldX = Char.x
  174. Char.y = Char.y + Char.Movement
  175. Char.Direction = 2
  176. Char.Moved = True
  177. GoTo Moved
  178. End If
  179. Moved:
  180. If Char.x < 0 Then
  181. Char.x = 0
  182. ElseIf Char.x + 32 > MAP_WIDTH Then
  183. Char.x = MAP_WIDTH - 32
  184. End If
  185. If Char.y < 0 Then
  186. Char.y = 0
  187. ElseIf Char.y + 32 > MAP_HEIGHT Then
  188. Char.y = MAP_HEIGHT - 32
  189. End If
  190. Xd = Int(Char.x / 32)
  191. Yd = Int(Char.y / 32)
  192. If Int(Char.x / 32) = Char.x / 32 Then
  193. Xz = 0
  194. Else: Xz = 1
  195. End If
  196. If Int(Char.y / 32) = Char.y / 32 Then
  197. Yz = 0
  198. Else: Yz = 1
  199. End If
  200. For Xr = 0 To Xz
  201. For Yr = 0 To Yz
  202. If Map(Xd + Xr, Yd + Yr, 1) = 1 Then
  203.     If Char.Direction = 1 Then
  204.         Char.x = (Xd + Xr - 1) * 32
  205.         Char.y = Char.OldY
  206.     End If
  207.     If Char.Direction = 3 Then
  208.         Char.x = (Xd + Xr + 1) * 32
  209.         Char.y = Char.OldY
  210.     End If
  211.     If Char.Direction = 2 Then
  212.         Char.x = Char.OldX
  213.         Char.y = (Yd + Yr - 1) * 32
  214.     End If
  215.     If Char.Direction = 0 Then
  216.         Char.x = Char.OldX
  217.         Char.y = (Yd + Yr + 1) * 32
  218.     End If
  219. End If
  220. If Char.Moved = True Then
  221. AnimCount = AnimCount + Char.Movement / 20
  222. If AnimCount > 2 Then AnimCount = 0
  223. AnimCount = 0
  224. End If
  225. If Char.x < 320 Then
  226. PosX = -(320 - Char.x)
  227. ElseIf Char.x > MAP_WIDTH - 320 Then
  228. PosX = (Char.x - MAP_WIDTH) + 320
  229. PosX = 0
  230. End If
  231. If Char.y < 240 Then
  232. PosY = -(240 - Char.y)
  233. ElseIf Char.y > MAP_HEIGHT - 240 Then
  234. PosY = (Char.y - MAP_HEIGHT) + 240
  235. PosY = 0
  236. End If
  237. End Sub
  238. Private Sub DrawStage()
  239. Xr = (Char.x - 320)
  240. Yr = (Char.y - 240)
  241. If Xr < 0 Then Xr = 0
  242. If Yr < 0 Then Yr = 0
  243. If Xr + 640 > MAP_WIDTH Then Xr = MAP_WIDTH - 640
  244. If Yr + 480 > MAP_HEIGHT Then Yr = MAP_HEIGHT - 480
  245. Xz = (Xr) Mod 32
  246. Yz = (Yr) Mod 32
  247. For Xt = 0 To 640 Step 32
  248. For Yt = 0 To 480 Step 32
  249. BitBlt StageDC, Xt - (Xz), Yt - (Yz), 32, 32, TileSet, Map(Int((Xr + Xt) / 32), Int((Yr + Yt) / 32), 0), 0, SRCCOPY
  250. BitBlt StageDC, 320 + PosX, 240 + PosY, 32, 32, CharSpriteDC, CInt(AnimCount) * 32, Char.Direction * 32, SRCAND
  251. BitBlt StageDC, 320 + PosX, 240 + PosY, 32, 32, CharDC, CInt(AnimCount) * 32, Char.Direction * 32, SRCPAINT
  252. End Sub
  253.