inkpictureでdeleteすると、他のstrokeのｲﾝﾃﾞｯｸｽなどが配列から無くなります への返答
投稿で使用できる特殊コードの説明。(別タブで開きます。)
以下の返答は逆順(新しい順)に並んでいます。
投稿者 snowmansnow (社会人)
投稿日時
2021/3/21 22:53:55
こんばんは、るきお様、仮面の魔界弁士様
WM_PAINTは、うまくいかなったですが、WM_PAINTで再描画できました。
るきお様のvb6を参考にVBA用に変更しました。
コードが長くなり、フォームムジュールは次です
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
コードが長くなり、フォームムジュールは次です
投稿者 snowmansnow (社会人)
投稿日時
2021/2/28 16:59:40
こんにちは、魔界の仮面弁士様
なかなかうまくいかず、遅くなってしまい、申し訳ございません。
①座標変換は、出来るようになりました。（下記）
他の方々がやっているように、重ね合わせがしたかったです。
何か触ると消えてしまいますが、触らなければ、追加情報が手に入るから。と思っております。
WM_PAINT メッセージは、面白そうだなぁと思いましたが、
ＶＢＡでの使い方がわからず、また、その後の対策？（再描画？）もわからなそうでした。
②今回は、たぶん、form1を取得してると思うのですが、strokeの座標系は、inkpicture2だと思われるので、
上部タイトルや、左枠線分ずれていると思われます。
inkpicture2のデバイスコンテキストが取得できるのか、わからないですし、
将来、他のアプリ？などに、重ね合わせて、転記して表示する、DCの取得方法もわかりません。
③ズレは、私の環境の、ストローク座標で、目検offsetX = 390、offsetY = 1020だと思われました。
④ReleaseDC 0, hDCだと、重ね合わせは消えるのですが、
ReleaseDC hTargetWin, hDCだと、重ね合わせが消えない事を表現しようと思いました。
それを、「Draw メソッドが消えない。（リリースできない？）ようでした。」と記載しました。
①は、出来るようになりましたので、他の方用にコードを記載いたします。
アトリビュートのコピーがうまくいってなくて、
下記の前のバージョン（createstrokeなど)では、boundingboxが、丸くなる症状が出てしまってましたが、
今回は、うまくコピーできてるようでした。
前回、言葉足らずだったり、表現が悪く申し訳ございませんでした。
あきれずに、また宜しくお願いします。
なかなかうまくいかず、遅くなってしまい、申し訳ございません。
①座標変換は、出来るようになりました。（下記）
他の方々がやっているように、重ね合わせがしたかったです。
何か触ると消えてしまいますが、触らなければ、追加情報が手に入るから。と思っております。
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
投稿者 魔界の仮面弁士 (社会人)
投稿日時
2021/2/27 11:10:15
> でも早速InkRenderer オブジェクトの Draw メソッドの簡易サンプルを今回に使わせて頂こうと思ったのですが、
InkRenderer は、インクをオーバーレイ表示するために使うものだと思いますが、
これを使う目的は何でしょうか。座標変換は使わず、単に転記するのみ?
Draw メソッドを使うとなると、ジェスチャーの軌跡などの一時的な描画であればさておき、
複数のストロークを永続表示しようとするならば、ボタン押下時ではなく、
WM_PAINT メッセージを捉えて随時描画し続けるコードを用意する必要があると思います。
> デバイスコンテキストが違うのか、
何に対して描画することを目的としていますか?
ビットマップファイル? プリンター? ディスプレイ? ウィンドウ?
どのデバイスのどのレイヤーに描画するのかによって、
デバイスコンテキストハンドルの取得方法も変わってきますし、
ウィンドウのクライアント領域に描画することを目的としているのであれば、
高DPIへの考慮が必要になる消すもあるかもしれません。
> 多少ズレてしまい、
どの座標に描画しようとしているのでしょうか。
また、そのずれの量は具体的には如何ほどですか?
> Draw メソッドが消えない。（リリースできない？）ようでした。
メソッドが消える…? ごめんなさい、質問の意味を理解できませんでした。
InkRenderer は、インクをオーバーレイ表示するために使うものだと思いますが、
これを使う目的は何でしょうか。座標変換は使わず、単に転記するのみ?
Draw メソッドを使うとなると、ジェスチャーの軌跡などの一時的な描画であればさておき、
複数のストロークを永続表示しようとするならば、ボタン押下時ではなく、
WM_PAINT メッセージを捉えて随時描画し続けるコードを用意する必要があると思います。
> デバイスコンテキストが違うのか、
何に対して描画することを目的としていますか?
ビットマップファイル? プリンター? ディスプレイ? ウィンドウ?
どのデバイスのどのレイヤーに描画するのかによって、
デバイスコンテキストハンドルの取得方法も変わってきますし、
ウィンドウのクライアント領域に描画することを目的としているのであれば、
高DPIへの考慮が必要になる消すもあるかもしれません。
> 多少ズレてしまい、
どの座標に描画しようとしているのでしょうか。
また、そのずれの量は具体的には如何ほどですか?
> Draw メソッドが消えない。（リリースできない？）ようでした。
メソッドが消える…? ごめんなさい、質問の意味を理解できませんでした。
投稿者 snowmansnow (社会人)
投稿日時
2021/2/24 21:46:16
こんばんは魔界の仮面弁士様
全ての疑問にお答え頂きありがとうございます。嬉しすぎて、お時間申し訳ないです。
でも早速InkRenderer オブジェクトの Draw メソッドの簡易サンプルを今回に使わせて頂こうと思ったのですが、デバイスコンテキストが違うのか、多少ズレてしまい、下記コード（※２）
るきお様の例を使って、ウィンドウのハンドルを使おうと思うと（※１）
Draw メソッドが消えない。（リリースできない？）ようでした。
特に変な事はしていないと思うのですが、何が悪いのでしょうか？
文字のストロークはそのままで、一時InkPicture(inkP)にBoundingbox分のストロークを入れて、InkRendererで一時ストロークをDrawさせて、重ね合わせて表示させようとしました。
全ての疑問にお答え頂きありがとうございます。嬉しすぎて、お時間申し訳ないです。
でも早速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
投稿者 魔界の仮面弁士 (社会人)
投稿日時
2021/2/24 01:52:41
> vbaで実現できずに、煮詰まったりしていました。
> 今回バイナリセーブの例を出して頂いて、スッキリしました。
Save & Load の例として、昨年書いていたこのあたりも。
http://rucio.cloudapp.net/ThreadDetail.aspx?ThreadId=30478
> 線画など描画のヒント（背景も読めないし、出来ない旨のｗｅｂもありました）を頂ければ、ありがたいです。
すでに
https://www.vbforums.com/showthread.php?763319-Drawing-shapes-on-ink-picture
を利用したコードを書かれているようなので、ストロークの扱いは省くとして。
既存の画像を読み込むなら、LoadPicture を使えます。
あとは GDI API を使って、デバイス コンテキストに対して直接描画することもできます。
> 今回バイナリセーブの例を出して頂いて、スッキリしました。
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
投稿者 魔界の仮面弁士 (社会人)
投稿日時
2021/2/24 00:28:58
ソースを貼る場合には、 CODE ブロックタグを併用して頂けると読みやすいです。
http://rucio.cloudapp.net/Usage.aspx
> 何か、MSINKAUTLib.inkrendererの中のdrawstrokeとかが、グラフィックなのかなぁ？と思ってます。
質問の意図が良く分かりませんが、DrawStroke メソッドは単一ストローク単位の描画、
Draw メソッドは複数のストローク群の描画にあたりますね。
InkRenderer オブジェクトの Draw メソッドの簡易サンプルを載せておきます。
現在のストロークの内容をデスクトップに転写するものです。
> （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
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
投稿者 snowmansnow (社会人)
投稿日時
2021/2/24 00:14:05
こんばんは、魔界の仮面弁士様
忙しい中、お時間割いて頂き、お返事ありがとうございます。
頭がこんがらがっていた時、
るきお様の別件の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とかいうものが、それに当たるのかな？とか困っています。
やってみて、また分からない所など、お聞きしますので、御教授お願いしたいです。
よろしくお願いします。
忙しい中、お時間割いて頂き、お返事ありがとうございます。
頭がこんがらがっていた時、
るきお様の別件の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とかいうものが、それに当たるのかな？とか困っています。
やってみて、また分からない所など、お聞きしますので、御教授お願いしたいです。
よろしくお願いします。
投稿者 魔界の仮面弁士 (社会人)
投稿日時
2021/2/23 23:34:51
最初の質問では、
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 な別インクコレクション」などで管理しておく方が、手っ取り早いのではないでしょうか。
あるいは、複数ストロークの「一括削除」などが目的であれば、戻したい状態のストロークを
バイナリデータとして変数もしくはファイルに保持しておき、リロードするという手もあります。
> プリザーブを修正してみましたところ、１回目は動くようになりました。
今回のケースに限りませんが、ループ内で毎回 ReDim Preserve するような
コーディングはあまり好ましくありません。Preserve の回数は最小限に留めましょう。
現在のストローク総数は .Count で得られるので、最初に一回だけ
総数分の領域を ReDim で確保しておけば、ループ内で毎回
ReDim Preserve しなおす必要はないと思いますよ。
まぁ、件数が少ない場合はさほど問題になりませんが…。
https://vbabeginner.net/redim-preserve-really-slow/
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/
投稿者 snowmansnow (社会人)
投稿日時
2021/2/23 22:50:28
こんばんは、
２回目のエラーが頻発し、頭がこんがらがってましたが、
ｉｄが変わっても、カウントは変わらなかったので、頭を切り替えて、下記に変更してみたら動きました。
今回は、同じ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
２回目のエラーが頻発し、頭がこんがらがってましたが、
ｉｄが変わっても、カウントは変わらなかったので、頭を切り替えて、下記に変更してみたら動きました。
今回は、同じ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
投稿者 snowmansnow (社会人)
投稿日時
2021/2/23 20:52:49
魔界の仮面弁士様、大変ありがとうございます。
プリザーブを修正してみましたところ、１回目は動くようになりました。
でも、２回目やってみると、「実行時エラー５。プロシジャーの呼び出し、または引数が不正です」
になってしまいます。（下記の場所）
前回教えてもらった、シート上にストロークデータを記載する。をやってみると、ｓｔ．ｉｄが飛んでいます。
何かリフレッシュみたいに、連番に戻す命令があるのでしょうか？
他に何か理由があるのでしょうか？
よろしくお願いします。
修正版
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
プリザーブを修正してみましたところ、１回目は動くようになりました。
でも、２回目やってみると、「実行時エラー５。プロシジャーの呼び出し、または引数が不正です」
になってしまいます。（下記の場所）
前回教えてもらった、シート上にストロークデータを記載する。をやってみると、ｓｔ．ｉｄが飛んでいます。
何かリフレッシュみたいに、連番に戻す命令があるのでしょうか？
他に何か理由があるのでしょうか？
よろしくお願いします。
修正版
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
投稿者 魔界の仮面弁士 (社会人)
投稿日時
2021/2/23 19:30:49
コードの内容は全く読み取っていないのですが、
> ReDim dels(UBound(dels) + 1)
For Each ループ内で繰り返し行うというのであれば、
Preserve キーワード付きで ReDim する必要があるのでは。
もしくは 配列の代わりに VBA.Collection を使うとか。
> ReDim dels(UBound(dels) + 1)
For Each ループ内で繰り返し行うというのであれば、
Preserve キーワード付きで ReDim する必要があるのでは。
もしくは 配列の代わりに VBA.Collection を使うとか。
投稿者 snowmansnow (社会人)
投稿日時
2021/2/23 18:45:20
文字制限のため、追加投稿いたします。
問題の削除の部分です
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
よろしくお願いします
問題の削除の部分です
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
よろしくお願いします
投稿者 snowmansnow (社会人)
投稿日時
2021/2/23 18:43:39
こんにちは、るきお様、魔界の仮面弁士様、ニケ様、皆様、
また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()
文字制限のため、問題の削除部分は追加投稿いたします
また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()
文字制限のため、問題の削除部分は追加投稿いたします
なぜかWM_PAINTがうまく動きませんでした・・・