Impression d'étiquettes

' Impression de planches d'étiquettes sur A4
LABEL Quit, Appliq, Contours, Txet, Copie, Raz, Pol, Pol1, Imprime
DIM ra,wf%,hf%,we%,he%,mg%,mh%,ev%,eh%,nc%,nr%,ne%,x%,y%,xe%(100),ye%(100),c%,r%
DIM i%,j%,k%,sz%,n1%,n2%,tth%,ttv%,ftm$
ftm$ = "C:\TEMP\Etiq.bmp"

WIDTH 0,260: HEIGHT 0,500: BORDER_SMALL 0
  FONT_NAME 0,"Arial": FONT_BOLD 0: CAPTION 0, "  -   ÉTIQUETTES   SUR   A4   -"
  COLOR 0,80,255,255
Winbord(): tth% = 2*wbb%: ttv% = wbh%+wbb%: ' dimensions des bordures h et v
CONTAINER 1: TOP 1,5: LEFT 1,0: WIDTH 1,WIDTH(0)-tth%: HEIGHT 1,160
  COLOR 1,255,255,200: CAPTION 1, " 1 - CARACTÉRISTIQUES :"
ALPHA 2: PARENT 2,1: TOP 2,20: LEFT 2,5
  CAPTION 2,"Dimensions: W=       H=       mm"
  FONT_NAME 2,"Consolas": FONT_SIZE 2,10
SPIN 3: PARENT 3,1: TOP 3,TOP(2)-2: LEFT 3,105: WIDTH 3,45
SPIN 4: PARENT 4,1: TOP 4,TOP(3): LEFT 4,LEFT(3)+65: WIDTH 4,WIDTH(3)
  POSITION 3,99: POSITION 4,38
ALPHA 12: PARENT 12,1: TOP 12,TOP(2)+30: LEFT 12,5
  CAPTION 12,"    Marges: G=       H=       mm"
  FONT_NAME 12,"Consolas": FONT_SIZE 12,10
SPIN 13: PARENT 13,1: TOP 13,TOP(12)-2: LEFT 13,LEFT(3): WIDTH 13,WIDTH(3)
SPIN 14: PARENT 14,1: TOP 14,TOP(13): LEFT 14,LEFT(4): WIDTH 14,WIDTH(13)
  POSITION 13,5: POSITION 14,15
ALPHA 22: PARENT 22,1: TOP 22,TOP(12)+30: LEFT 22,5
  CAPTION 22,"Espacement: H=       V=       mm"
  FONT_NAME 22,"Consolas": FONT_SIZE 22,10
SPIN 23: PARENT 23,1: TOP 23,TOP(22)-2: LEFT 23,LEFT(3): WIDTH 23,WIDTH(3)
SPIN 24: PARENT 24,1: TOP 24,TOP(23): LEFT 24,LEFT(4): WIDTH 24,WIDTH(23)
  POSITION 23,2: POSITION 24,0
ALPHA 32: PARENT 32,1: TOP 32,TOP(22)+30: LEFT 32,5
  CAPTION 32,"->           Colonnes x           Rangées ="
EDIT 33: PARENT 33,1: TOP 33,TOP(32)-3: LEFT 33,20: WIDTH 33,25
EDIT 34: PARENT 34,1: TOP 34,TOP(33): LEFT 34,115: WIDTH 34,25
EDIT 35: PARENT 35,1: TOP 35,TOP(34): LEFT 35,205: WIDTH 35,25
CHECK 39: PARENT 39,1: TOP 39,HEIGHT(1)-25: LEFT 39,10: WIDTH 39,200
  CAPTION 39,"Contours+Numéros": MARK_ON 39: ON_CLICK 39,Appliq
BUTTON 40: PARENT 40,1: TOP 40,HEIGHT(1)-28: LEFT 40,WIDTH(1)-80
  CAPTION 40,"Appliquer": ON_CLICK 40,Appliq
' ------------------------------------------------------------------------------
CONTAINER 50: TOP 50,TOP(1)+HEIGHT(1)+5: WIDTH 50,WIDTH(1): HEIGHT 50,125
  COLOR 50,255,255,200: CAPTION 50," 2 - CONTENU :"
EDIT 51: PARENT 51,50: TOP 51,20: WIDTH 51,100: TEXT 51,"Arial": ON_CLICK 51,Pol
SPIN 52: PARENT 52,50: TOP 52,TOP(51): LEFT 52,WIDTH(51)+3: WIDTH 52,40
  MIN 52,8: MAX 52,255: POSITION 52,16: ON_CHANGE 52,Txet
CHECK 53: PARENT 53,50: TOP 53,TOP(52)+2: LEFT 53,LEFT(52)+45: CAPTION 53,"G"
  FONT_BOLD 53: FONT_SIZE 53,10
CHECK 54: PARENT 54,50: TOP 54,TOP(53): LEFT 54,LEFT(53)+30: CAPTION 54,"I"
  FONT_ITALIC 54: FONT_SIZE 54,10
CHECK 55: PARENT 55,50: TOP 55,TOP(53): LEFT 55,LEFT(54)+30: CAPTION 55,"S"
  FONT_UNDERLINE 55: FONT_SIZE 55,10
  FOR i% = 53 TO 55: ON_CLICK i%,Txet: NEXT i%
CONTAINER_OPTION 60: PARENT 60,50: TOP 60,50: WIDTH 60,WIDTH(50): HEIGHT 60,40
CAPTION 60,"Couleur texte :"
OPTION 61: PARENT 61,60: TOP 61,15: LEFT 61,10: CAPTION 61,"Noir": MARK_ON 61
OPTION 62: PARENT 62,60: TOP 62,TOP(61): LEFT 62,60: CAPTION 62,"Rouge"
  FONT_COLOR 62,255,0,0
OPTION 63: PARENT 63,60: TOP 63,TOP(61): LEFT 63,125: CAPTION 63,"Vert"
  FONT_COLOR 63,0,128,0
OPTION 64: PARENT 64,60: TOP 64,TOP(61): LEFT 64,180: CAPTION 64,"Bleu"
  FONT_COLOR 64,0,0,255
  FOR i% = 61 TO 64: ON_CLICK i%,Txet: NEXT i%
BUTTON 65: PARENT 65,50: TOP 65,HEIGHT(50)-28: LEFT 65,WIDTH(50)-80
  CAPTION 65,"Saisie": ON_CLICK 65,Txet

CONTAINER 70: TOP 70,TOP(50)+HEIGHT(50)+5: WIDTH 70,WIDTH(1): HEIGHT 70,90
  COLOR 70,255,255,200: CAPTION 70," 3 - RECOPIE :"
CONTAINER_OPTION 76: PARENT 76,70: TOP 76,12: WIDTH 76,WIDTH(70): HEIGHT 76,46
OPTION 71: PARENT 71,76: TOP 71,5: LEFT 71,5
  WIDTH 71,200: CAPTION 71,"Copier dans toutes": MARK_ON 71
OPTION 72: PARENT 72,76: TOP 72,TOP(71)+16: LEFT 72,LEFT(71)
  WIDTH 72,200: CAPTION 72,"Copier dans les N°                 à"
SPIN 73: PARENT 73,70: TOP 73,31: LEFT 73,130: WIDTH 73,40
SPIN 74: PARENT 74,70: TOP 74,TOP(73): LEFT 74,LEFT(73)+58: WIDTH 74,WIDTH(73)
  MIN 73,1: MAX 73,100: MIN 74,1: MAX 74,100: POSITION 73,1
BUTTON 75: PARENT 75,70: TOP 75,HEIGHT(70)-28: LEFT 75,WIDTH(70)-80
  CAPTION 75,"Recopier": ON_CLICK 75,Copie
BUTTON 77: PARENT 77,70: TOP 77,TOP(75): LEFT 77,10: CAPTION 77,"Raz feuille"
  ON_CLICK 77,Raz
  
CONTAINER 110: TOP 110,TOP(70)+HEIGHT(70)+5: WIDTH 110,WIDTH(1): HEIGHT 110,40
  COLOR 110,255,255,200: CAPTION 110," 4 - IMPRESSION"
BUTTON 111: PARENT 111,110: TOP 111,10: LEFT 111,WIDTH(110)-80
  CAPTION 111,"Imprimer": ON_CLICK 111,Imprime

BUTTON 85: HEIGHT 85,20: TOP 85,HEIGHT(0)-62: LEFT 85,WIDTH(0)/2-40: CAPTION 85,"Quitter"
  ON_CLICK 85,Quit
  
' Form de saisie
FORM 100: HIDE 100: TOP 100,TOP(0)+HEIGHT(0): LEFT 100,0: WIDTH 100,WIDTH(0)
  HEIGHT 100,100: BORDER_SMALL 100
MEMO 101: PARENT 101,100: FULL_SPACE 101
IMAGE 102

' Form d'impression
hf% = 1100: ' dimensions (hauteur) de la feuille A4 en pixels à l'écran
IF hf%>(SCREEN_Y-40) THEN hf% = SCREEN_Y-40
wf% = hf%*210/297: ' proportions A4 (778 x 1100)
FORM 80: TOP 80,0: LEFT 80,LEFT(0)+WIDTH(0)+5: WIDTH 80,wf%: HEIGHT 80,hf%
    BORDER_HIDE 80
PICTURE 81: PARENT 81,80: FULL_SPACE 81
ra = hf%/297: ' pixels par mm à 300 dpi
' Choix de police
FORM 90: HIDE 90: TOP 90,TOP(50)+50: LEFT 90,0: WIDTH 90,140: HEIGHT 90,400
  BORDER_HIDE 90
LIST 91: PARENT 91,90: FULL_SPACE 91: ON_CLICK 91,Pol1: FONT_NAMES_LOAD 91
  FOR i% = COUNT(91) TO 1 STEP -1
      IF LEFT$(ITEM_READ$(91,i%),1) = "@" THEN ITEM_DELETE 91,i%
  NEXT i%

GOSUB Appliq
END
' ==============================================================================
Quit:
TERMINATE
' ==============================================================================
Appliq:
  we% = ra*POSITION(3): he% = ra*POSITION(4): ' dimensions étiquette, en pixels
  mg% = ra*POSITION(13): mh% = ra*POSITION(14): ' marges gauche et haut, idem
  eh% = ra*POSITION(23): ev% = ra*POSITION(24): ' espacements horizontal et vertical
  nc% = (wf%-mg%)/(we%+eh%): ' colonnes
  nr% = (hf%-mh%)/(he%+ev%): ' rangées
  TEXT 33,STR$(nc%): TEXT 34,STR$(nr%): TEXT 35,STR$(nc%*nr%)
  2D_TARGET_IS 81: 2d_pen_width 1
  y% = mh%
  FOR r% = 1 TO nr%
      ye%(r%) = y%
      x% = mg%
      FOR c% = 1 TO nc%
          xe%(c%) = x%: x% = x%+we%+eh%
      NEXT c%
      y% = y%+he%+ev%
  NEXT r%
  GOSUB Contours
  WIDTH 100,we%+tth%+2: HEIGHT 100,he%+ttv%+2: WIDTH 101,we%+2: HEIGHT 101,he%+2
  ' +2 pour compenser les bordures haut et gauche du Memo (2 pixels)
RETURN
' ==============================================================================
Contours:
  PRINT_TARGET_IS 81: FONT_NAME 81,"Calibri": FONT_SIZE 81,16
  2D_FILL_OFF
  IF CHECKED(39) = 1
      2D_PEN_COLOR 0,0,0: FONT_COLOR 81,128,128,128
  ELSE
      2D_PEN_COLOR 255,255,255: FONT_COLOR 81,255,255,255
  END_IF
  ne% = 1
  FOR r% = 1 TO nr%
      FOR c% = 1 TO nc%
          k% = he%+1: IF r% = nr% THEN k% = he%
          2D_RECTANGLE xe%(c%),ye%(r%),xe%(c%)+we%,ye%(r%)+k%
          PRINT_LOCATE xe%(c%)+5,ye%(r%)+he%-25: PRINT RIGHT$(" "+STR$(ne%),2)
          ne% = ne%+1
      NEXT c%
  NEXT r%
  ne% = ne%-1: ' nb total d'étiquettes
  MAX 73,ne%: MAX 74,ne%
  POSITION 74,ne%
RETURN
' ==============================================================================
Txet:
  FONT_NAME 101,TEXT$(51): FONT_SIZE 101,POSITION(52): ' Police et taille
  FONT_BOLD_OFF 101: FONT_ITALIC_OFF 101: FONT_UNDERLINE_OFF 101
  IF CHECKED(53) = 1 THEN FONT_BOLD 101: ' Gras
  IF CHECKED(54) = 1 THEN FONT_ITALIC 101: ' Italiques
  IF CHECKED(55) = 1 THEN FONT_UNDERLINE 101: ' Souligné
  IF CHECKED(61) = 1 THEN FONT_COLOR 101,0,0,0: ' noir
  IF CHECKED(62) = 1 THEN FONT_COLOR 101,255,0,0: ' rouge
  IF CHECKED(63) = 1 THEN FONT_COLOR 101,0,128,0: ' vert
  IF CHECKED(64) = 1 THEN FONT_COLOR 101,0,0,255: ' bleu
  SHOW 100
RETURN
' ==============================================================================
Copie:
  2D_TARGET_IS 100: 2D_IMAGE_COPY 102,2,2,we%,he%: ' 2 et 2 pour les bordures du memo
  2D_TARGET_IS 81
  IF CHECKED(71) = 1
      n1% = 1: n2% = ne%
  ELSE
      n1% = POSITION(73): n2% = POSITION(74)
  END_IF
  i% = 0
  FOR r% = 1 TO nr%
      FOR c% = 1 TO nc%
          i% = i%+1
          IF i%>=n1% AND i%<=n2%
              2D_IMAGE_PASTE 102,xe%(c%),ye%(r%)
          END_IF
     NEXT c%
  NEXT r%
RETURN
' ==============================================================================
Raz:
  CLS: GOSUB Contours
RETURN
' ==============================================================================
Pol:
  SHOW 90
RETURN
' ==============================================================================
Pol1:
  TEXT 51,ITEM_INDEX$(91): HIDE 90
  FONT_NAME 101,TEXT$(51)
RETURN
' ==============================================================================
Imprime:
IF CHECKED(39) = 1
    i%=MESSAGE_CONFIRMATION_YES_NO("Supprimer les contours ?")
    IF i% = 1 THEN MARK_OFF 39: GOSUB Contours
END_IF
FILE_SAVE 81,ftm$
Pr_init(0,"")
Pr_Image(ftm$,0,0,Pr_lt%,Pr_ht%,0): ' totalité de la feuille
Pr_Impr()
FILE_DELETE ftm$
RETURN
' ==============================================================================
SUB Pr_init(orient%,prn$)
' Initialisation imprimante ('début d'impression')
' orient% = 0 Portrait, = 1 Paysage
' prn$ = "": imprimante par défaut
'            sinon nom de l'imprimante (pour essais)
'            par exemple "Microsoft XPS Document Writer" impression virtuelle
'            dans un fichier .XPS
' Dans les paramètres des fonctions, le positionnement initial doit être fait en
' valeurs absolues: distances par rapport aux bords gauche et haut de la feuille
' A4, sans tenir compte des marges non imprimables.
' Les couleurs sont à exprimer au format BGR (en non pas RGB): B*256*256+G*256+R
DLL_ON "C:\PANORAMIC\KGF\KGF.dll"
IF VARIABLE("phnd%") = 0 THEN DIM phnd%
IF VARIABLE("chnd%") = 0 THEN DIM chnd%
IF VARIABLE("inip%") = 0 THEN DIM inip%
IF VARIABLE("Pr_res%") = 0 THEN DIM Pr_res%
IF VARIABLE("Pr_px%") = 0 THEN DIM Pr_px%: ' pixels par mm (600 dpi)
IF VARIABLE("Pr_lt%") = 0 THEN DIM Pr_lt%: ' largeur totale
IF VARIABLE("Pr_ht%") = 0 THEN DIM Pr_ht%: ' hauteur totale
IF VARIABLE("Pr_mg%") = 0 THEN DIM Pr_mg%: ' marge gauche
IF VARIABLE("Pr_mh%") = 0 THEN DIM Pr_mh%: ' marge haut
IF VARIABLE("Pr_lu%") = 0 THEN DIM Pr_lu%: ' largeur utile
IF VARIABLE("Pr_hu%") = 0 THEN DIM Pr_hu%: ' hauteur utile
IF prn$ <> "": ' pour essais sans impression réelle
    Pr_res%=DLL_CALL4("PrinterManager",10,ADR(phnd%),ADR(chnd%),ADR(prn$))
END_IF
' Orientation portrait (0) ou paysage (1)
Pr_res% = DLL_CALL4("PrinterManager",4,ADR(phnd%),ADR(chnd%),orient%): ' orientation
Pr_res% = DLL_CALL4("PrinterManager",1,ADR(phnd%),ADR(chnd%),0): ' init
' Dimensions sans les marges, en pixels:
' ==========
' ATTENTION: Les dimensions sont actualisées en fonction de l'option orientation !
' ==========
Pr_lt% = DLL_CALL6("PrinterFunction",8,ADR(phnd%),ADR(chnd%),3,0,0): ' largeur totale
Pr_ht% = DLL_CALL6("PrinterFunction",8,ADR(phnd%),ADR(chnd%),4,0,0): ' hauteur totale
IF orient% = 0
    Pr_px% = Pr_ht%/297: ' pixels par mm, à l'impression en 600 dpi
ELSE
    Pr_px% = Pr_lt%/297: ' idem (paysage)
END_IF
' Marges non imprimables: décalage en pixels à soustraire gauche et haut:
Pr_mg% = DLL_CALL6("PrinterFunction",8,ADR(phnd%),ADR(chnd%),1,0,0): ' marge gauche
Pr_mh% = DLL_CALL6("PrinterFunction",8,ADR(phnd%),ADR(chnd%),2,0,0): ' marge haut
' Dimensions utiles, en pixels:
IF Pr_mg% = 0 OR Pr_mh%= 0: ' cas imprimante virtuelle (PDFCreator)
    Pr_mg% = 75: Pr_mh% = 75: ' forçage comme imprimante réelle
    Pr_lu% = Pr_lt% - 2*Pr_mg%: Pr_hu% = Pr_ht% - 2*Pr_mh%
ELSE
    Pr_lu% = DLL_CALL6("PrinterFunction",8,ADR(phnd%),ADR(chnd%),7,0,0): ' largeur utile
    Pr_hu% = DLL_CALL6("PrinterFunction",8,ADR(phnd%),ADR(chnd%),8,0,0): ' hauteur utile
END_IF
' Couleur trait noir, épaisseur = 1, arrière-plan transparent:
inip% = -2
Pr_res% = DLL_CALL6("PrinterFunction",6,ADR(phnd%),ADR(chnd%),0,inip%,1)
inip% = 1
END_SUB
' ==============================================================================
SUB Pr_Image(f$,x%,y%,w%,h%,u%)
' Impression de l'image f$ en x%,y%, dimensions w% x h% (sera redimensionnée pour
' tenir dans le cadre donné).
' u% = 0: unités pixels, u% = 1, unités millimètres
' ******** NB: coordonnées d'impression absolues (pixels): de 0,0 à 4962,7013 ********
'             Attention aux marges non imprimables de 75 pixels haut/bas, gauche/droite
IF inip% = 0 THEN EXIT_SUB: ' imprimante non initialisée (Sub Pr_Init)
IF u% = 1: ' unités en mm, conversion en pixels
    x% = x%*Pr_mmpix: y% = y%*Pr_mmpix: w% = w%*Pr_mmpix: h% = h%*Pr_mmpix
END_IF
' Pour que les coordonnées soient en absolu (sinon on part de 75,75):
x% = x%-Pr_mg%: y% = y%-Pr_mh%: ' marges non imprimables
Pr_res% = DLL_call6("PrinterFunction",4,ADR(phnd%),ADR(chnd%),0,x%,y%): ' positionnement
Pr_res% = DLL_call6("PrinterFunction",7,ADR(phnd%),ADR(chnd%),ADR(f$),w%,h%)
END_SUB
' ==============================================================================
SUB Pr_Impr()
' Lancement de l'impression réelle ('fin d'impression')
IF inip% = 0 THEN EXIT_SUB: ' imprimante non initialisée (Sub Pr_Init)
Pr_res% = DLL_CALL4("PrinterManager",3,ADR(phnd%),ADR(chnd%),0)
inip% = 0
END_SUB
' ==============================================================================
SUB Winbord()
' Dimensions des bordures de fenêtres Windows
' wbh%: bordure haut, wbb%: bordures bas et latérales
' à appeler juste après la définition des caractéristiques du Form 0
IF VARIABLE("wbh%") = 0 THEN DIM wbh%: ' bordure haut
IF VARIABLE("wbb%") = 0 THEN DIM wbb%: ' bordure bas et latérales
PICTURE 971: FULL_SPACE 971
wbb% = (WIDTH(0)-WIDTH(971))/2: ' bordures latérales (chacune)
wbh% = HEIGHT(0)-HEIGHT(971)-wbb%: ' bordure haut (bas = latérale)
DELETE 971
END_SUB
' ==============================================================================