画像の取り込みなんですが

解決済

質問者：tetudamon
質問日時：2001/12/14 19:06
回答数：3件

VB最近始めたばかりです。
起動してあるウインドウの全体をｊｐｇなどの画像として取込み、それを保存したいのですが、どうやればいいのかさっぱりわかりません。　
わかりずらい質問の仕方かもしれませんが、もしわかる方がいれば教えてください。お願いします

通報する

この質問への回答は締め切られました。

質問の本文を隠す

回答 (3件)

ベストアンサー優先
最新から表示
回答順に表示

No.2ベストアンサー

回答者： TAGOSAKU7
回答日時：2001/12/16 00:06

サンプルです。

クリップボードを使用する方法のサンプルが手元にあったので、それを載せておきます。
クリップボードを使用しない方法は手元にないのですが、todo36さんの載せているサンプルをちょっとだけ改造するときますよ。

※処理の流れ
１．クリップボードにコピー(関数：fucSnapShot)
２．クリップボードの内容を取得
３．保存

※必要な物
フォーム
コマンドボタン
ピクチャボックス

Private Type tagKEYBDINPUT
　　wVk　　　　　　　　 As Integer
　　wScan　　　　　　　 As Integer
　　dwFlags　　　　　　 As Long
　　time　　　　　　　　As Long
　　dwExtraInfo　　　　 As Long
　　bytUnusedPadding(7) As Byte
End Type
Private Type tagINPUT
　　type As Long
　　ki　 As tagKEYBDINPUT
End Type
Private Const INPUT_KEYBOARD = 1
Private Const VK_SNAPSHOT = &H2C
Private Const VK_LMENU = &HA4&
Private Const KEYEVENTF_KEYUP = &H2
Private Declare Function SendInput Lib "user32.dll" (ByVal nInputs As Long, pInputs As tagINPUT, ByVal cbSize As Long) As Long

Private Sub Command1_Click()
　　'画面をクリップボードにコピーさせる
　　Call fucSnapShot
　　
　　With Me
　　　　'クリップボードから画像を得る
　　　　.Picture1.Picture = Clipboard.GetData
　　　　
　　　　'画像を保存
　　　　Call SavePicture(.Picture1.Image, "c:\test.bmp")
　　End With
End Sub

Sub fucSnapShot()
　　Dim inpInfomation(3)　　As tagINPUT
　　
　　' キーストロークを作成
　　With inpInfomation(0)
　　　　.type = INPUT_KEYBOARD
　　　　.ki.wVk = VK_LMENU
　　End With
　　With inpInfomation(1)
　　　　.type = INPUT_KEYBOARD
　　　　.ki.wVk = VK_SNAPSHOT
　　End With
　　With inpInfomation(2)
　　　　.type = INPUT_KEYBOARD
　　　　.ki.wVk = VK_LMENU
　　　　.ki.dwFlags = KEYEVENTF_KEYUP
　　End With
　　With inpInfomation(3)
　　　　.type = INPUT_KEYBOARD
　　　　.ki.wVk = VK_SNAPSHOT
　　　　.ki.dwFlags = KEYEVENTF_KEYUP
　　End With
　　
　　' キーストロークを合成
　　Call SendInput(3, inpInfomation(0), Len(inpInfomation(0)))
　　
　　'Windowsに処理を渡す（クリップボードに画像がわたる）
　　DoEvents
End Sub

Private Sub Form_Load()
　　With Me
　　　　'フォームの書式設定
　　　　.ScaleMode = vbPixels
　　　　
　　　　'ダミーピクチャボックスの書式設定
　　　　With .Picture1
　　　　　　.Appearance = 0
　　　　　　.AutoRedraw = True
　　　　　　.AutoSize = True
　　　　　　.BorderStyle = 0
　　　　　　.Visible = False
　　　　End With
　　　　
　　　　'コマンドボタン
　　　　.Command1.Caption = "実行"
　　End With
End Sub