画像を切り取って保存するには？
解決初めて書き込みします。
PictureBoxの画像の必要な部分を切り取って、.jpgに保存しようとしているのですが、どうしても全体が保存されてしまいます。どのようにすればよろしいでしょうか。言葉足らずで申し訳ありませんが、お願いします。
Option Explicit
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Type BITMAP 'BITMAP構造体
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Dim Img() As Byte
'JPEG保存用
Private Declare Function DCSavetoJPEG Lib "SaveJPG.DLL" _
(ByVal srchDC As Long, ByVal srcWidth As Long, ByVal srcHeight As Long, ByVal jpgf As String, ByVal Value As Byte, ByVal Prgr As Boolean) As Integer
'指定の領域をウインドウ領域として設定する(P335)
Private Declare Function SetWindowRgn Lib "user32" _
(ByVal hWnd As Long, ByVal hRgn As Long, _
ByVal bRedraw As Boolean) As Long
'四角形の領域を作成する(P321)
'X1=左上隅のX座標 Y1=同Y座標 X2=右下隅のX座標 Y2=同Y座標
Private Declare Function CreateRectRgn Lib "gdi32" _
(ByVal X1 As Long, ByVal Y1 As Long, _
ByVal X2 As Long, ByVal Y2 As Long) As Long
'グラフィックスオブジェクトを削除しシステムリソースを開放する(P261)
Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long
Private Sub Form_Load()
Dim RectSet As Long
Dim Result As Long
With Picture1
.AutoSize = True
.AutoRedraw = True
.ScaleMode = vbPixels
End With
' 四角い領域を作る（）内の数値を変えると四角形の大きさが変わります
RectSet = CreateRectRgn(127, 18, 769, 498)
Result = SetWindowRgn(Picture1.hWnd, RectSet, True)
'オブジェクトを削除しシステムリソースを開放する
Result = DeleteObject(RectSet)
End Sub
Private Sub FileSave_Click()
Dim FileName As String
Dim modori As Integer
CommonDialog1.Filter = "画像(*.jpg)|*.jpg"
CommonDialog1.FilterIndex = 1
CommonDialog1.Flags = cdlOFNOverwritePrompt
CommonDialog1.ShowSave
FileName = CommonDialog1.FileName
modori = DCSavetoJPEG(Picture1.hdc, Picture1.ScaleWidth, Picture1.ScaleHeight, FileName, 100, False)
End Sub
１：保存用に新たなPictureBoxを用意
２：サイズを切り抜いた後の大きさに変更する
３：元絵のPictureBoxからPaintPictureなりBitbltなりで保存用のPictureBoxにコピー
４：保存用PictureBoxを保存
でどうです？
通ってみたさん、ご意見ありがとうございます。
でも、うまくいきません。
RectSet = CreateRectRgn(127, 18, 769, 498)
Result = SetWindowRgn(Picture1.hWnd, RectSet, True)
'オブジェクトを削除しシステムリソースを開放する
Result = DeleteObject(RectSet)
で生成したものが、Picture型で無いようです。
頭が悪くてすみません。簡単教えて頂けないでしょうか？
SetWindowRgnのHelpをご覧になりましたか？
>指定されたウィンドウのウィンドウリージョンを設定します。
>ウィンドウリージョンは、ウィンドウのうち、システムが描画を行える領域を決定します。
>システムは、ウィンドウのうち、ウィンドウリージョンの外側にある部分を表示しません。
となっていますよ、画像を切り取ったのではなく、描画領域をを制限しているだけでは。
つまりPicture1の画像はそっくり残っているということで。
考え方が間違えていました。
どのようにしたら、必要な部分だけを切り取って保存することができますでしょうか？
通ってみたさんがレスをつけてます。↑
PaintPictureで上と左部分は切り取ることができるのですが、下と右部分を切り取ることができません。どうすればいいでしょうか？
何のこっちゃ・・・
>>上と左部分は切り取ることができる
のなら、同じように
>>下と右部分
も切り取ればいいのでは？
本当に
>>上と左部分は切り取ることができる
ができているのか謎ですが
私の知識不足のため、この板は合わないようです。
もっと、勉強してから戻ってきます。
まああまり短気にならず、こんなの色々やってみて。(^^
PicWidth = 200
PicHeight = 300
PicStartX = 100
PicStartY = 50
Picture1.Picture = LoadPicture(App.Path + "\" + "test1.jpg")
Picture2.Width = PicWidth * Screen.TwipsPerPixelX
Picture2.Height = PicHeight * Screen.TwipsPerPixelY
Picture2.PaintPicture Picture1.Picture, 0, 0, PicWidth, PicHeight, _
PicStartX, PicStartY, PicWidth, PicHeight
DCSavetoJPEG Picture2.hDC, Picture2.ScaleWidth, Picture2.ScaleHeight, _
App.Path + "\" + "test2.jpg", 100, False
うまくいきました。
我龍院忠太さん、本当にありがとうございました。
| ツイート |  |