Дві функції для роботи з буфером обміну

Text2Clipboard– Поміщає дані в буфер обміну
Clipboard2Text –
витягує дані з буфера обміну

Декларуємо API функції:

Declare Function abOpenClipboard Lib “User32” Alias “OpenClipboard” (ByVal Hwnd As Long) As Long
Declare Function abCloseClipboard Lib “User32” Alias “CloseClipboard” () As Long
Declare Function abEmptyClipboard Lib “User32” Alias “EmptyClipboard” () As Long
Declare Function abIsClipboardFormatAvailable Lib “User32” Alias “IsClipboardFormatAvailable” (ByVal wFormat As Long) As Long
Declare Function abSetClipboardData Lib “User32” Alias “SetClipboardData” (ByVal wFormat As Long, ByVal hMem As Long) As Long
Declare Function abGetClipboardData Lib “User32” Alias “GetClipboardData” (ByVal wFormat As Long) As Long
Declare Function abGlobalAlloc Lib “Kernel32” Alias “GlobalAlloc” (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Declare Function abGlobalLock Lib “Kernel32” Alias “GlobalLock” (ByVal hMem As Long) As Long
Declare Function abGlobalUnlock Lib “Kernel32” Alias “GlobalUnlock” (ByVal hMem As Long) As Boolean
Declare Function abLstrcpy Lib “Kernel32” Alias “lstrcpyA” (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Declare Function abGlobalFree Lib “Kernel32” Alias “GlobalFree” (ByVal hMem As Long) As Long
Declare Function abGlobalSize Lib “Kernel32” Alias “GlobalSize” (ByVal hMem As Long) As Long
Const GHND = &H42
Const CF_Text = 1
Const APINULL = 0

Функція копіювання даних в буфер обміну:
Public Function Text2Clipboard(strText As String)
Dim intLen As Integer
Dim hMemory As Long
Dim lpMemory As Long
Dim retval As Variant
Dim wFreeMemory As Boolean

intLen = Len(strText) + 1
strText = strText & Chr$(0)
hMemory = abGlobalAlloc(GHND, intLen + 1)
If hMemory = APINULL Then
    MsgBox “Unable to allocate memory.”
    Exit Function
End If
wFreeMemory = True
lpMemory = abGlobalLock(hMemory)
If lpMemory = APINULL Then
    MsgBox “Unable to lock memory.”
    GoTo T2CB_Free
End If
retval = abLstrcpy(lpMemory, strText)
retval = abGlobalUnlock(hMemory)
If abOpenClipboard(0&) = APINULL Then
    MsgBox “Unable to open Clipboard.  Perhaps some other application is using it.”
    GoTo T2CB_Free
End If
If abEmptyClipboard() = APINULL Then
    MsgBox “Unable to empty the clipboard.”
    GoTo T2CB_Close
End If
If abSetClipboardData(CF_Text, hMemory) = APINULL Then
    MsgBox “Unable to set the clipboard data.”
    GoTo T2CB_Close
End If
wFreeMemory = False
T2CB_Close:
If abCloseClipboard() = APINULL Then
    MsgBox “Unable to close the Clipboard.”
End If
If wFreeMemory Then GoTo T2CB_Free
Exit Function
T2CB_Free:
If abGlobalFree(hMemory) <> APINULL Then
    MsgBox “Unable to free global memory.”
End If
End Function

Функція витягання даних з буфера обміну:
Public Function Clipboard2Text()
Dim intLen As Integer
Dim hMemory As Long
Dim hMyMemory As Long
Dim lpMemory As Long
Dim lpMyMemory As Long
Dim retval As Variant
Dim wFreeMemory As Boolean
Dim wClipAvail As Integer
Dim strText As String
Dim wSize As Long
If abIsClipboardFormatAvailable(CF_Text) = APINULL Then
    Clipboard2Text = Null
    Exit Function
End If
If abOpenClipboard(0&) = APINULL Then
    MsgBox “Unable to open Clipboard.  Perhaps some other application is using it.”
    GoTo CB2T_Free
End If
hMemory = abGetClipboardData(CF_Text)
If hMemory = APINULL Then
    MsgBox “Unable to retrieve text from the Clipboard.”
    Exit Function
End If
wSize = abGlobalSize(hMemory)
strText = Space(wSize)
wFreeMemory = True
lpMemory = abGlobalLock(hMemory)
If lpMemory = APINULL Then
    MsgBox “Unable to lock clipboard memory.”
    GoTo CB2T_Free
End If
retval = abLstrcpy(strText, lpMemory)
strText = Trim(strText)
Clipboard2Text = Left(strText, Len(strText) – 1)
wFreeMemory = False
CB2T_Close:
If abCloseClipboard() = APINULL Then
    MsgBox “Unable to close the Clipboard.”
End If
If wFreeMemory Then GoTo CB2T_Free
Exit Function
CB2T_Free:
If abGlobalFree(hMemory) <> APINULL Then
    MsgBox “Unable to free global clipboard memory.”
End If
End Function


Схожі статті:


Сподобалася стаття? Ви можете залишити відгук або підписатися на RSS , щоб автоматично отримувати інформацію про нові статтях.

Коментарів поки що немає.

Ваш отзыв

Поділ на параграфи відбувається автоматично, адреса електронної пошти ніколи не буде опублікований, допустимий HTML: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

*

*