PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Drawing arrows etc.

https://www.purebasic.fr/english/viewtopic.php?t=41593

Page 1 of 1

Drawing arrows etc.

Posted: Sat Mar 27, 2010 3:05 pm
by blueznl
Is there an easy way to turn a regular line (as in LineXY etc.)...

--------

... into something with has an arrow on one side?

------>

Re: Drawing arrows etc.

Posted: Sat Mar 27, 2010 5:28 pm
by Demivec
Here's a simple one using a method I ran across. Tailor the parameters to your needs. :)

Code: Select all

Procedure.d atan2(y.d, x.d)
  !FLD qword[p.v_y]
  !FLD qword[p.v_x]
  !FPATAN
  ProcedureReturn
EndProcedure

Procedure arrowLine(x1, y1, x2, y2, aPos = 0, tightness = 2)
  ;aPos = arrowhead position; 0 (for none), 1 (x1,y1), 2 (x2,y2), or 3 (both ends)
  ;tightness = arrowhead tightness; range 1 -> 10, 1 is the least tight, 10 is the tightest.
  Protected.d slopY, cosY, sinY, length = 10.0 ;length = arrow line length
  
  slopY = atan2(y1 - y2, x1 - x2)
  cosY = Cos(slopY)
  sinY = Sin(slopY)
  
  LineXY(x1, y1, x2, y2)
  If tightness > 10 Or tightness < 1: tightness = 2: EndIf 

  ;The method used here is based on code by Mayank Malik.
  If aPos & 1 
    LineXY(x1, y1, x1 + Int(-length * cosY - length / tightness * sinY), y1 + Int(-length * sinY + length / tightness * cosY ))
    LineXY(x1 + Int(-length * cosY + length / tightness * sinY), y1 - Int(length / tightness * cosY  + length * sinY), x1, y1)
  EndIf 
  
  If aPos & 2
    LineXY(x2, y2, x2 + Int(length * cosY - length / tightness * sinY), y2 + Int(length * sinY + length / tightness * cosY ))
    LineXY(x2 + Int(length * cosY + length / tightness * sinY ), y2 - Int(length / tightness * cosY  - length * sinY),x2, y2)
  EndIf 
EndProcedure

CreateImage(0, 300, 300)
StartDrawing(ImageOutput(0))
  arrowLine(70, 10, 220, 160, 0) ;no arrowheads
  FrontColor($4040FF)
  arrowLine(50, 10, 200, 160, 2) ;arrowhead on second point
  arrowLine(50, 10, 80, 260, 2)  ;arrowhead on second point
  arrowLine(80, 260, 250, 210, 2) ;arrowhead on second point
  FrontColor($20FF20)
  arrowLine(80, 270, 250, 220, 1) ;arrowhead on first point
  FrontColor($FF50FF)
  arrowLine(50, 280, 250, 280, 3) ;arrowhead on both ends
StopDrawing()

OpenWindow(0,0,0,300,300,"hello",#PB_Window_SystemMenu)
ImageGadget(0,0,0,0,0,ImageID(0))

Repeat:Until WaitWindowEvent() = #PB_Event_CloseWindow

Re: Drawing arrows etc.

Posted: Sat Mar 27, 2010 5:37 pm
by kenmo
Damn, I was beaten!

I just made this code up, it does pretty much the same thing but not as elegantly.

But in my demo you draw with the mouse! :D

Code: Select all


Procedure ArrowXY(x1.l, y1.l, x2.l, y2.l, Color.l, Head.f = 20.0, Angle.f = 40)
  Head = Abs(Head) : Angle = Abs(Angle*#PI/180.0)
  LineXY(x1, y1, x2, y2, Color)
  If (Head > 0.0) And (Abs(x2 - x1) + Abs(y2 - y1) > Head)
    x33.f = -1*Cos(Angle) * Head
    y33.f =    Sin(Angle) * Head
    x44.f = -1*Cos(Angle) * Head
    y44.f = -1*Sin(Angle) * Head
    
    SAngle.f = ATan((y1 - y2)/(x2 - x1))
    If (x2 < x1)
      SAngle = SAngle + #PI
    EndIf
    
    x3 = Cos(SAngle)*x33 + Sin(SAngle)*y33
    y3 = Cos(SAngle)*y33 - Sin(SAngle)*x33
    x4 = Cos(SAngle)*x44 + Sin(SAngle)*y44
    y4 = Cos(SAngle)*y44 - Sin(SAngle)*x44
    
    LineXY(x2, y2, x2 + x3, y2 + y3, Color)
    LineXY(x2, y2, x2 + x4, y2 + y4, Color)
  EndIf
EndProcedure



#W = 400
#H = 300

Global Dragging.l = 0
Global StartX.l   = 0
Global StartY.l   = 0
Global NewColor.l = RGB(Random(192),Random(192),Random(192))

Structure ARROW
  x1.l
  y1.l
  x2.l
  y2.l
  Co.l
EndStructure

Global NewList A.ARROW()

Procedure Redraw()
  If StartDrawing(ImageOutput(0))
    Box(0, 0, #W, #H, #White)
    ForEach A()
      ArrowXY(A()\x1, A()\y1, A()\x2, A()\y2, A()\Co)
    Next
    If Dragging
      ArrowXY(StartX, StartY, WindowMouseX(0), WindowMouseY(0), NewColor)
    EndIf
    StopDrawing()
    SetGadgetState(0, ImageID(0))
  EndIf
EndProcedure

OpenWindow(0, 0, 0, #W, #H, "Really Simple Arrows", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)

CreateImage(0, #W, #H)
If StartDrawing(ImageOutput(0))
  Box(0, 0, #W, #H, #White)
  StopDrawing()
  ImageGadget(0, 0, 0, #W, #H, ImageID(0))
EndIf

Click.l  = 0 : OClick.l = 0

Repeat
  Event = WaitWindowEvent(50)
  
  If (Event = #PB_Event_Gadget) And (EventType() = #PB_EventType_LeftClick)
    StartX = WindowMouseX(0) : StartY = WindowMouseY(0)
    Dragging = 1
  ElseIf Event = #WM_LBUTTONUP
    AddElement(A())
    A()\x1 = StartX : A()\y1 = StartY
    A()\x2 = WindowMouseX(0) : A()\y2 = WindowMouseY(0)
    A()\Co = NewColor
    Dragging = 0
    Redraw()
    NewColor = RGB(Random(192),Random(192),Random(192))
  EndIf
  
  If Dragging
    Redraw()
  EndIf
  
Until Event = #PB_Event_CloseWindow

Re: Drawing arrows etc.

Posted: Sat Mar 27, 2010 5:56 pm
by Demivec
kenmo wrote:Damn, I was beaten!

I just made this code up, it does pretty much the same thing but not as elegantly.

But in my demo you draw with the mouse! :D
First! :D

Mine is definitely not interactive. :)

Re: Drawing arrows etc.

Posted: Sat Mar 27, 2010 6:24 pm
by RASHAD
Hi blueznl
Very simple you can adapt it for your needs
I hope you like it
Tested with PB 4.4x Win 7 x86 x64
Have fun

Code: Select all

      

  LoadFont(1, "Wingdings 3",24)
  
  If OpenWindow(0, 0, 0, 200, 200, "2DDrawing Example", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  
    x1 = 10
    y1 = 10
    x2 = 100
    y2 = 72
    Lthick = 8
    StartDrawing(WindowOutput(0))
      DrawingFont(FontID(1))
      DrawingMode(#PB_2DDrawing_Transparent)
      DrawRotatedText(100, 50, Chr($E2),-35,$0502FA)
      For i = 1 To Lthick
        LineXY(x1, y1-(Lthick/2)+i, x2, y2-(Lthick/2)+i,RGB(255, 0, 0) )
      Next 
    StopDrawing() 
    
    Repeat
      Event = WaitWindowEvent()
    Until Event = #PB_Event_CloseWindow
  EndIf

Re: Drawing arrows etc.

Posted: Sat Mar 27, 2010 8:48 pm
by WilliamL
@Rashad

Yours is the only one that works for me (Mac) but the arrow head is shifted up the width of one of the wings of the arrow head.

I would guess the font (Wingdings 3) must be a slightly different size on a Mac. DrawRotatedText(100, 55, Chr($E2),-35,$0502FA) seem to get the alignment right.

Re: Drawing arrows etc.

Posted: Sat Mar 27, 2010 8:54 pm
by Demivec
WilliamL wrote:@Rashad

Yours is the only one that works for me (Mac) but the arrow head is shifted up the width of one of the wings of the arrow head. (I'll play with it)
@WilliamL: Mine may not function because of the atan2() function. You can replace that function with this one:

Code: Select all

#TWOPI = 2*#PI
Procedure.d atan2(y.d,x.d)
  Protected r.d
  If x > 0.0
    r  = ATan(y / x)
  ElseIf x < 0.0
    r= ATan(y / x) - #PI
  ElseIf x = 0
    If y > 0.0
      r = #PI
    ElseIf y < 0.0
      r = -#PI
    ElseIf y = 0.0
      r = 0
    EndIf
  EndIf
  ;if you want 2 PI range
  If y < 0
    r + #TWOPI
  EndIf
  
  ProcedureReturn r
EndProcedure

Re: Drawing arrows etc.

Posted: Sat Mar 27, 2010 8:57 pm
by WilliamL
@ Demivec

Yup, that fixed it. Very nice!

Re: Drawing arrows etc.

Posted: Sat Mar 27, 2010 9:16 pm
by RASHAD
Hi WilliamL
I am thinking to draw the req. arrow head only to a transparet image with the color , thickness , style and rotation
then resize the image hal. and val. as req.
That will be fantastic if I succeded.
in that case we will not face any problem with alignment
May be I will try that later

Have a good day mate

Re: Drawing arrows etc.

Posted: Sat Mar 27, 2010 10:59 pm
by Vera
Hello,

Reading this thread I remembered that Kwaï chang caïne had quite a struggle with arrows lately and maybe you'll find some valuable hints there too : Linking graphically two gadgets

regards ~ Vera

Re: Drawing arrows etc.

Posted: Sun Mar 28, 2010 9:56 am
by einander
http://www.purebasic.fr/english/viewtop ... ow#p123130
Cheers

Re: Drawing arrows etc.

Posted: Sun Mar 28, 2010 11:31 am
by blueznl
Duh! I did a search on the forums, your honour! Seriously!

:oops:

Thanks einander and all others! I may actually go this time for platform independent... hmmm... decisions decisions...

Re: Drawing arrows etc.

Posted: Sun Mar 28, 2010 8:48 pm
by einander
Platform independent

Code: Select all

#DEGTORAD=#PI/180.0
Structure PointF
   X.f
   Y.f
EndStructure
   

Macro CosAng(Ang,Radius)
   Cos(Ang*#DEGTORAD)*Radius
EndMacro
Macro SinAng(Ang,Radius)
   Sin(Ang*#DEGTORAD)*Radius
EndMacro


Procedure AngleEndPoint(X.D,Y.D,Ang.D,LineSize.D,*P.PointF) ; Ret circular end pointF for line, angle, size
   *P\X= X+CosAng(Ang,LineSize)        
   *P\Y= Y+SinAng(Ang,LineSize) 
EndProcedure
 ;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
OpenWindow(0, 100, 100,700,500 ,"",#PB_Window_SystemMenu|1) 

_Img=CreateImage(-1,WindowWidth(0),WindowHeight(0))
_ImGad=ImageGadget(-1,0,0,0,0,ImageID(_Img)) 
X=300
Y=300
Ang2.f=10     ;try other angles and radius
Radius.f=150
RGB=#Yellow
 
Repeat
   
   Ev=WaitWindowEvent(1) 
   
   StartDrawing(ImageOutput(_Img))
      Ang.f=i
      
      Circle(X,Y,Radius,$444444) ;comment if you want
      AngleEndPoint(X,Y,Ang,Radius,P.PointF)
      LineXY(X,Y,P\X,P\Y,RGB) 
      AngleEndPoint(X,Y,Ang+Ang2,Radius*0.8,P1.PointF)
      LineXY(P\X,P\Y,P1\X,P1\Y,RGB)
      AngleEndPoint(X,Y,Ang-Ang2,Radius*0.8,P2.PointF)
      LineXY(P\X,P\Y,P2\X,P2\Y,RGB)
      LineXY(P1\X,P1\Y,P2\X,P2\Y,RGB)
   StopDrawing()
   SetGadgetState(_ImGad,ImageID(_Img))
   Delay(10)
   i+1
Until Ev=#pb_event_closewindow
Cheers

Re: Drawing arrows etc.

Posted: Thu Apr 01, 2010 6:27 pm
by Demivec
Now platform independent (via the new beta's math functions).

Code: Select all

;Updated for PureBasic v4.50b1
Procedure arrowLine(x1, y1, x2, y2, aPos = 0, tightness = 2)
  ;aPos = arrowhead position; 0 (for none), 1 (x1,y1), 2 (x2,y2), or 3 (both ends)
  ;tightness = arrowhead tightness; range 1 -> 10, 1 is the least tight, 10 is the tightest.
  Protected.d slopY, cosY, sinY, length = 10.0 ;length = arrow line length
  
  slopY = ATan2(x1 - x2, y1 - y2)
  cosY = Cos(slopY)
  sinY = Sin(slopY)
  
  LineXY(x1, y1, x2, y2)
  If tightness > 10 Or tightness < 1: tightness = 2: EndIf 

  ;The method used here is based on code by Mayank Malik, uncomment lines for a full triangle arrowhead.
  If aPos & 1 
    LineXY(x1, y1, x1 + Int(-length * cosY - length / tightness * sinY), y1 + Int(-length * sinY + length / tightness * cosY ))
    LineXY(x1 + Int(-length * cosY + length / tightness * sinY), y1 - Int(length / tightness * cosY  + length * sinY), x1, y1)
  EndIf 
  
  If aPos & 2
    LineXY(x2, y2, x2 + Int(length * cosY - length / tightness * sinY), y2 + Int(length * sinY + length / tightness * cosY ))
    LineXY(x2 + Int(length * cosY + length / tightness * sinY ), y2 - Int(length / tightness * cosY  - length * sinY),x2, y2)
  EndIf 
EndProcedure

CreateImage(0, 300, 300)
StartDrawing(ImageOutput(0))
  arrowLine(70, 10, 220, 160, 0) ;no arrowheads
  FrontColor($4040FF)
  arrowLine(50, 10, 200, 160, 2) ;arrowhead on second point
  arrowLine(50, 10, 80, 260, 2)  ;arrowhead on second point
  arrowLine(80, 260, 250, 210, 2) ;arrowhead on second point
  FrontColor($20FF20)
  arrowLine(80, 270, 250, 220, 1) ;arrowhead on first point
  FrontColor($FF50FF)
  arrowLine(50, 280, 250, 280, 3) ;arrowhead on both ends
StopDrawing()

OpenWindow(0,0,0,300,300,"hello",#PB_Window_SystemMenu)
ImageGadget(0,0,0,0,0,ImageID(0))

Repeat:Until WaitWindowEvent() = #PB_Event_CloseWindow
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited