Private Declare Function icePub_copyForegroundFormToClipboard Lib "icePubDll.dll" () As Integer
創(chuàng)新互聯(lián)是一家集網站建設,泗水企業(yè)網站建設,泗水品牌網站建設,網站定制,泗水網站建設報價,網絡營銷,網絡優(yōu)化,泗水網站推廣為一體的創(chuàng)新建站企業(yè)，幫助傳統(tǒng)企業(yè)提升企業(yè)形象加強企業(yè)競爭力?？沙浞譂M足這一群體相比中小企業(yè)更為豐富、高端、多元的互聯(lián)網需求。同時我們時刻保持專業(yè)、時尚、前沿，時刻以成就客戶成長自我，堅持不斷學習、思考、沉淀、凈化自己，讓我們?yōu)楦嗟钠髽I(yè)打造出實用型網站。
Dim a2 As Integer
a2 = icePub_copyForegroundFormToClipboard()
Private Declare Function icePub_saveClipboardToBmpFile Lib "icePubDll.dll" (ByVal strBmpFilename As String) As Integer
Dim a2 As Integer
a2 = icePub_saveClipboardToBmpFile("d:\c.bmp")
Private Declare Function icePub_saveScreen Lib "icePubDll.dll" (ByVal bmpFile As String) As Integer
Dim str1 As String
Dim a2 As Integer
str1 = App.Path + "\1.bmp"
a2 = icePub_saveScreen(str1)
VB.NT用的是觸發(fā)事件，一按就會觸發(fā)，要不你加個timer控件，延遲一秒
標題的問題：你先把圖片保存，再加載
按快捷鍵后，先把整個屏幕截下來，然后顯示在form1上，form1是一個沒有邊框的窗體，之后最大化顯示form1，開始鼠標拖坐標，截取坐標內的圖片，保存，
補充：
4年前用vb寫的：
Option Explicit
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const theScreen = 0
Const theForm = 1
Private Sub Form_Load()
XPForm1.Make
Load Form2
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unload Form2
Unload Me
End Sub
Private Sub HScroll1_Change()
If Picture1.Width Picture2.Width Then
Picture1.Left = -((Picture1.Width - Picture2.Width) / 100) * HScroll1.Value
End If
End Sub
Private Sub MGButton1_Click()
If Option1.Value = True Then
If Check1.Value = 1 Then
Me.Hide
End If
Call Delay
Call keybd_event(vbKeySnapshot, theScreen, 0, 0)
Call Delay
Form2.Picture = Clipboard.GetData(vbCFBitmap)
Form2.Shape1.Height = 0
Form2.Shape1.Width = 0
Form2.Picture2.Visible = False
Form2.Picture3.Visible = False
Form2.Picture4.Visible = False
Form2.Show 1, Me
ElseIf Option2.Value = True Then
If Check1.Value = 1 Then
Me.Hide
End If
Call Delay
Call keybd_event(vbKeySnapshot, theScreen, 0, 0)
Call Delay
Picture1.Cls
Picture1.Picture = Clipboard.GetData(vbCFBitmap)
Me.Show
ElseIf Option3.Value = True Then
If Check1.Value = 1 Then
Me.Hide
End If
Call Delay
Call keybd_event(vbKeySnapshot, theForm, 0, 0)
Call Delay
Picture1.Cls
Picture1.Picture = Clipboard.GetData(vbCFBitmap)
Me.Show
Else
End If
End Sub
Private Sub Delay()
Dim i As Integer
For i = 0 To 1000
DoEvents
Next i
End Sub
Private Sub MGButton2_Click()
Picture1.Cls
Picture1.Picture = LoadPicture
End Sub
Private Sub MGButton3_Click()
CommonDialog1.DialogTitle = "保存"
CommonDialog1.FileName = ""
CommonDialog1.Filter = "位圖文件(*.BMP)|*.bmp|所有文件(*.*)|*.*"
CommonDialog1.FilterIndex = 0
CommonDialog1.ShowSave
If CommonDialog1.FileName "" Then
SavePicture Picture1.Image, CommonDialog1.FileName
End If
End Sub
Private Sub MGButton4_Click()
Clipboard.SetData Picture1.Image, vbCFBitmap
End Sub
Private Sub VScroll1_Change()
If Picture1.Height Picture2.Height Then
Picture1.Top = -((Picture1.Height - Picture2.Height) / 100) * VScroll1.Value
End If
End Sub
下面的代碼是我很欣賞的編程牛人CBM666的，你看下就應該能明白意思了，需要的haunted自己修改一下，我運行過了可以運行成功，不會截到其它窗體只是打印當前窗體
友情提示：你點下打印鍵的時候沒有提示會直接打印出窗口內容來，沒有確定取消的按鈕的，當初我在公司試的時候隨便貼了個很爛的圖就給打出來了，還被人笑了。。。
'添加 Picture1 Picture2 各別放一張圖片 窗體也可加圖片, 只是測試用罷了.
,Text1 隨便打一些內容,(只是測試用)
'再隨便加一個Picture3 用來保存圖片
'Command1 抓圖存圖 Command2 打印
'本代碼是將窗體內所有的控件與窗體一起保存到Picture3再打印出來.
Option Explicit
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const theScreen = 0 '整個Screen
Const theForm = 1 '當前活動界面
Private Sub Form_Load()
Command1.Caption = "抓取窗體"
Command2.Caption = "打 印"
Picture3.Move Screen.Width
Picture3.AutoRedraw = True
Picture3.BorderStyle = 0
Me.AutoRedraw = False
Clipboard.Clear
End Sub
Private Sub Command1_Click()
Me.Refresh
Picture3.Picture = LoadPicture()
Picture3.Width = Me.Width
Picture3.Height = Me.Height
Call keybd_event(vbKeySnapshot, 1, 0, 0)
DoEvents
Picture3.Picture = Clipboard.GetData(vbCFBitmap)
Set Picture3.Picture = Picture3.Image '此時才真正顯示Picture
'SavePicture Picture3.Image, "c:\kkkw.bmp"
End Sub
Private Sub Command2_Click()
Printer.PaintPicture Picture3.Picture, 0, 0, Picture3.Width, Picture3.Height
Printer.EndDoc
End Sub
有空你搜索下CBM666的代碼，絕對能給你很大收獲
'模塊中
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) _
As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
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
'form1中
Private Sub Command1_Click()
Dim hDCtmp As Long, picWidth As Double, picHeight As Double
Dim x As Double
Dim y As Double
x = Val(Text2.Text)
y = Val(Text3.Text)
picWidth = Val(Text3.Text)
picHeight = Val(Text4.Text)
hDCtmp = GetDC(0)
BitBlt Picture1.hdc, 0, 0, picWidth, picHeight, hDCtmp, x, y, vbSrcCopy
ReleaseDC 0, hDCtmp
End Sub
目的: 將屏幕按照指定坐標和大小進行截取成圖,在picture1顯示
問題: 大小是相同了,為什么截取的坐標不對,只是屏幕上的左上
相信大家都用過QQ截圖功能。不過很多人并沒有真正掌握好它的用法。將QQ截圖與其它截屏和制圖軟件配合使用，會有意想不到的效果。
獲取顏色的RGB值
我們在編輯圖片或網頁的時候，經常需要獲取某種顏色的“RGB值”，所以很多人都安裝了第三方的顏色吸取工具。其時用QQ截圖鍵即可獲取屏幕上任意顏色的RGB值。
當按下“Ctrl+Shift+A”彈出“截圖”提示框時，提示框中的“當前像素RGB”即為當前鼠標屏幕位置的顏色RGB值，將鼠標移動到你想查看的屏幕顏色上即可獲得相應的RGB值（如圖1）。
圖1精確截取圖片大小
有時我們對要使用的截圖尺寸有嚴格要求，比如論壇簽名或QQ頭像等。用QQ截圖鍵可以按尺寸精確截取，一步到位無需再進行后期裁剪了。
按下QQ截圖鍵，按住鼠標不放選取截取范圍時，在鼠標上方會有一個信息框顯示當前范圍的詳細信息，其中“矩形大小”就是以像素來表示的圖片的尺寸大小，括號內的數(shù)字分別表示的是長和高（如圖2）。松開鼠標調整截圖框時，對照“矩形大小”就可以按需要的尺寸來精確截圖范圍，然后用鼠標點住截圖框將截圖框拖到要截取的圖片上，雙擊即可獲得所需尺寸的圖片了。
圖2圖片拼貼好幫手
大部分的截圖軟件一次只能截取一張圖片，當要截取多張圖片并進行拼貼組合時，就需要一張一張截取全部保存后再進行拼貼操作，非常麻煩。
我們知道用QQ截圖鍵截取的圖片可以在任一個可以粘貼圖片的程序中使用，這樣只需用截圖軟件進行一次截圖操作，剩下的圖片用QQ截圖鍵來截取，然后依次粘貼到截圖軟件的窗口中即可快速進行拼貼操作了，是不是很方便啊。
小提示：QQ截圖鍵無需打開聊天窗口即可使用，截取的圖片在任一可粘貼圖片的程序窗口中如畫圖、Word等，使用“粘貼”命令即可使用
1. 啟動新 VisualBasic 常用 Exe 項目。 默認情況下創(chuàng)建 Form 1。
2. 在 項目 菜單上, 選擇將一個新模塊添加到現(xiàn)有項目 添加模塊 。
3. 向窗體, 名稱之一添加兩 圖片框 Pic_Edit （目標）, 和其他名稱 Pic_Dest （目標）。
4. 將是 Pic_Edit Picture 屬性設置為要從中選擇區(qū)域位圖
5. 將是 Pic_Dest AutoRedraw 屬性設置為 True
6. 以下代碼添加到 Module 1：Public Const INVERSE = 6
Public Const DOT = 2
Public Const SOLID = 0
Public OrigX As Long
Public OrigY As Long
Public DestX As Long
Public DestY As Long
Public Sub Draw_Selection_Rectangle()
' Set drawing mode to INVERSE since this routine also used to erase
' the selection rectangle by simply drawing over the currently
' displayed rectangle
With Editor.Pic_Edit
.DrawMode = INVERSE
.DrawStyle = DOT
Editor.Pic_Edit.Line (OrigX, OrigY)-(DestX, DestY), , B
.DrawStyle = SOLID
End With
End Sub
Public Sub Copy_Rectangle()
With Editor.Pic_Dest
.Cls
.Visible = True
.Height = DestY - OrigY
.Width = DestX - OrigX
.PaintPicture Editor.Pic_Edit, 0, 0, (DestX - OrigX), _
(DestY - OrigY), OrigX, OrigY, (DestX - OrigX), _
(DestY - OrigY), vbSrcCopy
End With
' Make sure the clipboard is clear, then copy the image:
Clipboard.Clear
Clipboard.SetData Editor.Pic_Dest.Image
End Sub
7. 以下代碼添加到 Form 1：Private Sub Pic_Edit_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then Pic_Edit.Refresh
Pic_Dest.Visible = False
OrigX = X
OrigY = Y
DestX = OrigX
DestY = OrigY
Call Module1.Draw_Selection_Rectangle
End Sub
Private Sub Pic_Edit_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
DestX = X
DestY = Y
Pic_Edit.Refresh
Call Module1.Draw_Selection_Rectangle
End If
End Sub
Private Sub Pic_Edit_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
' Check to see if mouse moved or goes the "wrong" way:
If DestX = OrigX Or DestY = OrigY Then
Pic_Edit.Refresh
Exit Sub
End If
If Button = 1 Then Call Copy_Rectangle
End Sub
8. 啟動應用程序并選擇用鼠標與位圖的區(qū)域。 當您松開鼠標按鈕, Pic_Dest 出現(xiàn) 備注 所選區(qū)域： 如果備份 MS 畫圖、 MSWord 或任何其他應用程序可能需要粘貼位圖, 打開您就可以粘貼到該應用程序圖像的選定部分。 也可以通過剪貼板查看程序查看剪貼板的內容。
重慶分公司
重慶分公司
