汎用キュークラス

バリアント型の要素を格納するキューです。
以下のメンバを持ちます。
Property Count () As Long: 格納されているデータの個数を返します
Property IsEmpty () As Boolean: キューが空なら True を返します
Property IsFull () As Boolean: キューがいっぱいなら True を返します
Sub Initialize ([ByVal MaxItem As Long = 255]): 最大数をMaxItem個としてキューを初期化します
Function Peek () As Variant: 先頭データを返しますキューから削除しません
Function Pop () As Variant: 先頭データを取り出しますキューからは削除します
Sub Push (Item As Variant): キューの最後尾にデータを追加します
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CQueue"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'******************************************************************
'CommonClass.vbp
'CQueue
'汎用キュークラス
'2005/06/20
'******************************************************************
Option Explicit

Private Const CNST_MODULE_NAME           As String = "CQueue"
Private Const CNST_DEFAULT_MAXITEM       As Long = 255&
Private mvarQueueData()                  As Variant
Private mlngArrayNum                     As Long
Private mlngFirstIndex                   As Long
Private mlngLastIndex                    As Long


'******************************************************************
'プロシージャ名   :Get Count
'説明             :キューに格納されている要素数を返す
'戻り値           :Long型               O   要素数
'******************************************************************
Public Property Get Count() As Long
'============= Declare ==============
'============= Initiarize ===========
On Error GoTo ERR_HANDLER_00

'============= Main =================

    Count = ((mlngArrayNum - mlngFirstIndex) + mlngLastIndex) Mod mlngArrayNum

'============= Release ==============
RESUME_00:
    Exit Property
'============= Error ================
ERR_HANDLER_00:
    Call Err.Raise(Err.Number, CNST_MODULE_NAME & ".Get Count ← " & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)

End Property


'******************************************************************
'プロパティ名:    :Get IsFull
'説明:            :キューの要素が最大数に達しているかを返す
'戻り値           :Boolean型            True    キューは満杯
'                 :                     False   キューに空きあり
'******************************************************************
Public Property Get IsFull() As Boolean
'============= Declare ==============
'============= Initiarize ===========
On Error GoTo ERR_HANDLER_00

'============= Main =================

    IsFull = (InclementIndex(mlngLastIndex) = mlngFirstIndex)

'============= Release ==============
RESUME_00:
    Exit Property
'============= Error ================
ERR_HANDLER_00:
    Call Err.Raise(Err.Number, CNST_MODULE_NAME & ".Get IsFull ← " & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)

End Property


'******************************************************************
'プロパティ名:    :Get IsEmpty
'説明:            :キューが空かどうかを返す
'戻り値           :Boolean型            True    キューは空
'                 :                     False   キューは空ではない
'******************************************************************
Public Property Get IsEmpty() As Boolean
'============= Declare ==============
'============= Initiarize ===========
On Error GoTo ERR_HANDLER_00

'============= Main =================

    IsEmpty = (mlngFirstIndex = mlngLastIndex)

'============= Release ==============
RESUME_00:
    Exit Property
'============= Error ================
ERR_HANDLER_00:
    Call Err.Raise(Err.Number, CNST_MODULE_NAME & ".Get IsEmpty ← " & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)

End Property


'******************************************************************
'プロシージャ名:  :Initialize
'説明:            :キューの初期化を行う
'引数:            :plngMaxItem        I   キューの最大数
'******************************************************************
Public Sub Initialize(Optional ByVal plngMaxItem As Long = CNST_DEFAULT_MAXITEM)
'============= Declare ==============
'============= Initiarize ===========
On Error GoTo ERR_HANDLER_00

'============= Main =================

    mlngArrayNum = plngMaxItem + 1&
    ReDim mvarQueueData(mlngArrayNum - 1&)
    mlngFirstIndex = 0&
    mlngLastIndex = 0&

'============= Release ==============
RESUME_00:
    Exit Sub
'============= Error ================
ERR_HANDLER_00:
    Call Err.Raise(Err.Number, CNST_MODULE_NAME & ".Initialize ← " & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)

End Sub


'******************************************************************
'プロシージャ名:  :Pop
'説明:            :先頭のデータを返し、キューより削除する
'戻り値           :Variant型        取り出したデータ
'******************************************************************
Public Function Pop() As Variant
'============= Declare ==============
'============= Initiarize ===========
On Error GoTo ERR_HANDLER_00

'============= Main =================
    
    If IsObject(mvarQueueData(mlngFirstIndex)) Then
        Set Pop = Peek()
    Else
        Pop = Peek()
    End If
    mvarQueueData(mlngFirstIndex) = Empty
    mlngFirstIndex = InclementIndex(mlngFirstIndex)

'============= Release ==============
RESUME_00:
    Exit Function
'============= Error ================
ERR_HANDLER_00:
    Call Err.Raise(Err.Number, CNST_MODULE_NAME & ".Pop ← " & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)

End Function


'******************************************************************
'プロシージャ名:  :Peek
'説明:            :先頭のデータを返す。キューより削除はしない
'戻り値           :Variant型        取り出したデータ
'******************************************************************
Public Function Peek() As Variant
'============= Declare ==============
'============= Initiarize ===========
On Error GoTo ERR_HANDLER_00

'============= Main =================

    If (IsEmpty()) Then
        Peek = Empty
        Call Err.Raise(vbObjectError, "CQueue", "キューにデータがありません")
    End If
    If IsObject(mvarQueueData(mlngFirstIndex)) Then
        Set Peek = mvarQueueData(mlngFirstIndex)
    Else
        Peek = mvarQueueData(mlngFirstIndex)
    End If

'============= Release ==============
RESUME_00:
    Exit Function
'============= Error ================
ERR_HANDLER_00:
    Call Err.Raise(Err.Number, CNST_MODULE_NAME & ".Peek ← " & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)

End Function


'******************************************************************
'プロシージャ名:  :Push
'説明:            :キューの最後尾にデータを追加する
'引数:            :pvarItem           I   追加するデータ
'******************************************************************
Public Sub Push(pvarItem As Variant)
'============= Declare ==============
'============= Initiarize ===========
On Error GoTo ERR_HANDLER_00

'============= Main =================

    If (IsFull()) Then
        Call Err.Raise(vbObjectError, "CQueue", "キューがいっぱいです")
    End If
    
    If (IsObject(pvarItem)) Then
        Set mvarQueueData(mlngLastIndex) = pvarItem
    Else
        mvarQueueData(mlngLastIndex) = pvarItem
    End If
    mlngLastIndex = InclementIndex(mlngLastIndex)

'============= Release ==============
RESUME_00:
    Exit Sub
'============= Error ================
ERR_HANDLER_00:
    Call Err.Raise(Err.Number, CNST_MODULE_NAME & ".Push ← " & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)

End Sub


'------------------------------------------------------------------
'プロシージャ名:  :InclementIndex
'説明:            :インデックスをインクリメントする
'引数:            :plngIndex          I   インクリメント前の値
'戻り値           :Long型                 インクリメント後
'------------------------------------------------------------------
Private Function InclementIndex(ByVal plngIndex As Long) As Long
'============= Declare ==============
'============= Initiarize ===========
On Error GoTo ERR_HANDLER_00

'============= Main =================

    InclementIndex = (plngIndex + 1) Mod mlngArrayNum

'============= Release ==============
RESUME_00:
    Exit Function
'============= Error ================
ERR_HANDLER_00:
    Call Err.Raise(Err.Number, CNST_MODULE_NAME & ".InclementIndex ← " & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)

End Function


'------------------------------------------------------------------
'プロシージャ名:  :Class_Initialize
'説明:            :オブジェクト初期化
'------------------------------------------------------------------
Private Sub Class_Initialize()
'============= Declare ==============
'============= Initiarize ===========
On Error GoTo ERR_HANDLER_00

'============= Main =================

    Call Initialize

'============= Release ==============
RESUME_00:
    Exit Sub
'============= Error ================
ERR_HANDLER_00:
    Call Err.Raise(Err.Number, CNST_MODULE_NAME & ".Class_Initialize ← " & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)

End Sub


'------------------------------------------------------------------
'プロシージャ名:  :Class_Terminate
'説明:            :オブジェクト終業
'------------------------------------------------------------------
Private Sub Class_Terminate()
'============= Declare ==============
'============= Initiarize ===========
On Error GoTo ERR_HANDLER_00

'============= Main =================



'============= Release ==============
RESUME_00:
    Exit Sub
'============= Error ================
ERR_HANDLER_00:
    Call Err.Raise(Err.Number, CNST_MODULE_NAME & ".Class_Terminate ← " & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)

End Sub
frog.raindrop.jp.knowledge

June 20, 2005

トラックバック

コメント

コメントする
