tagCANDY CGI VBレスキュー(花ちゃん) の Visual Basic 2010 用 掲示板(VB.NET 掲示板)
VBレスキュー(花ちゃん) の Visual Basic 2010 用 掲示板(VB.NET 掲示板)
[ツリー表示へ]  [ワード検索]  [Home]

タイトル クリップボード監視時のエラーについて
投稿日: 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

- 関連一覧ツリー をクリックするとツリー全体を一括表示します)

古いスレッドにレスはつけられません。