2013-06-19 07:44

' ADDRESS BOOK PANEL

     $IFDEF FRANCAIS
      CONST adfile="data\Contacts.txt" 'address data file
      CONST addeffile="data\champs contacts.txt" 'address fields definition file
     $ELSE
      CONST adfile="data\Contact Book.txt" 'address data file
      CONST addeffile="data\contact fields.txt"
     $ENDIF

     DECLARE SUB adinit
     DECLARE SUB adnewClic
     DECLARE SUB summaryclic
     DECLARE SUB findchange
     DECLARE SUB adkeydown(key AS WORD, shift AS INTEGER)
     DECLARE SUB adupdate
     DECLARE SUB combochange(sender AS QCOMBOBOX)
     DECLARE SUB filterchange
'declare sub summaryproc (Handle AS integer, uMsg AS DWORD, wParam AS LONG, lParam AS LONG)


'------------ CONTROLS
     CONST admarginW=0.06 'percentage of panel width for left+right margin+margin between fields (1/3 each)
     CONST adsummaryW=0.36 'percentage for summary
     CONST adseparW=0.06    'middle separation
     CONST adfieldW=0.52 'percentage for the 2 columns of fields (1/2 each)
     CONST adVunit=20 'line height

     CREATE AdPanel AS QPANEL
      PARENT=Tab
      left=4 : top=28
      COLOR=colorfond
      visible=false
      borderstyle=0 : bevelouter=0 : bevelinner=0
      CREATE summary AS QLISTBOX 'list of records
    'wndproc=summaryProc
       onclick=summaryclic
      END CREATE
      CREATE findlabel AS QLABEL
       CAPTION=s_Find
       alignment=taRightJustify
      END CREATE
      CREATE find AS QEDIT
       onchange=findchange
      END CREATE
      CREATE filterlabel AS QLABEL
       CAPTION=s_Filter
       alignment=taRightJustify
      END CREATE
      CREATE filter AS QCOMBOBOX
       onchange=filterchange
      END CREATE
      CREATE adnew AS QBUTTON
       CAPTION=s_New
       onclick=adnewClic
      END CREATE
     END CREATE '-- (AdPanel)

'sub summaryproc (Handle AS INTEGER, uMsg AS DWORD, wParam AS LONG, lParam AS LONG)
'showmessage("summaryproc")
'end sub

'-----------------  Address Book : data and files

     CREATE ad AS QSTRINGLIST 'database; declared in fichiers.bas
      duplicates=dupAccept
     END CREATE
     DIM adfieldlist AS QSTRINGLIST 'list of fields
     CREATE adsummarydesc AS QSTRINGLIST 'composition of Summary field (displayed in the lefthand listbox 'Summary'
      duplicates=dupError
     END CREATE
     CREATE hiddensummary AS QSTRINGLIST 'copy of Summary listbox, with also reference to ad
      duplicates=dupAccept
     END CREATE
     DIM adfield(0) AS QEDIT 'simple fields (half-line) on form
     DIM admulti(0) AS QRICHEDIT 'multiline data fields
     DIM adcombo(0) AS QCOMBOBOX 'combo boxes
     DIM adfieldlabel(0) AS QLABEL 'labels
     DIM admultilabel(0) AS QLABEL
     DIM adcombolabel(0) AS QLABEL
     DEFINT nbadfield=0 'nb of fields of each type
     DEFINT nbadmulti=0
     DEFINT nbadcombo=0
     DEFINT nbadallfield=0 'total number of fields

'-- BUILDADFIELDS   called once in GlobalInit
     SUB buildadfields  'open field list file, build adfieldlist, adsummarydesc and create field controls
      DIM s AS STRING, key AS STRING, arg AS STRING, s2 AS STRING
      DIM thisfield AS STRING, thisfieldtype AS STRING, fieldtypetag AS STRING
      DIM filterlist AS QSTRINGLIST 'categories that should show
      defaultfiltervalue=-1
      CHDIR appdir
      filterlist.clear
      IF FILEEXISTS(adDefFile)=false THEN
       adfieldlist.clear
       adfieldlist.additems("field"+CHR$(9)+"Info")
       adfieldlist.additems("summary"+CHR$(9)+"$Info")
       adfieldlist.savetofile(adDefFile)
      END IF
      adfieldlist.loadfromfile(adDefFile) 'field definition file
      x=0 : y=3
      FOR i=adfieldlist.itemcount-1 TO 0 STEP -1 'remove comment lines
       s=adfieldlist.item(i) 'ligne i du fichier de définition des champs
       IF LTRIM$(s)="" THEN
        adfieldlist.delitems(i)
       ELSEIF LEFT$(s,1)="'" THEN
        adfieldlist.delitems(i)
       END IF
      NEXT
      FOR i=0 TO adfieldlist.itemcount-1
       s=adfieldlist.item(i) 'ligne i du fichier de définition des champs
       key=LCASE$(FIELD$(s,CHR$(9),1)) : arg=FIELD$(s,CHR$(9),2)
       IF LEFT$(key,5)="multi" THEN key="multi"
       SELECT CASE key

       CASE "field","champ" 'create a simple field: syntax "field<tab>Name"
        adfieldlist.item(i)=s+CHR$(9)+STR$(nbadfield)+CHR$(9)+STR$(nbadallfield)
        REDIM adfieldlabel(nbadfield) AS QLABEL
        adfieldlabel(nbadfield).PARENT=adPanel
        adfieldlabel(nbadfield).hint=STR$(0.44+x*0.28)+" "+STR$(y)
        adfieldlabel(nbadfield).CAPTION=arg
        REDIM adfield(nbadfield) AS QEDIT
        adfield(nbadfield).PARENT=adPanel
        adfield(nbadfield).onchange=adupdate
        adfield(nbadfield).hint=STR$(0.44+x*0.28)+" "+STR$(y+1)
        IF x=0 THEN 'move to next position
         x=1
        ELSE 'and if necessary to next line
         x=0 : y=y+2.5
        END IF
        nbadallfield++
        nbadfield++

       CASE "multi" ' create a multi-line field: syntax "multi4<tab>Street Address" for 4 lines
        adfieldlist.item(i)=s+CHR$(9)+STR$(nbadmulti)+CHR$(9)+STR$(nbadallfield)
        IF x=1 THEN  'jump to next line start
         x=0 : y=y+2.5
        END IF
        multinblines=VAL(MID$(s,6,1)) 'last character of key gives number of lines of field
        REDIM admultilabel(nbadmulti) AS QLABEL
        admultilabel(nbadmulti).PARENT=adPanel
        admultilabel(nbadmulti).hint=STR$(0.44+x*0.28)+" "+STR$(y)
        admultilabel(nbadmulti).CAPTION=arg
        REDIM admulti(nbadmulti) AS QRICHEDIT
        admulti(nbadmulti).PARENT=adPanel
        admulti(nbadmulti).onchange=adupdate
        admulti(nbadmulti).hint=STR$(0.44+x*0.28)+" "+STR$(y+1)+" "+STR$(multinblines)
        x=0 : y=y+1.5+multinblines 'jump to next line
        nbadallfield++
        nbadmulti++

       CASE "combo" ' create a combo box field: syntax "combo<tab>Category"
        adfieldlist.item(i)=s+CHR$(9)+STR$(nbadcombo)+CHR$(9)+STR$(nbadallfield)
        REDIM adcombolabel(nbadcombo) AS QLABEL
        adcombolabel(nbadcombo).PARENT=adPanel
        adcombolabel(nbadcombo).hint=STR$(0.44+x*0.28)+" "+STR$(y)
        adcombolabel(nbadcombo).CAPTION=arg
        REDIM adcombo(nbadcombo) AS QCOMBOBOX
        adcombo(nbadcombo).PARENT=adPanel
        adcombo(nbadcombo).tag=nbadallfield
        adcombo(nbadcombo).onchange=combochange
        adcombo(nbadcombo).hint=STR$(0.44+x*0.28)+" "+STR$(y+1)
        IF x=0 THEN
         x=1
        ELSE
         x=0 : y=y+2.5
        END IF
        nbadallfield++
        nbadcombo++

       CASE "summary","résumé"  'summary field composition: syntax "summary<tab>description",
        'where description is a string containing field names preceded by $
        'ex: "$Name, $First Name ($Company)"
        flag=true
        arg=LCASE$(arg)
        WHILE flag
         dollarpos=INSTR(arg,"$") 'look for next $fieldname statement
'        showmessage(arg)
         IF dollarpos=0 THEN 'no more fields to insert
          adsummarydesc.additems(arg) : flag=false
         ELSE
          adsummarydesc.additems(LEFT$(arg,dollarpos-1)) 'add text preceding $fieldname
          arg=RIGHT$(arg,LEN(arg)+1-dollarpos)
          FOR j=0 TO i-1 'run through declared field names to find this one
           s2=adfieldlist.item(j) 'field description #j
           thisfield=LCASE$(FIELD$(s2,CHR$(9),2))
           thisfieldlength=LEN(thisfield)
           IF MID$(arg,2,thisfieldlength)=thisfield THEN 'if found
            thisfieldindex=VAL(FIELD$(s2,CHR$(9),4))
            thisfieldtype=LCASE$(LEFT$(s2,5))
            fieldtypetag="$"
            adsummarydesc.additems(fieldtypetag+STR$(thisfieldindex))
            arg=RIGHT$(arg,LEN(arg)-thisfieldlength-1)
            j=i 'to end loop
           END IF
          NEXT
         END IF
        WEND  'end case "summary"

       CASE "filter","filtre"  'filter values= values of combo box 0 that should be shown
        IF arg="[[def]]" THEN  'default value
         defaultfiltervalue=VAL(FIELD$(s,CHR$(9),3))
        ELSE
         filterlist.additems(arg)
        END IF

       CASE ELSE 'should be declaration of an item of a declared combo box
        FOR j=0 TO nbadallfield-1 'scan fields for field name 'key'
         s2=adfieldlist.item(j) 'field description #j
         thisfield=LCASE$(FIELD$(s2,CHR$(9),2))
         thisfieldtype=LCASE$(LEFT$(s2,5))
         IF (thisfield=key) AND (thisfieldtype="combo") THEN
          thisfieldindex=VAL(FIELD$(s2,CHR$(9),3))
          adcombo(thisfieldindex).additems(arg)
         END IF
        NEXT 'end case combo box item

       END SELECT
      NEXT 'next line in description file

'build filter combo box from data of combo box #0
      filter.clear
      IF nbadcombo<>0 THEN
    'add values of combo box #0
       FOR i=0 TO adcombo(0).itemcount-1
        filter.additems("  "+adcombo(0).item(i))
       NEXT
    'add preset values : ... Others, ... All, ... Only this one
       IF filter.item(filter.itemcount-1)<> s_filterOthers THEN filter.additems(s_filterOthers)
       filter.additems(s_filterAll)
       filter.additems(s_filterOnlythis)
    'set default, taken from filterlist
       FOR i=0 TO filter.itemcount-3
        s=LTRIM$(filter.item(i))  'if found in filterlist then check it
        IF filterlist.indexof(s)>=0 THEN
         filter.item(i)="• "+s
        ELSE
         filter.item(i)="  "+s
        END IF
       NEXT
      END IF
      filter.itemindex=defaultfiltervalue

'control lines of other combo boxes
      FOR i=0 TO nbadcombo-1
       adcombo(i).additems(s_additemtocombo, s_deletecomboitem)
      NEXT
     END SUB '--(buildAdFields)

'-- ADGETINDEX: index (in AD list) corresponding to item #i of summarylist
     FUNCTION adgetindex(i AS INTEGER) AS INTEGER
'this index is stored in field #2 of hidden summary
      adgetindex=VAL(FIELD$(hiddensummary.item(i),separ,2))
     END FUNCTION

'-- SETFIELD: set value of field control #fnum
     SUB setfield(fnum AS INTEGER, s AS STRING)
      DIM fielddesc AS STRING, fieldtype AS STRING
      fielddesc=adfieldlist.item(fnum)
      fieldtype=FIELD$(fielddesc,CHR$(9),1) 'extract type of field
      fieldtype=LCASE$(LEFT$(fieldtype,5))
      fieldnum=VAL(FIELD$(fielddesc,CHR$(9),3)) 'and field number (of its kind)
      SELECT CASE fieldtype
      CASE "champ","field"
       adfield(fieldnum).text=s
      CASE "multi"
       admulti(fieldnum).text=s
      CASE "combo"
       adcombo(fieldnum).text=s
      END SELECT
     END SUB '-(setfield)

'-- GETFIELD: get value of field control #fnum
     FUNCTION getfield(fnum AS INTEGER) AS STRING
      DIM s AS STRING
      DIM fielddesc AS STRING, fieldtype AS STRING
      fielddesc=adfieldlist.item(fnum)
      fieldtype=FIELD$(fielddesc,CHR$(9),1) 'extract field type
      fieldtype=LCASE$(LEFT$(fieldtype,5))
      fieldnum=VAL(FIELD$(fielddesc,CHR$(9),3)) 'and field number (of its kind)
      SELECT CASE fieldtype
      CASE "champ","field"
       s=adfield(fieldnum).text
      CASE "multi"
       s=admulti(fieldnum).text
      CASE "combo"
       s=adcombo(fieldnum).text
      END SELECT
      getfield=s
     END FUNCTION '-(getfield)

'-- SHOWCURRENTAD: show fields of current record
     DEFINT showingcurrentad=false
     SUB showcurrentad
      DIM record AS STRING, segment AS STRING
      showingcurrentad=true 'set to true so that setting field values does not trigger adupdate
      currentad=summary.itemindex
      adindex=VAL(FIELD$(hiddensummary.item(currentad),separ,2))
      record=ad.item(adindex)
      FOR i=0 TO nbadallfield-1
       segment=FIELD$(record,CHR$(9),i+1)
       setfield(i,segment)
      NEXT i
      showingcurrentad=false
     END SUB '--(showcurrentad)

'-- SUMMARYSTR: returns value of the summary field corresponding to record
     FUNCTION summarystr(record AS STRING) AS STRING
      DIM s AS STRING, ss AS STRING
      ss=""
      FOR i=0 TO adsummarydesc.itemcount-1
       s=adsummarydesc.item(i) 'i-th segment of summary
       IF LEFT$(s,1)="$" THEN 'insert field
        ss=ss+FIELD$(record,CHR$(9),VAL(RIGHT$(s,LEN(s)-1))+1)
       ELSE  'insert plain string
        ss=ss+s
       END IF
      NEXT
      summarystr=ss
     END FUNCTION  '--(summarystr)

'-- BUILDSUMMARY: build summary listbox
     SUB buildsummary
      DIM record AS STRING, lrecord AS STRING, searchstring AS STRING
      DIM ss AS STRING, filterStr AS STRING, state AS STRING, filterfield AS STRING
      summary.clear
      hiddensummary.clear
      searchstring=LCASE$(find.text)
      filterfieldnum=adcombo(0).tag+1  'field corresponding to combobox #0, to match against filter
      IF ad.itemcount=0 THEN ad.additems(STRING$(nbadallfield,CHR$(9)))
      FOR i=0 TO ad.itemcount-1
       record=ad.item(i)
       IF record="[[deleted]]" THEN GOTO buildsumnext
       lrecord=LCASE$(record)
       IF (find.text="") OR (INSTR(lrecord,searchstring)<>0) THEN   'filter out with Find field
    'if record passes the Find test, filter out with Filter combo box:
        showit=false
        belongstoacat=false
        filterfield=LCASE$(FIELD$(record,CHR$(9),filterfieldnum))
        FOR j=0 TO filter.itemcount-4  'find if record belongs to a category of the filter combo box
         filterStr=filter.item(j)
         state=LEFT$(filterStr,2)
         filterStr=LCASE$(MID$(filterStr,3,LEN(filterStr)-2))
         IF filterfield=filterStr THEN
          belongstoacat=true
          IF state<>"  " THEN showit=true
         END IF
        NEXT
        IF belongstoacat=false THEN  'if category not found, check if 'Other' categories should show
         filterStr=filter.item(filter.itemcount-3)
         state=LEFT$(filterStr,2)
         showit=IIF(state="  ",false,true)
        END IF
        IF showit THEN
         ss=summarystr(record)
         ss=REPLACESUBSTR$(ss,separ," # ")
         hiddensummary.additems(ss+separ+STR$(i)) 'add to list of items to show
        END IF
       END IF
buildsumnext:
      NEXT
      hiddensummary.sort  'sort
      FOR i=0 TO hiddensummary.itemcount-1   'and build summary
       summary.additems(FIELD$(hiddensummary.item(i),separ,1))
      NEXT
      summary.itemindex=0
      showcurrentad
      adupdate
     END SUB '--(buildsummary)

'-- ADINIT: show controls
     SUB adinit
      DIM s AS STRING
'Redimension controls according to window size
      adpanel.width=panelwidth: adpanel.height=panelheight
      WITH summary
       .left=panelwidth*admarginW/3
       .top=3*adVunit
       .width=panelwidth*adsummaryW
       .height=panelheight-summary.top-3*adVunit
      END WITH
      WITH findlabel
       .left=summary.left : .top=adVunit
       .width=summary.width * 0.2 : .height=adVunit
      END WITH
      WITH find
       .left=summary.left+findlabel.width : .top=adVunit
       .width=summary.width * 0.4 : .height=adVunit
      END WITH
      WITH filterlabel
       .left=summary.left : .top=summary.top+summary.height+adVunit
       .width=summary.width * 0.2 : .height=adVunit
      END WITH
      WITH filter
       .left=summary.left+findlabel.width : .top=filterlabel.top
       .width=summary.width * 0.4 : .height=adVunit
      END WITH
      WITH adnew
       .left=summary.left+summary.width*0.7 : .top=adVunit
       .width=summary.width * 0.3 : .height=adVunit
      END WITH

'Redimension data fields
      FOR i=0 TO nbadfield-1 'simple fields
       s=adfieldlabel(i).hint 'hint describes position, syntax: "x y"
       x=VAL(FIELD$(s," ",1)) : y=VAL(FIELD$(s," ",2))
       adfieldlabel(i).left=panelwidth*x : adfieldlabel(i).top=y*adVunit
       adfieldlabel(i).width=panelwidth*0.26 : adfieldlabel(i).height=adVunit
       s=adfield(i).hint 'hint describes position, syntax: "x y"
       x=VAL(FIELD$(s," ",1)) : y=VAL(FIELD$(s," ",2))
       adfield(i).left=panelwidth*x : adfield(i).top=y*adVunit
       adfield(i).width=panelwidth*0.26 : adfield(i).height=adVunit
      NEXT
      FOR i=0 TO nbadmulti-1 'multiline fields
       s=admultilabel(i).hint 'hint describes position, syntax: "x y"
       x=VAL(FIELD$(s," ",1)) : y=VAL(FIELD$(s," ",2))
       admultilabel(i).left=panelwidth*x : admultilabel(i).top=y*adVunit
       admultilabel(i).width=panelwidth*0.26 : admultilabel(i).height=adVunit
       s=admulti(i).hint 'hint describes position and nb of lines, syntax: "x y h"
       x=VAL(FIELD$(s," ",1)) : y=VAL(FIELD$(s," ",2)) : h=VAL(FIELD$(s," ",3))
       admulti(i).left=panelwidth*x : admulti(i).top=y*adVunit
       admulti(i).width=panelwidth*0.54 : admulti(i).height=adVunit*h
      NEXT
      FOR i=0 TO nbadcombo-1 'combo boxes
       s=adcombolabel(i).hint 'hint describes position, syntax: "x y"
       x=VAL(FIELD$(s," ",1)) : y=VAL(FIELD$(s," ",2))
       adcombolabel(i).left=panelwidth*x : adcombolabel(i).top=y*adVunit
       adcombolabel(i).width=panelwidth*0.26 : adcombolabel(i).height=adVunit
       s=adcombo(i).hint 'hint describes position, syntax: "x y"
       x=VAL(FIELD$(s," ",1)) : y=VAL(FIELD$(s," ",2))
       adcombo(i).left=panelwidth*x : adcombo(i).top=y*adVunit
       adcombo(i).width=panelwidth*0.26 : adcombo(i).height=adVunit
      NEXT
'get address records
      ad.clear
      CHDIR appdir
      IF FILEEXISTS(adFile)<>false THEN
       ad.loadfromfile(adFile)
       FOR i=ad.itemcount-1 TO 0 STEP -1
        s=ad.item(i)
        IF s="" THEN
         ad.delitems(i)
        ELSE
         s=REPLACESUBSTR$(s,crSubst,crString)
         ad.item(i)=s
        END IF
       NEXT
      END IF
      buildsummary
'menu enables
      fileprint.enabled=false
      editnew.enabled=true
      edituse.enabled=true
      menuicon.enabled=false
      editall.enabled=false
      editfind.enabled=false
      editfindnext.enabled=false
      setfocus(find.handle)
     END SUB   '--(ADinit)

'-- SUMMARYCLIC: select item in summary listbox
     SUB summaryclic
      showcurrentad
     END SUB

'-- FINDCHANGE: rebuild summary
     SUB findchange
      buildsummary
     END SUB

'-- ADUPDATE: update data, ie create record string from field values
     SUB adupdate
      DIM record AS STRING, segment AS STRING, ss AS STRING
      IF showingcurrentad THEN EXIT SUB 'do nothing if building data fields
'condense field values into record string
      record=""
      FOR i=0 TO nbadallfield-1
       segment=getfield(i)
       IF i<>0 THEN record=record+CHR$(9)
       record=record+segment
      NEXT i
      currentad=summary.itemindex  'current item position in summary
      adindex=adgetindex(currentad) 'corresponding position in ad list
      ad.item(adindex)=record
      ss=summarystr(record)
      summary.item(currentad)=ss  'update summary with new string
      hiddensummary.item(currentad)=ss+separ+STR$(adindex) 'and hidden summary with new string (same adindex)
     END SUB

'-- FOCUSFIRSTFIELD: 'give focus to first field
     SUB focusfirstfield
      DIM h AS LONG
      DIM fielddesc AS STRING, fieldtype AS STRING
      fielddesc=adfieldlist.item(0)
      fieldtype=FIELD$(fielddesc,CHR$(9),1)
      fieldtype=LCASE$(LEFT$(fieldtype,5))
      SELECT CASE fieldtype
      CASE "champ","field"
       h=adfield(0).handle
      CASE "multi"
       h=admulti(0).handle
      CASE "combo"
       h=adcombo(0).handle
      END SELECT
      setfocus(h)
     END SUB

'-- ADNEWCLIC: create new record
     SUB adnewclic
      DIM blankrecord AS STRING, blanksumm AS STRING
      blankrecord=STRING$(nbadallfield,CHR$(9))
      blanksumm=summarystr(blankrecord) 'corresponding summary string
'create blank record
      ad.additems(blankrecord)
      summary.insertitem(0,blanksumm)
      hiddensummary.insertitem(0,blanksumm+separ+STR$(ad.itemcount-1))
      summary.itemindex=0
      showcurrentad
      focusfirstfield
     END SUB

'-- ADSAVE: save address book
     DIM s AS STRING, key AS STRING, comboboxname AS STRING
     SUB adsave
'save records
      ad.sort
      FOR i=ad.itemcount-1 TO 0 STEP -1  'scan records. kill deleted records; remove carriage returns
       s=ad.item(i)
       IF s="[[deleted]]" THEN
        ad.delitems(i)
       ELSE
        s=REPLACESUBSTR$(s,crString,crSubst)
        ad.item(i)=s
       END IF
      NEXT
      CHDIR appdir
      ad.savetofile(adFile)
'save comboboxes contents:
'scan field definition file
      DIM fieldef AS QSTRINGLIST
      fieldef.duplicates=dupAccept
      fieldef.loadfromfile(adDefFile)
      FOR i=0 TO fieldef.itemcount-1 'loop while file lines are field definitions or comments
       s=fieldef.item(i)
       IF LTRIM$(s)="" THEN GOTO nextadsavei
       IF LEFT$(s,1)="'" THEN GOTO nextadsavei
       key=LCASE$(FIELD$(s,CHR$(9),1))
       IF LEFT$(key,5)="multi" THEN GOTO nextadsavei
       IF (key="field")OR(key="champ")OR(key="multi")OR(key="combo")OR(key="summary")OR(key="résumé") THEN GOTO nextadsavei
       EXIT FOR
nextadsavei:
      NEXT
'reach beginning of combo box value definition
      FOR j=i TO fieldef.itemcount-1 'delete all subsequent lines
       fieldef.delitems(i)
      NEXT
'and replace them with new combo box presets
      FOR i=0 TO nbadcombo-1
       combofieldnb=adcombo(i).tag 'field number of current combo box
       comboboxname=FIELD$(adfieldlist.item(combofieldnb),CHR$(9),2)
       FOR j=0 TO adcombo(i).itemcount-3 'save all combo box items but the last 2 ones (Add/Delete)
        fieldef.additems(comboboxname+CHR$(9)+adcombo(i).item(j))
       NEXT
      NEXT
'and filter settings
      FOR i=0 TO filter.itemcount-3
       s=filter.item(i)
       IF LEFT$(s,2)="• " THEN fieldef.additems("filtre"+CHR$(9)+s-"• ")
      NEXT
      IF filter.itemindex>=0 THEN fieldef.additems("filtre"+CHR$(9)+"[[def]]"+CHR$(9)+STR$(filter.itemindex))
      fieldef.savetofile(adDefFile)
     END SUB

'-- FILTERCHANGE: user selects other value in filter combo box
     DEFINT previouscat=-1
     SUB filterchange
      DIM s AS STRING, state AS STRING
      i=filter.itemindex
      SELECT CASE i
      CASE filter.itemcount-2  'last item but one =show all
       FOR j=0 TO filter.itemcount-3
        s=filter.item(j)
        s="• "+MID$(s,3,LEN(s)-2)
        filter.item(j)=s
        previouscat=i
       NEXT
      CASE filter.itemcount-1 'last item = only current family
       IF (previouscat=-1)OR(previouscat>filter.itemcount-3) THEN EXIT SUB
       FOR j=0 TO filter.itemcount-3
        s=filter.item(j)
        state=IIF(j=previouscat,"• ","  ")
        s=state+MID$(s,3,LEN(s)-2)
        filter.item(j)=s
       NEXT
      CASE ELSE  'other item=toggle it
       s=filter.item(i)
       state=LEFT$(s,2)
       state=IIF(state="  ","• ","  ")
       s=state+MID$(s,3,LEN(s)-2)
       filter.item(i)=s
       previouscat=i
      END SELECT
      filter.itemindex=previouscat
      filter.text=s
      buildsummary 'update summary
     END SUB

'-- COMBOCHANGE: change combo box
     SUB combochange(sender AS QCOMBOBOX)
      DIM previousvalue AS STRING, currentrecord AS STRING
'find which combo box
      whichfield=sender.tag
      whichbox=VAL(FIELD$(adfieldlist.item(whichfield),CHR$(9),3))
'find previous value of combo box
      currentrecordnb=VAL(FIELD$(hiddensummary.item(summary.itemindex),separ,2))
      currentrecord=ad.item(currentrecordnb)
      previousvalue=FIELD$(currentrecord,CHR$(9),whichfield+1)
'find previous itemindex in combobox corresponding to combobox item previousvalue
      previouscomboindex=-1
      FOR i=0 TO adcombo(whichbox).itemcount-1
       IF adcombo(whichbox).item(i)=previousvalue THEN previouscomboindex=i
      NEXT

      itemindexfromend=adcombo(whichbox).itemcount-1-adcombo(whichbox).itemindex
'item chosen, numbered from the end. last item (--Delete)=0; last but one (--Add)=1
      SELECT CASE itemindexfromend
      CASE 0 'Delete item from combobox
       IF previouscomboindex=-1 THEN
        SHOWMESSAGE("'"+previousvalue+"' "+s_combodeleteimpossible)
        adcombo(whichbox).itemindex=-1
        adupdate
       ELSEIF MESSAGEDLG(s_combodeleteconfirm+" '"+previousvalue+"' ?", mtWarning, mbYes OR mbNo, 0) = mrYes THEN 'confirm dialog
            'delete item
        adcombo(whichbox).delitems(previouscomboindex)
        adcombo(whichbox).itemindex=-1
            'if in combo box 0, delete from filter combo box
        IF whichbox=0 THEN filter.delitems(previouscomboindex)
        adupdate 'update summary
       ELSE 'don't delete item and restore it
        adcombo(whichbox).itemindex=previouscomboindex
       END IF
      CASE 1 'Add item to combobox
       IF previouscomboindex<>-1 THEN  'value is already a predefined value of the combobox
        SHOWMESSAGE("'"+previousvalue+"' "+s_comboalreadyexists) 'say it can't add it
        adcombo(whichbox).itemindex=previouscomboindex
       ELSE
            'add previousvalue to the combobox
        whereto=adcombo(whichbox).itemcount-2
        adcombo(whichbox).insertitem(whereto,previousvalue)
            'and select it
        adcombo(whichbox).itemindex=adcombo(whichbox).itemcount-3
            'if in combo box 0, add to filter combo box
        IF whichbox=0 THEN filter.insertitem(whereto,"• "+previousvalue)
       END IF
      CASE ELSE
    'not the last 2 items
       adupdate 'the user chose another value in the combobox -> simply update record
      END SELECT
     END SUB

'-- ADDELETE: delete address record
     SUB addelete
      currentad=summary.itemindex  'current position in summary
      adindex=adgetindex(currentad) 'corresponding position in ad
      ad.item(adindex)="[[deleted]]" 'mark record as deleted
      hiddensummary.delitems(currentad) 'and remove it from summary
      summary.delitems(currentad)
      showcurrentad
     END SUB

'-- ADFINDFOCUS: find which field has the focus, return its type, number, and selection
     SUB adfindfocus(byref fieldtype AS STRING, byref fieldnum AS INTEGER, byref selecttext AS STRING)
      DIM fielddesc AS STRING
      DIM h AS LONG
      h=getfocus 'currently focused item
      FOR i=0 TO nbadallfield-1  'scan all fields
       fielddesc=adfieldlist.item(i) 'get field definition
       fieldtype=FIELD$(fielddesc,CHR$(9),1) 'its type
       fieldtype=LCASE$(LEFT$(fieldtype,5))
       fieldnum=VAL(FIELD$(fielddesc,CHR$(9),3)) 'and its index
       SELECT CASE fieldtype
       CASE "champ","field"
        IF adfield(fieldnum).handle=h THEN
         selecttext=adfield(fieldnum).seltext
         EXIT SUB
        END IF
       CASE "multi"
        IF admulti(fieldnum).handle=h THEN
         selecttext=admulti(fieldnum).seltext
         EXIT SUB
        END IF
'        case "combo"     'doesn't work : combo boxes don't get focus
'            if adcombo(fieldnum).handle=h then
'                selecttext=adcombo(fielnum).text
'                exit sub
'            end if
       END SELECT
      NEXT
'if sub hasn't been exited then= no field was selected
'look if the find field has focus :
      IF find.handle=h THEN
       fieldtype="find"
       selecttext=find.seltext
      ELSE
       fieldtype=""
      END IF
     END SUB '-(adfindfocus)

'-- ADCUT: cut
     SUB adcut
'if summary is active --> cut whole record
      IF getfocus=summary.handle THEN
       adindex=adgetindex(summary.itemindex)
       clipboard.text=ad.item(adindex)
       adDelete
       EXIT SUB
      END IF
'if summary not active --> look for selected text in focused field
      DIM selecttext AS STRING, fieldtype AS STRING
      DIM fieldnum AS INTEGER
      adfindfocus(fieldtype,fieldnum,selecttext) 'get focused field number
      IF fieldtype="" THEN EXIT SUB 'no field selected -> nothing to do
'copy selected text to clipboard
      clipboard.text=selecttext
'and cut it
      SELECT CASE fieldtype
      CASE "champ","field"
       adfield(fieldnum).seltext=""
      CASE "multi"
       admulti(fieldnum).seltext=""
'        case "combo"
'            adcombo(fieldnum).seltext=""
      CASE "find"
       find.seltext=""
      END SELECT
     END SUB '-(adcut)

'-- ADCOPY: copy
     SUB adcopy
'if summary is active --> copy whole record
      IF getfocus=summary.handle THEN
       adindex=adgetindex(summary.itemindex)
       clipboard.text=ad.item(adindex)
       EXIT SUB
      END IF
'if summary not active --> look for selected text in focused field
      DIM selecttext AS STRING, fieldtype AS STRING
      DIM fieldnum AS INTEGER
      adfindfocus(fieldtype,fieldnum,selecttext) 'get focused field number
      IF fieldtype="" THEN EXIT SUB 'no field selected -> nothing to do
'else copy selected text to clipboard
      clipboard.text=selecttext
     END SUB

'-- ADPASTE: paste
     SUB adpaste
      DIM s AS STRING, summs AS STRING
      s=clipboard.text
'if clipboard consists of the right number of fields, tab-separated
      IF TALLY(s,CHR$(9))=nbadallfield-1 THEN
'THEN paste as new record
       ad.additems(s)
       summs=summarystr(s)
       summary.insertitem(0,summs)
       summary.itemindex=0
       hiddensummary.insertitem(0,summs+separ+STR$(ad.itemcount-1))
       showcurrentad
       focusfirstfield
      ELSE
       IF INSTR(s,CHR$(9))<>0 THEN s=FIELD$(s,CHR$(9),1) 'keep only first field of clipboard text
'else look for active field
       DIM selecttext AS STRING, fieldtype AS STRING
       DIM fieldnum AS INTEGER
       adfindfocus(fieldtype,fieldnum,selecttext) 'get focused field number
       IF fieldtype="" THEN EXIT SUB 'no field selected -> nothing to do
       SELECT CASE fieldtype
       CASE "champ","field"
        adfield(fieldnum).seltext=s
       CASE "multi"
        admulti(fieldnum).seltext=s
'        case "combo"
'            adcombo(fieldnum).text=s
       CASE "find"
        find.seltext=s
       END SELECT
      END IF
     END SUB '-(adpaste)

'--ADUSE: find and use data field
     SUB aduse
      DIM s AS STRING
'look for focused field
      DIM selecttext AS STRING, fieldtype AS STRING
      DIM fieldnum AS INTEGER
      adfindfocus(fieldtype,fieldnum,selecttext) 'get focused field number
      IF fieldtype="" THEN EXIT SUB 'no field selected --> do nothing
      SELECT CASE fieldtype
      CASE "champ","field"
       s=adfield(fieldnum).seltext     'if some text is selected, use it. Else :
       IF s="" THEN 'for simple fields: use whole field
        s=adfield(fieldnum).text
        adfield(fieldnum).selstart=0
        adfield(fieldnum).sellength=LEN(s)
       END IF
      CASE "find"
       s=find.seltext
       IF s="" THEN
        s=find.text
        find.selstart=0
        find.sellength=LEN(s)
       END IF
      CASE "multi"
       s=admulti(fieldnum).seltext
       IF s="" THEN
        s=admulti(fieldnum).line(admulti(fieldnum).wherey) 'for multilines: get current line
        admulti(fieldnum).selstart=admulti(fieldnum).selstart-admulti(fieldnum).wherex
        admulti(fieldnum).sellength=LEN(s)
       END IF
'        case "combo"
'            s=adcombo(fieldnum).text
      END SELECT
      use(s)
     END SUB '-(aduse)

'-- ADpageup: move up 1 record
     SUB adpageup
      index=summary.itemindex
      IF index<>0 THEN
       summary.itemindex=index-1
       showcurrentad
       focusfirstfield
      END IF
     END SUB '-(adpageup)

'-- ADpagedown: move down 1 record
     SUB adpagedown
      index=summary.itemindex
      IF index<>summary.itemcount-1 THEN
       summary.itemindex=index+1
       showcurrentad
       focusfirstfield
      END IF
     END SUB '-(adpagedown)

'-- adkeydown: handle keydown : check for carriage returns, tabs, escape
     SUB adkeydown(key AS WORD, shift AS INTEGER)
      SELECT CASE key
      CASE 13 : adupdate
      CASE 33 : adpageup 'PageUp
      CASE 34 : adpagedown 'PageDown
      END SELECT
     END SUB

'-- adprint
     SUB adprint
      SHOWMESSAGE(s_addontprint)
     END SUB

2013-06-19 07:44