| 投稿日 | ： 2005/11/05(Sat) 15:17 |
| 投稿者 | ： 筆武将 |
| ＵＲＬ | ： |
| タイトル | ： 指定ハンドルに自作オブジェクトプロパティを(メモリ上で仮想的に)新規作成するには |
VB6で以下のようにクラスモジュールをプロパティとして渡したいと思っています。
ハンドルがMe.hwndだけなら、Public Property を使えば良いのですが、
実際は他のハンドルにも使うつもりです。
以下のようにすれば値が得られると思いきや、全てゼロでした。
このような方法では無理なのでしょうか？
よろしくお願いします。
'フォームモジュール
Option Explicit
Private Sub Command1_Click()
Call GetMemoryProperty(Me.hWnd)
End Sub
Private Sub Form_Load()
Dim cTest As clsTest
Set cTest = New clsTest
With cTest
.ItemA = 123
.ItemB = 234
.ItemC = 345
.ItemD = 456
End With
If SetMemoryProperty(Me.hWnd, cTest) Then
Command1.Enabled = True
Else
Command1.Enabled = False
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call DestroyMemoryProperty(Me.hWnd)
End Sub
'標準モジュール
Option Explicit
Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hWnd As Long, ByVal
lpString As Any) As Long
Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hWnd As Long, ByVal
lpString As String, ByVal hData As Long) As Long
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hWnd As Long,
ByVal lpString As String) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As
Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (ByRef Destination As
Any, ByVal Length As Long)
Private Const OBJECT_PROPERT As String = "MyObjectProperty"
Public Function SetMemoryProperty(hWnd As Long, cTest As clsTest) As Boolean
If SetProp(hWnd, OBJECT_PROPERT, ObjPtr(cTest)) Then
SetMemoryProperty = True
End If
End Function
Public Function GetMemoryProperty(hWnd As Long) As Boolean
Dim cTest As clsTest
Dim lngPointer As Long
Set cTest = New clsTest 'ここをコメントにするとVBが落ちる
lngPointer = GetProp(hWnd, OBJECT_PROPERT)
CopyMemory cTest, lngPointer, 4
Debug.Print cTest.ItemA, cTest.ItemB, cTest.ItemC, cTest.ItemD '全てゼロ
ZeroMemory cTest, 4&
'CopyMemory cTest, 0&, 4
End Function
Public Function DestroyMemoryProperty(hWnd As Long) As Boolean
Call RemoveProp(hWnd, OBJECT_PROPERT)
End Function
'クラスモジュール（clsTest）
Option Explicit
Public ItemA As Long
Public ItemB As Long
Public ItemC As Long
Public ItemD As Long