LEADERSOFT.ru Разработка на заказ программ и сайтов
Раздел обучения информационным технологиям
Разработка программ на Access
04. Этот пример показывает как с использованием API интерфейса управлять буфером Windows. Используется класс и api интерфейс. Это более надежный способ, чем другие без api интерфейса.
Свойства продукта

 Microsoft Office: 2000,2002,2003,2007,2010  Архив с файлами: Перейти
 Операционная система: Windows XP,Vista  Применение: Базы данных Access
 Продажа: Купить  Файл исходника: ..\Access\16 Модули\API\la_api.mdb
 Язык интерфейса: Русский

   

' Функции управления буфером
Private Declare Function IsClipboardFormatAvailable Lib "user32" _
    (ByVal uFormat As IntegerAs Integer
Private Declare Function apiOpenClipboard Lib "user32" Alias "OpenClipboard" _
    (ByVal hWnd As LongAs Integer
Private Declare Function apiSetClipboardData Lib "user32" Alias "SetClipboardData" _
    (ByVal uFormat As Integer, _
     ByVal hData As LongAs Long
Private Declare Function apiGetClipboardData Lib "user32" Alias "GetClipboardData" _
    (ByVal uFormat As IntegerAs Long
Private Declare Function apiCloseClipboard Lib "user32" Alias "CloseClipboard" _
    () As Integer
Private Declare Function apiEmptyClipboard Lib "user32" Alias "EmptyClipboard" _
    () As Integer

' Функции управления памятью
Private Declare Function apiGlobalAlloc Lib "kernel32" Alias "GlobalAlloc" _
    (ByVal uFlags As Integer, _
     ByVal dwBytes As LongAs Long
Private Declare Function apiGlobalSize Lib "kernel32" Alias "GlobalSize" _
    (ByVal hMem As LongAs Integer
Private Declare Function apiGlobalLock Lib "kernel32" Alias "GlobalLock" _
    (ByVal hMem As LongAs Long
Private Declare Sub apiMoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (ByVal strDest As Any, _
     ByVal lpSource As Any, _
     ByVal Length As Long)
Private Declare Function apiGlobalUnlock Lib "kernel32" Alias "GlobalUnlock" _
    (ByVal hMem As LongAs Integer
Private Declare Function apiGlobalFree Lib "kernel32" Alias "GlobalFree" _
    (ByVal hMem As LongAs Long

' api-Константы памяти
Private Const GMEM_FIXED = &H0
Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_NOCOMPACT = &H10
Private Const GMEM_NODISCARD = &H20
Private Const GMEM_ZEROINIT = &H40
Private Const GMEM_MODIFY = &H80
Private Const GMEM_DISCARDABLE = &H100
Private Const GMEM_NOT_BANKED = &H1000
Private Const GMEM_SHARE = &H2000
Private Const GMEM_DDESHARE = &H2000
Private Const GMEM_NOTIFY = &H4000
Private Const GMEM_LOWER = GMEM_NOT_BANKED
Private Const GMEM_VALID_FLAGS = &H7F72
Private Const GMEM_INVALID_HANDLE = &H8000
Private Const GMEM_TEXT = (GMEM_MOVEABLE Or GMEM_DDESHARE)

' api-Форматы буфера
Private Const CF_TEXT = 1
Private Const CF_BITMAP = 2
Private Const CF_METAFILEPICT = 3
Private Const CF_SYLK = 4
Private Const CF_DIF = 5
Private Const CF_TIFF = 6
Private Const CF_OEMTEXT = 7
Private Const CF_DIB = 8
Private Const CF_PALETTE = 9
Private Const CF_PENDATA = 10
Private Const CF_RIFF = 11
Private Const CF_WAVE = 12
Private Const CF_UNICODETEXT = 13
Private Const CF_ENHMETAFILE = 14

'==============================================================
'  Копируем текст в буфер
'
Function CopyText(strText As StringAs Variant
Dim hMem As Long
Dim lpMem As Long
Dim As Long

    ' Выделение памяти
    l = Len(strText) + 1 ' Длина строки с учетом символа \0 (c++)
    hMem = apiGlobalAlloc(GMEM_TEXT, l) ' Память для буфера
    
    ' Управление памятью
    lpMem = apiGlobalLock(hMem) ' Блокируем часть памяти
    Call apiMoveMemory(lpMem, strText, l) ' Копируем строку в память
    Call apiGlobalUnlock(hMem) ' Разблокируем память
    
    ' Управление буфером
    Call apiOpenClipboard(0&) ' Открываем буфер
    Call apiEmptyClipboard ' Очищаем буфер
    Call apiSetClipboardData(CF_TEXT, hMem) ' Загружаем текст
    Call apiCloseClipboard ' Закрываем буфер
    
    ' Освобождаем память
    Call apiGlobalFree(hMem)
End Function


'==============================================================
'  Получаем текст из буфера
'
Public Function GetText() As Variant
Dim hMem As Long
Dim lpMem As Long
Dim As String
Dim As Long

    ' Проверяем формат буфера
    If Not CBool(IsClipboardFormatAvailable(CF_TEXT)) Then
        Exit Function
    End If
   
    ' Работаем с буфером и памятью
    Call apiOpenClipboard(0&) ' Открываем буфер
    hMem = apiGetClipboardData(CF_TEXT) ' Получаем заголовок данных в буфере
    l = apiGlobalSize(hMem) ' Определяем размер строки
    s = Space$(l) ' Выделение памяти для строки
    lpMem = apiGlobalLock(hMem) ' Блокируем память
    Call apiMoveMemory(s, lpMem, l) ' Копируем информацию из буфера в строку
    Call apiGlobalUnlock(hMem) ' Разблокирование памяти
    Call apiCloseClipboard ' Закрываем буфер
    
    ' Возвращаем результат
    GetText = Left$(s, InStr(1, s, Chr$(0)) - 1)
    
End Function


Copyright © 2002-2015 ООО Лидер Эксэсс
Сайт работает под управлением: ASP.NET, Access