Буфер обмена для своих объектов

[Alexanbar]

Есть некий класс Works. Нужно сделать операции с буфером обмена для него.

Делаю так:

Код: Выделить всё

'класс-модуль Works

Public Function CopyToClipboard(Optional ByVal hwnd As Long, _
Optional ByVal SelectedOnly As Boolean = True) As Boolean

Dim wFormat&, hMem&, lpData&
Dim ClpWork As Works


If SelectedOnly Then
    Set ClpWork = New Works
   
    For i = 1 To Count
        If Item(i).Selected Then
            ClpWork.AddNewWork Item(i), True
        End If
    Next i
Else
    Set ClpWork = Me
End If

If ClpWork.Count > 0 Then

    wFormat = RegisterClipboardFormat("Work.lst")
    If wFormat <> 0 Then
        If OpenClipboard(hwnd) <> 0 Then
               
           
            hMem = GlobalAlloc(GHND, ByVal 4&)

            If hMem <> 0 Then
                   
                lpData& = GlobalLock(hMem)
               
                If lpData <> 0 Then
               
                    CopyMemory ByVal lpData, ByVal ObjPtr(ClpWork), ByVal 4&
                    GlobalUnlock hMem
                   
                    EmptyClipboard
                   
                    Call SetClipboardData(wFormat&, hMem&)
                    CopyToClipboard = True
           
                End If
            End If
           
        End If
           
        CloseClipboard
       
    End If
End If
End Function

Public Sub PasteFromClipboard()
Dim wFormat&, hMem&, lpData&
Dim ClpWork As Works

wFormat = RegisterClipboardFormat("Work.lst")
If wFormat <> 0 Then
    If OpenClipboard(hwnd) <> 0 Then
       

        hMem = GetClipboardData(wFormat)
       
        If hMem <> 0 Then
            lpData = GlobalLock(hMem)
           
            If lpData <> 0 Then
               
               
                CopyMemory ClpWork, ByVal lpData, ByVal 4&
               
               
       
                GlobalUnlock hMem
               
                 
                For i = 1 To ClpWork.Count
                    AddNewWork ClpWork(i), True

                Next i
               
               
            End If
           
           
        End If
        CloseClipboard
       
       
    End If
End If
End Sub


Копирование в буфер проходит без видимых ошибок.

Вставка из буфера не работает (вырубается приложение).

Неверно выполняется строка из Sub PasteFromClipboard:

Код: Выделить всё

CopyMemory ClpWork, ByVal lpData, ByVal 4&.


[Vi]

Нужно корректно устанавливать счетчик ссылок объекта - функции AddRef/Release интерфейса IUnknown.

Или обнулять (но не через Nothing) ClpWork после копирования в буфер.

[Alexanbar]

Нужно корректно устанавливать счетчик ссылок объекта - функции AddRef/Release интерфейса IUnknown.

Или обнулять (но не через Nothing) ClpWork после копирования в буфер.

А подробнее?

[Vi]

Я не знаю варианта с AddRef/Release, но могу продемонстрировать обнуление.

Код: Выделить всё

Public Function CopyToClipboard ...
...
          CopyMemory ByVal lpData, ClpWork, ByVal 4& ' !!! Сравни со своим вариантом
          Dim lZero As Long
          lZero = 0
          CopyMemory ClpWork, lZero, ByVal 4& ' эквивалент  Set ClpWork = Nothing без уменьшения счетчика ссылок
...
Public Sub PasteFromClipboard...
...
          CopyMemory ClpWork, ByVal lpData, ByVal 4&
...
          EmptyClipboard ' только один раз
или после использования
          Dim lZero As Long
          lZero = 0: CopyMemory ClpWork, lZero, ByVal 4& ' несколько раз
...


В любом случае учти, что скопированный в Clipboard объект не удаляется из памяти, т.к. имеет увеличенную ссылку. И когда-то должен быть удален. Есть также проблема в возможном отсутствии Paste после Copy.

Лучше всего помещать эти скопированные объекты в некий массив/коллекцию, чтобы VB сам их освободил в конце работы.

[Alexanbar]

Откорректировал обе процедуры.

Код: Выделить всё

Public Function CopyToClipboard(Optional ByVal hwnd As Long, _
Optional ByVal SelectedOnly As Boolean = True) As Boolean

Dim wFormat&, hMem&, lpData&
Dim ClpWork As Works
'Dim lZero As Long

On Error Resume Next

If SelectedOnly Then
    Set ClpWork = New Works
   
    For i = 1 To Count
        If Item(i).Selected Then
            ClpWork.AddNewWork Item(i), True
        End If
    Next i
Else
    Set ClpWork = Me
End If

If ClpWork.Count > 0 Then

    wFormat = RegisterClipboardFormat("Work.lst")
    If wFormat <> 0 Then
        If OpenClipboard(hwnd) <> 0 Then
               
           
            hMem = GlobalAlloc(GHND, ByVal 4&)

            If hMem <> 0 Then
                lpData& = GlobalLock(hMem)
               
                If lpData <> 0 Then
               
                   
                    CopyMemory ByVal lpData, ClpWork, ByVal 4&
                   
                   
                   
                    CopyMemory ClpWork, 0&, 4&
                   
                    GlobalUnlock hMem
                   
                   
                   
                    EmptyClipboard
                   
                    Call SetClipboardData(wFormat&, hMem&)
                    CopyToClipboard = True
           
                End If
            End If
           
        End If
           
        CloseClipboard
       
    End If
End If
End Function
Public Sub PasteFromClipboard(Optional ByVal hwnd As Long)
Dim wFormat&, hMem&, lpData&
Dim ClpWork As Works



wFormat = RegisterClipboardFormat("Work.lst")
If wFormat <> 0 Then
    If OpenClipboard(hwnd) <> 0 Then
       
       
        hMem = GetClipboardData(wFormat)
       
        If hMem <> 0 Then
            lpData = GlobalLock(hMem)
           
         
            If lpData <> 0 Then
               
                CopyMemory ClpWork, ByVal lpData, ByVal 4&
               
               
                 
               
               
                On Error Resume Next
                If Not ClpWork Is Nothing Then
                   
                    For i = 1 To ClpWork.Count
                       
                        ClpWork(i).Selected = False
                        AddNewWork ClpWork(i), True
   
                    Next i
                   
               
                End If
                Err.Clear
                On Error GoTo 0
               
               
                CopyMemory ClpWork, 0&, 4&
               
               
               
            End If
     
            GlobalUnlock hMem
           
        End If
        CloseClipboard
       
    End If
End If
End Sub



Работает только при условии, если обмен идёт между двумя копиями приложения.

Пробовал запускать исходное приложение и переименованное.

ПРи копировании с помощью исходного и попытки вставить в буфер перименованного идёт вырубание.

[Vi]

А что ты хочешь, передавая какой-то внутренний адрес приложения? Чтобы передать объект (как адрес объекта) нужно задействовать СОМ систему, иначе кто будет маршаллировать твой интерфейс в чужой процесс?

Есть хороший моникер, создаваемый через CreateObjrefMoniker. Он имеет строковое представление, которое даст объект через VB-шный GetObject.

Поищи здесь на форуме, вроде, tyomitch тоже решал эту проблему.

[Alexanbar]

А что ты хочешь, передавая какой-то внутренний адрес приложения?

Выходит, про то, что написано в MSDN, нужно забыть? Обидно.

Есть хороший моникер, создаваемый через CreateObjrefMoniker

Не нашёл, к сожалению. В строку я могу преобразовать свой объект и самостоятельно, поскольку он берётся из текстового файла, и туда же отправляется при обновлении.

Но строка тоже копируется в буфер только в пределах приложения.

[Vi]

Но строка тоже копируется в буфер только в пределах приложения.

Если ты применяешь эту же технику, то - да. Но для строк есть другие форматы Clipboard, которые могут переносить строки между приложениями. Есть и стандартный объект Clipboard, работа с которым прозрачна и надежна.

[Alexanbar]

Но для строк есть другие форматы Clipboard, которые могут переносить строки между приложениями. Есть и стандартный объект Clipboard, работа с которым прозрачна и надежна.

Дело в том, что строка, соответсвующая моему объекту, не предназначена для вставки в блокнот или, скажем, в MS Word.
Верно и обратное. Не каждая текстовая строка является текстовым представлением моего объекта.

Но, похоже, придётся добавлять в начало строки некую сигнатуру и работать со стандартным объектом Clipboard и форматом VBCFText, хотя это и неудобно.

К сожалению, метод SetText отказывается посылать строку для форматов, которые не являются встроенными.

[alibek]

А почему бы не сериализовать PropertyBag?

[Alexanbar]

А почему бы не сериализовать PropertyBag?

Как это связано с буфером обмена?

[Alexanbar]

Проблема решена.
Суть решения.

1) Объект представлен в виде байтового массива btW.

2) Выделяется память соответсвующего размера

Код: Выделить всё


lx&=Ubound(btW)+1
hMem = GlobalAlloc(GHND, ByVal lx)


3) При использовании CopyMemory указывается размер массива

Код: Выделить всё

CopyMemory ByVal lpData, btW(0), ByVal lx


4) Операторов типа CopyMemory ClpWork, 0&, 4& не требуется