GFLRC/Receiver/GFLRC_Receiverfrm.frm

VERSION 5.00
Begin VB.Form GFLRC_Receiverfrm
   BorderStyle     =   0 'Kein
   Caption         =   "GFLRC_Receiverfrm"
   ClientHeight    =   90
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   90
   LinkTopic       =   "Form1"
   ScaleHeight     =   90
   ScaleWidth      =   90
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3 'Windows‑Standard
End
Attribute VB_Name = "GFLRC_Receiverfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)2002 by Louis. Created out of (god bless it) NN99 code.
'Use the GFLRC code to exchange strings between two applications.
'
'Any target form should own the following sub:
'Public Sub GFLRC_ReceiveMessage(ByVal Message As String)
'    'on error resume next
'End Sub
'
'GFSubClassWindowProc
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As AnyByVal cbCopy As Long)
'GFSubClassWindowProc
Const WM_COPYDATA = &H4A
'GFSubClassWindowProc
Private Type COPYDATASTRUCT
    dwData As Long
    cbData As Long
    lpData As Long
End Type
'GFLRCStruct ‑ stores target form references
Private Type GFLRCStruct
    TargetForm As Object
End Type
Dim GFLRCStructNumber As Integer
Dim GFLRCStructArray() As GFLRCStruct
'[Open/Close]LRCPort
Dim LRCPortOpenedFlag As Boolean
Dim LRCPortGFLRC_ReceiverfrmhWndOld As Long
Dim LRCPortGFLRC_ReceiverfrmhWndUnchanged As Long

Public Sub GFLRC_AddCallBackForm(ByRef CallBackForm As Object)
    'on error resume next
    If Not (GFLRCStructNumber = 32766) Then 'verify
        GFLRCStructNumber = GFLRCStructNumber + 1
        ReDim Preserve GFLRCStructArray(1 To GFLRCStructNumber) As GFLRCStruct
        Set GFLRCStructArray(GFLRCStructNumber).TargetForm = CallBackForm
    Else
        MsgBox "internal error in GFLRC_ReceiveCallBackForm(): overflow !", vbOKOnly + vbExclamation
    End If
End Sub

Public Sub GFLRC_RemoveCallBackForm(ByRef CallBackForm As Object)
    'on error resume next
    Dim StructIndex As Integer
    Dim StructLoop As Integer
    'begin
    For StructLoop = 1 To GFLRCStructNumber
        If GFLRCStructArray(StructLoop).TargetForm Is CallBackForm Then
            StructIndex = StructLoop
        End If
    Next StructLoop
    If StructIndex = 0 Then Exit Sub 'verify
    For StructLoop = StructIndex To GFLRCStructNumber
        If Not (StructLoop = GFLRCStructNumber) Then
            Set GFLRCStructArray(StructLoop).TargetForm = GFLRCStructArray(StructLoop + 1).TargetForm
        Else
            GFLRCStructNumber = GFLRCStructNumber ‑ 1
            StructLoop = GFLRCStructNumber
            If StructLoop < 1 Then StructLoop = 1 'verify
            ReDim Preserve GFLRCStructArray(1 To StructLoop) As GFLRCStruct
            Exit For 'important
        End If
    Next StructLoop
    Exit Sub
End Sub

Public Sub OpenLRCPort(ByVal LRCLocalPortNamePassed As String) 'enables bypassing GFLRC_Receiverfrm messages to LRCHookProcSub()
    'On Error Resume Next 'LRCLocalPortNamePassed will be caption of GFLRC_Receiverfrm (should not be nothing)
    If LRCPortOpenedFlag = False Then
        LRCPortOpenedFlag = True
        '
        Call GFSubClass(Me, "GFLRC_Receiverfrm", Me, True)
        GFLRC_Receiverfrm.Caption = LRCLocalPortNamePassed
        GFLRC_Receiverfrm.Refresh 'verify caption is changed
        '
    End If
End Sub

Public Sub CloseLRCPort() 'disables bypassing GFLRC_Receiverfrm messages to LRCHookProcSub()
    'On Error Resume Next
    Dim Temp As Long
    If LRCPortOpenedFlag = True Then
        LRCPortOpenedFlag = False
        '
        Call GFSubClass_UnSubclass("GFLRC_Receiverfrm", Me)
        GFLRC_Receiverfrm.Caption = "" 'reset (important)
        GFLRC_Receiverfrm.Refresh 'verify caption is changed
        '
    End If
End Sub

Public Sub GFSubClassWindowProc(ByVal SourceDescription As StringByVal hwnd As LongByVal Msg As LongByVal wParam As LongByVal lParam As LongByRef ReturnValue As LongByRef ReturnValueUsedFlag As Boolean)
    'On Error Resume Next
    Dim TargetFormLoop As Integer
    Dim Tempstr$
    Dim TempArrayByte() As Byte
    Dim COPYDATASTRUCTVar As COPYDATASTRUCT
    'begin
    Select Case Msg
    Case WM_COPYDATA
        If Not ((wParam = 0) Or (lParam = 0)) Then 'verify valid values arrived
            'STOLEN CODE ('PassString' from VBNet)
            'stolen annotations: copy the data sent to this application into a local structure
            Call CopyMemory(COPYDATASTRUCTVar, ByVal lParam, Len(COPYDATASTRUCTVar))
            ReDim TempArrayByte(1 To COPYDATASTRUCTVar.cbData) As Byte 'length of msg line passed by .cdData
            'copy the string that was passed into a byte array
            Call CopyMemory(TempArrayByte(1), ByVal COPYDATASTRUCTVar.lpData, COPYDATASTRUCTVar.cbData)
            'convert the ASCII byte array back to a Unicode string
            Tempstr$ = StrConv(TempArrayByte(), vbUnicode)
            'END OF STOLEN CODE
            '***SUB RECEIVING LRC DATA***
            For TargetFormLoop = 1 To GFLRCStructNumber
                Call GFLRCStructArray(TargetFormLoop).TargetForm.GFLRC_ReceiveMessage(Tempstr$)
            Next TargetFormLoop
            '***END***
        End If
    End Select
End Sub


[END OF FILE]