2013-06-19 07:44

'------- PRINTING

     DECLARE FUNCTION DestroyWindow LIB "user32.dll" ALIAS "DestroyWindow" (hObject AS LONG) AS LONG

'-------  margins and coordinates
     DIM vm(1) AS INTEGER 'vertical margin
     DIM hm AS INTEGER 'horizontal margin
     DIM sc AS DOUBLE 'screen to printer scale
     DIM wk AS INTEGER 'week index = 0 for current week, 1 for next

     FUNCTION prx(x AS INTEGER) AS INTEGER 'screen to printer coordinate conversion
      prx=INT(hm+x*sc)
     END FUNCTION
     FUNCTION pry(y AS INTEGER) AS INTEGER
      pry=INT(vm(wk )+y*sc)
     END FUNCTION

'-- PRTEXT: printout string
     SUB prtext(x AS INTEGER, y AS INTEGER, s AS STRING)
      printer.textout(hm+x*sc,vm(wk )+y*sc,s,0,&hffffff)
     END SUB

'-- PRABSRECT: printout rectangle (x,y,a,b) in screen coordinates
     SUB prabsrect(x AS INTEGER, y AS INTEGER, a AS INTEGER, b AS INTEGER)
      printer.rectangle(hm+x*sc,vm(wk )+y*sc,hm+a*sc+1,vm(wk )+b*sc+1,0)
     END SUB

'-- PRRECT: printout rectangle (x,y,a,b) in day/hour coordinates
     SUB prrect(x AS DOUBLE, y AS DOUBLE, a AS DOUBLE, b AS DOUBLE)
      prabsrect(lheures+x*ljour,hheader+y*hheure,lheures+a*ljour,hheader+b*hheure)
     END SUB

'-- PRLINE: printout line
     SUB prline(x AS INTEGER, y AS INTEGER, a AS INTEGER, b AS INTEGER, c AS INTEGER)
      printer.line(hm+x*sc,vm(wk )+y*sc,hm+a*sc,vm(wk )+b*sc,c)
     END SUB

'-- PRFILL: fillout rectangle
     SUB prfill(x AS INTEGER, y AS INTEGER, a AS INTEGER, b AS INTEGER, c AS INTEGER)
      printer.fillrect(hm+x*sc,vm(wk )+y*sc,hm+a*sc,vm(wk )+b*sc,c)
     END SUB

'-- PRDRAW: draw bitmap
     SUB prdraw(x AS INTEGER, y AS INTEGER, bmp AS STRING)
      DIM r AS QRECT
      r.left=hm+x*sc : r.top=vm(wk)+y*sc
      r.right=hm+(x+bordureicone)*sc : r.bottom=vm(wk)+(y+bordureicone)*sc
      printer.stretchdraw(r,bmp)
     END SUB

'-- PRTEXR: printout text clipped to rectangle (image of a Qrichedit)
'Strategy :
'The only working graphical routines seem to be printer.draw and printer.stretchdraw from a Qimage.
'--> text is first written to a dummy Qrichedit inside a hidden form
'then printed line by line on a hidden Qbitmap
'then saved to file
'then loaded into a hidden Qimage
'then drawn to printer. If you know a simpler way, please tell me.
     DEFINT canprint=0
     SUB canprintOn
      canprint=1
     END SUB
     CREATE printtimer AS QTIMER
      interval=10
      enabled=0
      ontimer=canprintOn
     END CREATE
     SUB prtexr(x AS INTEGER, y AS INTEGER, a AS INTEGER, b AS INTEGER, s AS STRING, centered AS INTEGER)
      DIM linetext AS STRING
      DIM sourcer AS QRECT, destr AS QRECT
      ll=(a-x)*sc : hh=(b-y)*sc  'width and height, converted from screen to printer coordinates
      CREATE sizedfont AS QFONT
       name=appfont
       size=appfontsize*sc
      END CREATE
      CREATE dummyform AS QFORM
       width=ll : height=hh
       CREATE dummyimage AS QIMAGE
        left=0:top=0
        width=ll : height=hh
       END CREATE
      END CREATE
'Now for the mystery statement:
      dummyresult=destroywindow(dummyform.handle)
'Without the destroywindow, the hidden qrichedit never resizes --> line breaks do not fall where they should.
'For some reason, Destroywindow seems to shake up the hidden form somehow and the qrichedit adjusts!
      CREATE dummyedit AS QRICHEDIT
       PARENT=dummyform
       left=0:top=0
       width=ll : height=hh
       font=sizedfont
       text=s
      END CREATE
      CREATE dummybitmap AS QBITMAP
       width=ll : height=hh
       fillrect(0,0,ll,hh,&hffffff)
       font=sizedfont
      END CREATE
      sourcer.left=0 : sourcer.top=0 : sourcer.right=(a-x)*sc : sourcer.bottom=(b-y)*sc
      destr.left=hm+x*sc : destr.top=vm(wk)+y*sc
      destr.right=hm+a*sc-2 : destr.bottom=vm(wk)+b*sc-2
      fontheight=dummybitmap.textheight(" ")
'print text on hidden bitmap, line by line from the qrichedit
      FOR i=0 TO dummyedit.linecount-1
       linetext=dummyedit.line(i)
       linewidth=dummybitmap.textwidth(linetext)
       lineleft=IIF(centered=0,0,(dummybitmap.width-linewidth)/2)
       dummybitmap.textout(lineleft,fontheight*i,linetext,0,&hffffff)
      NEXT
      CHDIR appdir
      buffindex++
      dummybitmap.savetofile("data\printbuffer.bmp") 'save bitmap to file
'wait 10 ms for image to be ready
      canprint=false : printtimer.enabled=true
      DO : DOEVENTS : LOOP UNTIL canprint
       dummyimage.bmp="data\printbuffer.bmp" 'load it into image
       printer.draw(hm+x*sc, vm(wk)+y*sc, dummyimage.bmp) 'and print
'printer.copyrect(destr,dummybitmap,sourcer)
      END SUB

      SUB pricon(x AS INTEGER, y AS INTEGER, iconname AS STRING)
'Same strategy as for text:
'load icon, draw it to hidden bitmap, save it to file, load it into image, stretchdraw it to printer
       DIM iconh AS LONG
       CREATE iconbuff AS QBITMAP 'buffer for drawing icon in its original size
        width=32
        height=32
        fillrect(0,0,32,32,&hffffff) 'erase buffer
       END CREATE
        'nbicones=ExtractIcon(application.handle,dia.filename,-1)
       whichicon=VAL(FIELD$(iconname,CHR$(9),2))
       iconname=FIELD$(iconname,CHR$(9),1)
       IF LEFT$(iconname,1)="\" THEN iconname=icondir+iconname
       iconh=ExtractIcon(application.handle,iconname,0) 'à la place de 0 mettre 1..nbicones pour les autres icones
       DrawIcon(iconbuff.handle,0,0,iconh)
       CHDIR appdir
       iconbuff.savetofile("data\printbuffer.bmp")
       CREATE dummyform AS QFORM
        width=bordureicone : height=bordureicone
        CREATE dummyimage AS QIMAGE
         left=0 : top=0
         width=bordureicone : height=bordureicone
         bmp="data\printbuffer.bmp"
        END CREATE
       END CREATE
       DIM r AS QRECT
       r.left=hm+x*sc : r.top=vm(wk)+y*sc
       r.right=hm+(x+bordureicone)*sc : r.bottom=vm(wk)+(y+bordureicone)*sc
       printer.stretchdraw(r,dummyimage.bmp)
      END SUB

      DIM firstday AS STRING 'first day of current week
      SUB printweek  'printout 2 weeks on a page
       DIM s AS STRING, letexte AS STRING, lapos AS STRING, licone AS STRING, ss AS STRING
       DIM hh1 AS STRING, hh2 AS STRING
       savecarnet 'save data to file
'initialize printer
       printer.orientation=0
       pgwidth=printer.pagewidth : pgheight=printer.pageheight
       printer.begindoc
'compute printing scale
       xscale=pgwidth*(1-2*printmargin)/(lheures+nbjours*ljour)
       yscale=pgheight*(1-3.5*printmargin)/2/(hheader+(nbheures+bottommargin+hnotes)*hheure)
       sc=min(xscale,yscale)
       hm=(pgwidth-sc*(lheures+nbjours*ljour))/2 'horiz margin
       vvm=(pgheight-2*sc*(hheader+(nbheures+hnotes+bottommargin)*hheure))/3.5
       vm(0)=vvm : vm(1)=pgheight/2+vvm/2  'vertical margin for first and second week
       CREATE printfont AS QFONT
        name=appfont
        size=appfontsize
       END CREATE
       printer.font=printfont
'    printer.rectangle(0,0,hm*2+sc*(lheures+nbjours*ljour),vvm*3.5+sc*2*(hheader+(nbheures+hnotes+bottommargin)*hheure),0)

       FOR wk=0 TO 1   'Week #0 and 1
        firstday=advancedays(lundi,wk*7) 'first day of current week
    'background
        prfill(lheures,hheader,lheures+nbjours*ljour,hheader+(nbheures+hnotes+bottommargin)*hheure,&hf0f0f0)
    'days of the week
        FOR i=1 TO nbjours
         x=lheures+(i-1)*ljour : a=lheures+i*ljour
         ss=advancedays(firstday,i-1)
         ss=datetext(ss)
         prtexr(x, 3, a, hheader, ss, 1)
        NEXT
        prabsrect(lheures, 1, lheures+nbjours*ljour, hheader)
    'hours of the day
        FOR i=0 TO nbheures-1
         prtexr(0,hheader+i*hheure+3,lheures,hheader+(i+1)*hheure, STR$(heure1+i),1)
    'prtext(10,hheader+i*hheure+5, str$(heure1+i))
         prline(lheures,hheader+i*hheure,lheures+nbjours*ljour,hheader+i*hheure,0) 'hour
         prline(lheures,hheader+(i+0.5)*hheure,lheures+nbjours*ljour,hheader+(i+0.5)*hheure,&hcccccc) 'half hour
        NEXT
        prabsrect(0,hheader,lheures,hheader+nbheures*hheure)
    'division lines
        FOR i=1 TO nbjours-1
         prfill(lheures+i*ljour-2,hheader,lheures+i*ljour+2,hheader+(nbheures+hnotes+bottommargin)*hheure,&haaaaaa) 'vertical line between days
        NEXT
        prfill(lheures,hheader+nbheures*hheure,lheures+nbjours*ljour,hheader+(nbheures+bottommargin)*hheure,&haaaaaa) 'separation between hours and notes
        prabsrect(lheures,hheader,lheures+nbjours*ljour,hheader+(nbheures+hnotes+bottommargin)*hheure)
    'events
        findweek(firstday)
        FOR i=1 TO nbeventsinweek 'for each event
         s=ev.item(weekstartindex+i-1)
         letexte=FIELD$(s,separ,2)
         letexte=REPLACESUBSTR$(letexte,crSubst,crString) 'restore carriage returns
         lapos=FIELD$(s,separ,3)
         licone=FIELD$(s,separ,4)
        'frame
         g=VAL(nthfield(lapos,1))-firstdaydisplayed : d=VAL(nthfield(lapos,2))-firstdaydisplayed
         hh1= nthfield(lapos,3) : hh2=nthfield(lapos,4)
         t=strheure(hh1)-heure1 : b=strheure(hh2)-heure1
         prfill(lheures+g*ljour,hheader+t*hheure,lheures+d*ljour,hheader+b*hheure,&hffffff)
         prrect(g,t,d,b)
        'icon
         IF licone="" THEN
          iconsize=0
         ELSE
          iconsize=bordureicone
          x=lheures+g*ljour+2 : y=hheader+t*hheure+2
          pricon(x,y,licone)
         END IF
        'text
         prtexr(lheures+g*ljour+8+iconsize,hheader+t*hheure+5,lheures+d*ljour-6,hheader+b*hheure-4,letexte,0)
        NEXT
       NEXT
       printer.enddoc
       IF FILEEXISTS("data\printbuffer.bmp") THEN KILL("data\printbuffer.bmp")
       buildweek
      END SUB

2013-06-19 07:44