FC2ブログ

画像の縮小(サムネイル)について

画像の縮小(サムネイル)

画像のサムネイル作成方法についてです。
サムネイルの作成方法は,多数ありますが表示速度やメモリ使用量,解像度など考えなければいけない
要素があります。ここで紹介している方法では,元画像をいったんロードしている為,表示速度は
速くありませんが元画像をサムネイル作成後に破棄している分,サムネイルを同時に複数作成しても
メモリ使用量を抑えられます。
(サンプルでは,サムネイルは1つしか作成していません。)


'==============================================================================
'
' サムネイル関連
'
'==============================================================================




'---------------------------------------------------
' 利用方法(以下必要に応じてプロシージャに貼り付けて下さい。)
'---------------------------------------------------

  '---<< サムネイル作成 >>
    Dim sFile As String
    Dim dHeight As Double
    Dim dWidth As Double
    Dim dNewHeight As Single
    Dim dNewWidth As Single

    Const iPicHeight = 3000
    Const iPicWidth = 3000

    On Error GoTo Err

    '---ファイル取得
      sFile = "c:\aaa\bbb\ccc\ddd.bmp"


    '---画像クリア
      Picture1.Cls


    '---幅と高さを調べるために、一旦 Picture オブジェクトに格納
      Picture2.Picture = LoadPicture(sFile)


    '---元画像の幅・高さ取得
      dHeight = Picture2.Picture.Height
      dWidth = Picture2.Picture.Width


    '---元画像の幅・高さがサムネイルの範囲を超える場合のみ縮小するサイズを取得
      If dHeight > 0 Or dWidth > 0 Then

        '元画像の幅・高さどちらかでもサムネイルの範囲を超えるかチェック
        If dHeight > iPicHeight Or dWidth > iPicWidth Then

          '元画像の幅・高さどちらかがサムネイルの範囲を超える場合
          If dHeight > dWidth Then

            '高さが幅より範囲を大きく超えている場合,高さの縮小率に併せて幅を縮小
            dNewHeight = iPicHeight
            dNewWidth = dWidth / dHeight * iPicHeight
          Else

            '幅が高さより範囲を大きく超えている場合,幅の縮小率に併せて高さを縮小
            dNewWidth = iPicWidth
            dNewHeight = dHeight / dWidth * iPicWidth
          End If

        Else

          '元画像の幅・高さどちらかがサムネイルの範囲を超えない場合
          dNewHeight = dHeight
          dNewWidth = dWidth
        End If
      End If


    '---サムネイルの大きさ変更
      Picture1.Height = dNewHeight
      Picture1.Width = dNewWidth
      DoEvents


    '---サムネイル作成
      Picture1.PaintPicture Picture2.Picture, 0, 0, dNewWidth / 0.567, dNewHeight / 0.567, _
                               0, 0, Picture2.Picture.Width, Picture2.Picture.Height


    '---元画像破棄
      Set Picture2 = Nothing


    '---終了
      Exit Sub

  Err:
    '---エラー処理
      sErrMsg = "エラーが発生しました。" & vbCrLf & _
             Err.Number & " " & Err.Description
      MsgBox sErrMsg, vbCritical, "サムネイルサンプル"
      Exit Sub



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。
関連記事

テーマ : プログラミング
ジャンル : コンピュータ

コメントの投稿

非公開コメント

検索フォーム
最新記事
カテゴリ
全記事表示リンク

全ての記事を表示する

最新コメント
プロフィール

ITLife

Author:ITLife
システム葵新井聡太です。
東京都東村山市に生まれ、ここで育ち、ここで結婚し、システムエンジニア一筋で十数年やってきました。
ここでは主に、パソコンを中心にITに関わることを備忘録として残していきたいと思います。
少しでも来ていただいた方のお役に立てたら幸いです。
m(_ _)m

p.s
ここで紹介している内容は一例です。すべては、自己責任でお願いします。

カレンダー
07 | 2019/08 | 09
- - - - 1 2 3
4 5 6 7 8 9 10
11 12 13 14 15 16 17
18 19 20 21 22 23 24
25 26 27 28 29 30 31
訪問数
月別アーカイブ
リンク