Pour créer une affichette, des dépliants, menus, cartes diverses, jaquettes de dvd, pochettes de Cd-Rom., etc.
L'intéressant ce sont les trois Subs utilitaires de travail sur un picture donné:
- Texte() insertion de texte formaté
- Dessin() création de dessins divers, formes géométriques, fonction gomme, ...
- Imagin() insertion d'images
Dans le cas de texte et d'image, on peut ensuite déplacer l'élément inséré pixel par pixel dans les quatre directions pour positionnement précis, le pivoter par angles de 90°, avant validation.
Il n'est pas fait appel à des ressources externes,
sauf l'incontournable KGF.dll pour l'impression du résultat.
En fait le travail se fait sur une image grandeur nature de la page A4, aussi c'est mieux d'avoir un grand écran, sinon ça dépasse. Pour moi, sur mon 1920x1200 24" (
), ça tient tout juste en vertical.
Le résultat imprimé sera une impression de l'image du picture de travail.
Il faut ajuster quelques paramètres en tête du programme:
- le chemin de KGF.dll
- le chemin du répertoire des fichiers temporaires
- le rapport pixels par mm, fonction de l'écran de travail. C'est ce rapport (variable
rec) qu'il faut réduire si on veut que l'image de la feuille tienne en entier dans l'écran.
Le programme fait près de 1100 lignes:
[code:1:a890]
' Dépliants, affichettes, pochettes cd et dvd, etc. sur format A4
LABEL Quit,Typfig,Desfond,Ouvrir,Sauver,Insert,Imprime,Aide
DIM rec,rim,wA4%,hA4%,x0%,y0%,hj%,wj%,wd%,x%,y%,i%,a$,b$,typ%,scx%,scy%
DIM fsv$,kgf$,rtmp$,subact%,forsub%
Windows_Ver(): ' -> win$ = version de Windows
forsub% = 950: ' arbitraire, pour les Form des subs
scx% = SCREEN_X: scy% = SCREEN_Y
' ####################### A PERSONNALISER ##############################
kgf$ = "C:\PANORAMIC\KGF\KGF.dll": ' <<<<=== à ajuster #
' rtmp$ = "Z:": ' #
rtmp$ = "C:\TEMP": ' <<<<================== à ajuster (fichiers temporaires) #
rec = 3.70656: ' <<<<======= A l'écran: 1 mm = 3,70656 pixels (à ajuster) #
' ##############################################################################
hA4% = scy%-100: wA4% = hA4%*210/297: ' image de la page A4, en pixels
rec = hA4%/297: ' pixels/mm
WIDTH 0,hA4%+30: HEIGHT 0,wA4%+70: COLOR 0,180,255,255: BORDER_SMALL 0
FONT_NAME 0,"Arial": FONT_BOLD 0: FONT_SIZE 0,10: CAPTION 0,win$
ON_CLOSE 0,Quit
CAPTION 0,win$+" - PAGE A4 Paysage -"
MAIN_MENU 50
SUB_MENU 51: PARENT 51,50: CAPTION 51,"Fichier"
SUB_MENU 52: PARENT 52,51: CAPTION 52,"Nouveau"
SUB_MENU 53: PARENT 53,51: CAPTION 53,"Ouvrir...": ON_CLICK 53,Ouvrir
SUB_MENU 54: PARENT 54,51: CAPTION 54,"Enregistrer": ON_CLICK 54,Sauver
SUB_MENU 55: PARENT 55,51: CAPTION 55,"Enregistrer sous...": ON_CLICK 55,Sauver
SUB_MENU 56: PARENT 56,51: CAPTION 56,"Imprimer": ON_CLICK 56,Imprime
SUB_MENU 57: PARENT 57,51: CAPTION 57,"Quitter": ON_CLICK 57,Quit
SUB_MENU 61: PARENT 61,50: CAPTION 61,"Type de projet"
SUB_MENU 62: PARENT 62,61: CAPTION 62,"Feuille A4, Portrait"
SUB_MENU 63: PARENT 63,61: CAPTION 63,"Feuille A4, Paysage"
SUB_MENU 64: PARENT 64,61: CAPTION 64,"Pochette CD-ROM"
SUB_MENU 65: PARENT 65,61: CAPTION 65,"Jaquette DVD, dos 14 mm"
SUB_MENU 66: PARENT 66,61: CAPTION 66,"Jaquette DVD, dos 7 mm"
SUB_MENU 67: PARENT 67,61: CAPTION 67,"Menu (A4/2 = A5)"
SUB_MENU 68: PARENT 68,61: CAPTION 68,"Dépliant (A4/4 = A6)"
FOR x% = 62 TO 68: ON_CLICK x%,Typfig: NEXT x%
SUB_MENU 71: PARENT 71,50: CAPTION 71,"Insérer": ' outil à utiliser
SUB_MENU 72: PARENT 72,71: CAPTION 72,"Texte"
SUB_MENU 73: PARENT 73,71: CAPTION 73,"Dessin"
SUB_MENU 74: PARENT 74,71: CAPTION 74,"Image"
FOR x% = 72 TO 74: ON_CLICK x%,Insert: NEXT x%
SUB_MENU 81: PARENT 81,50: CAPTION 81,"Aide": ON_CLICK 81,Aide
PICTURE 8: TOP 8,0: LEFT 8,0: WIDTH 8,hA4%+10: HEIGHT 8,wA4%+10
COLOR 8,0,0,0: ' pour encadrer en noir l'image de la feuille A4 (Picture 1)
PICTURE 1: TOP 1,TOP(8)+5: LEFT 1,LEFT(8)+5: WIDTH 1,hA4%: HEIGHT 1,wA4%
2D_TARGET_IS 1: COLOR 1,255,255,255: ' Picture principal: image de la feuille A4
BUTTON 2: TOP 2,0: LEFT 2,x0%+215: WIDTH 2,50: HEIGHT 2,16: CAPTION 2,"Verso"
BUTTON 3: TOP 3,TOP(2): LEFT 3,x0%+480: WIDTH 3,40: HEIGHT 3,HEIGHT(2)
CAPTION 3,"Dos"
BUTTON 4: TOP 4,TOP(2): LEFT 4,LEFT(3)+240: WIDTH 4,WIDTH(2): HEIGHT 4,HEIGHT(2)
CAPTION 4,"Recto"
FOR x% = 2 TO 4: HIDE x%: NEXT x%
OPEN_DIALOG 90
SAVE_DIALOG 91
fsv$ = ""
typ% = 2: GOSUB Desfond
' ==============================================================================
END: ' =========================================================================
' ==============================================================================
Quit:
DLL_ON kgf$ : ' correction Klaus du bug de Terminate
x% = DLL_CALL1("KillProcessByHandle",handle(0))
TERMINATE
' ==============================================================================
Typfig:
x% = NUMBER_CLICK
SELECT x%
CASE 62: typ% = 1
CASE 63: typ% = 2
CASE 64: typ% = 3
CASE 65: typ% = 4
CASE 66: typ% = 5
CASE 67: typ% = 6
CASE 68: typ% = 7
END_SELECT
GOSUB Desfond
IF subact% = 1 THEN TO_FOREGROUND forsub%
RETURN
' ==============================================================================
Desfond:
CLS
FOR x% = 2 TO 4: HIDE x%: NEXT x%
b$ = CHR$(10)
x0% = 16: y0% = 16: ' pour sauter les marges non imprimables gauche et haut (pixels écran)
IF typ% = 1 OR typ% = 7: ' A4 Portrait
hA4% = scy%-100: wA4% = hA4%*210/297: ' image de la page A4, en pixels
rec = hA4%/297: ' pixels/mm
WIDTH 0,wA4%+30: HEIGHT 0,hA4%+70
WIDTH 8,wA4%+10: HEIGHT 8,hA4%+10: COLOR 8,0,0,0
WIDTH 1,wA4%: HEIGHT 1,hA4%
CAPTION 0,win$+" - PAGE A4 Portrait -"
IF typ% = 7
2D_LINE wA4%/2,0,wA4%/2,hA4%: 2D_LINE 0,hA4%/2,wA4%,hA4%/2
END_IF
ELSE: ' A4 Paysage
wA4% = 778: ' page A4 grandeur nature
IF wA4% > (scy%-100) THEN wA4% = scy%-100
hA4% = 297*wA4%/210: ' Page A4 en pixels
rec = hA4%/297: ' pixels/mm
IF typ% = 2 OR typ% = 6
' A4 Paysage simple
WIDTH 0,hA4%+30: HEIGHT 0,wA4%+70
WIDTH 8,hA4%+10: HEIGHT 8,wA4%+10: COLOR 8,0,0,0
WIDTH 1,hA4%: HEIGHT 1,wA4%
CAPTION 0,win$+" - PAGE A4 Paysage -"
IF typ% = 6
2D_LINE hA4%/2,0,hA4%/2,wA4%
END_IF
ELSE
IF typ% = 3
' Pochette CD-ROM
WIDTH 0,hA4%+30: HEIGHT 0,wA4%+70
WIDTH 8,hA4%+10: HEIGHT 8,wA4%+10: COLOR 8,0,0,0
WIDTH 1,hA4%: HEIGHT 1,wA4%
wj% = rec*123: hj% = rec*123
wd% = rec*12: ' largeur des languettes à encoller (12 mm)
2D_LINE x0%,y0%+wd%,x0%+2*wj%,y0%+wd%: 2D_POLY_TO x0%+2*wj%,y0%+wd%+hj%
2D_POLY_TO x0%,y0%+wd%+hj%: 2D_POLY_TO x0%,y0%+wd%
2D_LINE x0%+wj%,y0%+wd%,x0%+wj%,y0%+wd%+hj%
2D_LINE x0%,y0%+wd%,x0%+20,y0%: 2D_POLY_TO x0%+wj%-20,y0%: 2D_POLY_TO x0%+wj%,y0%+wd%
2D_LINE x0%,y0%+wd%+hj%,x0%+20,y0%+2*wd%+hj%: 2D_POLY_TO x0%+wj%-20,y0%+2*wd%+hj%
2D_POLY_TO x0%+wj%,y0%+wd%+hj%
2D_LINE x0%,y0%+wd%,x0%+wj%-20,y0%: 2D_LINE x0%+20,y0%,x0%+wj%,y0%+wd%
2D_LINE x0%,y0%+wd%+hj%,x0%+wj%-20,y0%+2*wd%+hj%
2D_LINE x0%+20,y0%+2*wd%+hj%,x0%+wj%,y0%+wd%+hj%
PRINT_TARGET_IS 1: FONT_SIZE 1,12
PRINT_LOCATE x0%+wj%/2-70,y0%+10: PRINT " replier et encoller "
PRINT_LOCATE x0%+wj%/2-70,y0%+wd%+hj%+10: PRINT " replier et encoller "
CAPTION 0,win$+" - POCHETTE DE CD-ROM -"
SHOW 2: SHOW 4
ELSE
IF typ% = 4 OR typ% = 5
' Jaquette DVD
WIDTH 0,hA4%+30: HEIGHT 0,wA4%+70
WIDTH 8,hA4%+10: HEIGHT 8,wA4%+10: COLOR 8,0,0,0
WIDTH 1,hA4%: HEIGHT 1,wA4%
wj% = rec*130: hj% = rec*183: wd% = rec*14: ' dos de 14 mm
IF typ% = 5 THEN wd% = rec*7: ' dos de 7 mm
2D_LINE x0%,y0%,x0%+2*wj%+wd%,y0%: 2D_POLY_TO x0%+2*wj%+wd%,y0%+hj%
2D_POLY_TO x0%,y0%+hj%: 2D_POLY_TO x0%,y0%
2D_LINE x0%+wj%,y0%,x0%+wj%,y0%+hj%
2D_LINE x0%+wj%+wd%,y0%,x0%+wj%+wd%,y0%+hj%
LEFT 2,x0%+wj%/2-25: LEFT 3,x0%+wj%+wd%/2-20: LEFT 4,x0%+wj%+wd%+wj%/2-25
CAPTION 0,win$+" - JAQUETTE DVD -"
SHOW 2: SHOW 3: SHOW 4
END_IF
END_IF
END_IF
END_IF
' message str$(width(0))+" x "+str$(height(0))+b$+str$(width(1))+" x "+str$(height(1))
RETURN
' ==============================================================================
Ouvrir:
FILTER 90,"*.bmp;*.jpg"
a$ = FILE_NAME$(90): IF LEN(a$)<5 THEN RETURN
b$ = UPPER$(FILE_EXTRACT_EXTENSION$(a$))
IF b$<>".BMP" AND b$<>".JPG"
MESSAGE "Fichier "+a$+CHR$(10)+"type incorrect (doit être .BMP ou .JPG)": RETURN
END_IF
Dimima(a$): b$ = CLIPBOARD_STRING_PASTE$: i% = INSTR(b$,"x")
x% = VAL(LEFT$(b$,i%-1)): y% = VAL(RIGHT_POS$(b$,i%+1))
IF x%>y% AND WIDTH(1)<HEIGHT(1) THEN typ% = 2: GOSUB Desfond
IF x%<y% AND WIDTH(1)>HEIGHT(1) THEN typ% = 1: GOSUB Desfond
FILE_LOAD 1,a$
fsv$ = a$
CAPTION 0,CAPTION$(0)+" "+fsv$
RETURN
' ==============================================================================
Sauver:
IF fsv$ = "" OR CLICKED(55) = 1
FILTER 91,"*.bmp"
a$ = FILE_NAME$(91): IF LEN(a$)<5 THEN RETURN
b$ = UPPER$(FILE_EXTRACT_EXTENSION$(a$))
IF b$<>".BMP"
MESSAGE "Fichier "+a$+CHR$(10)+"type incorrect (doit être .BMP)": RETURN
END_IF
fsv$ = a$
END_IF
FILE_SAVE 1,fsv$
CAPTION 0,CAPTION$(0)+" "+fsv$
RETURN
' ==============================================================================
Insert:
IF subact% = 1
TO_FOREGROUND forsub%
MESSAGE "Fermez d'abord l'outil en cours !"
RETURN: ' une sub déjà active, remise au 1er plan
END_IF
x% = NUMBER_CLICK
SELECT x%
CASE 72: Texte(100,100,1)
CASE 73: Dessin(100,100,1,0)
CASE 74: Imagin(100,100,1)
END_SELECT
RETURN
' ==============================================================================
Imprime:
IF MESSAGE_CONFIRMATION_YES_NO("Imprimante prête ?") = 0 THEN RETURN
FILE_SAVE 1,rtmp$+"Img.bmp": ' image du picture de travail
DLL_ON kgf$
i% = 1: ' orientation paysage
IF typ% = 1 OR typ% = 7 THEN i% = 0: ' orientation portrait
Pr_Init(i%,""): ' format paysage
Pr_Image(rtmp$+"Img.bmp",0,0,Pr_lt%,Pr_ht%,0)
Pr_Impr()
DLL_OFF
FILE_DELETE rtmp$+"Img.bmp"
RETURN
' ==============================================================================
Aide:
b$ = CHR$(10)
SELECT typ%
CASE 1: a$ = "Page A4 orientation Portrait, remplissage libre."
CASE 2: a$ = "Page A4 orientation Paysage, remplissage libre."
CASE 3: a$ = "Fabrication d'une pochette pour CD-ROM:"+b$
a$=a$+"A imprimer sur papier fort ou bristol, découper,"+b$
a$=a$+"replier les languettes vers l'arrière,les encoller,"+b$
a$=a$+"puis replier la partie droite pour l'appliquer sur"+b$
a$=a$+"les languettes."+b$
a$=a$+"La partie à droite est le recto (Titre)."
CASE 4: a$ = "Fabrication d'une jaquette pour boîtier de DVD:"+b$
a$=a$+"A imprimer, puis découper, puis marquer les plis."+b$
a$=a$+"Glisser sous le plastique transparent du coffret dvd."+b$+b$
a$=a$+"Les dimensions implicites sont standards (panneaux de 130x183 mm),"+b$
a$=a$+"le dos a une épaisseur de 14 mm (boîtier normal)."
CASE 5: a$ = "Fabrication d'une jaquette pour boîtier de DVD:"+b$
a$=a$+"A imprimer, puis découper, puis marquer les plis."+b$
a$=a$+"Glisser sous le plastique transparent du coffret dvd."+b$+b$
a$=a$+"Les dimensions implicites sont standards (panneaux de 130x183 mm),"+b$
a$=a$+"le dos a une épaisseur de 7 mm (boîtier mince)."
CASE 6: a$ = "Carte imprimée au format A5, la partie droite étant le recto."+b$
a$=a$+"L'impression se fait sur papier fort ou bristol. On peut"+b$
a$=a$+"également créer la partie interne et l'imprimer sur le même"+b$
a$=a$+"support en retournant la feuille (page 2 à gauche) ou sur une"+b$
a$=a$+"feuille séparée qui sera encartée."
CASE 7: a$="Carte à imprimer sur bristol et replier, d'abord le"+b$
a$=a$+"le bas vers le haut, puis la droite sur la gauche."+b$
a$=a$+"Les pages sont sur sur la feuille dans l'ordre suivant:"+b$+b$
a$=a$+" Page 4 Page 1"+b$+" Page 3 Page 2"+b$+b$
a$=a$+"N.B.: La moitié inférieure de la feuille comprend les deux"+b$
a$=a$+"futures pages intérieures (2 et 3) de la carte.
a$=a$+"Aussi, les textes de ces pages 2 et 3 sont à pivoter de"+b$
a$=a$+"180° (deux fois 90°) pour être dans le bon sens à la"+b$
a$=a$+"lecture, après pliage."
END_SELECT
MESSAGE a$
RETURN
' ==============================================================================
SUB Windows_Ver()
' Version de Windows, -> win$ (papydall)
DIM_LOCAL v$,v2$,w$,n
IF VARIABLE("win$") = 0 THEN DIM win$
EXECUTE_WAIT "cmd /c ver | clip"
v$ = CLIPBOARD_STRING_PASTE$
n = INSTR(v$,"version"): v2$ = MID$(v$,n+8,3)
if v2$ ="10." then win$ = "Windows 10"
if v2$ ="6.3" then win$ = "Windows 8.1"
if v2$ ="6.2" then win$ = "Windows 8"
if v2$ ="6.1" then win$ = "Windows 7"
if v2$ ="6.0" then win$ = "Windows Vista"
if v2$ ="5.1" then win$ = "Windows XP"
if v2$ ="4.9" then win$ = "Windows ME"
if v2$ ="5.0" then win$ = "Windows 2000"
if v2$ ="4.1" then win$ = "Windows 98"
if v2$ ="4.0" then win$ = "Windows 95"
END_SUB
' ==============================================================================
SUB Texte(xa%,ya%,p%)
' boîte à outils affichée en xa%,ya% pour apposer du texte sur le picture p%
' Variables définies dans le programme principal:
' subact% (témoin d'activité)
' rtmp$ (répertoire des fichiers temporaires)
' forsub% (Form utilisée par la sub)
subact% = 1
DIM_LOCAL f%,i%,j%,k%,x%,y%,tr%,tg%,tb%,a$,ret%,lp%,n2t%,n2p%,p1%,wt%,ht%,fpr$,co%
DIM_LOCAL r%,g%,b%,mm%,lc%,ld%,sh%,ps%,sx%,sy%,pal%,ap%,wi%,hi%,wp%,hp%,ima%,rtg%
DIM_LOCAL x1%,y1%,q$,ft1$,ft2$,scr$,rec
rec = 3.70656: ' A l'écran: 1 mm = 3,70656 pixels
fpr$ = rtmp$+"Savpre.bmp"
ft1$ = rtmp$+"temp.bmp"
ft2$ = rtmp$+"tempr.bmp": ' provisoires, pour la rotation
IF FILE_EXISTS(fpr$) = 1 THEN FILE_DELETE fpr$
DATA "Pal16": ' palette 16 couleurs
DATA "000000","000080","0000FF","008000","008080","00FF00","00FFFF","800000"
DATA "800080","808000","808080","C0C0C0","FF0000","FF00FF","FFFF00","FFFFFF"
n2t% = NUMBER_2D_TARGET: n2p% = NUMBER_PRINT_TARGET
IF LABEL("Texfin")=0 THEN LABEL Texfin
IF LABEL("Texpol")=0 THEN LABEL Texpol
IF LABEL("Texpom")=0 THEN LABEL Texpom
IF LABEL("Texcou")=0 THEN LABEL Texcou
IF LABEL("Texenr")=0 THEN LABEL Texenr
IF LABEL("Texins")=0 THEN LABEL Texins
IF LABEL("Texanu")=0 THEN LABEL Texanu
IF LABEL("Texdim")=0 THEN LABEL Texdim
IF LABEL("Texrot")=0 THEN LABEL Texrot
IF LABEL("Texshi")=0 THEN LABEL Texshi
IF LABEL("Texinss")=0 THEN LABEL Texinss
IF LABEL("Texcen")=0 THEN LABEL Texcen
f% = forsub%: WHILE OBJECT_EXISTS(f%)=1: f%=f%+1: END_WHILE
FORM f%: TOP f%,ya%: LEFT f%,xa%: HEIGHT f%,540: WIDTH f%,352: BORDER_SMALL f%
COLOR f%,180,255,255: FONT_BOLD f%: FONT_NAME f%,"Arial": ON_CLOSE f%,Texfin
CAPTION f%,"- OUTILS TEXTE -"
i%=f%+1: EDIT i%: PARENT i%,f%: TOP i%,0: LEFT i%,0: WIDTH i%,130
TEXT i%,"Arial": ON_CLICK i%,Texpol: ' Police
i%=f%+2: SPIN i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,WIDTH(i%-1)+2: WIDTH i%,45
MIN i%,6: MAX i%,255: POSITION i%,12: ' Taille caractères
ON_CHANGE f%+2,Texenr
i%=f%+3: PICTURE i%: PARENT i%,f%: TOP i%,1: LEFT i%,LEFT(f%+2)+47: WIDTH i%,25
HEIGHT i%,20: COLOR i%,0,0,0: ' Témoin de couleur
i%=f%+4: CHECK i%: PARENT i%,f%: TOP i%,3: LEFT i%,LEFT(f%+3)+28: CAPTION i%,"G"
i%=f%+5: CHECK i%: PARENT i%,f%: TOP i%,3: WIDTH i%,25: LEFT i%,LEFT(f%+4)+25: CAPTION i%,"I"
i%=f%+6: CHECK i%: PARENT i%,f%: TOP i%,3: WIDTH i%,25: LEFT i%,LEFT(f%+5)+25: CAPTION i%,"S"
FOR j%=f%+4 TO f%+6: ON_CLICK j%,Texenr: NEXT j%
i%=f%+7: CHECK i%: PARENT i%,f%: TOP i%,3: WIDTH i%,54: LEFT i%,LEFT(i%-1)+25: CAPTION i%,"Centré"
ON_CLICK i%,Texcen
i%=i%+1: PICTURE i%: PARENT i%,f%: TOP i%,25: LEFT i%,0: WIDTH i%,WIDTH(f%)-17
HEIGHT i%,16: 2D_TARGET_IS i%: ON_CLICK i%,Texcou: pal%=i%: ' palette de 16 couleurs
RESTORE: READ a$: WHILE a$<>"Pal16": READ a$: END_WHILE
FOR j% = 1 TO 16
READ a$
tr%=HEX(LEFT$(a$,2)): tg%=HEX(MID$(a$,3,2)): tb%=HEX(RIGHT$(a$,2))
2D_FILL_COLOR tr%,tg%,tb%
2D_RECTANGLE x%,y%,x%+20,y%+15: x%=x%+21
NEXT j%
tr% = 0: tg% = 0: tb% = 0: ' couleur de base (noir)
i%=i%+1: ALPHA i%: PARENT i%,f%: TOP i%,TOP(pal%)+30: LEFT i%,2: CAPTION i%,"Aperçu:"
i%=i%+1: EDIT i%: PARENT i%,f%: TOP i%,TOP(pal%)+20: LEFT i%,50: WIDTH i%,WIDTH(f%)-68
HEIGHT i%,40: COLOR i%,255,255,190: ap%=i%
FONT_SIZE i%,12: FONT_BOLD_OFF i%: TEXT i%,"ABC xyz 01234"
co%=i%+1: CONTAINER_OPTION co%: PARENT co%,f%: TOP co%,TOP(i%)+40
LEFT co%,50: WIDTH co%,220: HEIGHT co%,30: COLOR co%,255,255,190
i%=co%+1: OPTION i%: PARENT i%,co%: TOP i%,10: LEFT i%,10: CAPTION i%,"Fond blanc"
WIDTH i%,150: MARK_ON i%
i%=i%+1: OPTION i%: PARENT i%,co%: TOP i%,TOP(i%-1): LEFT i%,105
CAPTION i%,"Fond transparent"
mm%=i%+1: MEMO mm%: PARENT mm%,f%: TOP mm%,TOP(co%)+30: WIDTH mm%,WIDTH(f%)-16
HEIGHT mm%,HEIGHT(f%)-240: FONT_BOLD_OFF mm%: ' memo de saisie du texte
FONT_NAME mm%,"Arial": FONT_SIZE mm%,10
lp%=mm%+1: LIST lp%: PARENT lp%,f%: TOP lp%,TOP(f%+1)+20: WIDTH lp%,130: HEIGHT lp%,HEIGHT(f%)-130
HIDE lp%: FONT_NAMES_LOAD lp%: COLOR lp%,255,255,190: ON_CLICK lp%,Texpom
FOR j%=COUNT(lp%) TO 1 STEP -1: ' liste des polices
IF LEFT$(ITEM_READ$(lp%,j%),1)="@" THEN ITEM_DELETE lp%,j%
NEXT j%: ' Polices
p1%=lp%+1: PICTURE p1%: LEFT p1%,-2000: WIDTH p1%,WIDTH(p%): HEIGHT p1%,HEIGHT(p%)
i%=p1%+1: BUTTON i%: PARENT i%,f%: TOP i%,TOP(mm%)+HEIGHT(mm%): LEFT i%,20: WIDTH i%,100
CAPTION i%,"Dimensions ->": ON_CLICK i%,Texdim
i%=i%+1: EDIT i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,LEFT(i%-1)+100: WIDTH i%,200: ' HEIGHT i%,25
ld% = i%
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,HEIGHT(f%)-95: LEFT i%,0: WIDTH i%,80: CAPTION i%,"Rotation 90°G"
ON_CLICK i%,Texrot: rtg%=i%
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,80: WIDTH i%,80: CAPTION i%,"Rotation 90°D"
ON_CLICK i%,Texrot
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,HEIGHT(f%)-70: LEFT i%,10: WIDTH i%,25: CAPTION i%,CHR$(231): sh%=i%
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,35: WIDTH i%,25: CAPTION i%,CHR$(232)
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,60: WIDTH i%,25: CAPTION i%,CHR$(233)
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,85: WIDTH i%,25: CAPTION i%,CHR$(234)
FOR j% = i%-3 TO i%: FONT_NAME j%,"Wingdings": ON_CLICK j%,Texshi: NEXT j%
i%=i%+1: SPIN i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,LEFT(i%-1)+30: WIDTH i%,40
POSITION i%,5
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,WIDTH(f%)/2+10
CAPTION i%,"Annuler": ON_CLICK i%,Texanu
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,TOP(i%-1): WIDTH i%,50: LEFT i%,WIDTH(f%)-70
CAPTION i%,"Quitter": ON_CLICK i%,Texfin
i%=i%+1: IMAGE i%: PARENT i%,f%: ima% = i%
ON_CLICK p%,Texins: ' clic sur le point d'insertion du texte (picture principal)
x% = -1: y% = -1
ret% = 0: WHILE ret% = 0: WAIT 100: END_WHILE
OFF_CLICK p%: 2D_TARGET_IS n2t%: PRINT_TARGET_IS n2p%
DELETE f%: DELETE ima%: DELETE p1%
IF FILE_EXISTS(fpr$) = 1 THEN FILE_DELETE fpr$
IF FILE_EXISTS(ft1$) = 1 THEN FILE_DELETE ft1$
subact% = 0: EXIT_SUB
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texpol:
SHOW lp%
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texpom:
TEXT f%+1,ITEM_INDEX$(lp%)
HIDE lp%
FONT_NAME mm%,TEXT$(f%+1)
FONT_NAME ap%,TEXT$(f%+1)
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texcou:
x%=MOUSE_X_LEFT_DOWN(pal%): y%=MOUSE_Y_LEFT_DOWN(pal%)
tr%=COLOR_PIXEL_RED(pal%,x%,y%): tg%=COLOR_PIXEL_GREEN(pal%,x%,y%)
tb%=COLOR_PIXEL_BLUE(pal%,x%,y%): COLOR f%+3,tr%,tg%,tb%
FONT_COLOR ap%,tr%,tg%,tb%
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texenr:
FONT_BOLD_OFF ap%: FONT_ITALIC_OFF ap%: FONT_UNDERLINE_OFF ap%
IF CHECKED(f%+4) = 1 THEN FONT_BOLD ap%
IF CHECKED(f%+5)=1 THEN FONT_ITALIC ap%
IF CHECKED(f%+6)=1 THEN FONT_UNDERLINE ap%
FONT_SIZE ap%,POSITION(f%+2)
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texdim:
IF COUNT(mm%) = 0 THEN RETURN
FONT_NAME p1%,TEXT$(f%+1): FONT_SIZE p1%,POSITION(f%+2)
FONT_BOLD_OFF p1%: FONT_ITALIC_OFF p1%: FONT_UNDERLINE_OFF p1%: ' init
IF CHECKED(f%+4) = 1 THEN FONT_BOLD p1%
IF CHECKED(f%+5) = 1 THEN FONT_ITALIC p1%
IF CHECKED(f%+6) = 1 THEN FONT_UNDERLINE p1%
i% = 0
FOR j% = 1 TO COUNT(mm%)
k% = TEXT_WIDTH(ITEM_READ$(mm%,j%),p1%): IF k%>i% THEN i%=k%
NEXT j%
j% = COUNT(mm%)*TEXT_HEIGHT("Abcxyz",p1%): ' hauteur totale
a$ = STR$(i%)+" x "+STR$(j%)+" pixels = "
TEXT ld%,a$
wt% = i%: ht% = j%
i% = wt%/rec: j% = ht%/rec: a$ = a$+STR$(i%)+" x "+STR$(j%)+" mm"
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texcen:
IF COUNT(mm%)=0 THEN RETURN
IF CHECKED(f%+7) = 1: ' Texte centré sur lui-même
GOSUB Texdim: ' -> wt% = largeur maxi, ht% = hauteur
i% = wt%: j% = ht%
FOR j% = 1 TO COUNT(mm%)
a$ = TRIM$(ITEM_READ$(mm%,j%))
k%=TEXT_WIDTH(a$,p1%): message str$(j%)+": "+str$(k%)
WHILE k%<i%: a$=" "+a$+" ": k%=TEXT_WIDTH(a$,p1%): END_WHILE
message str$(j%)+": "+str$(k%)
ITEM_DELETE mm%,j%: ITEM_INSERT mm%,j%,RTRIM$(a$)
NEXT j%
ELSE: ' décentrage (alignement à gauche)
FOR i% = 1 TO COUNT(mm%)
a$ = TRIM$(ITEM_READ$(mm%,i%))
ITEM_DELETE mm%,i%: ITEM_INSERT mm%,i%,a$
NEXT i%
END_IF
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texins:
' Insertion du texte au clic souris
IF COUNT(mm%) = 0 THEN RETURN: ' pas de texte
sx% = MOUSE_X_POSITION(p%): sy% = MOUSE_Y_POSITION(p%)
FILE_SAVE p%,fpr$: ' sauvegarde préalable
FONT_NAME p1%,TEXT$(f%+1): FONT_SIZE p1%,POSITION(f%+2)
FONT_BOLD_OFF p1%: FONT_ITALIC_OFF p1%: FONT_UNDERLINE_OFF p1%: ' init
IF CHECKED(f%+4) = 1 THEN FONT_BOLD p1%
IF CHECKED(f%+5) = 1 THEN FONT_ITALIC p1%
IF CHECKED(f%+6) = 1 THEN FONT_UNDERLINE p1%
PRINT_TARGET_IS p1%: FONT_COLOR p1%,tr%,tg%,tb%
2D_TARGET_IS p1%
2D_FILL_COLOR 255,255,255
IF CHECKED(co%+2)=1 THEN 2D_FILL_COLOR 254,254,254: COLOR p1%,254,254,254
ht%=TEXT_HEIGHT("ABCxyz",p1%): wt% = 0
x% = 0: y% = 0
FOR k% = 1 TO COUNT(mm%)
a$ = ITEM_READ$(mm%,k%)
IF a$ <> ""
PRINT_LOCATE x%,y%: PRINT a$
i% = TEXT_WIDTH(a$,p1%): IF i%>wt% THEN wt% = i%
END_IF
y% = y% + ht%
NEXT k%
ht% = y%
2D_IMAGE_COPY ima%,0,0,wt%,ht%: FILE_SAVE ima%,ft1$
TEXT ld%,STR$(wt%)+" x "+STR$(ht%)+" pixels."
a$ = STR$(wt%)+" x "+STR$(ht%)+" pixels = "
i% = wt%/rec: j% = ht%/rec: a$ = a$+STR$(i%)+" x "+STR$(j%)+" mm"
TEXT ld%,a$
Texinss:
x% = sx%: y% = sy%
FILE_LOAD ima%,ft1$
IF CHECKED(co%+1) = 1: ' impression directe (fond blanc opaque)
2D_TARGET_IS p%: 2D_IMAGE_PASTE ima%,x%,y%
ELSE: ' texte fond transparent (pixel par pixel)
2D_TARGET_IS p1%: 2D_IMAGE_PASTE ima%,0,0
2D_TARGET_IS p%
FOR j% = 0 TO ht%-1
FOR i% = 0 TO wt%-1
r% = COLOR_PIXEL_RED(p1%,i%,j%)
IF r% <> 254
g% = COLOR_PIXEL_GREEN(p1%,i%,j%)
b% = COLOR_PIXEL_BLUE(p1%,i%,j%)
2D_PEN_COLOR r%,g%,b%: 2D_POINT x%+i%,y%+j%
END_IF
NEXT i%
DISPLAY
NEXT j%
END_IF
TO_FOREGROUND f%
IF FILE_EXISTS(ft2$) = 1 THEN FILE_DELETE ft2$
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texrot:
IF x%=-1 OR y%=-1 OR COUNT(mm%)=0 THEN RETURN
CLIPBOARD_COPY p%: ' sauvegarde préalable
2D_TARGET_IS p%
x%=sx%: y%=sy%: ' point d'insertion (haut gauche)
IF FILE_EXISTS(ft2$) = 1 THEN FILE_DELETE ft2$
a$ = "270": ' rotation 90° à gauche
IF NUMBER_CLICK = rtg%+1 THEN a$ = "90": ' rotation 90° à droite
q$ = CHR$(34)
scr$ = rtmp$+"vbscr.vbs"
FILE_OPEN_WRITE 9,scr$
FILE_WRITELN 9,"Dim Img 'As ImageFile"
FILE_WRITELN 9,"Dim IP 'As ImageProcess"
FILE_WRITELN 9,"Set Img = CreateObject("+q$+"WIA.ImageFile"+q$+")"
FILE_WRITELN 9,"Set IP = CreateObject("+q$+"WIA.ImageProcess"+q$+")"
FILE_WRITELN 9,"Img.LoadFile "+q$+ft1$+q$
FILE_WRITELN 9,"IP.Filters.Add IP.FilterInfos("+q$+"RotateFlip"+q$+").FilterID"
FILE_WRITELN 9,"IP.Filters(1).Properties("+q$+"RotationAngle"+q$+") = "+a$
FILE_WRITELN 9,"Set Img = IP.Apply(Img)"
FILE_WRITELN 9,"Img.SaveFile "+q$+ft2$+q$
FILE_WRITELN 9,"WScript.Quit(0)"
FILE_CLOSE 9
EXECUTE_WAIT "Wscript.exe " + scr$: ' Exécution du script
FILE_DELETE scr$
FILE_LOAD ima%,ft2$: FILE_SAVE ima%,ft1$: FILE_DELETE ft2$
FILE_LOAD p%,fpr$
' la rotation s'effectue autour du centre du texte (?)
sx% = x%+wt%/2-ht%/2:sy% = y%-wt%/2+ht%/2
i% = wt%: wt% = ht%: ht% = i%
IF CHECKED(co%+1) = 1: ' fond opaque
2D_IMAGE_PASTE ima%,sx%,sy%
ELSE
2D_TARGET_IS p1%: 2D_IMAGE_PASTE ima%,0,0
2D_TARGET_IS p%
FOR j% = 0 TO ht%-1
FOR i% = 0 TO wt%-1
r% = COLOR_PIXEL_RED(p1%,i%,j%)
IF r% <> 254
g% = COLOR_PIXEL_GREEN(p1%,i%,j%)
b% = COLOR_PIXEL_BLUE(p1%,i%,j%)
2D_PEN_COLOR r%,g%,b%: 2D_POINT sx%+i%,sy%+j%
END_IF
NEXT i%
DISPLAY
NEXT j%
END_IF
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texshi:
IF x%=-1 OR y%=-1 OR COUNT(mm%)=0 THEN RETURN
ps% = POSITION(sh%+4): ' pas du déplacement
CLIPBOARD_COPY p%
2D_TARGET_IS p%
i% = NUMBER_CLICK
IF i%=sh%: ' décalage vers la gauche
sx% = sx%-ps%
ELSE
IF i%=sh%+1: ' décalage vers la droite
sx%=sx%+ps%
ELSE
IF i%=sh%+2: ' décalage vers le haut
sy%=sy%-ps%
ELSE: ' décalage vers le bas
sy%=sy%+ps%
END_IF
END_IF
END_IF
FILE_LOAD p%,fpr$
GOSUB Texinss
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texanu:
IF FILE_EXISTS(fpr$) = 1 THEN FILE_LOAD p%,fpr$: CLIPBOARD_COPY p%
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texfin:
ret% = 1
RETURN
END_SUB
' ==============================================================================
SUB Dessin(xa%,ya%,p%,r)
' Boîte à outils affichée en xa%,ya% pour dessiner sur le picture p%
' r = facteur de correction des coordonnées
' cas du stretch_on dans un picture: r = Largeur picture/Largeur réelle image
' (r = 1 si picture = image)
' Variables définies dans le programme principal:
' subact% (témoin d'activité)
' rtmp$ (répertoire des fichiers temporaires)
' forsub% (Form utilisée par la sub)
subact% = 1
IF r = 0 THEN r = 1: ' si paramètre absent
DIM_LOCAL f%,t%,i%,j%,k%,x%,y%,a$,tr%,tg%,tb%,n2t%,fig%,trac%,term%,ret%,an,cpt
DIM_LOCAL x1%,y1%,x2%,y2%,x3%,y3%,fpr$,btg%,cap$,rx%,ry%,pix
fpr$ = rtmp$+"Savpre.bmp"
IF FILE_EXISTS(fpr$) = 1 THEN FILE_DELETE fpr$
IF LABEL("Desfin")=0 THEN LABEL Desfin
IF LABEL("Desopt")=0 THEN LABEL Desopt
IF LABEL("Desanu")=0 THEN LABEL Desanu
IF LABEL("Descou")=0 THEN LABEL Descou
IF LABEL("Destim")=0 THEN LABEL Destim
IF LABEL("Destra")=0 THEN LABEL Destra
IF LABEL("Deslib")=0 THEN LABEL Deslib
IF LABEL("Desrec")=0 THEN LABEL Desrec
IF LABEL("Desron")=0 THEN LABEL Desron
IF LABEL("Desrem")=0 THEN LABEL Desrem
DATA "Pal16": ' palette 16 couleurs
DATA "000000","000080","0000FF","008000","008080","00FF00","00FFFF","800000"
DATA "800080","808000","808080","C0C0C0","FF0000","FF00FF","FFFF00","FFFFFF"
n2t% = NUMBER_2D_TARGET
ON_CLICK p%,Desrem
f% = forsub%: WHILE OBJECT_EXISTS(f%)=1: f%=f%+1: END_WHILE
FORM f%: TOP f%,ya%: LEFT f%,xa%: HEIGHT f%,280: WIDTH f%,145: BORDER_SMALL f%
COLOR f%,180,255,255: FONT_BOLD f%: FONT_NAME f%,"Arial": ON_CLOSE f%,Desfin
CAPTION f%,"- OUTILS DESSIN -"
i%=f%+1: ALPHA i%: PARENT i%,f%: TOP i%,3: CAPTION i%,"Trait:"
i%=f%+2: PICTURE i%: PARENT i%,f%: TOP i%,0: LEFT i%,32: WIDTH i%,35: HEIGHT i%,23
COLOR i%,0,0,0
i%=f%+3: PICTURE i%: PARENT i%,f%: TOP i%,3: LEFT i%,35: WIDTH i%,WIDTH(i%-1)-5
HEIGHT i%,18: COLOR i%,255,0,0
i%=f%+4: SPIN i%: PARENT i%,f%: LEFT i%,75: WIDTH i%,40: font_size i%,9
MIN i%,1: MAX i%,20: POSITION i%,1
i%=f%+5: PICTURE i%: PARENT i%,f%: TOP i%,25: LEFT i%,0: WIDTH i%,WIDTH(f%)-17
HEIGHT i%,63: 2D_TARGET_IS i%: ON_CLICK i%,Descou
RESTORE: READ a$: WHILE a$<>"Pal16": READ a$: END_WHILE
FOR j% = 1 TO 4
FOR i% = 1 TO 4
READ a$
tr%=HEX(LEFT$(a$,2)): tg%=HEX(MID$(a$,3,2)): tb%=HEX(RIGHT$(a$,2))
2D_FILL_COLOR tr%,tg%,tb%
2D_RECTANGLE x%,y%,x%+31,y%+15: x%=x%+32
NEXT i%
y%=y%+16: x% = 0
NEXT j%
tr% = 0: tg% = 0: tb% = 0: COLOR f%+3,tr%,tg%,tb%
i%=f%+6: CONTAINER_OPTION i%: PARENT i%,f%: TOP i%,TOP(i%-1)+65: WIDTH i%,WIDTH(f%)-17
LEFT i%,0: HEIGHT i%,125: COLOR i%,255,255,180
i%=i%+1:OPTION i%: PARENT i%,f%+6: TOP i%,10: LEFT i%,3: CAPTION i%,"Trait"
i%=i%+1:OPTION i%: PARENT i%,f%+6: TOP i%,25: LEFT i%,3: CAPTION i%,"Libre"
i%=i%+1:OPTION i%: PARENT i%,f%+6: TOP i%,40: LEFT i%,3: CAPTION i%,"Rectangle vide"
i%=i%+1:OPTION i%: PARENT i%,f%+6: TOP i%,55: LEFT i%,3: CAPTION i%,"Rectangle plein"
i%=i%+1:OPTION i%: PARENT i%,f%+6: TOP i%,70: LEFT i%,3: CAPTION i%,"Cercle/Ellipse vide"
i%=i%+1:OPTION i%: PARENT i%,f%+6: TOP i%,85: LEFT i%,3: CAPTION i%,"Cercle/Ellipse plein"
i%=i%+1:OPTION i%: PARENT i%,f%+6: TOP i%,100: LEFT i%,3: CAPTION i%,"Remplir"
MARK_ON f%+7
FOR j%=f%+7 TO f%+13: WIDTH j%,WIDTH(f%+6)-7: ON_CLICK j%,Desopt: NEXT j%
i%=f%+14: BUTTON i%: PARENT i%,f%: WIDTH i%,60: TOP i%,TOP(f%+6)+HEIGHT(f%+6)
HEIGHT i%,20: CAPTION i%,"Annuler": ON_CLICK i%,Desanu
i%=f%+15:BUTTON i%: PARENT i%,f%: WIDTH i%,55:TOP i%,TOP(i%-1): LEFT i%,70
HEIGHT i%,20: CAPTION i%,"Quitter": ON_CLICK i%,Desfin
2D_TARGET_IS p%: 2D_PEN_DOT
t%=f%+16: TIMER t%: PARENT t%,f%: TIMER_INTERVAL t%,40: ON_TIMER t%,Destim
trac% = 0: term% = 0: btg% = 0
fig% = 1: ret% = 0: cap$ = CAPTION$(0)
CLIPBOARD_COPY p%
WHILE 1 > 0: WAIT 100: END_WHILE: GOTO Desfin
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Desopt:
fig% = 1: ' trait
IF CHECKED(f%+8) = 1
fig% = 2: ' tracé libre
FILE_SAVE p%,fpr$: ' sauvegarde préalable
ELSE
IF CHECKED(f%+9) = 1 OR CHECKED(f%+10) = 1
fig% = 3: ' rectangle vide ou plein
ELSE
IF CHECKED(f%+11) = 1 OR CHECKED(f%+12) = 1
fig% = 4: ' cercle vide ou plein
ELSE
IF CHECKED(f%+13) = 1
fig% = 5: ' remplissage
END_IF
END_IF
END_IF
END_IF
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Destim:
IF CHECKED(f%+13)=1 THEN RETURN: ' remplissage
cpt = cpt+1: IF cpt>1000 THEN cpt = 2
x% = MOUSE_X_POSITION(p%)/r: y% = MOUSE_Y_POSITION(p%)/r: ' position actuelle souris
a$ = "X= "+STR$(x%)+" pixels Y= "+STR$(y%)+" pixels"
CAPTION 0,a$
2D_PEN_COLOR tr%,tg%,tb%: 2D_PEN_WIDTH POSITION(f%+4)
IF MOUSE_LEFT_DOWN(p%) = 1: ' bouton gauche enfoncé
x1% = x%: y1% = y%: ' origine
trac% = 1
IF fig% = 2 AND btg% = 0 THEN FILE_SAVE p%,fpr$: ' sauvegarde préalable
btg% = 1
END_IF
IF MOUSE_LEFT_UP(p%) = 1: ' relâche, tracé final
btg% = 0
IF x1% = -1 THEN RETURN
TIMER_OFF t%
' clipboard_paste p%:
term% = 1: 2D_PEN_SOLID
SELECT fig%
CASE 1: GOSUB Destra
CASE 2: GOSUB Deslib
CASE 3: GOSUB Desrec
CASE 4: GOSUB Desron
CASE 5: GOSUB Desrem
END_SELECT
' x1% = sx1%: x2% = sx2%: y1% = sy1%: y2% = sy2%
CLIPBOARD_COPY p%: term% = 0
trac% = 0: 2D_PEN_DOT: 2D_PEN_COLOR 0,0,255
TIMER_ON t%
END_IF
IF trac% = 1
' tracé provisoire, en continu
if x1% = -1 then return
x2% = x%: y2% = y%: ' position actuelle
IF x2%=x3% AND y2%=y3% THEN RETURN: ' position inchangée
2D_PEN_DOT: 2D_PEN_COLOR 0,0,255: 2D_PEN_WIDTH 1
SELECT fig%
CASE 1: GOSUB Destra
CASE 2: GOSUB Deslib
CASE 3: GOSUB Desrec
CASE 4: GOSUB Desron
END_SELECT
x3% = x%: y3% = y%
END_IF
TO_FOREGROUND f%
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Destra:
IF cpt = 1 THEN RETURN: ' init
CLIPBOARD_PASTE p%: IF term% = 1 THEN FILE_SAVE p%,fpr$: ' sauvegarde préalable
2D_LINE x1%,y1%,x2%,y2%
IF term% = 1 THEN x1% = -1
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Deslib:
2D_PEN_SOLID: 2D_PEN_COLOR tr%,tg%,tb%: 2D_PEN_WIDTH POSITION(f%+4)
2D_LINE x1%,y1%,x2%,y2%: x1%=x2%: y1%=y2%
IF term% = 1 THEN x1% = -1
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Desrec:
CLIPBOARD_PASTE p%: IF term% = 1 THEN FILE_SAVE p%,fpr$: ' sauvegarde préalable
2D_LINE x1%,y1%,x2%,y1%:2D_POLY_TO x2%,y2%:2D_POLY_TO x1%,y2%:2D_POLY_TO x1%,y1%
IF term% = 1
IF CHECKED(f%+10) = 1: ' rectangle plein
2D_FILL_COLOR tr%,tg%,tb%: 2D_RECTANGLE x1%,y1%,x2%,y2%
END_IF
x1% = -1
END_IF
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Desron:
CLIPBOARD_PASTE p%: IF term% = 1 THEN FILE_SAVE p%,fpr$: ' sauvegarde préalable
rx% = (x2%-x1%)/2: ry% = (y2%-y1%)/2: ' rayons
IF SCANCODE = 160 THEN ry% = rx%: SCANCODE = 0: ' cercle: touche 'Maj' enfoncée
x3% = x1%+rx%: y3% = y1%+ry%: ' centre
pix = 4*ATN(1)
2D_POLY_FROM x3%+rx%,y3%
FOR an = 0 TO 2*pix STEP pix/180
2D_POLY_TO x3%+rx%*COS(an),y3%+ry%*SIN(an)
NEXT an
IF term% = 1
IF CHECKED(f%+12) = 1: ' cercle/ellipse plein
2D_FLOOD x3%,y3%,tr%,tg%,tb%
END_IF
x1% = -1
END_IF
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Desrem:
IF CHECKED(f%+13)=0 THEN RETURN
FILE_SAVE p%,fpr$: ' sauvegarde préalable
x% = MOUSE_X_LEFT_DOWN(p%)/r: y% = MOUSE_Y_LEFT_DOWN(p%)/r
2D_FLOOD x%,y%,tr%,tg%,tb%
x1% = -1
CLIPBOARD_COPY p%
TO_FOREGROUND f%
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Desanu:
IF FILE_EXISTS(fpr$) = 1 THEN FILE_LOAD p%,fpr$: CLIPBOARD_COPY p%
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Descou:
x%=MOUSE_X_LEFT_DOWN(f%+5): y%=MOUSE_Y_LEFT_DOWN(f%+5)
tr%=COLOR_PIXEL_RED(f%+5,x%,y%): tg%=COLOR_PIXEL_GREEN(f%+5,x%,y%)
tb%=COLOR_PIXEL_BLUE(f%+5,x%,y%): COLOR f%+3,tr%,tg%,tb%
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Desfin:
ret% = 1
TIMER_OFF t%: DELETE t%: OFF_CLICK p%: 2D_TARGET_IS n2t%
DELETE f%: CAPTION 0,cap$
WAIT 100
subact% = 0: EXIT_SUB
RETURN
END_SUB
' ==============================================================================
SUB Imagin(xa%,ya%,p%)
' boîte à outils, affichée en xa%,ya%, pour apposer une image sur le picture p%
' Variables définies dans le programme principal:
' subact% (témoin d'activité)
' rtmp$ (répertoire des fichiers temporaires)
' forsub% (Form utilisée par la sub)
subact% = 1
DIM_LOCAL f%,i%,j%,k%,x%,y%,tr%,tg%,tb%,a$,b$,ret%,lp%,n2t%,p1%,wt%,ht%,fpr$,opn%
DIM_LOCAL img%,fcl$,fvb$,wi%,hi%,fi$,sh%,ps%,sx%,sy%,adi%,pic%,rc$,wp%,hp%,tra%
DIM_LOCAL t$,n$,rig%,iv$,fop%,ppr%,imi%,far$,bh%,bl%,ft1$,r$,q$,scr$
fi$ = rtmp$+"Ifxwz.txt"
fpr$ = rtmp$+"Savpre.bmp"
fcl$ = rtmp$+"Savcol.bmp"
fvb$ = rtmp$+"Script.vbs": ' calcul des dimensions de l'image
ft1$ = rtmp$+"temp.bmp"
far$ = rtmp$+"Img.bmp": ' provisoires, pour la rotation
wp% = WIDTH(p%): hp% = HEIGHT(p%)
IF FILE_EXISTS(fpr$) = 1 THEN FILE_DELETE fpr$
rc$ = CHR$(13)+CHR$(10)
n2t% = NUMBER_2D_TARGET: 2D_TARGET_IS p%
IF LABEL("Imgfin")=0 THEN LABEL Imgfin
IF LABEL("Imgchx")=0 THEN LABEL Imgchx
IF LABEL("Imgins")=0 THEN LABEL Imgins
IF LABEL("Imginc")=0 THEN LABEL Imginc
IF LABEL("Imganu")=0 THEN LABEL Imganu
IF LABEL("Imgchw")=0 THEN LABEL Imgchw
IF LABEL("Imgchh")=0 THEN LABEL Imgchh
IF LABEL("Imgshi")=0 THEN LABEL Imgshi
IF LABEL("Imgrot")=0 THEN LABEL Imgrot
IF LABEL("Imginss")=0 THEN LABEL Imginss
f% = forsub%: WHILE OBJECT_EXISTS(f%)=1: f%=f%+1: END_WHILE
PICTURE f%: FULL_SPACE f%: bl% = (WIDTH(0)-WIDTH(f%))/2: ' largeur bordures latérales
bh% = HEIGHT(0)-HEIGHT(f%)-bl%: ' bordure haut (bordure bas = bordures latérales)
DELETE f%
FORM f%: TOP f%,ya%: LEFT f%,xa%: HEIGHT f%,240: WIDTH f%,352: BORDER_SMALL f%
COLOR f%,180,255,255: FONT_BOLD f%: FONT_NAME f%,"Arial": ON_CLOSE f%,Imgfin
CAPTION f%,"- OUTILS IMAGE -"
i%=f%+1: ALPHA i%: PARENT i%,f%: TOP i%,3: CAPTION i%,"Image:"
i%=f%+2: EDIT i%: PARENT i%,f%: TOP i%,0: LEFT i%,40: WIDTH i%,290: ON_CLICK i%,Imgchx: ' Image
TEXT i%," (parcourir)": FONT_BOLD_OFF i%: FONT_ITALIC i%
i%=i%+1: PICTURE i%: PARENT i%,f%: TOP i%,TOP(i%-1)+28: LEFT i%,1: WIDTH i%,144: HEIGHT i%,108
STRETCH_ON i%: pic%=i%
i%=i%+1: ALPHA i%: PARENT i%,f%: TOP i%,25: LEFT i%,155: CAPTION i%,"Dimensions:"
i%=i%+1: ALPHA i%: PARENT i%,f%: TOP i%,28: LEFT i%,LEFT(i%-1)+75: WIDTH i%,100
COLOR i%,255,255,0: adi%=i%
i%=adi%+1: ALPHA i%: PARENT i%,f%: TOP i%,58: LEFT i%,155
CAPTION i%,"Redim.: W= H="
i%=adi%+2: SPIN i%: PARENT i%,f%: TOP i%,TOP(i%-1)-3: LEFT i%,LEFT(i%-1)+60: WIDTH i%,50
i%=adi%+3: SPIN i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,LEFT(i%-1)+70: WIDTH i%,50
ON_CHANGE adi%+2,Imgchw: ON_CHANGE adi%+3,Imgchh
i%=adi%+4: ALPHA i%: PARENT i%,f%: TOP i%,TOP(i%-1)+25: LEFT i%,LEFT(adi%+2): COLOR i%,255,255,0
i%=i%+1: ALPHA i%: PARENT i%,f%: LEFT i%,165: TOP i%,TOP(i%-1)+20: CAPTION i%,"Luminosité (0 à 127):"
i%=i%+1: SPIN i%: PARENT i%,f%: TOP i%,TOP(i%-1)-3: LEFT i%,LEFT(i%-1)+120: WIDTH i%,50: tra%=i%
MIN i%,0: MAX i%,127: POSITION i%,0
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,TOP(i%-1)+20: LEFT i%,155: WIDTH i%,90: HEIGHT i%,18
CAPTION i%,"Insérer en 0,0": ON_CLICK i%,Imginc
i%=i%+1: ALPHA i%: PARENT i%,f%: TOP i%,TOP(i%-1)+18: LEFT i%,LEFT(i%-1)+10
CAPTION i%,"(sinon, insertion au clic souris)"
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,HEIGHT(f%)-98: LEFT i%,0: WIDTH i%,80
CAPTION i%,"Rotation 90°G": ON_CLICK i%,Imgrot: rig% = i%
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,LEFT(i%-1)+WIDTH(i%-1)
WIDTH i%,80: CAPTION i%,"Rotation 90°D": ON_CLICK i%,Imgrot
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,HEIGHT(f%)-70: LEFT i%,10: WIDTH i%,25
CAPTION i%,CHR$(231): sh%=i%
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,35: WIDTH i%,25: CAPTION i%,CHR$(232)
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,60: WIDTH i%,25: CAPTION i%,CHR$(233)
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,85: WIDTH i%,25: CAPTION i%,CHR$(234)
FOR j% = i%-3 TO i%: FONT_NAME j%,"Wingdings": ON_CLICK j%,Imgshi: NEXT j%
i%=i%+1: SPIN i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,LEFT(i%-1)+30: WIDTH i%,40
POSITION i%,5
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,HEIGHT(f%)-70: LEFT i%,WIDTH(f%)/2
CAPTION i%,"Annuler": ON_CLICK i%,Imganu
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,LEFT(i%-1)+80
CAPTION i%,"Quitter": ON_CLICK i%,Imgfin
i%=i%+1: OPEN_DIALOG i%: opn% = i%
i%=i%+1: IMAGE i%: img% = i%
i%=i%+1: fop% = i%
i%=i%+1: ppr% = i%
i%=i%+1: imi% = i%
ON_CLICK p%,Imgins: ' clic sur le point d'insertion de l'image (picture principal)
x%=-1: y%=-1
ret% = 0: WHILE ret% = 0: WAIT 100: END_WHILE
OFF_CLICK p%: 2D_TARGET_IS n2t%
DELETE f%: IF OBJECT_EXISTS(opn%)=1 THEN DELETE opn%
IF OBJECT_EXISTS(img%)=1 THEN DELETE img%
IF FILE_EXISTS(fpr$) = 1 THEN FILE_DELETE fpr$
IF FILE_EXISTS(fcl$) = 1 THEN FILE_DELETE fcl$
IF FILE_EXISTS(far$) = 1 THEN FILE_DELETE far$
subact% = 0
EXIT_SUB
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Imgchx:
FILTER opn%,"*.bmp;*.jpg"
a$ = FILE_NAME$(opn%): IF LEN(a$)<4 THEN RETURN
b$ = UPPER$(FILE_EXTRACT_EXTENSION$(a$))
IF b$<>".BMP" AND b$<>".JPG"
MESSAGE "Fichier "+a$+CHR$(10)+"type incorrect (doit être .BMP ou .JPG)": RETURN
END_IF
TEXT f%+2,a$: far$ = a$: FONT_ITALIC_OFF f%+2: FONT_BOLD f%+2
r$ = FILE_EXTRACT_PATH$(a$): n$ = FILE_EXTRACT_NAME$(a$)
FILE_OPEN_WRITE 9,fvb$
FILE_WRITELN 9,"Const DIMENSIONS = 31"
FILE_WRITELN 9,"Set oShell = CreateObject ("+CHR$(34)+"Shell.Application"+CHR$(34)+")"
FILE_WRITELN 9,"Set oFolder = oShell.Namespace ("+CHR$(34)+r$+CHR$(34)+")"
FILE_WRITELN 9,"Set oFile = oFolder.ParseName("+CHR$(34)+n$+CHR$(34)+")"
FILE_WRITELN 9,"strDimensions = oFolder.GetDetailsOf(oFile, DIMENSIONS)"
FILE_WRITELN 9,"WScript.Echo strDimensions"
FILE_CLOSE 9
EXECUTE_WAIT "Cmd.exe /c Cscript.exe "+fvb$+" | clip"
FILE_DELETE fvb$
r$ = TRIM$(CLIPBOARD_STRING_PASTE$): r$ = MID$(r$,2,LEN(r$)-2)
wi% = VAL(LEFT$(r$,INSTR(r$," x ")-1)): hi% = VAL(MID$(r$,INSTR(r$," x ")+3,10))
i% = wi%/rec: j% = hi%/rec: ' en mm à l'écran
a$ = " "+STR$(wi%)+" x "+ STR$(hi%)+" pixels "
a$=a$+rc$+"= "+STR$(i%/10)+" x "+STR$(j%/10)+" cm"
CAPTION adi%,a$
POSITION adi%+2,wi%: POSITION adi%+3,hi%
IF wi%>hi%
WIDTH pic%,120: HEIGHT pic%,120*hi%/wi%
ELSE
HEIGHT pic%,90: WIDTH pic%,90*wi%/hi%
END_IF
FILE_LOAD pic%,TEXT$(f%+2): ' vignette
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Imgins:
IF TEXT$(f%+2) = "" OR LEFT$(TEXT$(f%+2),1)=" " THEN TO_FOREGROUND f%: RETURN: ' pas d'image
sx% = MOUSE_X_POSITION(p%): sy% = MOUSE_Y_POSITION(p%)
FILE_SAVE p%,fpr$: ' sauvegarde préalable
' insertion de l'image au clic souris (coin supérieur gauche)
Imginss:
x% = sx%: y% = sy%
a$ = far$: ' image à insérer
i% = POSITION(adi%+2): j% = POSITION(adi%+3): ' w,h redimensionnement éventuel
FORM fop%: TOP fop%,TOP(0): LEFT fop%,LEFT(0): WIDTH fop%,i%: HEIGHT fop%,j%: BORDER_HIDE fop%
PICTURE ppr%: PARENT ppr%,fop%: WIDTH ppr%,i%: HEIGHT ppr%,j%: STRETCH_ON ppr%
FILE_LOAD ppr%,a$
IF POSITION(tra%) > 0 THEN BRIGHTNESS ppr%,POSITION(tra%): ' luminosité
2D_TARGET_IS 0
IMAGE imi%
2D_IMAGE_COPY imi%,-1*bl%,-1*bh%,i%-bl%,j%-1*bh%: ' pour tenir compte des bordures de Form 0
CLIPBOARD_COPY imi%
DELETE fop%: DELETE imi%
CLIPBOARD_PASTE img%
2D_TARGET_IS p%: 2D_IMAGE_PASTE img%,x%,y%
TO_FOREGROUND f%
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Imginc:
' insertion en 0,0 du picture
sx% = 0: sy% = 0: FILE_SAVE p%,fpr$: ' sauvegarde préalable
GOSUB Imginss
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Imgchw:
' redimensionnement éventuel de l'image
POSITION adi%+3,POSITION(adi%+2)*hi%/wi%: ' largeur proportionnelle à la hauteur
i% = POSITION(adi%+2)/rec: j% = POSITION(adi%+3)/rec: ' en mm à l'écran
CAPTION adi%+4,"= "+STR$(i%/10)+" x "+STR$(j%/10)+" cm."
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Imgchh:
i% = POSITION(adi%+2)/rec: j% = POSITION(adi%+3)/rec: ' en mm à l'écran
CAPTION adi%+4,"= "+STR$(i%/10)+" x "+STR$(j%/10)+" cm."
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Imgshi:
IF x%=-1 OR y%=-1 THEN RETURN
ps% = POSITION(sh%+4): ' pas du déplacement
CLIPBOARD_COPY p%
2D_TARGET_IS p%
i% = NUMBER_CLICK
IF i%=sh%: ' décalage vers la gauche
sx% = sx%-ps%
ELSE
IF i%=sh%+1: ' décalage vers la droite
sx%=sx%+ps%
ELSE
IF i%=sh%+2: ' décalage vers le haut
sy%=sy%-ps%
ELSE: ' décalage vers le bas
sy%=sy%+ps%
END_IF
END_IF
END_IF
FILE_LOAD p%,fpr$
GOSUB Imginss
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Imgrot:
IF x%=-1 OR y%=-1 THEN RETURN
CLIPBOARD_COPY p%
2D_TARGET_IS p%
i% = POSITION(adi%+2): j% = POSITION(adi%+3): ' dimensions de l'image
x%=sx%: y%=sy%: ' point d'insertion (haut gauche)
2D_IMAGE_COPY img%,x%,y%,x%+i%,y%+j%
IF FILE_EXISTS(far$) = 1 THEN FILE_DELETE far$
FILE_SAVE img%,ft1$
a$ = "270": ' rotation 90° à gauche
IF NUMBER_CLICK = rig%+1 THEN a$ = "90": ' rotation 90° à droite
q$ = CHR$(34)
scr$ = rtmp$+"vbscr.vbs"
FILE_OPEN_WRITE 9,scr$
FILE_WRITELN 9,"Dim Img 'As ImageFile"
FILE_WRITELN 9,"Dim IP 'As ImageProcess"
FILE_WRITELN 9,"Set Img = CreateObject("+q$+"WIA.ImageFile"+q$+")"
FILE_WRITELN 9,"Set IP = CreateObject("+q$+"WIA.ImageProcess"+q$+")"
FILE_WRITELN 9,"Img.LoadFile "+q$+ft1$+q$
FILE_WRITELN 9,"IP.Filters.Add IP.FilterInfos("+q$+"RotateFlip"+q$+").FilterID"
FILE_WRITELN 9,"IP.Filters(1).Properties("+q$+"RotationAngle"+q$+") = "+a$
FILE_WRITELN 9,"Set Img = IP.Apply(Img)"
FILE_WRITELN 9,"Img.SaveFile "+q$+far$+q$
FILE_WRITELN 9,"WScript.Quit(0)"
FILE_CLOSE 9
EXECUTE_WAIT "Wscript.exe " + scr$: ' Exécution du script
FILE_DELETE scr$: FILE_DELETE ft1$
FILE_LOAD img%,far$: ' nouvelle image pivotée
FILE_LOAD p%,fpr$
' rotation autour du centre de l'image (?)
sx% = x%+i%/2-j%/2: sy% = y%+j%/2-i%/2: ' pour rotation de 90°
2D_IMAGE_PASTE img%,sx%,sy%
k% = POSITION(adi%+2): POSITION adi%+2,POSITION(adi%+3): POSITION adi%+3,k%
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Imganu:
IF FILE_EXISTS(fpr$) = 1 THEN FILE_LOAD p%,fpr$: CLIPBOARD_COPY p%
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Imgfin:
ret% = 1
RETURN
END_SUB
' ==============================================================================
SUB Dimima(f$)
' Dimensions d'une image Bmp ou Jpg -> clipboard, sous la forme: wwwxhhh
DIM_LOCAL pi%,vi%(8 )
pi%=970: WHILE OBJECT_EXISTS(pi%)=1: pi% = pi%+1: END_WHILE
PICTURE pi%: TOP pi%,-1000: LEFT pi%,-1000
FILE_LOAD pi%,f$: FILE_SAVE pi%,rtmp$+"Dima.bmp"
FILEBIN_OPEN_READ 9, rtmp$+"Dima.bmp"
FILEBIN_POSITION 9,18: FILEBIN_BLOCK_READ 9,8,vi%(0)
FILEBIN_CLOSE 9: FILE_DELETE rtmp$+"Dima.bmp"
CLIPBOARD_STRING_COPY STR$(vi%(0)+256*vi%(1))+"x"+STR$(vi%(4)+256*vi%(5))
DELETE pi%
END_SUB
' ==============================================================================
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
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_mmp
Accueil 
Calendrier
