テキストボックス上での貼り付け防止
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　玄関へお回り下さい。 　　
テキストボックス上での貼り付け防止対策　　　　　　　　　　　（１１３）
　　　　 Option Explicit　　 'SampleNo=113　WindowsXP VB6.0(SP5) 2002.05.22
'指定のウィンドウにマウスキャプチャを設定する（P1046)
Private Declare Function SetCapture Lib "user32" _
　　　　(ByVal hWnd As Long) As Long
'キーストロークをシミュレートする(P1065)
Private Declare Sub keybd_event Lib "user32.dll" _
　　　　(ByVal bVk As Byte, ByVal bScan As Byte, _
　　　　 ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
'仮想キーコード・ASCII値・スキャンコード間でコードを変換する(P1067)
Private Declare Function MapVirtualKey Lib "user32" _
　　Alias "MapVirtualKeyA" (ByVal wCode As Long, _
　　ByVal wMapType As Long) As Long
Private Const VK_APPS = &H5D　　　　　　　　'アプリケーションキー
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2


Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
　　If KeyCode = VK_APPS Or (Shift = vbShiftMask And KeyCode = vbKeyF10) Then
　　'アプリケーションキー及び Shift＋F10 による貼付防止
　　　　'Alt キーを押す
　　　　Call keybd_event(vbKeyMenu, MapVirtualKey(vbKeyMenu, 0), _
　　　　　　　　KEYEVENTF_EXTENDEDKEY Or 0, 0)
　　　　Dim lngSt As Long
　　　　lngSt = Timer
　　　　Do While Timer - lngSt < 2
　　　　　　DoEvents
　　　　Loop
　　　　'Alt キーを離す
　　　　Call keybd_event(vbKeyMenu, MapVirtualKey(vbKeyMenu, 0), _
　　　　　　　　KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
　　End If
　　If Shift = vbShiftMask And KeyCode = vbKeyInsert Then
　　'Shift + Ins による貼り付けがあった場合元に戻す
　　　　Call keybd_event(vbKeyControl, MapVirtualKey(vbKeyControl, 0), _
　　　　　　　　KEYEVENTF_EXTENDEDKEY Or 0, 0)
　　　　Call keybd_event(vbKeyZ, MapVirtualKey(vbKeyZ, 0), _
　　　　　　　　KEYEVENTF_EXTENDEDKEY Or 0, 0)
　　　　Call keybd_event(vbKeyZ, MapVirtualKey(vbKeyZ, 0), _
　　　　　　　　KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
　　　　Call keybd_event(vbKeyControl, MapVirtualKey(vbKeyControl, 0), _
　　　　　　　　KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
　　End If
End Sub


Private Sub Text1_KeyPress(KeyAscii As Integer)
　　'Ctrl + V による貼り付け防止　Ctrl + C=3　Ctrl + Z=26　 Ctrl + X=24
　　If KeyAscii = 22 Then
　　　　KeyAscii = 0
　　End If
End Sub


Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, _
　　　　　　　　　　　　　　　　　　　　　　　　x As Single, y As Single)
　　If Button = vbRightButton Then　　'右クリックしたら
　　　　Dim Ret As Long
　　　　Ret = SetCapture(Me.hWnd)　　 'Form にマウスキャプチャを設定
　　End If
End Sub


Private Sub Text1_DblClick()
　　'ダブルクリック後の右クリック防止
　　Text1_MouseDown vbRightButton, 0, 0, 0
End Sub
まず、貼り付けできないようにしたいと言う理由をハッキリして下さい。
数字しか入力できないようにしたいと言うなら［テキストボックスに数値しか入力出来ないように制限する関数（改良型）］を参考にするとか、Change イベントや LostFocus イベントで監視するとかして、短路的に使用されるのには、お勧めできませんが掲示板の質問にも多く出ていますので考えて見ました。
マウスの右クリックよる貼り付けはSetCapture関数で出来たのですが、ショートカットキーによる貼り付けには[Ctrl] +[ V]とあまり知られていませんが[Shift] + [Insert] でも可能です。
[Ctrl] +[ V]こちらの方はうまくいったのですが、[Shift] + [Insert]こちらはいい方法が見つからず、[Shift] + [Insert]キーが押されたかを監視して、貼り付けを元に戻す方法とホームのイベントで先取りし、Clipboard.Clear して貼り付ける物が無いようにする方法を取りました。
もう少しいい方法がありましたら教えて下さい。
[アプリケーション] キーと[Shift] + [F10] キーによるポップアップメニューは表示されたら[Alt]
キーを送る事でポップアップメニューを閉じるようにしています。
この他の方法でも貼り付けが出来る場合があるようですが、それとこの方法でも十分ではないかも
知れません。それぞれの環境で試してからお使い下さい。
その他の方法として、事前にクリップボードの内容を退避させてからクリアして LostFocus 時に元に戻すといった方法もあります。
この方法は簡単ですが、GotFocus 時クリアした後でコピー・貼り付けがあった場合は対応できません。又、場合によってはテキスト以外のクリップボードの内容を保存しておきたい場合は面倒になりますが、条件さえあえばこちらの方がいいかと思います。
又、少し複雑になりますが、サブクラス化し、WM_CUT, WM_COPY, WM_PASTEとWM_RBUTTONUP のメッセージを無効にするという方法があります。（SampleNo．158）
この方法はサブクラス化についてご存じない方には危険？が伴いますのでお勧めできません。




2003/03/15