Problema al arrastrar un formulario

[LeandroA]

Hola te paso un ejemplo utlizando SendMessage con WM_COPYDATA (ojo nada que ver con el portapapeles)

En la Aplicacion que va a recivir los mensages

Dentro de un modulo bas

Código:

Option Explicit
'---------------------------------------
'Autor:     Leandro Ascierto
'Web:       www.leandroascierto.com.ar
'Date:      07/11/09
'---------------------------------------
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function CreateWindowEx Lib "user32.dll" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, ByRef lpParam As Any) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function DestroyWindow Lib "user32.dll" (ByVal hwnd As Long) As Long

Private Const GWL_WNDPROC = (-4)
Private Const WM_COPYDATA = &H4A

Private Type COPYDATASTRUCT
    dwData As Long
    cbData As Long
    lpData As Long
End Type

Dim PrevProc As Long
Dim hWin As Long

Public Sub StartListen(ByVal sKey As String)
    hWin = CreateWindowEx(0, "Static", sKey, 0, 0, 0, 0, 0, 0, 0, 0, 0&)
    PrevProc = SetWindowLong(hWin, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub StopListen()
    SetWindowLong hWin, GWL_WNDPROC, PrevProc
    DestroyWindow hWin
End Sub

Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    
    If uMsg = WM_COPYDATA Then
        Dim sBuff As String
        Dim CDS As COPYDATASTRUCT
        Call CopyMemory(CDS, ByVal lParam, Len(CDS))
        sBuff = Space(CDS.cbData)
        Call CopyMemory(ByVal sBuff, ByVal CDS.lpData, CDS.cbData)
        '------------
        ProcesarDatos sBuff
    End If

    WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)


End Function

Private Sub ProcesarDatos(sDATA As String)
    Form1.Text1 = sDATA '<---Ojo aca con el nombre del formulario
End Sub

y dentro del formulario (Que para este ejemplo se llama Form1)

Código:

Option Explicit
Const PersonalKey = "MyKeyWindow"

Private Sub Form_Load()
    StartListen PersonalKey
End Sub

Private Sub Form_Unload(Cancel As Integer)
    StopListen
End Sub

en la aplicacion que envia los mensages
agrega para probar un formulario con un Command1

Código:

Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Const WM_COPYDATA = &H4A

Private Type COPYDATASTRUCT
    dwData As Long
    cbData As Long
    lpData As Long
End Type

Const PersonalKey = "MyKeyWindow"

Private Function SendData(ByVal sKey As String, ByVal sDATA As String) As Boolean
    Dim CDS As COPYDATASTRUCT
    Dim sSTR As String
    Dim hWin As String
        
    hWin = FindWindow("Static", sKey)
    If hWin Then
        sSTR = StrConv(sDATA, vbFromUnicode)
        With CDS
            .dwData = 3
            .cbData = LenB(sSTR)
            .lpData = StrPtr(sSTR)
        End With
        SendData = SendMessage(hWin, WM_COPYDATA, Me.hwnd, CDS) = 0
    End If
End Function


Private Sub Command1_Click()
    Call SendData(PersonalKey, "hola mundo")
End Sub