LongStackC.inc - Long Stack Class - Hybrid COM object

[Stanley Durham]

Long Stack Class

uses an error handler: ErrT (in download source)
local e as ErrT
o.Initialize(e)

hybrid object needs internal memory allocated before use:
o.Alloc()
internal memory must be freed before object goes out of scope:
o.Free()

Source: LongStack.zip: Long Stack Class. > http://deadtheorywalking.com/pb.aspx
public domain - use at own risk
need to download all files to compile

[Stanley Durham]

'PB 5/9 .02
'LongStackC.inc
'
'   Long Stack Class - Hybrid COM Object
'
#Include Once "LongListC.inc"
'
Macro LongStackC_ErrStatus(exitWhat) = If pe = %null Or @pe.err Then Exit exitWhat
'
Class LongStackC
    Instance pe As ErrT Ptr
    Instance cList As LongListI
    '
    Class Method Create()
        cList = Class "LongListC"
    End Method
    '
    Interface LongStackI : Inherit IUnknown
        '
        Method Initialize(e As ErrT)
            'set error handler
            pe = VarPtr(e)
            cList.Initialize(e)
        End Method
        '
        Method Alloc()
            'allocate new instance
            LongStackC_ErrStatus(Method)
            cList.Alloc()
        End Method
        '
        Method Free()
            'free instance
            LongStackC_ErrStatus(Method)
            cList.Free()
        End Method
        '
        Property Get Ptr() As Long
            'get current instance
            LongStackC_ErrStatus(Property)
            Property = cList.Ptr
        End Property
        '
        Property Set Ptr(ByVal hMem As Long)
            'set current instance
            LongStackC_ErrStatus(Property)
            cList.Ptr = hMem
        End Property
        '
        Method Clear()
            'clear stack
            LongStackC_ErrStatus(Method)
            cList.Clear()
        End Method
        '
        Method Count() As Long
            LongStackC_ErrStatus(Method)
            Method = cList.Count()
        End Method
        '
        Method Push(ByVal v As Long)
            'push value on top of stack
            LongStackC_ErrStatus(Method)
            cList.Add(v)
        End Method
        '
        Method Peek() As Long
            'get top item on stack
            LongStackC_ErrStatus(Method)
            Local node As LongListNodeCT Ptr
            node = cList.Last()
            If node Then
                Method = @node.value
            End If
        End Method
        '
        Method Pop() As Long
            'pop top item off stack
            LongStackC_ErrStatus(Method)
            Local node As LongListNodeCT Ptr
            node = cList.Last()
            If node Then
                Method = @node.value
                cList.Remove(node)
            End If
        End Method
        '
    End Interface
    '
End Class
'

[Stanley Durham]

test/sample - need to download all files to compile

'PB 9
%ErrHaltActive = 1
$TestSource = "LongStackC.bas"
$TestTitle = "Long Stack Class Test"
#Compile Exe "LongStackC.exe"
#Dim All
#Optimize Speed
#If Not %Def(%WINAPI)
    #Include Once "WIN32API.INC"
#EndIf
#Include Once "PBForms.INC"
#Include "LongStackC.inc"
'
%Dlg1    =  101
%BtnTest = 1002
%Lbx     = 1001
'
Global lbx As ListBoxI
Global tmr As TimerI
'
Sub BtnTest(ByVal hDlg As Long)
    Local i As Long
    Local e As ErrT
    Local stack As LongStackI : stack = Class "LongStackC" : stack.Initialize(e)
    Local s As String
    '
    lbx.Clear(2)
    '
    stack.Alloc()
    '
    lbx.Add("push 5 value on stack")
    '
    For i = 1 To 5
        stack.Push(i)
    Next i
    '
    While stack.Count()
        s = "Peek = "
        s += Format$(stack.Peek())
        s += " | "
        s += "Pop = "
        s += Format$(stack.Pop())
        lbx.Add(s)
    Wend
    '
    stack.Free()
    '
    lbx.Add("")
    lbx.Add("done...")
End Sub
'
Function PBMain()
    ShowDlg1 %HWND_Desktop
End Function
CallBack Function ShowDlg1Proc()
    Select Case As Long CbMsg
        Case %WM_InitDialog
             lbx = Class "ListBoxC"
             lbx.INI(Cb.Hndl, %Lbx)
             lbx.SetHorizontal(1000)
             tmr = Class "TimerC"
        Case %WM_Command
            Select Case As Long CbCtl
                Case %BtnTest
                    If CbCtlMsg = %BN_Clicked Or CbCtlMsg = 1 Then
                        BtnTest(Cb.Hndl)
                    End If
            End Select
    End Select
End Function
Function ShowDlg1(ByVal hParent As Dword) As Long
    Local lRslt  As Long
    Local hDlg   As Dword
    Local hFont1 As Dword
    Dialog New hParent, $TestTitle, 67, 61, 341, 241, %WS_Popup _
        Or %WS_Border Or %WS_DlgFrame Or %WS_Caption Or %WS_SysMenu Or _
        %WS_MinimizeBox Or %WS_ClipSiblings Or %WS_Visible Or %DS_ModalFrame _
        Or %DS_3DLook Or %DS_NoFailCreate Or %DS_SetFont, _
        %WS_Ex_ControlParent Or %WS_Ex_Left Or %WS_Ex_LtrReading Or _
        %WS_Ex_RightScrollbar, To hDlg
    Control Add ListBox, hDlg, %Lbx, , 5, 5, 330, 210, %WS_Child Or _
        %WS_Visible Or %WS_HScroll Or %WS_VScroll Or %LBS_Notify Or _
        %LBS_NoIntegralHeight, %WS_Ex_ClientEdge Or %WS_Ex_Left Or _
        %WS_Ex_LtrReading Or %WS_Ex_RightScrollbar
    Control Add Button,  hDlg, %BtnTest, "Test", 275, 220, 60, 15
    hFont1 = PBFormsMakeFont("Courier New", 9, 400, %FALSE, %FALSE, %FALSE, _
        %ANSI_CHARSET)
    Control Send hDlg, %Lbx, %WM_SETFONT, hFont1, 0
    Dialog Show Modal hDlg, Call ShowDlg1Proc To lRslt
    DeleteObject hFont1
    Function = lRslt
End Function
Class ListBoxC
    Instance meHDlg As Long
    Instance meID As Long
    Interface ListBoxI
        Inherit IUnknown
        Method INI(ByVal hDlg As Long, ByVal Id As Long)
            meHDlg = hDlg
            meID = Id
        End Method
        Method SetHorizontal(ByVal Count As Long)
            Local hCntrl&
            Control Handle meHDlg, meID To hCntrl&
            SendMessage hCntrl&, %LB_SETHORIZONTALEXTENT, Count, 0
        End Method
        Method Clear(Opt doEventsCount As Long)
            ListBox Reset meHDlg, meID
            If VarPtr(doEventsCount) Then me.DoEventsCount(doEventsCount)
        End Method
        Method Add(ByVal s As String, Opt doEventsCount As Long) As String
            ListBox Add meHDlg, meID, s
            If VarPtr(doEventsCount) Then me.DoEventsCount(doEventsCount)
        End Method
    End Interface
    Class Method DoEventsCount(ByVal Count As Long)
        Local i As Long
        For i = 1 To Count
            Dialog DoEvents
        Next i
    End Method
End Class
Class TimerC
    Instance meTime As Double
    Interface TimerI
        Inherit IUnknown
        Method Start()
            meTime = Timer
        End Method
        Method Get() As String
            Method = "    Time: " + Format$(Timer - meTime, "###.###############")
        End Method
    End Interface
End Class