Dim PN As Integer '点の数
Dim ST As Integer 'ステップ
Dim L1 As Integer '制御線長さ１
Dim L2 As Integer '制御線長さ２
Dim S1 As Integer '制御線角度１
Dim S2 As Integer '制御線角度２
Dim DM As Integer '直径
Dim RD As Integer '半径
Dim LN As Integer '線の数
Dim paArray()() As Point '点配列の配列
|
Private Sub CalcPoint()
'頂点とステップの最大公約数
Dim A As Integer = PN
Dim B As Integer = ST
Dim C
For I = 0 To 1 Step 0
C = A Mod B
A = B
B = C
If B = 0 Then
Exit For
End If
Next I
LN = A
'描画データ作成
'最小公倍数が１でない場合 2から最小公倍数-1までの点が使用されないので
'開始点を１ずつずらして最小公倍数回描画する
Dim sin0 As Double
Dim sin1 As Double
Dim sin2 As Double
Dim cos0 As Double
Dim cos1 As Double
Dim cos2 As Double
Dim X0 As Integer
Dim Y0 As Integer
Dim XS As Integer '開始点
Dim YS As Integer '開始点
ReDim paArray(A - 1)
For K = 0 To A - 1
Dim plist As New List(Of Point)
XS = Math.Round(Math.Sin(K * 6.283 / PN) * RD) + RD + 50
YS = RD + 50 - Math.Round(Math.Cos(K * 6.283 / PN) * RD)
plist.Add(New Point(XS, YS)) '開始点保存
For I = 0 To PN / A
cos0 = Math.Cos(((ST * I) + K) * 6.283 / PN)
sin0 = Math.Sin(((ST * I) + K) * 6.283 / PN)
X0 = Math.Round(sin0 * RD) + RD + 50
Y0 = RD + 50 - Math.Round(cos0 * RD)
cos1 = Math.Cos(((ST * I) + K) * 6.283 / PN + S1 * 3.142 / 180)
sin1 = Math.Sin(((ST * I) + K) * 6.283 / PN + S1 * 3.142 / 180)
cos2 = Math.Cos(((ST * I) + K) * 6.283 / PN + S2 * 3.142 / 180)
sin2 = Math.Sin(((ST * I) + K) * 6.283 / PN + S2 * 3.142 / 180)
If I > 0 Then '終点とその制御点を保存
If I = PN / A Then '最後の頂点は最初と同じ
plist.Add(New Point(XS - Math.Round(cos2 * L2), YS - Math.Round(sin2 * L2)))
plist.Add(New Point(XS, YS))
'plist.Add(New Point(X0 - Math.Round(cos2 * L2), Y0 - Math.Round(sin2 * L2)))
Else
plist.Add(New Point(X0 - Math.Round(cos2 * L2), Y0 - Math.Round(sin2 * L2)))
plist.Add(New Point(X0, Y0))
'plist.Add(New Point(X0, Y0))
End If
End If
If I < PN / A Then '始点の制御点を保存
plist.Add(New Point(X0 + Math.Round(cos1 * L1), Y0 + Math.Round(sin1 * L1)))
End If
Next I
If CheckBox2.Checked Then '開始点上書きのため最初の線を繰り返す
plist.Add(New Point(plist(1).X, plist(1).Y))
plist.Add(New Point(plist(2).X, plist(2).Y))
plist.Add(New Point(plist(3).X, plist(3).Y))
End If
paArray(K) = plist.ToArray
Next K
End Sub
|
Private Sub SaveMetafile(ByVal sw As Integer)
Dim ms As MemoryStream = New MemoryStream
Dim mf As Metafile ' = New Metafile("metafiletest.wmf", ipHdc, EmfType.EmfPlusDual)
Dim grfx As Graphics = CreateGraphics()
Dim ipHdc As IntPtr = grfx.GetHdc
mf = New Metafile(ms, ipHdc, EmfType.EmfPlusDual)
grfx.ReleaseHdc(ipHdc)
grfx.Dispose()
Dim grfxMeta As Graphics = Graphics.FromImage(mf)
Dim LW As Double '線幅
Try
LW = Double.Parse(TextBox11.Text)
If LW < 0 Then Throw New Exception("LW<0")
Catch ex As Exception
LW = 1
End Try
Dim CL As Color '線色
Try
If TextBox12.Text = "" Then Throw New Exception("TextBox12.Text=""""")
CL = ColorTranslator.FromHtml(TextBox12.Text)
Catch ex As Exception
CL = Color.Black
End Try
Dim myPen As New Pen(CL, LW) 'ペンを作成
If CheckBox1.Checked Then 'ベジェ曲線を1本ずつ描く
Dim myPath As New GraphicsPath
For i = 0 To paArray.Length - 1
myPath.StartFigure() '新しい図形を開始する
For j = 0 To Int(paArray(i).Length / 3) - 1
myPath.AddBezier(paArray(i)(j * 3), paArray(i)(j * 3 + 1), paArray(i)(j * 3 + 2), paArray(i)(j * 3 + 3))
Next j
myPath.CloseFigure()
Next i
grfxMeta.DrawPath(myPen, myPath) 'パス図形を描画する()
Else 'ベジェ曲線をまとめて描く
For i = 0 To paArray.Length - 1
grfxMeta.DrawBeziers(myPen, paArray(i))
Next i
End If
grfxMeta.Dispose()
If sw = 0 Then 'ファイルに保存
SaveFileDialog1.Filter = "拡張メタファイル|*.emf|メタファイル|*.wmf|すべてのファイル|*.*"
If SaveFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
Dim fsm As FileStream = New FileStream(SaveFileDialog1.FileName, FileMode.Create, FileAccess.Write)
fsm.Write(ms.GetBuffer, 0, CType(ms.Length, Integer))
fsm.Close()
End If
ElseIf sw = 1 Then 'クリップボードにコピー
ClipboardMetafileHelper.PutEnhMetafileOnClipboard(Me.Handle, mf)
'この呼び出しには下記ページのコードが必要です
'「クリップボード上のメタファイルは、すべてのアプリケーションには表示されません」https://support.microsoft.com/ja-jp/kb/323530
End If
End Sub
|
Dim P1 As New Point(100, 20)
Dim P2 As New Point(180, 100)
Dim P3 As New Point(100, 180)
Dim P4 As New Point(20, 100)
G.DrawBezier(myPen, P1, P1, P2, P2)
G.DrawBezier(myPen, P2, P2, P3, P3)
G.DrawBezier(myPen, P3, P3, P4, P4)
G.DrawBezier(myPen, P4, P4, P1, P1)
|
こんな風に、線の接続点が離れてしまいます。
Dim pa() As Point = {P1, P1, P2, P2, P2, P3, P3, P3, P4, P4, P4, P1, P1}
G.DrawBeziers(myPen, pa)
|
これでも、開始点と終了点の接続がきれいになりません。
Dim pa1() As Point = {P1, P1, P2, P2, P2, P3, P3, P3, P4, P4, P4, P1, P1, P1, P2, P2}
G.DrawBeziers(myPen, pa)
|
これできれいになりました。
Dim myPath As New GraphicsPath
myPath.StartFigure() '新しい図形を開始する
myPath.AddBezier(P1, P1, P2, P2)
myPath.AddBezier(P2, P2, P3, P3)
myPath.AddBezier(P3, P3, P4, P4)
myPath.AddBezier(P4, P4, P1, P1)
myPath.CloseFigure()
G.DrawPath(myPen, myPath) 'パス図形を描画する
|
こうなります。