VB实现截图、复制、剪切和粘贴功能.doc

ReleaseDC函数释放设备上下文环境（DC）供其他应用程序使用Private Declare Function ReleaseDC Lib user32 (ByVal hwnd As Long, ByVal hdc As Long) As LongOpenClipboard函数用于打开剪切板Private Declare Function OpenClipboard Lib user32 (ByVal hwnd As Long) As LongEmptyClipboard函数用于清空剪切板Private Declare Function EmptyClipboard Lib user32 () As LongSetClipboardData函数用于把数据放到具有指定格式的剪切板，窗口必须是当前剪切板的拥有者，该函数必须在OpenClipboard调用后才可以用Private Declare Function SetClipboardData Lib user32 (ByVal wFormat As Long, ByVal hMem As Long) As LongSelectObject 函数选择一对象到指定的设备上下文环境中，该新对象替换先前的相同类型的对象。Private Declare Function SelectObject Lib gdi32 (ByVal hdc As Long, ByVal hObject As Long) As LongDeleteDC 该函数删除指定的设备上下文环境（Dc）。Private Declare Function DeleteDC Lib gdi32 (ByVal hdc As Long) As LongBitBlt 该函数对指定的源设备环境区域中的像素进行位块（bit_block）转换，以传送到目标设备环境。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 LongCreateCompatibleDC该函数创建一个与指定设备兼容的内存设备上下文环境（DC）。通过GetDc()获取的HDC直接与相关设备沟通，而本函数创建的DC，则是与内存中的一个表面相关联。Private Declare Function CreateCompatibleDC Lib gdi32 (ByVal hdc As Long) As LongCreateCompatibleBitmap该函数创建与指定的设备环境相关的设备兼容的位图。Private Declare Function CreateCompatibleBitmap Lib gdi32 (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As LongCloseClipboard关闭剪贴板,这使其他窗口能访问剪贴板Private Declare Function CloseClipboard Lib user32 () As LongCreateDC该函数通过使用指定的名字为一个设备创建设备上下文环境。Private Declare Function CreateDC Lib gdi32 Alias CreateDCA (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Long) As Long Const MAX_TOOLTIP As Integer = 64 Const NIF_ICON = &H2 删除图标 Const NIF_MESSAGE = &H1 Const NIF_TIP = &H4 Const NIM_ADD = &H0 添加图标到任务栏提示区 Const NIM_DELETE = &H2 Const WM_MOUSEMOVE = &H200 Const WM_LBUTTONUP = &H202 Const WM_RBUTTONUP = &H205 Private Type NOTIFYICONDATA cbSize As Long hwnd As Long uID As Long uFlags As Long uCallbackMessage As Long hIcon As Long szTip As String * MAX_TOOLTIPEnd TypePrivate Declare Function GetMenu Lib user32 (ByVal hwnd As Long) As LongPrivate Declare Function GetSubMenu Lib user32 (ByVal hMenu As Long, ByVal nPos As Long) As LongPrivate Declare Function GetMenuItemID Lib user32 (ByVal hMenu As Long, ByVal nPos As Long) As LongPrivate Declare Function Shell_NotifyIcon Lib shell32.dll Alias Shell_NotifyIconA (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As LongPrivate nfIconData As NOTIFYICONDATADim X, Y As IntegerPrivate Sub end_Click() 退出系统 Call Shell_NotifyIcon(NIM_DELETE, nfIconData) EndEnd SubFunction vis() Dim i As Integer Dim menu1 As Long Dim menuID As Long menu1 = GetMenu(Me.hwnd) For i = 1 To 14 menuID = GetMenuItemID(GetSubMenu(menu1, 0), i - 1) Next nfIconData.hwnd = Me.hwnd nfIconData.uID = Me.Icon nfIconData.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP nfIconData.uCallbackMessage = WM_MOUSEMOVE nfIconData.hIcon = Me.Icon.Handle nfIconData.szTip = System Tray Example & vbNullChar nfIconData.cbSize = Len(nfIconData) Call Shell_NotifyIcon(NIM_ADD, nfIconData)End FunctionPrivate Sub Command4_Click()TWidth = Screen.Width / Screen.TwipsPerPixelXMsgBox TWidthTHeight = Screen.Height / Screen.TwipsPerPixelYMsgBox THeightEnd SubPrivate Sub Form_Activate()visEnd SubPrivate Sub Form_Load() If App.PrevInstance Then End End IfEnd SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim lMsg As Single lMsg = X / Screen.TwipsPerPixelX If lMsg = WM_RBUTTONUP Or lMsg = WM_LBUTTONUP Then Me.PopupMenu MyMenu End IfEnd SubPrivate Sub Form_Unload(Cancel As Integer) Cancel = 1EndEnd SubPrivate Sub Command1_Click() 抓图 Dim TWidth As Long Dim THeight As Long TWidth = Screen.Width Screen.TwipsPerPixelX THeight = Screen.Height Screen.TwipsPerPixelY SourceDC = CreateDC(DISPLAY, 0, 0, 0) DestDC = CreateCompatibleDC(SourceDC) Bhandle = CreateCompatibleBitmap(SourceDC, TWidth, THeight) SelectObject DestDC, Bhandle BitBlt DestDC, 0, 0, TWidth, THeight, SourceDC, 0, 0, &HCC0020 Wnd = Screen.ActiveForm.hwnd OpenClipboard Wnd EmptyClipboard SetClipboardData 2, Bhandle CloseClipboard DeleteDC DestDC ReleaseDC Dhandle, SourceDC Image1.Picture = Clipboard.GetData()End SubPrivate Sub Command2_Click() 保存图片 CommonDialog1.Filter = BMP文件(*.bmp)|*.bmp|JPG文件(*.jpg)|*.jpg CommonDialog1.ShowSave CommonDialog1.Flags = &H2 + &H4 + &H8 If CommonDialog1.FileName Then SavePicture Image1.Picture, CommonDialog1.FileName End IfEnd