Dessin(x)

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

Rassurez-vous (ou regrettez, c'est selon), le 'x' ce n'est pas pour faire des dessins érotiques (ou alors plutôt à la manière cubiste), non c'est un énième programme de dessin, plutôt une base qui ne demande qu'à être étoffée selon les besoins de chacun, c'est très évolutif.

Le dessin se fait à la souris dans un picture, selon le principe universel: on clique, on trace, et on relâche, le dessin évolue en pointillés jusqu'à sa forme définitive.

Une fois le dessin terminé, il est possible:
- de l'annuler purement et simplement (retour à l'état antérieur).
- de le déplacer dans les quatre directions d'un nombre choisi de pixels, pour le positionner avec précision.
(boutons flèches)
- de l'agrandir ou de le diminuer d'un nombre choisi de pixels (boutons flèche vers le bas à gauche pour diminuer, vers le haut à droite pour agrandir).
Ces fonctions sont possibles tant qu'on n'a pas commencé une autre figure.

Quatre fonctions de base sont prévues au départ (mais on peut évidemment en rajouter):
- le tracé libre (pour celle-ci, pas de déplacement ultérieur possible, seulement l'annulation totale).
- le rectangle vide
- l'ellipse/cercle vide
- le remplissage d'une zone avec une couleur choisie, en cliquant dans la zone voulue).
On peut choisir la couleur (parmi 6 élémentaires) et l'épaisseur du tracé (de 1 à 20 pixels)
La fonction 'gomme' peut s'exécuter avec le tracé libre à la couleur de fond, avec une épaisseur choisie.

Pour éviter l'utilisation d'un timer (pour le tracé en temps réel), qui est toujours délicate et pose souvent des problèmes, on utilise une dll externe: Mouse.dll, de l'excellent ami Nardo (Nardo, où es-tu ?), cette petite (40k) dll fournit en permanence la position de la souris (sur la totalité de l'écran), ainsi que l'état de ses boutons, ce qui est fort pratique pour dessiner en temps réel.
On surveille donc en permanence la souris, ce qui monopolise le temps uc comme me l'a fait remarquer Klaus, mais après tout en principe quand on dessine on ne fait pas autre chose...
(la dll est disponible ici, chez Nardo: http://nardo26.lescigales.org/divers-dll-28.html ).

Le programme n'est pas très long (~200 lignes), il va certainement continuer à évoluer, mais chacun peut l'adapter à ses goûts et besoins.
On peut notamment dimensionner à sa guise les dimensions de la fenêtre de dessin (wp% et hp%, en tête), en ne descendant pas au-dessous d'un minimum pour la largeur (à cause des menus).
Il sera facile d'ajouter des fonction de lecture fichier, d'impression, etc.

Code:: ' Dessin
LABEL Quit,Type,Couleur,Dessiner,ign,Desrec,Desell,Deplacer,Annuler,Sauve
DIM wp%,hp%,i%,j%,p%,x%,y%,xd%,yd%,x1%,y1%,xa%,ya%,xf%,yf%,btn,coord$,ofx,ofy,typ
DIM r%,g%,b%,wt%,rx%,ry%,xc%,yc%,pi,t,f$,mm$
pi = 4*ATN(1)
mm$ = "C:\PANORAMIC\Mouse.dll": ' <<<<<<<<<<<<<<<<<< A AJUSTER <<<<<<<<<<

wp% = 900: hp% = 675: ' Dimensions du picture de dessin

WIDTH 0,wp%+16: HEIGHT 0,hp%+58: COLOR 0,180,255,255: ON_CLOSE 0,Quit: FONT_BOLD 0
BORDER_SMALL 0
p% = 1: PICTURE p%: TOP p%,24: WIDTH p%,wp%: HEIGHT p%,hp%
ofx = LEFT(0)+LEFT(p%)+8: ofy = TOP(0)+TOP(p%)+30
2D_TARGET_IS p%
' Figures
CONTAINER_OPTION 10: TOP 10,0: HEIGHT 10,20: WIDTH 10,250
OPTION 11: PARENT 11,10: TOP 11,3: LEFT 11,5: CAPTION 11,"Libre": MARK_ON 11
OPTION 12: PARENT 12,10: TOP 12,3: LEFT 12,55: CAPTION 12,"Rectangle"
OPTION 13: PARENT 13,10: TOP 13,3: LEFT 13,133: CAPTION 13,"Ellipse"
OPTION 14: PARENT 14,10: TOP 14,3: LEFT 14,190: CAPTION 14,"Remplir"
FOR i% = 11 TO 14: ON_CLICK i%,Type: NEXT i%
typ = 0: 2D_PEN_SOLID: ' tracé libre
' Palette
CONTAINER 20: LEFT 20,WIDTH(10)+20: HEIGHT 20,20: top 20,top(10)+2: WIDTH 20,160
PICTURE 21: PARENT 21,20: WIDTH 21,25: HEIGHT 21,20: COLOR 21,0,0,0
PICTURE 22: PARENT 22,20: LEFT 22,35: WIDTH 22,120: HEIGHT 22,20: 2D_TARGET_IS 22
2D_PEN_COLOR 0,0,0: 2D_FILL_COLOR 0,0,0: 2D_RECTANGLE 0,0,20,20
2D_PEN_COLOR 255,255,255: 2D_FILL_COLOR 255,255,255: 2D_RECTANGLE 20,0,40,20
2D_PEN_COLOR 255,0,0: 2D_FILL_COLOR 255,0,0: 2D_RECTANGLE 40,0,60,20
2D_PEN_COLOR 0,255,0: 2D_FILL_COLOR 0,255,0: 2D_RECTANGLE 60,0,80,20
2D_PEN_COLOR 0,0,255: 2D_FILL_COLOR 0,0,255: 2D_RECTANGLE 80,0,100,20
2D_PEN_COLOR 255,255,0: 2D_FILL_COLOR 255,255,0: 2D_RECTANGLE 100,0,120,20
ON_CLICK 22,Couleur
' Épaisseur du trait
ALPHA 30: TOP 30,TOP(20)+2: LEFT 30,LEFT(20)+165: CAPTION 30,"Trait:"
SPIN 31: TOP 31,TOP(30)-4: LEFT 31,LEFT(30)+35: WIDTH 31,40
MIN 31,1: MAX 31,20: POSITION 31,1

BUTTON 40: LEFT 40,LEFT(31)+50: HEIGHT 40,23: WIDTH 40,20
BUTTON 41: LEFT 41,LEFT(40)+20: HEIGHT 41,23: WIDTH 41,20
BUTTON 42: LEFT 42,LEFT(41)+20: HEIGHT 42,23: WIDTH 42,20
BUTTON 43: LEFT 43,LEFT(42)+20: HEIGHT 43,23: WIDTH 43,20
BUTTON 44: LEFT 44,LEFT(43)+20: HEIGHT 44,23: WIDTH 44,20
BUTTON 45: LEFT 45,LEFT(44)+20: HEIGHT 45,23: WIDTH 45,20
FOR i%=40 TO 45
FONT_NAME i%,"Wingdings": CAPTION i%,CHR$(191+i%): ON_CLICK i%,Deplacer
NEXT i%
CAPTION 44,CHR$(229): CAPTION 45,CHR$(228)
SPIN 46: LEFT 46,LEFT(45)+20: WIDTH 46,40: POSITION 46,5: MIN 46,1: MAX 46,50
ALPHA 47: TOP 47,2: LEFT 47,LEFT(46)+40: CAPTION 47,"pixels"
BUTTON 48: LEFT 48,WIDTH(0)-136: WIDTH 48,53: HEIGHT 48,23: CAPTION 48,"Annuler"
ON_CLICK 48,Annuler
BUTTON 50: WIDTH 50,67: LEFT 50,LEFT(48)+53: HEIGHT 50,23: CAPTION 50,"Enregistrer"
ON_CLICK 50,Sauve
SAVE_DIALOG 51: FILTER 51,"fichier image .BMP|*.bmp"

2D_TARGET_IS p%
DLL_ON mm$
coord$ = STRING$(8," ")
btn = DLL_CALL1("GetMouseXY",ADR(coord$)): ' état boutons et coordonnées souris
WHILE btn<>2
xd% = VAL(LEFT$(coord$,4))-ofx: yd% = VAL(RIGHT$(coord$,4))-ofy
IF xd%>=0 AND yd%>=0 AND xd%<wp% AND yd%<hp%
CAPTION 0,"x= "+STR$(xd%)+" y= "+STR$(yd%)
btn = DLL_CALL1("GetMouseXY",ADR(coord$))
IF btn=1: ' bouton gauche enfoncé
GOSUB Dessiner
END_IF
ELSE
btn = DLL_CALL1("GetMouseXY",ADR(coord$))
END_IF
PAUSE 100
END_WHILE
END
' ==============================================================================
Quit:
TERMINATE
' ==============================================================================
Type:
' Type de dessin: libre, rectangle, cercle/ellipse, ou autre (à voir)...
IF CHECKED(11)=1
typ = 0: 2D_PEN_SOLID: 2D_PEN_WIDTH POSITION(31)
ELSE
IF CHECKED(12)=1
typ = 1: 2D_PEN_DOT: 2D_PEN_WIDTH 1: 2D_PEN_COLOR 0,0,255
ELSE
IF CHECKED(13)=1
typ = 2: 2D_PEN_DOT: 2D_PEN_WIDTH 1: 2D_PEN_COLOR 0,0,255
ELSE
IF CHECKED(14)=1
typ = 3
ELSE
' autre, à définir
END_IF
END_IF
END_IF
END_IF
RETURN
' ==============================================================================
Couleur:
' Couleur du tracé
x%=MOUSE_X_POSITION(22): y%=MOUSE_Y_POSITION(22)
r%=COLOR_PIXEL_RED(22,x%,y%): g%=COLOR_PIXEL_GREEN(22,x%,y%): b%=COLOR_PIXEL_BLUE(22,x%,y%)
COLOR 21,r%,g%,b%: 2D_PEN_COLOR r%,g%,b%
RETURN
' ==============================================================================
Dessiner:
ofx = LEFT(0)+LEFT(p%)+8: ofy = TOP(0)+TOP(p%)+30
xd%=VAL(LEFT$(coord$,4))-ofx: yd% = VAL(RIGHT$(coord$,4))-ofy
x1%=xd%: y1%=yd%
btn = 1
CLIPBOARD_COPY 1
WHILE btn = 1
btn = DLL_CALL1("GetMouseXY",ADR(coord$))
x%=VAL(LEFT$(coord$,4))-ofx: y% = VAL(RIGHT$(coord$,4))-ofy
IF x%<0 OR y%<0 OR x%>WIDTH(p%) OR y%>HEIGHT(p%) THEN GOTO ign
CAPTION 0,"x= "+STR$(x%)+" y= "+STR$(y%)
IF x%<>x1% OR y%<>y1%
IF typ = 0: ' tracé libre
2D_PEN_COLOR r%,g%,b%
2D_PEN_WIDTH POSITION(31): 2D_LINE x1%,y1%,x%,y%
ELSE
2D_PEN_COLOR 0,0,0
IF typ = 1: ' rectangle
CLIPBOARD_PASTE 1
2D_LINE xd%,yd%,x%,yd%: 2D_POLY_TO x%,y%: 2D_POLY_TO xd%,y%: 2D_POLY_TO xd%,yd%
ELSE
IF typ = 2: ' ellipse
CLIPBOARD_PASTE 1
rx%=(x%-xd%)/2: ry%=(y%-yd%)/2: xc%=xd%+rx%: yc%=yd%+ry%
2D_POLY_FROM xc%+rx%,yc%
FOR t=0 TO 2*pi STEP pi/180
2D_POLY_TO xc%+rx%*COS(t),yc%+ry%*SIN(t)
NEXT t
ELSE
IF typ = 3: ' remplir

ELSE
' autres
END_IF
END_IF
END_IF
END_IF
x1%=x%: y1%=y%
END_IF
ign:
PAUSE 30
END_WHILE
' bouton gauche relâché: tracé définitif
IF typ > 0
CLIPBOARD_PASTE 1: 2D_PEN_SOLID: 2D_PEN_WIDTH POSITION(31): 2D_PEN_COLOR r%,g%,b%
xa%=xd%: ya%=yd%: xf%=x%: yf%=y%
IF typ = 1: ' rectangle
GOSUB Desrec
ELSE
IF typ = 2: ' ellipse
GOSUB Desell
ELSE
IF typ = 3: ' remplir
2D_FLOOD xa%,ya%,r%,g%,b%
ELSE
' autres
END_IF
END_IF
END_IF
2D_PEN_WIDTH 1: 2D_PEN_DOT: 2D_PEN_COLOR 0,0,255
END_IF
RETURN
' ==============================================================================
Desrec:
2D_LINE xa%,ya%,xf%,ya%: 2D_POLY_TO xf%,yf%: 2D_POLY_TO xa%,yf%: 2D_POLY_TO xa%,ya%
RETURN
' ==============================================================================
Desell:
rx%=(xf%-xa%)/2: ry%=(yf%-ya%)/2: xc%=xa%+rx%: yc%=ya%+ry%
2D_POLY_FROM xc%+rx%,yc%
FOR t=0 TO 2*pi STEP pi/180
2D_POLY_TO xc%+rx%*COS(t),yc%+ry%*SIN(t)
NEXT t
RETURN
' ==============================================================================
Deplacer:
IF typ = 0 THEN RETURN: ' (tracé libre, non déplaçable)
i% = NUMBER_CLICK: j% = POSITION(46)
SELECT i%
CASE 40: xa%=xa%-j%: xf%=xf%-j%
CASE 41: xa%=xa%+j%: xf%=xf%+j%
CASE 42: ya%=ya%-j%: yf%=yf%-j%
CASE 43: ya%=ya%+j%: yf%=yf%+j%
CASE 44: xf%=xf%-j%: yf%=yf%-j%
CASE 45: xf%=xf%+j%: yf%=yf%+j%
END_SELECT
CLIPBOARD_PASTE 1: 2D_PEN_SOLID: 2D_PEN_WIDTH POSITION(31): 2D_PEN_COLOR r%,g%,b%
SELECT typ
CASE 1: GOSUB Desrec
CASE 2: GOSUB Desell
END_SELECT
2D_PEN_WIDTH 1: 2D_PEN_DOT: 2D_PEN_COLOR 0,0,255
RETURN
' ==============================================================================
Annuler:
CLIPBOARD_PASTE 1: ' retour à l'état précédent
RETURN
' ==============================================================================
Sauve:
f$ = FILE_NAME$(51)
IF LEN(f$)<5 THEN RETURN
IF UPPER$(RIGHT$(f$,4))<>".BMP"
MESSAGE "Format non BMP !"+CHR$(13)+"Sauvegarde annulée."
ELSE
FILE_SAVE p%,f$
END_IF
RETURN
' ==============================================================================

C'est une super base. Tu peux réimplanter dedans une partie des outils que tu avais fait dans ton logiciel de dessin d'avant, aussi même si tu as déjà repris les principales fonctionnalités. J'ai testé, ça marche bien. Après de temps en temps, le picture clignote, mais ça je pense que c'est inévitable et ça ne le fait pas trop. Ca répond bien.

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

Bonjour Jicehel,
Je n'avais même pas remarqué ce clignotement (pendant les déplacements de souris en cours de dessin: c'est le rafraîchissement écran), effectivement, en regardant bien... mais j'imagine que ça doit beaucoup dépendre de la puissance du pc (pourtant le mien n'est pas un cheval de course).
Il faut peut-être moduler la temporisation en cours de dessin (ligne 147: Pause 30), pour voir, essayer d'autres valeurs, 30 c'est peut-être trop court.

Et bon dimanche !

PS tu as peut-être vu, mais j'ai rajouté deux boutons en plus des déplacements: agrandir ou rétrécir le dernier dessin.

Les outils supplémentaires du programme précédent étaient dans des Subs à part, et ça posait parfois quelques problèmes surtout avec les timers inclus.
Par exemple la sub affiche sa boîte à outils dans un Form à part, avec ses propres boutons, et si pendant qu'elle est active on clique sur un bouton du Form 0 les timers n'aiment pas du tout et on part dans les décors.

oui, c'est une très bonne base pour un outil de dessin et ça permet déjà de faire beaucoup de chose. Dans ce que je rajouterais, il y aurait une astuce à trouver pour tracer des carrés ou des ronds à la place de rectangles et d'élipse (une case à cocher, un bouton à appuyer ou autre...) et le système de lignes continues que tu avais fait pour faire des tracés ainsi peut être qu'une touche pour fermer un tracé libre.

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

Tiens c'est vrai, j'ai oublié la ligne droite ! Pour les carrés et les cercles c'est facile (cas particulier des rectangles et ellipses).
Fermer un tracé libre ? bof, oui, pourquoi pas...

Mais ça ne sera pas aujourd'hui, j'ai du monde à manger (non, je ne suis pas cannibale, ce sont des invités Very Happy

)

Il n'y a pas d'urgence, mais fermer automatiquement un tracé libre, ça facilite pour le remplissage. Si tu utilises un système de touche pour faire des cercles ou des carrés, tu peux utiliser la même pour faire les ligne à partir de l'icone dessin libre.

Salut JL35

En voyant le X, je me suis dit « waou !!! Voila quelqu’un qui nous propose ce qu’on n’ose pas dire ! »
Mes illusions n’ont duré que le temps de lire ta première phrase et en testant le code, je n’ai plus dans la tête des XXX.
Merci pour cet outil parfaitement évolutif et adaptable pour tous gouts.

Bon, occupes-toi de ton « monde à manger

», on verra la suite plus tard.

Encore un truc de plus à tester,

Hou ! débordé... Very Happy

A+

Je viens de tester et cela mérite une suite... bounce

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

Bon, voici la suite.
Pour faire plaisir à Jicehel j'ai ajouté:
- une option figure 'ligne droite': Trait (c'est vrai que ça manquait)
- un check qui, s'il est coché, transforme automatiquement les rectangles en carrés et les ellipses en cercles.
- un check qui, s'il est coché, reboucle automatiquement les tracés libres.
Je remets le programme en entier:

Code:: ' Dessin
LABEL Quit,Type,Couleur,Dessiner,ign,Destrait,Desrec,Desell,Deplacer,Annuler,Sauve
DIM wp%,hp%,i%,j%,p%,x%,y%,xd%,yd%,x1%,y1%,xa%,ya%,xf%,yf%,btn,coord$,ofx,ofy,typ
DIM r%,g%,b%,wt%,rx%,ry%,xc%,yc%,pi,t,f$,mm$
pi = 4*ATN(1)
mm$ = "C:\PANORAMIC\Mouse.dll": ' <<<<<<<<<<<<<<<<<< A AJUSTER <<<<<<<<<<

wp% = 900: hp% = 675: ' Dimensions du picture de dessin

WIDTH 0,wp%+16: HEIGHT 0,hp%+68: COLOR 0,180,255,255: ON_CLOSE 0,Quit: FONT_BOLD 0
BORDER_SMALL 0
p% = 1: PICTURE p%: TOP p%,34: WIDTH p%,wp%: HEIGHT p%,hp%
ofx = LEFT(0)+LEFT(p%)+8: ofy = TOP(0)+TOP(p%)+40
' Figures
CONTAINER_OPTION 10: TOP 10,0: HEIGHT 10,30: WIDTH 10,200
OPTION 11: PARENT 11,10: TOP 11,-3: LEFT 11,5: CAPTION 11,"Libre": MARK_ON 11
OPTION 12: PARENT 12,10: TOP 12,12: LEFT 12,5: CAPTION 12,"Trait"
OPTION 13: PARENT 13,10: TOP 13,-3: LEFT 13,55: CAPTION 13,"Rectangle"
OPTION 14: PARENT 14,10: TOP 14,12: LEFT 14,55: CAPTION 14,"Ellipse"
OPTION 15: PARENT 15,10: TOP 15,-3: LEFT 15,133: CAPTION 15,"Remplir"
FOR i% = 11 TO 15: ON_CLICK i%,Type: NEXT i%
typ = 0: 2D_PEN_SOLID: ' tracé libre

CONTAINER 60: TOP 60,TOP(10): HEIGHT 60,HEIGHT(10): LEFT 60,LEFT(10)+WIDTH(10)
WIDTH 60,95
CHECK 61: PARENT 61,60: TOP 61,-3: LEFT 61,0: CAPTION 61,"Carré/Cercle"
CHECK 62: PARENT 62,60: TOP 62,12: LEFT 62,0: CAPTION 62,"Rebouclage"

' Palette
CONTAINER 20: LEFT 20,LEFT(60)+WIDTH(60)+10: HEIGHT 20,20: TOP 20,TOP(10)+2: WIDTH 20,130
PICTURE 21: PARENT 21,20: WIDTH 21,25: HEIGHT 21,20: COLOR 21,0,0,0
PICTURE 22: PARENT 22,20: LEFT 22,35: WIDTH 22,90: HEIGHT 22,20: 2D_TARGET_IS 22
2D_PEN_COLOR 0,0,0: 2D_FILL_COLOR 0,0,0: 2D_RECTANGLE 0,0,15,20
2D_PEN_COLOR 255,255,255: 2D_FILL_COLOR 255,255,255: 2D_RECTANGLE 15,0,30,20
2D_PEN_COLOR 255,0,0: 2D_FILL_COLOR 255,0,0: 2D_RECTANGLE 30,0,45,20
2D_PEN_COLOR 0,255,0: 2D_FILL_COLOR 0,255,0: 2D_RECTANGLE 45,0,60,20
2D_PEN_COLOR 0,0,255: 2D_FILL_COLOR 0,0,255: 2D_RECTANGLE 60,0,75,20
2D_PEN_COLOR 255,255,0: 2D_FILL_COLOR 255,255,0: 2D_RECTANGLE 75,0,90,20
ON_CLICK 22,Couleur
' Épaisseur du trait
ALPHA 30: TOP 30,TOP(20)+2: LEFT 30,LEFT(20)+135: CAPTION 30,"Trait:"
SPIN 31: TOP 31,TOP(30)-4: LEFT 31,LEFT(30)+35: WIDTH 31,40
MIN 31,1: MAX 31,20: POSITION 31,1

BUTTON 40: LEFT 40,LEFT(31)+50: HEIGHT 40,23: WIDTH 40,20
BUTTON 41: LEFT 41,LEFT(40)+20: HEIGHT 41,23: WIDTH 41,20
BUTTON 42: LEFT 42,LEFT(41)+20: HEIGHT 42,23: WIDTH 42,20
BUTTON 43: LEFT 43,LEFT(42)+20: HEIGHT 43,23: WIDTH 43,20
BUTTON 44: LEFT 44,LEFT(43)+20: HEIGHT 44,23: WIDTH 44,20
BUTTON 45: LEFT 45,LEFT(44)+20: HEIGHT 45,23: WIDTH 45,20
FOR i%=40 TO 45
FONT_NAME i%,"Wingdings": CAPTION i%,CHR$(191+i%): ON_CLICK i%,Deplacer
NEXT i%
CAPTION 44,CHR$(229): CAPTION 45,CHR$(228)
SPIN 46: LEFT 46,LEFT(45)+20: WIDTH 46,40: POSITION 46,5: MIN 46,1: MAX 46,50
ALPHA 47: TOP 47,2: LEFT 47,LEFT(46)+40: CAPTION 47,"pixels"
BUTTON 48: LEFT 48,WIDTH(0)-136: WIDTH 48,53: HEIGHT 48,23: CAPTION 48,"Annuler"
ON_CLICK 48,Annuler
BUTTON 50: WIDTH 50,67: LEFT 50,LEFT(48)+53: HEIGHT 50,23: CAPTION 50,"Enregistrer"
ON_CLICK 50,Sauve
SAVE_DIALOG 51: FILTER 51,"fichier image .BMP|*.bmp"

2D_TARGET_IS p%
DLL_ON mm$
coord$ = STRING$(8," ")
btn = DLL_CALL1("GetMouseXY",ADR(coord$)): ' état boutons et coordonnées souris
WHILE btn<>2: ' Boucle d'attente de clic dans la surface de dessin
xd% = VAL(LEFT$(coord$,4))-ofx: yd% = VAL(RIGHT$(coord$,4))-ofy
IF xd%>=0 AND yd%>=0 AND xd%<wp% AND yd%<hp%
CAPTION 0,"x= "+STR$(xd%)+" y= "+STR$(yd%)
btn = DLL_CALL1("GetMouseXY",ADR(coord$))
IF btn=1: ' bouton gauche enfoncé
GOSUB Dessiner
END_IF
ELSE
btn = DLL_CALL1("GetMouseXY",ADR(coord$))
END_IF
PAUSE 100
END_WHILE
END
' ==============================================================================
Quit:
TERMINATE
' ==============================================================================
Type:
' Type de dessin: libre, rectangle, cercle/ellipse, ou autre (à voir)...
IF CHECKED(11)=1
typ = 0: 2D_PEN_SOLID: 2D_PEN_WIDTH POSITION(31): ' tracé libre
ELSE
IF CHECKED(12)=1
typ = 1: 2D_PEN_DOT: 2D_PEN_WIDTH 1: 2D_PEN_COLOR 0,0,255: ' Trait
ELSE
IF CHECKED(13)=1
typ = 2: 2D_PEN_DOT: 2D_PEN_WIDTH 1: 2D_PEN_COLOR 0,0,255: ' Rectangle
ELSE
IF CHECKED(14)=1
typ = 3: 2D_PEN_DOT: 2D_PEN_WIDTH 1: 2D_PEN_COLOR 0,0,255: ' Ellipse
ELSE
IF CHECKED(15)=1
typ = 4: ' Remplir
ELSE
' autre, à définir
END_IF
END_IF
END_IF
END_IF
END_IF
RETURN
' ==============================================================================
Couleur:
' Couleur du tracé
x%=MOUSE_X_POSITION(22): y%=MOUSE_Y_POSITION(22)
r%=COLOR_PIXEL_RED(22,x%,y%): g%=COLOR_PIXEL_GREEN(22,x%,y%): b%=COLOR_PIXEL_BLUE(22,x%,y%)
COLOR 21,r%,g%,b%: 2D_PEN_COLOR r%,g%,b%
RETURN
' ==============================================================================
Dessiner:
ofx = LEFT(0)+LEFT(p%)+8: ofy = TOP(0)+TOP(p%)+30
xd%=VAL(LEFT$(coord$,4))-ofx: yd% = VAL(RIGHT$(coord$,4))-ofy
xa%=xd%: ya%=yd%: x1%=xd%: y1%=yd%
btn = 1
CLIPBOARD_COPY 1
WHILE btn = 1
btn = DLL_CALL1("GetMouseXY",ADR(coord$))
x%=VAL(LEFT$(coord$,4))-ofx: y% = VAL(RIGHT$(coord$,4))-ofy
IF x%<0 OR y%<0 OR x%>WIDTH(p%) OR y%>HEIGHT(p%) THEN GOTO ign
CAPTION 0,"x= "+STR$(x%)+" y= "+STR$(y%)
IF x%<>x1% OR y%<>y1%
IF typ = 0: ' tracé libre
2D_PEN_COLOR r%,g%,b%
2D_PEN_WIDTH POSITION(31): 2D_LINE x1%,y1%,x%,y%
ELSE
2D_PEN_COLOR 0,0,0
IF typ = 1: ' Trait
CLIPBOARD_PASTE 1
2D_LINE xd%,yd%,x%,y%
ELSE
IF typ = 2: ' Rectangle
CLIPBOARD_PASTE 1
IF CHECKED(61) = 1 THEN y% = yd%+x%-xd%: ' carré
2D_LINE xd%,yd%,x%,yd%: 2D_POLY_TO x%,y%: 2D_POLY_TO xd%,y%
2D_POLY_TO xd%,yd%
ELSE
IF typ = 3: ' Ellipse
CLIPBOARD_PASTE 1
rx%=(x%-xd%)/2: ry%=(y%-yd%)/2
IF CHECKED(61)=1 THEN ry%=rx%
xc%=xd%+rx%: yc%=yd%+ry%
2D_POLY_FROM xc%+rx%,yc%
FOR t=0 TO 2*pi STEP pi/180
2D_POLY_TO xc%+rx%*COS(t),yc%+ry%*SIN(t)
NEXT t
ELSE
IF typ = 4: ' Remplir

ELSE
' autres
END_IF
END_IF
END_IF
END_IF
END_IF
x1%=x%: y1%=y%
END_IF
ign:
PAUSE 50
END_WHILE
' bouton gauche relâché: tracé définitif
IF typ = 0
IF CHECKED(62)=1 THEN 2D_LINE x%,y%,xa%,ya%: ' rebouclage tracé libre
ELSE
CLIPBOARD_PASTE 1: 2D_PEN_SOLID: 2D_PEN_WIDTH POSITION(31): 2D_PEN_COLOR r%,g%,b%
xa%=xd%: ya%=yd%: xf%=x%: yf%=y%
IF typ = 1: ' Trait
GOSUB Destrait
ELSE
IF typ = 2: ' rectangle/carré
GOSUB Desrec
ELSE
IF typ = 3: ' ellipse/cercle
GOSUB Desell
ELSE
IF typ = 4: ' remplir
2D_FLOOD xa%,ya%,r%,g%,b%
ELSE
' autres
END_IF
END_IF
END_IF
END_IF
2D_PEN_WIDTH 1: 2D_PEN_DOT: 2D_PEN_COLOR 0,0,255
END_IF
RETURN
' ==============================================================================
Destrait:
2D_LINE xa%,ya%,xf%,yf%
RETURN
' ==============================================================================
Desrec:
IF CHECKED(61) = 1 THEN yf% = yd%+xf%-xd%
2D_LINE xa%,ya%,xf%,ya%: 2D_POLY_TO xf%,yf%: 2D_POLY_TO xa%,yf%: 2D_POLY_TO xa%,ya%
RETURN
' ==============================================================================
Desell:
rx%=(xf%-xa%)/2: ry%=(yf%-ya%)/2
IF CHECKED(61)=1 THEN ry%=rx%
xc%=xa%+rx%: yc%=ya%+ry%
2D_POLY_FROM xc%+rx%,yc%
FOR t=0 TO 2*pi STEP pi/180
2D_POLY_TO xc%+rx%*COS(t),yc%+ry%*SIN(t)
NEXT t
RETURN
' ==============================================================================
Deplacer:
IF typ = 0 THEN RETURN: ' (tracé libre, non déplaçable)
i% = NUMBER_CLICK: j% = POSITION(46)
SELECT i%
CASE 40: xa%=xa%-j%: xf%=xf%-j%: ' gauche
CASE 41: xa%=xa%+j%: xf%=xf%+j%: ' droite
CASE 42: ya%=ya%-j%: yf%=yf%-j%: ' haut
CASE 43: ya%=ya%+j%: yf%=yf%+j%: ' bas
CASE 44: xf%=xf%-j%: yf%=yf%-j%: ' diminuer
CASE 45: xf%=xf%+j%: yf%=yf%+j%: ' augmenter
END_SELECT
CLIPBOARD_PASTE 1: 2D_PEN_SOLID: 2D_PEN_WIDTH POSITION(31): 2D_PEN_COLOR r%,g%,b%
SELECT typ
CASE 1: GOSUB Destrait
CASE 2: GOSUB Desrec
CASE 3: GOSUB Desell
END_SELECT
2D_PEN_WIDTH 1: 2D_PEN_DOT: 2D_PEN_COLOR 0,0,255
RETURN
' ==============================================================================
Annuler:
CLIPBOARD_PASTE 1: ' retour à l'état précédent
RETURN
' ==============================================================================
Sauve:
f$ = FILE_NAME$(51)
IF LEN(f$)<5 THEN RETURN
IF UPPER$(RIGHT$(f$,4))<>".BMP"
MESSAGE "Format non BMP !"+CHR$(13)+"Sauvegarde annulée."
ELSE
FILE_SAVE p%,f$
END_IF
RETURN
' ==============================================================================

Super, ça marche très bien et c'est très pratique

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

Ah, voilà un connaisseur ! Merci Jicehel, et bonne nuit ! Wink

J’ai ajouté un autre type Spirale
Le check carré/cercle s’applique aussi à Spirale. Idea

J’ai simplifié le code du sous-programme Type :
Il contient beaucoup de IF … ELSE … END_IF et je crains de m’y perdre !

Code:: ' Dessin
LABEL Quit,Type,Couleur,Dessiner,ign,Destrait,Desrec,Desell,Deplacer,Annuler,Sauve,desspi
DIM wp%,hp%,i%,j%,p%,x%,y%,xd%,yd%,x1%,y1%,xa%,ya%,xf%,yf%,btn,coord$,ofx,ofy,typ
DIM r%,g%,b%,wt%,rx%,ry%,xc%,yc%,pi,t,f$,mm$
pi = 4*ATN(1)
mm$ = "C:\PANORAMIC\Mouse.dll": ' <<<<<<<<<<<<<<<<<< A AJUSTER <<<<<<<<<<

wp% = 900: hp% = 675: ' Dimensions du picture de dessin

WIDTH 0,wp%+16: HEIGHT 0,hp%+68: COLOR 0,180,255,255: ON_CLOSE 0,Quit: FONT_BOLD 0
   BORDER_SMALL 0
p% = 1: PICTURE p%: TOP p%,34: WIDTH p%,wp%: HEIGHT p%,hp%
   ofx = LEFT(0)+LEFT(p%)+8: ofy = TOP(0)+TOP(p%)+40
' Figures
CONTAINER_OPTION 10: TOP 10,0: HEIGHT 10,30: WIDTH 10,200
  OPTION 11: PARENT 11,10: TOP 11,-3: LEFT 11,5: CAPTION 11,"Libre": MARK_ON 11
  OPTION 12: PARENT 12,10: TOP 12,12: LEFT 12,5: CAPTION 12,"Trait"
  OPTION 13: PARENT 13,10: TOP 13,-3: LEFT 13,55: CAPTION 13,"Rectangle"
  OPTION 14: PARENT 14,10: TOP 14,12: LEFT 14,55: CAPTION 14,"Ellipse"
  OPTION 15: PARENT 15,10: TOP 15,-3: LEFT 15,133: CAPTION 15,"Remplir"
  OPTION 16: PARENT 16,10: TOP 16,12: LEFT 16,133: CAPTION 16,"Spirale"
   FOR i% = 11 TO 16: ON_CLICK i%,Type: NEXT i%
   typ = 0: 2D_PEN_SOLID: ' tracé libre

CONTAINER 60: TOP 60,TOP(10): HEIGHT 60,HEIGHT(10): LEFT 60,LEFT(10)+WIDTH(10)
   WIDTH 60,95
  CHECK 61: PARENT 61,60: TOP 61,-3: LEFT 61,0: CAPTION 61,"Carré/Cercle"
  CHECK 62: PARENT 62,60: TOP 62,12: LEFT 62,0: CAPTION 62,"Rebouclage"

' Palette
CONTAINER 20: LEFT 20,LEFT(60)+WIDTH(60)+10: HEIGHT 20,20: TOP 20,TOP(10)+2: WIDTH 20,130
  PICTURE 21: PARENT 21,20: WIDTH 21,25: HEIGHT 21,20: COLOR 21,0,0,0
  PICTURE 22: PARENT 22,20: LEFT 22,35: WIDTH 22,90: HEIGHT 22,20: 2D_TARGET_IS 22
   2D_PEN_COLOR 0,0,0: 2D_FILL_COLOR 0,0,0: 2D_RECTANGLE 0,0,15,20
   2D_PEN_COLOR 255,255,255: 2D_FILL_COLOR 255,255,255: 2D_RECTANGLE 15,0,30,20
   2D_PEN_COLOR 255,0,0: 2D_FILL_COLOR 255,0,0: 2D_RECTANGLE 30,0,45,20
   2D_PEN_COLOR 0,255,0: 2D_FILL_COLOR 0,255,0: 2D_RECTANGLE 45,0,60,20
   2D_PEN_COLOR 0,0,255: 2D_FILL_COLOR 0,0,255: 2D_RECTANGLE 60,0,75,20
   2D_PEN_COLOR 255,255,0: 2D_FILL_COLOR 255,255,0: 2D_RECTANGLE 75,0,90,20
   ON_CLICK 22,Couleur
' Épaisseur du trait
ALPHA 30: TOP 30,TOP(20)+2: LEFT 30,LEFT(20)+135: CAPTION 30,"Trait:"
SPIN 31: TOP 31,TOP(30)-4: LEFT 31,LEFT(30)+35: WIDTH 31,40
   MIN 31,1: MAX 31,20: POSITION 31,1

BUTTON 40: LEFT 40,LEFT(31)+50: HEIGHT 40,23: WIDTH 40,20
BUTTON 41: LEFT 41,LEFT(40)+20: HEIGHT 41,23: WIDTH 41,20
BUTTON 42: LEFT 42,LEFT(41)+20: HEIGHT 42,23: WIDTH 42,20
BUTTON 43: LEFT 43,LEFT(42)+20: HEIGHT 43,23: WIDTH 43,20
BUTTON 44: LEFT 44,LEFT(43)+20: HEIGHT 44,23: WIDTH 44,20
BUTTON 45: LEFT 45,LEFT(44)+20: HEIGHT 45,23: WIDTH 45,20
   FOR i%=40 TO 45
   FONT_NAME i%,"Wingdings": CAPTION i%,CHR$(191+i%): ON_CLICK i%,Deplacer
   NEXT i%
   CAPTION 44,CHR$(229): CAPTION 45,CHR$(228)
SPIN 46: LEFT 46,LEFT(45)+20: WIDTH 46,40: POSITION 46,5: MIN 46,1: MAX 46,50
ALPHA 47: TOP 47,2: LEFT 47,LEFT(46)+40: CAPTION 47,"pixels"
BUTTON 48: LEFT 48,WIDTH(0)-136: WIDTH 48,53: HEIGHT 48,23: CAPTION 48,"Annuler"
   ON_CLICK 48,Annuler
BUTTON 50: WIDTH 50,67: LEFT 50,LEFT(48)+53: HEIGHT 50,23: CAPTION 50,"Enregistrer"
   ON_CLICK 50,Sauve
SAVE_DIALOG 51: FILTER 51,"fichier image .BMP|*.bmp"

2D_TARGET_IS p%
DLL_ON mm$
coord$ = STRING$(8," ")
btn = DLL_CALL1("GetMouseXY",ADR(coord$)): ' état boutons et coordonnées souris
WHILE btn<>2: ' Boucle d'attente de clic dans la surface de dessin
   xd% = VAL(LEFT$(coord$,4))-ofx: yd% = VAL(RIGHT$(coord$,4))-ofy
   IF xd%>=0 AND yd%>=0 AND xd%<wp% AND yd%<hp%
   CAPTION 0,"x= "+STR$(xd%)+" y= "+STR$(yd%)
   btn = DLL_CALL1("GetMouseXY",ADR(coord$))
   IF btn=1: ' bouton gauche enfoncé
   GOSUB Dessiner
   END_IF
   ELSE
   btn = DLL_CALL1("GetMouseXY",ADR(coord$))
   END_IF
   PAUSE 100
END_WHILE
END
' ==============================================================================
Quit:
TERMINATE
' ==============================================================================
Type:
' Type de dessin: libre, rectangle, cercle/ellipse, ou autre (à voir)...

for i% = 11 to 16
   if checked(i%) = 1
   typ = i% -11
   2D_PEN_DOT: 2D_PEN_WIDTH 1: 2D_PEN_COLOR 0,0,255
   end_if
next i%
if CHECKED(11)=1 then 2D_PEN_SOLID: 2D_PEN_WIDTH POSITION(31)
RETURN
' ==============================================================================
Couleur:
' Couleur du tracé
x%=MOUSE_X_POSITION(22): y%=MOUSE_Y_POSITION(22)
r%=COLOR_PIXEL_RED(22,x%,y%): g%=COLOR_PIXEL_GREEN(22,x%,y%): b%=COLOR_PIXEL_BLUE(22,x%,y%)
COLOR 21,r%,g%,b%: 2D_PEN_COLOR r%,g%,b%
RETURN
' ==============================================================================
Dessiner:
ofx = LEFT(0)+LEFT(p%)+8: ofy = TOP(0)+TOP(p%)+30
xd%=VAL(LEFT$(coord$,4))-ofx: yd% = VAL(RIGHT$(coord$,4))-ofy
xa%=xd%: ya%=yd%: x1%=xd%: y1%=yd%
btn = 1
CLIPBOARD_COPY 1
WHILE btn = 1
   btn = DLL_CALL1("GetMouseXY",ADR(coord$))
   x%=VAL(LEFT$(coord$,4))-ofx: y% = VAL(RIGHT$(coord$,4))-ofy
   IF x%<0 OR y%<0 OR x%>WIDTH(p%) OR y%>HEIGHT(p%) THEN GOTO ign
   CAPTION 0,"x= "+STR$(x%)+" y= "+STR$(y%)
   IF x%<>x1% OR y%<>y1%
   IF typ = 0: ' tracé libre
   2D_PEN_COLOR r%,g%,b%
   2D_PEN_WIDTH POSITION(31): 2D_LINE x1%,y1%,x%,y%
   ELSE
   2D_PEN_COLOR 0,0,0
   IF typ = 1: ' Trait
   CLIPBOARD_PASTE 1
   2D_LINE xd%,yd%,x%,y%
   ELSE
   IF typ = 2: ' Rectangle
   CLIPBOARD_PASTE 1
   IF CHECKED(61) = 1 THEN y% = yd%+x%-xd%: ' carré
   2D_LINE xd%,yd%,x%,yd%: 2D_POLY_TO x%,y%: 2D_POLY_TO xd%,y%
   2D_POLY_TO xd%,yd%
   ELSE
   IF typ = 3: ' Ellipse
   CLIPBOARD_PASTE 1
   rx%=(x%-xd%)/2: ry%=(y%-yd%)/2
   IF CHECKED(61)=1 THEN ry%=rx%
   xc%=xd%+rx%: yc%=yd%+ry%
   2D_POLY_FROM xc%+rx%,yc%
   FOR t=0 TO 2*pi STEP pi/180
   2D_POLY_TO xc%+rx%*COS(t),yc%+ry%*SIN(t)
   NEXT t
   ELSE
   IF typ = 4: ' Remplir

   ELSE
   if typ = 5 : ' Spirale
   CLIPBOARD_PASTE 1
   rx%=(x%-xd%)/4: ry%=(y%-yd%)/4
   IF CHECKED(61)=1 THEN ry%=rx%
   xc%=xd%+rx%: yc%=yd%+ry%
   2D_POLY_FROM xc%+rx%,yc%
   for t = 0 to 10*pi step pi/180
   2d_poly_to xc%+rx%*t*cos(t),yc%+ry%*t*sin(t)
   next t
   end_if
   END_IF
   END_IF
   END_IF
   END_IF
   END_IF
   x1%=x%: y1%=y%
   END_IF
ign:
   PAUSE 50
END_WHILE
' bouton gauche relâché: tracé définitif
IF typ = 0
   IF CHECKED(62)=1 THEN 2D_LINE x%,y%,xa%,ya%: ' rebouclage tracé libre
ELSE
   CLIPBOARD_PASTE 1: 2D_PEN_SOLID: 2D_PEN_WIDTH POSITION(31): 2D_PEN_COLOR r%,g%,b%
   xa%=xd%: ya%=yd%: xf%=x%: yf%=y%
   IF typ = 1: ' Trait
   GOSUB Destrait
   ELSE
   IF typ = 2: ' rectangle/carré
   GOSUB Desrec
   ELSE
   IF typ = 3: ' ellipse/cercle
   GOSUB Desell
   ELSE
   IF typ = 4: ' remplir
   2D_FLOOD xa%,ya%,r%,g%,b%
   ELSE
   if typ = 5 then gosub desspi
   END_IF
   END_IF
   END_IF
   END_IF
   2D_PEN_WIDTH 1: 2D_PEN_DOT: 2D_PEN_COLOR 0,0,255
END_IF
RETURN
' ==============================================================================
Destrait:
2D_LINE xa%,ya%,xf%,yf%
RETURN
' ==============================================================================
Desrec:
IF CHECKED(61) = 1 THEN yf% = yd%+xf%-xd%
2D_LINE xa%,ya%,xf%,ya%: 2D_POLY_TO xf%,yf%: 2D_POLY_TO xa%,yf%: 2D_POLY_TO xa%,ya%
RETURN
' ==============================================================================
Desell:
rx%=(xf%-xa%)/2: ry%=(yf%-ya%)/2
IF CHECKED(61)=1 THEN ry%=rx%
xc%=xa%+rx%: yc%=ya%+ry%
2D_POLY_FROM xc%+rx%,yc%
FOR t=0 TO 2*pi STEP pi/180
   2D_POLY_TO xc%+rx%*COS(t),yc%+ry%*SIN(t)
NEXT t
RETURN
' ==============================================================================
Desspi:
rx%=(x%-xd%)/4: ry%=(y%-yd%)/4
IF CHECKED(61)=1 THEN ry%=rx%
xc%=xd%+rx%: yc%=yd%+ry%
2D_POLY_FROM xc%+rx%,yc%
for t = 0 to 10*pi step pi/180
   2d_poly_to xc%+rx%*t*cos(t),yc%+ry%*t*sin(t)
next t
return
' ==============================================================================
Deplacer:
IF typ = 0 THEN RETURN: ' (tracé libre, non déplaçable)
i% = NUMBER_CLICK: j% = POSITION(46)
SELECT i%
   CASE 40: xa%=xa%-j%: xf%=xf%-j%: ' gauche
   CASE 41: xa%=xa%+j%: xf%=xf%+j%: ' droite
   CASE 42: ya%=ya%-j%: yf%=yf%-j%: ' haut
   CASE 43: ya%=ya%+j%: yf%=yf%+j%: ' bas
   CASE 44: xf%=xf%-j%: yf%=yf%-j%: ' diminuer
   CASE 45: xf%=xf%+j%: yf%=yf%+j%: ' augmenter
END_SELECT
CLIPBOARD_PASTE 1: 2D_PEN_SOLID: 2D_PEN_WIDTH POSITION(31): 2D_PEN_COLOR r%,g%,b%
SELECT typ
   CASE 1: GOSUB Destrait
   CASE 2: GOSUB Desrec
   CASE 3: GOSUB Desell
END_SELECT
2D_PEN_WIDTH 1: 2D_PEN_DOT: 2D_PEN_COLOR 0,0,255
RETURN
' ==============================================================================
Annuler:
CLIPBOARD_PASTE 1: ' retour à l'état précédent
RETURN
' ==============================================================================
Sauve:
f$ = FILE_NAME$(51)
IF LEN(f$)<5 THEN RETURN
IF UPPER$(RIGHT$(f$,4))<>".BMP"
   MESSAGE "Format non BMP !"+CHR$(13)+"Sauvegarde annulée."
ELSE
   FILE_SAVE p%,f$
END_IF
RETURN
' ==============================================================================

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

D'accord avec toi papydall pour les IF en cascade peu esthétiques, que j'ai remplacé par des Select/End_Select quand je pouvais (s/p Dessiner et Type).
Je n'ai pas ajouté de fonction spirale, mais à la place une fonction 'Coller' qui permet de coller où on veut une image contenue dans le presse-papier.
On pourrait évidemment ajouter des figures à l'infini, spirale entre autres, étoiles, polygones, etc. mais pour ça il faut agrandir l'en-tête, mais est-ce bien utile ? j'ai des doutes pour la spirale...
Le programme faisant un usage constant du presse-papier (pour pouvoir annuler une action: retour à l'état précédent), il faut utiliser cette fonction Coller dans l'ordre:
- mettre une image dans le presse-papier (à l'aide d'un programme externe)
- cliquer l'option 'Coller'
- cliquer dans le dessin l'emplacement (coin supérieur gauche) de l'insertion.
L'annulation de cette opération a quelquefois des ratés, je ne sais pas trop pourquoi (dans le cas 'coller', la sauvegarde préalable se fait dans un fichier de travail, qui est restauré dans le picture en cas d'annulation).

J'ai ajouté également un bouton 'RAZ total' qui efface la totalité du dessin en cours (avec confirmation).

Code:: ' Dessin
LABEL Quit,Type,Couleur,Dessiner,ign,Destrait,Desrec,Desell,Deplacer,Annuler
LABEL SauvRest,SauvRest1,Raztou
DIM wp%,hp%,i%,j%,p%,x%,y%,xd%,yd%,x1%,y1%,xa%,ya%,xf%,yf%,btn,coord$,ofx,ofy,typ
DIM r%,g%,b%,wt%,rx%,ry%,xc%,yc%,pi,t,f$,mm$,ftmp$
pi = 4*ATN(1)
mm$ = "C:\PANORAMIC\Mouse.dll": ' <<<<<<<<<<<<<<<<<< A AJUSTER <<<<<<<<<<
ftmp$ = "C:\TEMP\Tmp.bmp"

wp% = 900: hp% = 675: ' Dimensions du picture de dessin

WIDTH 0,wp%+16: HEIGHT 0,hp%+68: COLOR 0,180,255,255: ON_CLOSE 0,Quit: FONT_BOLD 0
BORDER_SMALL 0
p% = 1: PICTURE p%: TOP p%,34: WIDTH p%,wp%: HEIGHT p%,hp%
' ofx = LEFT(0)+LEFT(p%)+8: ofy = TOP(0)+TOP(p%)+40
' Figures
CONTAINER_OPTION 10: TOP 10,0: HEIGHT 10,30: WIDTH 10,200
OPTION 11: PARENT 11,10: TOP 11,0: LEFT 11,5: CAPTION 11,"Libre": MARK_ON 11
OPTION 12: PARENT 12,10: TOP 12,15: LEFT 12,5: CAPTION 12,"Trait"
OPTION 13: PARENT 13,10: TOP 13,0: LEFT 13,55: CAPTION 13,"Rectangle"
OPTION 14: PARENT 14,10: TOP 14,15: LEFT 14,55: CAPTION 14,"Ellipse"
OPTION 15: PARENT 15,10: TOP 15,0: LEFT 15,133: CAPTION 15,"Remplir"
OPTION 16: PARENT 16,10: TOP 16,15: LEFT 16,133: CAPTION 16,"Coller"
FOR i% = 11 TO 16: ON_CLICK i%,Type: NEXT i%
typ = 0: 2D_PEN_SOLID: ' tracé libre

CONTAINER 60: TOP 60,TOP(10): HEIGHT 60,HEIGHT(10): LEFT 60,LEFT(10)+WIDTH(10)
WIDTH 60,95
CHECK 61: PARENT 61,60: TOP 61,0: LEFT 61,0: CAPTION 61,"Carré/Cercle"
CHECK 62: PARENT 62,60: TOP 62,15: LEFT 62,0: CAPTION 62,"Rebouclage"

' Palette
CONTAINER 20: LEFT 20,LEFT(60)+WIDTH(60)+0: HEIGHT 20,22: TOP 20,TOP(10)+6: WIDTH 20,125
PICTURE 21: PARENT 21,20: TOP 21,1: WIDTH 21,25: HEIGHT 21,22: COLOR 21,0,0,0
PICTURE 22: PARENT 22,20: TOP 22,TOP(21): LEFT 22,32: WIDTH 22,90: HEIGHT 22,HEIGHT(21)
2D_TARGET_IS 22
2D_PEN_COLOR 0,0,0: 2D_FILL_COLOR 0,0,0: 2D_RECTANGLE 0,0,15,22
2D_PEN_COLOR 255,255,255: 2D_FILL_COLOR 255,255,255: 2D_RECTANGLE 15,0,30,22
2D_PEN_COLOR 255,0,0: 2D_FILL_COLOR 255,0,0: 2D_RECTANGLE 30,0,45,22
2D_PEN_COLOR 0,255,0: 2D_FILL_COLOR 0,255,0: 2D_RECTANGLE 45,0,60,22
2D_PEN_COLOR 0,0,255: 2D_FILL_COLOR 0,0,255: 2D_RECTANGLE 60,0,75,22
2D_PEN_COLOR 255,255,0: 2D_FILL_COLOR 255,255,0: 2D_RECTANGLE 75,0,90,22
ON_CLICK 22,Couleur
' Épaisseur du trait
ALPHA 30: TOP 30,TOP(20)+5: LEFT 30,LEFT(20)+130: CAPTION 30,"Trait:"
SPIN 31: TOP 31,TOP(30)-4: LEFT 31,LEFT(30)+35: WIDTH 31,40
MIN 31,1: MAX 31,20: POSITION 31,1

BUTTON 40: TOP 40,TOP(31): LEFT 40,LEFT(31)+50: HEIGHT 40,23: WIDTH 40,20
BUTTON 41: TOP 41,TOP(40): LEFT 41,LEFT(40)+20: HEIGHT 41,23: WIDTH 41,20
BUTTON 42: TOP 42,TOP(40): LEFT 42,LEFT(41)+20: HEIGHT 42,23: WIDTH 42,20
BUTTON 43: TOP 43,TOP(40): LEFT 43,LEFT(42)+20: HEIGHT 43,23: WIDTH 43,20
BUTTON 44: TOP 44,TOP(40): LEFT 44,LEFT(43)+20: HEIGHT 44,23: WIDTH 44,20
BUTTON 45: TOP 45,TOP(40): LEFT 45,LEFT(44)+20: HEIGHT 45,23: WIDTH 45,20
FOR i%=40 TO 45
FONT_NAME i%,"Wingdings": CAPTION i%,CHR$(191+i%): ON_CLICK i%,Deplacer
NEXT i%
CAPTION 44,CHR$(229): CAPTION 45,CHR$(228)
SPIN 46: TOP 46,TOP(40): LEFT 46,LEFT(45)+20: WIDTH 46,40: POSITION 46,5: MIN 46,1: MAX 46,50
ALPHA 47: TOP 47,TOP(30): LEFT 47,LEFT(46)+40: CAPTION 47,"pix."
BUTTON 48: TOP 48,TOP(40): LEFT 48,LEFT(46)+60: WIDTH 48,85: HEIGHT 48,23: CAPTION 48,"Annul dernier"
ON_CLICK 48,Annuler
BUTTON 49: TOP 49,TOP(48): LEFT 49,LEFT(48)+WIDTH(48): HEIGHT 49,23: WIDTH 49,65: CAPTION 49,"RAZ tout"
ON_CLICK 49,Raztou
BUTTON 50: TOP 50,TOP(48): WIDTH 50,57: LEFT 50,WIDTH(0)-73: HEIGHT 50,23: CAPTION 50,"Fichier"
ON_CLICK 50,SauvRest
LIST 51: TOP 51,TOP(50)+25: WIDTH 51,WIDTH(50)+50: LEFT 51,LEFT(50)-50: HEIGHT 51,50
COLOR 51,255,255,128: HIDE 51
ITEM_ADD 51,"Ouvrir: JPG, BMP": ITEM_ADD 51,"Enregistrer: BMP": ITEM_ADD 51,"Quitter"
ON_CLICK 51,SauvRest1
OPEN_DIALOG 55: FILTER 55,"fichier image BMP ou JPG|*.bmp*.jpg"
SAVE_DIALOG 56: FILTER 56,"fichier image .BMP|*.bmp"
IMAGE 57

2D_TARGET_IS p%: DLL_ON mm$
coord$ = STRING$(8," ")
btn = DLL_CALL1("GetMouseXY",ADR(coord$)): ' état boutons et coordonnées souris
WHILE btn<>2: ' Boucle d'attente de clic dans la surface de dessin
xd% = VAL(LEFT$(coord$,4))-ofx: yd% = VAL(RIGHT$(coord$,4))-ofy
IF xd%>=0 AND yd%>=0 AND xd%<wp% AND yd%<hp%
CAPTION 0,"x= "+STR$(xd%)+" y= "+STR$(yd%)
btn = DLL_CALL1("GetMouseXY",ADR(coord$))
IF btn=1: ' bouton gauche enfoncé
GOSUB Dessiner
END_IF
ELSE
btn = DLL_CALL1("GetMouseXY",ADR(coord$))
END_IF
PAUSE 100
END_WHILE
END
' ==============================================================================
Quit:
TERMINATE
' ==============================================================================
Type:
' Type de dessin: libre, rectangle, cercle/ellipse, ou autre (à voir)...
FOR i% = 11 TO 20
IF CHECKED(i%)=1 THEN typ = i%-11: EXIT_FOR
NEXT i%
SELECT typ
CASE 0: 2D_PEN_SOLID: 2D_PEN_WIDTH POSITION(31): ' tracé libre
CASE 1: 2D_PEN_DOT: 2D_PEN_WIDTH 1: 2D_PEN_COLOR 0,0,255: ' Trait
CASE 2: 2D_PEN_DOT: 2D_PEN_WIDTH 1: 2D_PEN_COLOR 0,0,255: ' Rectangle
CASE 3: 2D_PEN_DOT: 2D_PEN_WIDTH 1: 2D_PEN_COLOR 0,0,255: ' Ellipse
CASE 4: ' Remplir
CASE 5: ' Coller
END_SELECT
RETURN
' ==============================================================================
Couleur:
' Couleur du tracé
x%=MOUSE_X_POSITION(22): y%=MOUSE_Y_POSITION(22)
r%=COLOR_PIXEL_RED(22,x%,y%): g%=COLOR_PIXEL_GREEN(22,x%,y%): b%=COLOR_PIXEL_BLUE(22,x%,y%)
COLOR 21,r%,g%,b%: 2D_PEN_COLOR r%,g%,b%
RETURN
' ==============================================================================
Dessiner:
ofx = LEFT(0)+LEFT(p%)+8: ofy = TOP(0)+TOP(p%)+30
xd%=VAL(LEFT$(coord$,4))-ofx: yd% = VAL(RIGHT$(coord$,4))-ofy
xa%=xd%: ya%=yd%: x1%=xd%: y1%=yd%
btn = 1
IF typ = 5
FILE_SAVE p%,ftmp$
CLIPBOARD_PASTE 57: 2D_IMAGE_PASTE 57,xd%,yd%: RETURN
END_IF
CLIPBOARD_COPY p%
WHILE btn = 1
btn = DLL_CALL1("GetMouseXY",ADR(coord$))
x%=VAL(LEFT$(coord$,4))-ofx: y% = VAL(RIGHT$(coord$,4))-ofy
IF x%<0 OR y%<0 OR x%>WIDTH(p%) OR y%>HEIGHT(p%) THEN GOTO ign
CAPTION 0,"x= "+STR$(x%)+" y= "+STR$(y%)
IF x%<>x1% OR y%<>y1%
SELECT typ
2D_PEN_COLOR 0,0,0
CASE 0: ' tracé libre
2D_PEN_COLOR r%,g%,b%
2D_PEN_WIDTH POSITION(31): 2D_LINE x1%,y1%,x%,y%
CASE 1: ' trait
CLIPBOARD_PASTE p%: 2D_LINE xd%,yd%,x%,y%
CASE 2: ' rectangle/carré
CLIPBOARD_PASTE p%
IF CHECKED(61) = 1 THEN y% = yd%+x%-xd%: ' carré
2D_LINE xd%,yd%,x%,yd%: 2D_POLY_TO x%,y%: 2D_POLY_TO xd%,y%
2D_POLY_TO xd%,yd%
CASE 3: ' ellipse/cercle
CLIPBOARD_PASTE p%
rx%=(x%-xd%)/2: ry%=(y%-yd%)/2
IF CHECKED(61)=1 THEN ry%=rx%
xc%=xd%+rx%: yc%=yd%+ry%
2D_POLY_FROM xc%+rx%,yc%
FOR t=0 TO 2*pi STEP pi/180
2D_POLY_TO xc%+rx%*COS(t),yc%+ry%*SIN(t)
NEXT t
CASE 4: ' remplir

END_SELECT
x1%=x%: y1%=y%
END_IF
ign:
PAUSE 50
END_WHILE
' bouton gauche relâché: tracé définitif
IF typ = 0
IF CHECKED(62)=1 THEN 2D_LINE x%,y%,xa%,ya%: ' rebouclage tracé libre
ELSE
CLIPBOARD_PASTE p%: 2D_PEN_SOLID: 2D_PEN_WIDTH POSITION(31): 2D_PEN_COLOR r%,g%,b%
xa%=xd%: ya%=yd%: xf%=x%: yf%=y%
SELECT typ
CASE 1: GOSUB Destrait: ' trait
CASE 2: GOSUB Desrec: ' rectangle/carré
CASE 3: GOSUB Desell: ' ellipse/cercle
CASE 4: 2D_FLOOD xa%,ya%,r%,g%,b%: ' remplir
END_SELECT
2D_PEN_WIDTH 1: 2D_PEN_DOT: 2D_PEN_COLOR 0,0,255
END_IF
RETURN
' ==============================================================================
Destrait:
2D_LINE xa%,ya%,xf%,yf%
RETURN
' ==============================================================================
Desrec:
IF CHECKED(61) = 1 THEN yf% = yd%+xf%-xd%
2D_LINE xa%,ya%,xf%,ya%: 2D_POLY_TO xf%,yf%: 2D_POLY_TO xa%,yf%: 2D_POLY_TO xa%,ya%
RETURN
' ==============================================================================
Desell:
rx%=(xf%-xa%)/2: ry%=(yf%-ya%)/2
IF CHECKED(61)=1 THEN ry%=rx%
xc%=xa%+rx%: yc%=ya%+ry%
2D_POLY_FROM xc%+rx%,yc%
FOR t=0 TO 2*pi STEP pi/180
2D_POLY_TO xc%+rx%*COS(t),yc%+ry%*SIN(t)
NEXT t
RETURN
' ==============================================================================
Deplacer:
IF typ = 0 THEN RETURN: ' (tracé libre, non déplaçable)
i% = NUMBER_CLICK: j% = POSITION(46)
SELECT i%
CASE 40: xa%=xa%-j%: xf%=xf%-j%: ' gauche
CASE 41: xa%=xa%+j%: xf%=xf%+j%: ' droite
CASE 42: ya%=ya%-j%: yf%=yf%-j%: ' haut
CASE 43: ya%=ya%+j%: yf%=yf%+j%: ' bas
CASE 44: xf%=xf%-j%: yf%=yf%-j%: ' diminuer
CASE 45: xf%=xf%+j%: yf%=yf%+j%: ' augmenter
END_SELECT
CLIPBOARD_PASTE p%: 2D_PEN_SOLID: 2D_PEN_WIDTH POSITION(31): 2D_PEN_COLOR r%,g%,b%
SELECT typ
CASE 1: GOSUB Destrait
CASE 2: GOSUB Desrec
CASE 3: GOSUB Desell
END_SELECT
2D_PEN_WIDTH 1: 2D_PEN_DOT: 2D_PEN_COLOR 0,0,255
RETURN
' ==============================================================================
Annuler:
IF typ=5: ' coller
FILE_LOAD p%,ftmp$
ELSE
CLIPBOARD_PASTE p%: ' retour à l'état précédent
END_IF
RETURN
' ==============================================================================
SauvRest:
SHOW 51
RETURN
SauvRest1:
i% = ITEM_INDEX(51)
SELECT i%
CASE 1: ' Ouvrir
f$ = FILE_NAME$(55)
IF LEN(f$)<5 THEN HIDE 51: RETURN
IF UPPER$(RIGHT$(f$,4))<>".BMP" OR UPPER$(RIGHT$(f$,4))<>".JPG"
MESSAGE "Format non BMP ou JPG !"+CHR$(13)+"Chargement ignoré."
ELSE
FILE_SAVE p%,f$
END_IF
CASE 2: ' Enregistrer
f$ = FILE_NAME$(56)
IF LEN(f$)<5 THEN HIDE 51: RETURN
IF UPPER$(RIGHT$(f$,4))<>".BMP"
MESSAGE "Format non BMP !"+CHR$(13)+"Sauvegarde annulée."
ELSE
FILE_SAVE p%,f$
END_IF
CASE 3: ' Quitter
TERMINATE
END_SELECT
HIDE 51
RETURN
' ==============================================================================
Raztou:
' Effacement total
i%=MESSAGE_CONFIRMATION_YES_NO("Effacer totalement le dessin ?")
IF i% = 1
2D_FILL_COLOR 255,255,255: CLS: 2D_FILL_COLOR r%,g%,b%
END_IF
RETURN
' ==============================================================================

Edit 24/02: précision sur les formats de lecture et sauvegarde (bouton Fichier), et correction dans la fonction RAZ qui mettait parfois une couleur farfelue.

D’accord pour la spirale ; ce n’est pas top du top.
Mais que dis-tu des rectangles/carrés à coins arrondis ?
Si tu veux incorporer ce type de figures, voici un code suffisamment documenté pour faire des jolies objets.
Sinon, ça sera une Sub de plus à mettre où on veut (sous le coude, sur le bureau, dans la poubelle, etc..)

Code:: rem ============================================================================
rem Superellipse
rem Equation de Lamé
rem Par Papydall
rem ============================================================================
rem Les courbes de Lamé (ou superellipses) sont définies par leur équation cartésienne
rem sous la forme : (abs(x/a))^n + (abs(y/b))^n = 1
rem Pour le tracé de ces types de fonctions, on utilise plutôt la forme paramétrique
rem beaucoup plus facile à manipuler:
rem x(t) = ± a*(cos(t)^2/n
rem y(t) = ± a*(sin(t)^2/n
rem avec t : angle en radian variant entre 0 et pi/2
rem Dans la sub ci-dessus, elle se présente sous la forme Panoramicienne :
rem x = r*a*power(abs(cos(t)),2/n)*sgn(cos(t))
rem y = r*b*power(abs(sin(t)),2/n)*sgn(sin(t))
rem ============================================================================
dim x,y,xc,yc,n,pi,pas
pi = acos(-1) : pas = pi/180
xc = width(0)/2 : yc = height(0)/2 -20

Superellipse(1,1,10,100) : ' supercercle qui tend vers un carré
' Superellipse(1,.5,20,200) : ' superellipse large qui tend vers un rectangle large
' Superellipse(0.5,1,4,200) : ' superellipse haute qui tend vers un rectangle haut
' Superellipse(1,1,1/2,200)
' for n = 0.25 to 8 step 0.25 : Superellipse(1,1,n,200) : next n

end
rem ============================================================================
' a et b : paramètres agissant respectivement sur les rayons horizontal et vertical
' Si a = b : c'est un supercercle
' Si a > b : c'est une superellipse large
' Si a < b : c'est une superellipse haute
' Pour des grandes valeurs de n ça tend vers le rectangle/carré

SUB Superellipse(a,b,n,r)
   dim_local t
' Calcul des coordonnées du début du tracé
   x = r*a*power(abs(cos(t)),2/n)*sgn(cos(t)) : ' abscisse x
   y = r*b*power(abs(sin(t)),2/n)*sgn(sin(t)) : ' ordonné y
   2d_poly_from xc+ x,yc+y
' Le tracé proprement dit
   for t = 0 to 2*pi + pas step pas
   x = r*a*power(abs(cos(t)),2/n)*sgn(cos(t))
   y = r*b*power(abs(sin(t)),2/n)*sgn(sin(t))
   2d_poly_to xc + x,yc + y
   next t
END_SUB
rem ============================================================================

Nombre de messages : 598 Date d'inscription : 06/01/2012

Bonjour ! quelle est donc cette DLL à ajuster ?

JL35 dans son 1er message ( relis-le si tu veux!) a écrit:: (la dll est disponible ici, chez Nardo: http://nardo26.lescigales.org/divers-dll-28.html ).

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

Le terme 'à ajuster' est sans doute mal choisi, c'est son chemin qui est à ajuster. Il faut donc la télécharger et la mettre quelque part chez soi en indiquant son adresse.

D'accord papydall, on peut faire plein de dessins préfabriqués de toutes sortes (j'ai les subs à peu près pour tout), mais au départ je voulais faire quelque chose de simple, une base de départ pour que chacun l'accommode à sa façon. Ce qui est toujours valable, y compris avec l'incorporation de tes subs.
Mais il faudra revoir la partie menu qui sera plus conséquente.

Ton programme enregistrant exclusivement au format *.bmp,
je te propose ceci comme label de sauvegarde :

Code:: Sauve:
f$ = FILE_NAME$(51)
IF LEN(f$)<5 THEN RETURN
IF UPPER$(RIGHT$(f$,4))<>".BMP"
if instr(f$,".")>1
f$=left$(f$,instr(f$,".")-1)
end_if
f$=f$+".bmp"
FILE_SAVE p%,f$
END_IF
RETURN

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

Eh bien ygeronimi... je ne suis pas trop d'accord !
En effet l'utilisateur donne un nom de fichier image avec un type de format incorrect (par exemple jpg), et toi tu changes subrepticement l'extension en bmp sans le prévenir, ce qui fait qu'il croit avoir écrit un fichier jpg.
Je préfère comme j'ai fait, lui signaler le fait, et qu'il choisisse lui-même un autre nom de fichier, plus convenable.

J'aurais bien aimé avoir d'autre formats, mais, contrainte Panoramic en écriture.
D'un autre côté, pour des dessins au trait comme ici, bmp est plus approprié, sans compression (mais bien plus gros).

Il te suffit de mettre "Save to *.bmp" en caption du bouton
au lieu de "Enregistrer".
De toute façon, tu ne peux pas l' enregistrer sous un autre format... Wink

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

Et de toute façon il n'a pas le choix, il faudra bien qu'il m'obéisse ! (et je n'ai pas le choix moi non plus Smile

)
ET puis je ne veux pas mettre de l'anglais sur mes boutons, na ! Evil or Very Mad

Bon, ben en français alors..." Enregistrer sous *.bmp"
Laughing

Nombre de messages : 598 Date d'inscription : 06/01/2012

Me revoilou. Merci pour le lien sur la page de Nardo26 que je ne connaissais effectivement pas. Maintenant le logiciel fonctionne ! Je rêve d'en écrire un comme ça, mais il me faudrait une deuxième vie rien que pour ça, et celle que j'ai est déjà bien comme ça.

Bonne journée !!!

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

@ygeronimi, pour te faire plaisir, j'ai ajouté (dans la dernière version page précédente) les précisions de format pour le bouton Fichier (jpg+bmp en lecture, bmp en écriture).
J'ai aussi corrigé la fonction 'Raz tout' qui effaçait parfois avec une couleur inattendue.

@Froggy, sympa, mais ce n'est pas si difficile que ça. Le plus difficile, en tout cas ce dont je suis le plus content, c'est le dessin en pointillés en temps réel, c'est spectaculaire et on voit bien ce qu'on fait.
Mais, même si ça peut être utilisé tel quel, c'est une base pour des améliorations personnelles, et qui sait, ça peut te donner des idées pour t'en faire un perso, changer les dimensions des objets, rajouter des fonctions, etc., que tu ne manquerais pas de nous montrer, c'est tout ce que je souhaite.

» Dessin 2d
» Dessin sur A4
» Dessin
» Dessin d'arc
» Dessin INDUSTRIEL animé