TB-火柴人

• 下载源代码 - 1.07 MB

引言

这篇文章旨在测试如何通过线条绘画简单地创建逼真的对象。

我在 VB.NET 中要解决的一个问题是动画性能。由于保留了矢量数据，因此应该能够以良好的性能创建动画，或者将数据发送到任何 3D 软件，如 Truespace 或 Maya。

背景

主要想法是制作由外部程序、音乐、操纵杆等驱动的动画。

如果你的自定义对象为低音鼓、旋律和踩镘跳舞，你的音乐可视化效果会是什么样子？这就是我的问题。

这个文档对于保持比例很有用。

Using the Code

应该重点关注 clsStickStructure.vb 类。它保存了任何点的属性。它还保存了该点是否与其他点相关联。因此，可以使用简单的运动学来制作动画。

移动鼠标时，选择必须固定到网格上，以便更快地创建模型

If MoveIndex > -1 Then
    If e.Button = Windows.Forms.MouseButtons.Left _
	Then Call MoveObjectToPosition(MoveIndex, New Point(e.X, e.Y), False)
    If e.Button = Windows.Forms.MouseButtons.Right _
	Then Call MoveObjectToPosition(MoveIndex, New Point(e.X, e.Y), True)
End If 

为了引用这些点，有必要为每个点保留一个对象。

 Private Sub MoveObjectToPosition(ByVal ObjectIndex As Integer, ByVal Pos As PointF, _
	ByVal MoveFullObject As Boolean)
        Dim X, Y As Integer
        Dim DiffX, DiffY As Integer
        'Dim item2 As StickStructure
        Dim i As Integer

        X = CInt(Pos.X / GridSize) * GridSize
        Y = CInt(Pos.Y / GridSize) * GridSize

        X = X - MittX
        Y = Y - MittY
        If Stick.Points IsNot Nothing _
		AndAlso UBound(Stick.Points)>= MoveIndex Then       
            If LastPoint.Pos2Active = True Then
                DiffX = Stick.Points(MoveIndex).Pos2Relativ.X - X
                DiffY = Stick.Points(MoveIndex).Pos2Relativ.Y - Y
                Stick.Points(MoveIndex).Pos2Relativ = New PointF(X, Y)

                If MoveFullObject = True Then
                    Stick.Points(MoveIndex).Pos1Relativ = _
			New PointF(Stick.Points(MoveIndex).Pos1Relativ.X - DiffX, _
			Stick.Points(MoveIndex).Pos1Relativ.Y - DiffY)

                    If Stick.Points(MoveIndex).Pos1LinkToIndexToP1 > -1 _
		     Then Stick.Points(Stick.Points(MoveIndex).Pos1LinkToIndexToP1)._
			Pos1Relativ = Stick.Points(MoveIndex).Pos1Relativ
                    If Stick.Points(MoveIndex).Pos1LinkToIndexToP2 > -1 _
		     Then Stick.Points(Stick.Points(MoveIndex).Pos1LinkToIndexToP2)._
			Pos2Relativ = Stick.Points(MoveIndex).Pos1Relativ
                End If

            Else
                DiffX = Stick.Points(MoveIndex).Pos1Relativ.X - X
                DiffY = Stick.Points(MoveIndex).Pos1Relativ.Y - Y
                Stick.Points(MoveIndex).Pos1Relativ = New PointF(X, Y)

                If MoveFullObject = True Then
                    Stick.Points(MoveIndex).Pos2Relativ.X = _
			Stick.Points(MoveIndex).Pos2Relativ.X - DiffX
                    Stick.Points(MoveIndex).Pos2Relativ.Y = _
			Stick.Points(MoveIndex).Pos2Relativ.Y - DiffY

                    If Stick.Points(MoveIndex).Pos2LinkToIndexToP1 > -1 _
			Then Stick.Points(Stick.Points(MoveIndex)._
			Pos2LinkToIndexToP1).Pos1Relativ = _
			Stick.Points(MoveIndex).Pos1Relativ
                    If Stick.Points(MoveIndex).Pos2LinkToIndexToP2 > -1 _
			Then Stick.Points(Stick.Points(MoveIndex)._
			Pos2LinkToIndexToP2).Pos2Relativ = _
			Stick.Points(MoveIndex).Pos1Relativ
                End If
            End If

            For i = 0 To Stick.Points.Length - 1
                If i <> MoveIndex Then
                    If Stick.Points(i).Pos1LinkToIndexToP1 = _
		    Stick.Points(MoveIndex).Id Then Stick.Points(i).Pos1Relativ = _
			Stick.Points(MoveIndex).Pos1Relativ
                    If Stick.Points(i).Pos1LinkToIndexToP2 = _
		    Stick.Points(MoveIndex).Id Then Stick.Points(i).Pos1Relativ = _
			Stick.Points(MoveIndex).Pos2Relativ
                    If Stick.Points(i).Pos2LinkToIndexToP1 = _
		    Stick.Points(MoveIndex).Id Then Stick.Points(i).Pos2Relativ = _
			Stick.Points(MoveIndex).Pos1Relativ
                    If Stick.Points(i).Pos2LinkToIndexToP2 = _
		    Stick.Points(MoveIndex).Id Then Stick.Points(i).Pos2Relativ = _
			Stick.Points(MoveIndex).Pos2Relativ
                End If
            Next
        End If
    End Sub

    Private Sub PaintMousePosition(ByVal Pos As PointF)
        If Me.pic.Image Is Nothing Then Exit Sub
        Dim i As Integer = 5
        Pos.X = CInt(Pos.X / Me.GridSize) * Me.GridSize
        Pos.Y = CInt(Pos.Y / Me.GridSize) * Me.GridSize
        Dim P As New Pen(Color.FromArgb(100, 90, 90, 90), 1)
        Dim PBlue As New Pen(Color.FromArgb(90, 90, 90, 255), 1)
        PBlue.DashStyle = Drawing2D.DashStyle.DashDotDot

        Using gr As Graphics = Graphics.FromImage(Me.pic.Image)
            'Cross
            gr.DrawLine(P, CInt(Pos.X - i), CInt(Pos.Y - i), CInt(Pos.X + i), _
			CInt(Pos.Y + i))
            gr.DrawLine(P, CInt(Pos.X + i), CInt(Pos.Y - i), CInt(Pos.X - i), _
			CInt(Pos.Y + i))

            'Horizontal line
            gr.DrawLine(PBlue, 0, Pos.Y, Me.pic.Image.Width, Pos.Y)

            'Vertical line
            gr.DrawLine(PBlue, Pos.X, 0, Pos.X, pic.Image.Height)

        End Using
    End Sub

要选择下一个点对象，以下函数将提供帮助：

Private Function GetNextFreeItemIdNumber()
        Dim i As Integer
        Dim res As Integer = 1
        Dim S As clsStickStructure.StickPoint

        If Stick.Points Is Nothing OrElse Stick.Points.Length = 0 Then Return 1

        For i = 0 To Stick.Points.Length - 1
            S = Stick.GeItemById(Stick.Points(i).Id)
            If S.Equals(Nothing) Then
                Exit For
            Else
                res = S.Id + 1
            End If
        Next
        Return res
    End Function

关注点

我认为 VB.NET 非常易于使用，可以制作这样的工具。并且在拥有了火柴人对象作为数据之后，任何动画都将非常快速。

历史

• 2009 年 10 月 2 日：初始发布

该工具已准备好修复项目中的角度。但我今天没有时间将其包含进去。希望有人乐于使用这个项目。动画控制对于未来来说也是一个不错的工具。