実行時のVB.NETのフォーム画面を画像ファイルに落としたいのですがどうしたらよいのか解りません。又、現実に可能なのでしょうか?
教えていただけたらこれ幸いです。
よろしきお願いします。
SSを取ると言うこと?
SendKeysなどで{PRTSC}などを送ってやって、クリップボードの内容を保存…とかですかねぇ?
ガッ さん、言葉が少なくて済みません。
純粋に、画像ファイルに落とせたらいいのです。
SSを取らないと無理とか、SendKeysを使ってファイルを保存しないとだめなのでしょうか?
BitBltを使うと
Private Declare Auto Function BitBlt Lib "gdi32.dll" ( _
ByVal hdcDest As IntPtr, _
ByVal nXDest As Integer, _
ByVal nYDest As Integer, _
ByVal nWidth As Integer, _
ByVal nHeight As Integer, _
ByVal hdcSrc As IntPtr, _
ByVal nXSrc As Integer, _
ByVal nYSrc As Integer, _
ByVal dwRop As System.Int32 _
) As Boolean
Const SRCCOPY As Integer = &HCC0020
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim Gp As Graphics = Me.CreateGraphics ' フォームのGraphicオブジェクトの作成
Dim BitImg = New Bitmap(Me.Size.Width, Me.Size.Height, Gp) ' ビットマップ領域確保
Dim FomG As Graphics = Gp.FromImage(BitImg)
Dim Hdc1 As IntPtr = Gp.GetHdc()
Dim Hdc2 As IntPtr = FomG.GetHdc()
BitBlt(Hdc2, 0, 0, Me.ClientRectangle.Width, Me.ClientRectangle.Height, Hdc1, 0, 0, SRCCOPY)
Gp.ReleaseHdc(Hdc1)
FomG.ReleaseHdc(Hdc2)
BitImg.Save("c:\test.jpg", System.Drawing.Imaging.ImageFormat.Jpeg)
BitImg.Dispose()
End Sub
こんなことになるのかな。
ねろさんどうもありがとうございました。
早速試してみましたが、フォームのタスクバーが途切れてしまって旨く落とせていません。
色々、試してみましたが、タスクバーが途切れてしまいます。
どうしたら、フォームのタスクバーからフォーム全体を落とす事が出来ますか?
確かに。。。。
Dim h As Integer
h = Me.ClientSize.Height - Me.Height
BitBlt(Hdc2, 0, 0, Me.ClientRectangle.Width, Me.ClientRectangle.Height - h, Hdc1, 0, h, SRCCOPY)
こうするとかなり改善されるが、まだどこかで誤差が発生しているような。。。
研究の余地はありそうですね、正確な物が必要ですか?(^^;
献身的な努力の結果、私の環境では
Dim h As Integer
h = Me.ClientSize.Height - Me.Height
BitBlt(Hdc2, 0, 0, Me.ClientRectangle.Width + 10, Me.ClientRectangle.Height + 30, Hdc1, -4, h + 4, SRCCOPY)
とするとかなり近いものが取れました。ただしなぜこんなにべたべたと、オフセットをつけなくてはいけないか、
と言うことに関しては、これからの課題となりました。
ガッさん、ねろさんありがとうございました。
もう質問者も見ていないと思いますが、気になったので確認してみました。
誤差が出ていた件、極めて簡単なことでした。
先ずWidth方向ですが、(ClientSize.Width-Size.Width)/2で
左側のFormの淵からClientSizeの淵までの長さが出ます。(実際はマイナス値)
縦方向は、ClientSize.Heigh-Size.Heightでタスクバー+2倍の淵までの長さが出ます。
従ってその値から淵までの長さを引くとタスクバーと淵までの長さが出ます。
この2つの数値で縦横のオフセットをかけます。
最終的なコードは
一番初めのコードの
BitBlt(Hdc2, 0, 0, Me.ClientRectangle.Width, Me.ClientRectangle.Height, Hdc1, 0, 0, SRCCOPY)
を次のように書き換えます。
Dim h, w As Integer
w = (Me.ClientSize.Width - Me.Size.Width) / 2
h = Me.ClientSize.Height - Me.Height - w
BitBlt(Hdc2, 0, 0, Me.Size.Width, Me.Size.Height, Hdc1, w, h, SRCCOPY)
ツイート | ![]() |