Announcement

Collapse
No announcement yet.

Objects using Dialog Boxes to edit properties

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

  • Objects using Dialog Boxes to edit properties

    Hey Guys,

    I've been puzzled about something Bob wrote in one of the sticky's in the Objects forum. It was called "What is an Object anyway?"

    Specifically this...

    For example, a string array containing names and addresses (data) might be packaged with a subroutine (code) that displays a popup dialog to edit the data, another subroutine (code) to print mailing labels, and so forth. That's a great candidate for an object.
    How on earth do you implement a dialog box inside an object? Well this is the best I could come up and hopefully some of you can also jump in here with ideas.

    Code:
    #COMPILER PBWIN
    #COMPILE EXE
    #DIM ALL
    
    #INCLUDE ONCE "Win32api.inc"
    
    
    '==============================================================================
    ' Constants
    '------------------------------------------------------------------------------
    %IDC_CONTACTS = 1000
    %IDC_NAME = 1001
    %IDC_ADDRESS = 1002
    %IDC_PHONE = 1003
    %IDC_EMAIL = 1004
    %IDC_INSERT = 1005
    %IDC_UPDATE = 1006
    %IDC_DELETE = 1007
    %IDC_STATIC = -1
    
    
    
    '==============================================================================
    ' Get contacts interface from dialog handle
    '------------------------------------------------------------------------------
    FUNCTION GetContacts(BYVAL hDlg AS LONG) AS IContacts
        DIM Contacts    AS IContacts
        DIM dwPointer   AS DWORD
    
        DIALOG GET USER hDlg, 0 TO dwPointer
        IF (dwPointer) THEN
            POKE DWORD, VARPTR(Contacts), dwPointer
            IF ISOBJECT(Contacts) THEN
                Contacts.AddRef()
                FUNCTION = Contacts
            END IF
        END IF
    END FUNCTION
    
    
    
    '==============================================================================
    ' Contacts Dialog Box Handler
    '------------------------------------------------------------------------------
    CALLBACK FUNCTION ContactsProc()
        DIM Contacts    AS IContacts
        DIM dwObject    AS DWORD
    
    
        'Get contacts object interface
        Contacts = GetContacts(CB.HNDL)
        IF ISNOTHING(Contacts) THEN
            IF (CB.MSG = %WM_COMMAND) THEN
                IF (CB.CTL = %IDCANCEL) THEN
                    IF (CB.CTLMSG = %BN_CLICKED) THEN
                        DIALOG END CB.HNDL, 0
                    END IF
                END IF
            END IF
    
            EXIT FUNCTION
        END IF
    
    
        'Process message
        SELECT CASE AS LONG CBMSG
            CASE %WM_INITDIALOG
                FUNCTION = Contacts.OnInitDialog(CB.HNDL, CB.WPARAM, CB.LPARAM)
    
            CASE %WM_DESTROY
                FUNCTION = Contacts.OnDestroy(CB.WPARAM, CB.LPARAM)
    
            CASE %WM_COMMAND
                FUNCTION = Contacts.OnCommand(CB.WPARAM, CB.LPARAM)
        END SELECT
    END FUNCTION
    
    
    
    
    '==============================================================================
    ' Contact Entry Class
    '------------------------------------------------------------------------------
    CLASS CEntry
        INSTANCE m_szName       AS STRING
        INSTANCE m_szAddress    AS STRING
        INSTANCE m_szPhone      AS STRING
        INSTANCE m_szEmail      AS STRING
    
    
        INTERFACE IEntry
            INHERIT IUNKNOWN
    
            '----------------------------------------------------------------------
            'Get name
            '----------------------------------------------------------------------
            PROPERTY GET NAME() AS STRING
                PROPERTY = m_szName
            END PROPERTY
    
            '----------------------------------------------------------------------
            'Set name
            '----------------------------------------------------------------------
            PROPERTY SET NAME(BYVAL szName AS STRING)
                m_szName = szName
            END PROPERTY
    
            '----------------------------------------------------------------------
            'Get Address
            '----------------------------------------------------------------------
            PROPERTY GET Address() AS STRING
                PROPERTY = m_szAddress
            END PROPERTY
    
            '----------------------------------------------------------------------
            'Set Address
            '----------------------------------------------------------------------
            PROPERTY SET Address(BYVAL szAddress AS STRING)
                m_szAddress = szAddress
            END PROPERTY
    
            '----------------------------------------------------------------------
            'Get Phone
            '----------------------------------------------------------------------
            PROPERTY GET Phone() AS STRING
                PROPERTY = m_szPhone
            END PROPERTY
    
            '----------------------------------------------------------------------
            'Set Phone
            '----------------------------------------------------------------------
            PROPERTY SET Phone(BYVAL szPhone AS STRING)
                m_szPhone = szPhone
            END PROPERTY
    
            '----------------------------------------------------------------------
            'Get Email
            '----------------------------------------------------------------------
            PROPERTY GET Email() AS STRING
                PROPERTY = m_szEmail
            END PROPERTY
    
            '----------------------------------------------------------------------
            'Set Email
            '----------------------------------------------------------------------
            PROPERTY SET Email(BYVAL szEmail AS STRING)
                m_szEmail = szEmail
            END PROPERTY
        END INTERFACE
    END CLASS
    
    
    
    
    '==============================================================================
    ' Contacts Class
    '------------------------------------------------------------------------------
    CLASS CContacts
        INSTANCE m_Entry()  AS IEntry
        INSTANCE m_hDlg     AS LONG
    
    
        '--------------------------------------------------------------------------
        ' Append entry to array
        '--------------------------------------------------------------------------
        CLASS METHOD APPEND(Entry AS IEntry) AS LONG
            DIM lRow    AS LONG
    
            TRY 'Check entry object
                IF ISNOTHING(Entry) THEN ERROR %ERR_OBJECTERROR
    
                lRow = UBOUND(m_Entry)
                INCR lRow
    
                REDIM PRESERVE m_Entry(lRow)
                m_Entry(lRow) = Entry
    
                METHOD = %TRUE
            CATCH
                METHOD = %FALSE
            END TRY
        END METHOD
    
    
        '--------------------------------------------------------------------------
        ' Remove entry from array
        '--------------------------------------------------------------------------
        CLASS METHOD Remove(BYVAL lRow AS LONG) AS LONG
            DIM lMinRow     AS LONG
            DIM lMaxRow     AS LONG
    
            TRY 'Get array bounds
                lMinRow = LBOUND(m_Entry)
                lMaxRow = UBOUND(m_Entry)
    
                'Check row against array bounds
                IF (lRow < lMinRow) THEN ERROR %ERR_SUBSCRIPTPOINTEROUTOFRANGE
                IF (lRow > lMaxRow) THEN ERROR %ERR_SUBSCRIPTPOINTEROUTOFRANGE
    
                'Release object
                m_Entry(lRow) = NOTHING
    
                'Allocate dword array over object array and delete element
                REDIM Index(lMinRow TO lMaxRow) AS DWORD AT VARPTR(m_Entry(lMinRow))
                ARRAY DELETE Index(lRow)
    
                'Reallocate object array
                IF (lMinRow = lMaxRow) THEN
                    ERASE m_Entry()
                ELSE
                    DECR lMaxRow
                    REDIM PRESERVE m_Entry(lMinRow TO lMaxRow)
                END IF
    
                'Success
                METHOD = %TRUE
            CATCH
                METHOD = %FALSE
            END TRY
        END METHOD
    
    
    
    
        INTERFACE IContacts
            INHERIT IUNKNOWN
    
    
            '----------------------------------------------------------------------
            ' Initialize contacts with some data
            '----------------------------------------------------------------------
            METHOD Initialize() AS LONG
                DIM Entry   AS IEntry
                DIM lIndex  AS LONG
    
    
                'Read data into array
                FOR lIndex = 1 TO DATACOUNT STEP 4
                    Entry = CLASS "CEntry"
                    IF ISOBJECT(Entry) THEN
                        Entry.Name      = READ$(lIndex + 0)
                        Entry.Address   = READ$(lIndex + 1)
                        Entry.Phone     = READ$(lIndex + 2)
                        Entry.Email     = READ$(lIndex + 3)
    
                        me.Append(Entry)
                    END IF
                NEXT
    
    
                'Contact data
                DATA "Dasher", "North Pole", "(123) 456-7890", "[email protected]"
                DATA "Dancer", "North Pole", "(123) 456-7890", "[email protected]"
                DATA "Prancer", "North Pole", "(123) 456-7890", "[email protected]"
                DATA "Vixen", "North Pole", "(123) 456-7890", "[email protected]"
                DATA "Comet", "North Pole", "(123) 456-7890", "[email protected]"
                DATA "Cupid", "North Pole", "(123) 456-7890", "[email protected]"
                DATA "Donner", "North Pole", "(123) 456-7890", "[email protected]"
                DATA "Blitzen", "North Pole", "(123) 456-7890", "[email protected]"
            END METHOD
    
    
    
    
            '----------------------------------------------------------------------
            ' Show dialog box
            '----------------------------------------------------------------------
            METHOD ShowDialog() AS LONG
                DIM dwStyleEx   AS DWORD
                DIM dwStyle     AS DWORD
                DIM lResult     AS LONG
    
    
                'Setup listbox styles
                dwStyle     = %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %WS_VSCROLL OR %LBS_NOTIFY OR %LBS_NOINTEGRALHEIGHT
                dwStyleEx   = %WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
    
    
                'Create dialog box and add controls
                DIALOG NEW 0, "Contacts", 70, 70, 201, 151, TO m_hDlg
                CONTROL ADD LISTBOX, m_hDlg, %IDC_CONTACTS, , 5, 5, 190, 55, dwStyle, dwStyleEx
                CONTROL ADD LABEL,   m_hDlg, %IDC_STATIC, "Name:", 5, 65, 55, 10
                CONTROL ADD LABEL,   m_hDlg, %IDC_STATIC, "Address:", 5, 80, 55, 10
                CONTROL ADD LABEL,   m_hDlg, %IDC_STATIC, "Phone #:", 5, 95, 55, 10
                CONTROL ADD LABEL,   m_hDlg, %IDC_STATIC, "Email:", 5, 110, 55, 10
                CONTROL ADD TEXTBOX, m_hDlg, %IDC_NAME, "", 65, 65, 130, 10
                CONTROL ADD TEXTBOX, m_hDlg, %IDC_ADDRESS, "", 65, 80, 130, 10
                CONTROL ADD TEXTBOX, m_hDlg, %IDC_PHONE, "", 65, 95, 130, 10
                CONTROL ADD TEXTBOX, m_hDlg, %IDC_EMAIL, "", 65, 110, 130, 10
                CONTROL ADD BUTTON,  m_hDlg, %IDC_INSERT, "Insert", 5, 130, 45, 15
                CONTROL ADD BUTTON,  m_hDlg, %IDC_UPDATE, "Update", 55, 130, 45, 15
                CONTROL ADD BUTTON,  m_hDlg, %IDC_DELETE, "Delete", 105, 130, 45, 15
                CONTROL ADD BUTTON,  m_hDlg, %IDCANCEL, "Close", 155, 130, 40, 15
    
    
                'Assign ME object pointer to dialog user data
                DIALOG SET USER m_hDlg, 0, OBJPTR(ME)
    
                'Show dialog box
                DIALOG SHOW MODAL m_hDlg, CALL ContactsProc TO lResult
                METHOD = lResult
            END METHOD
    
    
            '----------------------------------------------------------------------
            ' Refresh ListBox contents
            '----------------------------------------------------------------------
            METHOD ReloadListBox() AS LONG
                DIM Entry   AS IEntry
                DIM lIndex  AS LONG
                DIM lRow    AS LONG
    
    
                'Check dialog handle
                IF (m_hDlg = 0) THEN
                    METHOD = %FALSE
                    EXIT METHOD
                END IF
    
                'Save current selection and reset content
                LISTBOX GET SELECT m_hDlg, %IDC_CONTACTS TO lIndex
                LISTBOX RESET m_hDlg, %IDC_CONTACTS
    
                'Add entry strings to listbox
                FOR lRow = 0 TO UBOUND(m_Entry)
                    Entry = m_Entry(lRow)
                    IF ISOBJECT(Entry) THEN
                        LISTBOX ADD m_hDlg, %IDC_CONTACTS, Entry.Name & ", " & Entry.Address
                        LISTBOX SET USER m_hDlg, %IDC_CONTACTS, (lRow + 1), lRow
                        Entry = NOTHING
                    END IF
                NEXT
    
                'Restore selection
                LISTBOX SELECT m_hDlg, %IDC_CONTACTS, MIN(lIndex, UBOUND(m_Entry) + 1)
    
            END METHOD
    
    
            '----------------------------------------------------------------------
            ' Reset name, address, phone and email controls
            '----------------------------------------------------------------------
            METHOD ResetControls() AS LONG
                IF (m_hDlg) THEN
                    CONTROL SET TEXT m_hDlg, %IDC_NAME, ""
                    CONTROL SET TEXT m_hDlg, %IDC_ADDRESS, ""
                    CONTROL SET TEXT m_hDlg, %IDC_PHONE, ""
                    CONTROL SET TEXT m_hDlg, %IDC_EMAIL, ""
                END IF
            END METHOD
    
    
            '----------------------------------------------------------------------
            ' Update dialog box controls
            '----------------------------------------------------------------------
            METHOD UpdateControls() AS LONG
                DIM Entry   AS IEntry
                DIM lIndex  AS LONG
                DIM lRow    AS LONG
    
    
                'Check dialog handle
                IF (m_hDlg = 0) THEN
                    METHOD = %FALSE
                    EXIT METHOD
                END IF
    
                'Get currently selected item index
                LISTBOX GET SELECT m_hDlg, %IDC_CONTACTS TO lIndex
                IF (lIndex = 0) THEN
                    CONTROL DISABLE m_hDlg, %IDC_UPDATE
                    CONTROL DISABLE m_hDlg, %IDC_DELETE
                    me.ResetControls()
                ELSE
                    CONTROL ENABLE m_hDlg, %IDC_UPDATE
                    CONTROL ENABLE m_hDlg, %IDC_DELETE
    
                    LISTBOX GET USER m_hDlg, %IDC_CONTACTS, lIndex TO lRow
    
                    IF (lRow < LBOUND(m_Entry)) OR (lRow > UBOUND(m_Entry)) THEN
                        me.ResetControls()
                        METHOD = %FALSE
                        EXIT METHOD
                    END IF
    
    
                    Entry = m_Entry(lRow)
                    IF ISNOTHING(Entry) THEN
                        me.ResetControls()
                        METHOD = %FALSE
                        EXIT METHOD
                    END IF
    
                    CONTROL SET TEXT m_hDlg, %IDC_NAME, Entry.Name
                    CONTROL SET TEXT m_hDlg, %IDC_ADDRESS, Entry.Address
                    CONTROL SET TEXT m_hDlg, %IDC_PHONE, Entry.Phone
                    CONTROL SET TEXT m_hDlg, %IDC_EMAIL, Entry.Email
                END IF
            END METHOD
    
    
    
            '----------------------------------------------------------------------
            ' Handle WM_INITDIALOG
            '----------------------------------------------------------------------
            METHOD OnInitDialog(BYVAL hDlg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
                m_hDlg = hDlg
                me.ReloadListBox()
                me.UpdateControls()
                METHOD = %TRUE
            END METHOD
    
    
            '----------------------------------------------------------------------
            ' Handle WM_DESTROY
            '----------------------------------------------------------------------
            METHOD OnDestroy(BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
                METHOD = %TRUE
            END METHOD
    
    
            '----------------------------------------------------------------------
            ' Handle WM_COMMAND
            '----------------------------------------------------------------------
            METHOD OnCommand(BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
                DIM wMessage    AS WORD
                DIM hListBox    AS DWORD
                DIM lRow        AS LONG
                DIM lIndex      AS LONG
                DIM Entry       AS IEntry
    
                DIM szName      AS STRING
                DIM szAddress   AS STRING
                DIM szPhone     AS STRING
                DIM szEmail     AS STRING
    
    
                'Extract control message
                wMessage = HI(WORD, wParam)
    
    
                SELECT CASE LO(WORD, wParam)
                    CASE %IDC_INSERT
                        IF (wMessage = %BN_CLICKED) THEN
                            Entry = CLASS "CEntry"
                            IF ISOBJECT(Entry) THEN
                                CONTROL GET TEXT m_hDlg, %IDC_NAME TO szName
                                CONTROL GET TEXT m_hDlg, %IDC_ADDRESS TO szAddress
                                CONTROL GET TEXT m_hDlg, %IDC_PHONE TO szPhone
                                CONTROL GET TEXT m_hDlg, %IDC_EMAIL TO szEmail
    
                                IF LEN(szName) THEN
    
                                    Entry.Name = szName
                                    Entry.Address = szAddress
                                    Entry.Phone = szPhone
                                    Entry.Email = szEmail
    
                                    IF me.Append(Entry) THEN
                                        me.ReloadListBox()
                                    END IF
                                END IF
                            END IF
                        END IF
    
    
                    CASE %IDC_UPDATE
                        IF (wMessage = %BN_CLICKED) THEN
    
                            'Get currently selected row
                            LISTBOX GET SELECT m_hDlg, %IDC_CONTACTS TO lIndex
                            IF (lIndex = 0) THEN
                                me.UpdateControls()
                                EXIT METHOD
                            END IF
    
                            'Get index from item data
                            LISTBOX GET USER m_hDlg, %IDC_CONTACTS, lIndex TO lRow
    
                            'Check index against entry array bounds
                            IF (lRow < LBOUND(m_Entry)) THEN EXIT METHOD
                            IF (lRow > UBOUND(m_Entry)) THEN EXIT METHOD
    
                            'Get entry reference
                            Entry = m_Entry(lRow)
                            IF ISNOTHING(Entry) THEN
                                EXIT METHOD
                            END IF
    
                            'Update entry data
                            CONTROL GET TEXT m_hDlg, %IDC_NAME TO szName
                            CONTROL GET TEXT m_hDlg, %IDC_ADDRESS TO szAddress
                            CONTROL GET TEXT m_hDlg, %IDC_PHONE TO szPhone
                            CONTROL GET TEXT m_hDlg, %IDC_EMAIL TO szEmail
    
                            IF LEN(szName) THEN
                                Entry.Name = szName
                                Entry.Address = szAddress
                                Entry.Phone = szPhone
                                Entry.Email = szEmail
    
                                me.ReloadListBox()
                                me.UpdateControls()
                            END IF
                        END IF
    
    
                    CASE %IDC_DELETE
                        IF (wMessage = %BN_CLICKED) THEN
                            'Get currently selected row
                            LISTBOX GET SELECT m_hDlg, %IDC_CONTACTS TO lIndex
                            IF (lIndex = 0) THEN
                                me.UpdateControls()
                                EXIT METHOD
                            END IF
    
                            'Get index from item data
                            LISTBOX GET USER m_hDlg, %IDC_CONTACTS, lIndex TO lRow
    
                            'Check index against entry array bounds
                            IF (lRow < LBOUND(m_Entry)) THEN EXIT METHOD
                            IF (lRow > UBOUND(m_Entry)) THEN EXIT METHOD
    
                            me.Remove(lRow)
                            me.ReloadListBox()
                            me.UpdateControls()
                        END IF
    
    
                    CASE %IDC_CONTACTS
                        IF (wMessage = %LBN_SELCHANGE) THEN
                            me.UpdateControls()
                        END IF
    
    
                    CASE %IDCANCEL
                        IF (wMessage = %BN_CLICKED) THEN
                            DIALOG END m_hDlg, 0
                        END IF
    
                END SELECT
            END METHOD
        END INTERFACE
    END CLASS
    
    
    
    '==============================================================================
    ' Application entry point
    '------------------------------------------------------------------------------
    FUNCTION PBMAIN() AS LONG
        DIM Contacts    AS IContacts
    
        Contacts = CLASS "CContacts"
        IF ISOBJECT(Contacts) THEN
            Contacts.Initialize()
            Contacts.ShowDialog()
        END IF
    END FUNCTION
    Start as you mean to go on.

  • #2
    Nicely DONE Mark :top:

    I have been trying to figure this one out too, and your code shows me hints of "Its Possible". (Although I have not had time to fully develop ideas yet).

    I can almost see some ideas for handling events as objects, but still not sure if the dialog belongs to the object that created it? or 1 dialog that each object can access????

    (Just a working train of thought)
    Engineer's Motto: If it aint broke take it apart and fix it

    "If at 1st you don't succeed... call it version 1.0"

    "Half of Programming is coding"....."The other 90% is DEBUGGING"

    "Document my code????" .... "WHYYY??? do you think they call it CODE? "

    Comment


    • #3
      Hey Cliff,

      Thanks for kind words and ideas. I'm thinking pretty much the same as you. A before B or B before A kinda thing. When you generalize this you basically want the Window/Dialog to share the same instance as the object.

      I think I'll take a crack at this again tonight when everyone else is in bed.

      Hopefully some of the other guys can join in to figure out the "right" way to do this.

      Start as you mean to go on.

      Comment


      • #4
        I think what Bob means is that your object (which may contain properties and methods) can use a dialog box to perform certain tasks.

        So: Object Customer might have properties to set the name, address, transactions etc. and might have a method called ShowBalance.

        Pseudocode:

        Dim Fred as Customer
        Fred.Name = "Santa"
        Fred.Transactions.add(1)
        Fred.Transactions.add(2)
        Fred.Transactions.add(-10)
        Fred.Showbalance() 'would open a dialog box showing the figure -7

        The only real question would be one of coding style. Some people would argue that the object should not open a dialog box but instead just return a value so that the main program could choose how to display it. Others see that as a waste of code because the object could handle that for you.

        Comment


        • #5
          That appears to be a nice working example... meaning, it really belongs in the Source Code Forum.

          You could ask the webmaster to move it, but I'd probably just re-post it there and edit this post to provide a link.


          MCM
          Michael Mattias
          Tal Systems (retired)
          Port Washington WI USA
          [email protected]
          http://www.talsystems.com

          Comment

          Working...
          X