PureBasic Forums - English

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

help please with creating a graphics component

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

Page 3 of 3

Re: help please with creating a graphics component

Posted: Sat Jan 07, 2012 3:26 pm
by infratec
Hi,

as it was easy to integrate, some new attributes:
#CurveGadget_Y_Only
#CurveGadget_DrawLines
#CurveGadget_DrawBars

Code: Select all

; Program: CurveGadget.pbi
; Author: intratec, modified by Demivec, Little John and Danilo
; version: 13
;
; History:
;
; 13 (infratec) bugfix for the middle point in a vertical row
; 12 (Danilo) added #CurveGadget_MinXSpacing
; 11 (infratec) added CurveGadgetSetState()
; 10 (infratec) added #CurveGadget_Y_Only, #CurveGadget_DrawLines and #CurveGadget_DrawBars
;  9 (infratec) bugfix for placing points on top of each other
;  8 (Demivec) code optimization
;    (infratec) set catchRadius when pointRadius is changed
;    renamed everything from filterBoxGadget to CurveGadget
;    small cosmetic changes
;  7 (infratec) added attribute #FilterBox_Points
;  6 (infratec) added attribute #FilterBox_PointRadius and #FilterBox_CatchRadius
;  5 (infratec) added filterBoxGadgetSetAttribut for scaling the result
;    make it impossible to place illegal X values (hopefully)
;  4 (Little John) changed cursor on mouse over
;    (Demivec) simplified code
;  3 (infratec) added filterBoxGadgetSetColor
;  2 (Demivec) changed cursor on pick up
;    fixed mouse move event
;    more flexible with #FilterBoxPoint... defines
;  1 (infratec) initial version

;EnableExplicit

CompilerIf Defined(PB_Gadget_DisableColor, #PB_Constant) = 0
  #PB_Gadget_DisableColor = 20
CompilerEndIf

Enumeration
  #CurveGadget_Points
  #CurveGadget_PointRadius
  #CurveGadget_CatchRadius
  #CurveGadget_X_Maximum
  #CurveGadget_Y_Maximum
  #CurveGadget_Y_Only
  #CurveGadget_DrawLines
  #CurveGadget_DrawBars
  #CurveGadget_MinXSpacing
EndEnumeration

Structure CurveGadgetStr
  List dataPoint.Point()
  width.i
  height.i
  disabled.i
  activePoint.i
  frontColor.i
  backColor.i
  disableColor.i
  xScaleMax.f
  yScaleMax.f
  pointRadius.i
  catchRadius.i
  points.i
  yOnly.i
  drawLines.i
  drawBars.i
  minXSpacing.i
EndStructure


Procedure CurveGadgetDraw(gadgetNo)
  Protected *CurveGadget.CurveGadgetStr
  Protected i, x1, y1
 
  If IsGadget(gadgetNo)
    *CurveGadget = GetGadgetData(gadgetNo)
    With *CurveGadget
      If StartDrawing(CanvasOutput(gadgetNo))
          If \disabled
            Box(0, 0, \width, \height, \disableColor)
          Else
            Box(0, 0, \width, \height, \backColor)
          EndIf
          ResetList(\dataPoint())
          NextElement(\dataPoint())
          i = 0
          While i < \points
            x1 = \dataPoint()\x
            y1 = \dataPoint()\y
            Circle(x1, y1, \pointRadius, \frontColor)
            NextElement(\dataPoint())
            If \drawLines
              LineXY(x1, y1, \dataPoint()\x, \dataPoint()\y, \frontColor)
            EndIf
            If \drawBars
              Box(x1 - \pointRadius, y1, \pointRadius * 2 + 1, \height - y1, \frontColor)
            EndIf
            i + 1
          Wend
        StopDrawing()
      EndIf
    EndWith
  EndIf
EndProcedure


Procedure CurveGadgetSetAttribute(gadgetNo, attribute, value)
  Protected *CurveGadget.CurveGadgetStr
  Protected i.i
  
  If IsGadget(gadgetNo)
    *CurveGadget = GetGadgetData(gadgetNo)
    With *CurveGadget
      Select attribute
        Case #CurveGadget_Points
          If value < 2 : value = 2 : EndIf
          \points = value
          ClearList(\dataPoint())
          AddElement(\dataPoint())
          \dataPoint()\x = 0
          \dataPoint()\y = \height / 2
          For i = 1 To \points - 2
            AddElement(\dataPoint())
            \dataPoint()\x = ((0.0 + \width - \pointRadius) / (\points - 1)) * i
            \dataPoint()\y = \height / 2
          Next
          AddElement(\dataPoint())
          \dataPoint()\x = \width - 1
          \dataPoint()\y = \height / 2
        Case #CurveGadget_PointRadius
          \pointRadius = value
          If \catchRadius < value : \catchRadius = value : EndIf
        Case #CurveGadget_CatchRadius : \catchRadius = value
        Case #CurveGadget_X_Maximum : \xScaleMax = value
        Case #CurveGadget_Y_Maximum : \yScaleMax = value
        Case #CurveGadget_Y_Only : \yOnly = value
        Case #CurveGadget_DrawLines
          If value
            \drawLines = #True
            \drawBars = #False
          Else
            \drawLines = #False
          EndIf
        Case #CurveGadget_DrawBars
          If value
            \drawBars = #True
            \drawLines = #False
          Else
            \drawBars = #False
          EndIf
        Case #CurveGadget_MinXSpacing : \minXSpacing = value
      EndSelect
    EndWith
    CurveGadgetDraw(gadgetNo)
  EndIf
EndProcedure


Procedure CurveGadget(gadgetNo, x, y, width, height, points = 5, fgc = $0000FF, bgc = $FFFFFF, dc = $E0E0E0)
  Protected *CurveGadget.CurveGadgetStr
  Protected i
 
  If gadgetNo = #PB_Any Or IsGadget(gadgetNo) = 0
    gadgetNo = CanvasGadget(#PB_Any, x, y, width, height, #PB_Canvas_Border)
    If gadgetNo
      *CurveGadget = AllocateMemory(SizeOf(CurveGadgetStr))
      SetGadgetData(gadgetNo, *CurveGadget)
     
      ;gadget output will be smaller if borders are drawn
      StartDrawing(CanvasOutput(gadgetNo))
        width = OutputWidth()
        height = OutputHeight()
      StopDrawing()
      With *CurveGadget
        \width = width
        \height = height
        \disabled = #False
        \activePoint = -1
        \frontColor = fgc
        \backColor = bgc
        \disableColor = dc
        \xScaleMax = width
        \yScaleMax = height
        \pointRadius = 5
        \catchRadius = 5
        \points = points
        \yOnly = #False
        \drawLines = #True
        \drawBars = #False
        \minXSpacing = 0
        
        NewList \dataPoint.POINT()
        CurveGadgetSetAttribute(gadgetNo, #CurveGadget_Points, points)
      EndWith
    EndIf
  EndIf
 
  CurveGadgetDraw(gadgetNo)
 
  ProcedureReturn gadgetNo
EndProcedure


Procedure CurveGadgetPointCheck(*CurveGadget.CurveGadgetStr, xPos, yPos)
  ;returns the number of the point at (xPos, yPos) for the given filterBox structure
  ;returns -1 if no point present at (xPos, yPos)
  Protected i
  
  With *CurveGadget
    i = 0
    ForEach \dataPoint()
      If (\dataPoint()\x - \catchRadius) < xPos And (\dataPoint()\x + \catchRadius) > xPos
        If (\dataPoint()\y - \catchRadius) < yPos And (\dataPoint()\y + \catchRadius) > yPos
          ProcedureReturn i ;found a point
        EndIf
      EndIf
      i + 1
    Next
  EndWith
 
  ProcedureReturn -1 ;no point at (xPos, yPos)
EndProcedure


Procedure CurveGadgetEvent(gadgetNo)
  
  Enumeration
    #TwoPointsBefore
    #PointBefore
    #Point
    #PointAfter
    #TwoPointsAfter
  EndEnumeration
  
  Protected *CurveGadget.CurveGadgetStr
  Protected result
  Protected i, xPos, yPos
  
  *CurveGadget = GetGadgetData(gadgetNo)
  
  With *CurveGadget
    If Not \disabled
      xPos = GetGadgetAttribute(gadgetNo, #PB_Canvas_MouseX)
      yPos = GetGadgetAttribute(gadgetNo, #PB_Canvas_MouseY)
      
      If xPos < 0 : xPos = 0 : EndIf
      If xPos > \width - 1: xPos = \width - 1: EndIf
      If yPos < 0 : yPos = 0 : EndIf
      If yPos > \height - 1 : yPos = \height - 1 : EndIf
      
      Select EventType()
        Case #PB_EventType_LeftButtonDown
          If \activePoint = -1
            \activePoint = CurveGadgetPointCheck(*CurveGadget, xPos, yPos)
          EndIf
          
        Case #PB_EventType_MouseMove
          If \activePoint <> -1
            
            Protected Dim pointArray.POINT(4)
            
            i = 0
            ForEach \dataPoint()
              If i = \activePoint - 2
                pointArray(#TwoPointsBefore)\x = \dataPoint()\x
                pointArray(#TwoPointsBefore)\y = \dataPoint()\y
              ElseIf i = \activePoint - 1
                pointArray(#PointBefore)\x = \dataPoint()\x
                pointArray(#PointBefore)\y = \dataPoint()\y
              ElseIf i = \activePoint
                pointArray(#Point)\x = \dataPoint()\x
                pointArray(#Point)\y = \dataPoint()\y
              ElseIf i = \activePoint + 1
                pointArray(#PointAfter)\x = \dataPoint()\x
                pointArray(#PointAfter)\y = \dataPoint()\y
              ElseIf i = \activePoint + 2
                pointArray(#TwoPointsAfter)\x = \dataPoint()\x
                pointArray(#TwoPointsAfter)\y = \dataPoint()\y
                Break
              EndIf
              i + 1
            Next
            
            If \activePoint > 0 And \activePoint < \points - 1
              
              ; the y-stuff, when a point is in the middle of a vertical line
              If \activePoint > 1 And \activePoint < \points - 2
                If pointArray(#PointBefore)\x = pointArray(#Point)\x And pointArray(#PointAfter)\x = pointArray(#Point)\x
                  If yPos > pointArray(#PointAfter)\y - \pointRadius : yPos = pointArray(#PointAfter)\y - \pointRadius : EndIf
                  If yPos < pointArray(#PointBefore)\y + \pointRadius : yPos = pointArray(#PointBefore)\y + \pointRadius : EndIf
                EndIf
              EndIf
              
              
              If xPos < \pointRadius: xPos = \pointRadius : EndIf
              If xPos > \width - \pointRadius: xPos = \width - \pointRadius : EndIf
              
              If xPos < pointArray(#PointBefore)\x + \minXSpacing
                xPos = pointArray(#PointBefore)\x + \minXSpacing
                
                If yPos > pointArray(#PointBefore)\y - \pointRadius And yPos < pointArray(#PointBefore)\y + \pointRadius
                  xPos + \pointRadius
                EndIf
                
                If \activePoint > 2
                  If xPos = pointArray(#TwoPointsBefore)\x
                    If pointArray(#TwoPointsBefore)\y - pointArray(#PointBefore)\y > 0
                      If yPos > pointArray(#PointBefore)\y
                        xPos + \pointRadius
                      EndIf
                    Else
                      If yPos < pointArray(#PointBefore)\y
                        xPos + \pointRadius
                      EndIf
                    EndIf
                  EndIf
                EndIf
              EndIf
              
              If xPos > pointArray(#PointAfter)\x - \minXSpacing
                xPos = pointArray(#PointAfter)\x - \minXSpacing
                
                If yPos < pointArray(#PointAfter)\y + \pointRadius And yPos > pointArray(#PointAfter)\y - \pointRadius
                  xPos - \pointRadius
                EndIf
                
                If \activePoint < \points - 2
                  If xPos = pointArray(#TwoPointsAfter)\x
                    If pointArray(#TwoPointsAfter)\y - pointArray(#PointAfter)\y > 0
                      If yPos > pointArray(#PointAfter)\y
                        xPos - \pointRadius
                      EndIf
                    Else
                      If yPos < pointArray(#PointAfter)\y
                        xPos - \pointRadius
                      EndIf
                    EndIf
                  EndIf
                EndIf
              EndIf
              
            Else
              If \activePoint = 0
                xPos = 0
              Else
                xPos = \width
              EndIf
            EndIf
            
            i = 0
            ForEach \dataPoint()
              If i = \activePoint
                If Not \yOnly
                  \dataPoint()\x = xPos
                EndIf
                \dataPoint()\y = yPos
                Break
              EndIf
              i + 1
            Next
            CurveGadgetDraw(gadgetNo)
            
          Else
            If CurveGadgetPointCheck(*CurveGadget, xPos, yPos) >= 0
              SetGadgetAttribute(gadgetNo, #PB_Canvas_Cursor, #PB_Cursor_Hand)
            Else
              SetGadgetAttribute(gadgetNo, #PB_Canvas_Cursor, #PB_Cursor_Default)
            EndIf
          EndIf
          
        Case #PB_EventType_LeftButtonUp
          If \activePoint <> -1
            \activePoint = -1
            result = 1
          EndIf
      EndSelect
    Else
      SetGadgetAttribute(gadgetNo, #PB_Canvas_Cursor, #PB_Cursor_Denied)
    EndIf
  EndWith
  
  ProcedureReturn result
EndProcedure


Procedure CurveGadgetDisable(gadgetNo, state)
  Protected *CurveGadget.CurveGadgetStr
 
  *CurveGadget = GetGadgetData(gadgetNo)
  If state
    If Not *CurveGadget\disabled
      *CurveGadget\disabled = #True
      CurveGadgetDraw(gadgetNo)
    EndIf
  Else
    If *CurveGadget\disabled
      *CurveGadget\disabled = #False
      CurveGadgetDraw(gadgetNo)
    EndIf
  EndIf
EndProcedure


Procedure CurveGadgetGetState(gadgetNo, Array dataPoint.POINT(1))
  Protected *CurveGadget.CurveGadgetStr
  Protected result, i
  
  result = #False
  
  If IsGadget(gadgetNo)
    *CurveGadget = GetGadgetData(gadgetNo)
    With *CurveGadget
      Dim dataPoint(\points - 1)
      i = 0
      ForEach \dataPoint()
        dataPoint(i)\x = \xScaleMax * \dataPoint()\x / \width
        dataPoint(i)\y = \yScaleMax - (\yScaleMax * \dataPoint()\y / \height)
        i + 1
      Next
    EndWith
    result = #True
  EndIf
  
  ProcedureReturn result
EndProcedure


Procedure CurveGadgetSetState(gadgetNo, Array dataPoint.POINT(1))
  Protected *CurveGadget.CurveGadgetStr
  Protected i.i
  
  If IsGadget(gadgetNo)
    *CurveGadget = GetGadgetData(gadgetNo)
    With *CurveGadget
      LSize = ListSize(\dataPoint()) - 1
      If LSize = ArraySize(dataPoint())
        i = 0
        ForEach \dataPoint()
          If i > 0 And i < LSize
            \dataPoint()\x = dataPoint(i)\x
          EndIf
          \dataPoint()\y = \height - dataPoint(i)\y
          i + 1
        Next
      EndIf
    EndWith
    CurveGadgetDraw(gadgetNo)
  EndIf
  
EndProcedure


Procedure CurveGadgetSetColor(gadgetNo, attribute, value)
  Protected *CurveGadget.CurveGadgetStr
 
  If IsGadget(gadgetNo)
    *CurveGadget = GetGadgetData(gadgetNo)
    With *CurveGadget
      Select attribute
        Case #PB_Gadget_FrontColor : \frontColor = value
        Case #PB_Gadget_BackColor : \backColor = value
        Case #PB_Gadget_DisableColor : \disableColor = value
      EndSelect
    EndWith
    CurveGadgetDraw(gadgetNo)
  EndIf
EndProcedure
And the demo

Code: Select all

XIncludeFile "CurveGadget.pbi"

Dim CurvePoint.POINT(1)

OpenWindow(0, 0, 0, 430, 340, "CurveGadget Demo", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)

No1 = CurveGadget(#PB_Any, 10, 10, 200, 100)
No2 = CurveGadget(#PB_Any, 10, 120, 200, 100)
No3 = CurveGadget(#PB_Any, 220, 120, 200, 100)
No4 = CurveGadget(#PB_Any, 10, 230, 200, 100)
No5 = CurveGadget(#PB_Any, 220, 230, 200, 100, 7)

CurveGadgetSetAttribute(No1, #CurveGadget_MinXSpacing, 20) ; test by Danilo

CurveGadgetSetColor(No2, #PB_Gadget_FrontColor, $FF0000)
CurveGadgetSetColor(No2, #PB_Gadget_BackColor, $00FFFF)

CurveGadgetSetAttribute(No2, #CurveGadget_Points, 8)
CurveGadgetSetAttribute(No2, #CurveGadget_PointRadius, 3)
CurveGadgetSetAttribute(No2, #CurveGadget_CatchRadius, 10)
CurveGadgetSetAttribute(No2, #CurveGadget_X_Maximum, 50)
CurveGadgetSetAttribute(No2, #CurveGadget_Y_Maximum, 20)

CurveGadgetSetAttribute(No3, #CurveGadget_Points, 2)

CurveGadgetSetAttribute(No4, #CurveGadget_Y_Only, #True)
CurveGadgetSetAttribute(No4, #CurveGadget_DrawLines, #False)
CurveGadgetSetAttribute(No4, #CurveGadget_DrawBars, #True)


CurveGadgetGetState(No5, CurvePoint())
CurvePoint(0)\x + 10    ; not possible
CurvePoint(1)\y + 10
CurvePoint(3)\y - 10
CurvePoint(4)\x + 10
CurvePoint(6)\y + 20
CurvePoint(6)\x - 20    ; not possible
CurveGadgetSetState(No5, CurvePoint())
CurveGadgetDisable(No5, #True)

Exit = #False
Repeat

  Event = WaitWindowEvent()

  Select Event
    Case #PB_Event_Gadget
      Select EventGadget()
        Case No1
          If CurveGadgetEvent(No1) = 1
            If CurveGadgetGetState(No1, CurvePoint())
              For i = 0 To ArraySize(CurvePoint())
                Debug "1: P" + Str(i + 1) + " (" + Str(CurvePoint(i)\x) + "/" + Str(CurvePoint(i)\y) + ")"
              Next i
            EndIf
          EndIf
        Case No2
          If CurveGadgetEvent(No2) = 1
            If CurveGadgetGetState(No2, CurvePoint())
              For i = 0 To ArraySize(CurvePoint())
                Debug "2: P" + Str(i + 1) + " (" + Str(CurvePoint(i)\x) + "/" + Str(CurvePoint(i)\y) + ")"
              Next i
            EndIf
          EndIf
        Case No3 : CurveGadgetEvent(No3)
        Case No4 : CurveGadgetEvent(No4)
        Case No5 : CurveGadgetEvent(No5)
      EndSelect
    Case #PB_Event_CloseWindow
      Exit = #True
  EndSelect

Until Exit
Bernd

Re: help please with creating a graphics component

Posted: Sat Jan 07, 2012 3:54 pm
by infratec
Hi Danilo,

try to put 2 points on top of each other with a distance greater than your choosen min_spacing.
It is not possible.

Do you know what I mean :?:

Or ist #CurveGadget_Min X PointSpacing what you mean :?:
So that you have a minimum x distance between the points?
MinPointSpacing is for means for me 'a circle around'.

Bernd

Re: help please with creating a graphics component

Posted: Sat Jan 07, 2012 3:58 pm
by infratec
Hi,

added CurveGadgetSetState()
Now we reached V11.

I changed the last listings above.

Bernd

Re: help please with creating a graphics component

Posted: Sat Jan 07, 2012 4:15 pm
by Danilo
infratec wrote:So that you have a minimum x distance between the points?
Korrekt. :)

It is not #CurveGadget_CircleAround. Call it #CurveGadget_MinimumXDistanceBetweenPoints if you like that more. ;)

It collides with your modification of not allowing points on each other little bit.
If you move points beside each other on Y-axis the points go CircleAround.

Re: help please with creating a graphics component

Posted: Sat Jan 07, 2012 4:47 pm
by infratec
Hi,

Danilos #CurveGadget_MinPointSpacing is now reborn as #CurveGadget_MinXSpacing.
(was a misunderstanding from me, sorry Danilo)
I changed the last listings above (V12)

Bernd

Re: help please with creating a graphics component

Posted: Sat Jan 07, 2012 7:05 pm
by infratec
Hi,

a hint from Michael Vogel showed me a bug :!:
It was possible to move a point from the middle of a vertical row over and under the next points.
I fixed this in V13 (see listing above).

Bernd
All times are UTC+01:00
Page 3 of 3

Powered by phpBB® Forum Software © phpBB Limited