分享到新浪微博 分享到QQ空间 打印

新年贺礼wwwww(程序)(渣)(无聊物)(源码)

新年贺礼wwwww(程序)(渣)(无聊物)(源码)

(原意某模拟口袋妖怪战斗动画的东西wwwww)
(可以做出很多奇怪的东西?)
程序:
主要类的源码
复制内容到剪贴板
代码:
Option Strict Off
Imports System.IO
Public Class DrawAnimationPMOldV2
    Private List As New Collection
    Private PointType As New Collection
    Private PointImgres As New Collection
    Private SpeedChange As New Collection
    Private DrawPad As Graphics
    Private PM1 As Image
    Private PM2 As Image
    Private pm1l As Point
    Private pm2l As Point
    Private TimeLine As Int32
    Dim Background As Image
    Private Running As New Threading.Thread(AddressOf RunThread)
    Private starttime As Date
    '当前格式:0,图片ID
    '          1,中心RGB代码,边缘RGB代码
    Private Function Paixu(ByVal SColl As Collection) As Collection
        Dim finish As Collection
        Dim i, j, k As Integer
        Dim minn, min As Integer
        k = SColl.Count
        For i = 1 To k
            For j = 1 To SColl.Count
            Next
        Next
    End Function
    Public Sub Init(ByVal PM1Loc As Point, ByVal PM2Loc As Point, ByVal DataPath As String, ByRef DefaultBackground As Image, ByRef DrawMainPad As Graphics, ByRef PM1I As Image, ByRef PM2I As Image)
        starttime = Now
        DrawMainPad.DrawEllipse(Pens.Blue, PM1Loc.X, PM1Loc.Y, 50, 50)
        DrawMainPad.DrawEllipse(Pens.Blue, PM2Loc.X, PM2Loc.Y, 50, 50)
        '       MsgBox(starttime)
        Running.Priority = Threading.ThreadPriority.BelowNormal
        DrawPad = DrawMainPad
        PM1 = PM1I
        PM2 = PM2I
        pm1l = PM1Loc
        pm2l = PM2Loc
        Background = DefaultBackground
        List.Clear()
        PointType.Clear()
        Dim read As New StreamReader(DataPath, System.Text.Encoding.Default)
        Dim getstr() As String
        Dim j As Integer
        j = 0
        Do
            j += 1
            If read.EndOfStream = True Then Exit Do
            getstr = Split(read.ReadLine, ",")
            If getstr(0) = "NewPoint" Then
                ' NewPoint,BaseX,BaseY,TargetX,TargetY,Type,Radius,StartTime,StayTime,SpeedInfo
                If Val(getstr(1)) < -900 Then getstr(1) = Val(getstr(1)) + 1000 + PM1Loc.X
                Debug.Print(Val(getstr(1)))
                If Val(getstr(2)) < -900 Then getstr(2) = Val(getstr(2)) + 1000 + PM1Loc.Y
                Debug.Print(Val(getstr(2)))
                If Val(getstr(3)) < -900 Then getstr(3) = Val(getstr(3)) + 1000 + PM2Loc.X
                Debug.Print(Val(getstr(3)))
                If Val(getstr(4)) < -900 Then getstr(4) = Val(getstr(4)) + 1000 + PM2Loc.Y
                Debug.Print(Val(getstr(4)))
                List.Add("Point," & Trim(getstr(1)) & "," & Trim(getstr(2)) & "," & Trim(getstr(3)) & "," & Trim(getstr(4)) & "," & Trim(getstr(5)) & "," & Trim(getstr(6)) & "," & Trim(getstr(7)) & "," & Trim(getstr(8)) & "," & Val(getstr(7)) + Val(getstr(8)) & "," & Val(getstr(9)))
                'Point,BaseX,BaseY,TargetX,TargetY,Type,Radius,StartTime,Staytime,SpeedInfo
            ElseIf getstr(0) = "NewSpeed" Then
                Dim x(0 To 1000) As String
                Dim z As Integer
                Dim tmp() As String
                z = 0
                Do
                    tmp = Split(read.ReadLine, ",")
                    If tmp(0) = "-1" Then
                        Exit Do
                    End If
                    x(z) = tmp(0)
                    z += 1
                    x(z) = tmp(1)
                    z += 1
                Loop
                SpeedChange.Add(x)
            ElseIf getstr(0) = "AddType" Then
                ' AddType,0,ImagePath,MoreSetting <=     ToDo:
                ' AddType,1,Alpha1,R1,G1,B1,Alpha2,R2,G2,B2
                If getstr(1) = "0" Then
                    Dim temp As Image = Image.FromFile(getstr(2))
                    PointImgres.Add(temp)
                    PointType.Add("0," & Str(PointImgres.Count))
                    '当前格式:0,图片ID
                ElseIf getstr(1) = "2" Then
                    Dim temp As Image = Image.FromFile(getstr(2))
                    PointImgres.Add(temp)
                    PointType.Add("2," & Str(PointImgres.Count))
                ElseIf getstr(1) = "1" Then
                    '          1,中心RGB代码,边缘RGB代码
                    PointType.Add("1," & Color.FromArgb(Val(getstr(2)), Val(getstr(3)), Val(getstr(4)), Val(getstr(5))).ToArgb & "," & Color.FromArgb(Val(getstr(6)), Val(getstr(7)), Val(getstr(8)), Val(getstr(9))).ToArgb)
                Else
                    MsgBox("配置读取错误:发生在Init 设置文件 " & DataPath & " 行: " & j, MsgBoxStyle.Critical, "Error")
                End If
                ' AddType,1,CenterRGBCode,OutRGBCode,MoreSetting <= ToDo:
            ElseIf getstr(0) = "SetBackGround" Then
                'SetBackGround,ImagePath
                Background = Image.FromFile(getstr(1))
            ElseIf getstr(0) = "AddBackColor" Then
                'AddBackColor,Alpha,R,G,B
                Dim tempg As Graphics
                Dim tempp As New Pen(Color.FromArgb(Val(getstr(1)), Val(getstr(2)), Val(getstr(3)), Val(getstr(4))))
                tempg = Graphics.FromImage(Background)
                Dim i As Integer
                For i = 1 To Background.Width
                    tempg.DrawLine(tempp, i, 1, i, Background.Height)
                Next
            End If
        Loop
    End Sub
    Public Sub StartDraw()
        On Error Resume Next
        Running.Start()
        Running.Resume()
    End Sub
    Public Sub StopDraw()
        On Error Resume Next
        Running.Suspend()
    End Sub
    Private Function Abs(ByVal Num As Double) As Double
        If Num < 0 Then Num = -Num
        Abs = Num
    End Function
    Private Function statuscalc(ByVal status As Single, ByVal X1 As Double, ByVal X2 As Double, ByVal Y1 As Double, ByVal Y2 As Double) As Point
        On Error Resume Next
        statuscalc.X = X1 + (X2 - X1) * status
        statuscalc.Y = Y1 + (Y2 - Y1) * status
    End Function
    '绘制背景
    Private Sub DrawBGI()
        DrawPad.DrawImage(Background, 0, 0)
    End Sub
    '绘图1
    Private Sub DrawPM1()
        DrawPad.DrawImage(PM1, pm1l)
    End Sub
    '绘图2
    Private Sub DrawPM2()
        DrawPad.DrawImage(PM2, pm2l)
    End Sub
    '计算当前帧数
    Private Function CalcF(ByVal NowTime As Integer) As Integer
        Return NowTime / 42
    End Function
    Private Function Calcqx(ByVal locx As Single, ByVal locy As Single, ByVal xl As Single) As Point
        Dim d As Single
        d = locx ^ 2 + locy ^ 2
        Calcqx.X = xl - (locy * xl) / Math.Sqrt(d)
        Calcqx.Y = (xl / locx) * Math.Sqrt(d) + (xl / locx) - (locy * (xl / locx)) / Math.Sqrt(d)
    End Function
    Private Sub RunThread()
        Dim Setting As String()
        Dim tmp1 As Int32
        Dim i As Integer
        Do
            Dim c As Boolean
            c = False
            DrawBGI()
            DrawPM1()
            DrawPM2()
            '      Debug.Print(TimeLine)
            tmp1 = (Now.Minute - starttime.Minute) * 60 + Now.Second - starttime.Second
            TimeLine = Now.Millisecond - starttime.Millisecond + tmp1 * 1000
            For i = 1 To List.Count
                Setting = Split(List(i), ",")
                'Point,BaseX,BaseY,TargetX,TargetY,Type,Radius,StartTime,Staytime,SpeedInfo
                '1       2        3          4           5        6        7          8               9           10
                If Setting(0) = "Point" And Val(Setting(7)) <= TimeLine And Val(Setting(9)) >= TimeLine Then
                    Dim a As Point
                    c = True
                    a = statuscalc((TimeLine - Val(Setting(7))) / Val(Setting(8)), Val(Setting(1)), Val(Setting(3)), Val(Setting(2)), Val(Setting(4)))
                    'a = Calcqx(a.X, a.Y, 20)
                    DrawPoint(a.X, a.Y, Val(Setting(6)), Val(Setting(5)), CalcF(TimeLine))
                    List.Remove(i)
                    List.Add("Point," & a.X & "," & a.Y & "," & Trim(Setting(3)) & "," & Trim(Setting(4)) & "," & Trim(Setting(5)) & "," & Trim(Setting(6)) & "," & TimeLine & "," & Trim(Setting(8)) - TimeLine + Val(Setting(7)) & "," & Val(Setting(7)) + Val(Setting(8)) & "," & Val(Setting(10)), , , i - 1)
                    '       CalcSpeedChange(TimeLine, i)
                End If
            Next
            If c = False Then
                TimeLine = 0
                List.Clear()
                PointType.Clear()
                PointImgres.Clear()
                Running.Suspend()
            End If
        Loop
    End Sub
    Private Sub CalcSpeedChange(ByVal TimeLine As Integer, ByVal Index As Integer)
        Dim Setting() As String
        Setting = Split(List(Index), ",")
        Dim speed, ltimeline As Integer
        '        On Error GoTo Error1
        Dim SI() As String
        SI = SpeedChange(Val(Setting(10)))
        Dim tmp As String()
        Dim i As Integer
        i = 0
        Do
            If i >= SI.Count Then Exit Do
            If SI(i) = "-1" Then Exit Do
            If Val(SI(i)) < TimeLine And Val(SI(i)) > ltimeline Then
                speed = Val(SI(i + 1))
                ltimeline = Val(SI(i))
            End If
            i += 2
        Loop
        List.Remove(Index)
        Dim dis As Single
        dis = Math.Sqrt((Val(Setting(1)) - Val(Setting(3))) ^ 2 + (Val(Setting(2)) - Val(Setting(4))) ^ 2)
        MsgBox(Setting(8) & vbCrLf & dis / speed & vbCrLf & vbCrLf)
        MsgBox(dis)
        MsgBox(speed)
        List.Add("Point," & Trim(Setting(1)) & "," & Trim(Setting(2)) & "," & Trim(Setting(3)) & "," & Trim(Setting(4)) & "," & Trim(Setting(5)) & "," & Trim(Setting(6)) & "," & Trim(Setting(7)) & "," & dis / speed & "," & Val(Setting(7)) + dis / speed & "," & Val(Setting(9)))
Error1:
    End Sub
    Public Sub EndDraw()
        If Running.ThreadState = Threading.ThreadState.Suspended Then
            Running.Resume()
            Running.Abort()
        End If
        Running.Abort()
    End Sub
    Private Sub DrawPoint(ByVal X As Integer, ByVal Y As Integer, ByVal Radius As Integer, ByVal Type As Integer, ByVal Frame As Integer)
        Dim TypeSetting As String()
        TypeSetting = Split(PointType(Type), ",")
        '当前格式:0,图片ID
        '          1,中心RGB代码,边缘RGB代码
        '          2,ImageID
        If TypeSetting(0) = 1 Then
            Dim CI, O As Color
            Dim Usecolor As Color
            CI = Color.FromArgb(TypeSetting(1))
            O = Color.FromArgb(TypeSetting(2))
            Dim Status As Double
            Dim i As Integer
            For i = 0 To Radius
                Status = i / Radius
                Usecolor = Color.FromArgb(O.R * Status + CI.R * (1 - Status), O.G * Status + CI.G * (1 - Status), O.B * Status + CI.B * (1 - Status))
                DrawPad.DrawEllipse(New Pen(Usecolor), X - i \ 2, Y + Radius - i \ 2, i, i)
            Next
        ElseIf TypeSetting(0) = 0 Then
            'ToDo: DrawPic
            DrawPad.DrawImage(PointImgres(Val(TypeSetting(1))), X, Y)
        ElseIf Val(TypeSetting(0)) = 2 Then
            Dim temp As Image
            temp = PointImgres(Val(TypeSetting(1)))
            '         MsgBox(Frame)
            Frame = Frame Mod (temp.GetFrameCount(New System.Drawing.Imaging.FrameDimension(temp.FrameDimensionsList(0))))
            temp.SelectActiveFrame(New System.Drawing.Imaging.FrameDimension(temp.FrameDimensionsList(0)), Frame)
            DrawPad.DrawImage(temp, X, Y)
        Else
            'ToDo:Error Prosess
            MsgBox("运行时错误 1:配置读取错误   发生在DrawAnimationPM.DrawPoint", MsgBoxStyle.Critical, "Runtime Error")
        End If
    End Sub

    Protected Overrides Sub Finalize()
        MyBase.Finalize()
    End Sub
    Public Sub New()
    End Sub
End Class
[ 本帖最后由 lzn3303768 于 2010-2-14 15:57 编辑 ]
附件: 您所在的用户组无法下载或查看附件
...大家多给我扣热度呀,期盼-273热度中...

TOP

好复杂……小东西代码超过一千就停手的路过……
本帖最近评分记录
  • lzn3303768 热度 +1 wwwwwww那个注释也占了比较多的部分... 2010-2-15 09:26
谁不怀念苏联,谁就没有良心;谁想回到苏联,谁就没有头脑.

Woodu.ME--从零开始的博客生活

TOP

其实我觉得您说说思路比较好……

TOP