2013-06-19 07:44

' PROJECTS PANEL
     $TYPECHECK ON

     $IFDEF FRANCAIS
      CONST prfile="data\Projets.txt" 'projects data file
     $ELSE
      CONST prfile="data\Projects.txt"
     $ENDIF

     DECLARE SUB prkeydown(key AS WORD, shift AS INTEGER)
     DECLARE SUB painttasks
     DECLARE SUB celldraw(col AS INTEGER, row AS INTEGER, state AS INTEGER, r AS QRECT)
     DECLARE SUB celledited(col AS INTEGER, row AS INTEGER, VAL AS STRING)
     DECLARE SUB cellselected(col AS INTEGER, row AS INTEGER, byref canselect AS INTEGER)
     DECLARE SUB scrollchange
     DECLARE SUB prmousedown(button AS INTEGER, x AS INTEGER, y AS INTEGER, shift AS INTEGER)
     DECLARE SUB prmousemove(x AS INTEGER, y AS INTEGER, shift AS INTEGER)
     DECLARE SUB prmouseup(button AS INTEGER, x AS INTEGER, y AS INTEGER, shift AS INTEGER)
     DECLARE SUB initproject
     DECLARE SUB closeproject
     DECLARE SUB prPageUp : DECLARE SUB prPageDown

'------------ VARIABLES
     CONST prworkdaysinweek=5          'nb of working days in week= nb of subdivisions. 5 or 7
     DIM prStartDate(0) AS STRING      'project date
     DEFDBL prDisplayoffset=0          'start of current display
     DIM prToday AS DOUBLE             'today's date in prTimeUnits
'dim prDisplayDate as string      'start of current display
'defdbl prDisplayCount=0          'distance between displaydate and startdate (in timeunit)
     DIM prTimeUnit(0) AS STRING      'project time units
     DIM prTimeCount(99) AS INTEGER    'nb of time units displayed
     DEFINT prTimeSubdiv=4            'nb of divisions of time unit, =4 for months, 7 for weeks
     DEFINT prAlign=1                 'if force align on time divisions
     DEFINT nbprojects=0
     DEFINT currentproject=-1
     DIM logicalprojectindex AS QSTRINGLIST 'correspondence between tab index and project arrays
     DIM prtasks(0) AS QSTRINGLIST         'tasks of the different projects
     DIM prlinks(0) AS QSTRINGLIST         'links between tasks
     DIM prdones(0) AS QSTRINGLIST         'progress state of the projects, make column 0 of prgrid
     DIM prtexts(0) AS QSTRINGLIST         'texts of projects, make column 1 of prgrid
     DEFINT previoustoprow=1
     DEFINT currenttask=-1
     DEFINT currentcolor=0
     CONST prlinkthickness=1  'thickness of link lines = 2*prlinkthickness + 1
     CONST linkcolor=&h0000ff 'color of link lines
     CONST currentlkcolor=&h0080ff 'color of link lines involving current task
     CONST prscrolldelay=120 'scroll bar delay
     DEFINT prgridselstart=-1
     DEFINT prgridselend=-1

'------------ CONTROLS
     CONST prDonecol=35  'width of 'Done' column
     CONST prTitlecol=200'width of 'Text' column
     CONST prVunit=20  'row height
     CREATE PrPanel AS QPANEL
      PARENT=tab
      left=4 : top=28
      COLOR=colorfond
      visible=false
      borderstyle=0 : bevelouter=0 : bevelinner=0
      CREATE prTabs AS QTABCONTROL
       left=0 : top=0
       onchange=initproject
       CREATE prdummybtn AS QBUTTON
        visible=false
       END CREATE
      END CREATE
      CREATE prgrid AS QSTRINGGRID
       font=appqfont
       ScrollBars =ssVertical
       ColCount = 5
       height=form.height-76-54
       RowCount = INT(form.height-76-54)/prVunit+1
       cell(0,0)="  •"
       cell(2,0)=s_prDone
       cell(3,0)=s_prtext
       defaultrowheight=prVunit-1
       FixedCols = 0
       col=1
       addoptions(goediting,goAlwaysShowEditor,goTabs)
       ondrawcell=celldraw
       onselectcell=cellselected
       onsetedittext=celledited
      END CREATE
      CREATE taskpanel AS QPANEL
       borderstyle=0
       bevelwidth=0
       font=appsmallfont
       CREATE prcanv AS QCANVAS
        onpaint=painttasks
        onmousedown=prmousedown
        onmousemove=prmousemove
        onmouseup=prmouseup
       END CREATE
       CREATE prdatecanv AS QCANVAS
       END CREATE
      END CREATE
      CREATE prHscrollbar AS QSCROLLBAR
       kind=sbhorizontal
       Height = 16
       onchange=scrollchange
      END CREATE
     END CREATE '-- (PrPanel)
'get handle to Tabcontrol :
     DEFDBL prtabshandle=getparent(prdummybtn.handle)
'-- PRINIT: show controls
     SUB prinit
'Redimension controls according to window size
      prpanel.width=panelwidth
      prpanel.height=panelheight
      prtabs.width=panelwidth
      prtabs.height=panelheight
      prgrid.Left = 10 : prgrid.Width = prpanel.width-20
      prgrid.Top = 40 : prgrid.Height = prpanel.height-54-20
      prgrid.colwidths(0)=prvunit
      prgrid.colwidths(2)=prDonecol
      prgrid.colwidths(1)=0
      prgrid.colwidths(3)=prTitlecol
      prgrid.colwidths(4)=prgrid.width-prTitlecol-prDonecol-24-prVunit
      taskpanel.Left = prgrid.left+prDonecol+prTitlecol+4
      taskpanel.Top = prgrid.top
      taskpanel.Width = prgrid.width-prTitlecol-prDonecol-24+1
      taskpanel.Height = prgrid.height-1
      prcanv.top=prVunit+1 : prcanv.left=0
      prcanv.width=taskpanel.width
      prcanv.height=taskpanel.height-prVunit-2
      prdatecanv.top=0 : prdatecanv.left=0
      prdatecanv.width=taskpanel.width
      prdatecanv.height=prVunit+2
      prHscrollbar.Left = taskpanel.left
      prHscrollbar.Top = taskpanel.top+taskpanel.height
      prHscrollbar.Width = taskpanel.width
'menu enables
      fileprint.enabled=false
      editnew.enabled=false
      edituse.enabled=false
      menuicon.enabled=false
      menuicon.shortcut=""
      editall.enabled=false
      editfind.enabled=false
      editfindnext.enabled=false
      projectinsert.shortcut="CTRL+I"
      setfocus(prgrid.handle)
      currenttask=-1
      initproject 'prepare grid
'painttasks
     END SUB   '--(PRinit)

'--------------- LINKS handling

'TASKSTART: start of task #i, expressed as a number of prTimeUnits
     FUNCTION taskstart(i AS INTEGER) AS DOUBLE
      taskstart=VAL(FIELD$(prtasks(currentproject).item(i),CHR$(9),2))
     END FUNCTION '-(taskstart)

'TASKEND: end of task #i, expressed as a number of prTimeUnits
     FUNCTION taskend(i AS INTEGER) AS DOUBLE
      taskend=VAL(FIELD$(prtasks(currentproject).item(i),CHR$(9),3))
     END FUNCTION '-(taskend)

'TASKLINE: line of task #i
     FUNCTION taskline(i AS INTEGER) AS INTEGER
      taskline=VAL(FIELD$(prtasks(currentproject).item(i),CHR$(9),1))
     END FUNCTION '-(taskline)

'LINKORIGIN: task number corresponding to origin of link #i
     FUNCTION linkorigin(i AS INTEGER) AS INTEGER
      linkorigin=VAL(FIELD$(prlinks(currentproject).item(i),CHR$(9),1))
     END FUNCTION '-(linkorigin)

'LINKDEST: task number corresponding to destination of link #i
     FUNCTION linkdest(i AS INTEGER) AS INTEGER
      linkdest=VAL(FIELD$(prlinks(currentproject).item(i),CHR$(9),2))
     END FUNCTION '-(linkdest)

'SETORIGIN: set link origin
     SUB setorigin(i AS INTEGER, orig AS INTEGER)
      DIM s AS STRING, origstr AS STRING, deststr AS STRING
      s=prlinks(currentproject).item(i)
      origstr=format$("%4.4d",orig)
      deststr=FIELD$(s,CHR$(9),2)
      prlinks(currentproject).item(i)=origstr+CHR$(9)+deststr
     END SUB '-(setorigin)

'SETDEST: set link destination
     SUB setdest(i AS INTEGER, dest AS INTEGER)
      DIM s AS STRING, origstr AS STRING, deststr AS STRING
      s=prlinks(currentproject).item(i)
      origstr=FIELD$(s,CHR$(9),1)
      deststr=format$("%4.4d",dest)
      prlinks(currentproject).item(i)=origstr+CHR$(9)+deststr
     END SUB '-(setdest)

'ISLINKED: is there an existing link
     FUNCTION islinked(a AS INTEGER, b AS INTEGER) AS INTEGER 'is b a child of a
      DIM i AS INTEGER, origin AS INTEGER, dest AS INTEGER
      FOR i=0 TO prlinks(currentproject).itemcount-1 'scan links list for links originating in a
       origin=linkorigin(i)
       IF origin>a THEN islinked=0 : EXIT FUNCTION
       IF origin=a THEN
        dest=linkdest(i)     'check if this is a direct link between a and b
        IF dest=b THEN islinked=1 : EXIT FUNCTION  'else recursively check if there's a link between dest and b
        IF islinked(dest,b) THEN islinked=1 : EXIT FUNCTION
       END IF
      NEXT
      islinked=0
     END FUNCTION '-(islinked)

'-- FINDLINK: look for direct link between a and b
     FUNCTION findlink(a AS INTEGER, b AS INTEGER) AS INTEGER
      DIM i AS INTEGER, origin AS INTEGER
      findlink=-1
      FOR i=0 TO prlinks(currentproject).itemcount-1 'scan links list for links originating in a
       origin=linkorigin(i)
       IF origin>a THEN EXIT FUNCTION
       IF origin=a THEN 'check if this is a direct link between a and b
        IF linkdest(i)=b THEN findlink=i : EXIT FUNCTION
       END IF
      NEXT
     END FUNCTION '-(findlink)

'EARLIESTSTART: earliest date a task can start, given existing links
     FUNCTION earlieststart(a AS INTEGER) AS DOUBLE
      DIM origin AS INTEGER, i AS INTEGER
      DIM maxdate AS DOUBLE, thisdate AS DOUBLE
      maxdate=-999
      FOR i=0 TO prlinks(currentproject).itemcount-1 'scan links list for links destinating in a
       IF linkdest(i)=a THEN
        origin=linkorigin(i)
        thisdate=taskend(origin)
        IF thisdate>maxdate THEN maxdate=thisdate
       END IF
      NEXT
      earlieststart=maxdate
     END FUNCTION '-(earlieststart)

'--------------- TIME functions

'-- ALIGN: align to next time division
     FUNCTION align(a AS DOUBLE) AS DOUBLE
      IF prAlign=0 THEN
       align=a
      ELSE
       align=IIF(a*prTimeSubdiv>=-0.5,ROUND(a*prTimeSubdiv)/prTimeSubdiv,(ROUND(a*prTimeSubdiv)-1)/prTimeSubdiv)
      END IF
     END FUNCTION '-(align)

'-- PRDATESTR: short date format (2 Nov 02)
     FUNCTION prdatestr(j AS STRING) AS STRING
      DIM y AS INTEGER, m AS INTEGER, d AS INTEGER
      DIM mstr AS STRING
      y= VAL(LEFT$(j,4))
      m=VAL(MID$(j,6,2))
      $IFDEF FRANCAIS
       SELECT CASE m
       CASE 6 : mstr="jun"
       CASE 7 : mstr="jul"
       CASE ELSE : mstr=LEFT$(MonthName(m),3)
       END SELECT
      $ELSE
       mstr=LEFT$(MonthName(m),3)
      $ENDIF
      d=VAL(MID$(j,9,2))
      prdatestr=STR$(d)+" "+mstr+" "+RIGHT$(format$("%4.4d",y),2)
     END FUNCTION

'-- COUNTMONTHS: count months between 2 dates
     FUNCTION countmonths(j1 AS STRING, j2 AS STRING) AS DOUBLE
      IF j2<j1 THEN countmonths=0-countmonths(j2,j1) : EXIT FUNCTION
      DIM y1 AS INTEGER, m1 AS INTEGER, d1 AS INTEGER
      DIM y2 AS INTEGER, m2 AS INTEGER, d2 AS INTEGER
      DIM daystomonthend AS INTEGER, daysinmonth AS INTEGER
      DIM d AS DOUBLE
      y1= VAL(LEFT$(j1,4)):m1=VAL(MID$(j1,6,2)):d1=VAL(MID$(j1,9,2))
      y2= VAL(LEFT$(j2,4)):m2=VAL(MID$(j2,6,2)):d2=VAL(MID$(j2,9,2))
'same month:
      daysinmonth=nbdaysinmonth(y1,m1)
      IF (y2=y1)AND(m2=m1) THEN countmonths=(d2-d1)/daysinmonth : EXIT FUNCTION
'get to month's end
      daystomonthend=daysinmonth+1-d1
      d=daystomonthend/daysinmonth
      m1++ : IF m1=13 THEN m1=1 : y1++
'move on months:
      d=d+(y2-y1)*12+m2-m1
'move on remaining days:
      daysinmonth=nbdaysinmonth(y2,m2)
      d=d+(d2-1)/daysinmonth
      countmonths=d
     END FUNCTION '-(countmonths)

'-- ADVANCEMONTHS: advance by a number of months
     FUNCTION advancemonths(j AS STRING, a AS DOUBLE) AS STRING
      DIM y AS INTEGER, m AS INTEGER, d AS INTEGER
      DIM monthstomonthend AS DOUBLE, daysinmonth AS INTEGER
      y= VAL(LEFT$(j,4))
      m=VAL(MID$(j,6,2))
      d=VAL(MID$(j,9,2))
      daysinmonth=nbdaysinmonth(y,m)
      monthstomonthend=(daysinmonth+1-d)/daysinmonth 'how many months to go to reach this month's end
      monthstomonthend=align(monthstomonthend)
      IF a<monthstomonthend THEN   'if stay in this month, just add the number of days
       d=ROUND(d+daysinmonth*a)
       advancemonths=numtodate(y,m,d)
       EXIT FUNCTION
      END IF
      m++  'else move to next month
      a=a-monthstomonthend
      m=m+INT(a) 'move forward int(a) months
      WHILE m>12  'correct year if end of year reached
       y++
       m=m-12
      WEND
      a=FRAC(a)  'move forward by the remaining nb of days
      daysinmonth=nbdaysinmonth(y,m)
      d=1+ROUND(a*daysinmonth)
      advancemonths=numtodate(y,m,d)
     END FUNCTION '-(advancemonths)

'-- COUNTWEEKS: count weeks between 2 dates
     FUNCTION countweeks(j1 AS STRING, j2 AS STRING) AS DOUBLE
      IF j2<j1 THEN countweeks=0-countweeks(j2,j1) : EXIT FUNCTION
      DIM y1 AS INTEGER, m1 AS INTEGER, d1 AS INTEGER
      DIM y2 AS INTEGER, m2 AS INTEGER, d2 AS INTEGER
      DIM daystomonthend AS INTEGER, daysinmonth AS INTEGER
      DIM d AS DOUBLE
      DIM i AS INTEGER
      y1= VAL(LEFT$(j1,4)):m1=VAL(MID$(j1,6,2)):d1=VAL(MID$(j1,9,2))
      y2= VAL(LEFT$(j2,4)):m2=VAL(MID$(j2,6,2)):d2=VAL(MID$(j2,9,2))
'same month:
      daysinmonth=nbdaysinmonth(y1,m1)
      IF (y2=y1)AND(m2=m1) THEN countweeks=(d2-d1)/7 : EXIT FUNCTION
'get to month's end
      daystomonthend=daysinmonth+1-d1
      d=daystomonthend
      m1++ : IF m1=13 THEN m1=1 : y1++
      IF y1=y2 THEN
       FOR i=m1 TO m2-1
        d=d+nbdaysinmonth(y1,i)
       NEXT
      ELSE
    'move on months:
       FOR i=m1 TO 12
        d=d+nbdaysinmonth(y1,i)
       NEXT
    'move on years
       FOR i=y1+1 TO y2-1
        d=d+365+bisex(i)
       NEXT
    'move on months
       FOR i=1 TO m2-1
        d=d+nbdaysinmonth(y2,i)
       NEXT
      END IF
      d=d+d2-1
      countweeks=d/7
     END FUNCTION '-(countweeks)

'-- ADVANCEWEEKS: advance by a number of weeks
     FUNCTION advanceweeks(j AS STRING, a AS DOUBLE) AS STRING
      DIM y AS INTEGER, m AS INTEGER, d AS INTEGER, a7 AS INTEGER
      DIM daystomonthend AS INTEGER, daysinmonth AS INTEGER
      y= VAL(LEFT$(j,4))
      m=VAL(MID$(j,6,2))
      d=VAL(MID$(j,9,2))
      a7=a*7
      daysinmonth=nbdaysinmonth(y,m)
      daystomonthend=daysinmonth+1-d 'how many days to go to reach this month's end
      IF a7<daystomonthend THEN   'if stay in this month, just add the number of days
       d=d+a7
       advanceweeks=numtodate(y,m,d)
       EXIT FUNCTION
      END IF
      m++  'else move to next month
      IF m=13 THEN m=1 : y++
      a7=a7-daystomonthend
      daysinmonth=nbdaysinmonth(y,m)
      WHILE a7>=daysinmonth
       m++
       IF m=13 THEN m=1 : y++
       a7=a7-daysinmonth
       daysinmonth=nbdaysinmonth(y,m)
      WEND
      d=a7+1
      advanceweeks=numtodate(y,m,d)
     END FUNCTION '-(advanceweeks)

'-- COUNTTIME: count time units between 2 dates
     FUNCTION counttime(j1 AS STRING, j2 AS STRING) AS DOUBLE
      SELECT CASE prTimeUnit(currentproject)
      CASE s_Monthunit
       counttime=countmonths(j1,j2)
      CASE s_Weekunit
       counttime=countweeks(j1,j2)
      END SELECT
     END FUNCTION '-(counttime)

'-- ADVANCETIME: count time units between 2 dates
     FUNCTION advancetime(j AS STRING, a AS DOUBLE) AS STRING
      SELECT CASE prTimeUnit(currentproject)
      CASE s_Monthunit
       advancetime=advancemonths(j,a)
      CASE s_Weekunit
       advancetime=advanceweeks(j,a)
      END SELECT
     END FUNCTION '-(counttime)

'-- PRSCREENTODATE: convert x screen coordinate to date
     FUNCTION prScreenToDate(x AS INTEGER) AS DOUBLE
      DIM a AS DOUBLE
      a=prDisplayoffset+x*prTimeCount(currentproject)/prcanv.width
      prScreenToDate=align(a) 'advancetime(prDisplayDate,a)
     END FUNCTION '-(prscreentodate)

'-- PRDATETOSCREEN: convert date to screen x coordinate
     FUNCTION prDateToScreen(d AS DOUBLE) AS INTEGER
      prDateToScreen=(d-prDisplayoffset)*prcanv.width/prTimeCount(currentproject)
     END FUNCTION '-(prdatetoscreen)

'-- PUSHTASK: set start of task #i
     SUB pushtask(i AS INTEGER, newstart AS DOUBLE)
      DIM s AS STRING, delta AS DOUBLE, oldstart AS DOUBLE, oldend AS DOUBLE, newend AS DOUBLE
      oldstart=taskstart(i)
      oldend=taskend(i)
      delta=newstart-oldstart
      newend=align(oldend+delta)
      s=prtasks(currentproject).item(i)
      prtasks(currentproject).item(i)=FIELD$(s,CHR$(9),1)+CHR$(9)+STR$(newstart)+CHR$(9)+STR$(newend)
     END SUB '-(settaskstart)

'--PUSHTASKS: adjust children of task #a so that they start after #a's end
     SUB pushtasks(a AS INTEGER)
      DIM i AS INTEGER, origin AS INTEGER, dest AS INTEGER
      DIM enda AS DOUBLE, startb AS DOUBLE
      enda=taskend(a)
      FOR i=0 TO prlinks(currentproject).itemcount-1 'scan links list for links originating in a
       origin=linkorigin(i)
       IF origin>a THEN EXIT SUB
       IF origin=a THEN
        dest=linkdest(i)
        startb=taskstart(dest) 'if child task starts before parent's end, set start to parent's end
        IF startb<enda THEN
         pushtask(dest,enda)
         pushtasks(dest) 'and recursively repeat for child's children
        END IF
       END IF
      NEXT
     END SUB '-(pushtasks)

'-- TASKAT: project number at coordinates x0,y0
     FUNCTION isintask(i AS INTEGER, x0 AS DOUBLE, y0 AS INTEGER) AS INTEGER 'true if coordinates x0,y0 are inside task #i
      DIM thistask AS STRING
      DIM x1 AS DOUBLE, x2 AS DOUBLE, y AS INTEGER
      thistask=prtasks(currentproject).item(i)
      y=VAL(FIELD$(thistask,CHR$(9),1))
      IF y=y0 THEN
       x1=VAL(FIELD$(thistask,CHR$(9),2))
       x2=VAL(FIELD$(thistask,CHR$(9),3))
       IF x1=x2 THEN
        IF ABS(x1-x0)*prcanv.width/prTimeCount(currentproject)<prVunit*0.35 THEN
         isintask=1
         EXIT FUNCTION
        END IF
       ELSEIF (x1<=x0)AND(x0<=x2) THEN
        isintask=1
        EXIT FUNCTION
       END IF
      END IF
      isintask=0
     END FUNCTION '-(isintask)
     FUNCTION taskat(x0 AS DOUBLE,y0 AS INTEGER) AS INTEGER
      DIM i AS INTEGER
      DIM thistask AS STRING, x1 AS DOUBLE, x2 AS DOUBLE
'look if x0,y0 is in task i, starting by zero-duration tasks
      FOR i=0 TO prtasks(currentproject).itemcount-1
       thistask=prtasks(currentproject).item(i)
       x1=VAL(FIELD$(thistask,CHR$(9),2))
       x2=VAL(FIELD$(thistask,CHR$(9),3))
       IF x1=x2 THEN
        IF isintask(i,x0,y0) THEN
         taskat=i
         EXIT FUNCTION
        END IF
       END IF
      NEXT
'then non-zero-duration tasks
      FOR i=0 TO prtasks(currentproject).itemcount-1
       thistask=prtasks(currentproject).item(i)
       x1=VAL(FIELD$(thistask,CHR$(9),2))
       x2=VAL(FIELD$(thistask,CHR$(9),3))
       IF x1<>x2 THEN
        IF isintask(i,x0,y0) THEN
         taskat=i
         EXIT FUNCTION
        END IF
       END IF
      NEXT
'if not found before
      taskat=-1
     END FUNCTION '-(taskat)

'------------------  Graphics

'-- PAINTGRID: draw grid with row selection
     SUB paintgrid
      DIM i AS INTEGER,row AS INTEGER
      DIM textcol AS LONG, backcol AS LONG, backcol0 AS LONG
      FOR i=1 TO prgrid.visiblerowcount
       row=prgrid.toprow+i-1
       IF (row>=prgridselstart)AND(row<=prgridselend) THEN
        textcol=clHilightText : backcol=clHilight : backcol0=&h777777
       ELSE
        textcol=0 : backcol=&hffffff : backcol0=prgrid.fixedcolor
       END IF
       prgrid.fillrect(0,prVunit*i,prgrid.colwidths(0),prvunit*(i+1)-1,backcol0)
       prgrid.fillrect(prgrid.colwidths(0)+2,prVunit*i,prgrid.colwidths(0)+prgrid.colwidths(2)+2,prvunit*(i+1)-1,backcol)
       prgrid.fillrect(prgrid.colwidths(0)+prgrid.colwidths(2)+3,prVunit*i,prgrid.colwidths(0)+prgrid.colwidths(2)+prgrid.colwidths(3)+3,prvunit*(i+1)-1,backcol)
       prgrid.textout(prgrid.colwidths(0)+3,prVunit*i+2,prgrid.cell(2,row),textcol,clHilight)
       prgrid.textout(prgrid.colwidths(0)+prgrid.colwidths(2)+5,prVunit*i+2,prgrid.cell(3,row),textcol,backcol)
      NEXT
     END SUB '-(paintgrid)

'-- PAINTTASKS: draw task bars
     SUB diamond(a AS INTEGER, b AS INTEGER, i AS INTEGER,c AS LONG)
      prcanv.line(a-i,b,a,b-i,c)
      prcanv.line(a,b-i,a+i,b,c)
      prcanv.line(a+i,b,a,b+i,c)
      prcanv.line(a,b+i,a-i,b,c)
     END SUB '-(diamond)
     SUB linkline(i AS INTEGER) 'draw link #i
      DIM y1 AS INTEGER, y2 AS INTEGER, yy1 AS INTEGER, yy2 AS INTEGER
      DIM end1 AS INTEGER, start2 AS INTEGER, bb AS INTEGER
      DIM origin AS INTEGER, dest AS INTEGER
      DIM lkcolor AS LONG
      origin=linkorigin(i) : dest=linkdest(i)
      y1=taskline(origin) : y2=taskline(dest)
      yy1=(1.5+y1-prgrid.toprow)*prVunit : yy2=(1.5+y2-prgrid.toprow)*prVunit
      end1=prdatetoscreen(taskend(origin)) : start2=prdatetoscreen(taskstart(dest))
      IF (dest=currenttask) THEN
       bb=end1+2*prlinkthickness : IF bb>start2 THEN bb=start2
      ELSE
       bb=start2-2*prlinkthickness : IF bb<end1 THEN bb=end1
      END IF
      IF (dest=currenttask)OR(origin=currenttask) THEN
       lkcolor=currentlkcolor
      ELSE
       lkcolor=linkcolor
      END IF
      prcanv.fillrect(end1-prlinkthickness,yy1-prlinkthickness,bb+prlinkthickness+1,yy1+prlinkthickness+1,lkcolor)
      prcanv.fillrect(bb-prlinkthickness,yy1-prlinkthickness,bb+prlinkthickness+1,yy2+prlinkthickness+1,lkcolor)
      prcanv.fillrect(bb-prlinkthickness,yy2-prlinkthickness,start2+prlinkthickness+1,yy2+prlinkthickness+1,lkcolor)
     END SUB '-(linkline)
     SUB taskbar(y AS INTEGER, x1 AS DOUBLE, x2 AS DOUBLE, hilited AS INTEGER)
      DIM yy AS INTEGER, aa AS INTEGER, bb AS INTEGER, ycenter AS INTEGER, i AS INTEGER
      DIM progressstate AS STRING
      yy=(1+y-prgrid.toprow)*prVunit
      aa=prDateToScreen(x1)
      bb=prDateToScreen(x2)
      progressstate=LCASE$(prgrid.cell(2,y+1))
      IF (progressstate="100")OR(progressstate="oui")OR(progressstate="yes")OR(progressstate="o")OR(progressstate="100%") THEN
    'task finished -> green
       currentcolor=IIF(hilited,&h55ff99,&h55aa33)
      ELSEIF x2<prtoday THEN
    'task late -> red
       currentcolor=IIF(hilited,&h0066ff,&h0044bb)
      ELSE  'in progress -> blue
       currentcolor=IIF(hilited,&hff9999,&haa2266)
      END IF
      IF aa<>bb THEN
       prcanv.fillrect(aa,yy+prVunit*0.25,bb,yy+prVunit*0.75,currentcolor)
       prcanv.rectangle(aa,yy+prVunit*0.25,bb,yy+prVunit*0.75,&h000000)
      ELSE
       ycenter=yy+prVunit*0.5
       FOR i=0 TO prVunit*0.4-1
        diamond(aa,ycenter,i,currentcolor)
       NEXT
       diamond(aa,ycenter,prVunit*0.4,0)
      END IF
     END SUB '-(taskbar)
     SUB prshowdates
      DIM interval AS DOUBLE 'nb of time units between 2 date labels
      DIM datex AS INTEGER, startdatex AS INTEGER, i AS INTEGER
      DIM ladate AS STRING, firstdatelabel AS STRING
      DIM nextmultiple AS DOUBLE, deltax AS DOUBLE
      prdatecanv.fillrect(0,0,prdatecanv.width,prdatecanv.height,&hd0d0d0)
      prdatecanv.rectangle(0,0,prdatecanv.width,prdatecanv.height,clBtnShadow)
      datex=prdatetoscreen(prtoday)
      startdatex=prdatetoscreen(0)
      prcanv.fillrect(startdatex,1,datex,prcanv.height,&hFFd8d8)
      SELECT CASE prTimeCount(currentproject)
      CASE 4 TO 7
       interval=1
      CASE ELSE
       interval=prTimeCount(currentproject)/6
      END SELECT
      nextmultiple=INT((prDisplayoffset)/interval+0.999999)*interval
      deltax=nextmultiple-prDisplayoffset
      firstdatelabel=advancetime(prStartDate(currentproject),nextmultiple)
      FOR i=0 TO prTimeCount(currentproject)/interval
       datex=(deltax+i*interval)*prdatecanv.width/prTimeCount(currentproject)
       prdatecanv.line(datex,0,datex,prdatecanv.height,clBtnShadow)
       prcanv.line(datex,0,datex,prcanv.height,&h558888) 'vertical lines
       ladate=advancetime(firstdatelabel,i*interval)
       prdatecanv.textout(datex+1,4,prdatestr(ladate),0,clBtnShadow)
      NEXT
      FOR i=1 TO prTimeCount(currentproject)-1
       datex=i*prdatecanv.width/prTimeCount(currentproject)
       prcanv.line(datex,1,datex,prcanv.height-1,&hd0d0d0)
      NEXT
     END SUB '-(prshowdates)
     SUB painttasks
      DIM i AS INTEGER, y AS INTEGER, selected AS INTEGER, j AS INTEGER
      DIM s AS STRING, x1 AS DOUBLE, x2 AS DOUBLE
      prcanv.fillrect(0,0,prcanv.width,prcanv.height,&hffffff)
      prshowdates
'horizontal lines
      FOR i=1 TO prcanv.height/prVunit
       prcanv.line(0,i*prVunit,prcanv.width,i*prVunit,&hb0b0b0)
      NEXT
'selected rows
      IF prgridselstart>=0 THEN
       FOR i=prgridselstart TO prgridselend
        j=i-prgrid.toprow
        prcanv.fillrect(1,j*prVunit+1,prcanv.width,(j+1)*prVunit,clhilight)
       NEXT
      END IF
'Links :
      FOR i=0 TO prlinks(currentproject).itemcount-1
       linkline(i)
      NEXT
'hilight links to current task
      FOR i=0 TO prlinks(currentproject).itemcount-1
       IF (linkorigin(i)=currenttask)OR(linkorigin(i)=currenttask) THEN linkline(i)
      NEXT
'Tasks : first draw non-zero tasks
      FOR i=0 TO prtasks(currentproject).itemcount-1
       s=prtasks(currentproject).item(i)
       x1=VAL(FIELD$(s,CHR$(9),2))
       x2=VAL(FIELD$(s,CHR$(9),3))
       IF x1<>x2 THEN
        y=VAL(FIELD$(s,CHR$(9),1))
        taskbar(y,x1,x2,0)
       END IF
      NEXT
'then draw zero-length tasks
      FOR i=0 TO prtasks(currentproject).itemcount-1
       s=prtasks(currentproject).item(i)
       x1=VAL(FIELD$(s,CHR$(9),2))
       x2=VAL(FIELD$(s,CHR$(9),3))
       IF x1=x2 THEN
        y=VAL(FIELD$(s,CHR$(9),1))
        taskbar(y,x1,x2,0)
       END IF
      NEXT
'hilight current task
      IF currenttask>=0 THEN
       s=prtasks(currentproject).item(currenttask)
       x1=VAL(FIELD$(s,CHR$(9),2))
       x2=VAL(FIELD$(s,CHR$(9),3))
       y=VAL(FIELD$(s,CHR$(9),1))
       taskbar(y,x1,x2,1)
      END IF
      paintgrid
     END SUB

     SUB celldraw(col AS INTEGER, row AS INTEGER, state AS INTEGER, r AS QRECT)
      DIM cellcolor AS LONG
'when grid cells are redrawn, check if top row has changed = if the grid has scrolled
      IF previoustoprow<>prgrid.toprow THEN  'if so, redraw tasks to reflect scroll
       painttasks
       previoustoprow=prgrid.toprow
      END IF
      IF (col=0)AND(row>0) THEN
       cellcolor=prgrid.fixedcolor
       IF prgridselstart>=0 THEN
        IF (row>=prgridselstart)AND(row<=prgridselend) THEN cellcolor=&h777777
       END IF
       prgrid.fillrect(r.left,r.top,r.right,r.bottom,cellcolor)
      END IF
      IF ((col=2)OR(col=3))AND(row>0) THEN
'    cellcolor=&hffffff
       IF prgridselstart>=0 THEN
        IF (row>=prgridselstart)AND(row<=prgridselend) THEN
         cellcolor=clhilight
         prgrid.fillrect(r.left,r.top,r.right,r.bottom,cellcolor)
         prgrid.textout(r.left+2,r.top+2,prgrid.cell(col,row),clhilighttext,clhilight)
        END IF
       END IF
      END IF
     END SUB

     SUB celledited(col AS INTEGER, row AS INTEGER, VAL AS STRING) 'when editing col2, adjust bar colors
      IF col=2 THEN painttasks
     END SUB

'defint prforcecol1=false
     DECLARE FUNCTION GetKeyState LIB "user32" ALIAS "GetKeyState" (vKey AS LONG) AS INTEGER
     SUB cellselected(col AS INTEGER, row AS INTEGER, byref canselect AS INTEGER)
      SELECT CASE col
      CASE 4  'prevent selecting column 4 (hidden behind tasks)
       canselect=false
       IF prgrid.row=prgrid.rowcount-1 THEN 'if this is the last line, add one:
        prgrid.insertrow(prgrid.rowcount)
       END IF
       prgrid.row=prgrid.row+1
       prgrid.col=2
      CASE 1   'prevent selecting column 1 (hidden)
    '    if prforcecol1 then
    '        prforcecol1=false
    '    else
    '        canselect=false
    '        prgrid.col=2
    '    end if
      CASE 0  'select rows when clicking column 0
       IF currenttask>=0 THEN 'unselect task
        currenttask=-1
        painttasks
       END IF
       IF (prgridselstart=row)AND(prgridselstart=prgridselend) THEN 'unselect row if click on the one selected row
        prgridselstart=-1 : prgridselend=-1
        paintgrid : painttasks
        canselect=false
        prgrid.row=row
            'prforcecol1=true
        prgrid.col=1
        EXIT SUB
       END IF
       IF (GetKeyState(16)>1)AND(prgridselstart>=0) THEN  'row already selected + shift pressed -> extend selection
        IF row>prgridselstart THEN
         prgridselend=row
        ELSE
         prgridselend=prgridselstart
         prgridselstart=row
        END IF
       ELSE 'select current row
        prgridselstart=row : prgridselend=row
       END IF
       paintgrid : painttasks
       canselect=false
        'prgrid.row=row
        'prforcecol1=true
       prgrid.col=1
      CASE 2,3
       IF prgridselstart>=0 THEN
        prgridselstart=-1 : prgridselend=-1
        paintgrid : painttasks
       END IF
      END SELECT
     END SUB

'SCROLLCHANGE : horizontal scroll bar
     SUB scrollchange
      prDisplayoffset=prHscrollbar.position
      painttasks
'don't keep focus
      IF currenttask<0 THEN
       setfocus(prgrid.handle)
      ELSE
       setfocus(taskpanel.handle)
      END IF
     END SUB '-(scrollchange)

'-- INITPROJECT: set project display (when switching to another project)
     SUB initproject
      DIM maxdate AS DOUBLE, datefin AS DOUBLE
      DIM i AS INTEGER
      closeproject  'save data of previous project: transfer grid data to lists prdones and prtexts
      currentproject=VAL(logicalprojectindex.item(prtabs.tabindex)) 'get project index corresponding to selected index
      maxdate=prTimecount(currentproject)  'get latest date in project, to set scrollbar max to this value
      FOR i=0 TO prtasks(currentproject).itemcount-1
       datefin=VAL(FIELD$(prtasks(currentproject).item(i),CHR$(9),3))
       IF datefin>maxdate THEN maxdate=datefin
      NEXT
      prgrid.row=1
      prgrid.rowcount=prdones(currentproject).itemcount+1 'get grid data from prdones and prtexts
      FOR i=0 TO prdones(currentproject).itemcount-1
       prgrid.cell(2,i+1)=prdones(currentproject).item(i)
       prgrid.cell(3,i+1)=prtexts(currentproject).item(i)
      NEXT
      SELECT CASE prTimeUnit(currentproject)
      CASE s_monthunit
       prTimeSubdiv=4
      CASE s_weekunit
       prTimeSubdiv=prworkdaysinweek
      END SELECT
      prHscrollbar.max=maxdate
      prHscrollbar.position=0
      prdisplayoffset=0
      prtoday=counttime(prstartdate(currentproject),todaystr)
      prgrid.toprow=1
      currenttask=-1
      painttasks
      prgridselstart=-1 : prgridselend=-1
      setfocus(prgrid.handle)
     END SUB


'---------------------- EVENTS
     CONST prnone=-1
     CONST prmoving=1 : CONST prcreating=2
     CONST prlinking=3 : CONST prredimleft=4 : CONST prredimright=5
     DEFINT prAction=prnone
     DEFINT prCanredim=0
'------------------shadow task
     CREATE prshadow AS QPANEL
      PARENT=taskpanel
      bevelwidth=0
      borderstyle=0
      width=0
      height=0
     END CREATE
     DIM shadowleft AS INTEGER, shadowright AS INTEGER, shadowy AS INTEGER
     SUB prshowshadow
      DIM tempo AS INTEGER, ycenter AS INTEGER
      IF shadowleft>shadowright THEN
       tempo=shadowleft
       shadowleft=shadowright
       shadowright=tempo
      END IF
      ycenter=((shadowy-prgrid.toprow)+2.5)*prVunit
      IF shadowleft=shadowright THEN
       prshadow.left=shadowleft-2
       prshadow.width=5
       prshadow.top=ycenter-prVunit*0.4+1
       prshadow.height=prVunit*0.8+1
      ELSE
       prshadow.top=ycenter-*prVunit*0.25+1 : prshadow.height=prVunit*0.5
       prshadow.left=shadowleft
       prshadow.width=shadowright-shadowleft
      END IF
     END SUB '-(prshowshadow)
'-------------- end shadow task

     DIM prx0 AS DOUBLE, prearliest AS DOUBLE
     DIM prshadowleft0 AS INTEGER, prshadowright0 AS INTEGER, prmousex0 AS DOUBLE
     DEFINT prIsdragging=false
     DECLARE SUB prscrolltimeout
     CREATE prscrolltimer AS QTIMER
      interval=prscrolldelay
      enabled=false
      tag=1
      ontimer=prscrolltimeout
     END CREATE
     SUB prscrolltimeout
      prscrolltimer.enabled=false
      prscrolltimer.tag=1
     END SUB
     SUB prmousedown(button AS INTEGER, x AS INTEGER, y AS INTEGER, shift AS INTEGER)
      DIM y0 AS INTEGER, thistask AS INTEGER, yy AS INTEGER
      DIM x0 AS DOUBLE, s AS STRING, x1 AS DOUBLE, x2 AS DOUBLE, dx AS INTEGER
      DIM newx AS INTEGER, newxx AS DOUBLE, xx AS DOUBLE
      DIM mycursorh AS LONG, cursorcode AS LONG
      y0=INT(y/prVunit)+prgrid.toprow-1
      x0=prscreentodate(x)
      thistask=taskat(x0,y0)
      setfocus(taskpanel.handle)
      prgridselstart=-1 : prgridselend=-1 : paintgrid
      IF thistask>=0 THEN
       currenttask=thistask
       prearliest=earlieststart(currenttask)
       IF prearliest<0 THEN prearliest=0
       SELECT CASE prcanredim
       CASE 1 : praction=prredimleft : prcanv.cursor=crSizeWE : cursorcode=32644&
       CASE 2 : praction=prredimright : prearliest=taskstart(currenttask) : prcanv.cursor=crSizeWE : cursorcode=32644&
       CASE ELSE
        IF shift=1 THEN
         praction=prlinking
         prcanv.cursor=crHandPoint  : cursorcode=32649
        ELSE
         praction=prmoving
         prcanv.cursor=0 : cursorcode=32512&
        END IF
       END SELECT
      ELSE
       currenttask=-1
       praction=prcreating
       prearliest=0
       prcanv.cursor=0 : cursorcode=32512&
      END IF
'force immediate cursor change
      mycursorh=loadcursor(0,cursorcode)
      setcursor(mycursorh)
      painttasks
      SELECT CASE prAction
      CASE prmoving, prredimleft, prredimright
       prshadow.COLOR=currentcolor
       shadowy=y0
       s=prtasks(currentproject).item(currenttask)
       x1=VAL(FIELD$(s,CHR$(9),2)) : prshadowleft0=prdatetoscreen(x1) : shadowleft=prshadowleft0
       x2=VAL(FIELD$(s,CHR$(9),3)) : prshadowright0=prdatetoscreen(x2) : shadowright=prshadowright0
       prshowshadow
       prmousex0=x
      CASE prcreating
       prshadow.COLOR=&hff9999
       shadowy=y0
       prshadowleft0=prdatetoscreen(x0) : shadowleft=prshadowleft0
       shadowright=shadowleft
       prshowshadow
      END SELECT
      prIsdragging=true
      WHILE prIsdragging
       x=MOUSEX : y=MOUSEY
'autoscroll
       IF x<0 THEN
        IF (prscrolltimer.tag=1)AND(prDisplayoffset>0) THEN
         prscrolltimer.enabled=true : prscrolltimer.tag=0 'reset scroll delay timer
         prDisplayOffset=prDisplayOffset-1
         IF prDisplayOffset<0 THEN prDisplayOffset=0
         prHscrollbar.position=prDisplayOffset
         SELECT CASE praction
         CASE prcreating,prredimright
          prshadowleft0=prdatetoscreen(prscreentodate(prshadowleft0)+1)
         CASE prcreating,prredimleft
          prshadowright0=prdatetoscreen(prscreentodate(prshadowright0)+1)
         END SELECT
        END IF
       END IF
       IF x>prcanv.width THEN
        IF prscrolltimer.tag=1 THEN
         prscrolltimer.enabled=true : prscrolltimer.tag=0 'reset scroll delay timer
         prDisplayOffset=prDisplayOffset+1
         IF prDisplayOffset>prHscrollbar.max THEN prHscrollbar.max=prDisplayOffset
         prHscrollbar.position=prDisplayOffset
         SELECT CASE praction
         CASE prcreating,prredimright
          prshadowleft0=prdatetoscreen(prscreentodate(prshadowleft0)-1)
         CASE prcreating,prredimleft
          prshadowright0=prdatetoscreen(prscreentodate(prshadowright0)-1)
         END SELECT
        END IF
       END IF
       IF y<0 THEN
        IF (prscrolltimer.tag=1)AND((prAction=prmoving)OR(prAction=prlinking)) THEN
         prscrolltimer.enabled=true : prscrolltimer.tag=0 'reset scroll delay timer
         prPageUp
        END IF
       END IF
       IF y>prcanv.height THEN
        IF (prscrolltimer.tag=1)AND((prAction=prmoving)OR(prAction=prlinking)) THEN
         prscrolltimer.enabled=true : prscrolltimer.tag=0 'reset scroll delay timer
         prPageDown
        END IF
       END IF
'end of autoscroll section
       SELECT CASE prAction
       CASE prmoving
        yy=INT(y/prVunit)+prgrid.toprow-1
        IF (yy>=0)AND(yy<prgrid.rowcount-1) THEN shadowy=yy
        dx=x-prmousex0
        xx=prscreentodate(prshadowleft0+dx)
        IF xx<prearliest THEN
         shadowleft=prdatetoscreen(prearliest)
         shadowright=prdatetoscreen(prearliest+x2-x1)
        ELSE
         shadowleft=prdatetoscreen(xx)
         shadowright=prdatetoscreen(prscreentodate(prshadowright0+dx))
        END IF
        prshowshadow
       CASE prredimleft
        dx=x-prmousex0
        x1=prscreentodate(prshadowleft0+dx)
        IF x1<prearliest THEN x1=prearliest
        IF x1>taskend(currenttask) THEN x1=taskend(currenttask)
        shadowleft=prdatetoscreen(x1)
        shadowright=prdatetoscreen(prscreentodate(prshadowright0))
        prshowshadow
       CASE prredimright
        dx=x-prmousex0
        x2=prscreentodate(prshadowright0+dx)
        IF x2<prearliest THEN x2=prearliest
        shadowright=prdatetoscreen(x2)
        shadowleft=prdatetoscreen(prscreentodate(prshadowleft0))
        prshowshadow
       CASE prlinking
        'do nothing
       CASE prcreating
        newxx=prscreentodate(x)
        IF newxx<prearliest THEN newxx=prearliest
        newx=prdatetoscreen(newxx)
        IF newx>prshadowleft0 THEN
         shadowleft=prshadowleft0
         shadowright=newx
        ELSE
         shadowleft=newx
         shadowright=prshadowleft0
        END IF
        prshowshadow
       END SELECT
       DOEVENTS
      WEND
     END SUB

     SUB prmousemove(x AS INTEGER, y AS INTEGER, shift AS INTEGER)
      DIM xx1 AS DOUBLE, xx2 AS DOUBLE, x1 AS DOUBLE, x2 AS DOUBLE, d AS DOUBLE, yy AS INTEGER, y0 AS INTEGER
      DIM s AS STRING
      IF currenttask>=0 THEN
       yy=INT(y/prVunit)+prgrid.toprow-1
       s=prtasks(currentproject).item(currenttask)
       y0=VAL(FIELD$(s,CHR$(9),1))
       IF yy=y0 THEN
        x1=VAL(FIELD$(s,CHR$(9),2)) : xx1=prdatetoscreen(x1)
        x2=VAL(FIELD$(s,CHR$(9),3)) : xx2=prdatetoscreen(x2)
        IF shift=1 THEN 'ctrl pressed
         IF x1=x2 THEN
          IF ABS(x-xx1)<prvunit*0.4 THEN prcanv.cursor=crHandPoint : prCanredim=0 : EXIT SUB
         ELSE
          IF (x>=xx1)AND(x<=xx2) THEN prcanv.cursor=crHandPoint : prCanredim=0 : EXIT SUB
         END IF
        ELSE 'ctrl not pressed
         d=(x-xx1)/prVunit
         IF x1=x2 THEN 'zero-duration task
          IF (d>=0.2)AND(d<=0.5) THEN prcanv.cursor=crSizeWE : prCanredim=2 : EXIT SUB
          IF (-d>=0.2)AND(-d<=0.5) THEN prcanv.cursor=crSizeWE : prCanredim=1 : EXIT SUB
         ELSE 'non-zero
          IF (d>=-0.5)AND(d<=0.3) THEN prcanv.cursor=crSizeWE : prCanredim=1 : EXIT SUB
          d=(xx2-x)/prvunit
          IF (d>=-0.5)AND(d<=0.3) THEN prcanv.cursor=crSizeWE : prCanredim=2 : EXIT SUB
         END IF
        END IF
       END IF
      END IF
      prcanv.cursor=0 : prCanredim=0
     END SUB

     SUB prmouseup(button AS INTEGER, x AS INTEGER, y AS INTEGER, shift AS INTEGER)
      DIM s AS STRING, x1 AS DOUBLE, x2 AS DOUBLE, x0 AS DOUBLE, y0 AS INTEGER
      prIsdragging=false
      SELECT CASE prAction
      CASE prmoving, prredimleft, prredimright
       x1=prscreentodate(shadowleft)
       x2=prscreentodate(shadowright)
       s=STR$(shadowy)+CHR$(9)+STR$(x1)+CHR$(9)+STR$(x2)
       prtasks(currentproject).item(currenttask)=s
       prshadow.width=0
       pushtasks(currenttask)
      CASE prcreating
       x1=prscreentodate(shadowleft)
       x2=prscreentodate(shadowright)
       s=STR$(shadowy)+CHR$(9)+STR$(x1)+CHR$(9)+STR$(x2)
       prtasks(currentproject).additems(s)
       prshadow.width=0
       currenttask=prtasks(currentproject).itemcount-1
      CASE prlinking
       DIM parenttask AS INTEGER, linkexists AS INTEGER, linkstr AS STRING
       y0=INT(y/prVunit)+prgrid.toprow-1
       x0=prscreentodate(x)
       parenttask=taskat(x0,y0)
       IF parenttask<0 THEN prAction=prnone: EXIT SUB
        'if the 2 tasks are already linked, delete the link
       linkexists=findlink(parenttask,currenttask)
       IF linkexists>=0 THEN
        prlinks(currentproject).delitems(linkexists)
        painttasks
        prAction=prnone
        EXIT SUB
       END IF
        'else check for circular links
       IF islinked(currenttask,parenttask) THEN
        SHOWMESSAGE(s_circularlink)
        prAction=prnone
        EXIT SUB
       END IF
        'else create link
       linkstr=format$("%4.4d",parenttask)+CHR$(9)+format$("%4.4d",currenttask)
       prlinks(currentproject).additems(linkstr)
       pushtasks(parenttask)
      END SELECT
      prAction=prnone
      painttasks
     END SUB

'----------------------- Load and Save

'-- NEWPROJECT: create new empty project
     SUB newproject (projname AS STRING, projdate AS STRING, projunit AS STRING, projcount AS INTEGER)
      DIM i AS INTEGER
      logicalprojectindex.additems(STR$(nbprojects))
      prtabs.addtabs(projname)
      REDIM prtasks(nbprojects) AS QSTRINGLIST
      REDIM prlinks(nbprojects) AS QSTRINGLIST
      prlinks(nbprojects).sorted=true
      REDIM prdones(nbprojects) AS QSTRINGLIST
      REDIM prtexts(nbprojects) AS QSTRINGLIST
      REDIM prstartdate(nbprojects) AS STRING
      REDIM prtimeunit(nbprojects) AS STRING
'redim prtimecount(nbprojects) as integer
      prtasks(nbprojects).clear
      prdones(nbprojects).clear
      prtexts(nbprojects).clear
      prstartdate(nbprojects)=projdate
      prtimeunit(nbprojects)=projunit
      prtimecount(nbprojects)=projcount
      FOR i=1 TO INT((form.height-76-54)/prVunit)+1
       prdones(nbprojects).additems("")
       prtexts(nbprojects).additems("")
      NEXT
      nbprojects++
     END SUB '-(newproject)

'-- OPENPROJECTS: get projects from file, called once in Globalinit
     FUNCTION getline(projlist AS QSTRINGLIST, byref j AS INTEGER) AS STRING
      DIM s AS STRING
      s=projlist.item(j)
      j=j+1
      IF LEFT$(s,1)="'" THEN
       getline=getline(projlist,j)
      ELSE
       getline=s
      END IF
     END FUNCTION '-(getline)
     SUB openprojects
      DIM projlist AS QSTRINGLIST
      DIM i AS INTEGER, j AS INTEGER, nbtasks AS INTEGER, k AS INTEGER, nblines AS INTEGER, nblinks AS INTEGER
      DIM s AS STRING, thisline AS STRING
      logicalprojectindex.clear
      IF FILEEXISTS(prfile) THEN
       j=0
       projlist.loadfromfile(prfile)
       nbprojects=VAL(getline(projlist,j))  'get nb of projects
       i=nbprojects-1
       IF i<>0 THEN
        REDIM prstartdate(i) AS STRING
        REDIM prtimeunit(i) AS STRING
        'redim prtimecount(i) as integer
        REDIM prtasks(i) AS QSTRINGLIST
        REDIM prdones(i) AS QSTRINGLIST
        REDIM prtexts(i) AS QSTRINGLIST
        REDIM prlinks(i) AS QSTRINGLIST
       END IF
       FOR i=0 TO nbprojects-1              'for each project :
        logicalprojectindex.additems(STR$(i))
        prtabs.addtabs(getline(projlist,j))  'get name
        prstartdate(i)=getline(projlist,j)   'get start date
        prtimeunit(i)=getline(projlist,j) 'get time unit
        prtimecount(i)=VAL(getline(projlist,j)) 'get time count
        nbtasks=VAL(getline(projlist,j))        'get nb of tasks
        prtasks(i).clear
        FOR k=1 TO nbtasks                      'get tasks
         prtasks(i).additems(getline(projlist,j))
        NEXT
        nblines=VAL(getline(projlist,j)) 'nb of lines
        prdones(i).clear
        prtexts(i).clear
        s=getline(projlist,j)
        FOR k=1 TO nblines
         thisline=FIELD$(s,crsubst,k)
         prdones(i).additems(FIELD$(thisline,CHR$(9),1))
         prtexts(i).additems(FIELD$(thisline,CHR$(9),2))
        NEXT
        nblinks=VAL(getline(projlist,j)) 'nb of links
        prlinks(i).clear
        prlinks(i).sorted=true
        s=getline(projlist,j)
        FOR k=1 TO nblinks
         thisline=FIELD$(s,crsubst,k)
         prlinks(i).additems(thisline)
        NEXT
       NEXT
      ELSE 'no project file
       nbprojects=0
       newproject("Projet 1",LEFT$(todaystr,4)+"-01-01",s_Monthunit,12)
      END IF
      prtabs.tabindex=0
'initproject
     END SUB '-(openprojects)

'-- CLOSEPROJECT: close project and save text data
     SUB closeproject
      IF currentproject<0 THEN EXIT SUB
      DIM i AS INTEGER
      prdones(currentproject).clear
      prtexts(currentproject).clear
      FOR i=0 TO prgrid.rowcount-2
       prdones(currentproject).additems(prgrid.cell(2,i+1))
       prtexts(currentproject).additems(prgrid.cell(3,i+1))
      NEXT
     END SUB '-(closeproject)

'-- PRSAVE: save projects
     SUB prsave
      DIM prlist AS QSTRINGLIST
      DIM s AS STRING, projname AS STRING
      DIM i AS INTEGER, j AS INTEGER, k AS INTEGER
      closeproject
      prlist.clear
      prlist.additems("'    Number of projects:")
      prlist.additems(STR$(logicalprojectindex.itemcount))
      FOR k=0 TO logicalprojectindex.itemcount-1
       prlist.additems("'")
       prlist.additems("'----------------------------------")
       projname=prtabs.tab(k)
       prlist.additems("'    Project n°"+STR$(k)+" : "+projname)
       prlist.additems(projname)
       i=VAL(logicalprojectindex.item(k))
       prlist.additems("'start date")
       prlist.additems(prstartdate(i))
       prlist.additems("'time unit")
       prlist.additems(prTimeUnit(i))
       prlist.additems("'nb of time units displayed")
       prlist.additems(STR$(prTimeCount(i)))
       prlist.additems("'nb of tasks")
       prlist.additems(STR$(prtasks(i).itemcount))
       prlist.additems("'tasks :")
       FOR j=0 TO prtasks(i).itemcount-1
        prlist.additems(prtasks(i).item(j))
       NEXT
       prlist.additems("'nb of lines")
       prlist.additems(STR$(prdones(i).itemcount))
       prlist.additems("'lines :")
       s=""
       FOR j=0 TO prdones(i).itemcount-1
        IF j<>0 THEN s=s+CRsubst
        s=s+prdones(i).item(j)+CHR$(9)+prtexts(i).item(j)
       NEXT
       prlist.additems(s)
       prlist.additems("'nb of links")
       prlist.additems(STR$(prlinks(i).itemcount))
       prlist.additems("'links :")
       s=""
       FOR j=0 TO prlinks(i).itemcount-1
        IF j<>0 THEN s=s+CRsubst
        s=s+prlinks(i).item(j)
       NEXT
       prlist.additems(s)
      NEXT
      prlist.savetofile(prfile)
     END SUB

'-- MENUPROJECTNEW: new project
     DECLARE SUB prclickOK
     DECLARE SUB prclickcancel
     DECLARE SUB prdialogkey(key AS WORD, shift AS INTEGER)
     CREATE prnamedialog AS QFORM
      CAPTION = s_NewProject
      Width = 317
      Height = 201
      Center
      visible=false
      keypreview=true
      onkeydown=prdialogkey
      onclose=prclickcancel
      CREATE Label1 AS QLABEL
       CAPTION = s_projname
       Left = 12
       Top = 20
       Width = 90
      END CREATE
      CREATE Label2 AS QLABEL
       CAPTION = s_startdate
       Left = 12
       Top = 58
       Width = 90
       Transparent = 1
      END CREATE
      CREATE Label3 AS QLABEL
       CAPTION = s_duration
       Left = 12
       Top = 102
       Width = 90
      END CREATE
      CREATE prnameedit AS QEDIT
       Text = ""
       Left = 105
       Top = 18
       taborder=0
      END CREATE
      CREATE prdateedit AS QEDIT
       Text = "prdateedit"
       Left = 105
       Top = 55
       TabOrder = 1
      END CREATE
      CREATE prcountcombo AS QCOMBOBOX
       Text = "12"
       Left = 105
       Top = 100
       Width = 65
       TabOrder = 2
       additems("3","6","12","24")
      END CREATE
      CREATE prunitcombo AS QCOMBOBOX
       Text = s_monthunit
       Left = 187
       Top = 100
       Width = 105
       TabOrder = 3
       additems(s_monthunit,s_weekunit)
      END CREATE
      CREATE Button1 AS QBUTTON
       CAPTION = "OK"
       Left = 105
       Top = 145
       TabOrder = 4
       onclick=prclickOK
      END CREATE
      CREATE Button2 AS QBUTTON
       CAPTION = s_Cancel
       Left = 216
       Top = 145
       TabOrder = 5
       onclick=prclickcancel
      END CREATE
     END CREATE
     SUB prclickcancel
      prnameedit.text=""
      prnamedialog.visible=false
     END SUB
     SUB prclickOK
      prnamedialog.visible=false
     END SUB
     SUB prdialogkey(key AS WORD, shift AS INTEGER)
      SELECT CASE key
      CASE 27 : prclickcancel
      CASE 13 : prclickOK
      END SELECT
     END SUB
     SUB menuprojectnew
      DIM ladate AS STRING, s AS STRING
      DIM p1 AS INTEGER, p2 AS INTEGER, y AS INTEGER, m AS INTEGER, d AS INTEGER
      $IFDEF FRANCAIS
       ladate="01"+"."+LEFT$(DATE$,2)+"."+RIGHT$(DATE$,2) 'mid$(date$,4,2)+"."+left$(date$,2)+"."+right$(date$,2)
      $ELSE
       ladate=DATE$
      $ENDIF
      prnameedit.text=""
      prdateedit.text=ladate
      prnamedialog.visible=true
      setfocus(prnameedit.handle)
      WHILE prnamedialog.visible
       DOEVENTS
      WEND
      IF prnameedit.text="" THEN EXIT SUB
'create new project
      s=prdateedit.text
      p1=INSTR(s,".")+INSTR(s,"/")+INSTR(s,"-")
      p2=INSTR(p1+1,s,".")+INSTR(p1+1,s,"/")+INSTR(p1+1,s,"-")
      y=VAL(MID$(s,p2+1,LEN(s)-p2))
      IF y<100 THEN y=y+2000
      $IFDEF francais
       m=VAL(MID$(s,p1+1,p2-p1-1))
       d=VAL(LEFT$(s,p1-1))
      $ELSE
       d=VAL(MID$(s,p1+1,p2-p1-1))
       m=VAL(LEFT$(s,p1-1))
      $ENDIF
      IF m<1 THEN m=1 : IF m>12 THEN m=12
      IF d<1 THEN d=1 : IF d>nbdaysinmonth(y,m) THEN d=nbdaysinmonth(y,m)
      ladate=numtodate(y,m,d)
      IF (prunitcombo.text<>s_monthunit)AND(prunitcombo.text<>s_weekunit) THEN prunitcombo.text=s_monthunit
      IF VAL(prcountcombo.text)=0 THEN prcountcombo.text="12"
      newproject(prnameedit.text,ladate,prunitcombo.text,VAL(prcountcombo.text))
      prtabs.tabindex=nbprojects-1
      initproject
     END SUB

'-- MENUPROJECTMODIFY: modify project
     SUB menuprojectmodify
      DIM s AS STRING, ladate AS STRING
      DIM p1 AS INTEGER, p2 AS INTEGER, y AS INTEGER, m AS INTEGER, d AS INTEGER, i AS INTEGER
      DIM oldunit AS STRING, newunit AS STRING, date1 AS STRING, date2 AS STRING
      DIM delta AS DOUBLE, X1 AS DOUBLE, x2 AS DOUBLE
      DEFINT startbeforestart=false 'are there tasks beginning before project startdate
'initialize dialog box
      prnameedit.text=prtabs.tab(prtabs.tabindex)
      date1=prStartdate(currentproject)
      $IFDEF FRANCAIS
       prdateedit.text=RIGHT$(date1,2)+"." + MID$(date1,6,2)+"."+MID$(date1,3,2)
      $ELSE
       prdateedit.text=MID$(date1,6,2)+"." + RIGHT$(date1,2)+"."+MID$(date1,3,2)
      $ENDIF
      prunitcombo.text=prtimeunit(currentproject)
      prcountcombo.text=STR$(prtimecount(currentproject))
'show dialog
      prnamedialog.visible=true
      setfocus(prnameedit.handle)
      WHILE prnamedialog.visible
       DOEVENTS
      WEND
      IF prnameedit.text="" THEN EXIT SUB
'test validity
      s=prdateedit.text
      p1=INSTR(s,".")+INSTR(s,"/")+INSTR(s,"-")
      p2=INSTR(p1+1,s,".")+INSTR(p1+1,s,"/")+INSTR(p1+1,s,"-")
      y=VAL(MID$(s,p2+1,LEN(s)-p2))
      IF y<100 THEN y=y+2000
      $IFDEF francais
       m=VAL(MID$(s,p1+1,p2-p1-1))
       d=VAL(LEFT$(s,p1-1))
      $ELSE
       d=VAL(MID$(s,p1+1,p2-p1-1))
       m=VAL(LEFT$(s,p1-1))
      $ENDIF
      IF m<1 THEN m=1 : IF m>12 THEN m=12
      IF d<1 THEN d=1 : IF d>nbdaysinmonth(y,m) THEN d=nbdaysinmonth(y,m)
      ladate=numtodate(y,m,d)
      IF (prunitcombo.text<>s_monthunit)AND(prunitcombo.text<>s_weekunit) THEN prunitcombo.text=s_monthunit
      IF VAL(prcountcombo.text)=0 THEN prcountcombo.text="12"
'edit project
      prtabs.tab(prtabs.tabindex)=prnameedit.text 'project name
'time shift
      delta=counttime(prStartdate(currentproject),ladate)
      FOR i=0 TO prtasks(currentproject).itemcount-1
       s=prtasks(currentproject).item(i)
       x1=VAL(FIELD$(s,CHR$(9),2))
       x2=VAL(FIELD$(s,CHR$(9),3))
       IF x1<delta THEN startbeforestart=true
       s=FIELD$(s,CHR$(9),1) + CHR$(9) + STR$(align(x1-delta))+ CHR$(9) + STR$(align(x2-delta))
       prtasks(currentproject).item(i)=s
      NEXT
      IF startbeforestart THEN SHOWMESSAGE(s_prmaskwarning)
'time unit conversion
      oldunit=prTimeUnit(currentproject)
      newunit=prunitcombo.text
      IF newunit <> oldunit THEN
       FOR i=0 TO prtasks(currentproject).itemcount-1
        s=prtasks(currentproject).item(i)
        x1=VAL(FIELD$(s,CHR$(9),2))
        x2=VAL(FIELD$(s,CHR$(9),3))
        prTimeUnit(currentproject)=oldunit
        SELECT CASE prTimeUnit(currentproject)
        CASE s_monthunit
         prTimeSubdiv=4
        CASE s_weekunit
         prTimeSubdiv=prworkdaysinweek
        END SELECT
        date1=advancetime(ladate,x1)
        date2=advancetime(ladate,x2)
        prTimeUnit(currentproject)=newunit
        SELECT CASE prTimeUnit(currentproject)
        CASE s_monthunit
         prTimeSubdiv=4
        CASE s_weekunit
         prTimeSubdiv=prworkdaysinweek
        END SELECT
        x1=counttime(ladate,date1)
        x2=counttime(ladate,date2)
        s=FIELD$(s,CHR$(9),1) + CHR$(9) + STR$(align(x1)) + CHR$(9) + STR$(align(x2))
        prtasks(currentproject).item(i)=s
       NEXT
      END IF
      prTimeUnit(currentproject)=newunit
      SELECT CASE prTimeUnit(currentproject)
      CASE s_monthunit
       prTimeSubdiv=4
      CASE s_weekunit
       prTimeSubdiv=prworkdaysinweek
      END SELECT
      prTimeCount(currentproject)=VAL(prcountcombo.text)
      prStartdate(currentproject)=ladate
      prtoday=counttime(prstartdate(currentproject),todaystr)
      painttasks
     END SUB

'-- MENUPROJECTDELETE: delete project
     CONST TCM_FIRST = &H1300
     CONST TCM_DELETEITEM = (TCM_FIRST + 8)
     SUB menuprojectdelete
      DIM i AS INTEGER
      IF logicalprojectindex.itemcount=1 THEN EXIT SUB 'leave at least 1 project
      IF MESSAGEDLG(s_confirmprdelete, mtWarning, mbYes OR mbNo, 0) <> mrYes THEN EXIT SUB 'confirm dialog
      closeproject
      i=prtabs.tabindex
      logicalprojectindex.delitems(i)
'delete tab item. the normal way prtabs.deltabs(prtabs.tabindex) doesn't work --> work around
      sendmessage(prtabshandle,TCM_DELETEITEM,i,0) 'delete tab item #i
      IF i<>0 THEN i--
      prtabs.tabindex=i
      setfocus(prtabshandle)
      initproject
     END SUB

'-- MENUPROJECTOPTIMIZE
     SUB menuprojectoptimize
      DIM i AS INTEGER, early AS DOUBLE, dooncemore AS INTEGER
      DO
       dooncemore=false
       FOR i=0 TO prtasks(currentproject).itemcount-1
        early=earlieststart(i)
        IF (taskstart(i)>early)AND(early>=0) THEN
         pushtask(i,early)
         dooncemore=true
        END IF
       NEXT
      LOOP UNTIL dooncemore=false
      painttasks
     END SUB '-(menuprojectoptimize)

'-- PRINSERTROWS: insert rows
     SUB prinsertrows(where AS INTEGER, nb AS INTEGER)
      DIM i AS INTEGER, s AS STRING, y AS INTEGER
      FOR i=1 TO nb
       prgrid.insertrow(where)
      NEXT
      FOR i=0 TO prtasks(currentproject).itemcount-1
       y=taskline(i)
       IF y>=where-1 THEN
        y=y+nb
        s=prtasks(currentproject).item(i)
        s=STR$(y)+CHR$(9)+FIELD$(prtasks(currentproject).item(i),CHR$(9),2)+CHR$(9)+FIELD$(prtasks(currentproject).item(i),CHR$(9),3)
        prtasks(currentproject).item(i)=s
       END IF
      NEXT
     END SUB '-(prinsertrows)

'-- MENUPROJECTINSERT: insert rows at selection point
     SUB menuprojectinsert
      DIM i AS INTEGER, s AS STRING, y AS INTEGER, nbrows AS INTEGER, where AS INTEGER
      IF prgridselstart>=0 THEN
       where=prgridselstart
       nbrows=prgridselend-prgridselstart+1
      ELSE
       IF prgrid.col=1 THEN EXIT SUB
       where=prgrid.row
       nbrows=1
      END IF
      prinsertrows(where,nbrows)
      prgridselstart=-1 : prgridselend=-1
      painttasks
     END SUB

'-- PRDELETETASK: delete task
     SUB prdeletetask(j AS INTEGER)
      DIM i AS INTEGER, origin AS INTEGER, dest AS INTEGER
    'delete links involving task #j ; shift by 1 links involving tasks >j
      prlinks(currentproject).sorted=false
      FOR i=prlinks(currentproject).itemcount-1 TO 0 STEP -1
       origin=linkorigin(i) : dest=linkdest(i)
       IF (origin=j)OR(dest=j) THEN
        prlinks(currentproject).delitems(i)
       ELSE
        IF origin>j THEN setorigin(i,origin-1)
        IF dest>j THEN setdest(i,dest-1)
       END IF
      NEXT
      prlinks(currentproject).sorted=true
    'delete task
      prtasks(currentproject).delitems(j)
     END SUB '-(prdeletetask)

'-- PRDELETE: delete item
     SUB PRdelete
      DIM y AS INTEGER, nbrows AS INTEGER, s AS STRING, i AS INTEGER
      IF getfocus=taskpanel.handle THEN 'delete task
       IF currenttask<0 THEN EXIT SUB
    'delete links involving task #currenttask ; shift by 1 links involving tasks >currenttask
       prdeletetask(currenttask)
       currenttask=-1
       setfocus(prgrid.handle)
       painttasks
      ELSE 'if getfocus=prgrid.handle then 'delete selected grid lines
       IF prgridselstart<0 THEN EXIT SUB
       nbrows=prgridselend-prgridselstart+1
       FOR i=prtasks(currentproject).itemcount-1 TO 0 STEP -1
        y=taskline(i)
        'delete tasks in selected lines
        IF (y>=prgridselstart-1)AND(y<prgridselend) THEN prdeletetask(i)
        'move up tasks in following lines
        IF y>=prgridselend THEN
         y=y-nbrows
         s=prtasks(currentproject).item(i)
         s=STR$(y)+CHR$(9)+FIELD$(prtasks(currentproject).item(i),CHR$(9),2)+CHR$(9)+FIELD$(prtasks(currentproject).item(i),CHR$(9),3)
         prtasks(currentproject).item(i)=s
        END IF
       NEXT
    'add empty rows to window's bottom
    'form.caption=str$(int((form.height-76-54)/prVunit)+2-prgrid.rowcount)
       FOR i=prgrid.rowcount TO INT((form.height-76-54)/prVunit)+nbrows+1
        prgrid.insertrow(prgrid.rowcount)
       NEXT
    'delete grid rows
'prgrid.row=1
       FOR i=1 TO nbrows
'showmessage(str$(i)+"/"+str$(nbrows)+" del "+str$(prgridselstart)+"/"+str$(prgrid.rowcount)+" ->"+str$(prgrid.row))
        prgrid.deleterow(prgridselstart)
       NEXT
       prgridselstart=-1 : prgridselend=-1
       painttasks
       paintgrid
      END IF
     END SUB

'-- PRCOPY: copy
     SUB prcopy
      DIM s AS STRING, i AS INTEGER, nbtasks AS INTEGER, nblinks AS INTEGER, y AS INTEGER
      DIM stasks AS STRING, slinks AS STRING, z AS INTEGER, nbrows AS INTEGER
      DIM localtaskIDs AS QSTRINGLIST
'copy rows
'form.caption=("focus:"+str$(getfocus)+" canv:"+str$(prcanv.handle)+" grid:"+str$(prgrid.handle)+" panel:"+str$(taskpanel.handle))
      IF getfocus=taskpanel.handle THEN EXIT SUB
      IF prgridselstart<0 THEN EXIT SUB
      nbrows=prgridselend+1-prgridselstart
      s="[project data]"+CHR$(13)+STR$(nbrows)+" rows"
      FOR i=0 TO nbrows-1
       s=s+CHR$(13)+prgrid.cell(2,prgridselstart+i)+CHR$(9)+prgrid.cell(3,prgridselstart+i)
      NEXT
      nbtasks=0 : stasks="" : localtaskIDs.clear
      FOR i=0 TO prtasks(currentproject).itemcount-1
       y=taskline(i)
       IF (y>=prgridselstart-1)AND(y<prgridselend)THEN
       nbtasks++
       localtaskIDs.additems(STR$(i))
       stasks=stasks+CHR$(13)+STR$(y+1-prgridselstart)+CHR$(9)+STR$(taskstart(i))+CHR$(9)+STR$(taskend(i))
      END IF
     NEXT
     s=s+CHR$(13)+STR$(nbtasks)+" tasks"+stasks
     nblinks=0 : slinks=""
     FOR i=0 TO prlinks(currentproject).itemcount-1
      y=linkorigin(i) : z=linkdest(i)
      IF (taskline(y)>=prgridselstart-1)AND(taskline(y)<prgridselend)AND(taskline(z)>=prgridselstart-1)AND(taskline(z)<prgridselend) THEN
       nblinks++
       slinks=slinks+CHR$(13)+STR$(localtaskIDs.indexof(STR$(y)))+CHR$(9)+STR$(localtaskIDs.indexof(STR$(z)))
      END IF
     NEXT
     s=s+CHR$(13)+STR$(nblinks)+" links"+slinks
     clipboard.text=s
     END SUB

'-- PRCUT: cut
     SUB prcut
      prcopy
      prdelete
     END SUB


'-- PRPASTE: paste
     FUNCTION tabstep(byref u AS STRING) AS STRING
      DIM p AS INTEGER
      p=INSTR(u,CHR$(13))
      IF p>0 THEN
       tabstep=LEFT$(u,p-1)
       u=MID$(u,p+1,LEN(u)-p)
      ELSE
       tabstep=u
       u=""
      END IF
     END FUNCTION
     SUB prpaste
      DIM s AS STRING, ss AS STRING
      DIM nblines AS INTEGER, nbtasks AS INTEGER, nblinks AS INTEGER, i AS INTEGER, firstrow AS INTEGER, firsttask AS INTEGER
      DIM y AS INTEGER, x1 AS DOUBLE, x2 AS DOUBLE
      DIM origin AS INTEGER, dest AS INTEGER
      s=clipboard.text
      IF tabstep(s)<>"[project data]" THEN EXIT SUB
      nblines=VAL(tabstep(s))
      IF prgridselstart>=0 THEN
       firstrow=prgridselstart
       prdelete
      ELSE
       firstrow=prgrid.row
      END IF
'insert lines
      prinsertrows(firstrow,nblines)
      FOR i=0 TO nblines-1
       ss=tabstep(s)
       prgrid.cell(2,firstrow+i)=FIELD$(ss,CHR$(9),1)
       prgrid.cell(3,firstrow+i)=FIELD$(ss,CHR$(9),2)
      NEXT
'create tasks
      nbtasks=VAL(tabstep(s))
      firsttask=prtasks(currentproject).itemcount
      FOR i=0 TO nbtasks-1
       ss=tabstep(s)
       y=VAL(FIELD$(ss,CHR$(9),1))
       x1=VAL(FIELD$(ss,CHR$(9),2))
       x2=VAL(FIELD$(ss,CHR$(9),3))
       prtasks(currentproject).additems(STR$(firstrow+y-1)+CHR$(9)+STR$(x1)+CHR$(9)+STR$(x2))
      NEXT
'create links
      nblinks=VAL(tabstep(s))
      FOR i=0 TO nblinks-1
       ss=tabstep(s)
       origin=VAL(FIELD$(ss,CHR$(9),1))
       dest=VAL(FIELD$(ss,CHR$(9),2))
       prlinks(currentproject).additems(STR$(firsttask+origin)+CHR$(9)+STR$(firsttask+dest))
      NEXT
      painttasks
     END SUB '-(prpaste)

'-- PRpageup: move up 1 item
     SUB prpageup
      IF(prgrid.toprow>1) THEN prgrid.toprow=prgrid.toprow-1
     END SUB

'-- PRpagedown: move down 1 item
     SUB prpagedown
      IF prgrid.toprow+prgrid.visiblerowcount<prgrid.rowcount THEN prgrid.toprow=prgrid.toprow+1
     END SUB

'-- prkeydown: handle keydown : check for carriage returns, tabs, escape
     SUB prkeydown(key AS WORD, shift AS INTEGER)
      SELECT CASE key
      CASE 33 : prpageup 'PageUp
      CASE 34 : prpagedown 'PageDown
      CASE 13 'return
       IF prgrid.row=prgrid.rowcount-1 THEN prgrid.insertrow(prgrid.rowcount)
       prgrid.row=prgrid.row+1
      END SELECT
     END SUB

'-- prprint
     SUB prprint
      SHOWMESSAGE(s_addontprint)
     END SUB
     $TYPECHECK off

2013-06-19 07:44