Re: Emulate AddressOf operator
- From: "Jonathan Wood" <jwood@xxxxxxxxxxxxxxxx>
- Date: Wed, 30 Nov 2005 12:35:52 -0700
But surely the callback cannot access any class member variables, right? A
regular callback has no reference to the class instance and so how could it?
--
Jonathan Wood
SoftCircuits
http://www.softcircuits.com
Available for consulting: http://www.softcircuits.com/jwood/resume.htm
"Michael C" <mculley@xxxxxxxxxxxxxxxxxxxxxx> wrote in message
news:OUWz3i88FHA.1140@xxxxxxxxxxxxxxxxxxxxxxx
> "Mark Yudkin" <myudkinATcompuserveDOTcom@xxxxxxxxxxxxxx> wrote in message
> news:eB7M$$y8FHA.2152@xxxxxxxxxxxxxxxxxxxxxxx
>> You can't. A class has a lifecycle and context that "prevents" usage of
>> any of it methods as a callback routine (in other words, the question is
>> semantic nonsense).
>
> Actually that's not true. I've done timer callbacks, hook callbacks and
> subclassing callbacks inside a class. I had a class once that did all of
> these but can't find it at the moment. However I have got code to do a
> timer callback in a class. To test it, create an exe project, add a class
> called clsTimer and paste in the code below. Then paste the code below
> this code into form1. This was originally designed for vb4 so had a late
> bound callback instead of the event but I just added the event now.
> Probably the SetRect code could be replaced with VarPtr as well.
>
> Option Explicit
>
> Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal
> nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As
> Long
> Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal
> nIDEvent As Long) As Long
> Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory"
> (Destination As Any, Source As Any, ByVal Length As Long)
> Private Declare Function GetTickCount Lib "kernel32" () As Long
> Private Declare Function SetRectByt Lib "user32" Alias "SetRect" (lpRect
> As Long, ByRef X1 As Byte, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As
> Long) As Long
> 'Set Rect is redifined with the second parameter as Byte and ByRef. This
> way SetRect is passed in the pointer
> 'to X1 and returns this pointer in lpRect
>
> Private mlngTimerId As Long
> Private mlngInterval As Long
> Private mbytData(12) As Byte
>
> Public Event Timer(ByVal dwTime As Long)
>
> Public Sub TimerProc()
> RaiseEvent Timer(GetTickCount)
> End Sub
>
> Public Property Let Interval(ByVal NewVal As Long)
> mlngInterval = NewVal
> If Running Then
> Running = False
> Running = True
> End If
> End Property
> Public Property Get Interval() As Long
> Interval = mlngInterval
> End Property
>
> Public Property Let Running(ByVal NewVal As Boolean)
> If NewVal Then
> If mlngTimerId = 0 Then
> mlngTimerId = SetTimer(0&, 0&, mlngInterval,
> VarPtrByt(mbytData(0)))
> If mlngTimerId = 0 Then Err.Raise vbObjectError,
> "clsTimer.Running", "Timer failed to start."
> End If
> Else
> If Not mlngTimerId = 0 Then
> If KillTimer(0&, mlngTimerId) = 0 Then Err.Raise vbObjectError
> + 1, "clsTimer.Running", "Timer failed to stop."
> mlngTimerId = 0
> End If
> End If
> End Property
> Public Property Get Running() As Boolean
> Running = mlngTimerId <> 0
> End Property
>
> Private Sub Class_Initialize()
> Dim lngX As Long
>
> CopyMemory lngX, Me, 4 'lngX=ObjPtr(me)
>
> mbytData(0) = &H68
> CopyMemory mbytData(1), lngX, 4 'push this (me) on stack
>
> mbytData(5) = &HE8
> CopyMemory mbytData(6), GetVTableAddress(Me, 7) -
> VarPtrByt(mbytData(10)), 4 'call TimerProc
>
> mbytData(10) = &HC2
> mbytData(11) = &H10
> mbytData(12) = &H0 'ret 10 --- return from
> callback, removing 4 parameters from stack
>
> 'Dump from C++
> '68 88 D8 17 00 push 17D888h 'push This
> (me) on stack
> 'E8 4B B1 FD FF call 0018201B 'Call Timer
> Proc
> 'C2 10 00 ret 10h 'Return
>
> 'Instead of the callback going directly into TimerProc, the callback
> goes into the
> 'byte array. This byte array contains code to call the TimerProc. As
> the TimerProc
> 'has no parameters and no return value (ie is a sub), no parameters
> need to be
> 'passed to it except for 'This'. The TimerProc really looks like this:
>
> 'Public Function TimerProc(ByVal This As Long) As Long
> End Sub
>
> Private Function VarPtrByt(ByRef bytRef As Byte) As Long
> 'To get a pointer to a variable, an API call that returns a value it is
> given is required
> 'It is also a big bonus if the API call doesn't actually do anything :)
> 'The SetRect API does this
>
> Dim lngX(3) As Long 'Replacement for RECT structure
> SetRectByt lngX(0), bytRef, 0, 0, 0
> VarPtrByt = lngX(0)
> End Function
>
> Private Function GetVTableAddress(objRef As Object, Offset As Long) As
> Long
> Dim lngX As Long
> CopyMemory lngX, objRef, 4 'lngx=ObjPtr(Me)
> CopyMemory lngX, ByVal lngX, 4 'Get pointer to VTable
> CopyMemory GetVTableAddress, ByVal lngX + Offset * 4, 4 'Get function
> pointer
> End Function
>
> Private Sub Class_Terminate()
> Running = False 'Stop timer if it is running
> End Sub
>
>
> -------------------------------------------------------
> form1code:
>
> Option Explicit
>
> Private WithEvents T As clsTimer
>
> Private Sub Form_Load()
> Set T = New clsTimer
> T.Interval = 1000
> T.Running = True
> End Sub
>
> Private Sub Form_Unload(Cancel As Integer)
> T.Running = False
> End Sub
>
> Private Sub T_Timer(ByVal dwTime As Long)
> Me.Caption = Me.Caption & "."
> End Sub
>
.
- Follow-Ups:
- Re: Emulate AddressOf operator
- From: Karl E. Peterson
- Re: Emulate AddressOf operator
- Prev by Date: Re: get text from listbox
- Next by Date: Re: get text from listbox
- Previous by thread: get text from listbox
- Next by thread: Re: Emulate AddressOf operator
- Index(es):
Relevant Pages
|
