Canva avec forme personnalisable

Vous avez une idée pour améliorer ou modifier PureBasic ? N'hésitez pas à la proposer.
kwandjeen
Messages : 204
Inscription : dim. 16/juil./2006 21:44

Re: Canva avec forme personnalisable

Message par kwandjeen »

Petite procédure pour savoir si l'on est dans un cercle

Code : Tout sélectionner

 
Procedure is_inside_circle(*m.point,*c.point,rayon)
    distance = Sqr(Pow((*c\x - *m\x),2) + Pow((*c\y - *m\y),2))
    If distance<=rayon
      ProcedureReturn 1
    EndIf
    ProcedureReturn 0
EndProcedure

h\x = mousex ;position x de la souris
h\y = mousey ;position y de la souris
a\x = \centre_x ;du cercle
a\y = \centre_y ;du cercle
If is_inside_circle(@h,@a,\tx/2) ;point souris, centre du cercle, rayon du cercle
   debug "sur le cercle"
EndIf
Voilà à vous de l'arranger pour votre programme.

PS : Sherman avait déjà répondu je viens de le voir :)
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Canva avec forme personnalisable

Message par falsam »

Distance entres deux points.

Code : Tout sélectionner

;Distance entres deux points (2D)
Procedure.d Distance(*p.Point, *q.Point)
  Protected Distance.d, dx.d, dy.d
  
  ;Distance horizontale
  dx = *p\x - *q\x   
  
  ;Distance verticale
  dy = *p\y - *q\y
  
  ;Théoréme de Pythagore
  Distance.d = Sqr(dx*dx + dy*dy )
  
  ProcedureReturn Distance
EndProcedure

;Définition du point A (Par exemple le centre du cercle)
A.point 
A\x = 3
A\y = 2

;Définition du point B (Par exemple les coordonnées de la souris )
B.point 
B\x = 7
B\y = 8

Debug "Distance entre A et B " + Distance(A, B)
■ Mise en pratique avec ce code.

Code : Tout sélectionner

EnableExplicit

Global Button.point, Radius = 40
Button\x = 50
Button\y = 50

;Plan de l'application
Declare   Start()
Declare   onEnter()
Declare.d Distance(*p.Point, *q.Point) 
Declare   Exit()

Start()

Procedure Start()
  OpenWindow(0, 0, 0, 800, 600, "Test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  
  CanvasGadget(0, 100, 100, 100, 100)
  StartDrawing(CanvasOutput(0))
  With Button
    Circle(\x, \y, Radius, RGB(50, 205, 50))
  EndWith
  StopDrawing()
  
  ;Triggers
  BindEvent(#PB_Event_CloseWindow, @Exit())
  BindGadgetEvent(0, @onEnter())
  
  Repeat : WaitWindowEvent() : ForEver
EndProcedure

Procedure onEnter()
  Protected mouse.point 
  
  mouse\x = GetGadgetAttribute(0, #PB_Canvas_MouseX)
  mouse\y = GetGadgetAttribute(0, #PB_Canvas_MouseY)
  
  If Distance(Mouse, Button) <= Radius
    Debug "dans le cercle"
  EndIf  
EndProcedure

;Distance entres deux points (2D)
Procedure.d Distance(*p.Point, *q.Point)
  Protected Distance.d, dx.d, dy.d
  
  ;Distance horizontale
  dx = *p\x - *q\x   
  
  ;Distance verticale
  dy = *p\y - *q\y
  
  ;Théoréme de Pythagore
  Distance = Sqr(dx*dx + dy*dy )
  
  ProcedureReturn Distance
EndProcedure

Procedure Exit()  
  End
EndProcedure
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
GallyHC
Messages : 1703
Inscription : lun. 17/déc./2007 12:44

Re: Canva avec forme personnalisable

Message par GallyHC »

Bonjour

J'ai repris le code de Falsam et adapter pour un triangle.

Code : Tout sélectionner

EnableExplicit

Global Dim triangle.Point(3)

triangle(0)\x = 50
triangle(0)\y = 10
triangle(1)\x = 10
triangle(1)\y = 90
triangle(2)\x = 90
triangle(2)\y = 90

;Plan de l'application
Declare   Start()
Declare   onEnter()
Declare.i GetInTriangle(Array triangle.Point(1), *point.Point)
Declare   Exit()

Start()

Procedure Start()
  OpenWindow(0, 0, 0, 800, 600, "Test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  
  CanvasGadget(0, 100, 100, 100, 100)
  StartDrawing(CanvasOutput(0))
    LineXY(triangle(0)\x, triangle(0)\y, triangle(1)\x, triangle(1)\y, $00ff00)
    LineXY(triangle(1)\x, triangle(1)\y, triangle(2)\x, triangle(2)\y, $00ff00)
    LineXY(triangle(2)\x, triangle(2)\y, triangle(0)\x, triangle(0)\y, $00ff00)
    FillArea(triangle(0)\x, triangle(0)\x + 5, $00ff00, $00ff00)
  StopDrawing()
  
  ;Triggers
  BindEvent(#PB_Event_CloseWindow, @Exit())
  BindGadgetEvent(0, @onEnter())
  
  Repeat : WaitWindowEvent() : ForEver
EndProcedure

Procedure onEnter()
  Protected mouse.point 
  
  mouse\x = GetGadgetAttribute(0, #PB_Canvas_MouseX)
  mouse\y = GetGadgetAttribute(0, #PB_Canvas_MouseY)
  
  If GetInTriangle(triangle(), mouse)
    Debug "dans le triangle"
  EndIf  
EndProcedure

; Savoir si la souris est dans un triangle.
Procedure.i GetInTriangle(Array triangle.Point(1), *point.Point)
;
  Protected.b bresult = #False
  Protected.i xu1, xu2, xu3, yu1, yu2, yu3
  Protected.i ax1, ax2, ax3, c1, c2, c3, p1, p2, p3
  ;
  If ArraySize(triangle()) = 3
    ;
    xu1 = triangle(1)\x - triangle(0)\x
    yu1 = triangle(1)\y - triangle(0)\y
    c1  = triangle(0)\y * xu1 - triangle(0)\x * yu1
    P1  = triangle(2)\x * yu1 - triangle(2)\y * xu1 + c1
    ax1 = *point\x * yu1 - *point\y * xu1 + c1
    ;
    xu2 = triangle(2)\x - triangle(1)\x
    yu2 = triangle(2)\y - triangle(1)\y
    c2  = triangle(1)\y * xu2 - triangle(1)\x * yu2
    P2  = triangle(0)\x * yu2 - triangle(0)\y * xu2 + c2
    ax2 = *point\x * yu2 - *point\y * xu2 + c2
    ;
    xu3 = triangle(0)\x-triangle(2)\x
    yu3 = triangle(0)\y-triangle(2)\y
    c3  = triangle(2)\y * xu3 - triangle(2)\x * yu3
    P3  = triangle(1)\x * yu3 - triangle(1)\y * xu3 + c3
    ax3 = *point\x * yu3 - *point\y * xu3 + c3
    ;
    If Sign(ax1) = Sign(P1) And Sign(ax2) = Sign(P2) And Sign(ax3) = Sign(P3)
      bresult = #True
    EndIf
  EndIf
  ;
  ProcedureReturn bresult

EndProcedure


Procedure Exit()  
  End
EndProcedure
Configuration : Tower: Windows 10 (Processeur: i7 "x64") (Mémoire: 16Go) (GeForce GTX 760 - 2Go) - PureBasic 5.72 (x86 et x64)
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Canva avec forme personnalisable

Message par Micoute »

C'est très bon ça, merci pour le partage.
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.73 PB 6.00 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Canva avec forme personnalisable

Message par falsam »

Joli Gally. :wink:
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
Ar-S
Messages : 9472
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Canva avec forme personnalisable

Message par Ar-S »

Je reviens sur les couleurs mais c'est tellement plus simple..
Et ça marchera sur toutes les formes.
Certes il faut que les couleurs du bouton diffèrent du fond mais c'est bien le but lorsqu'on veut simuler un bouton non carré...

Code : Tout sélectionner


Declare   Start()
Declare   onEnter()
Declare   Exit()

Start()

Procedure Start()
  OpenWindow(0, 0, 0, 800, 600, "Test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
 
  CanvasGadget(0, 100, 100, 100, 100)
  StartDrawing(CanvasOutput(0))
    LineXY(50, 10, 10, 90, $00ff00)
    LineXY(10, 90, 90, 90, $00ff00)
    LineXY(90, 90, 50, 10, $00ff00)
    FillArea(50, 50 + 5, $00ff00, $00ff00)

  StopDrawing()
 
  ;Triggers
  BindEvent(#PB_Event_CloseWindow, @Exit())
  BindGadgetEvent(0, @onEnter())
 
  Repeat : WaitWindowEvent() : ForEver
EndProcedure

Procedure onEnter()
  
If EventType() <> #PB_EventType_MouseLeave
  StartDrawing(CanvasOutput(0))
  Mx = GetGadgetAttribute(0, #PB_Canvas_MouseX)
  My = GetGadgetAttribute(0, #PB_Canvas_MouseY)
  COL = Point(Mx,My)
  
  If COL = $00ff00
    Debug "dans le triangle"
  Else
    Debug "hors triangle"
  EndIf 
  StopDrawing()
EndIf

EndProcedure


Procedure Exit() 
  End
EndProcedure
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Avatar de l’utilisateur
GallyHC
Messages : 1703
Inscription : lun. 17/déc./2007 12:44

Re: Canva avec forme personnalisable

Message par GallyHC »

@Ar-S > oui une détection par détection de couleur peut être utile aussi. Au moins, cela ajoute un exemple de plus et une autre méthode, même si chaque méthode a ses limites ou ses propres contre-indications.

Cordialement,
GallyHC
Configuration : Tower: Windows 10 (Processeur: i7 "x64") (Mémoire: 16Go) (GeForce GTX 760 - 2Go) - PureBasic 5.72 (x86 et x64)
Shadow
Messages : 1373
Inscription : mer. 04/nov./2015 17:39

Re: Canva avec forme personnalisable

Message par Shadow »

Merci pour ces nombreux exemples :)
Processeur: Intel Core I7-4790 - 4 Cœurs - 8 Thread: 3.60 Ghz.
Ram: 32 GB.
Disque: C: SDD 250 GB, D: 3 TB.
Vidéo: NVIDIA GeForce GTX 960: 2 GB DDR5.
Écran: Asus VX248 24 Pouces: 1920 x 1080.
Système: Windows 7 64 Bits.

PureBasic: 5.60 x64 Bits.
Avatar de l’utilisateur
microdevweb
Messages : 1798
Inscription : mer. 29/juin/2011 14:11
Localisation : Belgique

Re: Canva avec forme personnalisable

Message par microdevweb »

Petit exemple d'un simple rond.

Esc pour quitter

Windows only

Code : Tout sélectionner

Procedure Exit()
  CloseWindow(0)
  End
EndProcedure
Procedure Open()
    Protected w,h
    
    OpenWindow(0,0,0,800,600,"MainForm",#PB_Window_BorderLess|#PB_Window_ScreenCentered|#PB_Window_Maximize)
    w=WindowWidth(0)
    h=WindowHeight(0)
    
    CanvasGadget(0,0,0,w,h,#PB_Canvas_Keyboard|#PB_Canvas_Container)
    SetWindowColor(0,RGB(255,0,0))
    SetWindowLongPtr_(WindowID(0), #GWL_EXSTYLE, #WS_EX_LAYERED | #WS_EX_TOPMOST)
    SetLayeredWindowAttributes_(WindowID(0),RGB(255,0,0),0,#LWA_COLORKEY)
    SmartWindowRefresh(0,#True)
    AddKeyboardShortcut(0,#PB_Shortcut_Escape,1)
    BindEvent(#PB_Event_Menu,@Exit(),0,1)
    
    StartDrawing(CanvasOutput(0))
    Box(0,0,GadgetWidth(0),GadgetHeight(0),RGB(255,0,0))
    Circle(250,250,100,RGB(0,255,0))
    StopDrawing()
  EndProcedure
  Open()
  
  Repeat
    WaitWindowEvent()
  ForEver 
Windows 10 64 bits PB: 5.70 ; 5.72 LST
Work at Centre Spatial de Liège
Répondre