文字列を格納できるスタックです。
キューのときのコードをかなり流用しています。
コード:
' StrStackクラス:文字列を格納するスタック
'
' Push(String) 要素の挿入
' Get() As String 最も新しく挿入された要素の取得
' Pop() 最も新しく挿入された要素の破棄
' LastError() As Long 最後に実行したメンバ関数が失敗している時は1,それ以外は0を返す
Type _StrStack_Sub
lpBuf As BytePtr
lpNext As *_StrStack_Sub
End Type
Class StrStack
Private
first As *_StrStack_Sub ' スタックの先頭
Error As Long ' エラーの有無
' スタックの各要素を破棄(再帰呼出使用)
Sub FreeStrStack(lpStackElem As *_StrStack_Sub)
' NULLの場合
If lpStackElem=NULL Then Exit Sub
' 文字列領域を破棄
If lpStackElem->lpBuf<>NULL Then
free(lpStackElem->lpBuf)
End If
' 1つ先の要素にFreeStrStackをかける
FreeStrStack(lpStackElem->lpNext)
' 要素本体を破棄
free(lpStackElem)
End Sub
Public
' コンストラクタ
Sub StrStack()
'first=NULL
'Error=0
End Sub
' デストラクタ
Sub ~StrStack()
FreeStrStack(first)
End Sub
' 要素の挿入
Sub Push(buf As String)
Dim lpNewElem As *_StrStack_Sub
lpNewElem=malloc(SizeOf(_StrStack_Sub))
If lpNewElem=NULL Then
Error=1
Exit Sub
End If
' 挿入された要素に文字列を書き込む
lpNewElem->lpNext=first
lpNewElem->lpBuf=malloc(Len(buf)+1)
lstrcpy(lpNewElem->lpBuf, StrPtr(buf))
first=lpNewElem
Error=0
End Sub
' 末尾の要素の取得
Function Get() As String
' 要素が1つもない場合
If first=NULL Then
Error=1
Get=""
Exit Sub
End If
Get=MakeStr(first->lpBuf)
Error=0
End Function
' 末尾の要素の破棄
Sub Pop()
Dim lpSQTmp As *_StrStack_Sub
' 要素が1つもない場合
If first=NULL Then
Error=1
Exit Sub
End If
lpSQTmp=first
first=first->lpNext
' 文字列領域を破棄
If lpSQTmp->lpBuf<>NULL Then
free(lpSQTmp->lpBuf)
End If
' 要素本体を破棄
free(lpSQTmp)
Error=0
End Sub
Function LastError() As Long
LastError=Error
End Function
End Class
_________________
' ============================================================
' Sinryow Game Home Page -
http://www.sinryow.net/
' Sinryow ActiveBasic Center -
http://ab.sinryow.net/
' ============================================================