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

Alternative to Windows getprop/setprop

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

  • Chris Holbrook
    replied
    code in message #1 replaced with improved versions

    Leave a comment:


  • Chris Holbrook
    started a topic Alternative to Windows getprop/setprop

    Alternative to Windows getprop/setprop

    Here is an alternative way of maintaining a dynamic property list. You need an include file and one line of code per dialog in which these properties are used.

    demo program
    Code:
    #PBFORMS CREATED V1.51
    #COMPILE EXE
    #DIM ALL
    
    #PBFORMS BEGIN INCLUDES
    #IF NOT %DEF(%WINAPI)
        #INCLUDE "WIN32API.INC"
    #ENDIF
    #PBFORMS END INCLUDES
    
    #INCLUDE "DKWPROPS.INC"
    
    #PBFORMS BEGIN CONSTANTS
    %IDD_DIALOG2   = 101
    %IDC_LABEL1    = 104
    %IDC_SHOW_BN   = 106
    %IDC_ADDLIT_BN    = 105
    %IDC_EXISTS_BN = 107
    %IDC_LABEL2    = 108
    %IDC_LABEL3    = 109
    %IDC_LABEL4    = 110
    %IDC_NAME_TB   = 111
    %IDC_VALUE_TB  = 112
    %IDC_DEST_TB   = 113
    %IDC_get_BN    = 114
    %IDC_DEST_BN   = 115
    %IDC_LABEL5    = 117
    %IDC_STRING_TB = 118
    %IDC_ADDSTR_BN = 116
    #PBFORMS END CONSTANTS
    
    DECLARE CALLBACK FUNCTION ShowDIALOG2Proc()
    DECLARE FUNCTION ShowDIALOG2(BYVAL hParent AS DWORD) AS LONG
    #PBFORMS DECLARATIONS
    
    FUNCTION PBMAIN()
        ShowDIALOG2 %HWND_DESKTOP
    END FUNCTION
    
    CALLBACK FUNCTION ShowDIALOG2Proc()
    
        LOCAL s AS STRING
        LOCAL l, lval, ldes AS LONG
        STATIC sStrVal AS STRING
        LOCAL ps AS STRING PTR
    
        SELECT CASE AS LONG CBMSG
            CASE %WM_INITDIALOG
                DKWPropSet CBHNDL, "APPLES", 11, 0
                DKWPropSet CBHNDL, "ORANGES", 12, 1
            CASE %WM_NCACTIVATE
                STATIC hWndSaveFocus AS DWORD
                IF ISFALSE CBWPARAM THEN
                    hWndSaveFocus = GetFocus()
                ELSEIF hWndSaveFocus THEN
                    SetFocus(hWndSaveFocus)
                    hWndSaveFocus = 0
                END IF
    
            CASE %WM_COMMAND
                SELECT CASE AS LONG CBCTL
                    CASE %IDC_LABEL1
    
                    CASE %IDC_ADDLIT_BN
                        IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                            CONTROL GET TEXT CBHNDL, %IDC_VALUE_TB TO s
                            lval = VAL(s)
                            CONTROL GET TEXT CBHNDL, %IDC_DEST_TB TO s
                            ldes = VAL(s)
                            CONTROL GET TEXT CBHNDL, %IDC_NAME_TB TO s
                            IF DKWPropSet(CBHNDL, s, lval, ldes) = 1 THEN
                                CONTROL SET TEXT CBHNDL, %IDC_LABEL1, DKWPropS (CBHNDL)
                            ELSE
                                CONTROL SET TEXT CBHNDL, %IDC_LABEL1, "failed to create property " + "<" + s + ">"
                            END IF
                        END IF
    
                    CASE %IDC_ADDSTR_BN
                        IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                            CONTROL GET TEXT CBHNDL, %IDC_STRING_TB TO sStrVal
                            lval = VARPTR(sStrVal)
                            ps = lval
                            CONTROL GET TEXT CBHNDL, %IDC_DEST_TB TO s
                            ldes = VAL(s)
                            l = 1
                            SHIFT LEFT l, 24   ' set type = string ptr
                            l = l OR ldes
                            CONTROL GET TEXT CBHNDL, %IDC_NAME_TB TO s
                            IF DKWPropSet(CBHNDL, s, BYVAL lval, l) = 1 THEN
                                CONTROL SET TEXT CBHNDL, %IDC_LABEL1, DKWPropS (CBHNDL)
                            ELSE
                                CONTROL SET TEXT CBHNDL, %IDC_LABEL1, "failed to create property " + "<" + s + ">"
                            END IF
                        END IF
    
                    CASE %IDC_SHOW_BN
                        IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                            CONTROL SET TEXT CBHNDL, %IDC_LABEL1, DKWPropS (CBHNDL)
                        END IF
    
                    CASE %IDC_EXISTS_BN
                        IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                            CONTROL GET TEXT CBHNDL, %IDC_NAME_TB TO s
                            IF DKWPropIs ( CBHNDL, s) = 1 THEN
                                CONTROL SET TEXT CBHNDL, %IDC_LABEL1, s + " exists"
                            ELSE
                                CONTROL SET TEXT CBHNDL, %IDC_LABEL1, s + " does not exist"
                            END IF
                        END IF
    
                    CASE %IDC_GET_BN
                        IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                            CONTROL SET TEXT CBHNDL, %IDC_VALUE_TB, ""
                            CONTROL SET TEXT CBHNDL, %IDC_DEST_TB, ""
                            CONTROL GET TEXT CBHNDL, %IDC_NAME_TB TO s
                            IF DKWPropIs ( CBHNDL, s) <> 1 THEN  ' NB check property exists before getting its value
                                CONTROL SET TEXT CBHNDL, %IDC_LABEL1, s + " does not exist"
                                EXIT SELECT
                            END IF
                            lval = DKWPropGet( CBHNDL, s)
                            CONTROL SET TEXT CBHNDL, %IDC_VALUE_TB, STR$(lval)
                            lDes = DKWPropDestGet(CBHNDL, s)
                            IF HIBYT(HIWRD(ldes)) = 1 THEN ' it's a string ptr
                                ps = lval
                                CONTROL SET TEXT CBHNDL, %IDC_STRING_TB, @ps
                            ELSE
                                CONTROL SET TEXT CBHNDL, %IDC_STRING_TB, "n/a"
                            END IF
                            CONTROL SET TEXT CBHNDL, %IDC_DEST_TB, _
                                    HEX$(HIBYT(HIWRD( ldes))) + " " + HEX$(LOBYT(HIWRD( ldes)))
                        END IF
                    CASE %IDC_DEST_BN
                        IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                            CONTROL SET TEXT CBHNDL, %IDC_VALUE_TB, ""
                            CONTROL SET TEXT CBHNDL, %IDC_DEST_TB, ""
                            CONTROL GET TEXT CBHNDL, %IDC_NAME_TB TO s
                            IF DKWPropIs ( CBHNDL, s) <> 1 THEN  ' NB check property exists before gietting its value
                                CONTROL SET TEXT CBHNDL, %IDC_LABEL1, s + " does not exist"
                                EXIT SELECT
                            END IF
                            lval = DKWPropDestGet( CBHNDL, s)
                            CONTROL SET TEXT CBHNDL, %IDC_VALUE_TB, "?"
                            CONTROL SET TEXT CBHNDL, %IDC_DEST_TB, STR$(lval)
                        END IF
    
                END SELECT
        END SELECT
    END FUNCTION
    
    FUNCTION ShowDIALOG2(BYVAL hParent AS DWORD) AS LONG
        LOCAL lRslt AS LONG
    
    #PBFORMS BEGIN DIALOG %IDD_DIALOG2->->
        LOCAL hDlg  AS DWORD
    
        DIALOG NEW hParent, "DKW properties demo 20-MAR-2008", 70, 70, 211, 195, %WS_POPUP OR %WS_BORDER OR %WS_DLGFRAME OR _
            %WS_SYSMENU 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
        mDKW_DLG ( hdlg)
        CONTROL ADD TEXTBOX, hDlg, %IDC_NAME_TB,    "",                             55,   5,  60,  15
        CONTROL ADD TEXTBOX, hDlg, %IDC_VALUE_TB,   "",                             55,  20,  60,  15
        CONTROL ADD TEXTBOX, hDlg, %IDC_DEST_TB,    "",                             55,  35,  60,  15
        CONTROL ADD TEXTBOX, hDlg, %IDC_STRING_TB,  "",                             55,  50,  60,  15
        CONTROL ADD BUTTON,  hDlg, %IDC_ADDLIT_BN,  "Add Property, literal value",   5,  70, 110,  20
        CONTROL ADD BUTTON,  hDlg, %IDC_ADDSTR_BN,  "Add property, string address",  5,  90, 110,  20
        CONTROL ADD BUTTON,  hDlg, %IDC_SHOW_BN,    "Show Properties",               5, 110, 110,  20
        CONTROL ADD BUTTON,  hDlg, %IDC_get_BN,     "Get Value",                     5, 130, 110,  20
        CONTROL ADD BUTTON,  hDlg, %IDC_DEST_BN,    "Get Destructor",                5, 150, 110,  20
        CONTROL ADD BUTTON,  hDlg, %IDC_EXISTS_BN,  "Does property exist?",          5, 170, 110,  20
        CONTROL ADD LABEL,   hDlg, %IDC_LABEL1,     "",                            120,   5,  85, 185, _
                        %WS_CHILD OR %WS_VISIBLE OR %SS_LEFT, %WS_EX_CLIENTEDGE OR _
                        %WS_EX_LEFT OR %WS_EX_LTRREADING
        CONTROL ADD LABEL,   hDlg, %IDC_LABEL2,     "Name",                          5,   5,  50,  15
        CONTROL ADD LABEL,   hDlg, %IDC_LABEL3,     "Value",                         5,  20,  50,  15
        CONTROL ADD LABEL,   hDlg, %IDC_LABEL4,     "Info",                          5,  35,  50,  15
        CONTROL ADD LABEL,   hDlg, %IDC_LABEL5,     "String ",                       5,  50,  50,  15
    #PBFORMS END DIALOG
    
        DIALOG SHOW MODAL hDlg, CALL ShowDIALOG2Proc TO lRslt
    
    #PBFORMS BEGIN CLEANUP %IDD_DIALOG2
    #PBFORMS END CLEANUP
    
        FUNCTION = lRslt
    END FUNCTION
    
    
    #PBFORMS COPY
    Code:
    ' DKWPROPS.INC include file
    ' Chris Holbrook
    ' Mar 2008
    '===========================================================================
    ' PROPERTY HANDLING FUNCTIONS & DECLARATIONS
    ' max identifier length
    %DKW_ID_LEN = 8
    ' # of entries in table
    %DKW_ROWS_IN_TABLE = 16
    ' table element length
    %DKW_ELEMENT_LEN = 16
    '
    ' a string identifier for the single Windows property
    ' which is a pointer to a byte array(512) inside which is a table of DKWPROPERTIES
    ' every dialog with DKWproperties will need one in its WM_INITDIALOG handler
    ' or WM_CREATE handler or in the main dialog proc - anywhere after the dialog handle
    ' has been obtained. PBForms doesn't like it to be placed immediately after the
    ' DIALOG NEW statement, but this only means replcaing it after the PBForms edit which
    ' discards it.
    '
    MACRO mDKW_DLG (hD)
        STATIC DKW() AS BYTE
        DIM DKW(0 TO 511)
        fillmemory BYVAL VARPTR(DKW(0)), 512, &h20
        setprop  hD, mDKW_PROPERTY_NAME, BYVAL VARPTR(DKW(0))
    END MACRO
    ' and it must be removeProp'd when the dialog closes (in the WM_DESTROY message handler e.g.)
    MACRO mDKW_PROPERTY_NAME = "DWKPROP"
    ' No action is required to dispose of the DKWProperties array when the dialog is closed.
    ' However, to dispose of the referenced objects, the develeoper will have too
    ' loop through the table and call the appropriate (see INFO DWORD, Destroy Action Index)
    ' function to dispose of each object.
    '
    ' THE IDENTIFIER
    ' Each element starts with the identifier, left aligned and space filled
    ' into %DKW_ID_LEN bytes, no terminating null or length byte.
    
    ' the VALUE dword
    '  this is the value set by DKWPropSet and returned by DKWPropGet. It can be
    '  a literal dword value or a pointer. It is not processed by the DKWProps
    '  routines except to set and get it.
    '  offset of dword value within each element of the DKWPROPERTIES table
    %DKW_VAL_OFS = 8
    '
    ' THE INFO DWORD
    ' offset of info dword within each element of the DKWPROPERTIES table
    %DKW_INFO_OFS = 12
    ' Only the two top bytes are used.
    ' HI Destructor Action Index. an unsigned number which is used by the application
    '  to select a destructor proc for the object referenced by the VALUE dword,
    '  or as it sees fit, this is NOT REFERENCED by the DKW code except to set it
    '  and retrieve it when asked.
    ' LO Data type index. An unsigned number used by the application to determine the type
    '  of the value dword, literal, string/byte/dword pointer, etc. No values are defined
    '  herein except that 0 is a literal i.e. non-pointer type
    '
    '
    
    '---------------------------------------------------------------------------
    ' retval is zero if an error has occurred, else 1
    FUNCTION DKWPropSet ( hD AS DWORD, id AS STRING, dwval AS DWORD, DestroyAction AS DWORD) AS LONG
        LOCAL pProp         AS BYTE PTR
        LOCAL pb, pbs       AS BYTE PTR
        LOCAL pdw           AS DWORD PTR
        LOCAL s, stabid     AS STRING
        LOCAL i             AS LONG
    
    
        s =  TRIM$(id)
        IF s = "" THEN EXIT FUNCTION ' null identifier is not good
        pb = getprop(hd, mDKW_PROPERTY_NAME)
        IF pb = 0 THEN EXIT FUNCTION ' can't find the $DKWPROP property in the given dialog
        ' check that the property is not already in use
        stabid = STRING$(%DKW_ID_LEN,&H20)
        FOR i = 1 TO %DKW_ROWS_IN_TABLE
            IF @pb <> &H20 THEN
                pbs = STRPTR(stabid)
                movememory BYVAL pbs, BYVAL pb, %DKW_ID_LEN ' get string version if id from table
                IF TRIM$(stabid) = s THEN EXIT FUNCTION ' id is a duplicate
                pb = pb + %DKW_ELEMENT_LEN ' to point to next element
            ELSE
                ' pb points to the place where the new element should go
                EXIT FOR
            END IF
        NEXT
        '
        IF i = %DKW_ROWS_IN_TABLE THEN EXIT FUNCTION ' no more space in table
        ' pad the id with spaces & add 2 * 4 bytes to hold the dwords
        s = s + LEFT$(STRING$(%DKW_ID_LEN,&h20), %DKW_ID_LEN - LEN(s)) + STRING$(8,&H20)
        ' insert vlaue dword
        pdw = STRPTR(s) + %DKW_VAL_OFS
        POKE DWORD, pdw, dwval
        ' insert destructor action dword
        pdw = STRPTR(s) + %DKW_INFO_OFS
        POKE DWORD, pdw, DestroyAction
        ' we have just made a table element, insert it into to the table
        '? "insert " + trim$(left$(s,8)) + " at " + str$(pb)
        FOR i = 1 TO %DKW_ELEMENT_LEN
            POKE pb, ASC(MID$(s, i, 1))
            INCR pb
        NEXT
        FUNCTION = 1
    END FUNCTION
    '---------------------------------------------------------------------------
    ' retval is property value
    FUNCTION DKWPropGet ( hD AS DWORD, id AS STRING) AS DWORD
        LOCAL pProp         AS BYTE PTR
        LOCAL pb, pbs       AS BYTE PTR
        LOCAL pdw           AS DWORD PTR
        LOCAL s, stabid     AS STRING
        LOCAL i             AS LONG
    
        s =  TRIM$(id)
        IF s = "" THEN EXIT FUNCTION ' null identifier is not good
        pb = getprop(hd, mDKW_PROPERTY_NAME)
        IF pb = 0 THEN EXIT FUNCTION ' can't find the $DKWPROP property in the given dialog
        stabid = STRING$(%DKW_ID_LEN,&H20)
        FOR i = 1 TO %DKW_ROWS_IN_TABLE
            IF @pb <> &H20 THEN
                pbs = STRPTR(stabid)
                movememory BYVAL pbs, BYVAL pb, %DKW_ID_LEN ' get string version if id from table
                IF TRIM$(stabid) = s THEN
                    pdw = pb + %DKW_VAL_OFS
                    FUNCTION = @pdw ' return pointer to data
                    EXIT FUNCTION
                END IF
                pb = pb + %DKW_ELEMENT_LEN ' to point to next element
            ELSE
                ' pb points to the place where the new element should go
                EXIT FUNCTION
            END IF
        NEXT
        ' not found - return zero. Note warning above
    END FUNCTION
    '---------------------------------------------------------------------------
    ' retval is property value
    FUNCTION DKWPropDestGet ( hD AS DWORD, id AS STRING) AS DWORD
        LOCAL pProp         AS BYTE PTR
        LOCAL pb, pbs       AS BYTE PTR
        LOCAL pdw           AS DWORD PTR
        LOCAL s, stabid     AS STRING
        LOCAL i             AS LONG
    
        s =  TRIM$(id)
        IF s = "" THEN EXIT FUNCTION ' null identifier is not good
        pb = getprop(hd, mDKW_PROPERTY_NAME)
        IF pb = 0 THEN EXIT FUNCTION ' can't find the $DKWPROP property in the given dialog
        ' check that the property is not already in use
        stabid = STRING$(%DKW_ID_LEN,&H20)
        FOR i = 1 TO %DKW_ROWS_IN_TABLE
            IF @pb <> &H20 THEN
                pbs = STRPTR(stabid)
                movememory BYVAL pbs, BYVAL pb, %DKW_ID_LEN ' get string version if id from table
                IF TRIM$(stabid) = s THEN
                    pdw = pb + %DKW_INFO_OFS
                    FUNCTION = @pdw
                    EXIT FUNCTION
                END IF
                pb = pb + %DKW_ELEMENT_LEN ' to point to next element
            ELSE
                ' pb points to the place where the new element should go
                EXIT FUNCTION
            END IF
        NEXT
        ' not found - return zero. Note warning above
    END FUNCTION
    '---------------------------------------------------------------------------
    ' returns 1 if the property has been defined, 0 if not
    FUNCTION DKWPropIs ( hD AS DWORD, id AS STRING) AS LONG
        LOCAL pProp         AS BYTE PTR
        LOCAL pb, pbs       AS BYTE PTR
        LOCAL pdw           AS DWORD PTR
        LOCAL s, stabid     AS STRING
        LOCAL i             AS LONG
    
        s =  TRIM$(id)
        IF s = "" THEN EXIT FUNCTION ' null identifier is not good
        pb = getprop(hd, mDKW_PROPERTY_NAME)
        IF pb = 0 THEN EXIT FUNCTION ' can't find the $DKWPROP property in the given dialog
        ' check that the property is not already in use
        stabid = STRING$(%DKW_ID_LEN,&H20)
        FOR i = 1 TO %DKW_ROWS_IN_TABLE
            IF @pb <> &H20 THEN
                pbs = STRPTR(stabid)
                movememory BYVAL pbs, BYVAL pb, %DKW_ID_LEN ' get string version if id from table
                IF TRIM$(stabid) = s THEN
                    FUNCTION = 1
                    EXIT FUNCTION ' found it
                END IF
                pb = pb + %DKW_ELEMENT_LEN ' to point to next element
            ELSE
                EXIT FOR
            END IF
        NEXT
    
    END FUNCTION
    '---------------------------------------------------------------------------
    ' a debugging fn to return all property ids and values for a dialog
    FUNCTION DKWPropS ( hd AS DWORD) AS STRING
        LOCAL pProp, pb, pbs        AS BYTE PTR
        LOCAL pdw                   AS DWORD PTR
        LOCAL s, smsg               AS STRING
        LOCAL i                     AS LONG
    
        pProp = getprop(hd, mDKW_PROPERTY_NAME)
        IF pProp = 0 THEN EXIT FUNCTION
        ' find the requested property in the properties string & return its value
        pb = pProp
        FOR i = 1 TO %DKW_ROWS_IN_TABLE ' 16
            s = STRING$(8, &H20)
            IF @pb <> &H20 THEN
                pbs = STRPTR(s)
                movememory BYVAL pbs, BYVAL pb, 8 ' get string version if id from table
                pdw = pb + 8
                s = s + "," + STR$(@pdw)
                pdw = pb + %DKW_INFO_OFS
                s = s + "," + STR$(@pdw) + $CRLF
                pb = pb + 16 ' to point to next element
            ELSE
                EXIT FOR
            END IF
            smsg = smsg + s
        NEXT
        FUNCTION = smsg
    END FUNCTION
    Last edited by Chris Holbrook; 20 Mar 2008, 04:50 AM. Reason: improvements again
Working...
X