| 投稿日 | ： 2007/04/11(Wed) 12:17 |
| 投稿者 | ： ダンボ |
| Ｅメール | ： |
| ＵＲＬ | ： |
| タイトル | ： Re^14: PictureBox上のLineを回転させる方法 |
編集2時間、試験30秒くらいかな。
1次元が2次元になる場合はコード量は2倍ではなく2乗になることを痛感しました。
コマンド処理最後の Call DLine2Shape(DLine1, Line1)は
Set Line1 = DLine2Shape(DLine1)のようなインタフェースにしたかったが
コンパイルエラーが取れずに逃げました。誰か教えて。
Option Explicit
Const PAI = 3.1415926
Private Type PPoint
R As Double
T As Double
End Type
Private Type DPoint
X As Double
Y As Double
End Type
Private Type PLine
P1 As PPoint
P2 As PPoint
End Type
Private Type DLine
D1 As DPoint
D2 As DPoint
End Type
Private Sub Command3_Click()
Dim DLine1 As DLine, PLine1 As PLine, Org As DPoint
Org.X = Picture1.Width / 2
Org.Y = Picture1.Height / 2
DLine1 = Shape2DLine(Line1)
DLine1 = DLine2NewDeca(DLine1, Org)
PLine1 = DLine2PLine(DLine1)
PLine1 = RotatePLine(PLine1, Radian(90))
DLine1 = PLine2DLine(PLine1)
DLine1 = DLine2OrgDeca(DLine1, Org)
Call DLine2Shape(DLine1, Line1)
End Sub
Private Sub Command4_Click()
Dim DLine1 As DLine, PLine1 As PLine, Org As DPoint
Org.X = Picture1.Width / 2
Org.Y = Picture1.Height / 2
DLine1 = Shape2DLine(Line1)
DLine1 = DLine2NewDeca(DLine1, Org)
PLine1 = DLine2PLine(DLine1)
PLine1 = ReversePLine(PLine1, "X")
PLine1 = ReversePLine(PLine1, "Y")
DLine1 = PLine2DLine(PLine1)
DLine1 = DLine2OrgDeca(DLine1, Org)
Call DLine2Shape(DLine1, Line1)
End Sub
Private Function DLine2NewDeca(DLine1 As DLine, Org As DPoint) As DLine
DLine2NewDeca.D1 = DPoint2NewDeca(DLine1.D1, Org)
DLine2NewDeca.D2 = DPoint2NewDeca(DLine1.D2, Org)
End Function
Private Function DPoint2NewDeca(Deca1 As DPoint, Org As DPoint) As DPoint
DPoint2NewDeca.X = Deca1.X - Org.X
DPoint2NewDeca.Y = Deca1.Y - Org.Y
End Function
Private Function DLine2OrgDeca(DLine1 As DLine, Org As DPoint) As DLine
DLine2OrgDeca.D1 = DPoint2OrgDeca(DLine1.D1, Org)
DLine2OrgDeca.D2 = DPoint2OrgDeca(DLine1.D2, Org)
End Function
Private Function DPoint2OrgDeca(Deca1 As DPoint, Org As DPoint) As DPoint
DPoint2OrgDeca.X = Deca1.X + Org.X
DPoint2OrgDeca.Y = Deca1.Y + Org.Y
End Function
Private Function Shape2DLine(Line1 As Line) As DLine
Shape2DLine.D1.X = Line1.X1
Shape2DLine.D1.Y = Line1.Y1
Shape2DLine.D2.X = Line1.X2
Shape2DLine.D2.Y = Line1.Y2
End Function
Private Function DLine2Shape(DLine1 As DLine, Line1 As Line) ' As Line
Line1.X1 = DLine1.D1.X
Line1.Y1 = DLine1.D1.Y
Line1.X2 = DLine1.D2.X
Line1.Y2 = DLine1.D2.Y
End Function
Private Function Line_on_PPoint(DLine1 As DLine) As PLine
DLine2NewDeca.D1 = DPoint2NewDeca(DLine1.D1, Org)
DLine2NewDeca.D2 = DPoint2NewDeca(DLine1.D2, Org)
End Function
Private Function DLine2PLine(DLine1 As DLine) As PLine
DLine2PLine.P1 = DPoint2PPoint(DLine1.D1)
DLine2PLine.P2 = DPoint2PPoint(DLine1.D2)
End Function
Private Function DPoint2PPoint(DPoint1 As DPoint) As PPoint
DPoint2PPoint.R = Sqr(DPoint1.X ^ 2 + DPoint1.Y ^ 2)
DPoint2PPoint.T = ArcTan(DPoint1.X, DPoint1.Y)
End Function
Private Function PLine2DLine(PLine1 As PLine) As DLine
PLine2DLine.D1 = PPoint2DPoint(PLine1.P1)
PLine2DLine.D2 = PPoint2DPoint(PLine1.P2)
End Function
Private Function PPoint2DPoint(PPoint1 As PPoint) As DPoint
PPoint2DPoint.X = PPoint1.R * Cos(PPoint1.T)
PPoint2DPoint.Y = PPoint1.R * Sin(PPoint1.T)
End Function
Private Function RotatePLine(PLine1 As PLine, DT As Double) As PLine
RotatePLine.P1 = RotatePPoint(PLine1.P1, DT)
RotatePLine.P2 = RotatePPoint(PLine1.P2, DT)
End Function
Private Function RotatePPoint(PPoint1 As PPoint, DT As Double) As PPoint
RotatePPoint.R = PPoint1.R
RotatePPoint.T = PPoint1.T + DT
End Function
Private Function ReversePLine(PLine1 As PLine, DR As String) As PLine
ReversePLine.P1 = ReversePPoint(PLine1.P1, DR)
ReversePLine.P2 = ReversePPoint(PLine1.P2, DR)
End Function
Private Function ReversePPoint(PPoint1 As PPoint, DR As String) As PPoint
ReversePPoint.R = PPoint1.R
Select Case DR
Case "X"
ReversePPoint.T = -PPoint1.T
Case "Y"
ReversePPoint.T = PAI - PPoint1.T
Case Else
Stop
End Select
End Function
Private Function Radian(D As Double) As Double
Radian = PAI * D / 180
End Function
Private Function ArcTan(X As Double, Y As Double) As Double
Select Case X
Case Is > 0
ArcTan = Atn(Y / X)
Case Is < 0
ArcTan = Atn(Y / X) + PAI
Case Else
ArcTan = Sgn(Y) * PAI / 2
End Select
End Function