inkpictureでdeleteすると、他のstrokeのｲﾝﾃﾞｯｸｽなどが配列から無くなります

こんにちは、るきお様、魔界の仮面弁士様、ニケ様、皆様、
またVBAのinkpictureで質問があります

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

フォームに大きなinkpicture2と小さなinkpicture3、inkpicture4を配置して
「四角で囲むボタン」CommandButton36と、「削除のボタン」CommandButton37を配置して、
大きなinkpicture2に、横書きで３行くらい記入して、
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()

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

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


Private Sub CommandButton37_Click()
 Dim myStroke As Object
 Dim c As Variant
     Dim dels() As Long
   
    ReDim dels(0)
    MsgBox InkPicture2.ink.strokes.Count
   For Each myStroke In InkPicture2.ink.strokes
    If InkPicture2.ink.strokes(myStroke.id - 1).DrawingAttributes.Color <> 0 Then
    ReDim dels(UBound(dels) + 1)
     dels(UBound(dels) - 1) = myStroke.id
    MsgBox (UBound(dels)) & "-" & dels(UBound(dels) - 1)
    Else
    End If
 Next
    InkPicture2.AutoRedraw = True
    MsgBox (UBound(dels))

   Dim strokesd As IInkStrokeDisp
   
   Dim strokesToDelete As MSINKAUTLib.InkStrokes
  
   Set strokesToDelete = InkPicture2.ink.CreateStrokes()

   For d = (UBound(dels) - 1) To 1 Step -1
 '  Set strokesd = InkPicture2.ink.strokes(10)
    MsgBox d & "=" & dels(d)
 '  InkPicture2.ink.strokes.Remove strokesd
   InkPicture2.ink.DeleteStroke InkPicture2.ink.strokes(29)
   InkPicture2.AutoRedraw = True
  Next

'インクを足す事はできる・・・
Dim strokes As MSINKAUTLib.InkStrokes
Set combinedInk = InkPicture2.ink
Set strokes = InkPicture3.ink.strokes
iret = combinedInk.AddStrokesAtRectangle(strokes, strokes.GetBoundingBox())
Set strokes = InkPicture4.ink.strokes
iret = combinedInk.AddStrokesAtRectangle(strokes, strokes.GetBoundingBox())
'https://microsoft.public.windows.tabletpc.developer.narkive.com/xeodljDK/rendering-ink-from-multiple-inkpictures-in-the-same-form


InkPicture2.AutoRedraw = True

End Sub

よろしくお願いします

コードの内容は全く読み取っていないのですが、
> ReDim dels(UBound(dels) + 1)

For Each ループ内で繰り返し行うというのであれば、
Preserve キーワード付きで ReDim する必要があるのでは。

もしくは 配列の代わりに VBA.Collection を使うとか。

魔界の仮面弁士様、大変ありがとうございます。
プリザーブを修正してみましたところ、１回目は動くようになりました。

でも、２回目やってみると、「実行時エラー５。プロシジャーの呼び出し、または引数が不正です」
になってしまいます。（下記の場所）
前回教えてもらった、シート上にストロークデータを記載する。をやってみると、ｓｔ．ｉｄが飛んでいます。
何かリフレッシュみたいに、連番に戻す命令があるのでしょうか？
他に何か理由があるのでしょうか？
よろしくお願いします。


修正版
Private Sub CommandButton37_Click()
 Dim myStroke As Object
 Dim c As Variant
     Dim dels() As Long
   
    ReDim dels(0)
 '   MsgBox InkPicture2.ink.strokes.Count
   For Each myStroke In InkPicture2.ink.strokes
    If InkPicture2.ink.strokes(myStroke.id - 1).DrawingAttributes.Color <> 0 Then　・・・ここでエラー
    ReDim Preserve dels(UBound(dels) + 1)
     dels(UBound(dels) - 1) = myStroke.id
 '   MsgBox (UBound(dels)) & "-" & dels(UBound(dels) - 1)
    Else
    End If
 Next
    InkPicture2.AutoRedraw = True
 '   MsgBox (UBound(dels))

   Dim strokesd As IInkStrokeDisp
   
   Dim strokesToDelete As MSINKAUTLib.InkStrokes
  
   Set strokesToDelete = InkPicture2.ink.CreateStrokes()

   For d = (UBound(dels) - 1) To 0 Step -1
 '  Set strokesd = InkPicture2.ink.strokes(dels(d) - 1)
  '  MsgBox d & "=" & dels(d)
  ' InkPicture2.ink.strokes.Remove strokesd
'    InkPicture2.ink.DeleteStroke InkPicture2.ink.strokes(30)
  InkPicture2.ink.DeleteStroke InkPicture2.ink.strokes(dels(d) - 1)
   InkPicture2.AutoRedraw = True
  Next

'インクを足す事はできる・・・
'Dim strokes As MSINKAUTLib.InkStrokes
'Set combinedInk = InkPicture2.ink
'Set strokes = InkPicture3.ink.strokes
'iret = combinedInk.AddStrokesAtRectangle(strokes, strokes.GetBoundingBox())
'Set strokes = InkPicture4.ink.strokes
'iret = combinedInk.AddStrokesAtRectangle(strokes, strokes.GetBoundingBox())
'https://microsoft.public.windows.tabletpc.developer.narkive.com/xeodljDK/rendering-ink-from-multiple-inkpictures-in-the-same-form


InkPicture2.AutoRedraw = True

End Sub

こんばんは、
２回目のエラーが頻発し、頭がこんがらがってましたが、
ｉｄが変わっても、カウントは変わらなかったので、頭を切り替えて、下記に変更してみたら動きました。

今回は、同じstroke群の中で色で、文字とグラフィックを区別してるのですが、
何か、MSINKAUTLib.inkrendererの中のdrawstrokeとかが、グラフィックなのかなぁ？と思ってます。
（cifies the strokes to draw using the given Graphics object or device context.）と書いていて、
デバイスコンテキスト？Graphic g　とかの事かな？とか思ってまして、
簡単なヒントというかアドバイス（違うよとか、それだよとか）頂けたら、また頑張れる気がします。
よろしくお願いします。

再修正版
Private Sub CommandButton37_Click()
 
    For ind = InkPicture2.ink.strokes.Count - 1 To 0 Step -1
    If InkPicture2.ink.strokes.Item(ind).Deleted = False Then
 '   MsgBox "id-" & ind & "-" & InkPicture2.ink.strokes.Item(ind).DrawingAttributes.Color
  
    If InkPicture2.ink.strokes.Item(ind).DrawingAttributes.Color <> 0 Then
    
   InkPicture2.ink.DeleteStroke InkPicture2.ink.strokes.Item(ind)
    
    Else
    End If
    Else
    End If
 Next
    InkPicture2.AutoRedraw = True

'インクを足す事はできる・・・
'Dim strokes As MSINKAUTLib.InkStrokes
'Set combinedInk = InkPicture2.ink
'Set strokes = InkPicture3.ink.strokes
'iret = combinedInk.AddStrokesAtRectangle(strokes, strokes.GetBoundingBox())
'Set strokes = InkPicture4.ink.strokes
'iret = combinedInk.AddStrokesAtRectangle(strokes, strokes.GetBoundingBox())
'https://microsoft.public.windows.tabletpc.developer.narkive.com/xeodljDK/rendering-ink-from-multiple-inkpictures-in-the-same-form

End Sub

最初の質問では、
　InkPicture2.ink.DeleteStroke InkPicture2.ink.strokes(29)
のように固定値 29 に対して DeleteStroke していたのに対し、今回は
　InkPicture2.ink.DeleteStroke InkPicture2.ink.strokes(dels(d) - 1)
のような変動値にしているのですね?


今回の場合、Strokes プロパティから得られる InkStrokes コレクションに渡す引数が
間違っています。InkStrokes コレクションに対しては
　.strokes( Id )
ではなく
　.strokes( Index )
が求められます。
Id と Index は全く別物であることに気を付けましょう。


> やってみると、ｓｔ．ｉｄが飛んでいます。
Index は連番を保証しますが、ストロークの Id は連番を保証するものではありません。

ストロークが削除されたとしても、各ストロークの Id は変化しませんが、
ストロークが削除されると、それ以降のストロークの Index は減少するためです。

それゆえ、ストロークの追加・削除によって、Index と Id の組み合わせが変化することになります。


たとえば、3 本のストロークがあって、
　InkPicture1.Ink.InkPicture1.Ink.Strokes(0).Id が 1
　InkPicture1.Ink.InkPicture1.Ink.Strokes(1).Id が 2
　InkPicture1.Ink.InkPicture1.Ink.Strokes(2).Id が 3
となっているときに、
　InkPicture1.Ink.DeleteStroke InkPicture1.Ink.Strokes(Index:=1)
を実行すれば、
　InkPicture1.Ink.InkPicture1.Ink.Strokes(0).Id が 1
　InkPicture1.Ink.InkPicture1.Ink.Strokes(1).Id が 3
という状態になるわけです。


> dels(UBound(dels) - 1) = myStroke.id
今回のケースでは、Id の一覧を管理している点を見直すべきでしょう。
処理として必要なのは、Id や Index ではなく、Stroke オブジェクトそのもののはずです。

ですから、 Id や Index を 「As Long な配列」として管理するのではなく、
それぞれのストロークそのものを「As IInkStrokeDisp な配列」、または
「As VBA.Collection な汎用コレクション」あるいは
「As InkDisp な別インクコレクション」などで管理しておく方が、手っ取り早いのではないでしょうか。

あるいは、複数ストロークの「一括削除」などが目的であれば、戻したい状態のストロークを
バイナリデータとして変数もしくはファイルに保持しておき、リロードするという手もあります。

Option Explicit

Private SavedStrokes() As Byte



Private Sub CommandButton1_Click()

    '現在のストロークをバイナリとして保持 

    SavedStrokes = InkPicture1.Ink.Save()

End Sub



Private Sub CommandButton2_Click()

    '保持しておいたストロークを復元 

    Dim newInk As InkDisp

    Set newInk = New InkDisp

    newInk.Load SavedStrokes

    

    InkPicture1.InkEnabled = False

    Set InkPicture1.Ink = newInk

    InkPicture1.InkEnabled = True

End Sub

> プリザーブを修正してみましたところ、１回目は動くようになりました。
今回のケースに限りませんが、ループ内で毎回 ReDim Preserve するような
コーディングはあまり好ましくありません。Preserve の回数は最小限に留めましょう。

現在のストローク総数は .Count で得られるので、最初に一回だけ
総数分の領域を ReDim で確保しておけば、ループ内で毎回
ReDim Preserve しなおす必要はないと思いますよ。

まぁ、件数が少ない場合はさほど問題になりませんが…。
https://vbabeginner.net/redim-preserve-really-slow/

こんばんは、魔界の仮面弁士様
忙しい中、お時間割いて頂き、お返事ありがとうございます。

頭がこんがらがっていた時、
るきお様の別件のinkpicture.refresh()も試して、vbaではエラーになって、余計こんがらがったり、
Set newInk = New InkDisp
    newInk.Load ～～の
'https://stackoverflow.com/questions/3960729/how-to-erase-or-reload-strokes-to-an-inkpicture-in-vba-for-ms-access
を見つけても、vbaで実現できずに、煮詰まったりしていました。
今回バイナリセーブの例を出して頂いて、スッキリしました。
preserveの御指摘も端的で、総数を.countで取得も、全くその通りでした。

宜しければ、inkpictureで、線画など描画のヒント（背景も読めないし、出来ない旨のｗｅｂもありました）を頂ければ、ありがたいです。

今回の３つのboundingboxに加えて、GetStrokesFromTextRangeを順に調べたら、文字単位のboundingboxが取得出来るかな？と、思っています。（日本語）
でも、英語の筆記体は、文字に区別できなさそうで、どうやったら良いのかな？と思っています。
nodeとかleafとかいうものが、それに当たるのかな？とか困っています。
やってみて、また分からない所など、お聞きしますので、御教授お願いしたいです。
よろしくお願いします。

ソースを貼る場合には、 CODE ブロックタグを併用して頂けると読みやすいです。
http://rucio.cloudapp.net/Usage.aspx


> 何か、MSINKAUTLib.inkrendererの中のdrawstrokeとかが、グラフィックなのかなぁ？と思ってます。

質問の意図が良く分かりませんが、DrawStroke メソッドは単一ストローク単位の描画、
Draw メソッドは複数のストローク群の描画にあたりますね。

InkRenderer オブジェクトの Draw メソッドの簡易サンプルを載せておきます。
現在のストロークの内容をデスクトップに転写するものです。

Option Explicit

Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr

Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long

Private Sub CommandButton1_Click()

    Dim r As IInkRenderer

    Set r = New InkRenderer

    Dim hDC As LongPtr

    hDC = GetDC(0)

    r.Draw hDC, InkPicture1.Ink.Strokes

    ReleaseDC 0, hDC

End Sub

> （cifies the strokes to draw using the given Graphics object or device context.）と書いていて、
「Specifies the strokes」なのに、クリップボードにコピーすると
「cifies the strokes」に化けてしまう現象が出ますね…? なんだろう。

それはさておき：
InkRenderer オブジェクトの Draw メソッドや DrawStroke メソッドは、
第二引数で指定したストローク(InkStrokes or IInkStrokeDisp) の内容を
第一引数に指定したデバイス コンテキスト ハンドルに描画する処理です。
https://docs.microsoft.com/en-us/windows/win32/api/msinkaut/nf-msinkaut-iinkrenderer-drawstroke
https://docs.microsoft.com/en-us/windows/win32/api/msinkaut/nf-msinkaut-iinkrenderer-draw

VB6 だと、hDC プロパティでデバイス コンテキストのハンドルを得られますが、
VBA だとそれが無いので、API を使ってハンドルを得る必要があるでしょう。
https://excel.syogyoumujou.com/memorandum/get_dc.html

> vbaで実現できずに、煮詰まったりしていました。
> 今回バイナリセーブの例を出して頂いて、スッキリしました。
Save & Load の例として、昨年書いていたこのあたりも。
http://rucio.cloudapp.net/ThreadDetail.aspx?ThreadId=30478


> 線画など描画のヒント（背景も読めないし、出来ない旨のｗｅｂもありました）を頂ければ、ありがたいです。
すでに
　https://www.vbforums.com/showthread.php?763319-Drawing-shapes-on-ink-picture
を利用したコードを書かれているようなので、ストロークの扱いは省くとして。

既存の画像を読み込むなら、LoadPicture を使えます。

Set InkPicture1.Picture = LoadPicture("C:\Windows\Web\Wallpaper\Theme1\img1.jpg")

あとは GDI API を使って、デバイス コンテキストに対して直接描画することもできます。

Private Declare PtrSafe Function Ellipse Lib "gdi32" (ByVal hDC As LongPtr, ByVal Left As Long, ByVal Top As Long, ByVal Right As Long, ByVal Bottom As Long) As Long

Private Sub InkPicture1_Painting(ByVal hDC As Long, ByVal Rect As MSINKAUTLib.IInkRectangle, Allow As Boolean)

    Ellipse hDC, Rect.Left + 5, Rect.Top + 5, Rect.Right - 5, Rect.Bottom - 5

End Sub

こんばんは魔界の仮面弁士様
全ての疑問にお答え頂きありがとうございます。嬉しすぎて、お時間申し訳ないです。

でも早速InkRenderer オブジェクトの Draw メソッドの簡易サンプルを今回に使わせて頂こうと思ったのですが、デバイスコンテキストが違うのか、多少ズレてしまい、下記コード（※２）
るきお様の例を使って、ウィンドウのハンドルを使おうと思うと（※１）　
Draw メソッドが消えない。（リリースできない？）ようでした。
特に変な事はしていないと思うのですが、何が悪いのでしょうか？

文字のストロークはそのままで、一時InkPicture(inkP)にBoundingbox分のストロークを入れて、InkRendererで一時ストロークをDrawさせて、重ね合わせて表示させようとしました。

Private Sub CommandButton44_Click()



 Dim inkP As New MSINKAUTLib.InkPicture　'これが一時InkPicture 

 

'InkP.InkEnabled = True 

'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(4) As IInkStrokeDisp

For Each para In paras

    Set rect1 = para.strokes.GetBoundingBox(IBBM_Default)

     

    inkP.InkEnabled = False

 

       Set strokes(1) = inkP.ink.CreateStroke(MakeRectangle(rect1.Left - 2, rect1.Top + 4, rect1.Right + 4, rect1.Bottom - 2), Null)

    

         With strokes(1).DrawingAttributes

            .FitToCurve = IsCircle

            .Color = RGB(0, 0, 255)

        End With

 Next

For Each line In lines

    Set rect1 = line.strokes.GetBoundingBox(IBBM_Default)

     

      With inkP.ink

        Set strokes(2) = .CreateStroke(MakeRectangle(rect1.Left, rect1.Top, rect1.Right, rect1.Bottom), Null)

     End With

    

         With strokes(2).DrawingAttributes

            .FitToCurve = IsCircle

            .Color = 255

        End With

 Next

For Each segment In segments

    Set rect1 = segment.strokes.GetBoundingBox(IBBM_Default)

     

     With inkP.ink

        Set strokes(3) = .CreateStroke(MakeRectangle(rect1.Left + 2, rect1.Top + 2, rect1.Right - 4, rect1.Bottom + 2), Null)

     End With

    

         With strokes(3).DrawingAttributes

            .FitToCurve = IsCircle

            .Color = RGB(0, 128, 0)

        End With

 Next



    inkP.AutoRedraw = False

    With inkP.ink.CreateStrokes()

            .Add strokes(1)

            .Add strokes(2)

            .Add strokes(3)

    End With

   inkP.AutoRedraw = True



Dim hTargetWin As Long    '対象のウィンドウのハンドル 



hTargetWin = WindowFromPoint(0, 0)



'http://rucio.a.la9.jp/main/tyukyu/tyukyu5.htm 

    Dim r As IInkRenderer

    Set r = New InkRenderer

    Dim hDC As LongPtr

'   hDC = GetDC(hTargetWin)     '※１ 

    hDC = GetDC(0)              '※２ 

    r.Draw hDC, inkP.ink.strokes

'    ReleaseDC hTargetWin, hDC  '※１ 

     ReleaseDC 0, hDC          '※２ 



End Sub

> でも早速InkRenderer オブジェクトの Draw メソッドの簡易サンプルを今回に使わせて頂こうと思ったのですが、

InkRenderer は、インクをオーバーレイ表示するために使うものだと思いますが、
これを使う目的は何でしょうか。座標変換は使わず、単に転記するのみ?

Draw メソッドを使うとなると、ジェスチャーの軌跡などの一時的な描画であればさておき、
複数のストロークを永続表示しようとするならば、ボタン押下時ではなく、
WM_PAINT メッセージを捉えて随時描画し続けるコードを用意する必要があると思います。


> デバイスコンテキストが違うのか、
何に対して描画することを目的としていますか?
ビットマップファイル? プリンター? ディスプレイ? ウィンドウ?

どのデバイスのどのレイヤーに描画するのかによって、
デバイスコンテキストハンドルの取得方法も変わってきますし、
ウィンドウのクライアント領域に描画することを目的としているのであれば、
高DPIへの考慮が必要になる消すもあるかもしれません。

> 多少ズレてしまい、
どの座標に描画しようとしているのでしょうか。
また、そのずれの量は具体的には如何ほどですか?

> Draw メソッドが消えない。（リリースできない？）ようでした。
メソッドが消える…? ごめんなさい、質問の意味を理解できませんでした。

こんにちは、魔界の仮面弁士様
なかなかうまくいかず、遅くなってしまい、申し訳ございません。

①座標変換は、出来るようになりました。（下記）
　　他の方々がやっているように、重ね合わせがしたかったです。
　　何か触ると消えてしまいますが、触らなければ、追加情報が手に入るから。と思っております。
　　WM_PAINT メッセージは、面白そうだなぁと思いましたが、
　　　ＶＢＡでの使い方がわからず、また、その後の対策？（再描画？）もわからなそうでした。

②今回は、たぶん、form1を取得してると思うのですが、strokeの座標系は、inkpicture2だと思われるので、
　　上部タイトルや、左枠線分ずれていると思われます。
　　inkpicture2のデバイスコンテキストが取得できるのか、わからないですし、
　　将来、他のアプリ？などに、重ね合わせて、転記して表示する、DCの取得方法もわかりません。

③ズレは、私の環境の、ストローク座標で、目検offsetX = 390、offsetY = 1020だと思われました。

④ReleaseDC 0, hDCだと、重ね合わせは消えるのですが、
　ReleaseDC hTargetWin, hDCだと、重ね合わせが消えない事を表現しようと思いました。
　それを、「Draw メソッドが消えない。（リリースできない？）ようでした。」と記載しました。

　①は、出来るようになりましたので、他の方用にコードを記載いたします。
   
　　アトリビュートのコピーがうまくいってなくて、
　　下記の前のバージョン（createstrokeなど)では、boundingboxが、丸くなる症状が出てしまってましたが、
　　今回は、うまくコピーできてるようでした。

　前回、言葉足らずだったり、表現が悪く申し訳ございませんでした。
　あきれずに、また宜しくお願いします。

Private Sub CommandButton46_Click()



Dim inkP As New MSINKAUTLib.InkPicture

Dim strokesm As MSINKAUTLib.InkStrokes

Dim offsetX As Single

Dim offsetY As Single



offsetX = 390

offsetY = 1020



Set combinedInk = inkP.ink



Set strokesm = InkPicture2.ink.strokes

iret = combinedInk.AddStrokesAtRectangle(strokesm, strokesm.GetBoundingBox())

inkP.ink.strokes.Move offsetX, offsetY

inkP.AutoRedraw = True



  For st = 0 To InkPicture2.ink.strokes.Count - 1

  Set inkP.ink.strokes.Item(st).DrawingAttributes = InkPicture2.ink.strokes.Item(st).DrawingAttributes

  Next

   Dim r As IInkRenderer

    Set r = New InkRenderer

    Dim hDC As LongPtr

    hDC = GetDC(0)

    r.Draw hDC, inkP.ink.strokes

     ReleaseDC 0, hDC



End Sub

こんばんは、るきお様、仮面の魔界弁士様
WM_PAINTは、うまくいかなったですが、WM_PAINTで再描画できました。
るきお様のvb6を参考にVBA用に変更しました。

標準モジュール



'http://rucio.o.oo7.jp/main/tyukyu/tyukyu9.htm 





'□ＡＰＩ関数 

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long



Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr

Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long



Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _

       (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long



'□SetWindowLongで使用 

Private Const GWL_WNDPROC = -4



'□メッセージ 

Private Const WM_CONTEXTMENU = &H7B '右クリックWM_PAINT 

Private Const WM_PAINT = &HF       'ウィンドウを再描画する必要がある 

Private Const WM_MOVE = &H3       'ウィンドウ移動 



'□コレクション すべてウィンドウハンドルがキー 

Dim colDProc As Collection '現在サブクラス化されているコントロールの元のWindowsProcのアドレス 



Public sy As Long

Public sx As Long

Public ny As Long

Public nx As Long





'■WindowProc 

'■機能：メッセージを横取りする。 

'■備考：この関数はコールバック関数なので定義を変えてはいけない！ 

Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long



    Dim DefaultProc As Long

    Dim c As Long



    Select Case uMsg



        Case WM_PAINT 'ウィンドウを再描画する必要がある 

        UserForm1.Label11.Caption = c

        c = c + 1

            Exit Function

      

       'https://oshiete.goo.ne.jp/qa/4620863.html 

       Case WM_MOVE 'ウィンドウを再描画する必要がある 

         

        UserForm1.Label4.Caption = sx

        UserForm1.Label5.Caption = sy

         

        UserForm1.Label6.Caption = UserForm1.Left - sx

        UserForm1.Label7.Caption = UserForm1.Top - sy

       

        UserForm1.Label8.Caption = UserForm1.Left

        UserForm1.Label9.Caption = UserForm1.Top

        

        ny = UserForm1.Top

        nx = UserForm1.Left

        

        Call MOVEs  '・・・・・・これが再描画 

        

             Exit Function

            'WM_MOVE 

            

        Case WM_CONTEXTMENU '右クリック 

        MsgBox "右"

            Exit Function



    End Select



CONTINUE:

    '引当のWindowProcへメッセージを回す。 

    DefaultProc = colDProc(CStr(hwnd))

    WindowProc = CallWindowProc(DefaultProc, hwnd, uMsg, wParam, lParam)



End Function

'■BeginSubClass 

'■機能：サブクラス化を開始する。 

Public Sub BeginSubClass(l As Long)



    Static bAlready As Boolean

    Dim DefaultProc As Long



    If Not bAlready Then

        Set colDProc = New Collection

        bAlready = True

    End If



    'サブクラス化実行 

    DefaultProc = SetWindowLong(l, GWL_WNDPROC, AddressOf WindowProc)



    '元のWindowProcのアドレスを保存 

    colDProc.Add DefaultProc, CStr(l)



End Sub

'■EndSubClass 

'■機能：サブクラス化を終了します。 

Public Sub EndSubClass(l As Long)



    Dim Ret As Long

    Dim DefaultProc As Long



    'WindowProcのアドレスを元に戻す。 

    DefaultProc = colDProc(CStr(l))

    Ret = SetWindowLong(l, GWL_WNDPROC, DefaultProc)

    colDProc.Remove CStr(l)



End Sub



Sub MOVEs()



再描画



End Sub

コードが長くなり、フォームムジュールは次です

続きのフォームモジュールです

Private Sub CommandButton49_Click()

    

   'ユーザーフォームのハンドルを取得 

    'https://excel-excel.com/tips/vba_69.html 

 Dim hwnd As Long



 If buttonOn = False Then

    hwnd = FindWindow(vbNullString, Me.Caption)

    

    hTargetDC = GetDC(hwnd)



    If hTargetDC = 0 Then

     Cells(1, 3).Value = "失敗しました。"

     Else

     Cells(1, 3).Value = hTargetDC

     End If

      

    Cells(1, 1) = hwnd

    

 'https://tsware.jp/tips/tips_174.htm 

Dim strWindowText As String * 128   'キャプションを受け取る変数 

Dim lngRet As Long



'API関数を呼び出します 

lngRet = GetWindowText(hwnd, strWindowText, Len(strWindowText))



'引数の後続の Null を取り除いて表示します 

Cells(1, 2) = Left$(strWindowText, InStr(strWindowText, vbNullChar) - 1)

        

   Call BeginSubClass(hwnd)

   buttonOn = True

  ' CommandButton1.Enabled = False 

  'http://www.officetanaka.net/excel/vba/tips/tips136.htm 

  

  sy = UserForm1.Top

  sx = UserForm1.Left

  

  

 Else

 End If





End Sub



Private Sub CommandButton50_Click()

 Dim hwnd As Long

    hwnd = FindWindow(vbNullString, Me.Caption)

    Call EndSubClass(hwnd)

    buttonOn = False



End Sub

なぜかWM_PAINTがうまく動きませんでした・・・