Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

LongStackC.inc - Long Stack Class - Hybrid COM object

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Stanley Durham
    replied
    test/sample - need to download all files to compile

    Code:
    '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

    Leave a comment:


  • Stanley Durham
    replied
    Code:
    '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
    '

    Leave a comment:


  • LongStackC.inc - Long Stack Class - Hybrid COM object

    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
Working...
X