2013-06-19 07:44

'-----------  GRAPHIC CONSTANTS
'dim ljour as integer 'largeur d'un jour en pixels - declared in fichiers.bas
     CONST lheures=36 'largeur de la bande des heures (à gauche) en pixels
'dim hheure as integer 'hauteur d'une heure en pixels - declared in fichiers.bas
     CONST hheader=20 'hauteur de la bande des jours (en haut) en pixels
     CONST leftmargin=4 'marge à gauche
     CONST topmargin=4 'marge en haut
     CONST bottommargin=0.25 ' marge entre heures et notes (en heures)
     CONST hnotes=2 'hauteur de la zone des notes (en heures)
     CONST printmargin=0.04 'percentage of page width/height reserved as printing margin
     $RESOURCE im_calend AS "p:\documents\fun\carnet\source\data\calend.bmp"  'calendar
     CONST magnet=0.11 'intervalle d'alignement automatique sur les colonnes jour (en jours)
     CONST bordure=8  'bordure autour du texte dans sa case
     CONST bordureicone=24 'taille icône
     CONST minwidth=40 'minimum size of an event
     CONST minheight=17
     CONST bleu=&hdd6612

     DIM x0 AS INTEGER : DIM y0 AS INTEGER 'corner of event under creation
     DEFINT nouvelev=0  'flag : =1 if an event is being created
     DEFINT movingev=0  'flag : =1 if an event is being moved
     DEFINT doingredim=0 'flag : >0 if an event is being redimensioned
     DEFINT canredimH=0 : DEFINT canredimV=0 ' flags: =1 if cursor=redim
     DEFINT uboundED=0
     DECLARE SUB selectnone

'-- event handling declarations
     DECLARE SUB mousedownz (Button AS INTEGER, X AS INTEGER, Y AS INTEGER, Shift AS INTEGER)
     DECLARE SUB mousemovez (Button AS INTEGER, X AS INTEGER, Y AS INTEGER, Shift AS INTEGER)
     DECLARE SUB mouseupz (Button AS INTEGER, X AS INTEGER, Y AS INTEGER, Shift AS INTEGER)
     DECLARE SUB clicflechegauche : DECLARE SUB clicflechedroite : DECLARE SUB cliccalendr
     DECLARE SUB zcadreMove
     DECLARE SUB drawz

'------------- WEEK ORGANIZER PANEL
     DIM etiqjour(nbjours) AS QLABEL, etiqheure(nbheures) AS QLABEL 'day and hour labels
     CREATE WeekPanel AS QPANEL   '------------ WEEK ORGANIZER
      PARENT=Tab
      left=4 : top=28
      width=panelwidth: height=panelheight
      COLOR=colorfond
      borderstyle=0 : bevelouter=0 : bevelinner=0
      CREATE zcadre AS QPANEL  'zcadre: main zone, containing the events
       Left = leftmargin+lheures
       Top = topmargin+hheader
       width=nbjours*ljour+3
       height=hheure*(nbheures+hnotes+bottommargin)
       bevelouter=bvnone
       borderstyle=0
       bevelinner=0
       COLOR=&hddf4f4
       font=appsmallfont
       CREATE z AS QCANVAS 'event backdrop
        left=0 : top=0
        width=nbjours*ljour
        height=hheure*(nbheures+hnotes+bottommargin)
        onpaint=drawz
        onmousedown=mousedownz
        onmouseup=mouseupz
        onmousemove=mousemovez
       END CREATE
      END CREATE '(zcadre)
      CREATE heures AS QPANEL 'HEURES frame showing the hours of the day and Leftarrow and Calendar buttons
       left=leftmargin
       top=topmargin
       height=hheure*nbheures+hheader+1
       width=lheures
       COLOR=colorHeader
       bevelouter=bvnone
       borderstyle=1
       CREATE fondboutons AS QPANEL
        left=0:top=0
        width=32:height=17
        COLOR=&hbbbbbb
        bevelouter=bvnone
        borderstyle=0
        CREATE flechegauche AS QCOOLBTN
         bmphandle=im_flecheg
         left=16 : top=0
         width=16 : height=16
         flat=true
         onclick=clicflechegauche
        END CREATE
        CREATE calend AS QCOOLBTN
         bmphandle=im_calend
         left=0:top=0
         width=17 : height=17
         flat=true
         onclick=cliccalendr
        END CREATE
       END CREATE '(fondboutons)
      END CREATE '(heures)
      CREATE header AS QPANEL 'HEADER frame showing the days of the week and the Rightarrow
       left=leftmargin+lheures-2
       top=topmargin
       width=nbjours*ljour+3
       height=hheader
       bevelouter=bvnone
       borderstyle=1
       COLOR=colorHeader
       CREATE fondboutond AS QPANEL
        left=header.width-20
        top=0 : width=20 : height=18
        COLOR=&hbbbbbb
        bevelouter=bvnone
        borderstyle=0
        CREATE flechedroite AS QCOOLBTN
         bmphandle=im_fleched
         left=0 : top=0
         width=16 : height=16
         flat=true
         onclick=clicflechedroite
        END CREATE
       END CREATE
      END CREATE '(header)
     END CREATE '(WeekPanel)

'------- Basic graphic subs
     DECLARE FUNCTION ExtractIcon LIB "shell32.dll" ALIAS "ExtractIconA" (hInst AS LONG,lpszExeFileName AS STRING,nIconIndex AS LONG) AS LONG
     DECLARE FUNCTION DestroyIcon LIB "user32" ALIAS "DestroyIcon" (hIcon AS LONG) AS LONG
     DECLARE FUNCTION DrawIcon LIB "user32" ALIAS "DrawIcon" (hdc AS LONG,x AS LONG,y AS LONG,hIcon AS LONG) AS LONG

     SUB framerect(qc AS QCANVAS, c AS INTEGER) 'frame rectangle, color c
      qc.rectangle(0,0,qc.width,qc.height,c)
     END SUB

     SUB frameedrect(sender AS QCANVAS)  'frame event
      framecolor=IIF(sender.tag=currentev, bleu, 0)
      framerect(sender,framecolor)
     END SUB

     SUB hideallevents
      FOR i=1 TO nbevent
       edcadre(i).visible=False
      NEXT
     END SUB

'------- Basic functions MIN & MAX, NthFIELD
     FUNCTION min (a,b) AS INTEGER
      IF a>b THEN
       min=b
      ELSE
       min=a
      END IF
     END FUNCTION

     FUNCTION max (a,b) AS INTEGER
      IF a<b THEN
       max=b
      ELSE
       max=a
      END IF
     END FUNCTION

     FUNCTION nthfield(s AS STRING,i AS INTEGER) AS DOUBLE
'nème champ, séparé par des blancs
      nthfield=FIELD$(s," ",i)
     END FUNCTION

'------- GHOST EVENT HANDLING
     DIM fantome(0) AS QPANEL
     DIM fantomeframe AS QCANVAS
     DEFINT nbfantomes=0

     SUB fantomeredim(x AS INTEGER, y AS INTEGER)
    'aligne automatiquement sur les bords de colonne :
      IF (ROUND(x+ljour*magnet) MOD ljour)<ljour*(magnet+magnet) THEN x=ROUND(x/ljour)*ljour
    'aligne automatiquement sur les quarts d'heure :
      y=ROUND(y*quartdheure/hheure)*hheure/quartdheure
      gauche=min(x0,X):gauche=max(gauche,0)
      haut=min(y0,Y):haut=max(haut,0)
      largeur=max(X,x0)-gauche
      hauteur=max(Y,y0)-haut
      largeur=min(largeur,zcadre.width-gauche-3)
      hauteur=min(hauteur,zcadre.height-haut)
      fantome(nbfantomes).left=gauche
      fantome(nbfantomes).top=haut
      fantome(nbfantomes).width=largeur
      fantome(nbfantomes).height=hauteur
      fantomeframe.width=largeur : fantomeframe.height=hauteur
     END SUB

     SUB framefantome
      framerect(fantomeframe,bleu)
     END SUB

'-- DRAWZ: draw background lines and date labels
     SUB drawz
      DIM lejour AS STRING, datestr AS STRING
      FOR i=1 TO nbheures-1 'heures
       z.line(0,i*hheure,z.width,i*hheure,&h008888)
      NEXT
      FOR i=0 TO nbheures-1 '1/2 heures
       z.line(0,(i+0.5)*hheure,z.width,(i+0.5)*hheure,&hcccccc)
      NEXT
      FOR i=1 TO nbjours-1  'vertical line between days
       z.fillrect(i*ljour-2,0,i*ljour+2,z.height,colorHeader)
      NEXT
      FOR i=1 TO nbjours
       lejour=advancedays(lundi,i-1)
       datestr=datetext(lejour)
       IF form.textwidth(datestr)>ljour*0.95 THEN datestr=shortdatetext(lejour)
       etiqjour(i).CAPTION="  "+datestr
       etiqjour(i).PARENT=header
       etiqjour(i).left=(i-1)*ljour+2
      NEXT
      z.fillrect(0,nbheures*hheure,z.width,(nbheures+bottommargin)*hheure,colorHeader)
      z.rectangle(0,0,z.width,z.height,&h808080)
     END SUB

'----------- MOUSE HANDLING

'-- MOUSEDOWNZ: Mouse click in main zone
     SUB mousedownz (Button AS INTEGER, X AS INTEGER, Y AS INTEGER, Shift AS INTEGER)
      DIM mycursorh AS LONG, cursorcode AS LONG

'if cursor is not redim cursor --> create new event
      IF canredimH+canredimV=0 THEN GOTO creation

'Redim current event
      SELECT CASE canredimH+canredimV
      CASE 0 : zcadre.cursor=crCross : cursorcode=32515
      CASE 1,2 : zcadre.cursor=crSizeNS : cursorcode=32645
      CASE 4,8 : zcadre.cursor=crSizeWE : cursorcode=32644
      CASE 5,10 : zcadre.cursor=crSizeNWSE : cursorcode=32642
      CASE 6,9 : zcadre.cursor=crSizeNESW : cursorcode=32643
      END SELECT
'force immediate cursor change
      mycursorh=loadcursor(0,cursorcode)
      setcursor(mycursorh)
      doingredim=1
      DO
'boucle : on redimensionne le rectangle à mesure du déplacement de la souris
       x=MOUSEX : y=MOUSEY
    'aligne automatiquement sur les bords de colonne :
       IF (ROUND(x+ljour*magnet) MOD ljour)<ljour*(magnet+magnet) THEN x=ROUND(x/ljour)*ljour
    'aligne automatiquement sur les quarts d'heure :
       y=ROUND(y*quartdheure/hheure)*hheure/quartdheure
    'limites :
       x=max(x,0) : y=max(y,0)
       SELECT CASE canredimH
       CASE 4  'gauche
        largeur=edcadre(currentev).left+edcadre(currentev).width-x
        IF largeur>minwidth THEN
         delta=largeur-edcadre(currentev).width
         edcadre(currentev).left=x
         edcadre(currentev).width=largeur
         edrect(currentev).width=largeur
         ed(currentev).width=ed(currentev).width+delta
        END IF
       CASE 8 'droite
        IF x-edcadre(currentev).left>minwidth THEN
         delta=x-(edcadre(currentev).left+edcadre(currentev).width)
         edcadre(currentev).width=x-edcadre(currentev).left
         edrect(currentev).width=x-edcadre(currentev).left
         ed(currentev).width=ed(currentev).width+delta
        END IF
       END SELECT
       SELECT CASE canredimV
       CASE 1  'haut
        hauteur=edcadre(currentev).top+edcadre(currentev).height-y
        IF hauteur>minheight THEN
         delta=hauteur-edcadre(currentev).height
         edcadre(currentev).top=y
         edcadre(currentev).height=hauteur
         edrect(currentev).height=hauteur
         ed(currentev).height=ed(currentev).height+delta
        END IF
       CASE 2   'bas
        IF y-edcadre(currentev).top>minheight THEN
         delta=y-(edcadre(currentev).top+edcadre(currentev).height)
         edcadre(currentev).height=y-edcadre(currentev).top
         edrect(currentev).height=y-edcadre(currentev).top
         ed(currentev).height=ed(currentev).height+delta
        END IF
       END SELECT
       DOEVENTS
      LOOP UNTIL doingredim=0
      canredimH=0 : canredimV=0
      EXIT SUB

      creation :   'create a new event
      mycursorh=loadcursor(0,32515)
      setcursor(mycursorh)
      x0=X
      y0=Y
'aligne automatiquement sur les bords de colonne :
      IF (ROUND(x0+ljour*magnet) MOD ljour)<ljour*(magnet+magnet) THEN x0=ROUND(x0/ljour)*ljour
'aligne automatiquement sur les quarts d'heure :
      y0=ROUND(y0*quartdheure/hheure)*hheure/quartdheure
'create ghost frame
      nbfantomes++
      REDIM fantome(nbfantomes) AS QPANEL 'redim a new one so that is stands on top of all previous frames
      fantome(nbfantomes).PARENT=zcadre
      fantome(nbfantomes).left=0
      fantome(nbfantomes).top=0
      fantome(nbfantomes).width=0
      fantome(nbfantomes).height=0
      fantome(nbfantomes).borderstyle=0
      fantome(nbfantomes).COLOR=&hffffff
      fantome(nbfantomes).visible=true
      fantomeframe.PARENT=fantome(nbfantomes)
      fantomeframe.left=0:fantomeframe.top=0:fantomeframe.width=0:fantomeframe.height=0
      fantomeframe.onpaint=framefantome
'Création d'une nouvelle case
      nouvelev=1
      DO
'boucle : on redimensionne le rectangle à mesure du déplacement de la souris
       x=MOUSEX:y=MOUSEY
       fantomeredim(x,y)
       DOEVENTS
'jusqu'à ce que le bouton soit relaché : l'événement mouseupz met nouvelev à 0
      LOOP UNTIL nouvelev=0
     END SUB   'MOUSEDOWNZ

'-- MOUSEMOVEZ: mouse moving around in main frame = adjust cursor
     SUB mousemovez(X AS INTEGER, Y AS INTEGER, Shift AS INTEGER)
      IF doingredim<>0 THEN EXIT SUB
      canredimV=0 : canredimH=0
      IF nouvelev=1 THEN EXIT SUB  'if creation under way, do nothing=keep cross cursor
      IF currentev=0 THEN zcadre.cursor=crCross : EXIT SUB
      IF ABS(MOUSEY-edcadre(currentev).top)<=3 THEN canredimV=1
      IF ABS(MOUSEY-edcadre(currentev).top-edcadre(currentev).height)<=3 THEN canredimV=2
      IF (MOUSEX<edcadre(currentev).left-3)OR(MOUSEX>edcadre(currentev).left+edcadre(currentev).width+3) THEN canredimV=0
      IF ABS(MOUSEX-edcadre(currentev).left)<=3 THEN canredimH=4
      IF ABS(MOUSEX-edcadre(currentev).left-edcadre(currentev).width)<=3 THEN canredimH=8
      IF (MOUSEY<edcadre(currentev).top-3)OR(MOUSEY>edcadre(currentev).top+edcadre(currentev).height+3) THEN canredimH=0
      SELECT CASE canredimH+canredimV
      CASE 0 : zcadre.cursor=crCross
      CASE 1,2 : zcadre.cursor=crSizeNS
      CASE 4,8 : zcadre.cursor=crSizeWE
      CASE 5,10 : zcadre.cursor=crSizeNWSE
      CASE 6,9 : zcadre.cursor=crSizeNESW
      END SELECT
     END SUB

     DECLARE SUB bringtofront (i AS INTEGER)
     DECLARE SUB createev(gauche AS INTEGER,lehaut AS INTEGER,large AS INTEGER,hauteur AS INTEGER,letexte AS STRING,iconname AS STRING)

'-- MOUSEUPZ: button released --> end of redim or creation of event
     SUB mouseupz (Button AS INTEGER, X AS INTEGER, Y AS INTEGER, Shift AS INTEGER)
    ' mode Redim
      IF doingredim<>0 THEN
       doingredim=0
       EXIT SUB
      END IF

    ' mode Création
      IF nouvelev=0 THEN EXIT SUB
      nouvelev=0  'met fin à la boucle mousedownz
      fantomeredim(x,y)
      IF fantome(nbfantomes).width+fantome(nbfantomes).height=0 THEN  'click without moving -> create default size event : 1 day x 1 hour
       autolarge=IIF(x0<=(nbjours-1)*ljour,ljour,nbjours*ljour-x0)
       autohaut=IIF(y0<(nbheures+bottommargin+hnotes-1)*hheure,hheure,(nbheures+bottommargin+hnotes)*hheure-y0-1)
       fantome(nbfantomes).width=autolarge
       fantome(nbfantomes).height=autohaut
      END IF
      IF (fantome(nbfantomes).width<minwidth)OR(fantome(nbfantomes).height<minheight) THEN 'rectangle too small -> do nothing
       fantome(nbfantomes).visible=0
       selectnone    'unselect previous event (if any)
       EXIT SUB
      END IF
    'création d'un nouvel événement de mêmes dimensions que le fantôme
      createev(fantome(nbfantomes).left,fantome(nbfantomes).top,fantome(nbfantomes).width,fantome(nbfantomes).height,"","")
    'cacher le fantôme :
      fantome(nbfantomes).visible=False
      bringtofront(nbevent) 'select new event
     END SUB

'-- ClickEDCADRE: click in an event --> moving it around
     SUB clickedcadre(Button AS INTEGER, X AS INTEGER, Y AS INTEGER, Shift AS INTEGER, Sender AS QCANVAS)
      mycursorh=loadcursor(0,32512)
      setcursor(mycursorh)
      mx0=MOUSEX:my0=MOUSEY
      IF currentev=sender.tag THEN 'event is already in front -> OK
       sameevent=true
      ELSE 'event is not in front -> create a twin in the front
       sameevent=false
       bringtofront(Sender.tag)
      END IF
      movingev=1
'edcadre(currentev).cursor=crGrab 'doesn't work : cursor doesn't update
      x0=edcadre(currentev).left : y0=edcadre(currentev).top
      maxx=zcadre.width-edcadre(currentev).width-3
      maxy=zcadre.height-edcadre(currentev).height
      mx0=MOUSEX:my0=MOUSEY
      DO
'boucle : on déplace le rectangle à mesure du déplacement de la souris
       mx=MOUSEX: my=MOUSEY
       x=x0+mx-mx0
       y=y0+my-my0
    'aligne automatiquement sur les bords de colonne :
       IF (ROUND(x+ljour*magnet) MOD ljour)<ljour*(magnet+magnet) THEN x=ROUND(x/ljour)*ljour
    'aligne automatiquement sur les quarts d'heure :
       y=ROUND(y*quartdheure/hheure)*hheure/quartdheure
    'limites :
       x=max(x,0):x=min(x,maxx)
       y=max(y,0):y=min(y,maxy)
       edcadre(currentev).left=x
       edcadre(currentev).top=y
       IF sameevent=true THEN x0=x:y0=y  'coordinates are relative to edcadre -> move to new set of coordinates
       DOEVENTS
'jusqu'à ce que le bouton soit relaché : l'événement unclickedcadre met movingev à 0
      LOOP UNTIL movingev=0
     END SUB

'-- MousemoveEDCADRE: must exist to handle mousedown/mouseup
     SUB mousemoveedcadre(X AS INTEGER, Y AS INTEGER, Shift AS INTEGER)
     END SUB

'-- UnclickEDCADRE: mouse button is released after clicking an event --> end of moving around
     SUB unclickedcadre(Button AS INTEGER, X AS INTEGER, Y AS INTEGER, Shift AS INTEGER, Sender AS QPANEL)
      movingev=0 : edcadre(currentev).cursor=0 'crHand 'mettre fin à la boucle clickedcadre
     END SUB

'-- ClickED: click in text of an event
     SUB clicked(Button AS INTEGER, X AS INTEGER, Y AS INTEGER, Shift AS INTEGER, Sender AS QRICHEDIT)
      bringtofront(Sender.tag)
     END SUB

'-------------- EVENT CREATION AND DISPLAY

'-- DisplayIcon: displays icon in event i. returns width of icon displayed
     FUNCTION displayicon(i AS INTEGER, iconname AS STRING) AS INTEGER
      edicon(i).hint=iconname
      IF iconname="" THEN
       edicon(i).visible=false
       displayicon =0
      ELSE
        'retrieve file name and icon index in that file
       whichicon=VAL(FIELD$(iconname,CHR$(9),2))
       iconname=FIELD$(iconname,CHR$(9),1)
       nbicons=ExtractIcon(application.handle,iconname,-1) 'get nb of icons in file
       IF nbicons=0 THEN  'if no icons -> display none
        edicon(i).visible=false
        displayicon =0
        EXIT FUNCTION
       END IF
       IF whichicon>=nbicons THEN whichicon=0 'if icon number > number of icons in file, show icon #0 (by default)
       edicon(i).visible=true
       displayicon =bordureicone
       DIM iconh AS LONG
       CREATE licone AS QBITMAP 'buffer for drawing icon in its original size
        width=32
        height=32
        fillrect(0,0,32,32,&hffffff) 'erase buffer
       END CREATE
       DIM r1 AS QRECT,r2 AS QRECT
       iconh=ExtractIcon(application.handle,iconname,whichicon) 'à la place de 0 mettre 1..nbicones pour les autres icones
       DrawIcon(licone.handle,0,0,iconh)
       Destroyicon(iconh)
       r1.left=0:r1.top=0:r1.right=bordureicone:r1.bottom=bordureicone
       edicon(i).PARENT=edcadre(i)
       edicon(i).left=2:edicon(i).top=2
       edicon(i).width=bordureicone:edicon(i).height=bordureicone
       edicon(i).stretchdraw(r1,licone.bmp)
       edicon(i).onmousedown=clickedcadre
       edicon(i).onmouseup=unclickedcadre
       edicon(i).onmousemove=mousemoveedcadre
      END IF
     END FUNCTION '-(displayicon)

'-- CreateEV: create a new event
     SUB createev(gauche AS INTEGER,lehaut AS INTEGER,large AS INTEGER,hauteur AS INTEGER,letexte AS STRING,iconname AS STRING)
'exit sub
 '   showmessage(str$(ev.itemcount)):exit sub

      nbevent++
      IF nbevent>uboundED THEN
       REDIM edcadre(nbevent) AS QPANEL
       REDIM ed(nbevent) AS QRICHEDIT
       REDIM edicon(nbevent) AS QIMAGE
       REDIM edrect(nbevent) AS QCANVAS
       uboundED++
      END IF
        'cadre
      edcadre(nbevent).left=gauche
      edcadre(nbevent).top=lehaut
      edcadre(nbevent).width=large
      edcadre(nbevent).height=hauteur
      edcadre(nbevent).PARENT=zcadre
      edcadre(nbevent).borderstyle=0
      edcadre(nbevent).COLOR=&hffffff
      edcadre(nbevent).visible=True
      edcadre(nbevent).cursor=0  'crHand
        'contour
      edrect(nbevent).PARENT=edcadre(nbevent)
      edrect(nbevent).tag=nbevent
      edrect(nbevent).left=0 : edrect(nbevent).top=0
      edrect(nbevent).width=edcadre(nbevent).width : edrect(nbevent).height=edcadre(nbevent).height
      edrect(nbevent).onpaint=frameedrect
      edrect(nbevent).onmousedown=clickedcadre
      edrect(nbevent).onmouseup=unclickedcadre
      edrect(nbevent).onmousemove=mousemoveedcadre
        'icône
      tailleicone=displayicon(nbevent,iconname)
        'texte
      ed(nbevent).left=tailleicone+bordure-5
      ed(nbevent).top=bordure-5
      ed(nbevent).width=large-tailleicone-bordure-bordure+6
      ed(nbevent).height=hauteur-bordure-bordure+6
      ed(nbevent).PARENT=edcadre(nbevent)
      ed(nbevent).borderstyle=0
      letexte=REPLACESUBSTR$(letexte,crSubst,crString) 'restore carriage returns
      ed(nbevent).text=letexte
      ed(nbevent).onmousedown=clicked
      ed(nbevent).tag=nbevent
     END SUB

'-- CreateEVfromString: create new event from event description string
     SUB createevfromstring(s AS STRING)
      DIM letexte AS STRING, dimensions AS STRING, iconname AS STRING, hh1 AS STRING, hh2 AS STRING
      letexte=FIELD$(s,separ,2)
      dimensions =FIELD$(s,separ,3)
      iconname=FIELD$(s,separ,4)
      hh1=nthfield(dimensions,3):lehaut=ROUND((strheure(hh1)-heure1)*hheure)
      hh2=nthfield(dimensions,4):lahauteur=(strheure(hh2)-strheure(hh1))*hheure
      lagauche=(VAL(nthfield(dimensions,1))-firstdaydisplayed)*ljour
      lalargeur=(VAL(nthfield(dimensions,2))-VAL(nthfield(dimensions,1)))*ljour
      lejour=INT(VAL(nthfield(dimensions,1)))
      createev(lagauche, lehaut, lalargeur, lahauteur, letexte, iconname)
     END SUB

'-- BringToFront: brings event #i to front
     SUB bringtofront(i AS INTEGER)
      IF currentev=i THEN EXIT SUB 'event already in front -> do nothing
      cursorpos=ed(i).selstart
      IF (i<>currentev)AND(currentev<>0) THEN framerect(edrect(currentev),0) 'redraw frame of previous event in black
      createevfromstring(eventstring(i)) 'duplicates current event. new event is in front
      edcadre(i).visible=false
      ed(i).text="[[deleted]]" 'delete previous instance
      currentev=nbevent  'current event is new event
      setfocus(ed(currentev).handle)
      ed(currentev).selstart=cursorpos : ed(currentev).sellength=0 'reposition text cursor
     END SUB

'-- SelectNone: deselect all events
     SUB selectnone
      IF (currentev<>0) THEN framerect(edrect(currentev),0)
      currentev=0
     END SUB

'-- BUILDWEEK: extracts week from ev (list of all events) and creates corresponding qpanels
     SUB buildweek
      DIM s AS STRING
      findweek(lundi) 'sets WeekStartIndex and nbeventsinweek
'showmessage("buildweek "+str$(nbeventsinweek)+" events starting #"+str$(weekstartindex))
      nbevent=0
'nbfantomes=0
      FOR i=1 TO nbeventsinweek
       s=ev.item(WeekStartIndex) 'extract i-th event from global list
       ev.delitems(WeekStartIndex) 'and remove from list --> current event is always at index weekstartindex
       createevfromstring(s)
      NEXT
      selectnone
     END SUB 'buildweek

'-- ICONPICKER: select icon when file contains several ones
     DIM whichicon AS INTEGER, nbicons AS INTEGER
     DIM nbiconsinrow AS INTEGER, nbrows AS INTEGER
     DIM iconh AS LONG
     DIM fshortname AS STRING, flongname AS STRING
     CREATE iconform AS QFORM  'icon picker dialog
      width=356 : height=350
      center
      COLOR=&hffffff
      CREATE iconz AS QCANVAS
       left=0:top=0
       width=iconform.width-24
      END CREATE
     END CREATE
     SUB iconformshow
      x=0 : y=0
      FOR i=0 TO nbicons-1
       iconh=ExtractIcon(application.handle,flongname,i)
       DrawIcon(iconz.handle,x*36+2,y*36+2,iconh)
       DestroyIcon(iconh)
       x++
       IF x>=nbiconsinrow THEN
        y++ : x=0
       END IF
      NEXT
     END SUB
     SUB iconformclic (button AS LONG, x AS LONG, y AS LONG, shift AS LONG)
    'click in icon picker window --> return number of item clicked
      xx=INT(x/36) : yy=INT(y/36)
      whichicon=xx+yy*nbiconsinrow
      IF whichicon>=nbicons THEN whichicon=-1
    'and close
      iconform.visible=false
     END SUB
     SUB iconcancel
      whichicon=-1
      iconform.visible=false
     END SUB
     FUNCTION iconpicker(fname AS STRING) AS INTEGER
      nbicons=ExtractIcon(application.handle,fname,-1) 'get nb of icons
      IF nbicons=0 THEN 'no icons: return -1
       iconpicker=-1
       EXIT FUNCTION
      END IF
      extension$=LCASE$(RIGHT$(fname,4))
      IF (extension$=".ico")OR(nbicons=1) THEN 'ico files or files with 1 icon only
       iconpicker=0  'ICO files= always return 1st icon, for simplicity (don't ask user to choose)
       EXIT FUNCTION
      END IF
'several icons: show them and let the user choose
      flongname=fname
      fshortname=FIELD$(fname,"\",TALLY(fname,"\")+1)
'prepare icon picker window
      whichicon=-1
      iconform.onpaint=iconformshow
      iconform.onclose=iconcancel
      iconform.onkeydown=iconcancel
      iconz.onmousedown=iconformclic
      iconform.CAPTION=s_iconsinfile+fshortname
      nbiconsinrow=INT((iconz.width-8)/36) : nbrows=INT((nbicons+nbiconsinrow-1)/nbiconsinrow)
      iconz.height=nbrows*36
      IF iconz.height<iconform.clientheight THEN iconz.height=iconform.clientheight
'show icon picker window
      iconform.visible=true
'setfocus(iconform.handle)
      WHILE iconform.visible
       DOEVENTS
      WEND
      iconpicker=whichicon
     END FUNCTION '-(iconpicker)

'-- SELECTICONE: open icon dialog box and add icon selected to current event
     SUB selecticone
      DIM s AS STRING,ss AS STRING,quelicone AS STRING
      IF currentev=0 THEN EXIT SUB
      CREATE dia AS QOPENDIALOG
       filter=s_iconfilter
       filterindex=1
       initialdir=icondir
      END CREATE
      IF dia.EXECUTE=false THEN
       quelicone=""  'cancel by user -> no icon
      ELSE
       quelicone=dia.filename
       whichicon=iconpicker(quelicone)  'let the user pick icon if several ones are present
       IF whichicon<0 THEN
        quelicone=""
       ELSE
        quelicone=quelicone+CHR$(9)+STR$(whichicon)
        icondir=CURDIR$
       END IF
      END IF
      tailleicone=displayicon(currentev,quelicone)
      ed(currentev).left=tailleicone+bordure-5 'adjust width of text field
      ed(currentev).width=edcadre(currentev).width-tailleicone-bordure-bordure+6
     END SUB

'-- MENU commands, EVENTS AND CONTROLS handling

     SUB weekdelete    'delete event
      DIM s AS STRING
      IF currentev<1 THEN EXIT SUB
      ed(currentev).text="[[deleted]]"
      edcadre(currentev).visible=False
      selectnone
     END SUB

     SUB weekcut    'cut
      IF currentev=0 THEN EXIT SUB 'do nothing if no event is selected
      IF ed(currentev).sellength<>0 THEN 'some text is selected -> cut it
       myclipboard=""
       ed(currentev).cuttoclipboard
      ELSE 'no text is selected -> cut event
       edcadre(currentev).visible=false 'hide event
       myclipboard=eventstring(currentev) 'retain event description
       ed(currentev).selectall
       ed(currentev).cuttoclipboard 'cut text to Windows clipboard
       ed(currentev).text="[[deleted]]" 'mark event as deleted
       selectnone
      END IF
     END SUB

     SUB weekpaste    'paste
      DIM s AS STRING
      IF myclipboard="" THEN   'app private clipboard contains no event
       IF currentev=0 THEN EXIT SUB  'is an event selected?
       s=clipboard.text 'if so, paste Windows clipboard text
       ed(currentev).pastefromclipboard
      ELSE   'private clipboard contains an event -> paste it
       CreateEvFromString(myclipboard)
      END IF
     END SUB

     SUB weekcopy    'copy
      IF currentev=0 THEN EXIT SUB 'do nothing if no event is selected
      IF ed(currentev).sellength<>0 THEN 'some text is selected -> copy it
       myclipboard=""
       ed(currentev).copytoclipboard
      ELSE 'no text is selected -> copy event
       myclipboard=eventstring(currentev) 'retain event description
       clipboard.text=ed(currentev).text
      END IF
     END SUB

     SUB clicflechegauche    'left arrow
      savecarnet
      hideallevents
      lundi=advancedays(lundi,-7)
      drawz
      buildweek
     END SUB

     SUB clicflechedroite    'right arrow
      hideallevents
      savecarnet
      lundi=advancedays(lundi,7)
      drawz
      buildweek
     END SUB

     SUB weekkeydown(key AS WORD, shift AS INTEGER)
      SELECT CASE key
      CASE 33 : clicflechegauche 'PageUp
      CASE 34 : clicflechedroite 'PageDown
      CASE 27 : systray  'Escape
      END SELECT
     END SUB

     SUB cliccalendr    'call calendar form
      DIM nouvjour AS STRING
      nouvjour=calendrier  'appelle le calendrier pour choisir un nouveau jour
      IF nouvjour="" THEN EXIT SUB
      hideallevents
      savecarnet
      theweekday=weekday(nouvjour)
      IF (theweekday=7) AND (firstdayofweek=0) THEN theweekday=0
      lundi=advancedays(nouvjour,firstdaydisplayed-theweekday)  '1st day of selected week
      drawz
      buildweek
     END SUB

'--WEEKINIT: initialization of Week panel
     SUB weekinit
'redim panels
      ljour=INT((panelwidth-2*leftmargin-lheures-6)/nbjours)
      hheure=INT((panelheight-2*topmargin-hheader-6)/(nbheures+bottommargin+hnotes))
      hheure=hheure-(hheure MOD quartdheure)
      WeekPanel.width=panelwidth: WeekPanel.height=panelheight
      zcadre.width=nbjours*ljour+3 : zcadre.height=hheure*(nbheures+hnotes+bottommargin)
      z.width=nbjours*ljour : z.height=hheure*(nbheures+hnotes+bottommargin)
      heures.height=hheure*nbheures+hheader+1
      header.width=nbjours*ljour+3
      fondboutond.left=header.width-20
      FOR i=0 TO nbheures-1
       etiqheure(i).CAPTION=STR$(heure1+i)
       etiqheure(i).PARENT=heures
       etiqheure(i).left=10
       etiqheure(i).top=i*hheure+18
      NEXT
'get data for current week
      opencarnet
      buildweek
'menu enables
      fileprint.enabled=true
      editnew.enabled=false
      edituse.enabled=false
      editall.enabled=false
      editfind.enabled=true
      editfindnext.enabled=true
      menuicon.enabled=true
      menuicon.shortcut="CTRL+I"
      projectinsert.shortcut=""
      setfocus(weekpanel.handle)
     END SUB

     DIM findev AS INTEGER
'-- WKMENUFIND
     SUB wkdofind
      DIM i AS INTEGER, s AS STRING, p AS INTEGER, ss AS STRING, nouvjour AS STRING, theweekday AS INTEGER
      s=findtext.text
      IF s="" THEN EXIT SUB
'search current week
      FOR i=findev TO 1 STEP -1
       ss=ed(i).text
       IF ss<>"[[deleted]]" THEN
        p=INSTR(LCASE$(ss),LCASE$(s))
        IF p<>0 THEN
         bringtofront(i)
         EXIT SUB
        END IF
       END IF
      NEXT
'search following weeks
      FOR i=weekstartindex TO ev.itemcount-1
       ss=ev.item(i)
       nouvjour=FIELD$(ss,separ,1)
       ss=FIELD$(ss,separ,2)
       IF ss<>"[[deleted]]" THEN
        p=INSTR(LCASE$(ss),LCASE$(s))
        IF p<>0 THEN
            'if found : jump to that week
         savecarnet : hideallevents
'showmessage(nouvjour)
         theweekday=weekday(nouvjour)
         IF (theweekday=7) AND (firstdayofweek=0) THEN theweekday=0
         lundi=advancedays(nouvjour,firstdaydisplayed-theweekday)  '1st day of selected week
         drawz
         buildweek
         findev=nbevent
         wkdofind 'find in that week
         EXIT SUB
        END IF
       END IF
      NEXT
'search preceding weeks
      FOR i=0 TO weekstartindex-1
       ss=ev.item(i)
       nouvjour=FIELD$(ss,separ,1)
       ss=FIELD$(ss,separ,2)
       IF ss<>"[[deleted]]" THEN
        p=INSTR(LCASE$(ss),LCASE$(s))
        IF p<>0 THEN
            'if found : jump to that week
         savecarnet : hideallevents
         theweekday=weekday(nouvjour)
         IF (theweekday=7) AND (firstdayofweek=0) THEN theweekday=0
         lundi=advancedays(nouvjour,firstdaydisplayed-theweekday)  '1st day of selected week
         drawz
         buildweek
         findev=nbevent
         wkdofind 'find in that week
         EXIT SUB
        END IF
       END IF
      NEXT
     END SUB

     SUB wkmenufind
      findev=nbevent
'if currentev=0 then
'    findev=1
'    else
'    findev=currentev
'end if
      wkdofind
     END SUB

'-- WKFINDNEXT
     SUB wkfindnext
      findev=findev-1
'if currentev=0 then
'    findev=1
'    else
'    findev=currentev+1
'end if
      wkdofind
     END SUB

2013-06-19 07:44