自作プログラムにPhotoshopのような画像処理機能を組み込む

LEADTOOLS 14.0J Raster Imaging Proによる画像処理プログラムの作成 第1回

ファイルへの保存処理

　加工した画像をファイルに保存するのも簡単です。

　まず、コモンダイアログコントロールでファイル名を取得します。LEAD Mainコントロールは多彩な画像フォーマットを扱えますが、ここでは処理を簡単にするためにビットマップフォーマットで保存することにします。

　このプログラムではメニューを組み込み、［名前を付けて保存］メニューが選ばれると、新しいファイルに画像を保存するようにします。

　画像の保存は、LEAD MainコントロールのSaveメソッドを実行するだけです。書式は、次のとおりです。

Saveメソッド

LEAD.Save( pszName$, iFormat%, iBitsPerPixel%, iQuality%, iModify% )

引数	説明
pszName$	保存するファイル名。
iFormat%	保存するファイル形式を定数で指定。
iBitsPerPixel%	1ピクセルあたりのビット数。フルカラーで保存するなら24ビット、とビット数を指定。
iQuality%	Qファクタ（圧縮クオリティファクタ）を指定。圧縮処理における画質の劣化の度合を決定する数値で、2から255までの整数を指定する。
iModify%	上書き保存の場合は「SAVE_OVERWRITE」を、新規に保存するには「SAVE_INSERT」を指定する。

　ここでは、24ビットのビットマップで新しいファイルに保存することにします。

ret = Me.LEAD1.Save(savefname, FILE_BMP, 24, 2, SAVE_INSERT)

Private Sub IDMSave_Click()
    Dim savefname As String
    Dim ret As Integer
    With Me.CommonDialog1
        .Filter = "ビットマップ|*.bmp"
        .FileName = "image1.bmp"
        .ShowSave
        savefname = .FileName
    End With
    On Error Resume Next
    ret = Me.LEAD1.Save(savefname, FILE_BMP, 24, 2, SAVE_INSERT)
End Sub

今回作成したサンプルプログラム

「ImageEffect.frm」一部抜粋

Dim fname As String
Private Sub Command1_Click()
    CommonDialog1.ShowOpen
    fname = CommonDialog1.FileName
    On Error GoTo FAIL
    LEAD1.Load fname, 0, 0, 1
    '画像を読み込んでから各操作パネルを有効にする
    Frame1.Enabled = True
    Frame2.Enabled = True
    Frame3.Enabled = True
    Frame4.Enabled = True
    
    IDMSave.Enabled = True
FAIL:
End Sub

Private Sub Command2_Click()
    With LEAD1
        .AutoSetRects = True
        .PaintSizeMode = PAINTSIZEMODE_ZOOM
        .BackErase = False
        .PaintZoomFactor = .PaintZoomFactor + 10
    End With
End Sub

Private Sub Command3_Click()
    With LEAD1
        .AutoSetRects = True
        .BackErase = False
        .PaintSizeMode = PAINTSIZEMODE_ZOOM
        If .PaintZoomFactor > 10 Then
            .PaintZoomFactor = .PaintZoomFactor - 10
        End If
    End With
End Sub

Private Sub Command4_Click()
    LEAD1.Contrast (Me.HScroll1.Value)
End Sub

Private Sub Command5_Click()
    Me.LEAD1.Mosaic (Me.UpDown1.Value)
End Sub

Private Sub Command6_Click()
    If fname <> "" Then
        LEAD1.Load fname, 0, 0, 1
        LEAD1.PaintSizeMode = PAINTSIZEMODE_NORMAL
        Me.UpDown1.Value = 1
        Text1.Text = 0
        Me.Slider1.Value = 0
    End If
End Sub

Private Sub Form_Load()
    With LEAD1
        .Appearance = APPEARANCE_FLAT
        .BorderStyle = 1
        .BackColor = RGB(255, 255, 125)
        .PaintDither = PAINTDITHER_DIFFUSION
        .PaintPalette = PAINTPALETTE_AUTO
        .AutoRepaint = True
        .AutoSize = True
        .AutoSetRects = True
        .PaintSizeMode = PAINTSIZEMODE_FIT
    End With
End Sub

Private Sub HScroll1_Change()
    Text1.Text = HScroll1.Value
End Sub

Private Sub IDMSave_Click()
    Dim savefname As String
    Dim ret As Integer
    With Me.CommonDialog1
        .Filter = "ビットマップ|*.bmp"
        .FileName = "image1.bmp"
        .ShowSave
        savefname = .FileName
    End With
    On Error Resume Next
    ret = Me.LEAD1.Save(savefname, FILE_BMP, 24, 2, SAVE_INSERT)
End Sub

Private Sub Slider1_Click()
    Dim ret As Integer

    If Me.Option1.Value = True Then
        ret = Me.LEAD1.MotionBlur(Me.Slider1.Value, 0, False)
    Else
        ret = Me.LEAD1.MotionBlur(Me.Slider1.Value, 9000, False)
    End If
End Sub

Private Sub Text1_Change()
    If CInt(Text1.Text) <= 1000 Or CInt(Text1.Text) >= -1000 Then
        HScroll1.Value = Text1.Text
    Else
        MsgBox "1000から-1000までの値を入力してください"
    End If
End Sub

Private Sub UpDown1_Change()
    Me.Label1.Caption = Me.UpDown1.Value
End Sub

まとめ

　LEADTOOLS 14.0J Raster Imaging Proに格納されているコンポーネントの1つ、LEAD Mainコントロールを使った、簡単な画像処理プログラムを作成しました。いずれの画像処理も、メソッドを実行するだけの簡単なコードで実行できる点がとても魅力です。

　この機能は、LEAD Mainコントロールのごく一部の機能です。次回は、さらに進んだ画像処理機能を実装していきます。