Drapeau texte sur plan

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

Drapeau texte sur plan

Message par kernadec »

bonsoir
j'avais besoin d'un truc pour avoir toujours le texte a l' endroit dans un plan, quel que soit l'angle et sa position au moment de la rotation.
alors voilà, si ça intéresse quelqu'un.

Cordialement

Code : Tout sélectionner

;################################ Kernadec 06 2011 ####################################
;                  mode ecriture drapeau les rotations de plan
;######################################################################################
Enumeration
  #window0 
  #bureau0
  #gadget0
  #gadget1
  #gadget2
  #font5
EndEnumeration  
Global Text$,Xdt.l,Ydt.l,Rdt.i,Pdt.d,Adt.d,hft5.l,pos.l,x0.l,x1.l,x2.l,y0.l,y1.l,y2.l
hft5=10
Xdt=500
Ydt=500
Rdt=200
LoadFont(#font5,"COUR",hft5)
Procedure.w MouseWheelDelta()
  xxw.w = ((EventwParam()>>16)&$FFFF)
  ProcedureReturn -(xxw / 100)
EndProcedure

Procedure Drapeau_Text(tex$,Xdt,Ydt,Rdt,Pdt.d,Adt.d,color)
  ;(texte,centrex,centrey,rayon,position,angle-texte,couleur) 
  ;Procedure Drapeau_Text kernadec juin 2011
  While Pdt<0:Pdt=Pdt+360:Wend
  Pdt=Mod(Pdt,360)
  wdt=TextWidth(tex$)
  hdt=TextHeight(tex$)
  x0=Xdt+Rdt*Sin(Radian(Pdt+270))
  y0=Ydt+Rdt*Cos(Radian(Pdt+270))
  x1=x0+(wdt+(hft5/3))*Sin(Radian(Pdt+Adt+180))
  y1=y0+(wdt+(hft5/3))*Cos(Radian(Pdt+Adt+180))
  x2=x0-(hdt+(hft5/2))*Sin(Radian(Pdt+Adt+90))
  y2=y0-(hdt+(hft5/2))*Cos(Radian(Pdt+Adt+90))
  If Mod((Pdt+Adt+90),360)>90 And Mod((Pdt+Adt+90),360)<270
    DrawRotatedText(x1,y1,tex$,180+Mod((Pdt+Adt+90),360),color)
  Else
    DrawRotatedText(x2,y2,tex$,Mod((Pdt+Adt+90),360),color) 
  EndIf
  ;------------------------------
  LineXY(Xdt,Ydt,x0,y0,#Black)
  LineXY(x0,y0,x2,y2,#Black)
  LineXY(x0,y0,x1,y1,#Black)
  
EndProcedure
Procedure dessin()
  StartDrawing(CanvasOutput(#Gadget0))
   DrawingFont(FontID(#font5))
   Box(0,0,1000,1000,#White)
   
   DrawText(200,200,"Utiliser les flèches clavier",#Black,#White)
     
   drapeau_text(" Boussole ",Xdt,Ydt,180,pos,0,RGB(255,0,0))
  
   drapeau_text(" Sextant ",Xdt,Ydt,140,pos+120,90,RGB(0,255,0))
  
   drapeau_text(" Octant ",Xdt,Ydt,220,pos-90,45,RGB(0,0,255))
  
  StopDrawing() 
EndProcedure

OpenWindow(#window0,0,0,600,600, "Drapeau_Text", #PB_Window_SystemMenu | #PB_Window_ScreenCentered| #PB_Window_MinimizeGadget | #PB_Window_SizeGadget)
ScrollAreaGadget(#Gadget2,0,0, WindowWidth(#window0),WindowHeight(#window0), 1000, 1000, 30)
CanvasGadget(#Gadget0,0,0, 1000,1000,#PB_Canvas_Border)
SetGadgetColor(#Gadget2,#PB_Gadget_BackColor,#White)
SetGadgetAttribute(#Gadget2,#PB_ScrollArea_X,200)
SetGadgetAttribute(#Gadget2,#PB_ScrollArea_Y,200)

dessin()   

Repeat
  Event = WaitWindowEvent()
  Select event
   Case #PB_Event_SizeWindow
     ResizeGadget(#Gadget2,#PB_Ignore,#PB_Ignore,WindowWidth(#window0),WindowHeight(#window0))
     SetGadgetColor(#Gadget2,#PB_Gadget_BackColor,#White)
   Case  #WM_MOUSEWHEEL
      wheel_x=wheel_x+(MouseWheelDelta() *5)
      wheel_y=wheel_y+(MouseWheelDelta() *5)
      SetGadgetAttribute(#Gadget2,#PB_ScrollArea_Y,200+wheel_x)
  EndSelect    
  If event = #WM_KEYDOWN  ;  Command key
    key = EventwParam()
  EndIf
  Select key
    Case 39:pos=pos+1:dessin()    ;flèche droit
    Case 38:pos=pos+5:dessin()    ;flèche haut  
    Case 35:pos=pos+10:dessin()   ;flèche fin  
    Case 34:pos=pos+30:dessin()   ;flèche pagebas  
    Case 37:pos=pos-1:dessin()    ;flèche gauche
    Case 40:pos=pos-5:dessin()    ;flèche bas
    Case 36:pos=pos-10:dessin()   ;flèche début
    Case 33:pos=pos-30:dessin()   ;flèche pagehaut
  EndSelect   
    key=0      ;évite les répétition    
Until Event = #PB_Event_CloseWindow
Avatar de l’utilisateur
GeBonet
Messages : 453
Inscription : ven. 29/févr./2008 16:17
Localisation : Belgique

Re: Drapeau texte sur plan

Message par GeBonet »

Bonjour, et bien évidement que c'est intéressant :lol: En plus c'est une application de "CanvasGadget(" illustrant très bien une série de possibilité donc très utile... Merci :lol:
Windows 7 et Windows 8.1 Pb 5.0 jusque 5.24 Lts 64 et 5.3 (64)/b]
“Ceux qui rêvent éveillés ont conscience de mille choses qui échappent à ceux qui ne rêvent qu’endormis.”
-Edgar Allan Poe-
Torp
Messages : 360
Inscription : lun. 22/nov./2004 13:05

Re: Drapeau texte sur plan

Message par Torp »

Super Merci kernadec !
Avatar de l’utilisateur
Kwai chang caine
Messages : 6989
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: Drapeau texte sur plan

Message par Kwai chang caine »

Merci 8)
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Répondre