～　Henry Le Chatelier　～

画像一覧の画像を作成するソフトで出力するサムネイル間に、空白を設ける機能を追加しました。

この度、

画像一覧の画像を作成するソフトを、
http://oyk3865b.blog13.fc2.com/blog-entry-1040.html
で、出力するサムネイル間に

空白を設ける機能を追加したので、
記事にて紹介させていただきます。

これまでは、
空白を設置出来ず、詰まった感じの表現のみでしたが。

13時43分39秒listB8572016年6月6日Desktop2016_05_01_静岡_カメラ1[000]

今回追加した、空白機能を使用した場合は。

13時43分32秒list9F6F2016年6月6日Desktop2016_05_01_静岡_カメラ1[000]

↑
こんな感じの出力にすることが可能となりました。

尚、
空白の部分は、サムネイルの幅の拡張としてカウントされるので

出力する画像サイズが一定のままだと、
並びが変化するので気を付けてください。

そして。

いつもながら、今回追加しました機能と、

以前に追加した、
・タイトル機能
・背景透過／塗りつぶし設定

今後追加する予定の
・備考欄機能
・縦書き方向への描画機能

もを含む

Visual Basic 2015での
無駄に長くて、解読が面倒な長大コードを、

以下に、併せて紹介させていただきます。

以下のコードは、
直接、「新規Windowsフォームアプリケーション」でのFormに、
そのまま、貼り付けると、

あとは、表示される画面に今回のコードを
コピー＆貼り付けをすれば
動作が始まるようにしてあります。

しかし、
あくまで、公開用に必要部分だけに留め
端折ったコードです。

わやくちゃで、
もっと良いコーディングがあると思いますので、
適時書き換えて。
遂次、ご自身で、修正いただけると幸いです。

また、動作には、
.NET Framework 4.5がインストールされている環境が必要になりますので
あしからずご理解頂けると幸いでございます。

Public Class Form1
    '▼▼▼各種設定箇所。必要に応じて適当に変更してください。▼▼▼

'デスクトップのパスを格納
    Private ReadOnly desktop_path As String = System.Environment.GetFolderPath(Environment.SpecialFolder.DesktopDirectory)

'サムネの設定関係
    Private thumbnail_width As Integer = 532 '448 'サムネイル画像の幅
    Private thumbnail_height As Integer = 352 '336 'サムネイル画像の高さ
    Private thumbnail_border As Integer = 5 'サムネイル画像を囲む線の幅
    Private thumbnail_toka_Flg As Byte = If(MessageBox.Show("下地を透過させないかどうか(yes=透過しない/no=透過する）", "", MessageBoxButtons.YesNo) = DialogResult.Yes, 0, 1)
    Private thumbnail_border_color As Color = Color.Navy 'サムネイル画像を囲む線の色
    Private thumbnail_Info_color As Color = Color.Orange    'サムネイル画像に付する文字の色
    Private thumbnail_Info_font As Font = New Font("ＭＳ ゴシック", 25) 'サムネイル画像に付する文字のフォントs
    Private thumbnail_Blank_Space As Integer = 25 'サムネ画像の間の間隙の量

'出力設定関係
    Private Output_width As Integer = 760 * 2 + thumbnail_Blank_Space '1000  '出力画像の幅
    Private Output_height As Integer = 2970 \ 2 + 300 '出力画像の高さ
    Private SaveFileCName As String = "list_img" '保存先のファイル接頭語を格納
    Private Output_Background_Color As Color = Color.LightSkyBlue    '背景色

'タイトル関係
    Private Title_Draw_Flg As Byte = If(MessageBox.Show("タイトルを表示しないかどうか。(yes=しない/no=する）", "", MessageBoxButtons.YesNo) = DialogResult.Yes, 0, 1)
    Private Title_Draw_Text As String = "タイトルTest" 'タイトルの文字列
    Private Title_Draw_Page As Byte = 2 'ページ番号をつけるかどうか。(0=付けない/1=ページ数のみ/2=総ページ数も付記）
    Private Title_Draw_Font As Font = New Font("ＭＳ ゴシック", 36) '文字のフォント
    Private Title_Draw_Color As Color = Color.DarkSlateGray  '文字の色

'備考欄関係
    Private BikouRan_Flg As Byte = If(MessageBox.Show("備考欄を付けないかどうか(yes=つけない/no=つける)", "", MessageBoxButtons.YesNo) = DialogResult.Yes, 0, 1)
    Private BikouRan_width As Short = 228 '備考欄の幅
    Private BikouRan_Rows As Short = 11 '備考欄の行数
    Private BikouRan_Bold As Short = 3 '備考欄の行線の太さ

'縦書き方向に並べるかどうか
    Private Tategaki_Rotate_Flg As Byte = If(MessageBox.Show("横書きかどうか(yes=横書き/no=縦書き)", "", MessageBoxButtons.YesNo) = DialogResult.Yes, 0, 1)

'改行文字の指定
    Private vbCrLf_str As String = Environment.NewLine

Private Function File_List_Check_and_Start(ByVal AddFileName() As String) As Boolean
        '▼▼▼渡されたファイルリストから画像ファイルだけ選別して、開始する。▼▼▼

'空の配列の場合→出る
        If AddFileName.Length <= 0 Then Return False

'■■■以下、本処理■■■■■■■■■■■■■■■■

'有効な画像ファイルパスを抽出して、格納する変数
        Dim ImageFile_str() As String = Nothing

'配列の指定要素のみを入れるリスト
        Dim ImageFile_list As New ArrayList
        ImageFile_list.Clear() 'リストの初期化

'各ファイルを、チェックして、有効なファイルだけリストに、追加していく
        For Each ghd As String In AddFileName
            '今回調べる要素を取得
            If IO.File.Exists(ghd) Then
                'ファイルの存在が確認出来た場合

'★予防措置。
                If ghd.ToLower.IndexOf(IO.Path.Combine(desktop_path, SaveFileCName).ToLower) >= 0 Then '小文字に統一して比較
                    '自分の出力予定の画像パスと、類似パスの場合は、リストに加えない
                    GoTo Next_i_Line '入れ子になるなどのバグ予防
                End If

'★ファイルの拡張子を調査する。
                Dim fff As String = System.IO.Path.GetExtension(ghd).ToLower '小文字で統一

Select Case fff
                    Case ".jpg", ".jpeg", ".bmp", ".gif", ".png"
                        '扱える画像ファイルの拡張子だけ追加する。
                        ImageFile_list.Add(ghd)

Case Else
                        '他のファイルや、フォルダが混じっている場合
                        GoTo Next_i_Line 'そのファイル／フォルダは受け付けない
                End Select
            End If

Next_i_Line:
        Next

'リストのアイテム数が、１個以上の場合
        If ImageFile_list.Count > 0 Then

'リスト項目を文字配列に変換する
            'http://homepage1.nifty.com/rucio/main/dotnet/Samples/Sample113ListBoxToArray.htm
            ImageFile_str = ArrayList.Adapter(ImageFile_list).ToArray(GetType(String))

'初期化
            ImageFile_list.Clear() : ImageFile_list = Nothing

'画像の変換を開始する。
            Call Output_Image_Making(ImageFile_str)

Return True '成功を返す

Else '有効ファイルが無い場合

'初期化
            ImageFile_list.Clear() : ImageFile_list = Nothing
            Return False '出る
        End If

End Function

Private Sub Output_Image_Making(ByVal All_FileName() As String)
        '出力画像を組み立てるところ

Try

'処理する全候補ファイル数を格納
            Dim AllFileCount As Integer = 0
            '通常の画像ファイル処理の場合
            AllFileCount = All_FileName.Length

'タイトルを描画するとして+++++++ここから+++++++++++++++++++++++++++++++
            Dim Title_Height As Integer = 0 'まず高さだけ取得しておく
            If Title_Draw_Flg = 1 Then 'タイトルを加える場合
                '下地のImageオブジェクトのGraphicsオブジェクトを作成する
                Using g As Graphics = Graphics.FromImage(New Bitmap(200, 200))
                    Title_Height = g.MeasureString(Title_Draw_Text, Title_Draw_Font).Height
                    g.Dispose()
                End Using
            End If
            'タイトルを描画するとして+++++++ここまで+++++++++++++++++++++++++++++++

'作成したサムネイル数のカウント
            Dim Make_thumbnail_Count As Integer = 0

'出力する画像のサイズを設定
            Dim true_Blank_Space As Integer = thumbnail_Blank_Space '実際の空白を算出
            Dim plus_blank_thumbnail_width As Integer = （thumbnail_width + true_Blank_Space) '空白分を加えた幅

'備考欄を追加する場合
            If BikouRan_Flg <> 0 Then
                'さらに右側に備考欄を加える
                plus_blank_thumbnail_width += BikouRan_width
            End If

Dim plus_blank_thumbnail_height As Integer = （thumbnail_height + true_Blank_Space) '空白分を加えた高さ
            Dim output_image_width As Integer = 0 '幅を指定
            Dim output_image_height As Integer = 0 '高さの指定
            Dim width_count As Integer = ((Output_width + true_Blank_Space) \ plus_blank_thumbnail_width) '最大、横に置ける画像数
            Dim height_count As Integer = ((Output_height - Title_Height + true_Blank_Space) \ plus_blank_thumbnail_height) '最大、縦に置ける画像数
            Dim page_img_count As Integer = width_count * height_count '１ページに置ける画像の数

If Tategaki_Rotate_Flg = 1 Then
                '縦書きにする場合→縦横の値を反転させる。
                '(270°回転して横書きで描画して、再び90°回転して縦書きに戻す方法をとっている。)
                Dim k As Integer = width_count
                width_count = height_count
                height_count = k

k = plus_blank_thumbnail_width
                plus_blank_thumbnail_width = plus_blank_thumbnail_height
                plus_blank_thumbnail_height = k
            End If

'★★安全装置★★⇒1ページに置かれる画像の数が、0以下の場合
            If page_img_count <= 0 Then '→つまり、サムネ画像のサイズが、出力画像のサイズを上回っている場合
                MessageBox.Show("サムネ画像の設定サイズが、" & vbCrLf_str & "出力画像の設定サイズを上回っている可能性があります。" &
                                vbCrLf_str & vbCrLf_str & "出力設定を、もう一度確認してください。", "設定エラーです。",
                                MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
                Exit Sub
            End If

'ページ関係
            Dim page_count As Integer = 0 'ページ数のカウント(処理で走った、ページ数)
            Dim true_page_count As Integer = 0 '実際に作成した、有効なページ数のカウント(空白のエラーページは、除外した数)
            Dim max_page_count As Integer = (AllFileCount - 1) \ page_img_count + 1 '最大ページ数の取得
            Dim last_page_filepath As String = "" '最後に出力したページ画像ファイルのパスを格納

'開始の確認をする場合
            '★★★開始の確認★★★
            If MessageBox.Show("画像一覧を作成する処理を、開始しますか？" & vbCrLf_str & vbCrLf_str _
                          & "■処理画像数：" & AllFileCount.ToString & vbCrLf_str _
                          & "■サムネイルの並び：(横)" & width_count.ToString & "個ｘ (縦)" & height_count.ToString & "個" & vbCrLf_str _
                          & "■作成予定のページ数：" & max_page_count.ToString & vbCrLf_str _
                          & "■接頭語：" & SaveFileCName,
                          "開始の確認", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1, MessageBoxOptions.DefaultDesktopOnly) = DialogResult.No Then 'MsgBoxStyle.YesNo Or MsgBoxStyle.Question Or MsgBoxStyle.SystemModal
                '開始しない場合→出る
                Exit Sub
            End If

'■■■以下、本編■■■
            '処理時間の計測
            'http://atamoco.boy.jp/vbcs/windows.app/perf/stopwatch.php
            Dim startDt As DateTime = DateTime.Now '開始時刻の取得

'■■■■以下、■■■■
            'ページごとに、ループ処理
            For i As Integer = 0 To AllFileCount Step page_img_count 'ページの最大数ごとにループ
                '未処理のファイル数を格納
                Dim Nokori_FileCount As Integer = AllFileCount - i

'未処理の画像が、なくなった場合→出る
                If Nokori_FileCount <= 0 Then GoTo Exit_Line

'◆◆◆今回のページで、処理するファイル数を取得◆◆◆
                Dim FileCount As Integer = 0
                If Nokori_FileCount <= page_img_count Then
                    'サムネイルが一枚に収まる場合
                    FileCount = Nokori_FileCount '残りの全てを格納

Else '今ページの最大数を格納
                    FileCount = page_img_count
                End If

'◆◆◆今回のページで、処理するファイル数の配列を作成◆◆◆
                Dim FileName(FileCount - 1) As String
                '元となる配列All_FileNameの開始位置iから、FileNameの0番目の位置に、All_FileNameからFileCount個抜き出す
                Array.Copy(All_FileName, i, FileName, 0, FileCount)

'◆◆◆出力する画像のサイズを算出するところ◆◆◆

If FileCount <= width_count AndAlso Title_Draw_Flg <> 1 Then
                    '並べる数が、横に満たない場合。且つ、タイトルをつけない場合
                    output_image_width = (FileCount * plus_blank_thumbnail_width) 'サムネの数の横幅に設定
                Else 'それ以上の場合→最大限の横幅に設定する。
                    If Tategaki_Rotate_Flg = 1 Then
                        '縦書きにする場合
                        output_image_width = (((Output_height + true_Blank_Space - Title_Height) \ plus_blank_thumbnail_width) * plus_blank_thumbnail_width) '横幅の設定

Else '横書き方向の場合
                        output_image_width = (((Output_width + true_Blank_Space) \ plus_blank_thumbnail_width) * plus_blank_thumbnail_width) '横幅の設定
                    End If

End If

'高さの決定⇒行の数を算出し、行数×サムネの高さに設定
                output_image_height = (((FileCount - 1) \ width_count) + 1) * plus_blank_thumbnail_height
                If Tategaki_Rotate_Flg = 1 Then
                    '縦書きにする場合
                    output_image_width += Title_Height 'タイトルの高さを加える。
                Else '横書きの場合
                    output_image_height += Title_Height 'タイトルの高さを加える。
                End If

'◆全体画像からの右と下の余分な空白はカットする
                If thumbnail_Blank_Space > 0 Then
                    output_image_width -= thumbnail_Blank_Space
                    output_image_height -= thumbnail_Blank_Space
                End If

'下地となる画像の選択
                Dim Shitazi_Image As Image = Shitazi_Image_Get()

'下地画像の作成
                Dim Output_Image As New Bitmap(Shitazi_Image, output_image_width, output_image_height)

'下地のImageオブジェクトのGraphicsオブジェクトを作成する
                Dim g2 As Graphics = Nothing '一旦初期化
                g2 = Graphics.FromImage(Output_Image) '下地画像を読み込む

'ポジフィルム調に装飾でなく、背景を透過もしない場合
                '→背景を指定の色で塗りつぶす
                Call bmp_FillRectangle(g2, output_image_width, output_image_height)

'タイトルを加える場合++++++++ここから++++++++++++++++++++++++++++++++++
                If Title_Draw_Flg = 1 Then
                    '源タイトルの取得
                    Dim Title_Draw_Text_2 As String = If(Title_Draw_Text = "", "タイトル", Title_Draw_Text)

'ページ番号について
                    If Title_Draw_Page = 1 Then
                        'ページ番号を付記する場合
                        Title_Draw_Text_2 &= (" " & (true_page_count + 1).ToString)

Else '全ページ数も併記する場合
                        Title_Draw_Text_2 &= (" " & (true_page_count + 1).ToString & "/" & max_page_count.ToString)
                    End If

'画像の描画幅を求める
                    Dim Title_Width As Integer = g2.MeasureString(Title_Draw_Text_2, Title_Draw_Font).Width
                    If Tategaki_Rotate_Flg = 1 Then
                        '縦書きの場合
                        'まず文字用の画像を用意する。
                        Using Mozi_bmp As New Bitmap(Title_Width, Title_Height)
                            Using Mozi_g As Graphics = Graphics.FromImage(Mozi_bmp)
                                '→背景を指定の色で塗りつぶす
                                Call bmp_FillRectangle(Mozi_g, output_image_width, output_image_height)
                                'タイトル文字列の描画
                                Mozi_g.DrawString(Title_Draw_Text_2, Title_Draw_Font, (New SolidBrush(Color.FromArgb(255, Title_Draw_Color))), 0, 0)
                                Mozi_g.Dispose()
                            End Using

'270度回転
                            Mozi_bmp.RotateFlip(RotateFlipType.Rotate270FlipNone)
                            '描画
                            g2.DrawImage(Mozi_bmp, 0, (Output_Image.Height - Mozi_bmp.Height) \ 2)
                            Mozi_bmp.Dispose()
                        End Using

Else '通常時。上にタイトルを描く
                        g2.DrawString(Title_Draw_Text_2, Title_Draw_Font, (New SolidBrush(Color.FromArgb(255, Title_Draw_Color))), (Output_Image.Width - Title_Width) \ 2, 0)
                    End If
                End If
                'タイトルを加える場合++++++++ここまで++++++++++++++++++++++++++++++++++

'そのページ於いて並べたサムネイルの数用のカウンター
                Dim j As Integer = 0

'実際に並べた、有効なサムネイル数を格納
                Dim true_thumbnail_count As Integer = 0

'FileNameの配列の全項目でループ
                For Each ImageFileName As String In FileName

'付加文字情報の設定
                    Dim thumbnail_Info_str As String = ""
                    '通し番号をつける場合
                    thumbnail_Info_str = (Make_thumbnail_Count + 1).ToString

'▼サムネイル画像の取得
                    Try
                        Dim thumbnail_image As Bitmap = Nothing

'画像読み込み時に、エラーを起こしたか否か。
                        Dim Image_Load_Err_Flg As Boolean = False '初期化

Try '画像ファイルの読み込みを試みる
                            '普通に画像を呼び出して、サムネをもらう
                            Using bmp As New Bitmap(ImageFileName)
                                thumbnail_image = thumbnail_Image_Get(bmp, thumbnail_Info_str, False)
                                bmp.Dispose()
                            End Using

Catch ex As Exception
                            '画像の読み込みに失敗した場合

'読み込み失敗フラグを上げる
                            Image_Load_Err_Flg = True
                        End Try

'▼▼▼サムネ画像が、取得できた場合▼▼▼
                        If Not thumbnail_image Is Nothing Then

If BikouRan_Flg = 1 Then
                                '備考欄を付加する場合→付ける
                                Call BikouRan_Set(thumbnail_image)
                            End If

'サムネを並べる。
                            Dim left As Integer = (j Mod width_count) * plus_blank_thumbnail_width
                            Dim top As Integer = (j \ width_count) * plus_blank_thumbnail_height
                            If Tategaki_Rotate_Flg = 1 Then
                                '縦書きの場合→270度回転しておく
                                thumbnail_image.RotateFlip(RotateFlipType.Rotate270FlipNone)
                                left += Title_Height 'タイトルの高さを足す
                            Else '横書きの場合
                                top += Title_Height 'タイトルの高さを足す
                            End If

g2.DrawImage(thumbnail_image, left, top) '指定位置に、描画する。

Make_thumbnail_Count += 1 '通し番号を数える。
                            j += 1 'ループカウンター・カウントアップ

If Not Image_Load_Err_Flg Then
                                '■読み込み＆サムネイル取得・成功時
                                '有効なサムネイル数を、カウント
                                true_thumbnail_count += 1
                            End If

'開放
                            thumbnail_image.Dispose()
                        End If

'開放２
                        thumbnail_image = Nothing

Catch ex As Exception
                        'エラー時→何もしない
                    End Try

Application.DoEvents()
                Next

If Tategaki_Rotate_Flg = 1 Then
                    '縦書きにする場合
                    '90度回転して元の方向に戻す
                    Output_Image.RotateFlip(RotateFlipType.Rotate90FlipNone)
                End If

'1個以上の出力をした場合(正常終了時)
                If true_thumbnail_count > 0 Then
                    '▼完成した画像を出力 ＆ 最後に出力したファイルパスを取得
                    last_page_filepath = ImageFile_Output(Output_Image,
                                                          SaveFileCName & "[" & (true_page_count).ToString("000") & "]")
                    true_page_count += 1 '有効なページ数をカウント
                End If

'開放
                g2.Dispose()
                Output_Image.Dispose()
                page_count += 1 '処理したページ数をカウント

Application.DoEvents()

Exit_Line:  '以下、終了処理

'処理時間の計測終わり
            Dim endDt As DateTime = DateTime.Now
            Dim opration_ts_str As String = (endDt - startDt).ToString  ' 時間の差分を取得
            MessageBox.Show("END" & Environment.NewLine & opration_ts_str, "END", MessageBoxButtons.OK, MessageBoxIcon.Information, MessageBoxDefaultButton.Button1, MessageBoxOptions.DefaultDesktopOnly)

Catch ex As Exception
            '全体を通しての、エラー時
            MessageBox.Show("サムネイルまとめ画像作成・処理エラーです。" & vbCrLf_str & ex.Message,
                            "画像作成・処理エラー", MessageBoxButtons.OK, MessageBoxIcon.Error)

End Try

Final_Exit_Line:
        '■■■以下、終了処理■■■
    End Sub

Private Function ImageFile_Output(ByVal OutPut_Image As Bitmap, ByVal Output_FileName As String) As String
        '▼▼▼画像にパスを与え、ファイルとして出力させる場所▼▼▼
        Dim true_Output_FileName As String = IO.Path.Combine(desktop_path, Output_FileName)

Try
            '処理画像の形式に振り分けて、保存する。
            '→★今回は、pngの場合で固定。
            true_Output_FileName &= ".png" '拡張子をつける

'上書きの有無と、確認
            Call Output_Overwrite_Check(true_Output_FileName)

'実際に、完成画像を出力する場所
            OutPut_Image.Save(true_Output_FileName, Imaging.ImageFormat.Png)

Catch ex As Exception
            'エラー時
            true_Output_FileName = "" '空白を返す
        End Try

Exit_Line:
        '処理したファイルパスを返す
        Return true_Output_FileName

End Function

Private Function Output_Overwrite_Check(ByRef FileName As String) As Boolean
        '▼▼▼同名のファイル名とならないように、避ける場所▼▼▼

'◆公開版なので。別名で保存させる場合固定。
        If Not IO.File.Exists(FileName) Then
            '同名ファイルが存在しない場合→そのまま。
            Return False
        End If

'以下、同名のファイルが存在する場合
        Dim i As Integer = 0 'ループカウンター

'新しいファイルパスを作る。（連番にする。）
        Dim fff_c As String = IO.Path.Combine(IO.Path.GetDirectoryName(FileName), SaveFileCName & "[") '新しいファイルパスの頭
        Dim fff As String = "" '新しいファイルパスを格納

Try
            Do
                fff = fff_c & i.ToString("000") & "]" & IO.Path.GetExtension(FileName)
                i += 1 'カウントアップ
            Loop While IO.File.Exists(fff) '同名のファイルが、存在しなくなるまでループ

Catch ex As Exception
            'エラー防止用
        End Try

'新しい名前を与える。
        FileName = fff

Return True

End Function

Private Function thumbnail_Image_Get(ByVal orig As Bitmap, ByVal Info_Str As String, Excel_Flg As Boolean) As Bitmap
        'orig=乗せる元画像の指定

'空の画像が入ってきた場合→出る
        If orig Is Nothing Then GoTo Err_Line

'◆◆◆以下、本編◆◆◆
        Try
            Dim Sen_size As Integer = thumbnail_border '線の幅を格納
            '枠線を、Excelの罫線に依存する場合は、線幅を0とする。
            If Excel_Flg Then Sen_size = 0

Dim picture_width As Integer = thumbnail_width '線を含めた幅
            Dim picture_height As Integer = thumbnail_height '線を含めた高さ

'下地となる画像の選択
            Dim Shitazi_Image As Image = Shitazi_Image_Get()

'下地となるImageオブジェクトを作成する
            Dim canvas As New Bitmap(Shitazi_Image, picture_width, picture_height)

'下地のImageオブジェクトのGraphicsオブジェクトを作成する
            Dim g As Graphics = Graphics.FromImage(canvas)

'ポジフィルム調に装飾でなく、背景を透過もしない場合
            '→背景を指定の色で塗りつぶす
            Call bmp_FillRectangle(g, picture_width, picture_height)

Try 'サムネイルの作成処理に関して
                '★標準の場合
                g.InterpolationMode = Drawing2D.InterpolationMode.NearestNeighbor '	最近傍補間、ニアレストネイバー法

Catch ex As Exception

End Try

'枠線を除いた、画像の最大サイズを、計算
            Dim Gazou_Max_Width As Integer = picture_width - (Sen_size * 2) '画像の最大幅
            Dim Gazou_Max_Height As Integer = picture_height - (Sen_size * 2) '画像の最大高さ

'◎元画像から、アスペクト比が同じのサムネイル画像のサイズを取得++++++++++++ここから++++++++++++++++++++++++
            Dim width As Integer, height As Integer '幅／高さ

If orig.Width >= orig.Height Then
                '横長の画像の場合
                width = Gazou_Max_Width '幅を指定

height_set_Line:
                height = (width * orig.Height) \ orig.Width
                If height > Gazou_Max_Height Then 'もし、縦の長さが、オーバーしてしまった場合
                    height = Gazou_Max_Height '→縦で合わせる
                    GoTo width_set_Line
                End If
            Else '縦長の画像の場合
                height = Gazou_Max_Height '高さの指定

width_set_Line:
                width = (height * orig.Width) \ orig.Height
                If width > Gazou_Max_Width Then 'もし、幅が、オーバーしてしまった場合
                    width = Gazou_Max_Width '→幅で合わせる
                    GoTo height_set_Line
                End If

End If

'乗せる位置を設定（初期は、画像の中央に乗せる）
            Dim left As Integer = (Gazou_Max_Width - width) \ 2 + Sen_size '横位置は、中央に配置
            Dim top As Integer = (Gazou_Max_Height - height) \ 2 + Sen_size '縦位置は、中央に配置

'◎元画像から、アスペクト比が同じのサムネイル画像のサイズを取得++++++++++++ここまで++++++++++++++++++++++++

'★★★↓指定位置にサムネイル画像を乗せる。★★★
            '描画する部分の範囲を決定する。
            '標準・高品質時
            g.DrawImage(orig, left, top, width, height) '指定位置に、描画する。

'◎サムネイル内部に、文字情報をつける場合+++++++++++++++++++++++++++++++++++++++++++++++
            Try '不透明のブラシを作成する
                Using b = New SolidBrush(Color.FromArgb(255, thumbnail_Info_color)) '色=thumbnail_Info_colorで、透過させない
                    '文字列を描画する
                    '左上
                    g.DrawString(Info_Str, thumbnail_Info_font, b, Sen_size + 1, Sen_size + 1)

End Using
            Catch ex As Exception

End Try

'◎サムネイル内部に、文字情報をつける場合+++++++++++++++++++++++++++++++++++++++++++++++

'◎最後に、サムネイルに、外枠を描く+++++++++++++++++++++++++++++++++++++++++++++++++++++++
            If Sen_size > 0 Then '枠線を描く場合
                '通常環境時
                'Penオブジェクトの作成(幅=Sen_size/色=thumbnail_border_color)
                Using p As New Pen(thumbnail_border_color, Sen_size)
                    '四角の枠を描画する
                    'http://dobon.net/vb/dotnet/graphics/drawline.html
                    g.DrawRectangle(p, New Rectangle(Sen_size \ 2, Sen_size \ 2, picture_width - Sen_size, picture_height - Sen_size))
                End Using
            End If

'リソースを解放する
            g.Dispose()
            If orig IsNot Nothing Then orig.Dispose()
            Shitazi_Image.Dispose()

'出来た画像を返す
            Return canvas
            Exit Function

Catch ex As Exception 'エラー時
            GoTo Err_Line
        End Try

Err_Line:
        Return Nothing '空を返す

End Function
    Private Sub BikouRan_Set(ByRef thum As Bitmap)
        '備考欄をサムネイルの右側に添える。

'安全装置(備考欄を設置しない場合は出る)
        If BikouRan_Flg = 0 OrElse BikouRan_width <= 0 Then Exit Sub

'備考欄を含めたサムネイル全体の画像を作成
        Using BikouRan_bmp As New Bitmap(BikouRan_width + thum.Width, thum.Height)
            Using g As Graphics = Graphics.FromImage(BikouRan_bmp)
                Try '備考欄の枠線を描画する
                    '→最初に背景を指定の色で塗りつぶす
                    Call bmp_FillRectangle(g, BikouRan_bmp.Width, BikouRan_bmp.Height)

Using b = New SolidBrush(Color.FromArgb(255, thumbnail_border_color))
                        If thumbnail_border > 0 Then '枠線を描く場合
                            '→★どうやら、Mono環境では、Penの使用に問題があるみたいだ。
                            '四辺に四角を代用した線を描く
                            g.FillRectangle(b, New Rectangle(0, 0, BikouRan_bmp.Width, thumbnail_border)) '上
                            g.FillRectangle(b, New Rectangle(0, 0, thumbnail_border, BikouRan_bmp.Height)) '左
                            g.FillRectangle(b, New Rectangle(0, BikouRan_bmp.Height - thumbnail_border, BikouRan_bmp.Width, thumbnail_border)) '下
                            g.FillRectangle(b, New Rectangle(BikouRan_bmp.Width - thumbnail_border, 0, thumbnail_border, BikouRan_bmp.Height)) '右
                        End If

If BikouRan_Bold > 0 Then
                            '行間を算出描画する場合。
                            '線が描けるだけの高さ分を算出
                            Dim span As Single = BikouRan_bmp.Height
                            '行間の量を算出
                            span = span / BikouRan_Rows
                            For i As Single = 0 To BikouRan_bmp.Height Step span
                                g.FillRectangle(b, New Rectangle(thum.Width, i - (BikouRan_Bold \ 2), BikouRan_bmp.Width, BikouRan_Bold)) '行線を描く
                            Next
                        End If
                    End Using

'元のサムネ画像を上から乗せて完成
                    g.DrawImage(thum, 0, 0, thum.Width, thum.Height)

'元のサムネ画像の解放
                    thum.Dispose()
                    thum = Nothing

'新しい画像に書き換え
                    thum = BikouRan_bmp.Clone

Catch ex As Exception

End Try

End Using
        End Using
    End Sub

Private Function Shitazi_Image_Get() As Bitmap
        '下地となる画像を取得する。
        Try '(無地{0}か、透過{1}か。)
            If thumbnail_toka_Flg <> 1 Then
                'まずは白紙の画像を適当に作る。
                Using bmp As New Bitmap(126, 132)
                    Using g_ss As Graphics = Graphics.FromImage(bmp)
                        g_ss.FillRectangle(Brushes.White, 0, 0, 126, 132)
                        g_ss.Dispose()
                        Return bmp.Clone
                    End Using
                End Using
            Else
                '透過下地の画像ファイルのURL  
                Using wc As New System.Net.WebClient
                    Dim url As String = "http://blog-imgs-81.fc2.com/o/y/k/oyk3865b/20150907155625d35.png"
                    '指定したURLから画像をダウンロード  
                    Using st As System.IO.Stream = wc.OpenRead(url)
                        '指定したデータストリームから Image オブジェクトを作成します  
                        Return Image.FromStream(st) '下地となる画像の格納  
                        '現在のストリームを閉じリソースを解放します  
                        st.Close()
                    End Using
                    wc.Dispose()
                End Using
            End If

Catch ex As Exception
            'それでも、エラー時→空白の画像にする。
            Return New Bitmap(126, 132)
        End Try

End Function
    Private Sub bmp_FillRectangle(ByRef g As Graphics, width As Integer, height As Integer)
        '画像の背景を指定の色で塗りつぶす処

'背景を透過させる場合は塗りつぶしはしない
        If thumbnail_toka_Flg = 1 Then Exit Sub

Using b = New SolidBrush(Color.FromArgb(255, Output_Background_Color))
            g.FillRectangle(b, -50, -50, width + 50, height + 50) '50px四方に余裕を持たせる
            b.Dispose()
        End Using
    End Sub
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

Me.Text = Application.ProductName & " " & My.Application.Info.Version.ToString

'コントロール 、使用を止める。
        Me.Enabled = False

'ファイルダイアログ選択用
        Using OpenFileDialog1 As New OpenFileDialog
            With OpenFileDialog1
                .Filter = "画像ファイル|*.jpg;*.bmp;*.gif;*.png"

'複数のファイルを選択できるようにする
                .Multiselect = True

If .ShowDialog = DialogResult.OK Then 'OKを押した場合

'選択した画像を渡して、出力画像を組み立てる処理を行う
                    If Not File_List_Check_and_Start(.FileNames) Then
                        '何らかの失敗時
                        MessageBox.Show("ファイルの読み取りに失敗しました。", "ファイル読み取り失敗", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
                    End If

End If
            End With
        End Using

'処理が終わったら閉じる
        Me.Close()
    End Sub
    Private Sub Form1_FormClosed(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
        '各解放(手抜き)
        thumbnail_Info_font.Dispose()

'確実に、解放する
        Me.Dispose()
        Me.DestroyHandle()
    End Sub
    '以上。THE わやくちゃなコードでございました。
End Class

今後は、

『画像一覧の画像を作成するソフト』
http://oyk3865b.blog13.fc2.com/blog-entry-1040.html
に、以下の機能を追加できるように
調整していきたいと考えております。

・サムネイルの右側に、
　何行かの備考欄を設置できるようにする。
　ex.3枚の写真が並ぶ工事の現場報告書のようなものを想定。

・サムネイルの並びを、現在の横書き方向だけでなく、
　縦書き方向にも配置できるようにする。
　ex.3枚の写真が並ぶ工事の現場報告書のようなものを想定。

出来上がり次第、
このブログにて、報告させていただこうと思っております。

以上
お粗末様でございました。
ありがとうございました。

透過pngデータ置き場下地データ(透過)

スポンサーサイト

テーマ : ソフトウェア開発 - ジャンル : コンピュータ

<<三保半島の埠頭 | ホーム | 三保飛行場>>

コメントの投稿

トラックバック

この記事にトラックバックする(FC2ブログユーザー) URL

| ホーム |