投稿者 snowmansnow  (社会人) 投稿日時 2021/2/23 18:43:39
こんにちは、るきお様、魔界の仮面弁士様、ニケ様、皆様、
またVBAのinkpictureで質問があります

段落、行、単語に分けて四角で囲む例がwebであったので、移植してみました。
webの例では、グラフィックで四角を描画していましたが、やり方がわからず(render?)
strokeの色変えで描画してみました。
その後で、文字の黒色以外の色のstrokeを配列にして、削除するボタンを作ったつもりでしたが、
複数の削除の1回目以降で、配列の中身(strokeのインデックス)が失われるようでした。
for each 〇〇 in strokesの中身を回していますが、〇〇の型がわからず、as objectにしています。
〇〇にかかわるdeleteをすると、他の〇〇.idの全部の値が失われるのでしょうか?
msgboxで配列の値を表示すると、1回目の削除まで値を保持して、削除後、他の値を失ってるように見えます。

フォームに大きなinkpicture2と小さなinkpicture3、inkpicture4を配置して
「四角で囲むボタン」CommandButton36と、「削除のボタン」CommandButton37を配置して、
大きなinkpicture2に、横書きで3行くらい記入して、
inkpicture3、inkpicture4に一文字ずつくらい記入してボタンを押します。

最初、削除が悪さをしてると思い、逆に黒いstrokeを追加していくバージョンも検討したので、
このような形になっていますが、配列が悪さをしてるようなので、どちらもダメだと思います。
配列が直れば、削除型でも追加型でも出来る気がします。

①グラフィック(render?)で描画する。
②配列の値を失わないやり方。
③その他
など、御教授いただけるとありがたいです。
よろしくお願いいたします。


Private Sub CommandButton36_Click()

'https://microsoft.public.windows.tabletpc.developer.narkive.com/05mR9JoA/bounding-box-of-individual-words-in-inkpicture
Dim div As InkDivider
Dim divUnits As IInkDivisionUnits
Dim paras As IInkDivisionUnits
Dim lines As IInkDivisionUnits
Dim segments As IInkDivisionUnits

Dim divUnit As IInkDivisionUnit
Dim para As IInkDivisionUnit
Dim line As IInkDivisionUnit
Dim segment As IInkDivisionUnit

Set div = New InkDivider
Set div.strokes = InkPicture2.ink.strokes
Set res = div.Divide()

Set paras = div.Divide.ResultByType(IDT_Paragraph)
Set lines = div.Divide.ResultByType(IDT_Line)
Set segments = div.Divide.ResultByType(IDT_Segment)

'https://docs.microsoft.com/en-us/windows/win32/api/msinkaut15/ne-msinkaut15-inkdivisiontype
'Name    Description
'IDT_Segment A recognition segment.
'IDT_Line    A line of handwriting that contains one or more recognition segments.
'IDT_Paragraph   A block of strokes that contains one or more lines of handwriting.
'IDT_Drawing Ink that is not text.

Dim rect1 As InkRectangle

   Dim strokes(1) As IInkStrokeDisp
For Each para In paras
    Set rect1 = para.strokes.GetBoundingBox(IBBM_Default)
     
     With InkPicture2.ink
        Set strokes(0) = .CreateStroke(MakeRectangle(rect1.left - 2, rect1.top + 4, rect1.right + 4, rect1.bottom - 2), Null)
     End With
    
         With strokes(0).DrawingAttributes
            .FitToCurve = IsCircle
            .Color = RGB(0, 0, 255)
        End With
 Next
For Each line In lines
    Set rect1 = line.strokes.GetBoundingBox(IBBM_Default)
     
      With InkPicture2.ink
        Set strokes(0) = .CreateStroke(MakeRectangle(rect1.left, rect1.top, rect1.right, rect1.bottom), Null)
     End With
    
         With strokes(0).DrawingAttributes
            .FitToCurve = IsCircle
            .Color = 255
        End With
 Next
For Each segment In segments
    Set rect1 = segment.strokes.GetBoundingBox(IBBM_Default)
     
     With InkPicture2.ink
        Set strokes(0) = .CreateStroke(MakeRectangle(rect1.left + 2, rect1.top + 2, rect1.right - 4, rect1.bottom + 2), Null)
     End With
    
         With strokes(0).DrawingAttributes
            .FitToCurve = IsCircle
            .Color = RGB(0, 128, 0)
        End With
 Next

    InkPicture2.AutoRedraw = False
    With InkPicture2.ink.CreateStrokes()
            .Add strokes(0)
    End With
    InkPicture2.AutoRedraw = True

    
End Sub
Private Function MakeRectangle(left As Long, top As Long, right As Long, bottom As Long) As Long()
'http://www.vbforums.com/showthread.php?763319-Drawing-shapes-on-ink-picture
    Dim Coords() As Long
    ReDim Coords(9)
        Coords(0) = left
        Coords(1) = top
        Coords(2) = right
        Coords(3) = top
        Coords(4) = right
        Coords(5) = bottom
        Coords(6) = left
        Coords(7) = bottom
        Coords(8) = left
        Coords(9) = top
    MakeRectangle = Coords
End Function
Private Sub CommandButton38_Click()

文字制限のため、問題の削除部分は追加投稿いたします