'Types
Private Type tSprite
X As Long
Y As Long
w As Long
h As Long
Color As Long
End Type
Private Type tLine
Sprite1 As Long
Sprite2 As Long
Color As Long
End Type
'Variables
Private SpriteCount As Long
Private Sprite() As tSprite
Private LinesCount As Long
Private Lines() As tLine
Private X2 As Long
Private Y2 As Long
Private ActSprite As Long
Public Sub DrawSprites()
Dim A As Long
For A = 0 To SpriteCount
With Sprite(A)
Me.Line (.X, .Y)-(.X + .w, .Y + .h), .Color, BF
End With
Next
End Sub
Public Sub DrawLines()
Dim A As Long
For A = 0 To LinesCount
With Lines(A)
Me.Line (Sprite(.Sprite1).X + (Sprite(.Sprite1).w / 2), Sprite(.Sprite1).Y + (Sprite(.Sprite1).h / 2))-(Sprite(.Sprite2).X + (Sprite(.Sprite2).w / 2), Sprite(.Sprite2).Y + (Sprite(.Sprite2).h / 2)), .Color
End With
Next
End Sub
Private Function FindSprite(iX As Long, iY As Long) As Long
Dim A As Long
'Find sprite at specified position
For A = 0 To SpriteCount
With Sprite(A)
If iX > .X And iY > .Y Then
If iX < .X + .w And iY < .Y + .h Then
'Sprite found
FindSprite = A
Exit Function
End If
End If
End With
Next
'No sprite found
FindSprite = -1
End Function
Public Sub Redraw()
'Clear
Me.Cls
'Draw scene
DrawLines
DrawSprites
End Sub
Private Sub Form_Load()
'Reset variables
ActSprite = -1
'Create 2 sample sprites
SpriteCount = 2
ReDim Sprite(SpriteCount)
With Sprite(0)
.X = 100
.Y = 200
.w = 50
.h = 50
.Color = RGB(64, 64, 192)
End With
With Sprite(1)
.X = 400
.Y = 100
.w = 50
.h = 50
.Color = RGB(64, 64, 192)
End With
With Sprite(2)
.X = 100
.Y = 50
.w = 50
.h = 50
.Color = RGB(64, 64, 192)
End With
'Connect sprites
LinesCount = -1
' ReDim Lines(LinesCount)
'
' With Lines(0)
' .Sprite1 = 0
' .Sprite2 = 1
'
' .Color = RGB(192, 64, 64)
' End With
'
' With Lines(1)
' .Sprite1 = 1
' .Sprite2 = 2
'
' .Color = RGB(192, 64, 64)
' End With
'Setup window
With Me
.AutoRedraw = True
.ScaleMode = vbPixels
.Width = 8000
.Height = 6000
.Move (Screen.Width - .Width) / 2, (Screen.Height - .Height) / 2
.Caption = "Connected sprites"
End With
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Save mouse position
X2 = CLng(X)
Y2 = CLng(Y)
'Find sprite at clicked position
ActSprite = FindSprite(X2, Y2)
If ActSprite > -1 Then
Sprite(ActSprite).Color = RGB(64, 64, 255)
Redraw
End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
'Left button
If ActSprite > -1 Then
'Move sprite
With Sprite(ActSprite)
.X = .X + (X - X2)
.Y = .Y + (Y - Y2)
End With
Redraw
End If
'Save mouse position
X2 = CLng(X)
Y2 = CLng(Y)
End If
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Temp As Long
If ActSprite > -1 Then
'Save mouse position
X2 = CLng(X)
Y2 = CLng(Y)
If Button = 2 Then
Temp = FindSprite(X2, Y2)
If Temp > -1 Then
If Temp <> ActSprite Then
'Allocate memory
LinesCount = LinesCount + 1
ReDim Preserve Lines(LinesCount)
With Lines(LinesCount)
'Connect line
.Sprite1 = ActSprite
.Sprite2 = Temp
.Color = RGB(192, 64, 64)
End With
End If
End If
End If
'Release sprite
Sprite(ActSprite).Color = RGB(64, 64, 192)
ActSprite = -1
Redraw
End If
End Sub
Private Sub Form_Paint()
Redraw
End Sub
Private Sub Form_Resize()
Redraw
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Release memory
Erase Sprite
End Sub
