| Novembre 2024 | | Lun | Mar | Mer | Jeu | Ven | Sam | Dim |
|---|
| | | | | 1 | 2 | 3 | | 4 | 5 | 6 | 7 | 8 | 9 | 10 | | 11 | 12 | 13 | 14 | 15 | 16 | 17 | | 18 | 19 | 20 | 21 | 22 | 23 | 24 | | 25 | 26 | 27 | 28 | 29 | 30 | |  Calendrier |
|
|
| | Étiquettes |  |
| | | Auteur | Message |
|---|
JL35
Nombre de messages : 7112
Localisation : 77
Date d'inscription : 29/11/2007
| | Sujet: Étiquettes Dim 4 Nov 2018 - 15:25 | |
| Pour faire des étiquettes toutes simples: - Code:
-
DIM x%,y%,w%,h%,typ%,txt$,fnt$,ct%,cf%
PICTURE 1: WIDTH 1,600: HEIGHT 1,450
fnt$ = "Arial"
txt$ = "Étiquette pour voir"
typ% = 1
ct% = 255*65536+215*256: cf% = 0: ' texte 'or' sur fond noir
Etiq(1,50,40,300,80,typ%,Txt$,fnt$,"B",ct%,cf%)
typ% = 2
Etiq(1,50,140,300,80,typ%,Txt$,fnt$,"I",ct%,cf%)
typ% = 3
Etiq(1,50,240,300,80,typ%,Txt$,fnt$,"I",ct%,cf%)
typ% = 4
Etiq(1,50,340,300,80,typ%,Txt$,fnt$,"U",ct%,cf%)
END
SUB Etiq(p%,x%,y%,w%,h%,typ%,txt$,fnt$,enr$,ct%,cf%)
' Dessin sur le picture p% en x%,y% d'une étiquette de dimensions w% x h%
' de type typ%, texte Txt$, police fnt$, couleur de texte ct%, couleur de
' fond cf% (format rgb = R*65536+G*256+B).
' Types d'étiquettes:
' 1 rectangulaire, 2 rectangulaire bords arrondis, 3 rectangulaire 1/2 cercles
' 3 rectangulaire oreillettes
'
DIM_LOCAL r%,g%,b%,xc%,yc%,ry%,sz%,ht%,wt%
2D_TARGET_IS p%: PRINT_TARGET_IS p%
r% = INT(ct%/65536): g% = BIN_AND(ct%,65280)/256: b% = BIN_AND(ct%,255)
FONT_COLOR p%,r%,g%,b%: ' couleur fonte
FONT_BOLD_OFF p%: FONT_ITALIC_OFF p%: FONT_UNDERLINE_OFF p%
IF INSTR(enr$,"B") > 0 THEN FONT_BOLD p%
IF INSTR(enr$,"I") > 0 THEN FONT_ITALIC p%
IF INSTR(enr$,"U") > 0 THEN FONT_UNDERLINE p%
r% = INT(cf%/65536): g% = BIN_AND(cf%,65280)/256: b% = BIN_AND(cf%,255)
2D_PEN_COLOR 0,0,0: 2D_PEN_WIDTH 2
DEGREES
SELECT typ%
CASE 1: 2D_FILL_COLOR r%,g%,b%: 2D_RECTANGLE x%,y%,x%+w%,y%+h%
CASE 2: ry% = h%/4: 2D_LINE x%+ry%,y%,x%+w%-ry%,y%: xc%=x%+w%-ry%
yc% = y%+ry%: 2D_ARC xc%,yc%,ry%,90,0: 2D_LINE x%+w%,yc%,x%+w%,y%+h%-ry%
yc% = y%+h%-ry%: 2D_ARC xc%,yc%,ry%,0,270: 2D_LINE x%+w%-ry%,y%+h%,x%+ry%-2,y%+h%
xc% = x%+ry%: 2D_ARC xc%,yc%,ry%,270,180: 2D_LINE x%,yc%,x%,y%+ry%-2
yc% = y%+ry%: 2D_ARC xc%,yc%,ry%,180,90
2D_FLOOD xc%,yc%,r%,g%,b%
CASE 3: ry% = h%/2: 2D_LINE x%+ry%,y%,x%+w%-ry%,y%: 2D_ARC x%+w%-ry%,y%+ry%,ry%,90,270
2D_LINE x%+w%-ry%,y%+h%,x%+ry%,y%+h%: 2D_ARC x%+ry%,y%+ry%,ry%,270,90
2D_FLOOD x%+ry%,y%+ry%,r%,g%,b%
CASE 4: ry% = h%/4: 2D_LINE x%,y%,x%+w%,y%: 2D_POLY_TO x%+w%,y%+ry%
xc% = x%+w%: yc% = y%+h%/2: 2D_ARC xc%,yc%,ry%,90,270
2D_LINE xc%,yc%+ry%,xc%,y%+h%: 2D_POLY_TO x%,y%+h%: 2D_POLY_TO x%,yc%+ry%
2D_ARC x%,yc%,ry%,270,90: 2D_LINE x%,yc%-ry%,x%,y%
2D_FLOOD x%,yc%,r%,g%,b%
END_SELECT
ry% = 3*h%/4: ' hauteur maxi du texte
sz% = 6: FONT_SIZE p%,sz%: ht% = TEXT_HEIGHT(txt$,p%)
WHILE ht%<ry%: sz% = sz%+1: FONT_SIZE p%,sz%: ht% = TEXT_HEIGHT(txt$,p%): END_WHILE
wt% = TEXT_WIDTH(txt$,p%)
WHILE wt% > (w%-20): sz% = sz%-1: FONT_SIZE p%,sz%: wt% = TEXT_WIDTH(txt$,p%): END_WHILE
ht% = TEXT_HEIGHT(txt$,p%)
2D_FILL_OFF
PRINT_LOCATE x%+(w%-wt%)/2,y%+(h%-ht%)/2: PRINT txt$
END_SUB La taille des caractères s'adapte automatiquement aux dimensions de l'étiquette. J'ai fait au plus simple, une seule ligne de texte.  Il est facile d'imaginer tout un tas d'autres formes.
Dernière édition par JL35 le Dim 4 Nov 2018 - 19:48, édité 1 fois | |
| | | | jjn4
Nombre de messages : 2747
Date d'inscription : 13/09/2009
| | Sujet: +++ Dim 4 Nov 2018 - 16:30 | |
| Voilà qui peut toujours servir ! Intarissable, ce JL35 ! Tous les jours, il invente quelque chose !    | |
| | | | JL35
Nombre de messages : 7112
Localisation : 77
Date d'inscription : 29/11/2007
| | Sujet: Re: Étiquettes Dim 4 Nov 2018 - 19:25 | |
| Tiens mon ami, puisque ça t'intéresse, une version qui supporte plusieurs lignes, éventuellement centrées dans l'étiquette: - Code:
-
DIM x%,y%,w%,h%,typ%,txt$,fnt$,ct%,cf%,a$
PICTURE 1: WIDTH 1,600: HEIGHT 1,450
fnt$ = "Arial"
txt$ = "Étiquette pour voir"+CHR$(13)+CHR$(10)+"ce qui"+CHR$(13)+CHR$(10)+"se passe."
typ% = 1
ct% = 255*65536+215*256: cf% = 0: ' texte 'or' sur fond noir
Etiquettes(1,50,40,300,80,typ%,Txt$,fnt$,"B",ct%,cf%,1)
typ% = 2
Etiquettes(1,50,140,300,80,typ%,Txt$,fnt$,"I",ct%,cf%,0)
typ% = 3
Etiquettes(1,50,240,300,80,typ%,Txt$,fnt$,"I",ct%,cf%,1)
typ% = 4
Etiquettes(1,50,340,300,80,typ%,Txt$,fnt$,"U",ct%,cf%,0)
END
SUB Etiquettes(p%,x%,y%,w%,h%,typ%,txt$,fnt$,enr$,ct%,cf%,ce%)
' Dessin sur le picture p% en x%,y% d'une étiquette de dimensions w% x h%
' de type typ%, texte Txt$, police fnt$, couleur de texte ct%, couleur de
' fond cf% (format rgb = R*65536+G*256+B).
' Types d'étiquettes:
' 1 rectangulaire, 2 rectangulaire bords arrondis, 3 rectangulaire 1/2 cercles
' 4 rectangulaire oreillettes
' Si plusieurs lignes de texte: séparées par des retour chariot/interlignes
' Si ce% = 1: texte auto centré dans l'étiquette
'
DIM_LOCAL r%,g%,b%,xc%,yc%,ry%,sz%,ht%,wt%,nl%,hl%,max%,i%
2D_TARGET_IS p%: PRINT_TARGET_IS p%
r% = INT(ct%/65536): g% = BIN_AND(ct%,65280)/256: b% = BIN_AND(ct%,255)
FONT_COLOR p%,r%,g%,b%: ' couleur fonte
FONT_BOLD_OFF p%: FONT_ITALIC_OFF p%: FONT_UNDERLINE_OFF p%
IF INSTR(enr$,"B") > 0 THEN FONT_BOLD p%
IF INSTR(enr$,"I") > 0 THEN FONT_ITALIC p%
IF INSTR(enr$,"U") > 0 THEN FONT_UNDERLINE p%
r% = INT(cf%/65536): g% = BIN_AND(cf%,65280)/256: b% = BIN_AND(cf%,255)
2D_PEN_COLOR 0,0,0: 2D_PEN_WIDTH 2
DEGREES
SELECT typ%
CASE 1: 2D_FILL_COLOR r%,g%,b%: 2D_RECTANGLE x%,y%,x%+w%,y%+h%
CASE 2: ry% = h%/4: 2D_LINE x%+ry%,y%,x%+w%-ry%,y%: xc%=x%+w%-ry%
yc% = y%+ry%: 2D_ARC xc%,yc%,ry%,90,0: 2D_LINE x%+w%,yc%,x%+w%,y%+h%-ry%
yc% = y%+h%-ry%: 2D_ARC xc%,yc%,ry%,0,270: 2D_LINE x%+w%-ry%,y%+h%,x%+ry%-2,y%+h%
xc% = x%+ry%: 2D_ARC xc%,yc%,ry%,270,180: 2D_LINE x%,yc%,x%,y%+ry%-2
yc% = y%+ry%: 2D_ARC xc%,yc%,ry%,180,90
2D_FLOOD xc%,yc%,r%,g%,b%
CASE 3: ry% = h%/2: 2D_LINE x%+ry%,y%,x%+w%-ry%,y%: 2D_ARC x%+w%-ry%,y%+ry%,ry%,90,270
2D_LINE x%+w%-ry%,y%+h%,x%+ry%,y%+h%: 2D_ARC x%+ry%,y%+ry%,ry%,270,90
2D_FLOOD x%+ry%,y%+ry%,r%,g%,b%
CASE 4: ry% = h%/4: 2D_LINE x%,y%,x%+w%,y%: 2D_POLY_TO x%+w%,y%+ry%
xc% = x%+w%: yc% = y%+h%/2: 2D_ARC xc%,yc%,ry%,90,270
2D_LINE xc%,yc%+ry%,xc%,y%+h%: 2D_POLY_TO x%,y%+h%: 2D_POLY_TO x%,yc%+ry%
2D_ARC x%,yc%,ry%,270,90: 2D_LINE x%,yc%-ry%,x%,y%
2D_FLOOD x%,yc%,r%,g%,b%
END_SELECT
MEMO 900: HIDE 900: ITEM_ADD 900,txt$: nl% = COUNT(900): ' nb de lignes
IF nl% > 1
wt% = 0: max% = 0
FOR i% = 1 TO nl%
IF TEXT_WIDTH(ITEM_READ$(900,i%),p%) > wt% THEN wt% = TEXT_WIDTH(ITEM_READ$(900,i%),p%): max%=i%
NEXT i%
ELSE
wt% = TEXT_WIDTH(txt$,p%): max% = 1
END_IF
a$ = ITEM_READ$(900,max%)
ry% = 3*h%/4: ' hauteur maxi du texte T
sz% = 6: FONT_SIZE p%,sz%: hl% = TEXT_HEIGHT(txt$,p%)
WHILE ht%<ry%: sz% = sz%+1: FONT_SIZE p%,sz%: hl% = TEXT_HEIGHT(a$,p%): ht% = nl%*hl%: END_WHILE
wt% = TEXT_WIDTH(a$,p%)
WHILE wt% > (w%-20): sz% = sz%-1: FONT_SIZE p%,sz%: wt% = TEXT_WIDTH(a$,p%): END_WHILE
2D_FILL_OFF
xc% = x%+10: y% = y%+(h%-ht%)/2
FOR i% = 1 TO nl%
a$ = ITEM_READ$(900,i%)
IF ce% = 1 THEN xc% = x%+(w%-TEXT_WIDTH(a$,p%))/2
PRINT_LOCATE xc%,y%: PRINT a$: y% = y%+hl%: NEXT i%
DELETE 900
END_SUB  NB bizarre, je remarque que le forum colore en bleu un mot-clé des codes ci-dessus (FULL_SPACE), et si on clique dessus ça renvoie sur une pub ! c'est nouveau ça ?PS J'ai remplacé le Full_Space par des dimensions, et le coloriage a disparu...
Dernière édition par JL35 le Dim 4 Nov 2018 - 19:58, édité 1 fois | |
| | | | papydall
Nombre de messages : 7017
Age : 74
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012
| | | | | JL35
Nombre de messages : 7112
Localisation : 77
Date d'inscription : 29/11/2007
| | Sujet: Re: Étiquettes Dim 4 Nov 2018 - 20:01 | |
| C'était peut-être uniquement chez moi, en tout cas je l'ai fait disparaître ! curieux... ça renvoyait sur un site de pub de pneus et d'huile moteur... et je n'ai pas d'actions dans ce domaine  | |
| | | | Minibug
Nombre de messages : 4570
Age : 58
Localisation : Vienne (86)
Date d'inscription : 09/02/2012
| | Sujet: Re: Étiquettes Dim 4 Nov 2018 - 20:18 | |
| Notre JL35 n'est jamais à cours d'idée ! Bravo Belle réalisation en si peu de lignes. maintenant il ne me reste plus qu'a préparer la confiture et les pots...  Concernant les liens, il n'y a rien de tout ça chez moi non plus. Mais j'ai déjà rencontré ce genre de chose. Peu être que cela dépends aussi du navigateur utilisé...  | |
| | | | Marc
Nombre de messages : 2466
Age : 63
Localisation : TOURS (37)
Date d'inscription : 17/03/2014
| | Sujet: Re: Étiquettes Dim 4 Nov 2018 - 20:41 | |
| Bravo JL35 ! Encore un projet original !  Pour les liens publicitaires sur le forum, j'ai remarqué qu'ils apparaissent, chez moi, uniquement si je ne suis pas connecté. Dès l'identification de l'utilisateur, les liens disparaissent. | |
| | | | JL35
Nombre de messages : 7112
Localisation : 77
Date d'inscription : 29/11/2007
| | Sujet: Re: Étiquettes Dim 4 Nov 2018 - 21:18 | |
| Oui Marc, c'était pareil chez moi... curieux, et je n'avais encore jamais remarqué ça ici. Et je me demande si c'était uniquement chez moi que le lien apparaissait. Bon, pour le moment c'est supprimé.
@Minibug
Je veux bien préparer les étiquettes (j'ai déjà fait...), quant à la confiture je laisse ça à d'autre, d'ailleurs c'est plus prudent ! | |
| | | | Jicehel
Nombre de messages : 5947
Age : 52
Localisation : 77500
Date d'inscription : 18/04/2011
| | Sujet: Re: Étiquettes Lun 5 Nov 2018 - 8:25 | |
| Toujours plein de bonnes idées JL35 | |
| | | | Contenu sponsorisé
| | Sujet: Re: Étiquettes | |
| |
| | | | | | Étiquettes | |
|
Sujets similaires | |
|
| | Permission de ce forum: | Vous ne pouvez pas répondre aux sujets dans ce forum
| |
| |
| |
Pas chez moi !