選択されているパスを線分の集合に変換(Ⅱ)

選択されているパスを線分の集合に変換(Ⅱ) <TOP>

GetPath 選択されたパス内の直線の端点および曲線の制御点を定義する座標を取得
BeginPath hDCで指定されたデバイスコンテキストのパスの作成
EndPath BeginPathで開始したパスの作成を終了
PolyDraw 直線やベジエ曲線群の描画
ExtCreatePen 指定されたスタイル、幅、ブラシ属性を持つペンを作成
SetGraphicsMode 指定されたデバイスコンテキストのグラフィックスモードを設定
GetDC デバイスコンテキストのハンドルを取得
ReleaseDC デバイスコンテキストを解放

PenWidthを設定し「実行」をクリックすると、矩形領域パスを作成し、パス内直線の端点座標を取得、Points配列に格納します。

矩形領域を赤色のドットで描画し、間を置いて指定されたペン幅で青色のベジェ曲線を描画します。

最後に、Points配列に格納されている座標を黒色の点で描画しています。

'================================================================ '= 選択されているパスを線分の集合に変換(Ⅱ) '= (FlattenPath2.bas) '================================================================ #include "Windows.bi" Type POINTAPI X As Long Y As Long End Type Type LOGBRUSH lbStyle As Long lbColor As Long lbHatch As Long End Type ' 長方形の描画 Declare Function Api_Rectangle& Lib "gdi32" Alias "Rectangle" (ByVal hDC&, ByVal X1&, ByVal Y1&, ByVal X2&, ByVal Y2&) ' 論理ペンを作成 Declare Function Api_CreatePen& Lib "gdi32" Alias "CreatePen" (ByVal nPenStyle&, ByVal nWidth&, ByVal crColor&) ' 指定されたデバイスコンテキストのオブジェクトを選択 Declare Function Api_SelectObject& Lib "gdi32" Alias "SelectObject" (ByVal hDC&, ByVal hObject&) ' 論理オブジェクトを削除し、そのオブジェクトに関連付けられていたすべてのシステムリソースを解放 Declare Function Api_DeleteObject& Lib "gdi32" Alias "DeleteObject" (ByVal hObject&) ' 指定されたデバイスコンテキストの現在ペンを使ってパスが描かれている場合、そのパスを塗りつぶしの対象領域として再定義 Declare Function Api_WidenPath& Lib "gdi32" Alias "WidenPath" (ByVal hDC&) ' 現在のデバイスコンテキストに選択されているパスのすべての曲線を、一連の直線に変換 Declare Function Api_FlattenPath& Lib "gdi32" Alias "FlattenPath" (ByVal hDC&) ' 指定されたデバイスコンテキスト内で選択されたパス内の直線の端点および曲線の制御点を定義する座標を取得 Declare Function Api_GetPath& Lib "gdi32" Alias "GetPath" (ByVal hDC&, ByRef Points As POINTAPI, ByRef Types As Byte, ByVal PointNum&) ' hDCで指定されたデバイスコンテキストのパスの作成 Declare Function Api_BeginPath& Lib "gdi32" Alias "BeginPath" (ByVal hDC&) ' BeginPathで開始したパスの作成を終了 Declare Function Api_EndPath& Lib "gdi32" Alias "EndPath" (ByVal hDC&) ' 直線やベジエ曲線群の描画 Declare Function Api_PolyDraw& Lib "gdi32" Alias "PolyDraw" (ByVal hDC&, lppt As POINTAPI, lpbTypes As byte, ByVal cCount&) ' 指定されたスタイル、幅、ブラシ属性を持つペンを作成 Declare Function Api_ExtCreatePen& Lib "gdi32" Alias "ExtCreatePen" (ByVal dwPenStyle&, ByVal dwWidth&, ByRef lplb As LOGBRUSH, ByVal dwStyleCount&, ByRef lpStyle&) ' 指定されたデバイスコンテキストのグラフィックスモードを設定 Declare Function Api_SetGraphicsMode& Lib "gdi32" Alias "SetGraphicsMode" (ByVal hDC&, ByVal iMode&) ' 指定されたウィンドウのクライアント領域または画面全体を表すディスプレイデバイスコンテキストのハンドルを取得 Declare Function Api_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&) ' デバイスコンテキストを解放 Declare Function Api_ReleaseDC& Lib "user32" Alias "ReleaseDC" (ByVal hWnd&, ByVal hDC&) #define PS_COSMETIC 0 'コスメティックペン(幅は常に1で純色)を作成 #define PS_DASH 1 '破線のペンを作成(-------) #define PS_DASHDOT 3 '一点鎖線のペンを作成(-･-･-･-) #define PS_DASHDOTDOT 4 '二点鎖線のペンを作成(-･･-･･-) #define PS_DOT 2 '点線のペンを作成(･･･････) #define PS_ENDCAP_FLAT &H200 '端点キャップを平らにする #define PS_ENDCAP_ROUND &H0 '端点キャップを丸くする #define PS_ENDCAP_SQUARE &H100 '端点キャップを四角にする #define PS_GEOMETRIC &H10000 'ジオメトリックペン(幅は任意でパターンが使用できる)を作成 #define PS_INSIDEFRAME 6 '塗りつぶし #define PS_JOIN_BEVEL &H1000 '結合部分が平ら(ベベル接合) #define PS_JOIN_MITER &H2000 '接合がSetMiterLimit関数で設定した範囲内にあるとき、マイター接合(結合部分が尖る) #define PS_JOIN_ROUND &H0 '結合部分が丸くなる(ラウンド結合) #define PS_NULL 5 '空のペンを作成。描画は行われない #define PS_SOLID 0 '実線のペンを作成 #define PS_USERSTYLE 7 'ユーザ定義鎖線(WindowsNTのみ) #define GM_ADVANCED &H2 'WinNT･2K･XPグラフィックモード #define GM_COMPATIBLE &H1 '16ビットのWindowsと互換性があるグラフィックモード #define vbBlue &HFF0000 '青のカラーコード #define vbGreen &H00FF00 '緑のカラーコード #define vbRed &H0000FF '赤のカラーコード Var Shared Text1 As Object Var Shared Edit1 As Object Var Shared Picture1 As Object Var Shared Button1 As Object Picture1.Attach GetDlgItem("Picture1") Text1.Attach GetDlgItem("Text1") : Text1.SetFontSize 14 Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14 Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14 '================================================================ '= '================================================================ Declare Sub MainForm_Start edecl () Sub MainForm_Start() Text1.SetWindowText "PenWidth" & Chr$(13, 10) & " (5～25)" End Sub '================================================================ '= '================================================================ Declare Sub Button1_on edecl () Sub Button1_on() Var hDC As Long Var hPen As Long Var hOldPen As Long Var PointNum As Long Var lb As LOGBRUSH Var OldGM As Long Var i As Integer Var Ret As Long Static rcX1 As Long : rcX1 = 20 Static rcY1 As Long : rcY1 = 15 Static rcX2 As Long : rcX2 = 110 Static rcY2 As Long : rcY2 = 75 Static PenWidth As Long Picture1.Cls 'ペンの幅を設定 PenWidth = Val(Edit1.GetWindowtext) 'ピクチャボックスのDC取得 hDC = Api_GetDC(Picture1.GethWnd) 'グラフィックモードを設定 OldGM = Api_SetGraphicsMode(hDC, GM_ADVANCED) 'ペン幅を設定 hPen = Api_ExtCreatePen(PS_GEOMETRIC Or PS_SOLID Or PS_ENDCAP_SQUARE Or PS_JOIN_ROUND, PenWidth, lb, 0, ByVal 0) hOldPen = Api_SelectObject(hDC, hPen) '矩形パスを設定 Ret = Api_BeginPath(hDC) Ret = Api_Rectangle(hDC, rcX1, rcY1, rcX2, rcY2) Ret = Api_EndPath(hDC) '現在のペンを使ってパスを拡張 Ret = Api_WidenPath(hDC) Ret = Api_FlattenPath(hDC) 'ペンを選択 Ret = Api_SelectObject(hDC, hOldPen) Ret = Api_DeleteObject(hPen) 'DCからデータパスを取得 PointNum = Api_GetPath(hDC, ByVal 0, ByVal 0, 0) If (PointNum) Then Var Points(PointNum - 1) As POINTAPI Var Types(PointNum - 1) As Byte Ret = Api_GetPath(hDC, Points(0), Types(0), PointNum) End If 'ペンの色を赤に設定 hPen = Api_CreatePen(PS_DOT, 0, vbRed) hOldPen = Api_SelectObject(hDC, hPen) '矩形領域を赤で描画 Ret = Api_Rectangle(hDC, rcX1, rcY1, rcX2, rcY2) Ret = Api_SelectObject(hDC, hOldPen) Ret = Api_DeleteObject(hPen) Wait 300 'ペンの色を青に設定 hPen = Api_CreatePen(PS_SOLID, 1, vbBlue) hOldPen = Api_SelectObject(hDC, hPen) 'ベジエ曲線群の描画 Ret = Api_PolyDraw(hDC, Points(0), Types(0), PointNum) Ret = Api_SelectObject(hDC, hOldPen) Ret = Api_DeleteObject(hPen) Wait 300 'FlattenPathで取得した線分群の座標点を描画 Picture1.SetDrawWidth 4 For i = 0 To PointNum - 1 Picture1.Pset(Points(i).X, Points(i).Y) Next 'グラフィックモードを元に戻す Ret = Api_SetGraphicsMode(hDC, OldGM) 'デバイスコンテキストの解放 Ret = Api_ReleaseDC(Picture1.GethWnd, hDC) End Sub '================================================================ '= '================================================================ While 1 WaitEvent Wend Stop End