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

StringC.inc - Hybrid COM String Class

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

  • Stanley Durham
    replied
    test/sample
    Code:
    'PB 9
    %ErrHaltActive = 1
    $TestSource = "StringC.bas"
    $TestTitle = "String Class Test"
    #Compile Exe "StringC.exe"
    #Dim All
    #Optimize Speed
    #If Not %Def(%WINAPI)
        #Include Once "WIN32API.INC"
    #EndIf
    #Include Once "PBForms.INC"
    #Include "StringC.inc"
    '
    %Dlg1    =  101
    %BtnTest = 1002
    %Lbx     = 1001
    '
    Global lbx As ListBoxI
    Global tmr As TimerI
    '
    Sub BtnTest(ByVal hDlg As Long)
        Local e As ErrT
        Local s As StringI : s = Class "StringC" : s.Initialize(e)
        Local pz As Asciiz Ptr
        '
        lbx.Clear(2)
        '
        '   hybrid COM object - must be allocated before use
        s.Alloc()
        '
        '
        lbx.Add("")
        lbx.Add("set string: 'testing'")
        s.Str = "testing"
        lbx.Add("append; ' 123'")
        s.Str = s.Str + " 123"
        lbx.Add("string = " + $Dq + s.Str + $Dq)
        '
        lbx.Add("string Len() = " + Format$(s.Len))
        lbx.Add("Count() = " + Format$(s.Count))
        '
        lbx.Add("")
        lbx.Add("get ASCIIZ ptr")
        pz = s.StrPtr
        lbx.Add("@pz = " + $Dq + @pz + $Dq)
        '
        lbx.Add("")
        lbx.Add("set buffer: " + $Dq + "123" + $Dq)
        s.Buffer = "123"
        lbx.Add("buffer = " + $Dq + s.Buffer + $Dq)
        lbx.Add("Count() = " + Format$(s.Count))
        '
        '
        '   hybrid COM object - must free internal memory before object goes out of scope
        s.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
    'StringC.inc
    '
    '   Dynamic String Class - Hybrid COM Object
    '
    #Include Once "GlobalMem.inc"
    '
    %StringC_Hash = 1795437505
    '
    Macro StringC_ErrStatus(exitWhat) = If pe = %null Or @pe.err Then Exit exitWhat
    Macro StringC_ExitIf(test, message, exitWhat)
        If test Then
            Err_Set @pe, %ErrUndefined, "StringC.inc", "StringC", "StringI", FuncName$, message
            Exit exitWhat
        End If
    End Macro
    '
    Type StringCT
        hash As Long
        Count As Long
        bytes As Byte Ptr
    End Type
    '
    Class StringC
        Instance p As StringCT Ptr
        Instance pe As ErrT Ptr
        '
        Interface StringI : Inherit IUnknown
            '
            Method Initialize(e As ErrT)
                'set error handler
                pe = VarPtr(e)
            End Method
            '
            Method Alloc()
                'allocate new instance
                StringC_ErrStatus(Method)
                p = GMem_Alloc(SizeOf(@p), @pe)
                If @pe.err Then Exit Method
                @p.hash = %StringC_Hash
            End Method
            '
            Method Free()
                'free instance
                StringC_ErrStatus(Method)
                If p Then
                    me.Clear()
                    p = GMem_Free(p, @pe)
                End If
            End Method
            '
            Property Get Ptr() As Long
                'get current instance
                StringC_ErrStatus(Property)
                Property = p
            End Property
            '
            Property Set Ptr(ByVal hMem As Long)
                'set current instance
                StringC_ErrStatus(Property)
                p = hMem
                If p Then
                    StringC_ExitIf(@p.hash <> %StringC_Hash, "invalid instance handle", Property)
                End If
            End Property
            '
            Method Clear()
                'null string
                StringC_ErrStatus(Method)
                StringC_ExitIf(p = %null, "null instance", Method)
                If @p.bytes Then @p.bytes = GMem_Free(@p.bytes, @pe)
                @p.bytes = %null
                @p.count = 0
            End Method
            '
            Property Get Count() As Long
                'get stored byte count
                '   strings stored with added null; o.Count() includes null
                '   buffers stored as is
                StringC_ErrStatus(Property)
                StringC_ExitIf(p = %null, "null instance", Property)
                Property = @p.count
            End Property
            '
            Property Get Str() As String
                'get string
                StringC_ErrStatus(Property)
                StringC_ExitIf(p = %null, "null instance", Property)
                If @p.count > 1 Then Property = Peek$(@p.bytes, @p.count - 1)
            End Property
            '
            Property Set Str(In ByRef v As String)
                'set string - null added to end of string
                StringC_ErrStatus(Property)
                StringC_ExitIf(p = %null, "null instance", Property)
                If @p.bytes Then @p.bytes = GMem_Free(@p.bytes, @pe)
                @p.count = Len(v) + 1
                @p.bytes = GMem_Alloc(@p.count, @pe)
                If @pe.err Then Exit Property
                Poke$ @p.bytes, v
            End Property
            '
            Property Get Len() As Long
                'get string length
                StringC_ErrStatus(Property)
                StringC_ExitIf(p = %null, "null instance", Property)
                If @p.count Then Property = @p.count - 1
            End Property
            '
            Method Compare(In ByRef v As String, Opt ByVal upperCase As Long) As Long
                'compare stored string to v
                'string = v : method = 0
                'string < v : method < 0
                'string > v : method > 0
                Local i, theEnd As Long
                Local cA, cB As Long
                Local lenA, lenB As Long
                Local result As Long
                Local pB As Byte Ptr
                '
                StringC_ErrStatus(Method)
                StringC_ExitIf(p = %null, "null instance", Method)
                '
                lenA = IIf&(@p.count, @p.count - 1, 0)
                lenB = Len(v)
                If lenA = 0 Then
                    Method = IIf&(lenB, -1, 0)
                ElseIf lenB = 0 Then
                    Method = 1
                Else
                    theEnd = Min&(lenA, lenB) - 1
                    pB = StrPtr(v)
                    If upperCase Then
                        For i = 0 To theEnd
                            cA = @[email protected][i] : If cA>96 And cA<123 Then cA -= 32
                            cB = @pB[i]       : If cB>96 And cB<123 Then cB -= 32
                            result = cA - cB
                            If result Then
                                Method = result
                                Exit Method
                            End If
                        Next i
                    Else
                        For i = 0 To theEnd
                            cA = @[email protected][i]
                            cB = @pB[i]
                            result = cA - cB
                            If result Then
                                Method = result
                                Exit Method
                            End If
                        Next i
                    End If
                    Method = lenA - lenB
                End If
            End Method
            '
            Property Get StrPtr() As Long
                'get pointer to stored string
                StringC_ErrStatus(Property)
                StringC_ExitIf(p = %null, "null instance", Property)
                Property = @p.bytes
            End Property
            '
            Property Get Buffer() As String
                'get stored buffer
                StringC_ErrStatus(Property)
                StringC_ExitIf(p = %null, "null instance", Property)
                If @p.count Then Property = Peek$(@p.bytes, @p.count)
            End Property
            '
            Property Set Buffer(In ByRef v As String)
                StringC_ErrStatus(Property)
                StringC_ExitIf(p = %null, "null instance", Property)
                If @p.bytes Then @p.bytes = GMem_Free(@p.bytes, @pe)
                @p.count = Len(v)
                If @p.count Then
                    @p.bytes = GMem_Alloc(@p.count, @pe)
                    Poke$ @p.bytes, v
                End If
            End Property
            '
        End Interface
        '
    End Class
    '

    Leave a comment:


  • Stanley Durham
    started a topic StringC.inc - Hybrid COM String Class

    StringC.inc - Hybrid COM String Class

    Dynamic String Class - Hybrid COM Object

    the object may be store/restored in any LONG
    h = o.Ptr : o.Ptr = h
    so, you can store the dynamic string object in a UDT

    Hybrid COM Object:
    - must allocate internal memory before using object; o.Alloc()
    - must free allocated memory before object goes out of scope; o.Free()

    object also needs to be initialized with an error handler before use;
    local e as ErrT 'Error.inc
    o.Initialize(e)

    same error handler should be used for all hybrid objects.

    This seems like a lot of trouble at first, but the "hybrid" concept allows
    you to build lightweight class, list/trees/stacks, with millions if instances
    and still use them as PB COM objects.
    cal also be stored and passed as a Long.

    Hybrid COM Object is basically like C++, New & Delete; except only the
    internal UDT is allocated and freed - not the whole object.

    all source and sample/test app: StringC.zip
    http://deadtheorywalking.com/pb.aspx
    public domain - use at your own risk

    Note: you need to download source to compile
    error and memory lib not posted
Working...
X