Sub de dessin et sub d'insertion texte

Nombre de messages : 7112 Localisation : 77 Date d'inscription : 29/11/2007

Encore un petit programme de dessin, mais cette fois-ci sous la forme d'une petite (?) sub complètement indépendante, qui permet de dessiner sur un picture dont on donne le numéro en paramètre.
A l'appel de la sub, il s'affiche une petite boîte à outils:

Sub de dessin et sub d'insertion texte Boite10

qui permet de définir la couleur et l'épaisseur du tracé, et son type, ligne, rectangle, cercle (vides).
Il y a une option de remplissage avec la couleur courante, si cette option est sélectionnée, il suffit de cliquer un point de la zone à remplir.
On peut annuler la dernière action (le dernier objet dessiné): bouton 'Annuler'.
Et pour sortir, bouton 'Quitter' (étonnant, non ?), c'est tout simple.
Avec en tête 3 lignes d'exemple d'appel:

Code:: PICTURE 10: full_space 10
Dessin(10)
END
' ==============================================================================
SUB Dessin(p%)
' boîte à outils pour dessiner sur le picture p%
DIM_LOCAL f%,t%,i%,j%,k%,x%,y%,a$,tr%,tg%,tb%,n2t%,fig%,trac%,term%,ret%,an
DIM_LOCAL x1%,y1%,x2%,y2%,x3%,y3%,fpr$,btg%
fpr$ = "C:\TEMP\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% = 850: WHILE OBJECT_EXISTS(f%)=1: f%=f%+1: END_WHILE
FORM f%: TOP f%,0: LEFT f%,LEFT(0)+WIDTH(0): HEIGHT f%,208: WIDTH f%,132: 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%+28,y%+15: x%=x%+29
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%)-18
LEFT i%,0: HEIGHT i%,63: COLOR i%,255,255,180
i%=f%+7:OPTION i%: PARENT i%,f%+6: TOP i%,10: LEFT i%,4: CAPTION i%,"Trait"
i%=f%+8:OPTION i%: PARENT i%,f%+6: TOP i%,25: LEFT i%,4: CAPTION i%,"Libre"
i%=f%+9:OPTION i%: PARENT i%,f%+6: TOP i%,10: LEFT i%,54: CAPTION i%,"Rectan."
i%=f%+10:OPTION i%: PARENT i%,f%+6: TOP i%,25: LEFT i%,54: CAPTION i%,"Cercle"
i%=f%+11:OPTION i%: PARENT i%,f%+6: TOP i%,40: LEFT i%,4: CAPTION i%,"Remplir"
MARK_ON f%+7
FOR J%=f%+7 TO f%+11: ON_CLICK j%,Desopt: NEXT j%
i%=f%+12: 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%+13:BUTTON i%: PARENT i%,f%: WIDTH i%,55:TOP i%,TOP(i%-1): LEFT i%,60
HEIGHT i%,20: CAPTION i%,"Quitter": ON_CLICK i%,Desfin
2D_TARGET_IS p%: 2D_PEN_DOT
t%=f%+14: TIMER t%: PARENT t%,f%: TIMER_INTERVAL t%,40: ON_TIMER t%,Destim
trac% = 0: term% = 0: btg% = 0
fig% = 1
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
fig% = 3: ' rectangle
ELSE
IF CHECKED(f%+10) = 1
fig% = 4: ' cercle
ELSE
IF CHECKED(f%+11) = 1
fig% = 5: ' remplissage
END_IF
END_IF
END_IF
END_IF
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Destim:
IF CHECKED(f%+11)=1 THEN RETURN: ' remplissage
x% = MOUSE_X_POSITION(p%): y% = MOUSE_Y_POSITION(p%): ' 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
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
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
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Destra:
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_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 THEN x1% = -1
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Desron:
CLIPBOARD_PASTE p%: IF term% = 1 THEN FILE_SAVE p%,fpr$: ' sauvegarde préalable
k% = SQR((y2%-y1%)*(y2%-y1%) + (x2%-x1%)*(x2%-x1%)): ' rayon du cercle
2D_POLY_FROM x1%+k%,y1%
FOR an = 0 TO 8*ATN(1)+.1 STEP .1
2D_POLY_TO x1%+k%*COS(an), y1%+k%*SIN(an)
NEXT an
IF term% = 1 THEN x1% = -1
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Desrem:
IF CHECKED(f%+11)=0 THEN RETURN
FILE_SAVE p%,fpr$: ' sauvegarde préalable
x% = MOUSE_X_LEFT_DOWN(p%): y% = MOUSE_Y_LEFT_DOWN(p%)
2D_FLOOD x%,y%,tr%,tg%,tb%
x1% = -1
CLIPBOARD_COPY p%
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%: OFF_CLICK p%: 2D_TARGET_IS n2t%
DELETE f%: CAPTION 0,""
EXIT_SUB
RETURN
END_SUB
' ==============================================================================

La sub contient un certain nombre de sous-programmes internes, et un timer, donc risque de conflit à prendre en compte si le programme appelant en contient un aussi (il faudra le désactiver avant l'appel).
Sinon, bonjour les 'Runtime error' et autres joyeusetés.

Dans la sub j'ai positionné d'office la boîte à droite du Form 0, mais on peut facilement ajouter les deux paramètres de positionnement x et y dans l'appel à la sub.

Également, la sub réserve les numéros d'objets 850 à 850+14, c'est arbitraire et doit être modifié (variable f% = 850) s'il y a risque de conflit avec le programme appelant.

Ceci pour réveiller un peu le forum qui somnole en ce moment... mais je ne suis pas sûr que ça suffira ! Very Happy

Edit: j'ai changé le titre, voir plus loin pour la sub Texte et un exemple succinct d'utilisation.
Correction d'un petit bug de déclaration du Timer (mis comme Parent de f%)

@JL35,

Si tu me fais un petit package, j' ajoute cette Sub sur le site.
Laughing

(Pas avant lundi, tu as le temps)

Nombre de messages : 7112 Localisation : 77 Date d'inscription : 29/11/2007

salut ygeronimi, pas ce soir (fête des voisins, de la musique... ça ne m'enchante qu'à moitié... ça va parler football, bof!)
et il faudra que tu me précises ce que tu entends par petit package.
Et je suis en train de préparer la même chose pour les textes, ça fera un ensemble complet à mettre dans le 'package'

Ce que j' entends par package, c' est un petit *.ZIP avec le *.bas et un petit *.txt
Qui décrit la sub.

Excusez moi de faire court mais je poste depuis une tablette 7'' et c' est pas très pratique... Laughing

Bon, un petit peu de chauvinisme, Allez les Bleus !!!
lol!

JL35 a écrit:: Ceci pour réveiller un peu le forum qui somnole en ce moment... mais je ne suis pas sûr que ça suffira !

Ils bossent trop Sub de dessin et sub d'insertion texte Bonhomme-orange-marche

: c’est le jour le plus long de l’année, alors que les moins jeunes, eux, ils font la sieste !

Sub de dessin et sub d'insertion texte Ete2043

De toutes les façons, merci d’avoir partagé ta petite SUB qui n’est d’ailleurs pas si petite que ça !

Nombre de messages : 7112 Localisation : 77 Date d'inscription : 29/11/2007

Et voici la deuxième sub, très semblable, mais destinée à l'insertion de texte dans un picture donné

Sub de dessin et sub d'insertion texte Txt10

~~désolé, y'a du monde... à plus...~~
Comme pour le dessin, seul paramètre d'activation, le numéro d'objet du picture cible.
Il faut entrer le texte dans le memo (plusieurs lignes possibles), fixer les paramètres (police, taille, couleur, enrichissements), puis cliquer sur la cible à l'emplacement (haut/gauche) de l'insertion désirée.
L'insertion se fait à fond 'transparent', donc éventuellement sur une image préexistante. Entièrement en Panoramic, sans ressources externes.
Et possibilité d'annuler la dernière insertion, pour recommencer ou abandonner.

Code:: LABEL Tex, Des
DIM w,h,dt%
w = 640: h = w*3/4
WIDTH 0,w+16: HEIGHT 0,h+70
MAIN_MENU 1
SUB_MENU 2: PARENT 2,1: CAPTION 2,"Fichier"
SUB_MENU 3: PARENT 3,1: CAPTION 3,"Dessin": ON_CLICK 3,Des
SUB_MENU 4: PARENT 4,1: CAPTION 4,"Textes": ON_CLICK 4,Tex
PICTURE 10: WIDTH 10,w: TOP 10,0: HEIGHT 10,h
file_load 10,"c:\graph\jpg\goldgate.jpg": ' une image quelconque, pour voir
dt% = 0
END
' ==============================================================================
Des:
IF dt% > 0 THEN MESSAGE "Supprimer d'abord le processus en cours !": RETURN
dt% = 1: Dessin(10): dt% = 0
RETURN
' ==============================
Tex:
IF dt% > 0 THEN MESSAGE "Supprimer d'abord le processus en cours !": RETURN
dt% = 2: Texte(10): dt% = 0
RETURN
' ==============================================================================
' == S U B s ==
' ==============================================================================
SUB Texte(p%)
' boîte à outils pour apposer du texte sur le picture p%
DIM_LOCAL f%,i%,j%,k%,x%,y%,tr%,tg%,tb%,a$,ret%,lp%,n2t%,n2p%,p1%,wt%,ht%,fpr$
fpr$ = "C:\TEMP\Savpre.bmp"
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("Texins")=0 THEN LABEL Texins
IF LABEL("Texanu")=0 THEN LABEL Texanu
f% = 750: WHILE OBJECT_EXISTS(f%)=1: f%=f%+1: END_WHILE
FORM f%: TOP f%,0: LEFT f%,LEFT(0)+WIDTH(0): HEIGHT f%,195: 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)+5: WIDTH i%,50
   MIN i%,6: MAX i%,255: POSITION i%,12: ' Taille caractères
i%=f%+3: PICTURE i%: PARENT i%,f%: TOP i%,1: LEFT i%,LEFT(f%+2)+55: WIDTH i%,30
   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)+40: CAPTION i%,"G"
i%=f%+5: CHECK i%: PARENT i%,f%: TOP i%,3: WIDTH i%,25: LEFT i%,LEFT(f%+4)+35: CAPTION i%,"I"
i%=f%+6: CHECK i%: PARENT i%,f%: TOP i%,3: WIDTH i%,25: LEFT i%,LEFT(f%+5)+35: CAPTION i%,"S"
i%=f%+7: 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%+8: 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
   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%=f%+9: MEMO i%: PARENT i%,f%: TOP i%,TOP(f%+8)+20: WIDTH i%,WIDTH(f%)-16
lp%=f%+10: LIST lp%: PARENT lp%,f%: TOP lp%,TOP(f%+1)+20: WIDTH lp%,130: HEIGHT lp%,110
   HIDE lp%: FONT_NAMES_LOAD lp%: COLOR lp%,255,255,190: ON_CLICK lp%,Texpom
   FOR j%=COUNT(lp%) TO 1 STEP -1
   IF LEFT$(ITEM_READ$(lp%,j%),1)="@" THEN ITEM_DELETE lp%,j%
   NEXT j%
p1%=f%+11: PICTURE p1%: PARENT p1%,f%: LEFT p1%,-2000: PRINT_TARGET_IS p1%
i%=f%+12: BUTTON i%: PARENT i%,f%: TOP i%,TOP(f%+9)+HEIGHT(f%+9)+2: LEFT i%,90
   CAPTION i%,"Annuler": ON_CLICK i%,Texanu
i%=f%+13: BUTTON i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,LEFT(i%-1)+100
   CAPTION i%,"Quitter": ON_CLICK i%,Texfin
ON_CLICK p%,Texins: ' clic sur le point d'insertion du texte (picture principal)
ret% = 0: WHILE ret% = 0: WAIT 100: END_WHILE
2D_TARGET_IS n2t%: PRINT_TARGET_IS n2p%
DELETE f%
EXIT_SUB
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texpol:
SHOW lp%
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texpom:
TEXT f%+1,ITEM_INDEX$(f%+10)
HIDE lp%
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texcou:
x%=MOUSE_X_LEFT_DOWN(f%+8): y%=MOUSE_Y_LEFT_DOWN(f%+8)
tr%=COLOR_PIXEL_RED(f%+8,x%,y%): tg%=COLOR_PIXEL_GREEN(f%+8,x%,y%)
tb%=COLOR_PIXEL_BLUE(f%+8,x%,y%): COLOR f%+3,tr%,tg%,tb%
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texins:
IF COUNT(f%+9) = 0 THEN RETURN: ' pas de texte
FILE_SAVE p%,fpr$: ' sauvegarde préalable
' insertion du texte (fond transparent) au clic souris
x% = MOUSE_X_POSITION(p%): y% = MOUSE_Y_POSITION(p%)
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%: 2D_PEN_COLOR tr%,tg%,tb%
2D_TARGET_IS p1%: COLOR p1%,1,1,1: 2D_FILL_COLOR 1,1,1: ' couleur 'transparente': 1,1,1
FOR k% = 1 TO COUNT(f%+9)
   a$ = ITEM_READ$(f%+9,k%)
   IF a$ <> ""
   wt%=TEXT_WIDTH(a$,p1%): ht%=TEXT_HEIGHT(a$,p1%)
   WIDTH p1%,wt%: HEIGHT p1%,ht%
   PRINT_LOCATE 0,0: PRINT a$
   2D_TARGET_IS p%: 2D_PEN_COLOR tr%,tg%,tb%
   FOR j% = 0 TO ht%-1
   FOR i% = 0 TO wt%-1
   IF COLOR_PIXEL_RED(p1%,i%,j%) <> 1 THEN 2D_POINT x%+i%,y%+j%
   NEXT i%
   DISPLAY
   NEXT j%
   END_IF
   y% = y% + ht%
NEXT k%
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texanu:
IF FILE_EXISTS(fpr$) = 1 THEN FILE_LOAD p%,fpr$: CLIPBOARD_COPY p%
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texfin:
ret% = 1
RETURN
END_SUB

J'ai mis un exemple d'appel en tête (qui comprend également l'appel à la sub Dessin que je n'ai pas répétée ici, voir plus haut).
Il ne faut pas qu'elles soient présentes en même temps, ça pose des problèmes de confllit, alors il vaut mieux mettre un test dans le programme principal (comme j'ai fait) pour éviter ça.

@ygeronimi,
J'ai regroupé les deux subs dans Sub_Des.bas, avec un petit texte Destext.txt dans Sub_Des.zip que j'ai chargé dans ton webdav, rubrique PROCEDURES. Dis-moi à l'occasion si ça te convient.

@papydall, si tu m'écoutes,
Je sais que tu es pourcentophobe, mais j'ai pris cette habitude de nommer toutes mes variables numériques en 'entières' avec le pourcent. Du temps du bon vieux basic, ça améliorait considérablement la vitesse d'exécution.
Mais je me demande si en Panoramic ça sert bien à grand chose, il me semble bien qu'il n'y a pas de différence perceptible qu'on le fasse ou non...

Nombre de messages : 7112 Localisation : 77 Date d'inscription : 29/11/2007

Petit bug dans la sub Dessin: le Timer créé n'était pas déclaré comme 'Enfant' de la Form f%, et malgré qu'il soit supprimé en sortie il devait rester des séquelles qui empêchaient de fermer le Form 0 par la croix de fermeture.
Je répare ça plus haut...

@ygeronimi,
j'ai également mis à jour le zip, dans Procedures du Mag sur ton webdav, je ne suis pas sûr que c'était bien là qu'il fallait le mettre... pas l'habitude, excuse-moi sinon.

JL35 a écrit:: @papydall, si tu m'écoutes,
Je sais que tu es pourcentophobe, mais j'ai pris cette habitude de nommer toutes mes variables numériques en 'entières' avec le pourcent. Du temps du bon vieux basic, ça améliorait considérablement la vitesse d'exécution.
Mais je me demande si en Panoramic ça sert bien à grand chose, il me semble bien qu'il n'y a pas de différence perceptible qu'on le fasse ou non...

Pourcentophobe, oui et surtout Gotophobe et même Gosubophobe !
Pour les % question vitesse, je pense que c’est « Des économies de bouts de chandelle »
Voici deux codes : l’un avec des % et l’autre sans.
Chez moi les temps mis pour l’exécution de deux codes sont respectivement de 421 ms et de 436 ms soit un gain de 15 ms pour une boucle de 10000 calculs.
Un gain dérisoire de 15 ms contre un gain de saisie de 13 %.

Pour les GOTO : leurs utilisations c’est la négation pure et simple de la programmation structurée, tandis que le GOSUB est une instruction obsolète en présence des SUB.
Pourquoi appeler un sous-programme par GOSUB au lieu de l'appeler par son nom de SUB?
C’est mon opinion : Bye bye GOSUB, salut SUB, adieu GOTO (sans regret aucun) !

code1:

code2:

PS:

Je taquine Laughing

JL35 a écrit:: ... malgré qu'il soit supprimé ...

C'est du français ça ? Je ne pense pas affraid

Nombre de messages : 7112 Localisation : 77 Date d'inscription : 29/11/2007

Mon cher papydall, pour les % tu as raison, ça ne change pas grand chose.
Pour les Goto, je te l'accorde, ça ne fait pas très propre, et il y a toujours moyen de faire autrement.
Par contre je ne suis pas d'accord avec le gosubophobe que tu es, je considère que les sous-programmes appelés par Gosub n'ont pas le même usage que les subs, celles-ci étant des entités indépendantes avec leurs propres variables locales, les sous-programmes étant des blocs du programme principal, séparés pour éviter de répéter du code inutilement. Je ne trouve pas que les deux soient interchangeables.
Bon, c'est mon opinion. Et je la partage comme dit l'autre.
Et ~~malgré que~~ bien que la tienne soit différente, que ça ne nous empêche pas de dormir !

Tu as raison, j’ai raison, tout le monde a raison.
Le codage est un art qui se déroule, certes, selon des règles générales mais avec des touches personnelles.
Un code peut être considéré comme correct dès qu’il résout le problème auquel il est censé trouver une solution.
Correct ne veut pas dire parfait, mais correct peut être considéré comme bon !
Bon , ce n’est pas le moment de philosopher.
Je retourne à mon programme. En fait j’essaye de coder un ( grand) petit casse-tête !

Invité

En prenant le parti de répondre, je vois que tu as été plus rapide JL35.

Là et avec mes excuses, Papydall, je sais que je ne serais jamais à ta hauteur, vu que le seul diplôme que j'ai n'a pas de valeur à notre époque.

Pour les goto: franchement je suis d'accord, mais parfois ils sont bien pratiques. Exemple: on a une boucle for - next. Parfois on trouve la nécessité pendant le codage, ou les corrections de vouloir aller directement à next car dans un cas particulier, on doit évité la suite du code jusqu'au next. Et bien plutôt que de faire tout un cinéma pour évité le goto, c'est quand même plus simple, et moi qui ça ne me dérange pas, car je ne vais surtout pas faire un complexe pour si-peu. On est en basic, goto est une instruction qui fonctionne sans problème si on a prévu la sortie, alors je ne ferais pas le beau! Les remontrances ne me touchent pas lorsqu'elles n'ont pas d'importance. Il faut savoir avec quel langage on code, et moi je code au mieux comme ça m'arrenge.

Pour les gosub, je rejoins JL35. Les gosub sont aussi utiles. Pour plusieurs raisons. En plus de celles décrites par JL35, il y aussi le fait qu'un gosub fait à partir d'une sub, garde les variables locales intactes. Les variables sont encore utilisable avec un gosub à partir d'un appel d'une sub, ce qui n'est pas le cas, si d'une sub, on en appelle une autre.

Je n'essaye jamais d'être restrictif sans raison. Donc moi gosub, sans problème, goto avec restriction.

Bon au moment d'envoyer c'est Papydall qui me dépasse. Je change rien, vous aurez mon point de vue.

Bonne nuit Sleep

cosmos70 a écrit:: il y aussi le fait qu'un gosub fait à partir d'une sub, garde les variables locales intactes. Les variables sont encore utilisable avec un gosub à partir d'un appel d'une sub, ce qui n'est pas le cas, si d'une sub, on en appelle une autre.

Franchement je ne comprends pas : je suis désolé.
Tu dis que les variables locales restent intactes après un appel par gosub ?

Voici un code à tester

Code:: dim a
label go
a = 5
test()
print a ; " <==== variable globale inchangée par GOSUB mais changée par SUB"
end
sub test()
   dim_local a
   a = 10
   gosub go : ' cet appel fait perdre la valeur de la variable locale a
' go() :' cet appel préserve la valeur de la variable locale a
   print a ; " <==== Variable locale inchangée par l'appel d'une SUB"
   print " mais changée par l'appel par GOSUB"
end_sub
go:
a = 18 : ' C'est la variable locale de la SUB test() qui est changée
   ' La variable globale de même nom reste intacte
return
sub go()
   a = 20 : ' ici c'est la variable globale qui est changée tandis
   ' que la variable locale de la SUB test() reste inchangée
end_sub

L’appel à partir d’une SUB par GOSUB fait perdre la valeur de la variable locale.
L’appel à partir d’une SUB par le nom d’une autre SUB préserve la valeur de la variable locale.
Chaque méthode a ses subtilités.
L'essentiel est de savoir ce qu'on espère avoir.

Quelqu'un a dit (peut-être Papydall) que la programmation est l'art de trouver des solutions aux problèmes que l'on se posent : donc peu importe si on utilise une telle structure plutôt qu'une autre. Comme tous les chemins mènent à Panoramic, rien n'empêche d'utiliser n'importe quelle instruction Panoramicienne.
Chacun code comme il veut et surtout comme il peut.

Je vous laisse conclure.

Invité

J'ai pas regardé tes exemples, je suis encore endormi.

Code:: label teste

dim a%,b$ , t$ :t$=chr$(13)
a% =20
b$="variable dim"
teste_sub()
end

sub teste_sub()
   dim_local a%,b$
   a% = 5 : b$="dim_local"
   gosub teste
   message "retour à sub" + t$ + "a%="+str$(a%) + t$ + "b$="+b$
end_sub

teste:
   message "a%="+str$(a%) + t$ + "b$="+b$ + t$ + "Où-est-ce que ce sont des variables globales?"
   a%=50 : b$ = "modifie b$"
return

EDIT

J'ai dit que l'appel d'un gosub garde les variables locales intactes. Mais c'est une erreur d'interprétation. Je voulais dire qu'on récupérait les variables de la sub (et c'est en pensant à cela, que j'ai employé l'expression). Ce ne sont pas les variables globales mais locales quand elles existent, qui entrent en compte dans un appel à un sous-programme.
Donc gosub teste reçoit les valeurs de la sub, peut les modifier, et la sub a ses variables envoyées, travaillées par le sous-programme.

Tant mieux, les programmeurs n'ont qu'à utiliser des variables avec des noms différents, nah !!
Surtout quand on fait des triturage comme des appels de sous programmes depuis une sub.
C'est forcément incompréhensible sinon puisque le sous programme peut être lié à la sub ou au programme principal et que panoramic n'a aucun moyen de le savoir.
Donc dans ce cas, il faut forcément nommer correctement ses variables.

Variables locales:
Les variables locales d'une procédure (malheureusement nommée SUB alors que ça devrait être PROC) ont une durée de qui commence lors de l'appel à la procédure et qui se termine par END_SUB ou EXIT_SUB. Tu peux faire autant de GOSUB que tu veux, à l'intérieur - ni GOSUB ni GOTO influencent les variables locales.

GOTO
Pour ma part, je suis entièrement d'accord qu'il convient d'éviter les GOTO autant que possible, et même de remplacer les GOSUB par des appels à des procédures chaque fois qu'il est possible de le faire.

Mais il y a une exception notable, où l'on ne peut pas faire autrement: c'est le traitement des erreurs par ON_ERROR_GOTO. Ce GOTO là ne peut pas être remplacé, et cela peut bousiller complètement la structure de programmation la plus propre qui soit.

Je suggère donc l'ajout d'une commande ON_ERROR_PROCEDURE nom_de_procédure. Et si une erreur se produit, cette procédure sans paramètres sera appelée comme si l'on vait fait un appel de procédure normal.

papydall a écrit:: Pour les % question vitesse, je pense que c’est « Des économies de bouts de chandelle »

Qu'en est-il avec le compilateur ? Normalement, après traduction en FreeBASIC les variables entières devraient être plus rapides.

C'est un léger hors sujet, mais avec le comilateur, on devrait voir apparaitre les fonctions aussi, je pense. Non ?

@JL35
Je fais appel à ton indulgence pour ce « léger hors sujet »

jean_debord a écrit:: Qu'en est-il avec le compilateur ? Normalement, après traduction en FreeBASIC les variables entières devraient être plus rapides.

Je fais les tests avec le compilateur Panoramic en portant la boucle de calcul à 1000000 (un million pour voir une éventuelle différence) avec les deux codes que j’ai postés.
Résultat :
Avec les variables entières : temps mis pour le calcul : 31 ms
Avec les variables réelles : temps mis pour le calcul : 31 ms
AUCUNE DIFFERENCE DE VITESSE !!!

PS :
Pour une boucle de 10000000 (dix millions) les deux temps sont également identiques 421 ms

Je peux (?) conclure que (dans l'état actuel de PANORAMIC) l'utilisation des variables entières plutôt que des variables réelles n'apporte aucune différence appréciable de vitesse d'exécution.

Nombre de messages : 7112 Localisation : 77 Date d'inscription : 29/11/2007

Indulgence évidemment accordée papydall !
Mais là je constate qu'on est à des années-lumière de mes deux petites subs sans prétention Dessin et Texte...
Ceci est une tentative plus ou moins déguisée pour recentrer le sujet... Very Happy

après avoir néanmoins constaté avec plaisir que tous ces intervenants sont au moins venus lire le sujet !
Et ça fait plaisir de constater que malgré le calme apparent du forum il y a quand même des veilleurs qui surveillent.

Woui JL35, je n'ai pas fait de commentaires sur les 2 "procédurations" de ton programme car j'ai testé ton programme autonome et il était très bien. Je n'ai pas testé les versions procédurées et indépendantes car je n'en avait pas besoin et je me doute que tu as fait les tests avant publication (et aussi par ce que je manque de temps). J'ai jeté un œil et comme je n'avait rien à en dire, je n'avais rien dit pour laisser la parole aux gens qui ont testé.
En tout cas comme pour tous les gens qui publient des sources que certains utiliseront dans leur intégralité ou partiellement, merci pour ce partage et pour ton maintient de l'activité du forum.
D'autant plus que c'est particulièrement vrai en ce moment, nous sommes peu à intervenir pour le moment (lecteurs fantomatiques qui lisaient ces lignes sans intervenir, on compte sur vous. Ne pensez pas que vos programmes n’intéressent personne. Ne pensez pas que ce que vous faites est moins bien. Et quand bien même ça le serait, si vous supporter un peu la critique, partagez, vous aurez peut être des retours qui vous feront progresser ou au contraire juste un compliment ou un merci.)

@Papydall et Jicehel:
Qu'est-ce que vous pensez de ma réflexion sur les variables locales d"une SUB, et du problème des ON_ERROR_GOTO dans un programme structuré sans GOTO ?

Le petit exemple suivant:

Code:: label choc

test1()
test2()

end

sub test1()
dim_local n%
n% = 17
message "test1: n%="+str$(n%)
goto choc
end_sub

sub test2()
dim_local n%
n% = 23
choc:
message "test2: n%="+str$(n%)
end_sub

montre que le "goto choc" exécuté dans la procédure test1() utilise la variable censée être locale à test2() comme étant la variable locale définie dans test1().

En réalité, Panoramic ne définit pas vraiment des variables locales ! Je sais que je vais en choquer plus d'un, mais c'est de la publicité mensongère (pardon, Jack, je n'ai pas pu résister !). Lors de l'exécution de la commante DIM_LOCAL, panoramic crée dynamiquement des variables absolument identiques aux autres variables globales, mais leur nom dest préfixé de façon interne par une chaîne de caractères, invisible au programmeur, qui donne le nom de la procédure à laquelle appartient la variable. C'est astucieux, mais cela a un effet secondaire: dès l'instant qu"on sort du contexte de la procédure, des confusions (dans l'esprit du programmeur) deviennent possibles. En effet, dans l'exemple ci-dessus, comment ne pas supposer que la variable n% utilisée dans la commente MESSAGE de la procédure test2() est la variable locale définie dans la procédure test2() ? Oui, mais non. On oublie le contexte procédural. L'appel à la procédure test1() établit un contexte pour test1. Et ce contexte reste valide jusqu'à ce qu'on effectue un EXIT_SUB ou un END_SUB. Le GOTO ne change pas fe contexte - il pourrait aussi bien cibler un label dans une routine évènement ou dans le programme principal, avant le END. Et ceci explique pourquoi le deuxième message affiché, celui avec le libellé "test2", donne la valeur 17 en principe réservée à la procédure test1: c'est précisément parce qu'on est encore dans le contexte test1 !

Nombre de messages : 7112 Localisation : 77 Date d'inscription : 29/11/2007

Bon, j'abandonne le sujet initial, n'ayant eu aucun retour sur les subs proposées je suppose que ce n'était pas d'un intérêt puissant par rapport aux discussions en cours sur ce post. J'espère que vous avez compris que je dis ça sans aucune acrimonie, c'est le jeu !
Je communiquerai les quelques améliorations à ygeronimi qui en fera l'usage qu'il jugera bon, il sait qu'il a carte blanche pour ça.

Détrompes toi JL35, le fil de discussion à provoqué plusieurs fameuses dérives mais tes proc sont intéressantes. C'est juste qu'il faut avoir les idées et le temps pour les utiliser (hors contexte de ce que nous faisons actuellement) et comme tu as fait un programme juste avant sur le même sujet et que de premier abord, les procédures semblent bien faites on a eu peu de choses à dire sur ce sujet.

@Klaus, en effet, c'est très ambigu. Toutefois pour moi, même si je pense qu'il faudrait que les variables locales soient réellement locale, je suis contre l'usage du goto (sauf cas exceptionnel) et contre l'emploi du même nom de variable dans un même programme.
J'espère qu'avec l'arrivée du compilateur et un peu de temps, Jack pourra améliorer ces points.
J'ai même eu des doutes à un moment donné dans le fait que les valeurs des variables ne soient pas changées en appelant une sub depuis une autre sub qui utilisait les mêmes variables locales temporaires (mais je n'ai pas poussé les tests comme Klaus, j'ai juste changé le nom des variables).

Bon, je m’arrête là pour ne pas relancer un débat sur ce post qui n'y est pas destiné afin que les personnes qui veulent intervenir sur les procédures de JL35 puissent le faire. En tout cas JL35, tu as atteind un des 2 objectifs que tu t'étais fixé: animer un peu le forum Wink

Nombre de messages : 7112 Localisation : 77 Date d'inscription : 29/11/2007

C'est déjà ça qui n'est pas négligeable, en effet !

@ JL35,

Tes procédures sont très intéressantes et c' est pourquoi je t' ai proposé de les ajouter sur le site du mag.

Pour la dérive...je crois que c' est une cause désespérée sur ce forum... Laughing

» Dessin d'arc
» Dessin
» Dessin 2d
» Dessin(x)
» Dessin sur A4