画像を切り取って保存するには？ (ID:92251)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

初めて書き込みします。
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

←解決時は質問者本人がここをチェックしてください。

戻る