Visual Basic. Программирование на Visual Basic

..........................................................................................................................

[ Главная ] [ Статьи ] [ Для новичков ] [ Примеры ] [ Программы ] [ Microsoft Agent 2.0 ] [ Пособие ] [ Уроки ] [ Разное ]
..........................................................................................................................



Скопировать содержимое PictureBox в буфер обмена.
Интересный пример, правда не до конца понятый мною.
Расположите на форме элемент PictureBox и элемент CommandButton.
Запустите проект, нажмите на кнопку.
Затем откройте приложение Paint и нажмите сочетание клавиш Ctrl + V.

Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GetClipboardFormatName Lib "user32" Alias "GetClipboardFormatNameA" (ByVal wFormat As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CountClipboardFormats Lib "user32" () As Long
Private Declare Function EnumClipboardFormats Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function RegisterClipboardFormat Lib "user32" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Public Enum EPredefinedClipboardFormatConstants
[_First] = 1
CF_TEXT = 1
CF_BITMAP = 2
CF_METAFILEPICT = 3
CF_SYLK = 4
CF_DIF = 5
CF_TIFF = 6
CF_OEMTEXT = 7
CF_DIB = 8
CF_PALETTE = 9
CF_PENDATA = 10
CF_RIFF = 11
CF_WAVE = 12
CF_UNICODETEXT = 13
CF_ENHMETAFILE = 14
CF_HDROP = 15
CF_LOCALE = 16
CF_MAX = 17
[_Last] = 17
End Enum

Public Function CopyEntirePictureToClipboard(ByRef objFrom As Object) As Boolean
Dim lhDC As Long
Dim lhBmp As Long
Dim lhBmpOld As Long
lhDC = CreateCompatibleDC(objFrom.hdc)
If (lhDC <> 0) Then
lhBmp = CreateCompatibleBitmap(objFrom.hdc, objFrom.ScaleWidth \ Screen.TwipsPerPixelX, objFrom.ScaleHeight \ Screen.TwipsPerPixelY)
If (lhBmp <> 0) Then
lhBmpOld = SelectObject(lhDC, lhBmp)
BitBlt lhDC, 0, 0, objFrom.ScaleWidth \ Screen.TwipsPerPixelX, objFrom.ScaleHeight \ Screen.TwipsPerPixelY, objFrom.hdc, 0, 0, SRCCOPY
SelectObject lhDC, lhBmpOld
EmptyClipboard
OpenClipboard 0
SetClipboardData CF_BITMAP, lhBmp
CloseClipboard
End If
DeleteObject lhDC
CopyEntirePictureToClipboard = True
Else
CopyEntirePictureToClipboard = False
End If
End Function

Private Sub Command1_Click()
Call CopyEntirePictureToClipboard
End Sub

..........................................................................................................................

[ Главная ] [ Диски ] [ Книги ] [ Архив рассылки ] [ Архив новостей ] [ Готовые кусочки программ ] [ Карта сайта ]
..........................................................................................................................

По страницам сайта Visaul Progs
или Изучение Visual Basic
Рассылка 'По страницам сайта Visaul Progs' >>> Подпишись на рассылку - будешь получать новые статьи , примеры и много полезной информации из первых рук!!! >>>Если у вас есть статья которой нет на сайте
пришлите ее мне-------->
Послать статью
>>>Если вы хотите задать вопрос
пишите-------->
Мне нужна помощь


Рейтинг сайтов YandeG Rambler's Top100
Реклама:

...:::Design by Mystf0rse 2005-2010 year:::...