PureBasic

Forums PureBasic
Nous sommes le Dim 19/Mai/2013 12:01

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 7 messages ] 
Auteur Message
 Sujet du message: [Tutos] Box Collision et Sphere Collision
MessagePosté: Mer 01/Déc/2004 21:16 
Hors ligne

Inscription: Mer 21/Jan/2004 17:48
Messages: 4493
Code:
;Comtois 02/12/04
;Mise à jour pour PB4.10 le 30/06/07

;Tut sur les Collisions Sphériques
;l'exemple est en 2D , mais le principe est le même pour la 3D.
;la différence réside dans le calcul de la distance
;en 2D on a Distance=Sqr((x1-x2)²+(y1-y2)²)
;en 3D on a Distance=Sqr((x1-x2)²+(y1-y2)²+(z1-z2)²)
;Avec x1,y1,z1 les coordonnées de la sphere 1
;et  x2,y2,z2 les coordonnées de la sphere 2

;Pour détecter une collision entre deux entitys 3D , il suffit de définir une sphère qui enveloppe chacune des entitys
;et de tester la distance entre les entitys 3D. Bien sûr cette méthode a ses limites .
;Il est très rare d'avoir des entitys de forme sphérique :)
;l'avantage c'est que cette méthode est simple à mettre en oeuvre et elle est rapide (elle nécessite peu de calculs).

;Pour obtenir plus de précision Pour tester des collisions entre entitys ,
;il est possible de définir plusieurs petites sphères qui envelopperont au mieux le volume de chaque entity .
; Par exemple une sphere pour la tête d'un personnage,
; une autre sphere pour le tronc du personnage ,
;une troisième pour les jambes , etc
;en décomposant avec 3 ou 4 spheres il devient possible de détecter quelle partie du corps est touchée .


;-Declare
Declare Erreur(Message$)

;-Initialisation
#ScreenWidth = 800 : #ScreenHeight = 600 : #ScreenDepth = 32
If InitEngine3D() = 0
  Erreur("Impossible d'initialiser la 3D , vérifiez la présence de engine3D.dll")
ElseIf InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse()=0
  Erreur("Impossible d'initialiser DirectX 7 Ou plus")
ElseIf OpenScreen( #ScreenWidth , #ScreenHeight , #ScreenDepth , "" ) = 0
  Erreur("Impossible d'ouvrir l'écran ")
EndIf
Structure Sphere
  x.l
  y.l
  rayon.l
EndStructure
Global Sprite1.Sphere
Global Sprite2.Sphere

;/Sprite 1
Sprite1\x=400
Sprite1\y=300
Sprite1\rayon=60
CreateSprite(1,128,128)
If StartDrawing(SpriteOutput(1))
  Circle(SpriteWidth(1)/2,SpriteHeight(1)/2,Sprite1\rayon,RGB(185,155,255))
  StopDrawing()
EndIf

;/Sprite 2
Sprite2\x=0  ; utilise les coordonnées de la souris
Sprite2\y=0  ; utilise les coordonnées de la souris
Sprite2\rayon=40
CreateSprite(2,82,82)
If StartDrawing(SpriteOutput(2))
  Circle(SpriteWidth(2)/2,SpriteHeight(2)/2,Sprite2\rayon,RGB(55,55,255))
  StopDrawing()
EndIf
;-Procedures
Procedure Erreur(Message$)
  MessageRequester( "Erreur" , Message$ , 0 )
  End
EndProcedure
Procedure.f CalculDistance(x1,y1,x2,y2)
;en 2D Distance=Sqr((x1-x2)²+(y1-y2)²)
;en 3D Distance=Sqr((x1-x2)²+(y1-y2)²+(z1-z2)²)
  Distance.f=Sqr((x1-x2)*(x1-x2)+(y1-y2)*(y1-y2))
  ProcedureReturn Distance
EndProcedure
Procedure AfficheDistance(x1,y1,x2,y2)
  If StartDrawing(ScreenOutput())
    ;Affiche la distance entre la sphère 1 et la sphère 2
    R1=Sprite1\rayon
    R2=Sprite2\rayon
    LineXY(x1,y1,x2,y2,RGB(255,0,0))
    x=(x1+x2)/2
    y=(y1+y2)/2
    FrontColor(RGB(0,155,0))
    BackColor(RGB(255,255,0))
    Distance.f=CalculDistance(x1,y1,x2,y2)
    DrawText(x,y,"d="+StrF(Distance,1))
    ;/Affiche le rayon 1
    DrawText(x1,y1,"R1="+Str(R1))
    ;/Affiche le rayon 2
    DrawText(x2,y2,"R2="+Str(R2))
    ;/Commentaire et collision
    FrontColor(#White)
    BackColor(#Black)
    DrawText(0,0,"Soit 'R1' le rayon de la sphère 1 ,'R2' le rayon de la sphère 2 et 'd' la distance entre la sphère 1 et 2")
    DrawText(0,20,"Il y a collision entre les deux sphères si la Distance 'd' est inférieure à la somme des deux rayons > 'd'<'R1+R2'")   
    If Distance<R1+R2
    t$=" , Il y a collision"
    Else
    t$=" , il n'y a pas de collision"
    EndIf
    DrawText(0,40,"R1 + R2 = "+Str(R1)+" + "+Str(R2)+" = "+Str(R1+R2)+ " ..... et d = "+StrF(Distance,1))
    ;/Collision?
    If Distance<R1+R2
      FrontColor(#Yellow)
      BackColor(#Red)
      t$="Il y a collision !"
    Else
      FrontColor(#Yellow)
      BackColor(#Blue)
      t$="Il n'y a pas de collision"
    EndIf
    DrawText(400-TextWidth(t$)/2,580,t$)
    StopDrawing()
  EndIf
EndProcedure


;- Boucle principale
Repeat
  ClearScreen(0)
  ExamineKeyboard()
  ExamineMouse()
  ;/Affiche le sprite 1
  CentreX1=Sprite1\x+SpriteWidth(1)/2
  Centrey1=Sprite1\y+SpriteHeight(1)/2
  DisplaySprite(1,Sprite1\x,Sprite1\y)
  ;/Affiche le sprite 2 à la position de la souris
  Sprite2\x=MouseX()
  Sprite2\y=MouseY()
  CentreX2=Sprite2\x+SpriteWidth(2)/2
  Centrey2=Sprite2\y+SpriteHeight(2)/2
  DisplayTransparentSprite(2,Sprite2\x,Sprite2\y)
  ;/
  ;Il y a collision si la distance entre la sphere de rayon R1 et la sphere de rayon R2 est < R1+R2
  AfficheDistance(CentreX1,Centrey1,CentreX2,Centrey2)
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)

_________________
http://purebasic.developpez.com/
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.


Dernière édition par comtois le Sam 30/Juin/2007 10:42, édité 2 fois.

Haut
 Profil  
 
 Sujet du message:
MessagePosté: Jeu 02/Déc/2004 17:26 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 26/Mai/2004 0:33
Messages: 684
Salut Comtois , Trés bien ce petit cours ;)

_________________
http://garzul.tonsite.biz

Ancien site PB :
http://www.garzul.ca.cx


Haut
 Profil  
 
 Sujet du message: Nouveau Tut >> Box Collision
MessagePosté: Sam 04/Déc/2004 11:41 
Hors ligne

Inscription: Mer 21/Jan/2004 17:48
Messages: 4493
Voila un nouveau tut , les Box collisions

Code:
;Comtois 03/12/04
;Tut sur les Box Collisions
;l'exemple est en 2D , mais le principe est le même pour la 3D.
;la différence réside dans le test de l'encadrement
;en 2D on a collision si xa2>xb1 And xa1<xb2 And ya2>yb1 And ya1<yb2
;en 3D on a collision si xa2>xb1 And xa1<xb2 And ya2>yb1 And ya1<yb2 And za2>zb1 And za1<zb2
;Avec xa1,ya1,za1 les coordonnées du coin haut gauche de la box A
;et   xa2,ya2,za2 les coordonnées du coin bas droit de la box A

;un petit dessin pour une box 2D

  ; xa1/ya1 _________xa2/ya1
  ;        |         |
  ;        |         |
  ;        |         |
  ;        |         |
  ;        |         |
  ; xa1/ya2|_________|xa2/ya2

;En 3d cette méthode fonctionne dans la mesure où il n'y a pas rotation sur les box.
;Par exemple , Cette méthode peut être utilisée pour un jeu de casse briques 3D ou encore dans un space invaders 3D.

;-Declare
Declare Erreur(Message$)

;-Initialisation
#ScreenWidth = 800 : #ScreenHeight = 600 : #ScreenDepth = 32
If InitEngine3D() = 0
  Erreur("Impossible d'initialiser la 3D , vérifiez la présence de engine3D.dll")
ElseIf InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse()=0
  Erreur("Impossible d'initialiser DirectX 7 Ou plus")
ElseIf OpenScreen( #ScreenWidth , #ScreenHeight , #ScreenDepth , "" ) = 0
  Erreur("Impossible d'ouvrir l'écran ")
EndIf
Structure Zone
  x.l
  y.l
  Largeur.l
  Hauteur.l
EndStructure 
Global Sprite1.point
Global Sprite2.point 

;/Sprite 1
Sprite1\x=400
Sprite1\y=300
CreateSprite(1,128,128)
If StartDrawing(SpriteOutput(1))
  Box(0,0,SpriteWidth(1),SpriteHeight(1),RGB(185,155,255))
  StopDrawing()
EndIf 

;/Sprite 2
Sprite2\x=0  ; utilise les coordonnées de la souris
Sprite2\y=0  ; utilise les coordonnées de la souris
CreateSprite(2,82,82)
If StartDrawing(SpriteOutput(2))
  Box(0,0,SpriteWidth(2),SpriteHeight(2),RGB(55,55,255))
  StopDrawing()
EndIf

;-Procedures
Procedure Erreur(Message$)
  MessageRequester( "Erreur" , Message$ , 0 )
  End
EndProcedure
Procedure BoxCollision(NoA,xa1,ya1,NoB,xb1,yb1)
  ;NoA = No du sprite 1
  ;xa1,ya1 = coordonnées du sprite 1
  ;NoB = No du sprite 2
  ;xb1,yb1 = coordonnées du sprite 2
  ;C'est la même chose que la fonction purebasic SpriteCollision() ,
  ;ça pourrait être ImageCollision() d'ailleurs , il suffit de remplacer sprite par image dans le code qui suit.
  ;Si on a besoin de connaître l'étendue de la zone touchée , il faut utiliser la procédure ZoneBoxCollision()
  Collision=#False
  xa2=xa1+SpriteWidth(NoA)
  ya2=ya1+SpriteHeight(NoA)
  xb2=xb1+SpriteWidth(NoB)
  yb2=yb1+SpriteHeight(NoB)
  ;En 3D il faut ajouter  And za2>zb1 And za1<zb2
  If xa2>xb1 And xa1<xb2 And ya2>yb1 And ya1<yb2
    Collision=#True
  EndIf
  ProcedureReturn Collision
EndProcedure
Procedure ZoneBoxCollision(*Zone.Zone,NoA,xa1,ya1,NoB,xb1,yb1)
  ;C'est la même chose que la procédure BoxCollision ,
  ;sauf qu'en plus on récupère dans "Zone" les valeurs de la zone en collision
  Collision=#False
  xa2=xa1+SpriteWidth(NoA)
  ya2=ya1+SpriteHeight(NoA)
  xb2=xb1+SpriteWidth(NoB)
  yb2=yb1+SpriteHeight(NoB)
  ;En 3D il faut ajouter  And za2>zb1 And za1<zb2
  If xa2>xb1 And xa1<xb2 And ya2>yb1 And ya1<yb2
    Collision=#True
    ;/Zone en collision
    MinX=xa1 : MaxX=xa2
    If xa1<xb1: MinX=xb1 : EndIf
    If xa2>xb2 : MaxX=xb2 : EndIf
    MinY=ya1 : MaxY=ya2
    If ya1<yb1 : MinY=yb1 : EndIf
    If ya2>yb2 : MaxY=yb2 : EndIf 
    *Zone\x=MinX : *Zone\y=MinY
    *Zone\Largeur=MaxX-MinX
    *Zone\Hauteur=MaxY-MinY
  EndIf
  ProcedureReturn Collision
EndProcedure 
Procedure AfficheInfos()
  If StartDrawing(ScreenOutput())
    FrontColor(255,255,0)
    BackColor(0,0,0)
    ;Si on a pas besoin de connaitre l"étendue de la zone en collision , BoxCollision(xa1,ya1,2,xb1,yb1) suffit
    If ZoneBoxCollision(@i.Zone,1,Sprite1\x,Sprite1\y,2,Sprite2\x,Sprite2\y)
      t$="Collision"
      ;/Affiche la zone en collision
      Box(i\x,i\y,i\Largeur,i\Hauteur,RGB(255,0,0))
    Else
      t$="Pas de collision"
    EndIf
    Locate(0,0)
    DrawText(t$)
    StopDrawing()
  EndIf
EndProcedure

;- Boucle principale
Repeat
  ClearScreen(0,0,0)
  ExamineKeyboard()
  ExamineMouse()
  ;/Affiche le sprite 1
  DisplaySprite(1,Sprite1\x,Sprite1\y)
  ;/Affiche le sprite 2 à la position de la souris
  Sprite2\x=MouseX()
  Sprite2\y=MouseY()
  DisplayTransparentSprite(2,Sprite2\x,Sprite2\y)
  ;/Test la collision
  AfficheInfos()
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)

_________________
http://purebasic.developpez.com/
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.


Haut
 Profil  
 
 Sujet du message: Collision point avec un triangle
MessagePosté: Dim 06/Fév/2005 0:01 
Hors ligne

Inscription: Mer 21/Jan/2004 17:48
Messages: 4493
Code:
;Comtois 05/02/05
;Détection d'un point dans un triangle

;Update 07/07/07 - PB 4.10

;-Initialisation
Global ScreenHeight.l,ScreenWidth.l
Declare Erreur(Message$)
If ExamineDesktops()
  ScreenWidth = DesktopWidth(0)
  ScreenHeight = DesktopHeight(0)
Else
    Erreur("Euh ?")
EndIf
If InitSprite() = 0 Or InitMouse() = 0 Or InitKeyboard()=0
  Erreur("Impossible d'initialiser DirectX 7 Ou plus")
ElseIf OpenWindow(0,0,0,ScreenWidth,ScreenHeight,"Collision", #PB_Window_BorderLess) = 0
  Erreur("Impossible de créer la fenêtre")
EndIf
;{/ouvre un écran
If OpenWindowedScreen( WindowID(0), 0, 0, ScreenWidth , ScreenHeight, 0, 0, 0 ) = 0
   Erreur("Impossible d'ouvrir l'écran ")
EndIf

Structure Triangle
  X1.l
  Y1.l
  X2.l
  Y2.l
  X3.l
  Y3.l
EndStructure
Procedure Erreur(Message$)
  MessageRequester( "Erreur" , Message$ , 0 )
  End
EndProcedure
Procedure Signe(a.l)
  If a>0
    ProcedureReturn 1
  ElseIf a=0
    ProcedureReturn 0
  Else
    ProcedureReturn -1
  EndIf
EndProcedure

Procedure CollisionTriangle(*T.Triangle,*P.point)
  ;Test la collision du point avec le triangle
  ;pour en savoir plus  http://tanopah.jo.free.fr/seconde/region.html
  ;Plan 1
  xu1=*T\X2-*T\X1:yu1=*T\Y2-*T\Y1
  c1=*T\Y1*xu1-*T\X1*yu1
  P1=*T\X3*yu1-*T\Y3*xu1+c1
  AX1=*P\x*yu1-*P\y*xu1+c1
  ;Plan 2
  xu2=*T\X3-*T\X2:yu2=*T\Y3-*T\Y2
  c2=*T\Y2*xu2-*T\X2*yu2
  P2=*T\X1*yu2-*T\Y1*xu2+c2
  AX2=*P\x*yu2-*P\y*xu2+c2
  ;Plan 3
  xu3=*T\X1-*T\X3:yu3=*T\Y1-*T\Y3
  c3=*T\Y3*xu3-*T\X3*yu3
  P3=*T\X2*yu3-*T\Y2*xu3+c3
  AX3=*P\x*yu3-*P\y*xu3+c3

  If  Signe(AX1)=Signe(P1) And Signe(AX2)=Signe(P2) And Signe(AX3)=Signe(P3)
    Resultat=#True
  EndIf
  ProcedureReturn Resultat
EndProcedure

Procedure AffPoints(*T.Triangle,*P.point,mem)
  StartDrawing(ScreenOutput())
  ;/Affiche le triangle
  Circle(*T\X1,*T\Y1,4,RGB(255,0,0))
  Circle(*T\X2,*T\Y2,4,RGB(255,0,0))
  Circle(*T\X3,*T\Y3,4,RGB(255,0,0))
  LineXY(*T\X1,*T\Y1,*T\X2,*T\Y2,RGB(255,0,0))
  LineXY(*T\X2,*T\Y2,*T\X3,*T\Y3,RGB(255,0,0))
  LineXY(*T\X1,*T\Y1,*T\X3,*T\Y3,RGB(255,0,0))
  ;/Affiche le point
  If mem
    DrawingMode(4)
    Circle(*P\x,*P\y,6,RGB(255,255,255))
  Else
    DrawingMode(0)
    Circle(*P\x,*P\y,4,RGB(255,255,255))
  EndIf
  ;/Affiche une croix pour mieux suivre le déplacement du point
  LineXY(*P\x,0,*P\x,ScreenHeight-1,RGB(255,255,255))
  LineXY(0,*P\y,ScreenWidth-1,*P\y,RGB(255,255,255))
  If CollisionTriangle(*T,*P)
    FrontColor(#Yellow)
    BackColor(#Red)
    texte$="  IN "
  Else
    FrontColor(RGB(155,155,155))
    BackColor(#Green)
    texte$=" OUT "
  EndIf
  DrawText(0,0,texte$)
  StopDrawing()
EndProcedure
Procedure TestPoint(X1,Y1,X2,Y2,d)
  If X1>X2-d And X1<X2+d And Y1>Y2-d And Y1<Y2+d
    Resultat=#True
  EndIf
  ProcedureReturn Resultat
EndProcedure

Triangle.Triangle
Point.point
;Triangle modifiable à la souris
Triangle\X1=50
Triangle\Y1=50
Triangle\X2=200
Triangle\Y2=400
Triangle\X3=730
Triangle\Y3=150
;Point à tester
Point\x=340
Point\y=100
DiametreSelection=6

Repeat
While WindowEvent():Wend
  ClearScreen(0)
  ExamineKeyboard()
  ExamineMouse()
  ;Le triangle est modifiable à la souris en cliquant sur un point
  If MouseButton(1)
    If MemPoint=1
      Triangle\X1=MouseX()
      Triangle\Y1=MouseY()
    ElseIf MemPoint=2
      Triangle\X2=MouseX()
      Triangle\Y2=MouseY()
    ElseIf MemPoint=3
      Triangle\X3=MouseX()
      Triangle\Y3=MouseY()
    EndIf
  Else
    MemPoint=0
  EndIf
    If TestPoint(MouseX(),MouseY(),Triangle\X1,Triangle\Y1,DiametreSelection)
        MemPoint=1
    ElseIf TestPoint(MouseX(),MouseY(),Triangle\X2,Triangle\Y2,DiametreSelection)
      MemPoint=2
    ElseIf TestPoint(MouseX(),MouseY(),Triangle\X3,Triangle\Y3,DiametreSelection)
      MemPoint=3
    EndIf
  ;Place le point à tester sous la souris
  Point\x=MouseX()
  Point\y=MouseY()
  ;Affiche le tout
  AffPoints(@Triangle,@Point,MemPoint)
  FlipBuffers()
  Delay(1)
Until KeyboardPushed(#PB_Key_Escape)


Dernière édition par comtois le Sam 07/Juil/2007 5:15, édité 1 fois.

Haut
 Profil  
 
 Sujet du message: Collision segment/Segment
MessagePosté: Jeu 17/Fév/2005 8:39 
Hors ligne

Inscription: Mer 21/Jan/2004 17:48
Messages: 4493
Code:
;Comtois 16/02/05
;Détection collision d'un segment avec un autre segment
;Mise à jour le 03/09/2010 PB 4.50

;-Initialisation
Global ScreenHeight.l,ScreenWidth.l
Declare Erreur(Message$)
If ExamineDesktops()
  ScreenWidth = DesktopWidth(0)
  ScreenHeight = DesktopHeight(0)
Else
  Erreur("Euh ?")
EndIf
If InitSprite() = 0 Or InitMouse() = 0 Or InitKeyboard()=0
  Erreur("Impossible d'initialiser DirectX 7 Ou plus")
ElseIf OpenWindow(0,0,0,ScreenWidth,ScreenHeight,"Collision",#PB_Window_BorderLess) = 0
  Erreur("Impossible de créer la fenêtre")
EndIf
;{/ouvre un écran
If OpenWindowedScreen( WindowID(0), 0, 0, ScreenWidth , ScreenHeight, 0, 0, 0 ) = 0
  Erreur("Impossible d'ouvrir l'écran ")
EndIf

Structure Segment
  P1.point
  P2.point
EndStructure

Global Box1.Segment,Box2.Segment

Procedure Erreur(Message$)
  MessageRequester( "Erreur" , Message$ , 0 )
  End
EndProcedure
Procedure.l Signe(a.l)
  If a>0
    ProcedureReturn 1
  ElseIf a=0
    ProcedureReturn 0
  Else
    ProcedureReturn -1
  EndIf
EndProcedure
Procedure.l Min(a.l,b.l)
  If a<b
    ProcedureReturn a
  Else
    ProcedureReturn b
  EndIf
EndProcedure
Procedure.l Max(a.l,b.l)
  If a>b
    ProcedureReturn a
  Else
    ProcedureReturn b
  EndIf
EndProcedure
Procedure Encadrement(*S1.Segment,*S2.Segment)
  ;Box Segment1
  Box1\P1\x=Min(*S1\P1\x,*S1\P2\x)
  Box1\P1\y=Min(*S1\P1\y,*S1\P2\y)
  Box1\P2\x=Max(*S1\P1\x,*S1\P2\x)
  Box1\P2\y=Max(*S1\P1\y,*S1\P2\y)
  ;Box Segment2
  Box2\P1\x=Min(*S2\P1\x,*S2\P2\x)
  Box2\P1\y=Min(*S2\P1\y,*S2\P2\y)
  Box2\P2\x=Max(*S2\P1\x,*S2\P2\x)
  Box2\P2\y=Max(*S2\P1\y,*S2\P2\y)
EndProcedure

Procedure CollisionSegmentSegment(*S1.Segment,*S2.Segment)
  ;Test Collision encadrement
  If Box1\P2\x >= Box2\P1\x And Box1\P1\x <= Box2\P2\x And Box1\P2\y >= Box2\P1\y And Box1\P1\y <= Box2\P2\y
    ;Test chevauchement segments
    R1.f=((*S2\P1\x-*S1\P1\x)*(*S1\P2\y-*S1\P1\y))-((*S2\P1\y-*S1\P1\y)*(*S1\P2\x-*S1\P1\x))
    R2.f=((*S2\P2\x-*S1\P1\x)*(*S1\P2\y-*S1\P1\y))-((*S2\P2\y-*S1\P1\y)*(*S1\P2\x-*S1\P1\x))
    R3.f=((*S1\P1\x-*S2\P1\x)*(*S2\P2\y-*S2\P1\y))-((*S1\P1\y-*S2\P1\y)*(*S2\P2\x-*S2\P1\x))
    R4.f=((*S1\P2\x-*S2\P1\x)*(*S2\P2\y-*S2\P1\y))-((*S1\P2\y-*S2\P1\y)*(*S2\P2\x-*S2\P1\x))
    If (Signe(R1)*Signe(R2)<=0) And (Signe(R3)*Signe(R4)<=0)
      Resultat = #True
    EndIf
  EndIf
  ProcedureReturn Resultat
EndProcedure

Procedure AffPoints(*S1.Segment,*S2.Segment,*P.point,mem)
  CouleurBox=RGB(70,70,70)
  CouleurSegment1=RGB(255,0,0)
  CouleurSegment2=RGB(0,255,0)
  CouleurCurseur=RGB(255,255,255)
  StartDrawing(ScreenOutput())
  ;/Affiche les encadrements des segments en premier pour ne pas effacer le tracé d'un segment
  ;Segment1
  LineXY(Box1\P1\x,Box1\P1\y,Box1\P1\x,Box1\P2\y,CouleurBox)
  LineXY(Box1\P1\x,Box1\P1\y,Box1\P2\x,Box1\P1\y,CouleurBox)
  LineXY(Box1\P2\x,Box1\P1\y,Box1\P2\x,Box1\P2\y,CouleurBox)
  LineXY(Box1\P1\x,Box1\P2\y,Box1\P2\x,Box1\P2\y,CouleurBox)
  ;Segment2
  LineXY(Box2\P1\x,Box2\P1\y,Box2\P1\x,Box2\P2\y,CouleurBox)
  LineXY(Box2\P1\x,Box2\P1\y,Box2\P2\x,Box2\P1\y,CouleurBox)
  LineXY(Box2\P2\x,Box2\P1\y,Box2\P2\x,Box2\P2\y,CouleurBox)
  LineXY(Box2\P1\x,Box2\P2\y,Box2\P2\x,Box2\P2\y,CouleurBox)
  ;/Affiche le Segment1
  Circle(*S1\P1\x,*S1\P1\y,4,CouleurSegment1)
  Circle(*S1\P2\x,*S1\P2\y,4,CouleurSegment1)
  LineXY(*S1\P1\x,*S1\P1\y,*S1\P2\x,*S1\P2\y,CouleurSegment1)
  ;/Affiche le Segment2
  Circle(*S2\P1\x,*S2\P1\y,4,CouleurSegment2)
  Circle(*S2\P2\x,*S2\P2\y,4,CouleurSegment2)
  LineXY(*S2\P1\x,*S2\P1\y,*S2\P2\x,*S2\P2\y,CouleurSegment2)
  ;/Affiche le point
  If mem
    DrawingMode(4)
    Circle(*P\x,*P\y,6,CouleurCurseur)
  Else
    DrawingMode(0)
    Circle(*P\x,*P\y,4,CouleurCurseur)
  EndIf
  ;/Affiche une croix pour mieux suivre le déplacement du point
  LineXY(*P\x,0,*P\x,ScreenHeight-1,CouleurCurseur)
  LineXY(0,*P\y,ScreenWidth-1,*P\y,CouleurCurseur)
  If CollisionSegmentSegment(*S1,*S2)
    FrontColor(RGB(255,255,0))
    BackColor(RGB(255,0,0))
    texte$="  IN "
  Else
    FrontColor(RGB(255,255,255))
    BackColor(RGB(0,255,0))
    texte$=" OUT "
  EndIf
  DrawText(0,0,texte$)
  StopDrawing()
EndProcedure
Procedure TestPoint(X1,Y1,X2,Y2,d)
  If X1>X2-d And X1<X2+d And Y1>Y2-d And Y1<Y2+d
    Resultat=#True
  EndIf
  ProcedureReturn Resultat
EndProcedure

Segment1.Segment
Segment2.Segment
Point.point
;Segment1
Segment1\P1\x=50
Segment1\P1\y=50
Segment1\P2\x=110
Segment1\P2\y=250
;Segment2
Segment2\P1\x=210
Segment2\P1\y=250
Segment2\P2\x=410
Segment2\P2\y=350
;Point à tester
Point\x=340
Point\y=100
DiametreSelection=6

Repeat
  While WindowEvent():Wend
  ClearScreen(0)
  ExamineKeyboard()
  ExamineMouse()
  ;Le triangle est modifiable à la souris en cliquant sur un point
  If MouseButton(1)
    If MemPoint=1
      Segment1\P1\x=MouseX()
      Segment1\P1\y=MouseY()
    ElseIf MemPoint=2
      Segment1\P2\x=MouseX()
      Segment1\P2\y=MouseY()
    ElseIf MemPoint=3
      Segment2\P1\x=MouseX()
      Segment2\P1\y=MouseY()
    ElseIf MemPoint=4
      Segment2\P2\x=MouseX()
      Segment2\P2\y=MouseY()
    EndIf
  Else
    MemPoint=0
  EndIf
  If TestPoint(MouseX(),MouseY(),Segment1\P1\x,Segment1\P1\y,DiametreSelection)
    MemPoint=1
  ElseIf TestPoint(MouseX(),MouseY(),Segment1\P2\x,Segment1\P2\y,DiametreSelection)
    MemPoint=2
  ElseIf TestPoint(MouseX(),MouseY(),Segment2\P1\x,Segment2\P1\y,DiametreSelection)
    MemPoint=3
  ElseIf TestPoint(MouseX(),MouseY(),Segment2\P2\x,Segment2\P2\y,DiametreSelection)
    MemPoint=4
  EndIf
  ;Place le point à tester sous la souris
  Point\x=MouseX()
  Point\y=MouseY()
  ;Affiche le tout
  Encadrement(@Segment1,@Segment2)
  AffPoints(@Segment1,@Segment2,@Point,MemPoint)
  FlipBuffers()
  Delay(1)
Until KeyboardPushed(#PB_Key_Escape) 


Dernière édition par comtois le Ven 03/Sep/2010 17:01, édité 1 fois.

Haut
 Profil  
 
 Sujet du message:
MessagePosté: Lun 21/Fév/2005 15:49 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 26/Mai/2004 0:33
Messages: 684
Génial même si sa me sert plus j'essaye toujour vos codes :) et sa me sert en c/c++ des fois :) . merci

_________________
http://garzul.tonsite.biz

Ancien site PB :
http://www.garzul.ca.cx


Haut
 Profil  
 
 Sujet du message:
MessagePosté: Ven 17/Juil/2009 18:27 
Hors ligne

Inscription: Dim 11/Jan/2009 15:04
Messages: 130
woaw sa en fait des tuto 8O

_________________
Le guerrier avance vers sa destiné!


Haut
 Profil  
 
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 7 messages ] 

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 1 invité


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye