-
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 COPYCode:' 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
Leave a comment: