标题: 新年贺礼wwwww(程序)(渣)(无聊物)(源码) [打印本页]
作者: lzn3303768 时间: 2010-2-14 15:46 标题: 新年贺礼wwwww(程序)(渣)(无聊物)(源码)
(原意某模拟口袋妖怪战斗动画的东西wwwww)
(可以做出很多奇怪的东西?)
程序:[attach]25991[/attach]
主要类的源码复制内容到剪贴板
代码:
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 编辑 ]
作者: 最美我中文 时间: 2010-2-14 18:25
好复杂……小东西代码超过一千就停手的路过……
作者: roywillow 时间: 2010-2-15 10:13
其实我觉得您说说思路比较好……
| 欢迎光临 口袋社区-Poke The BBS (https://ww.poketb.com/) |
Powered by Discuz! 6.1.0F |