Store Cheklistbox Value in a field

[handoko]

Hi.
I want to make a checklistbox class with field in the controlsource represent the checklistbox value.

Here is my code, I use listbox.
I use a field C(5) with '0' or '1' value.
Maximum checklistbox option is 5 equal to length of the field.

Example: Value in the field='11001'
In Checklistbox shows:
-----------------
[X] CHECK1
[X] CHECK2
[ ] CHECK3
[ ] CHECK4
[X] CHECK5
-----------------
ROWSOURCETYPE IS VALUE

-------------------------------------------
PROC CHECKLISTBOX1.INIT
PUBLIC MAXOPTIONS
MAXOPTIONS=10
PUBLIC ARRAY SELECTEDINDEX(MAXOPTIONS)
PUBLIC fieldname
FIELDNAME=THIS.CONTROLSOURCE
FOR I=1 TO MAXOPTIONS
OPTIONS= SUBSTR(&FIELDNAME,i,1)
IF OPTIONS='1'
SELECTEDINDEX=.T.
ELSE
SELECTEDINDEX=.F.
ENDIF
ENDFOR
ENDPROC
--------------------------------------------
PROC CHECKLISTBOX1.INTERAKTIFCHANGE
FIELDNAME=THIS.CONTROLSOURCE
SELECTEDINDEX[THIS.LISTINDEX]=NOT SELECTEDINDEX[THIS.LISTINDEX]
newdata=&fieldname

IF SELECTEDINDEX[THIS.LISTINDEX]
newdata=SUBSTR(NEWDATA,1,THIS.ListIndex-1)+'1'+SUBSTR(NEWDATA,THIS.ListIndex+1,MAXOPTIONS-THIS.LISTINDEX)

REPLACE &FIELDNAME WITH newdata
ELSE
newdata=SUBSTR(NEWDATA,1,THIS.ListIndex-1)+'0'+SUBSTR(NEWDATA,THIS.ListIndex+1,MAXOPTIONS-THIS.LISTINDEX)

REPLACE &FIELDNAME WITH newdata
ENDIF

THIS.REFRESH
ENDPROC
--------------------------------------------
PROC CHECKLISTBOX1.REFRESH
FOR I=1 TO MAXOPTIONS
IF SELECTEDINDEX
THIS.Picture=ALLTRIM(SYS(5))+'\BITMAP\CROSSSMALLE.JPG'
ELSE
THIS.Picture=ALLTRIM(SYS(5))+'\BITMAP\EMPTYSMALL.JPG'
ENDIF
ENDFOR
ENDPROC
--------------------------------------------

The problem is the field value change to 'CHECK1'.
Is my way correct? If it's not, how?

Thank you guys.

 

[handoko]

Guys. I found the answer.
I make a newcontrolsource property that do not bind the listbox value directy.

See yaa

 

[darrellblackhawk]

You may want to consider changing the char bitfield to
a numeric field and using the bittest() function.

It's much faster.

example:

lv = 0x13

FOR i = 4 TO 0 STEP -1
? BITTEST(lv,i)
NEXT




'We all must do the hard bits so when we get bit we know where to bite'

 

[darrellblackhawk]

Here's a more extensive example:

[tt]
oForm = CREATEOBJECT("MyForm&quot
oForm.SHOW()
READ EVENTS


DEFINE CLASS MyForm AS FORM

DOCREATE = .T.
AUTOCENTER = .T.
CAPTION = "Using numeric field as a bitfield to drive a check list control"
WIDTH = 500
DATASESSION = 2

ADD OBJECT chkList AS chkList WITH ;
LEFT = 20, ;
TOP = 10

ADD OBJECT txtBitField AS TEXTBOX WITH ;
LEFT = 100, ;
TOP = THIS.chkList.TOP, ;
CONTROLSOURCE = "Test.BitField"

ADD OBJECT cmdNav AS RecordNav WITH ;
TOP = 120, ;
LEFT = THIS.chkList.LEFT

PROCEDURE LOAD
CREATE CURSOR Test (bitfield N(2))
FOR i = 0 TO 2^5-1
INSERT INTO test (bitfield) VALUES (i)
NEXT
GO TOP
ENDPROC

PROCEDURE DESTROY
CLEAR EVENTS
ENDPROC

ENDDEFINE


* Custom CheckList Control Class

DEFINE CLASS chkList AS CONTROL

CONTROLSOURCE = "Test.BitField"
VALUE = 0
CONTROLCOUNT = 5

ADD OBJECT check1 AS chk
ADD OBJECT check2 AS chk
ADD OBJECT check3 AS chk
ADD OBJECT check4 AS chk
ADD OBJECT check5 AS chk

PROCEDURE INIT
LOCAL i
FOR i = THIS.CONTROLCOUNT TO 1 STEP -1
THIS.CONTROLS(i).VISIBLE = .T.
THIS.CONTROLS(i).TOP = IIF(i<5,THIS.CONTROLS(i+1).TOP+THIS.CONTROLS(i+1).HEIGHT,0)
THIS.CONTROLS(i).CAPTION = &quot;Bit&quot;+STR(i,1)
NEXT
THIS.HEIGHT = THIS.CONTROLS(1).TOP+THIS.CONTROLS(1).HEIGHT
THIS.WIDTH = THIS.CONTROLS(1).LEFT+THIS.CONTROLS(1).WIDTH
THIS.REFRESH()
ENDPROC

PROCEDURE REFRESH
THIS.VALUE = EVAL(THIS.CONTROLSOURCE)
LOCAL i
FOR i = THIS.CONTROLCOUNT TO 1 STEP -1
THIS.CONTROLS(i).VALUE = BITTEST(THIS.VALUE,i-1)
NEXT
ENDPROC

PROCEDURE SetValue
LOCAL lnNewValue, i
lnNewValue = 0
FOR i = THIS.CONTROLCOUNT TO 1 STEP -1
lnNewValue = lnNewValue + IIF(THIS.CONTROLS(i).VALUE,1,0)*2^(i-1)
NEXT
THIS.VALUE = lnNewValue
REPLACE (JUSTEXT(THIS.CONTROLSOURCE)) WITH THIS.VALUE IN (JUSTSTEM(THIS.CONTROLSOURCE))
THISFORM.REFRESH()
ENDPROC
ENDDEFINE


* Custom Checkbox Class

DEFINE CLASS chk AS CHECKBOX

PROCEDURE CLICK
THIS.PARENT.SetValue()
ENDPROC

ENDDEFINE


* Record Navigation Class

DEFINE CLASS RecordNav AS COMMANDGROUP

BUTTONCOUNT = 4

PROCEDURE INIT
LOCAL i
FOR i = 1 TO THIS.BUTTONCOUNT
THIS.BUTTONS(i).HEIGHT = 27
THIS.BUTTONS(i).WIDTH = 40
THIS.BUTTONS(i).CAPTION = IIF(i==1,&quot;<<&quot;,IIF(i==2,&quot;<&quot;,IIF(i==3,&quot;>&quot;,&quot;>>&quot))
THIS.BUTTONS(i).TOP = 0
THIS.BUTTONS(i).LEFT = IIF(i==1,0,THIS.BUTTONS(i-1).LEFT+THIS.BUTTONS(i-1).WIDTH+1)
NEXT
THIS.AUTOSIZE = .T.
ENDPROC

PROCEDURE CLICK
DO CASE
CASE THIS.VALUE == 1
GO TOP
CASE THIS.VALUE == 2
SKIP -1
IF BOF()
GO BOTTOM
ENDIF
CASE THIS.VALUE == 3
SKIP
IF EOF()
GO TOP
ENDIF
CASE THIS.VALUE == 4
GO BOTTOM
ENDCASE
THISFORM.REFRESH()
ENDPROC
ENDDEFINE
[/tt]

Darrell

'We all must do the hard bits so when we get bit we know where to bite'

 

[handoko]

Thanks you Darrell.
I'll use your code.
Thanks Again

Handoko