Dim flg1 As Boolean = false
Dim flg2 As Boolean = false
// 文字列を指定してクラスオブジェクトを取得する。最初に一回宣言しておけばよい。
Declare Function NSClassFromString Lib "Cocoa" (aClassName As CFStringRef) As Ptr
Declare Function alloc Lib "Cocoa" Selector "alloc" (receiver As Ptr) As Ptr
Declare Function init Lib "Cocoa" Selector "init" (receiver As Ptr) As Ptr
Declare Sub release Lib "Cocoa" Selector "release" (receiver As Ptr)
// ペーストボードの取得
Dim pnt1 As Ptr = NSClassFromString("NSPasteboard")
Declare Function generalPasteboard Lib "Cocoa" Selector "generalPasteboard" (receiver As Ptr) As Ptr
Dim pboard As Ptr = generalPasteboard(pnt1)
// ペーストボード内に含まれるタイプを順に取得
Declare Function types Lib "Cocoa" Selector "types" (receiver As Ptr) As Ptr
Dim ary As Ptr = types(pboard)
Declare Function count Lib "Cocoa" Selector "count" (receiver As Ptr) As Integer
Dim cnt As Integer = count(ary)
Declare Function objectAtIndexString Lib "Cocoa" Selector "objectAtIndex:" (receiver As Ptr, idx As Integer) As CFStringRef
for i As Integer = 0 to cnt-1
if objectAtIndexString(ary, i) = "com.apple.flat-rtfd" then // 画像を含むタイプが見つかったらフラグをオンに
flg1 = true
exit
end if
next
if flg1 then// 画像を含んでいるので独自のペースト処理
//ペーストボード内の全てのアトリビュートを収納する領域を初期化
Dim attrSum As Ptr = NSClassFromString("NSMutableAttributedString")
attrSum = alloc(attrSum)
attrSum = init(attrSum)
// com.apple.flat-rtfdからNSAttributedStringを復元
Declare Function dataForType Lib "Cocoa" Selector "dataForType:" (receiver As Ptr, type As CFStringRef) As Ptr
Dim data As Ptr = dataForType(pboard, "com.apple.flat-rtfd")
Dim option As Ptr = NSClassFromString("NSMutableDictionary")
Declare Function dictionary Lib "Cocoa" Selector "dictionary" (receiver As Ptr) As Ptr
option = dictionary(option)
Declare Sub setObject Lib "Cocoa" Selector "setObject:forKey:" (receiver As Ptr, obj As CFStringRef, key As CFStringRef)
setObject(option, "NSRTFDTextDocumentType", "NSDocumentTypeDocumentAttribute")
Dim atstr As Ptr = NSClassFromString("NSAttributedString")
atstr = alloc(atstr)
Declare Function dataInit Lib "Cocoa" Selector "initWithData:options:documentAttributes:error:" (receiver As Ptr, data As Ptr, optn As Ptr, attr As Ptr, err As Ptr) As Ptr
atstr = dataInit(atstr, data, option, nil, nil)
Declare Function myString Lib "Cocoa" Selector "string" (receiver As Ptr) As CFStringRef
Dim str As CFStringRef = myString(atstr) // 文字列
Declare Function length Lib "Cocoa" Selector "length" (receiver As Ptr) As Integer
Dim ll As Integer = length(atstr) // 文字列長
// 個々のアトリビュートごとに処理
Dim attrib As Ptr
#if Target32Bit
Dim rng As New MemoryBlock(8) // 引数をNSRange型にすると戻り値が取得できない？ので、MemoryBlockを使う
Dim rng_location As Integer = 0
Dim rng_length As Integer = 0
#elseif Target64Bit
Dim rng As New MemoryBlock(16) // 引数をNSRange型にすると戻り値が取得できない？ので、MemoryBlockを使う
Dim rng_location As Integer = 0
Dim rng_length As Integer = 0
#endif
Dim attachment As Ptr
Dim attachChar As Ptr
Dim attachChar0 As Ptr = NSClassFromString("NSAttributedString") // 文字列の場合は領域をallocするので、別に確保しておく
attachChar0 = alloc(attachChar0)
do until (rng_location + rng_length) >= ll
Declare Function attributesAtIndex Lib "Cocoa" Selector "attributesAtIndex:effectiveRange:" (receiver As Ptr, idx As Integer, rng As Ptr) As Ptr
attrib = attributesAtIndex(atstr, (rng_location + rng_length), rng) // アトリビュートが適用される範囲がrngに返ってくる
#if Target32Bit
rng_location = rng.Int32Value(0)
rng_length = rng.Int32Value(4)
#elseif Target64Bit
rng_location = rng.Int64Value(0)
rng_length = rng.Int64Value(8)
#endif
Declare Function objectForKey Lib "Cocoa" Selector "objectForKey:" (receiver As Ptr, key As CFStringRef) As Ptr
attachment = objectForKey(attrib, "NSAttachment") // NSAttachmentAttributeNameでは取れないので、NSAttachmentを指定
if attachment = nil then // 文字列
Declare Function dataInit Lib "Cocoa" Selector "initWithString:attributes:" (receiver As Ptr, str As CFStringRef, attr As Ptr) As Ptr
attachChar = dataInit(attachChar0, Mid(str, rng_location+1, rng_length), attrib) // アトリビュートが適用される範囲の文字列を取得（文字単位となるので、MidBではなくMidを使う）
flg2 = true // 文字列の挿入があった
else // 画像
Declare Function fileWrapper Lib "Cocoa" Selector "fileWrapper" (receiver As Ptr) As Ptr
Dim wrap As Ptr = fileWrapper(attachment)
if wrap = nil then continue // ラッパーが取得できなければ、次の
Dim attachmentX As Ptr = NSClassFromString("NSTextAttachment")
attachmentX = alloc(attachmentX)
Declare Function wrapInit Lib "Cocoa" Selector "initWithFileWrapper:" (receiver As Ptr, wrapper As Ptr) As Ptr
attachmentX = wrapInit(attachmentX, wrap)
attachChar = NSClassFromString("NSAttributedString")
Declare Function attributedStringWithAttachment Lib "Cocoa" Selector "attributedStringWithAttachment:" (receiver As Ptr, attachment As Ptr) As Ptr
attachChar = attributedStringWithAttachment(attachChar, attachmentX)
release(attachmentX) // clean up
flg2 = true // 画像の挿入があった
end if
// 全アトリビュート収納領域にスタイル付テキストを追加
Declare Sub appendAttributedString Lib "Cocoa" Selector "appendAttributedString:" (receiver As Ptr, identifier As Ptr)
appendAttributedString(attrSum, attachChar)
loop
// NSTextStorageの取得
declare function textStorage lib "Cocoa" selector "textStorage" (obj_id as Ptr) As Ptr // Return NSTextStorage*
Dim pnt2 As Ptr = textStorage(id)
// Undo登録用
Dim attrString As Ptr = NSClassFromString("NSMutableAttributedString")
attrString = alloc(attrString)
Declare Function initWithAtrStr Lib "Cocoa" Selector "initWithAttributedString:" (receiver As Ptr, str As Ptr) As Ptr
attrString = initWithAtrStr(attrString, pnt2)
Declare Function mutableCopy Lib "Cocoa" Selector "mutableCopy" (receiver As Ptr) As Ptr
Dim oldAttrString As Ptr = mutableCopy(attrString) // Undo登録用に現在の値を複製しておく
// UndoManagerにUndo時に使うメソッドと値を登録
'declare function undoManager lib "Cocoa" selector "undoManager" (obj_id as Integer) as Ptr // Return NSUndoManager*
'Dim pnt11 As Ptr = undoManager(Window1.Handle)
Dim pnt11 As Ptr = myUnmgr // NSUndoManagerの取得
declare function prepareWithInvocationTarget lib "Cocoa" selector "prepareWithInvocationTarget:" (receiver as Ptr, target As Ptr) As Ptr
Dim pnt12 As Ptr = prepareWithInvocationTarget(pnt11, stAttrStrInstance)
Declare Sub tStragesetAttrString Lib "Cocoa" Selector "tStrage:setAttrString:" (receiver As Ptr, tStrage As Ptr, attrString As Ptr)
tStragesetAttrString(pnt12, pnt2, oldAttrString)
Declare Sub beginEditing Lib "Cocoa" Selector "beginEditing" (receiver As Ptr)
beginEditing(attrString)
// 全アトリビュート収納領域をテキストストレージに挿入する
Declare Function selectedRange Lib "Cocoa" Selector "selectedRange" (receiver As Ptr) As NSRange
Dim rng2 As NSRange = selectedRange(id)
'Declare Sub insertAttributedString Lib "Cocoa" Selector "insertAttributedString:atIndex:" (receiver As Ptr, attachChar As Ptr, index As Integer)
'insertAttributedString(pnt2, attrSum, rng2.location) // キャレット位置をNSTextViewから取得
Declare Sub replaceCharactersInRange Lib "Cocoa" Selector "replaceCharactersInRange:withAttributedString:" (receiver As Ptr, rng As NSRange, attr As Ptr) // 挿入より置換の方が汎用性が高い？
replaceCharactersInRange(pnt2, rng2, attrSum)
Declare Sub endEditing Lib "Cocoa" Selector "endEditing" (receiver As Ptr)
endEditing(attrString)
// Redo登録用
Dim attrStringR As Ptr = NSClassFromString("NSMutableAttributedString")
attrStringR = alloc(attrStringR)
attrStringR = initWithAtrStr(attrStringR, pnt2)
Dim newAttrString As Ptr = mutableCopy(attrStringR) // Redo登録用に現在の値を複製しておく
// UndoManagerにUndo時に使うメソッドと値を登録
pnt12 = prepareWithInvocationTarget(pnt11, stAttrStrInstance)
tStragesetAttrString(pnt12, pnt2, newAttrString)
// clean up
release(atstr) // ペーストボード用
release(attachChar0) // 文字列用
release(attrSum)
release(attrString) // Undo用
release(attrStringR) // Undo用
end if
if not flg2 then // 独自のペースト処理対象外のアイテム
// 本来のpaste:を実行
declare sub myPaste lib "Cocoa" selector "myPaste:" (receiver as Ptr, txt As Ptr)
myPaste(id, sender)
end if