Visual Basic, .NET, ASP, VBA, VBScript
 
  Библиотека кодов  
  Стандартные элементы >>> PictureBox/Image  
     
  Скопировать рисунок из PictureBox в буфер обмена  
  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 ' (DWORD) dest = source
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 EmptyClipboard Lib "USER32" () As Long
Private Const CF_BITMAP = 2

Public Function CopyEntirePicture(ByRef objFrom As Object) As Boolean
Dim lhDC As Long
Dim lhBMP As Long
Dim lhBMPOld As Long
Dim lWidthPixels As Long
Dim lHeightPixels As Long
' Create a DC compatible with the object we're copying from:
lhDC = CreateCompatibleDC(objFrom.hDC)
If (lhDC <> 0) Then
' Create a bitmap compatible with the object we're copying from:
lWidthPixels = objFrom.ScaleX(objFrom.ScaleWidth, objFrom.ScaleMode, vbPixels)
lHeightPixels = objFrom.ScaleY(objFrom.ScaleHeight, objFrom.ScaleMode, vbPixels)
lhBMP = CreateCompatibleBitmap(objFrom.hDC, lWidthPixels, lHeightPixels)
If (lhBMP <> 0) Then
' Select the bitmap into the DC we have created, and store the old bitmap that was there:
lhBMPOld = SelectObject(lhDC, lhBMP)
' Copy the contents of objFrom to the bitmap:
BitBlt lhDC, 0, 0, lWidthPixels, lHeightPixels, objFrom.hDC, 0, 0, SRCCOPY
' Remove the bitmap from the DC:
SelectObject lhDC, lhBMPOld
' Now set the clipboard to the bitmap:
OpenClipboard 0
EmptyClipboard
SetClipboardData CF_BITMAP, lhBMP
CloseClipboard
' We don't delete the Bitmap here - it is now owned
' by the clipboard and Windows will delete it for us
' when the clipboard changes or the program exits.
End If
' Clear up the device context we created:
DeleteObject lhDC
End If
End Function

Private Sub Command1_Click()
CopyEntirePicture Picture1
End Sub

Private Sub Form_Load()
Dim i As Long
' Draw something in the Picture box:
With Picture1.Font
.Name = "Arial"
.Bold = True
.Size = 24
End With
For i = 1 To 20
Picture1.ForeColor = QBColor(i Mod 15)
Picture1.Print "vbAccelerator"
Next i
End Sub
 
     
  VBNet online (всего: 51216)  
 

Логин:

Пароль:

Регистрация, забыли пароль?


В чате сейчас человек
 
     
  VBNet рекомендует  
   
     
  Лучшие материалы  
 
ActiveX контролы (112)
Hitman74_Library (36119)
WindowsXPControls (20739)
FlexGridPlus (19374)
DSMAniGifControl (18295)
FreeButton (15157)
Примеры кода (546)
Parol (18027)
Passworder (9299)
Screen saver (7654)
Kerish AI (5817)
Folder_L (5768)
Статьи по VB (136)
Мое второе впечатление... (11236)
VB .NET: дорога в будущее (11161)
Основы SQL (9225)
Сообщения Windows в Vi... (8788)
Классовая теория прогр... (8619)
 
     
Техническая поддержка MTW-хостинг | © Copyright 2002-2011 VBNet.RU | Пишите нам