2013-06-19 07:44

' LISTS PANEL


     $IFDEF FRANCAIS
      CONST trfile="data\Notes.txt" 'tree data file
'const trStrFile="data\struct listes.txt" ' tree structure file
'const trAppFile="data\affich listes.txt" ' tree appearance file
     $ELSE
      CONST trfile="data\Notes.txt" 'tree data file
'const trStrFile="data\lists struct.txt" ' tree structure file
'const trAppFile="data\lists displ.txt" ' tree appearance file
     $ENDIF

     DECLARE SUB trinit
     DECLARE SUB trnewclic
     DECLARE SUB treeclic
'declare sub trfindchange
     DECLARE SUB trkeydown(key AS WORD, shift AS INTEGER)
     DECLARE SUB trtextchange
     DECLARE SUB treechange(i AS INTEGER)

'------------ CONTROLS
     CONST trmarginW=0.06 'percentage of panel width for left+right margin (1/2 each)
     CONST trtreeW=0.22 'percentage for tree
     CONST trseparW=0.03    'middle separation
     CONST trtextW=0.69 'percentage for text
     CONST trVunit=20    'line height

     CREATE TrPanel AS QPANEL
      PARENT=Tab
      left=4 : top=28
      COLOR=colorfond
      visible=false
      borderstyle=0 : bevelouter=0 : bevelinner=0
      CREATE tree AS QTREEVIEW 'list of records
       showhint=false
       onchange=treechange
        'onclick=treeclic
      END CREATE
      CREATE texttree AS QTREEVIEW 'invisible tree with the same structure as tree, containing the text
       visible=false
       'top=250
      END CREATE
      CREATE trtext AS QRICHEDIT
       wanttabs=true
       onchange=trtextchange
      END CREATE
'    create trfindlabel as qlabel
'        caption=s_Find
'        alignment=taRightJustify
'    end create
'    create trfind as qedit
'        onchange=trfindchange
'    end create
      CREATE trnew AS QBUTTON
       CAPTION=s_New
       onclick=trnewclic
      END CREATE
     END CREATE '-- (TrPanel)

'disable treeview hints
' From: Lance (9/19/02 6:37:11 pm)
     CONST GWL_STYLE=-16
     CONST TVS_NOTOOLTIPS=&H80
     DECLARE FUNCTION SetWindowLong LIB "user32" ALIAS "SetWindowLongA" (hwnd AS LONG, nIndex AS LONG, dwNewLong AS LONG) AS LONG
     DECLARE FUNCTION GetWindowLong LIB "user32" ALIAS "GetWindowLongA" (hwnd AS LONG, nIndex AS LONG) AS LONG
     SetWindowLong(Tree.Handle, GWL_STYLE, GetWindowLong(Tree.Handle, GWL_STYLE) OR TVS_NOTOOLTIPS)


'-- TRINIT: show controls
     SUB trinit
'Redimension controls according to window size
      trpanel.width=panelwidth: trpanel.height=panelheight
      WITH tree
       .left=panelwidth*trmarginW/2
       .top=trVunit*2
       .width=panelwidth*trtreeW
       .height=panelheight-tree.top-trVunit
      END WITH
      WITH trtext
       .left=panelwidth*(trmarginW/2+trtreeW+trseparW)
       .top=tree.top
       .width=panelwidth*trtextW
       .height=tree.height
      END WITH
'with trfindlabel
'    .left=tree.left : .top=tree.top+tree.height+trVunit
'    .width=tree.width * 0.25 : .height=trVunit
'end with
'with trfind
'    .left=tree.left+trfindlabel.width : .top=trfindlabel.top
'    .width=tree.width * 0.38 : .height=trVunit
'end with
      WITH trnew
       .left=tree.left '+tree.width*0.7
       .top=trVunit/2
       .width=tree.width * 0.3 : .height=trVunit
      END WITH
'menu enables
      fileprint.enabled=true
      editnew.enabled=true
      edituse.enabled=true
      menuicon.enabled=false
      editall.enabled=true
      editfind.enabled=true
      editfindnext.enabled=true
      setfocus(tree.handle)
     END SUB   '--(TRinit)

'-- OPENTREE: get tree from file, called once in Globalinit
     SUB opentree
      DIM s AS STRING, state AS STRING
      DEFINT selecteditem=-1
'---1 main tree
      CHDIR appdir
      IF FILEEXISTS(trFile)=false THEN
       tree.clear
      ELSE
       tree.loadfromfile(trFile)
      END IF
'keep only titles and restore expanded/collapsed state of nodes
      FOR i=0 TO tree.itemcount-1
       s=tree.item(i).text
       state=LEFT$(s,1)
       SELECT CASE state
       CASE "["
        tree.expand(i,0)
       CASE "<"
        tree.expand(i,0)
        selecteditem=i
       CASE ">"
        selecteditem=i
       END SELECT
       s=FIELD$(s,CHR$(9),1)
       s=RIGHT$(s,LEN(s)-1)
       tree.item(i).text=s
      NEXT
'---2 tree containing text of notes
      IF FILEEXISTS(trFile)=false THEN
       texttree.clear
      ELSE
       texttree.loadfromfile(trFile)
      END IF
'keep only text and restore carriage returns in text
      FOR i=0 TO texttree.itemcount-1
       s=texttree.item(i).text
       placetab=INSTR(s,CHR$(9))
       s=MID$(s,placetab+1,LEN(s)-placetab)
       s=REPLACESUBSTR$(s,crSubst,crString)
    's=replacesubstr$(s,"<^t>",chr$(9))
       texttree.item(i).text=s
      NEXT
'---3 select item
      IF tree.itemcount>0 THEN tree.itemindex=selecteditem
     END SUB

'-- TREECHANGE: select another item
'defint returnfocustofind=false
     SUB treechange(i AS INTEGER)
      posit=tree.itemindex
      trtext.text=texttree.item(posit).text
'if returnfocustofind then setfocus(trfind.handle)
     END SUB

'-- TRFINDCHANGE: search for string
'sub trfindchange
'for i=0 to tree.itemcount-1
'    textplace=instr(texttree.item(i).text,trfind.text)
'    if textplace<>0 then
'        returnfocustofind=true 'call back focus
'        tree.itemindex=i 'move to node and update text panel
'        exit sub
'    end if
'next
'end sub

'-- TRNEWCLIC: create new item
     CONST TV_FIRST = &H1100 ' TreeView messages
     CONST TVM_EDITLABELA = TV_FIRST + 14
     DECLARE FUNCTION SendMessageA LIB "user32" ALIAS "SendMessageA" (BYVAL hwnd AS LONG, BYVAL wMsg AS LONG, BYVAL wParam AS LONG, lParam AS LONG) AS LONG
     SUB trnewclic
      IF tree.itemcount=0 THEN
       tree.additems("Notes")
       texttree.additems("")
       tree.itemindex=0
       setfocus(tree.handle)
      ELSE
       posit=tree.itemindex
       tree.addchilditems(posit,"Nouvelle note")
       tree.expand(posit,false)
       texttree.addchilditems(posit,"")
    'move to new position= scan tree for item of level <= level of previous position
    'the new item is at the index just before
       i=posit
       positlevel=tree.item(posit).level
       DO
        i++
        IF i=tree.itemcount-1 THEN EXIT DO
       LOOP UNTIL (tree.item(i+1).level<=positlevel)
       tree.itemindex=i
    'set newly created item in edit mode
       setfocus(tree.handle)
       l=SendMessageA(tree.handle,TVM_EDITLABELA,0,tree.item(i).handle)
      END IF
'    forcetrupdate=true 'set to true to allow trtext update
     END SUB

'-- TRTEXTCHANGE: text field edited -> update text tree
     SUB trtextchange
      posit=tree.itemindex
      texttree.item(posit).text=trtext.text
     END SUB

'-- TRSAVE: save tree
     SUB trsave
      DIM s AS STRING, state AS STRING, title AS STRING
'save records in the following format:
'a character indicating the collapsed/expanded state of the node:
'  [ for expanded, ] for collapsed
'  < and > if item is the currently selected item
'then <tab> item title <tab> item text

'add state and title info to texttree
      FOR i=0 TO tree.itemcount-1
       title=tree.item(i).text
       s=texttree.item(i).text
       s=REPLACESUBSTR$(s,crString,crSubst)
    's=replacesubstr$(s,chr$(9),"<^t>")
       IF i=tree.itemcount-1 THEN
        state=IIF(i=tree.itemindex,">","]")  'last item is always collapsed, since it can't have children
       ELSE
        isexpanded=tree.item(i).haschildren*tree.item(i+1).isvisible
        state=IIF(isexpanded=0,IIF(i=tree.itemindex,">","]"),IIF(i=tree.itemindex,"<","["))
       END IF
       texttree.item(i).text=state+title+CHR$(9)+s
      NEXT
'save to file
      CHDIR appdir
      texttree.savetofile(trFile)
'tree.savetofile(trStrFile)
'trApp.savetofile(trAppFile)
'restore texttree to its original state= text only by removing the state character and the title:
      FOR i=0 TO tree.itemcount-1
       s=texttree.item(i).text
       placetab=INSTR(s,CHR$(9))
       s=MID$(s,placetab+1,LEN(s)-placetab)
       s=REPLACESUBSTR$(s,crSubst,crString)
    's=replacesubstr$(s,"<^t>",chr$(9))
       texttree.item(i).text=s
      NEXT
     END SUB

'-- TRDODELETE: kill node i
     SUB trdodelete(i AS INTEGER)
      DIM s AS STRING
      tree.delitems(i)
      texttree.delitems(i)
'set trtext to text of new selected item, (if there is one left!)
      posit=tree.itemindex
      IF posit<0 THEN
       s=""
      ELSE
       s=texttree.item(posit).text
      END IF
      trtext.text=s
     END SUB '-(trdodelete)

'-- TRDELETE: delete item
     SUB TRdelete
      DIM s AS STRING
      posit=tree.itemindex
      IF posit<0 THEN EXIT SUB
      IF tree.item(posit).haschildren THEN
       IF MESSAGEDLG(s_childdeleteconfirm, mtWarning, mbYes OR mbNo, 0) <> mrYes THEN EXIT SUB 'confirm dialog
      END IF
      tree.delitems(posit)
      texttree.delitems(posit)
'set trtext to text of new selected item, (if there is one left!)
      posit=tree.itemindex
      IF posit<0 THEN
       s=""
      ELSE
       s=texttree.item(posit).text
      END IF
      trtext.text=s
     END SUB '-(trdelete)

'-- TRCOPYNODE: copy a node to clipboardtree
     CREATE clipboardtree AS QTREEVIEW
      PARENT=form
      visible=false
      clear
     END CREATE
     CREATE clipboardtexttree AS QTREEVIEW
      PARENT=form
      visible=false
      clear
     END CREATE
     SUB trCopyNode
      DIM s AS STRING, texts AS STRING
      clipboard.text=""
      clipboardtree.clear
      clipboardtexttree.clear
      copynode=tree.itemindex
      IF copynode<0 THEN EXIT SUB
      copynodelevel=tree.item(copynode).level
      s=tree.item(copynode).text
      texts=texttree.item(copynode).text
      clipboardtree.additems(s)
      clipboardtexttree.additems(texts)
      FOR i=copynode+1 TO tree.itemcount-1  'scan children of copynode until end of tree
       s=tree.item(i).text
       texts=texttree.item(i).text
       ilevel=tree.item(i).level
       IF ilevel<=copynodelevel THEN EXIT FOR 'or until node level <= copynodelevel
       FOR j=i-1 TO copynode STEP -1 'go back up tree to find j, the parent of the i-th node= the node of level immediately higher
        jlevel=tree.item(j).level
        IF jlevel<ilevel THEN EXIT FOR
       NEXT
       clipboardtree.addchilditems(j-copynode,s) 'add node as a child of j
       clipboardtexttree.addchilditems(j-copynode,texts) 'add node as a child of j
      NEXT
      FOR i=0 TO clipboardtree.itemcount-2  'copy the expanded/collapsed state of nodes
       IF tree.item(copynode+i).haschildren*tree.item(copynode+i+1).isvisible THEN
        clipboardtree.expand(i,0)
       ELSE
        clipboardtree.collapse(i,0)
       END IF
      NEXT
     END SUB '-(trcopynode)

'-- TRCUT: cut
     SUB trcut
      IF getfocus=tree.handle THEN 'if tree is active -> cut node
       i=tree.itemindex
       trCopyNode
       trDoDelete(i)
      ELSE
    'else : tree isn't active, cut text selected in trtext
       clipboard.text=trtext.seltext
       trtext.seltext=""
      END IF
     END SUB '-(trcut)

'-- TRCOPY: copy
     SUB trcopy
      IF getfocus=tree.handle THEN 'if tree is active -> copy node
       trCopyNode
      ELSE
    'else : tree isn't active, copy text selected in trtext
       clipboard.text=trtext.seltext
      END IF
     END SUB

'-- TRPASTE: paste
     SUB trpaste
      DIM s AS STRING, texts AS STRING
      IF clipboardtree.itemcount=0 THEN GOTO notreeclipboard
      IF getfocus <> tree.handle THEN EXIT SUB  'check if tree is active
      pastenode=tree.itemindex
'first node
      s=clipboardtree.item(0).text
      texts=clipboardtexttree.item(0).text
      IF tree.itemcount=0 THEN 'tree is empty -> create a 0-th node
       tree.additems(s)
       texttree.additems(texts)
       firstpasted=0 'pasted at position 0
      ELSE
       tree.addchilditems(pastenode,s)
       texttree.addchilditems(pastenode,texts)
    'find where this new node is: somewhere between pastenode+1 and the end of tree
       pastenodelevel=tree.item(pastenode).level
       FOR i=pastenode+1 TO tree.itemcount-1
        ilevel=tree.item(i).level
        IF ilevel<=pastenodelevel THEN EXIT FOR
       NEXT
       firstpasted=i-1  'first pasted node is at position i-1
      END IF
'subsequent nodes
      FOR i=1 TO clipboardtree.itemcount-1
       s=clipboardtree.item(i).text
       texts=clipboardtexttree.item(i).text
       ilevel=clipboardtree.item(i).level
       FOR j=i-1 TO 0 STEP -1 'go back up tree to find j, the parent of the i-th node= the node of level immediately higher
        jlevel=clipboardtree.item(j).level
        IF jlevel<ilevel THEN EXIT FOR
       NEXT
'        debug(j)
       tree.addchilditems(firstpasted+j,s)
       texttree.addchilditems(firstpasted+j,texts)
      NEXT
'set expanded/collapsed state
      FOR i=0 TO clipboardtree.itemcount-2  'copy the expanded/collapsed state of nodes
       IF clipboardtree.item(i).haschildren*clipboardtree.item(i+1).isvisible THEN
        tree.expand(firstpasted+i,0)
       ELSE
        tree.collapse(firstpasted+i,0)
       END IF
      NEXT
      EXIT SUB
notreeclipboard:  'no tree in clipboard --> paste clipboard text into trtext
      trtext.seltext=clipboard.text
     END SUB

'-- TRSELECTALL: select all
     SUB trselectall
      setfocus(trtext.handle)
      trtext.selstart=0
      trtext.sellength=LEN(trtext.text)
     END SUB

'-- TRUSE: use selected text
     SUB truse
      DIM s AS STRING
      s=trtext.seltext
      IF s="" THEN
       s=trtext.line(trtext.wherey) 'if no text is selected, use current line
       wherex=trtext.wherex
       FOR i=wherex TO 1 STEP -1
        IF MID$(s,i,1)=CHR$(9) THEN i++ : EXIT FOR
        trtext.selstart=trtext.selstart-1
       NEXT
       trtext.sellength=0
       FOR j=i TO LEN(s)
        IF MID$(s,j,1)=CHR$(9) THEN EXIT FOR
        trtext.sellength=trtext.sellength+1
       NEXT
       s=trtext.seltext
       s=s-crString-CHR$(9)
      END IF
      use(s)
     END SUB

'-- TRpageup: move up 1 item
     SUB trpageup
      i=tree.itemindex
      IF i=0 THEN EXIT SUB
      DO
       i--
       IF tree.item(i).isvisible THEN EXIT DO
      LOOP UNTIL i=0
      tree.itemindex=i
     END SUB

'-- TRpagedown: move down 1 item
     SUB trpagedown
      i=tree.itemindex
      IF i=tree.itemcount-1 THEN EXIT SUB
      DO
       i++
       IF tree.item(i).isvisible THEN GOTO nextvisiblenode
      LOOP UNTIL i=tree.itemcount-1
      EXIT SUB
nextvisiblenode:
      tree.itemindex=i
     END SUB

'-- TOGGLECOLLAPSE: change state of current node
     SUB togglecollapse
      i=tree.itemindex
      IF (i<0)OR(i>tree.itemcount-2) THEN EXIT SUB
      state=tree.item(i+1).isvisible*tree.item(i).haschildren 'item is expanded if it has children and its 1st child is visible
      IF state=0 THEN 'item is collapsed->expand it
       tree.expand(i,0)
      ELSE 'reverse
       tree.collapse(i,0)
      END IF
     END SUB

'-- trkeydown: handle keydown : check for carriage returns, tabs, escape
     SUB trkeydown(key AS WORD, shift AS INTEGER)
      SELECT CASE key
      CASE 33 : trpageup 'PageUp
      CASE 34 : trpagedown 'PageDown
      CASE 13 : IF getfocus=tree.handle THEN togglecollapse
      END SELECT
     END SUB '-(trkeydown)

'-- TRPRINT : print current node and its children
     SUB trprint
      DIM s AS STRING, mydate AS STRING
      CREATE trprintfont AS QFONT
       name=appfontname
       size=10
      END CREATE
      CREATE trprintfontbold AS QFONT
       name=appfontname
       size=10
       addstyles(fsbold)
      END CREATE
      DEFINT printitem=tree.itemindex
      DEFINT printitemlevel=tree.item(printitem).level
      printer.orientation=0
'Title
      s=tree.item(printitem).text
      $IFDEF FRANCAIS
       mydate=MID$(DATE$,4,2)+"."+LEFT$(DATE$,2)+"."+MID$(DATE$,7,4)
      $ELSE
       mydate=DATE$
      $ENDIF
      s=s+STRING$(20," ")+mydate
      printer.font=trprintfontbold
      LPRINT:LPRINT
      LPRINT s
      LPRINT STRING$(LEN(s),"_")
      printer.font=trprintfont
      LPRINT
      LPRINT texttree.item(printitem).text
      IF printitem=tree.itemcount-1 THEN GOTO endtrprint
'Print children= subsequent items until they're at the same or higher level than the original node
      FOR i=printitem+1 TO tree.itemcount-1
       IF tree.item(i).level<=printitemlevel THEN GOTO endtrprint
       LPRINT : LPRINT
       s=tree.item(i).text
       printer.font=trprintfontbold
       LPRINT s
       LPRINT STRING$(LEN(s),"_")
       printer.font=trprintfont
       LPRINT : LPRINT
       LPRINT texttree.item(i).text
      NEXT
endtrprint:
      LFLUSH
     END SUB

     DIM findnote AS INTEGER, findpos AS INTEGER
'-- TRMENUFIND
     SUB trdofind
      DIM i AS INTEGER, s AS STRING, p AS INTEGER
      s=findtext.text
      IF s="" THEN EXIT SUB
      findnote=tree.itemindex
      p=INSTR(findpos,LCASE$(trtext.text),LCASE$(s))
      IF p>0 THEN
       trtext.selstart=p-1
       findpos=p
       trtext.sellength=LEN(s)
       setfocus(trtext.handle)
       EXIT SUB
      END IF
      FOR i=findnote+1 TO tree.itemcount-1
       p=INSTR(LCASE$(texttree.item(i).text),LCASE$(s))
       IF p>0 THEN
        tree.itemindex=i
        trtext.selstart=p-1
        trtext.sellength=LEN(s)
        findnote=i
        findpos=p
        setfocus(trtext.handle)
        EXIT SUB
       END IF
      NEXT
      FOR i=0 TO findnote
       p=INSTR(LCASE$(texttree.item(i).text),LCASE$(s))
       IF p>0 THEN
        tree.itemindex=i
        trtext.selstart=p-1
        trtext.sellength=LEN(s)
        findnote=i
        findpos=p
        setfocus(trtext.handle)
        EXIT SUB
       END IF
      NEXT
     END SUB

     SUB trmenufind
      findpos=trtext.selstart+1
      trdofind
     END SUB

'-- TRFINDNEXT
     SUB trfindnext
      findpos=trtext.selstart+2
      trdofind
     END SUB

2013-06-19 07:44