VB各种图形设计报告_百度文库
两大类热门资源免费畅读
续费一年阅读会员，立省24元！
VB各种图形设计报告
阅读已结束，下载文档到电脑
想免费下载本文？
定制HR最喜欢的简历
下载文档到电脑，方便使用
还剩17页未读，继续阅读
定制HR最喜欢的简历
你可能喜欢 上传我的文档
 下载
 收藏
机械毕业设计CAD图纸，本人励志为大家提供最优秀，最全面的论文设计参考资料，如有不足请给予指正，本人将不甚感激！
 下载此文档
正在努力加载中...
VB图像处理工具设计（源代码及全套资料）
下载积分：1000
内容提示：VB图像处理工具设计（源代码及全套资料）
文档格式：DOC|
浏览次数：143|
上传日期： 18:16:22|
文档星级：
全文阅读已结束，如果下载本文需要使用
 1000 积分
下载此文档
该用户还上传了这些文档
VB图像处理工具设计（源代码及全套资料）
关注微信公众号'截图模块Module1.bas
Private Type PALETTEENTRY&& peRed As Byte&& peGreen As Byte&& peBlue As Byte&& peFlags As ByteEnd Type
Private Type LOGPALETTE&& palVersion As Integer&& palNumEntries As Integer&& palPalEntry(255) As PALETTEENTRYEnd Type
Private Type GUID&& Data1 As Long&& Data2 As Integer&& Data3 As Integer&& Data4(7) As ByteEnd Type
Private Const RASTERCAPS As Long = 38Private Const RC_PALETTE As Long = &H100Private Const SIZEPALETTE As Long = 104
Private Type RECT&& Left As Long&& Top As Long&& Right As Long&& Bottom As LongEnd Type
Private Declare Function CreateCompatibleDC Lib &GDI32& (ByVal hDC As Long) As LongPrivate Declare Function CreateCompatibleBitmap Lib &GDI32& (ByVal hDC As Long, _&&&&&&& ByVal nWidth As Long, ByVal nHeight As Long) As LongPrivate Declare Function GetDeviceCaps Lib &GDI32& (ByVal hDC As Long, ByVal _&&&&&&& iCapabilitiy As Long) As LongPrivate Declare Function GetSystemPaletteEntries Lib &GDI32& (ByVal hDC As Long, _&&&&&&& ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries _&&&&&&& As PALETTEENTRY) As LongPrivate Declare Function CreatePalette Lib &GDI32& (lpLogPalette As LOGPALETTE) _&&&&&&& As LongPrivate Declare Function SelectObject Lib &GDI32& (ByVal hDC As Long, ByVal hObject _&&&&&&& As Long) As LongPrivate Declare Function BitBlt Lib &GDI32& (ByVal hDCDest As Long, ByVal XDest As _&&&&&&& Long, ByVal YDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, _&&&&&&& ByVal hDCSrc As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop _&&&&&&& As Long) As LongPrivate Declare Function DeleteDC Lib &GDI32& (ByVal hDC As Long) As LongPrivate Declare Function GetForegroundWindow Lib &user32& () As LongPrivate Declare Function SelectPalette Lib &GDI32& (ByVal hDC As Long, ByVal hPalette _&&&&&&& As Long, ByVal bForceBackground As Long) As LongPrivate Declare Function RealizePalette Lib &GDI32& (ByVal hDC As Long) As LongPrivate Declare Function GetWindowDC Lib &user32& (ByVal hwnd As Long) As LongPrivate Declare Function GetDC Lib &user32& (ByVal hwnd As Long) As LongPrivate Declare Function GetWindowRect Lib &user32& (ByVal hwnd As Long, lpRect As _&&&&&&& RECT) As LongPrivate Declare Function ReleaseDC Lib &user32& (ByVal hwnd As Long, ByVal hDC As _&&&&&&& Long) As LongPrivate Declare Function GetDesktopWindow Lib &user32& () As Long
Private Type PicBmp&& Size As Long&& Type As Long&& hBmp As Long&& hPal As Long&& Reserved As LongEnd Type
Private Declare Function OleCreatePictureIndirect Lib &olepro32.dll& (PicDesc As _&&&&&&& PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
'创建BMP位图Public Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture& Dim r As Long
& Dim Pic As PicBmp& Dim IPic As IPicture& Dim IID_IDispatch As GUID
& '填充IDispatch界面& With IID_IDispatch&&&& .Data1 = &H20400&&&& .Data4(0) = &HC0&&&& .Data4(7) = &H46& End With
& '填充Pic& With Pic&&&& .Size = Len(Pic)&&&&&&&&& '注释： Pic结构长度&&&& .Type = vbPicTypeBitmap&& '注释： 图象类型&&&& .hBmp = hBmp&&&&&&&&&&&&& '注释： 位图句柄&&&& .hPal = hPal&&&&&&&&&&&&& '注释： 调色板句柄& End With
& '建立Picture图象& r = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)
& '返回Picture对象& Set CreateBitmapPicture = IPicEnd Function
'截图处理Public Function CaptureWindow(ByVal hWndSrc As Long, ByVal Client As Boolean, ByVal _&&& LeftSrc As Long, ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc _&&& As Long) As Picture
&&& Dim hDCMemory As Long&'保存截取图象的目标设备&&& Dim hBmp As Long&&& Dim hBmpPrev As Long&&& Dim r As Long&&& Dim hDCSrc As Long&'要截取图象的源设备&&& Dim hPal As Long&&& Dim hPalPrev As Long&&& Dim RasterCapsScrn As Long&&& Dim HasPaletteScrn As Long&&& Dim PaletteSizeScrn As Long&&& Dim LogPal As LOGPALETTE
'GetDC传回用于写入窗口显示区域的设备内容句柄,而GetWindowDC传回写入整个窗口的设备内容句柄'区别在于GetDC不包括边框、滚动条、标题栏、菜单等，而GetWindowDC则包括&If Client Then&'如果为真，即指定是客户区（不包括标题栏等）&&&&&&&& hDCSrc = GetDC(hWndSrc)&&'GetDC检索一指定窗口的客户区域或整个屏幕的显示设备上下文的句柄&&& Else&&&'否则用GetWindowDC寻找后获取&&&&&&& hDCSrc = GetWindowDC(hWndSrc)&&& End If
&&& hDCMemory = CreateCompatibleDC(hDCSrc)&'创建一块与hDCSrc设备场景一样的内存区&&& hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)&'创建一幅与设备有关位图&&& hBmpPrev = SelectObject(hDCMemory, hBmp)&'SelectObject将位图放入设备场景中
&&& '获得屏幕属性&&& RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS)&'根据指定设备场景代表的设备的功能返回信息&&& HasPaletteScrn = RasterCapsScrn And RC_PALETTE&&& PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE)
&&& '如果屏幕对象有调色板则获得屏幕调色板&&& If HasPaletteScrn And (PaletteSizeScrn = 256) Then&&&&&&& '建立屏幕调色板的拷贝&&&&&&& LogPal.palVersion = &H300&&&&&&& LogPal.palNumEntries = 256&&&&&&& r = GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry(0))&'获取系统调色板&&&&&&& hPal = CreatePalette(LogPal)&'CreatePalette调色板函数&&&&&&& '将新建立的调色板选入建立的内存绘图句柄中&&&&&&& hPalPrev = SelectPalette(hDCMemory, hPal, 0)&&&&&&& r = RealizePalette(hDCMemory)&'RealizePalette函数使系统恢复当前选中的逻辑调色板中的值&&& End If
&&& '拷贝图象&&& r = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, vbSrcCopy)&&&
&&& hBmp = SelectObject(hDCMemory, hBmpPrev)
&&& If HasPaletteScrn And (PaletteSizeScrn = 256) Then&&&&&&& hPal = SelectPalette(hDCMemory, hPalPrev, 0)&&& End If
&&& '释放资源&&& r = DeleteDC(hDCMemory)&&& r = ReleaseDC(hWndSrc, hDCSrc)
&&& Set CaptureWindow = CreateBitmapPicture(hBmp, hPal)End Function
'capturescreen函数捕捉整个屏幕图象Public Function CaptureScreen() As Picture&&& Dim hWndScreen As Long
'获得桌面的窗口句柄&&& hWndScreen = GetDesktopWindow()&&& Set CaptureScreen = CaptureWindow(hWndScreen, False, 0, 0, Screen.Width _&&&&&&& / Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY)End Function
'捕捉当前活动窗口图象Public Function CaptureActiveWindow() As Picture&&& Dim hWndActive As Long&&& Dim r As Long&&& Dim RectActive As RECT& &&& hWndActive = GetForegroundWindow()&&& r = GetWindowRect(hWndActive, RectActive)&&& Set CaptureActiveWindow = CaptureWindow(hWndActive, False, 0, 0, _&&&&&&& RectActive.Right - RectActive.Left, RectActive.Bottom - RectActive.Top)End Function
Public Sub PrintPictureToFitPage(Prn As Printer, Pic As Picture)&&& Const vbHiMetric As Integer = 8&&& Dim PicRatio As Double&&& Dim PrnWidth As Double&&& Dim PrnHeight As Double&&& Dim PrnRatio As Double&&& Dim PrnPicWidth As Double&&& Dim PrnPicHeight As Double& &&& If Pic.Height &= Pic.Width Then&&&&&&& Prn.Orientation = vbPRORPortrait&&& Else&&&&&&& Prn.Orientation = vbPRORLandscape&&& End If& &&& PicRatio = Pic.Width / Pic.Height& &&& PrnWidth = Prn.ScaleX(Prn.ScaleWidth, Prn.ScaleMode, vbHiMetric)&&& PrnHeight = Prn.ScaleY(Prn.ScaleHeight, Prn.ScaleMode, vbHiMetric)&&& PrnRatio = PrnWidth / PrnHeight& &&& If PicRatio &= PrnRatio Then&&&&&&& PrnPicWidth = Prn.ScaleX(PrnWidth, vbHiMetric, Prn.ScaleMode)&&&&&&& PrnPicHeight = Prn.ScaleY(PrnWidth / PicRatio, vbHiMetric, Prn.ScaleMode)&&& Else&&&&&&& PrnPicHeight = Prn.ScaleY(PrnHeight, vbHiMetric, Prn.ScaleMode)&&&&&&& PrnPicWidth = Prn.ScaleX(PrnHeight * PicRatio, vbHiMetric, Prn.ScaleMode)&&& End If& &&& Prn.PaintPicture Pic, 0, 0, PrnPicWidth, PrnPicHeightEnd Sub
'截图模块结束Module1.bas
'使用时&Dim tmpPicture As Picture'Public Const snapFolder = &c:/Snap&& '截图保存位置
&&& '捕捉活动窗口&&& Set tmpPicture = CaptureActiveWindow()&&& '捕捉整个屏幕&&& Set tmpPicture = CaptureScreen()
'保存时&SavePicture tmpPicture, &FileName完整路径名称&
本文已收录于以下专栏：
相关文章推荐
package com.boco.
import java.awt.AWTE
import java.awt.C
import java.awt...
本文属转载，版权属原作者！
using System.D
using System.Windows.F
namespace SrceenCapt...
上周一发表了，中国象棋程序的设计与实现(原始版)(包含源码) ，在一周的时间里，有22次下载，700次访问，还是挺让我欣喜的。
本周和下周，将陆续发表中国象棋程序的设计与实现(高级版)，包括 项目截...
他的最新文章
讲师：刘文志
讲师：陈伟
您举报文章：
举报原因：
原文地址：
原因补充：
(最多只允许输入30个字)君，已阅读到文档的结尾了呢~~
扫扫二维码，随身浏览文档
手机或平板扫扫即可继续访问
VB课程设计_登陆_管理员模块_说明书
举报该文档为侵权文档。
举报该文档含有违规或不良信息。
反馈该文档无法正常浏览。
举报该文档为重复文档。
推荐理由：
将文档分享至：
分享完整地址
文档地址：
粘贴到BBS或博客
flash地址：
支持嵌入FLASH地址的网站使用
html代码：
&embed src='/DocinViewer-4.swf' width='100%' height='600' type=application/x-shockwave-flash ALLOWFULLSCREEN='true' ALLOWSCRIPTACCESS='always'&&/embed&
450px*300px480px*400px650px*490px
支持嵌入HTML代码的网站使用
您的内容已经提交成功
您所提交的内容需要审核后才能发布，请您等待！
3秒自动关闭窗口}