LoginSignup
0
0

More than 3 years have passed since last update.

【Excel VBA】GIF画像ファイルがアニメーションGIFかどうか判別するツールの作成_その②「異なる方法で処理速度を比較」

Last updated at Posted at 2019-12-08

1.この記事について

この記事は先日投稿した記事の続きであり、
異なる2つのやり方の検証結果となります。

先日の記事:【Excel VBA】GIF画像ファイルがアニメーションGIFかどうか判別するツールの作成(VBAの機能のみを使って実装)

上の記事では、
「GIF画像ファイルをバイト列に格納して、NETSCAPEという文字列のバイト列と重なる部分があればアニメーションGIFである」というロジックで
ソースコードを作成しましたが、
今回は逆に「GIF画像ファイルをSJISの文字列として変数に格納して、”NETSCAPE”という文字列が含まれているかどうかを調査する」という方法でツールを作成します。

その後、2つの異なる方法で作成した機能の処理速度を比較したいと思います。

2.やりたいこと

 ・ツールの作成(先日の記事とは異なった方法)

 ・処理速度の比較をするソースコード作成

 ・処理速度の比較

3.作成したコードと解説、考察

①ツールの作成(先日の記事とは異なった方法)

まずはツールの作成から。

M_JudgeAnimationGif.bas
'******************************************************************************************
'*関数名    :isAnimationGifImage_ver2
'*機能      :指定のGIF画像ファイルがアニメーションであるかどうか判別する。ver2_画像を文字列として取り込んでNETSCAPEを探す方法。
'*引数(1)   :指定する画像ファイルのフルパス
'*引数(2)   :アニメーションであるかどうかの判定を出力するセルオブジェクト
'******************************************************************************************
Public Sub isAnimationGifImage_ver2(ByVal filePath As String, _
                                    ByRef outputCell As Range)

    '定数
    Const FUNC_NAME As String = "isAnimationGifImage"

    '変数
    Dim fileExpression As String            'ファイル拡張子
    Dim picObject As Object                 '画像ファイル格納オブジェクト
    Dim bufString As String                 '読み込んだ画像ファイルを文字列として格納
    Dim fileNum As Long                     'ファイル番号
    Dim cnt As Long                         'ループタウンタ

    On Error GoTo ErrorHandler
    '---以下に処理を記述---

    '///拡張子取得
    fileExpression = Mid(filePath, InStrRev(filePath, ".") + 1)
    '拡張子がgifであるファイルのみ処理を続行
    If fileExpression <> "gif" Then
        outputCell.Value = "指定されたファイルはGIFファイルではありません。"
        GoTo ExitHandler
    End If

    '///画像ファイルのみ処理を続行
    On Error GoTo 0
    On Error Resume Next
    Set picObject = LoadPicture(filePath)
    On Error GoTo 0
    On Error GoTo ErrorHandler
    '正しくloadできていないならExitHandlerへ
    If picObject Is Nothing Then
        outputCell.Value = "指定されたファイルは画像ファイルではありません。"
        GoTo ExitHandler
    End If

    '///ファイル読み込み
    With CreateObject("ADODB.Stream")
        .Open
        .Charset = "shift_jis"
        .LoadFromFile filePath
        bufString = .ReadText
        .Close
    End With


    '///アニメーションGIF判定
    '読み込んだ文字列の中にアニメーションGIFの識別文字列「NETSCAPE」が見つかるかどうかを調査する
    If InStr(bufString, "NETSCAPE") <> 0 Then
        outputCell.Value = "TRUE:指定したファイルはアニメーションGIF画像ファイルです。"
    Else
        outputCell.Value = "FALSE:指定したファイルはアニメーションGIF画像ファイルではありません。"
    End If


ExitHandler:

    Exit Sub

ErrorHandler:

        MsgBox "エラーが発生しましたので終了します" & _
                vbLf & _
                "関数名:" & FUNC_NAME & _
                vbLf & _
                "エラー番号" & Err.Number & Chr(13) & Err.Description, vbCritical

        GoTo ExitHandler

End Sub


ADODB.Streamオブジェクトを用いて画像ファイルをSJISの文字列として取り出し、
InStr関数を用いてその中にNETSCAPEの並びが存在するかどうかを判別しています。

この関数を用いて、先日の記事と同様にGIF画像のアニメーション有無を判別できました(ソースコードはGithubに上げます)。

②処理速度の比較をするソースコード作成

「マイクロ秒以下のスケールで現在時刻を取得できるライブラリ」を探していましたが、
ちょうど下記の方のサイトに良いものがあったため、参考にさせていただきました。

https://hatenachips.blog.fc2.com/blog-entry-377.html

それをもとに、次のように作成しました。

M_CalcProcessingTime.bas

Option Explicit

Private Declare PtrSafe Function QueryPerformanceCounter Lib "Kernel32" _
                           (X As Double) As Boolean
Private Declare PtrSafe Function QueryPerformanceFrequency Lib "Kernel32" _
                           (X As Double) As Boolean
Dim Freq As Double
Dim Overhead  As Double
Dim Ctr1 As Double, Ctr2 As Double, Result As Double

'ミリ秒以下の高精度で処理時間計測
Public Sub SWStart()
    If QueryPerformanceCounter(Ctr1) Then
        QueryPerformanceCounter Ctr2
        QueryPerformanceFrequency Freq
        Overhead = Ctr2 - Ctr1
    Else
        Err.Raise 513, "StopwatchError", "High-resolution counter not supported."
    End If
    QueryPerformanceCounter Ctr1
End Sub

Public Sub SWStop()
    QueryPerformanceCounter Ctr2
    Result = (Ctr2 - Ctr1 - Overhead) / Freq * 1000
End Sub

Public Function SWShow(Optional Caption As String) As Double
    SWShow = Result
End Function

Sheet4.cls

Option Explicit



'******************************************************************************************
'*関数名    :CommandButton_CalcProcessingTime_Run_Click
'*機能      :処理時間計算
'*引数(1)   :
'******************************************************************************************
Private Sub CommandButton_CalcProcessingTime_Run_Click()

    '定数
    Const FUNC_NAME As String = "CommandButton_CalcProcessingTime_Run_Click"

    '変数

    Dim filePath As String              '読み込む画像ファイルのフルパス格納
    Dim i As Long                       'ループカウンタ

    On Error GoTo ErrorHandler
    '---以下に処理を記述---

    '画面表示停止
    Application.ScreenUpdating = False

    '画像ファイルのパスを取得
    filePath = Me.Cells(6, 5).Value

    'バージョン1について処理時間計算
    For i = 1 To 5
        Call SWStart
        Call isAnimationGifImage(filePath, Me.Cells(1, 1))
        Call SWStop

        Me.Cells(13, 4 + i).Value = SWShow
        Me.Cells(1, 1).Value = ""
    Next

    'バージョン2について処理時間計算
    For i = 1 To 5
        Call SWStart
        Call isAnimationGifImage_ver2(filePath, Me.Cells(1, 1))
        Call SWStop

        Me.Cells(14, 4 + i).Value = SWShow
        Me.Cells(1, 1).Value = ""
    Next

    '画面表示再開
    Application.ScreenUpdating = True


ExitHandler:

    Exit Sub

ErrorHandler:

        MsgBox "エラーが発生しましたので終了します" & _
                vbLf & _
                "関数名:" & FUNC_NAME & _
                vbLf & _
                "エラー番号" & Err.Number & Chr(13) & Err.Description, vbCritical

        GoTo ExitHandler

End Sub







ツールの外観はこのようになっています。

[処理時間計算シート]
コメント 2019-12-08 230756.png

処理速度の比較

これを用いて、3種類のアニメーションGIFファイルについて処理速度を比較します。

(A)560KBのファイルの場合

処理速度は次のようになりました。
20191208_2044_page_72.png

(A)860KBのファイルの場合

処理速度は次のようになりました。
20191208_2042_page19.png

(A)2500KBのファイルの場合

処理速度は次のようになりました。
20191208_2041_page32.png

考察

やはり予想通り文字列での探索よりバイナリ列で処理をするほうが速いようです。
また、GIFの内部の画像枚数にも依るのでしょうが、
ファイルサイズが大きくなればなるほど処理速度の差は大きくなるようです。

5.終わりに

今回作成したツールについて、
Githubにあげたので良かったら参照してください。

Github

https://github.com/dede-20191130/MyExcelVBA/blob/master/forQiita/20191208/%E3%82%A2%E3%83%8B%E3%83%A1%E3%83%BC%E3%82%B7%E3%83%A7%E3%83%B3gif%E5%88%A4%E5%AE%9A.xlsm

なにか補足がありましたらコメントください。

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0