タイトル | : クリップボード監視時のエラーについて |
記事No | : 8866 |
投稿日 | : 2009/04/16(Thu) 14:10 |
投稿者 | : take |
いつもお世話になります。
Windows XP SP3 Visua lBasic Express Edition VB初心者です。
クリップボードを監視するソフトを作り始めたのですが、下記エラーが出て止まってしまいます。 ”コールバックが、型 'test!test.Form1+SubClassProcDelegate::Invoke' のガベージ コレクションされたデリゲートで行われました。これは、アプリケーションのクラッシュ、破損、およびデータの損失を発生させる可能性があります。デリゲートをアンマネージ コードに渡すとき、デリゲートは 2 度と呼び出されないことが確実になるまでマネージ アプリケーションによって維持されなければなりません。” エラーはフォームをアクティブにしたり、しなかったりを繰り返すと出ます。 ガベージコレクションが行われる時に落ちると思い、試しにコードにGC.Collect()を入れたところ落ちなくなりました。 下記がテストで作ったコードです。フォームにLabelだけ貼り付けてあります。 GC.Collect()をコメントアウトすると、しつこく操作しているうちに落ちます。 どこに問題があるのでしょうか、私には力不足でわかりません。 どなたかご教示お願いできませんでしょうか。
Public Class Form1
'クリップボード内容変更通知取得設定(WM_DRAWCLIPBOARDメッセージを受け取ります) Declare Function SetClipboardViewer Lib "user32" (ByVal hwnd As Integer) As Integer 'クリップボード内容変更通知解除 Declare Function ChangeClipboardChain Lib "user32" (ByVal hwnd As Integer, ByVal hWndNext As Integer) As Integer 'サブクラス化用 Delegate Function SubClassProcDelegate(ByVal hwnd As Integer, ByVal msg As Integer, ByVal wParam As Integer, _ ByVal lParam As Integer) As Integer Declare Function SetWindowLong1 Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Integer, ByVal nIndex As Integer, _ ByVal lVal As SubClassProcDelegate) As Integer Declare Function SetWindowLong2 Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Integer, ByVal nIndex As Integer, _ ByVal dwNewLong As Integer) As Integer '定数 Public Const GWL_WNDPROC = (-4) 'ウインドウプロシージャ Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Integer, ByVal hwnd As Integer, _ ByVal Msg As Integer, ByVal wParam As Integer, _ ByVal lParam As Integer) As Integer Public Const WM_DRAWCLIPBOARD = &H308 'クリップボードの内容が変更された時
Public P_hwndNext As Integer
Public Function WindowProc_ClipGet(ByVal hwnd As Integer, ByVal uMsg As Integer, _ ByVal wParam As Integer, ByVal lParam As Integer) As Integer Try Static Check As Boolean If Not Check Then Check = True Select Case uMsg Case WM_DRAWCLIPBOARD 'クリップボードが変更された Me.Label1.Text = Clipboard.GetText.ToString '********************************** '* こうすると落ちない なぜ? * '********************************** GC.Collect()
End Select Check = False End If
Catch ex As Exception MsgBox(ex.Message & " WindowProc") End Try
WindowProc_ClipGet = CallWindowProc(P_hwndNext, hwnd, uMsg, wParam, lParam)
End Function
'サブクラス化 Public Sub SubClass(ByVal hwnd As Integer) Try If P_hwndNext = 0 Then P_hwndNext = SetWindowLong1(hwnd, GWL_WNDPROC, AddressOf WindowProc_ClipGet) End If Catch ex As Exception MsgBox(ex.Message & " SubClass") End Try End Sub
'サブクラス化終了 Public Sub UnSubClass(ByVal hwnd As Integer) Try Dim ret As Integer If P_hwndNext <> 0 Then '元のプロシージャアドレスに設定する ret = SetWindowLong2(hwnd, GWL_WNDPROC, P_hwndNext) P_hwndNext = 0 End If Catch ex As Exception MsgBox(ex.Message & " UnSubClass") End Try End Sub
Private Sub Form1_FormClosed(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed ChangeClipboardChain(Me.Handle, P_hwndNext) 'クリップボードの監視終了 UnSubClass(Me.Handle) 'サブクラス化終了 End Sub
Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load Me.TopMost = True P_hwndNext = SetClipboardViewer(Me.Handle) 'クリップボードの監視スタート SubClass(Me.Handle) 'サブクラス化 End Sub
End Class
|