VB.NETのフォーム画面をJpgファイルで保存するには?

解決


AtoZ  2005-04-05 13:13:32  No: 89231  IP: [192.*.*.*]

実行時のVB.NETのフォーム画面を画像ファイルに落としたいのですがどうしたらよいのか解りません。又、現実に可能なのでしょうか?
教えていただけたらこれ幸いです。
よろしきお願いします。

編集 削除
ガッ  2005-04-05 13:27:13  No: 89232  IP: [192.*.*.*]

SSを取ると言うこと?
SendKeysなどで{PRTSC}などを送ってやって、クリップボードの内容を保存…とかですかねぇ?

編集 削除
AtoZ  2005-04-05 13:42:35  No: 89233  IP: [192.*.*.*]

ガッ  さん、言葉が少なくて済みません。
純粋に、画像ファイルに落とせたらいいのです。
SSを取らないと無理とか、SendKeysを使ってファイルを保存しないとだめなのでしょうか?

編集 削除
ねろ  2005-04-05 14:09:57  No: 89234  IP: [192.*.*.*]

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
こんなことになるのかな。

編集 削除
AtoZ  2005-04-05 16:05:47  No: 89235  IP: [192.*.*.*]

ねろさんどうもありがとうございました。
早速試してみましたが、フォームのタスクバーが途切れてしまって旨く落とせていません。
色々、試してみましたが、タスクバーが途切れてしまいます。
どうしたら、フォームのタスクバーからフォーム全体を落とす事が出来ますか?

編集 削除
ねろ  2005-04-05 17:05:17  No: 89236  IP: [192.*.*.*]

確かに。。。。
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)
こうするとかなり改善されるが、まだどこかで誤差が発生しているような。。。
研究の余地はありそうですね、正確な物が必要ですか?(^^;

編集 削除
ねろ  2005-04-05 17:43:47  No: 89237  IP: [192.*.*.*]

献身的な努力の結果、私の環境では
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)
とするとかなり近いものが取れました。ただしなぜこんなにべたべたと、オフセットをつけなくてはいけないか、
と言うことに関しては、これからの課題となりました。

編集 削除
AtoZ  2005-04-05 17:52:04  No: 89238  IP: [192.*.*.*]

ガッさん、ねろさんありがとうございました。

編集 削除
ねろ  2005-04-06 14:11:04  No: 89239  IP: [192.*.*.*]

もう質問者も見ていないと思いますが、気になったので確認してみました。
誤差が出ていた件、極めて簡単なことでした。
先ず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)

編集 削除