精华区 [关闭][返回]

当前位置:网易精华区>>讨论区精华>>编程开发>>● VB和Basic>>〓〓..图形图像处理..〓〓>>为您精心设计的画面拍张快照吧(z)

主题:为您精心设计的画面拍张快照吧(z)
发信人: 1landonsea(一路萤火虫)
整理人: gzwsh(2002-11-05 22:57:29), 站内信件
169、为您精心设计的画面拍张快照吧!( Taking a screenshot )

我们在设计系统时,有时候会保留让使用者做屏幕 HardCopy 的功能。

以前,我总是要求使用者自己去按键盘上的【Print Screen】按钮,将画面的影像留在【剪贴板】中,并要求使用者自己到 Windows95/98 提供的【小画家】或【小作家】中,先做【贴上】的动作后,再将画面影像存成 .BMP 档或直接由印表机中印出。

上面这些动作,对一个程序开发者,或一个熟练的操作者并不困难,但是,很可悲的,大部份的使用者都不属于以上所描述的二种人,例如:我曾经写过一个系统是给大楼清洁维护公司的人员用的,其中有很多使用者甚至是一些学历不高的『欧巴尚』,不但程序的设计都要简化操作,连系统上线都是高难度的,更别说屏幕的 HardCopy 列印、存档的动作了!

不过,以上的动作,我们都可以直接在 VB 的程序中做到,要做到这个功能有二个方法:
方法一:直接模拟按【Print Screen】按钮,再将【剪贴板】中的图像抓到 Picture 中。
方法二:完全使用 API 来处理。

下面来看看第二种做法:

'请在声明区中加入以下声明:

Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
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

'在 Form 中加入二个 CommandButton,及一个 PictureBox,不必更改属性,加入以下程序码:

Private Sub Form_Load()
'将 Picture1 之长宽设定成和屏幕一样大小
Picture1.Width = Screen.Width
Picture1.Height = Screen.Height
End Sub

Private Sub Command1_Click()
'将屏幕画面抓下后放到 Picture1 中
Dim lngDesktopHwnd As Long
Dim lngDesktopDC As Long

Picture1.AutoRedraw = True
Picture1.ScaleMode = vbPixels
lngDesktopHwnd = GetDesktopWindow
lngDesktopDC = GetDC(lngDesktopHwnd)

Call BitBlt(Picture1.hdc, 0, 0, Screen.Width, Screen.Height, lngDesktopDC, 0, 0, SRCCOPY)
Picture1.Picture = Picture1.Image
Call ReleaseDC(lngDesktopHwnd, lngDesktopDC)
End Sub

Private Sub Command2_Click()
'将 Picture1 中的屏幕画面存成 .BMP 档
SavePicture Picture1, "C:\TEST.BMP"
End Sub

在以上的范例中,只要按下 Command1 就会将屏幕的画面截取下来放到 Picture1 中,按下 Command2 之后,就会将 Picture1 中的图片存成文件 ( 文件名称可自行更改 ),如果您想打印,也可以直接使用 PaintPicture 将图片丢到打印机中打出!

至于图片的打印,以后会另有单元介绍。 
170、随心所欲地移除表单左上方的系统功能表的某几个项目

针对这个主题,其实以前已经讨论过二次了,只不过不是以这样直接了当的方式点出在题目中而已,不知道大家是否有印象?

这二次分别是:

问题:如何移除 Form 右上方之『X』按钮?

对应到系统功能表的【关闭】选项

问题:如何防止 Form 被移动?

对应到系统功能表的【移动】选项

而我在网路上闲逛时,看到有个外国人用了一个很笨的方法写了一个模组,不过对于不想研究 API 的人来说应该是很好用的模组,可以让您用选择的方式随便您想移除系统功能表的任一个项目!

完整程序码如下,说明加在其中:

'在声明区中加入以下声明:

'抓取系统 Menu 的 hwnd
Private Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Integer, ByVal bRevert As Integer) As Integer

'移除系统 Menu 的 API
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer
'第一个参数是系统 Menu 的 hwnd
'第二个参数是要移除选项的 Index

Private Const MF_BYPOSITION = &H400&

'模组内容如下:

Private Sub RemoveMenus(frm As Form, remove_restore As Boolean, remove_move As Boolean, remove_size As Boolean, remove_minimize As Boolean, remove_maximize As Boolean, remove_seperator As Boolean, remove_close As Boolean)

Dim hMenu As Long

' 抓取系统 Menu 的 hwnd
hMenu = GetSystemMenu(hWnd, False)

If remove_close Then RemoveMenu hMenu, 6, MF_BYPOSITION '是否移除【关闭】选项
If remove_seperator Then RemoveMenu hMenu, 5, MF_BYPOSITION '是否移除【分隔线】
If remove_maximize Then RemoveMenu hMenu, 4, MF_BYPOSITION '是否移除【放到最大】选项
If remove_minimize Then RemoveMenu hMenu, 3, MF_BYPOSITION '是否移除【缩到最小】选项
If remove_size Then RemoveMenu hMenu, 2, MF_BYPOSITION '是否移除【大小】选项
If remove_move Then RemoveMenu hMenu, 1, MF_BYPOSITION '是否移除【移动】选项
If remove_restore Then RemoveMenu hMenu, 0, MF_BYPOSITION '是否移除【还原】选项
End Sub

这个模组共有八个参数,第二个到第八个参数分别对应到系统功能表的七个选项! ( True / False )

今天如果我想做到和问题如何移除 Form 右上方之『X』按钮?一样的结果,表示我要将对应到系统功能表的【关闭】选项移除,则我只要将相对应的参数设成 True 即可,其他要保留的则为 False。

范例如下:

Private Sub Form_Load()
  RemoveMenus Me, False, False, False, False, False, True, True
End Sub

[关闭][返回]