Makkers
01-25-2002, 10:16 PM
Im trying to create an RPG based on the Rosebud Thriteen Code. Ive got the graphics improved and got the character on the map sprite properly working. Ive figured out how to do everything for the RPG now except for one hitch. On the battle screen, i use a map/tileset screen to create random ground each time the battle screen is called. On top of this i place the main character sprite(animated) and use the rosebuds code to load an enemy and place an enemy sprite(animated) on the map/tileset ground. The problem is that the enemy sprite appears wrong. about the a quater of the top half of the sprite appears correct and and the rest looks strange without all the colours. Im using the same code for the enemy sprite as the Main character sprite, but with different picture boxes. This is the first time ive used sprites as im a beginner and would love some help here :(
Here is the code:
---------------------------------------------------------------------------
Option Explicit
Dim Hit As Integer, EHit As Integer, Bar As Integer, E As Integer, BI As Integer, EBar As Integer
Private Type enemy
EName As String
Life As Integer
Speed As Integer
Strength As Integer
Def As Integer
XP As Integer
Money As Integer
End Type
Dim enemy As enemy
Dim charx As Integer
Dim chary As Integer
Dim enemyX As Integer
Dim enemyY As Integer
Const MAXROW = 20
Const MAXCOL = 70
Dim Map(MAXROW, MAXCOL) As Integer
Dim Row As Integer, Col As Integer 'current center coordinates
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Sub Form_Load()
Dim r As Integer, c As Integer, mapID As Integer, tries As Integer
Dim maskclr As Long
Dim maskclr2 As Long
Randomize
Dim FileNum As Integer, I As Integer
LblName.Caption = T.PName
LblHP = T.Life & "/" & T.MLife
LblTP = T.Tech & "/" & T.MTech
FileNum = FreeFile
E = Random(1, 3)
Open App.Path & "\Enemy" & E & ".txt" For Input As FileNum
Input #FileNum, enemy.EName, enemy.Life, enemy.Strength, enemy.Def, enemy.XP, enemy.Money
picEnemy.Picture = LoadPicture(App.Path & "\Enemy" & E & ".bmp")
Close FileNum
LblE.Caption = enemy.EName
LblELife.Caption = enemy.Life
charx = 800
chary = 85
enemyX = 200
enemyY = 85
For r = 0 To MAXROW
For c = 0 To MAXCOL
For tries = 1 To 5
mapID = Int(Rnd() * 94) + 48
Select Case mapID
Case 94, 95
Case Else
Exit For
End Select
Next tries
Map(r, c) = mapID
Next c
Next r
Row = 6
Col = 15
picMap.Move 0, 260, 1050, 300
maskclr2 = GetPixel(picEnemy.hdc, 1, 1)
picMasks.Move 0, 0, picEnemy.Width, picEnemy.Height
For r = 0 To picEnemy.ScaleHeight - 1
For c = 0 To picEnemy.ScaleWidth - 1
If GetPixel(picEnemy.hdc, c, r) = maskclr2 Then
SetPixel picMask.hdc, c, r, 0&
SetPixel picEnemy.hdc, c, r, &HFFFFFFFF
Else
SetPixel picMask.hdc, c, r, &HFFFFFFFF
End If
Next c
Next r
picMask.Refresh
picEnemy.Refresh
maskclr = GetPixel(picChars.hdc, 1, 1)
picMasks.Move 0, 0, picChars.Width, picChars.Height
For r = 0 To picChars.ScaleHeight - 1
For c = 0 To picChars.ScaleWidth - 1
If GetPixel(picChars.hdc, c, r) = maskclr Then
SetPixel picMasks.hdc, c, r, 0&
SetPixel picChars.hdc, c, r, &HFFFFFFFF
Else
SetPixel picMasks.hdc, c, r, &HFFFFFFFF
End If
Next c
Next r
picMasks.Refresh
picChars.Refresh
End Sub
Private Sub DrawMap()
Dim r As Integer, c As Integer
Dim x1 As Integer, x2 As Integer, y1 As Integer, y2 As Integer, ndx As Integer
y1 = 0
For r = Row - 5 To Row + 5
x1 = 0
For c = Col - 5 To Col + 35
If (r < 0) Or (c < 0) Or (r > MAXROW) Or (c > MAXCOL) Then
BitBlt picMap.hdc, x1, y1, 32, 32, picTiles.hdc, 0, 0, vbBlackness
Else
ndx = Map(r, c)
x2 = (ndx Mod 8) * 32
y2 = (ndx \ 8) * 32
BitBlt picMap.hdc, x1, y1, 32, 32, picTiles.hdc, x2, y2, vbSrcCopy
End If
x1 = x1 + 32
Next c
y1 = y1 + 32
Next r
picMap.Refresh
End Sub
Private Sub Form_Paint()
DrawMap
MoveTimer.Enabled = True
End Sub
Private Sub MoveTimer_Timer()
Static flip As Boolean
Dim c As Integer
Dim em As Integer
If flip Then
c = 1 Mod 10 * 64
em = 1 Mod 10 * 64
Else
c = 1 Mod 10 * 64 + 100
em = 1 Mod 10 * 64 + 100
End If
DrawMap
BitBlt picMap.hdc, charx, chary, 100, 132, picMasks.hdc, c, 0, vbSrcPaint
BitBlt picMap.hdc, charx, chary, 100, 132, picChars.hdc, c, 0, vbSrcAnd
BitBlt picMap.hdc, enemyX, enemyY, 100, 132, picMask.hdc, em, 0, vbSrcPaint
BitBlt picMap.hdc, enemyX, enemyY, 100, 132, picEnemy.hdc, em, 0, vbSrcAnd
picMap.Refresh
flip = Not flip
End Sub
Private Sub testmove_Timer()
charx = (charx - 0)
End Sub
Private Sub TmrBar_Timer()
PicBar.Line (Bar, 0)-(Bar, 309), RGB(0, 0, 255)
Bar = Bar + 15
If Bar >= PicBar.Width Then
FraOptions.Visible = True
ImgOPoint.Visible = True
TmrBar.Enabled = False
End If
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case ImgOPoint.Visible
Case True
Select Case KeyCode
Case 38:
Select Case ImgOPoint.Top
Case 360: ImgOPoint.Top = 1850
Case 1080: ImgOPoint.Top = 360
Case 1850: ImgOPoint.Top = 1080
End Select
Case 40:
Select Case ImgOPoint.Top
Case 360: ImgOPoint.Top = 1080
Case 1080: ImgOPoint.Top = 1850
Case 1850: ImgOPoint.Top = 360
End Select
Case 13:
Select Case ImgOPoint.Top
Case 360:
Case 1080:
Case 1850:
ImgOPoint.Visible = False
ImgIPointer.Visible = True
LblTonic.Caption = "Tonic (" & Game.Tonics & ")"
LblEther.Caption = "Ether (" & Game.Ethers & ")"
LblFullCure.Caption = "Full Cure (" & Game.FCures & ")"
FraItem.Visible = True
End Select
Case False
Select Case KeyCode
Case 13:
Select Case ImgIPointer.Top
Case 360: Call Tonic
Case 1080: Call Ether
Case 1850: Call Cure
End Select
Case 40:
Select Case ImgIPointer.Top
Case 360: ImgIPointer.Top = 1080
Case 1080: ImgIPointer.Top = 1850
Case 1850: ImgIPointer.Top = 360
End Select
Case 38:
Select Case ImgIPointer.Top
Case 360: ImgIPointer.Top = 1850
Case 1080: ImgIPointer.Top = 360
Case 1850: ImgIPointer.Top = 1080
End Select
End Select
End Select
End Select
End Sub
-----------------------------------------
Thanx.
Here is the code:
---------------------------------------------------------------------------
Option Explicit
Dim Hit As Integer, EHit As Integer, Bar As Integer, E As Integer, BI As Integer, EBar As Integer
Private Type enemy
EName As String
Life As Integer
Speed As Integer
Strength As Integer
Def As Integer
XP As Integer
Money As Integer
End Type
Dim enemy As enemy
Dim charx As Integer
Dim chary As Integer
Dim enemyX As Integer
Dim enemyY As Integer
Const MAXROW = 20
Const MAXCOL = 70
Dim Map(MAXROW, MAXCOL) As Integer
Dim Row As Integer, Col As Integer 'current center coordinates
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Sub Form_Load()
Dim r As Integer, c As Integer, mapID As Integer, tries As Integer
Dim maskclr As Long
Dim maskclr2 As Long
Randomize
Dim FileNum As Integer, I As Integer
LblName.Caption = T.PName
LblHP = T.Life & "/" & T.MLife
LblTP = T.Tech & "/" & T.MTech
FileNum = FreeFile
E = Random(1, 3)
Open App.Path & "\Enemy" & E & ".txt" For Input As FileNum
Input #FileNum, enemy.EName, enemy.Life, enemy.Strength, enemy.Def, enemy.XP, enemy.Money
picEnemy.Picture = LoadPicture(App.Path & "\Enemy" & E & ".bmp")
Close FileNum
LblE.Caption = enemy.EName
LblELife.Caption = enemy.Life
charx = 800
chary = 85
enemyX = 200
enemyY = 85
For r = 0 To MAXROW
For c = 0 To MAXCOL
For tries = 1 To 5
mapID = Int(Rnd() * 94) + 48
Select Case mapID
Case 94, 95
Case Else
Exit For
End Select
Next tries
Map(r, c) = mapID
Next c
Next r
Row = 6
Col = 15
picMap.Move 0, 260, 1050, 300
maskclr2 = GetPixel(picEnemy.hdc, 1, 1)
picMasks.Move 0, 0, picEnemy.Width, picEnemy.Height
For r = 0 To picEnemy.ScaleHeight - 1
For c = 0 To picEnemy.ScaleWidth - 1
If GetPixel(picEnemy.hdc, c, r) = maskclr2 Then
SetPixel picMask.hdc, c, r, 0&
SetPixel picEnemy.hdc, c, r, &HFFFFFFFF
Else
SetPixel picMask.hdc, c, r, &HFFFFFFFF
End If
Next c
Next r
picMask.Refresh
picEnemy.Refresh
maskclr = GetPixel(picChars.hdc, 1, 1)
picMasks.Move 0, 0, picChars.Width, picChars.Height
For r = 0 To picChars.ScaleHeight - 1
For c = 0 To picChars.ScaleWidth - 1
If GetPixel(picChars.hdc, c, r) = maskclr Then
SetPixel picMasks.hdc, c, r, 0&
SetPixel picChars.hdc, c, r, &HFFFFFFFF
Else
SetPixel picMasks.hdc, c, r, &HFFFFFFFF
End If
Next c
Next r
picMasks.Refresh
picChars.Refresh
End Sub
Private Sub DrawMap()
Dim r As Integer, c As Integer
Dim x1 As Integer, x2 As Integer, y1 As Integer, y2 As Integer, ndx As Integer
y1 = 0
For r = Row - 5 To Row + 5
x1 = 0
For c = Col - 5 To Col + 35
If (r < 0) Or (c < 0) Or (r > MAXROW) Or (c > MAXCOL) Then
BitBlt picMap.hdc, x1, y1, 32, 32, picTiles.hdc, 0, 0, vbBlackness
Else
ndx = Map(r, c)
x2 = (ndx Mod 8) * 32
y2 = (ndx \ 8) * 32
BitBlt picMap.hdc, x1, y1, 32, 32, picTiles.hdc, x2, y2, vbSrcCopy
End If
x1 = x1 + 32
Next c
y1 = y1 + 32
Next r
picMap.Refresh
End Sub
Private Sub Form_Paint()
DrawMap
MoveTimer.Enabled = True
End Sub
Private Sub MoveTimer_Timer()
Static flip As Boolean
Dim c As Integer
Dim em As Integer
If flip Then
c = 1 Mod 10 * 64
em = 1 Mod 10 * 64
Else
c = 1 Mod 10 * 64 + 100
em = 1 Mod 10 * 64 + 100
End If
DrawMap
BitBlt picMap.hdc, charx, chary, 100, 132, picMasks.hdc, c, 0, vbSrcPaint
BitBlt picMap.hdc, charx, chary, 100, 132, picChars.hdc, c, 0, vbSrcAnd
BitBlt picMap.hdc, enemyX, enemyY, 100, 132, picMask.hdc, em, 0, vbSrcPaint
BitBlt picMap.hdc, enemyX, enemyY, 100, 132, picEnemy.hdc, em, 0, vbSrcAnd
picMap.Refresh
flip = Not flip
End Sub
Private Sub testmove_Timer()
charx = (charx - 0)
End Sub
Private Sub TmrBar_Timer()
PicBar.Line (Bar, 0)-(Bar, 309), RGB(0, 0, 255)
Bar = Bar + 15
If Bar >= PicBar.Width Then
FraOptions.Visible = True
ImgOPoint.Visible = True
TmrBar.Enabled = False
End If
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case ImgOPoint.Visible
Case True
Select Case KeyCode
Case 38:
Select Case ImgOPoint.Top
Case 360: ImgOPoint.Top = 1850
Case 1080: ImgOPoint.Top = 360
Case 1850: ImgOPoint.Top = 1080
End Select
Case 40:
Select Case ImgOPoint.Top
Case 360: ImgOPoint.Top = 1080
Case 1080: ImgOPoint.Top = 1850
Case 1850: ImgOPoint.Top = 360
End Select
Case 13:
Select Case ImgOPoint.Top
Case 360:
Case 1080:
Case 1850:
ImgOPoint.Visible = False
ImgIPointer.Visible = True
LblTonic.Caption = "Tonic (" & Game.Tonics & ")"
LblEther.Caption = "Ether (" & Game.Ethers & ")"
LblFullCure.Caption = "Full Cure (" & Game.FCures & ")"
FraItem.Visible = True
End Select
Case False
Select Case KeyCode
Case 13:
Select Case ImgIPointer.Top
Case 360: Call Tonic
Case 1080: Call Ether
Case 1850: Call Cure
End Select
Case 40:
Select Case ImgIPointer.Top
Case 360: ImgIPointer.Top = 1080
Case 1080: ImgIPointer.Top = 1850
Case 1850: ImgIPointer.Top = 360
End Select
Case 38:
Select Case ImgIPointer.Top
Case 360: ImgIPointer.Top = 1850
Case 1080: ImgIPointer.Top = 360
Case 1850: ImgIPointer.Top = 1080
End Select
End Select
End Select
End Select
End Sub
-----------------------------------------
Thanx.