help please with creating a graphics component

[infratec]

Hi,

a last addition: filterBoxGadgetSetColor()

Code: Select all

;Program: FilterBoxGadget.pbi
;Author: intratec, modified by Demivec
;version: 3

#FilterBoxPointCount = 5
#FilterBoxPointRadius = 5

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


Structure filterBoxGadgetStr
  dataPoint.POINT[#FilterBoxPointCount]
  width.i
  height.i
  disabled.i
  activePoint.i
  frontColor.i
  backColor.i
  disableColor.i
EndStructure


Procedure filterBoxGadgetDraw(gadgetNo)
 
  Protected *filterBoxGadget.filterBoxGadgetStr
  Protected i
 
  If IsGadget(gadgetNo)
    *filterBoxGadget = GetGadgetData(gadgetNo)
    With *filterBoxGadget
      If StartDrawing(CanvasOutput(gadgetNo))
        If \disabled
          Box(0, 0, \width, \height, \disableColor)
        Else
          Box(0, 0, \width, \height, \backColor)
        EndIf
        For i = 0 To #FilterBoxPointCount - 1
          Circle(\dataPoint[i]\x, \dataPoint[i]\y, #FilterBoxPointRadius, \frontColor)
          If i < #FilterBoxPointCount - 1
            LineXY(\dataPoint[i]\x, \dataPoint[i]\y, \dataPoint[i + 1]\x, \dataPoint[i + 1]\y, \frontColor)
          EndIf
        Next
        StopDrawing()
      EndIf
    EndWith
  EndIf
 
EndProcedure


Procedure filterBoxGadget(gadgetNo, x, y, width, height, fgc = $0000FF, bgc = $FFFFFF, dc = $E0E0E0)
  
  Protected *filterBoxGadget.filterBoxGadgetStr
  Protected i
  
  If gadgetNo = #PB_Any Or IsGadget(gadgetNo) = 0
    gadgetNo = CanvasGadget(#PB_Any, x, y, width, height, #PB_Canvas_Border)
    If gadgetNo
      *filterBoxGadget = AllocateMemory(SizeOf(filterBoxGadgetStr))
      SetGadgetData(gadgetNo, *filterBoxGadget)
      
      ;gadget output will be smaller if borders are drawn
      StartDrawing(CanvasOutput(gadgetNo))
        width = OutputWidth()
        height = OutputHeight()
      StopDrawing()
      With *filterBoxGadget
        \width = width
        \height = height
        \dataPoint[0]\x = 0
        \dataPoint[0]\y = height / 2
        For i = 1 To #FilterBoxPointCount - 2
          \dataPoint[i]\x = ((0.0 + width - #FilterBoxPointRadius) / (#FilterBoxPointCount - 1)) * i
          \dataPoint[i]\y = height / 2
        Next
        \dataPoint[#FilterBoxPointCount - 1]\x = width - 1
        \dataPoint[#FilterBoxPointCount - 1]\y = height / 2
        
        \disabled = #False
        \activePoint = -1
        \frontColor = fgc
        \backColor = bgc
        \disableColor = dc
      EndWith
    EndIf
  EndIf
  
  filterBoxGadgetDraw(gadgetNo)
  
  ProcedureReturn gadgetNo
  
EndProcedure


Procedure filterBoxGadgetEvent(gadgetNo)
  
  Protected *filterBoxGadget.filterBoxGadgetStr
  Protected result
  Protected xPos, yPos
  Protected i
  
  result = 0
  
  *filterBoxGadget = GetGadgetData(gadgetNo)
  
  With *filterBoxGadget
    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
            For i = 0 To #FilterBoxPointCount - 1
              If (\dataPoint[i]\x - #FilterBoxPointRadius) < xPos And (\dataPoint[i]\x + #FilterBoxPointRadius) > xPos
                If (\dataPoint[i]\y - #FilterBoxPointRadius) < yPos And (\dataPoint[i]\y + #FilterBoxPointRadius) > yPos
                  \activePoint = i
                  SetGadgetAttribute(gadgetNo, #PB_Canvas_Cursor, #PB_Cursor_Hand)
                  Break
                EndIf
              EndIf
            Next
          EndIf
        Case #PB_EventType_MouseMove
          If \activePoint <> -1
            \dataPoint[\activePoint]\y = yPos
            If \activePoint > 0 And \activePoint < #FilterBoxPointCount - 1
              If xPos < #FilterBoxPointRadius: xPos = #FilterBoxPointRadius: EndIf
              If xPos > \width - #FilterBoxPointRadius: xPos = \width - #FilterBoxPointRadius: EndIf
             
              If xPos >= \dataPoint[\activePoint - 1]\x
                If xPos <= \dataPoint[\activePoint + 1]\x
                  \dataPoint[\activePoint]\x = xPos
                Else
                  \dataPoint[\activePoint]\x = \dataPoint[\activePoint + 1]\x
                EndIf
              Else
                \dataPoint[\activePoint]\x = \dataPoint[\activePoint - 1]\x
              EndIf
            EndIf
            
            filterBoxGadgetDraw(gadgetNo)
          EndIf
        Case #PB_EventType_LeftButtonUp
          If \activePoint <> -1
            \activePoint = -1
            SetGadgetAttribute(gadgetNo, #PB_Canvas_Cursor, #PB_Cursor_Default)
            result = 1
          EndIf
      EndSelect
    EndIf
  EndWith
  
  ProcedureReturn result
  
EndProcedure


Procedure disableFilterBoxGadget(gadgetNo, state)
  
  Protected *filterBoxGadget.filterBoxGadgetStr
  
  *filterBoxGadget= GetGadgetData(gadgetNo)
  If state
    If Not *filterBoxGadget\disabled
      *filterBoxGadget\disabled = #True
      filterBoxGadgetDraw(gadgetNo)
    EndIf
  Else
    If *filterBoxGadget\disabled
      *filterBoxGadget\disabled = #False
      filterBoxGadgetDraw(gadgetNo)
    EndIf
  EndIf
  
EndProcedure


Procedure filterBoxGadgetGetState(gadgetNo, Array dataPoint.POINT(1))
  
  Protected *filterBoxGadget.filterBoxGadgetStr
  Protected result, i
  
  result = #False
  
  If IsGadget(gadgetNo)
    *filterBoxGadget = GetGadgetData(gadgetNo)
    Dim dataPoint(#FilterBoxPointCount - 1)
    For i = 0 To #FilterBoxPointCount - 1
      dataPoint(i)\x = *filterBoxGadget\dataPoint[i]\x
      dataPoint(i)\y = *filterBoxGadget\dataPoint[i]\y
    Next
    result = #True
  EndIf
  
  ProcedureReturn result
  
EndProcedure


Procedure filterBoxGadgetSetColor(gadgetNo, attribute, value)
  
  Protected *filterBoxGadget.filterBoxGadgetStr
  
  If IsGadget(gadgetNo)
    *filterBoxGadget = GetGadgetData(gadgetNo)
    With *filterBoxGadget
      Select attribute
        Case #PB_Gadget_FrontColor : \frontColor = value
        Case #PB_Gadget_BackColor : \backColor = value
        Case #PB_Gadget_DisableColor : \disableColor = value
      EndSelect
    EndWith
    filterBoxGadgetDraw(gadgetNo)
  EndIf
  
EndProcedure

And the main program

Code: Select all

XIncludeFile "FilterBoxGadget.pbi"

Dim filter.POINT(#FilterBoxPointCount - 1)

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

no1 = FilterBoxGadget(#PB_Any, 10, 10, 200, 100)
no2 = FilterBoxGadget(#PB_Any, 10, 120, 200, 100)
no3 = FilterBoxGadget(#PB_Any, 220, 120, 200, 100)
no4 = FilterBoxGadget(#PB_Any, 10, 230, 200, 100)
no5 = FilterBoxGadget(#PB_Any, 220, 230, 200, 100)

filterBoxGadgetSetColor(no2, #PB_Gadget_FrontColor, $FF0000)
filterBoxGadgetSetColor(no2, #PB_Gadget_BackColor, $00FFFF)

disableFilterBoxGadget(no5, #True)

exit = #False
Repeat
 
  event = WaitWindowEvent()
 
  Select event
    Case #PB_Event_Gadget
      Select EventGadget()
        Case no1
          If FilterBoxGadgetEvent(no1) = 1
            If FilterBoxGadgetGetState(no1, filter())
              For i = 0 To #FilterBoxPointCount - 1
                Debug "P" + Str(i + 1) + " (" + Str(filter(i)\x) + "/" + Str(filter(i)\y) + ")"
              Next i
            EndIf
          EndIf
        Case no2 : FilterBoxGadgetEvent(no2)
        Case no3 : FilterBoxGadgetEvent(no3)
        Case no4 : FilterBoxGadgetEvent(no4)
        Case no5 : FilterBoxGadgetEvent(no5)
      EndSelect
    Case #PB_Event_CloseWindow
      exit = #True
  EndSelect
 
Until exit

Now I know how to implement a new 'canvas' gadget

[Demivec]

But you have a typo in your listing which avoids compilation.
(Line 139 before EndSelect is a control byte (DC1))

Also I modified this procedure a bit to the needs (if I think right) of doctornash:

Thanks for removing that strange control byte, I thought I had removed it when I made the post but it still slipped by (edit made to previous post to correct this).

Nice addition also for now allowing color settings in the FilterBox too.

[Little John]

I made some modifcations to infratec's code. [...] It handles item #1 by changing the mouse cursor (pointer) to a hand when over a node and the left mouse button is pushed. The changing of the mouse cursor means a user should only have to push the left mouse button to see if they are on the point they want to move. If the mouse cursor doesn't change then they need to reposition the mouse.

I made another modification (based on infratec's last code), so that the mouse cursor becomes a hand when over a node, even if the left mouse button is not pushed. It works the same way now like in a web browser, when the the mouse cursor is over a link, indicating there is something "clickable" at that place.
This is the first time I'm programming the canvas gadget, so my modifications (denoted by **) are probably far from perfect, but at least they seem to work.

Code: Select all

; Program: FilterBoxGadget.pbi
; Author: intratec, modified by Demivec and  Little John
; version: 4

#FilterBoxPointCount = 5
#FilterBoxPointRadius = 5

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


Structure filterBoxGadgetStr
   dataPoint.POINT[#FilterBoxPointCount]
   width.i
   height.i
   disabled.i
   activePoint.i
   frontColor.i
   backColor.i
   disableColor.i
EndStructure


Procedure filterBoxGadgetDraw(gadgetNo)
   Protected *filterBoxGadget.filterBoxGadgetStr
   Protected i
   
   If IsGadget(gadgetNo)
      *filterBoxGadget = GetGadgetData(gadgetNo)
      With *filterBoxGadget
         If StartDrawing(CanvasOutput(gadgetNo))
            If \disabled
               Box(0, 0, \width, \height, \disableColor)
            Else
               Box(0, 0, \width, \height, \backColor)
            EndIf
            For i = 0 To #FilterBoxPointCount - 1
               Circle(\dataPoint[i]\x, \dataPoint[i]\y, #FilterBoxPointRadius, \frontColor)
               If i < #FilterBoxPointCount - 1
                  LineXY(\dataPoint[i]\x, \dataPoint[i]\y, \dataPoint[i + 1]\x, \dataPoint[i + 1]\y, \frontColor)
               EndIf
            Next
            StopDrawing()
         EndIf
      EndWith
   EndIf
EndProcedure


Procedure filterBoxGadget(gadgetNo, x, y, width, height, fgc = $0000FF, bgc = $FFFFFF, dc = $E0E0E0)
   Protected *filterBoxGadget.filterBoxGadgetStr
   Protected i
   
   If gadgetNo = #PB_Any Or IsGadget(gadgetNo) = 0
      gadgetNo = CanvasGadget(#PB_Any, x, y, width, height, #PB_Canvas_Border)
      If gadgetNo
         *filterBoxGadget = AllocateMemory(SizeOf(filterBoxGadgetStr))
         SetGadgetData(gadgetNo, *filterBoxGadget)
         
         ;gadget output will be smaller if borders are drawn
         StartDrawing(CanvasOutput(gadgetNo))
         width = OutputWidth()
         height = OutputHeight()
         StopDrawing()
         With *filterBoxGadget
            \width = width
            \height = height
            \dataPoint[0]\x = 0
            \dataPoint[0]\y = height / 2
            For i = 1 To #FilterBoxPointCount - 2
               \dataPoint[i]\x = ((0.0 + width - #FilterBoxPointRadius) / (#FilterBoxPointCount - 1)) * i
               \dataPoint[i]\y = height / 2
            Next
            \dataPoint[#FilterBoxPointCount - 1]\x = width - 1
            \dataPoint[#FilterBoxPointCount - 1]\y = height / 2
            
            \disabled = #False
            \activePoint = -1
            \frontColor = fgc
            \backColor = bgc
            \disableColor = dc
         EndWith
      EndIf
   EndIf
   
   filterBoxGadgetDraw(gadgetNo)
   
   ProcedureReturn gadgetNo
EndProcedure


Procedure filterBoxGadgetEvent(gadgetNo)
   Protected *filterBoxGadget.filterBoxGadgetStr
   Protected result
   Protected xPos, yPos
   Protected i
   
   result = 0
   
   *filterBoxGadget = GetGadgetData(gadgetNo)
   
   With *filterBoxGadget
      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
                  For i = 0 To #FilterBoxPointCount - 1
                     If (\dataPoint[i]\x - #FilterBoxPointRadius) < xPos And (\dataPoint[i]\x + #FilterBoxPointRadius) > xPos
                        If (\dataPoint[i]\y - #FilterBoxPointRadius) < yPos And (\dataPoint[i]\y + #FilterBoxPointRadius) > yPos
                           \activePoint = i
;**                            SetGadgetAttribute(gadgetNo, #PB_Canvas_Cursor, #PB_Cursor_Hand)
                           Break
                        EndIf
                     EndIf
                  Next
               EndIf
               
            Case #PB_EventType_MouseMove
               If \activePoint <> -1
                  \dataPoint[\activePoint]\y = yPos
                  If \activePoint > 0 And \activePoint < #FilterBoxPointCount - 1
                     If xPos < #FilterBoxPointRadius: xPos = #FilterBoxPointRadius: EndIf
                     If xPos > \width - #FilterBoxPointRadius: xPos = \width - #FilterBoxPointRadius: EndIf
                     
                     If xPos >= \dataPoint[\activePoint - 1]\x
                        If xPos <= \dataPoint[\activePoint + 1]\x
                           \dataPoint[\activePoint]\x = xPos
                        Else
                           \dataPoint[\activePoint]\x = \dataPoint[\activePoint + 1]\x
                        EndIf
                     Else
                        \dataPoint[\activePoint]\x = \dataPoint[\activePoint - 1]\x
                     EndIf
                  EndIf
                  
                  filterBoxGadgetDraw(gadgetNo)
                  
               Else         ;** new block:
                  found = #False
                  For i = 0 To #FilterBoxPointCount - 1
                     If (\dataPoint[i]\x - #FilterBoxPointRadius) < xPos And (\dataPoint[i]\x + #FilterBoxPointRadius) > xPos
                        If (\dataPoint[i]\y - #FilterBoxPointRadius) < yPos And (\dataPoint[i]\y + #FilterBoxPointRadius) > yPos
                           SetGadgetAttribute(gadgetNo, #PB_Canvas_Cursor, #PB_Cursor_Hand)
                           found = #True
                           Break
                        EndIf
                     EndIf
                  Next
                  If Not found
                     SetGadgetAttribute(gadgetNo, #PB_Canvas_Cursor, #PB_Cursor_Default)
                  EndIf
               EndIf
               
            Case #PB_EventType_LeftButtonUp
               If \activePoint <> -1
                  \activePoint = -1
;**                   SetGadgetAttribute(gadgetNo, #PB_Canvas_Cursor, #PB_Cursor_Default)
                  result = 1
               EndIf
         EndSelect
      EndIf
   EndWith
   
   ProcedureReturn result
EndProcedure


Procedure disableFilterBoxGadget(gadgetNo, state)
   Protected *filterBoxGadget.filterBoxGadgetStr
   
   *filterBoxGadget= GetGadgetData(gadgetNo)
   If state
      If Not *filterBoxGadget\disabled
         *filterBoxGadget\disabled = #True
         filterBoxGadgetDraw(gadgetNo)
      EndIf
   Else
      If *filterBoxGadget\disabled
         *filterBoxGadget\disabled = #False
         filterBoxGadgetDraw(gadgetNo)
      EndIf
   EndIf
EndProcedure


Procedure filterBoxGadgetGetState(gadgetNo, Array dataPoint.POINT(1))
   Protected *filterBoxGadget.filterBoxGadgetStr
   Protected result, i
   
   result = #False
   
   If IsGadget(gadgetNo)
      *filterBoxGadget = GetGadgetData(gadgetNo)
      Dim dataPoint(#FilterBoxPointCount - 1)
      For i = 0 To #FilterBoxPointCount - 1
         dataPoint(i)\x = *filterBoxGadget\dataPoint[i]\x
         dataPoint(i)\y = *filterBoxGadget\dataPoint[i]\y
      Next
      result = #True
   EndIf
   
   ProcedureReturn result
EndProcedure


Procedure filterBoxGadgetSetColor(gadgetNo, attribute, value)
   Protected *filterBoxGadget.filterBoxGadgetStr
   
   If IsGadget(gadgetNo)
      *filterBoxGadget = GetGadgetData(gadgetNo)
      With *filterBoxGadget
         Select attribute
            Case #PB_Gadget_FrontColor : \frontColor = value
            Case #PB_Gadget_BackColor : \backColor = value
            Case #PB_Gadget_DisableColor : \disableColor = value
         EndSelect
      EndWith
      filterBoxGadgetDraw(gadgetNo)
   EndIf
EndProcedure

Code: Select all

XIncludeFile "FilterBoxGadget.pbi"

Dim filter.POINT(#FilterBoxPointCount - 1)

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

no1 = FilterBoxGadget(#PB_Any, 10, 10, 200, 100)
no2 = FilterBoxGadget(#PB_Any, 10, 120, 200, 100)
no3 = FilterBoxGadget(#PB_Any, 220, 120, 200, 100)
no4 = FilterBoxGadget(#PB_Any, 10, 230, 200, 100)
no5 = FilterBoxGadget(#PB_Any, 220, 230, 200, 100)

filterBoxGadgetSetColor(no2, #PB_Gadget_FrontColor, $FF0000)
filterBoxGadgetSetColor(no2, #PB_Gadget_BackColor, $00FFFF)

disableFilterBoxGadget(no5, #True)

exit = #False
Repeat
   event = WaitWindowEvent()
   
   Select event
      Case #PB_Event_Gadget
         Select EventGadget()
            Case no1
               If FilterBoxGadgetEvent(no1) = 1
                  If FilterBoxGadgetGetState(no1, filter())
                     For i = 0 To #FilterBoxPointCount - 1
                        Debug "P" + Str(i + 1) + " (" + Str(filter(i)\x) + "/" + Str(filter(i)\y) + ")"
                     Next i
                  EndIf
               EndIf
            Case no2 : FilterBoxGadgetEvent(no2)
            Case no3 : FilterBoxGadgetEvent(no3)
            Case no4 : FilterBoxGadgetEvent(no4)
            Case no5 : FilterBoxGadgetEvent(no5)
         EndSelect
      Case #PB_Event_CloseWindow
         exit = #True
   EndSelect
Until exit

Regards, Little John

[Demivec]

@Little John: Nice change. That is what I originally wanted to do with the cursors but didn't quite get there.

I split off some of the now repeated event code into another procedure called filterBoxGadget_pointCheck(). The functional remains the same as per your modifications.

Code: Select all

; Program: FilterBoxGadget.pbi
; Author: intratec, modified by Demivec and  Little John
; version: 4

#FilterBoxPointCount = 5
#FilterBoxPointRadius = 5

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


Structure filterBoxGadgetStr
  dataPoint.POINT[#FilterBoxPointCount]
  width.i
  height.i
  disabled.i
  activePoint.i
  frontColor.i
  backColor.i
  disableColor.i
EndStructure


Procedure filterBoxGadgetDraw(gadgetNo)
  Protected *filterBoxGadget.filterBoxGadgetStr
  Protected i
  
  If IsGadget(gadgetNo)
    *filterBoxGadget = GetGadgetData(gadgetNo)
    With *filterBoxGadget
      If StartDrawing(CanvasOutput(gadgetNo))
          If \disabled
            Box(0, 0, \width, \height, \disableColor)
          Else
            Box(0, 0, \width, \height, \backColor)
          EndIf
          For i = 0 To #FilterBoxPointCount - 1
            Circle(\dataPoint[i]\x, \dataPoint[i]\y, #FilterBoxPointRadius, \frontColor)
            If i < #FilterBoxPointCount - 1
              LineXY(\dataPoint[i]\x, \dataPoint[i]\y, \dataPoint[i + 1]\x, \dataPoint[i + 1]\y, \frontColor)
            EndIf
          Next
        StopDrawing()
      EndIf
    EndWith
  EndIf
EndProcedure


Procedure filterBoxGadget(gadgetNo, x, y, width, height, fgc = $0000FF, bgc = $FFFFFF, dc = $E0E0E0)
  Protected *filterBoxGadget.filterBoxGadgetStr
  Protected i
  
  If gadgetNo = #PB_Any Or IsGadget(gadgetNo) = 0
    gadgetNo = CanvasGadget(#PB_Any, x, y, width, height, #PB_Canvas_Border)
    If gadgetNo
      *filterBoxGadget = AllocateMemory(SizeOf(filterBoxGadgetStr))
      SetGadgetData(gadgetNo, *filterBoxGadget)
      
      ;gadget output will be smaller if borders are drawn
      StartDrawing(CanvasOutput(gadgetNo))
        width = OutputWidth()
        height = OutputHeight()
      StopDrawing()
      With *filterBoxGadget
        \width = width
        \height = height
        \dataPoint[0]\x = 0
        \dataPoint[0]\y = height / 2
        For i = 1 To #FilterBoxPointCount - 2
          \dataPoint[i]\x = ((0.0 + width - #FilterBoxPointRadius) / (#FilterBoxPointCount - 1)) * i
          \dataPoint[i]\y = height / 2
        Next
        \dataPoint[#FilterBoxPointCount - 1]\x = width - 1
        \dataPoint[#FilterBoxPointCount - 1]\y = height / 2
        
        \disabled = #False
        \activePoint = -1
        \frontColor = fgc
        \backColor = bgc
        \disableColor = dc
      EndWith
    EndIf
  EndIf
  
  filterBoxGadgetDraw(gadgetNo)
  
  ProcedureReturn gadgetNo
EndProcedure

Procedure filterBoxGadget_pointCheck(*filterBoxGadget.filterBoxGadgetStr, 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 *filterBoxGadget
    For i = 0 To #FilterBoxPointCount - 1
      If (\dataPoint[i]\x - #FilterBoxPointRadius) < xPos And (\dataPoint[i]\x + #FilterBoxPointRadius) > xPos
        If (\dataPoint[i]\y - #FilterBoxPointRadius) < yPos And (\dataPoint[i]\y + #FilterBoxPointRadius) > yPos
          ProcedureReturn i ;found a point
        EndIf
      EndIf
    Next
  EndWith
  
  ProcedureReturn -1 ;no point at (xPos, yPos)
EndProcedure

Procedure filterBoxGadgetEvent(gadgetNo)
  Protected *filterBoxGadget.filterBoxGadgetStr
  Protected result
  Protected xPos, yPos
  
  *filterBoxGadget = GetGadgetData(gadgetNo)
  
  With *filterBoxGadget
    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 = filterBoxGadget_pointCheck(*filterBoxGadget, xPos, yPos)
          EndIf
          
        Case #PB_EventType_MouseMove
          If \activePoint <> -1
            \dataPoint[\activePoint]\y = yPos
            If \activePoint > 0 And \activePoint < #FilterBoxPointCount - 1
              If xPos < #FilterBoxPointRadius: xPos = #FilterBoxPointRadius: EndIf
              If xPos > \width - #FilterBoxPointRadius: xPos = \width - #FilterBoxPointRadius: EndIf
              
              If xPos >= \dataPoint[\activePoint - 1]\x
                If xPos <= \dataPoint[\activePoint + 1]\x
                  \dataPoint[\activePoint]\x = xPos
                Else
                  \dataPoint[\activePoint]\x = \dataPoint[\activePoint + 1]\x
                EndIf
              Else
                \dataPoint[\activePoint]\x = \dataPoint[\activePoint - 1]\x
              EndIf
            EndIf
            
            filterBoxGadgetDraw(gadgetNo)
            
          Else
            If filterBoxGadget_pointCheck(*filterBoxGadget, 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
    EndIf
  EndWith
  
  ProcedureReturn result
EndProcedure


Procedure disableFilterBoxGadget(gadgetNo, state)
  Protected *filterBoxGadget.filterBoxGadgetStr
  
  *filterBoxGadget= GetGadgetData(gadgetNo)
  If state
    If Not *filterBoxGadget\disabled
      *filterBoxGadget\disabled = #True
      filterBoxGadgetDraw(gadgetNo)
    EndIf
  Else
    If *filterBoxGadget\disabled
      *filterBoxGadget\disabled = #False
      filterBoxGadgetDraw(gadgetNo)
    EndIf
  EndIf
EndProcedure


Procedure filterBoxGadgetGetState(gadgetNo, Array dataPoint.POINT(1))
  Protected *filterBoxGadget.filterBoxGadgetStr
  Protected result, i
  
  result = #False
  
  If IsGadget(gadgetNo)
    *filterBoxGadget = GetGadgetData(gadgetNo)
    Dim dataPoint(#FilterBoxPointCount - 1)
    For i = 0 To #FilterBoxPointCount - 1
      dataPoint(i)\x = *filterBoxGadget\dataPoint[i]\x
      dataPoint(i)\y = *filterBoxGadget\dataPoint[i]\y
    Next
    result = #True
  EndIf
  
  ProcedureReturn result
EndProcedure


Procedure filterBoxGadgetSetColor(gadgetNo, attribute, value)
  Protected *filterBoxGadget.filterBoxGadgetStr
  
  If IsGadget(gadgetNo)
    *filterBoxGadget = GetGadgetData(gadgetNo)
    With *filterBoxGadget
      Select attribute
        Case #PB_Gadget_FrontColor : \frontColor = value
        Case #PB_Gadget_BackColor : \backColor = value
        Case #PB_Gadget_DisableColor : \disableColor = value
      EndSelect
    EndWith
    filterBoxGadgetDraw(gadgetNo)
  EndIf
EndProcedure

[Little John]

Hi,

it's quite interesting to watch the "evolution" of this code.

Regards, Little John

[infratec]

Hi,

added a scaling option for the result filterBoxGadgetSetAttribute()

Thought about netmaestros hint: He is right
So I modified the allowed placing.
(doctornashs stuff is still possible)

Code: Select all

; Program: FilterBoxGadget.pbi
; Author: intratec, modified by Demivec and Little John
; version: 6
;
; History:
;
; 6 (infratec) added attribute #FilterBoxX_PointRadius and #FilterBoxX_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

#FilterBoxPointCount = 5

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

Enumeration
  #FilterBox_PointRadius
  #FilterBox_CatchRadius
  #FilterBoxX_Maximum
  #FilterBoxY_Maximum
EndEnumeration

Structure filterBoxGadgetStr
  dataPoint.POINT[#FilterBoxPointCount]
  width.i
  height.i
  disabled.i
  activePoint.i
  frontColor.i
  backColor.i
  disableColor.i
  xScaleMax.f
  yScaleMax.f
  pointRadius.i
  catchRadius.i
EndStructure


Procedure filterBoxGadgetDraw(gadgetNo)
  Protected *filterBoxGadget.filterBoxGadgetStr
  Protected i
 
  If IsGadget(gadgetNo)
    *filterBoxGadget = GetGadgetData(gadgetNo)
    With *filterBoxGadget
      If StartDrawing(CanvasOutput(gadgetNo))
          If \disabled
            Box(0, 0, \width, \height, \disableColor)
          Else
            Box(0, 0, \width, \height, \backColor)
          EndIf
          For i = 0 To #FilterBoxPointCount - 1
            Circle(\dataPoint[i]\x, \dataPoint[i]\y, \pointRadius, \frontColor)
            If i < #FilterBoxPointCount - 1
              LineXY(\dataPoint[i]\x, \dataPoint[i]\y, \dataPoint[i + 1]\x, \dataPoint[i + 1]\y, \frontColor)
            EndIf
          Next
        StopDrawing()
      EndIf
    EndWith
  EndIf
EndProcedure


Procedure filterBoxGadget(gadgetNo, x, y, width, height, fgc = $0000FF, bgc = $FFFFFF, dc = $E0E0E0)
  Protected *filterBoxGadget.filterBoxGadgetStr
  Protected i
 
  If gadgetNo = #PB_Any Or IsGadget(gadgetNo) = 0
    gadgetNo = CanvasGadget(#PB_Any, x, y, width, height, #PB_Canvas_Border)
    If gadgetNo
      *filterBoxGadget = AllocateMemory(SizeOf(filterBoxGadgetStr))
      SetGadgetData(gadgetNo, *filterBoxGadget)
     
      ;gadget output will be smaller if borders are drawn
      StartDrawing(CanvasOutput(gadgetNo))
        width = OutputWidth()
        height = OutputHeight()
      StopDrawing()
      With *filterBoxGadget
        \width = width
        \height = height
        \disabled = #False
        \activePoint = -1
        \frontColor = fgc
        \backColor = bgc
        \disableColor = dc
        \xScaleMax = width
        \yScaleMax = height
        \pointRadius = 5
        \catchRadius = 5
        
        \dataPoint[0]\x = 0
        \dataPoint[0]\y = height / 2
        For i = 1 To #FilterBoxPointCount - 2
          \dataPoint[i]\x = ((0.0 + width - \pointRadius) / (#FilterBoxPointCount - 1)) * i
          \dataPoint[i]\y = height / 2
        Next
        \dataPoint[#FilterBoxPointCount - 1]\x = width - 1
        \dataPoint[#FilterBoxPointCount - 1]\y = height / 2
      EndWith
    EndIf
  EndIf
 
  filterBoxGadgetDraw(gadgetNo)
 
  ProcedureReturn gadgetNo
EndProcedure


Procedure filterBoxGadget_pointCheck(*filterBoxGadget.filterBoxGadgetStr, 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 *filterBoxGadget
    For i = 0 To #FilterBoxPointCount - 1
      If (\dataPoint[i]\x - \catchRadius) < xPos And (\dataPoint[i]\x + \catchRadius) > xPos
        If (\dataPoint[i]\y - \catchRadius) < yPos And (\dataPoint[i]\y + \catchRadius) > yPos
          ProcedureReturn i ;found a point
        EndIf
      EndIf
    Next
  EndWith
 
  ProcedureReturn -1 ;no point at (xPos, yPos)
EndProcedure


Procedure filterBoxGadgetEvent(gadgetNo)
  Protected *filterBoxGadget.filterBoxGadgetStr
  Protected result
  Protected xPos, yPos
 
  *filterBoxGadget = GetGadgetData(gadgetNo)
 
  With *filterBoxGadget
    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 = filterBoxGadget_pointCheck(*filterBoxGadget, xPos, yPos)
          EndIf
         
        Case #PB_EventType_MouseMove
          If \activePoint <> -1
            
            If \activePoint > 0 And \activePoint < #FilterBoxPointCount - 1
              If xPos < \pointRadius: xPos = \pointRadius : EndIf
              If xPos > \width - \pointRadius: xPos = \width - \pointRadius : EndIf
              
              If xPos < \dataPoint[\activePoint - 1]\x
                xPos = \dataPoint[\activePoint - 1]\x
                
                If yPos > \dataPoint[\activePoint - 1]\y - \pointRadius And yPos < \dataPoint[\activePoint - 1]\y + \pointRadius
                  xPos + \pointRadius
                EndIf
                
                If \activePoint > 2
                  If xPos = \dataPoint[\activePoint - 2]\x
                    If yPos < \dataPoint[\activePoint - 1]\y
                      xPos + \pointRadius
                    EndIf
                  EndIf
                EndIf
              EndIf
              
              If xPos > \dataPoint[\activePoint + 1]\x
                xPos = \dataPoint[\activePoint + 1]\x
                
                If yPos < \dataPoint[\activePoint + 1]\y + \pointRadius And yPos > \dataPoint[\activePoint + 1]\y - \pointRadius
                  xPos - \pointRadius
                EndIf
                
                If \activePoint < #FilterBoxPointCount - 2
                  If xPos = \dataPoint[\activePoint + 2]\x
                    If yPos > \dataPoint[\activePoint + 1]\y
                      xPos - \pointRadius
                    EndIf
                  EndIf
                EndIf
              EndIf
              
              \dataPoint[\activePoint]\x = xPos
            EndIf
            
            \dataPoint[\activePoint]\y = yPos
            filterBoxGadgetDraw(gadgetNo)
           
          Else
            If filterBoxGadget_pointCheck(*filterBoxGadget, 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
    EndIf
  EndWith
 
  ProcedureReturn result
EndProcedure


Procedure disableFilterBoxGadget(gadgetNo, state)
  Protected *filterBoxGadget.filterBoxGadgetStr
 
  *filterBoxGadget= GetGadgetData(gadgetNo)
  If state
    If Not *filterBoxGadget\disabled
      *filterBoxGadget\disabled = #True
      filterBoxGadgetDraw(gadgetNo)
    EndIf
  Else
    If *filterBoxGadget\disabled
      *filterBoxGadget\disabled = #False
      filterBoxGadgetDraw(gadgetNo)
    EndIf
  EndIf
EndProcedure


Procedure filterBoxGadgetGetState(gadgetNo, Array dataPoint.POINT(1))
  Protected *filterBoxGadget.filterBoxGadgetStr
  Protected result, i
  
  result = #False
  
  If IsGadget(gadgetNo)
    *filterBoxGadget = GetGadgetData(gadgetNo)
    Dim dataPoint(#FilterBoxPointCount - 1)
    For i = 0 To #FilterBoxPointCount - 1
      dataPoint(i)\x = *filterBoxGadget\xScaleMax * *filterBoxGadget\dataPoint[i]\x / *filterBoxGadget\width
      dataPoint(i)\y = *filterBoxGadget\yScaleMax - (*filterBoxGadget\yScaleMax * *filterBoxGadget\dataPoint[i]\y / *filterBoxGadget\height)
    Next
    result = #True
  EndIf
  
  ProcedureReturn result
EndProcedure


Procedure filterBoxGadgetSetColor(gadgetNo, attribute, value)
  Protected *filterBoxGadget.filterBoxGadgetStr
 
  If IsGadget(gadgetNo)
    *filterBoxGadget = GetGadgetData(gadgetNo)
    With *filterBoxGadget
      Select attribute
        Case #PB_Gadget_FrontColor : \frontColor = value
        Case #PB_Gadget_BackColor : \backColor = value
        Case #PB_Gadget_DisableColor : \disableColor = value
      EndSelect
    EndWith
    filterBoxGadgetDraw(gadgetNo)
  EndIf
EndProcedure


Procedure filterBoxGadgetSetAttribute(gadgetNo, attribute, value)
  Protected *filterBoxGadget.filterBoxGadgetStr
  
  If IsGadget(gadgetNo)
    *filterBoxGadget = GetGadgetData(gadgetNo)
    With *filterBoxGadget
      Select attribute
        Case #FilterBox_PointRadius : \pointRadius = value
        Case #FilterBox_CatchRadius : \catchRadius = value
        Case #FilterBoxX_Maximum : \xScaleMax = value
        Case #FilterBoxY_Maximum : \yScaleMax = value
      EndSelect
    EndWith
    filterBoxGadgetDraw(gadgetNo)
  EndIf
EndProcedure

and the new example

Code: Select all

XIncludeFile "FilterBoxGadget.pbi"

Dim filter.POINT(#FilterBoxPointCount - 1)

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

no1 = FilterBoxGadget(#PB_Any, 10, 10, 200, 100)
no2 = FilterBoxGadget(#PB_Any, 10, 120, 200, 100)
no3 = FilterBoxGadget(#PB_Any, 220, 120, 200, 100)
no4 = FilterBoxGadget(#PB_Any, 10, 230, 200, 100)
no5 = FilterBoxGadget(#PB_Any, 220, 230, 200, 100)

filterBoxGadgetSetColor(no2, #PB_Gadget_FrontColor, $FF0000)
filterBoxGadgetSetColor(no2, #PB_Gadget_BackColor, $00FFFF)

filterBoxGadgetSetAttribute(no2, #FilterBox_PointRadius, 3)
filterBoxGadgetSetAttribute(no2, #FilterBox_CatchRadius, 10)
filterBoxGadgetSetAttribute(no2, #FilterBoxX_Maximum, 50)
filterBoxGadgetSetAttribute(no2, #FilterBoxY_Maximum, 20)

disableFilterBoxGadget(no5, #True)

exit = #False
Repeat
 
  event = WaitWindowEvent()
 
  Select event
    Case #PB_Event_Gadget
      Select EventGadget()
        Case no1
          If FilterBoxGadgetEvent(no1) = 1
            If FilterBoxGadgetGetState(no1, filter())
              For i = 0 To #FilterBoxPointCount - 1
                Debug "1: P" + Str(i + 1) + " (" + Str(filter(i)\x) + "/" + Str(filter(i)\y) + ")"
              Next i
            EndIf
          EndIf
        Case no2
          If FilterBoxGadgetEvent(no2) = 1
            If FilterBoxGadgetGetState(no2, filter())
              For i = 0 To #FilterBoxPointCount - 1
                Debug "2: P" + Str(i + 1) + " (" + Str(filter(i)\x) + "/" + Str(filter(i)\y) + ")"
              Next i
            EndIf
          EndIf
        Case no3 : FilterBoxGadgetEvent(no3)
        Case no4 : FilterBoxGadgetEvent(no4)
        Case no5 : FilterBoxGadgetEvent(no5)
      EndSelect
    Case #PB_Event_CloseWindow
      exit = #True
  EndSelect
 
Until exit

Bernd

[kenmo]

This is the first time I'm programming the canvas gadget, so my modifications (denoted by **) are probably far from perfect, but at least they seem to work.

You should keep experimenting with it! It's my favorite new PB feature in a long time (...glances around, considers starting a CanvasGadget appreciation thread, realizes how nerdy it sounds...)

[infratec]

Hi,

was not tired enough

added #FilterBox_PointRadius and #FilterBox_CatchRadius.
I changed the listings above (version 6).

Tomorrow, when I have time, I try to implement to set the number of points as attribute.

Good night
(1.02am local time, still hollidays )

Bernd

[infratec]

Hi,

I proudly present V7

I added the attribute #FilterBox_Points

Code: Select all

; Program: FilterBoxGadget.pbi
; Author: intratec, modified by Demivec and Little John
; version: 7
;
; History:
;
; 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
  #FilterBox_Points
  #FilterBox_PointRadius
  #FilterBox_CatchRadius
  #FilterBoxX_Maximum
  #FilterBoxY_Maximum
EndEnumeration

Structure filterBoxGadgetStr
  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
EndStructure


Procedure filterBoxGadgetDraw(gadgetNo)
  Protected *filterBoxGadget.filterBoxGadgetStr
  Protected i, x1, y1
 
  If IsGadget(gadgetNo)
    *filterBoxGadget = GetGadgetData(gadgetNo)
    With *filterBoxGadget
      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())
            LineXY(x1, y1, \dataPoint()\x, \dataPoint()\y, \frontColor)
            i + 1
          Wend
        StopDrawing()
      EndIf
    EndWith
  EndIf
EndProcedure


Procedure filterBoxGadget(gadgetNo, x, y, width, height, points = 5, fgc = $0000FF, bgc = $FFFFFF, dc = $E0E0E0)
  Protected *filterBoxGadget.filterBoxGadgetStr
  Protected i
 
  If gadgetNo = #PB_Any Or IsGadget(gadgetNo) = 0
    gadgetNo = CanvasGadget(#PB_Any, x, y, width, height, #PB_Canvas_Border)
    If gadgetNo
      *filterBoxGadget = AllocateMemory(SizeOf(filterBoxGadgetStr))
      SetGadgetData(gadgetNo, *filterBoxGadget)
     
      ;gadget output will be smaller if borders are drawn
      StartDrawing(CanvasOutput(gadgetNo))
        width = OutputWidth()
        height = OutputHeight()
      StopDrawing()
      With *filterBoxGadget
        \width = width
        \height = height
        \disabled = #False
        \activePoint = -1
        \frontColor = fgc
        \backColor = bgc
        \disableColor = dc
        \xScaleMax = width
        \yScaleMax = height
        \pointRadius = 5
        \catchRadius = 5
        \points = points
        
        NewList \dataPoint.POINT()
        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
      EndWith
    EndIf
  EndIf
 
  filterBoxGadgetDraw(gadgetNo)
 
  ProcedureReturn gadgetNo
EndProcedure


Procedure filterBoxGadget_pointCheck(*filterBoxGadget.filterBoxGadgetStr, 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 *filterBoxGadget
    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 filterBoxGadgetEvent(gadgetNo)
  Protected *filterBoxGadget.filterBoxGadgetStr
  Protected result
  Protected i, xPos, yPos
 
  *filterBoxGadget = GetGadgetData(gadgetNo)
 
  With *filterBoxGadget
    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 = filterBoxGadget_pointCheck(*filterBoxGadget, xPos, yPos)
          EndIf
         
        Case #PB_EventType_MouseMove
          If \activePoint <> -1
            
            Dim pointArray.POINT(4)
            
            i = 0
            ForEach \dataPoint()
              If i = \activePoint - 2
                pointArray(0)\x = \dataPoint()\x
                pointArray(0)\y = \dataPoint()\y
              ElseIf i = \activePoint - 1
                pointArray(1)\x = \dataPoint()\x
                pointArray(1)\y = \dataPoint()\y
              ElseIf i = \activePoint
                pointArray(2)\x = \dataPoint()\x
                pointArray(2)\y = \dataPoint()\y
              ElseIf i = \activePoint + 1
                pointArray(3)\x = \dataPoint()\x
                pointArray(3)\y = \dataPoint()\y
              ElseIf i = \activePoint + 2
                pointArray(4)\x = \dataPoint()\x
                pointArray(4)\y = \dataPoint()\y
                Break
              EndIf
              i + 1
            Next
            
            If \activePoint > 0 And \activePoint < \points - 1
              If xPos < \pointRadius: xPos = \pointRadius : EndIf
              If xPos > \width - \pointRadius: xPos = \width - \pointRadius : EndIf
              
              If xPos < pointArray(1)\x
                xPos = pointArray(1)\x
                
                If yPos > pointArray(1)\y - \pointRadius And yPos < pointArray(1)\y + \pointRadius
                  xPos + \pointRadius
                EndIf
                
                If \activePoint > 2
                  If xPos = pointArray(0)\x
                    If yPos < pointArray(1)\y
                      xPos + \pointRadius
                    EndIf
                  EndIf
                EndIf
              EndIf
              
              If xPos > pointArray(3)\x
                xPos = pointArray(3)\x
                
                If yPos < pointArray(3)\y + \pointRadius And yPos > pointArray(3)\y - \pointRadius
                  xPos - \pointRadius
                EndIf
                
                If \activePoint < \points - 2
                  If xPos = pointArray(4)\x
                    If yPos > pointArray(3)\y
                      xPos - \pointRadius
                    EndIf
                  EndIf
                EndIf
              EndIf
            Else
              If \activePoint = 0
                xPos = 0
              Else
                xPos = \width
              EndIf
            EndIf
            
            i = 0
            ForEach \dataPoint()
              If i = \activePoint
                \dataPoint()\x = xPos
                \dataPoint()\y = yPos
                Break
              EndIf
              i + 1
            Next
            filterBoxGadgetDraw(gadgetNo)
           
          Else
            If filterBoxGadget_pointCheck(*filterBoxGadget, 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
    EndIf
  EndWith
 
  ProcedureReturn result
EndProcedure


Procedure disableFilterBoxGadget(gadgetNo, state)
  Protected *filterBoxGadget.filterBoxGadgetStr
 
  *filterBoxGadget= GetGadgetData(gadgetNo)
  If state
    If Not *filterBoxGadget\disabled
      *filterBoxGadget\disabled = #True
      filterBoxGadgetDraw(gadgetNo)
    EndIf
  Else
    If *filterBoxGadget\disabled
      *filterBoxGadget\disabled = #False
      filterBoxGadgetDraw(gadgetNo)
    EndIf
  EndIf
EndProcedure


Procedure filterBoxGadgetGetState(gadgetNo, Array dataPoint.POINT(1))
  Protected *filterBoxGadget.filterBoxGadgetStr
  Protected result, i
  
  result = #False
  
  If IsGadget(gadgetNo)
    *filterBoxGadget = GetGadgetData(gadgetNo)
    With *filterBoxGadget
      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 filterBoxGadgetSetColor(gadgetNo, attribute, value)
  Protected *filterBoxGadget.filterBoxGadgetStr
 
  If IsGadget(gadgetNo)
    *filterBoxGadget = GetGadgetData(gadgetNo)
    With *filterBoxGadget
      Select attribute
        Case #PB_Gadget_FrontColor : \frontColor = value
        Case #PB_Gadget_BackColor : \backColor = value
        Case #PB_Gadget_DisableColor : \disableColor = value
      EndSelect
    EndWith
    filterBoxGadgetDraw(gadgetNo)
  EndIf
EndProcedure


Procedure filterBoxGadgetSetAttribute(gadgetNo, attribute, value)
  Protected *filterBoxGadget.filterBoxGadgetStr
  Protected i.i
  
  If IsGadget(gadgetNo)
    *filterBoxGadget = GetGadgetData(gadgetNo)
    With *filterBoxGadget
      Select attribute
        Case #FilterBox_Points
          \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 #FilterBox_PointRadius : \pointRadius = value
        Case #FilterBox_CatchRadius : \catchRadius = value
        Case #FilterBoxX_Maximum : \xScaleMax = value
        Case #FilterBoxY_Maximum : \yScaleMax = value
      EndSelect
    EndWith
    filterBoxGadgetDraw(gadgetNo)
  EndIf
EndProcedure

and the example

Code: Select all

XIncludeFile "FilterBoxGadget.pbi"

Dim filter.POINT(1)

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

no1 = FilterBoxGadget(#PB_Any, 10, 10, 200, 100)
no2 = FilterBoxGadget(#PB_Any, 10, 120, 200, 100)
no3 = FilterBoxGadget(#PB_Any, 220, 120, 200, 100)
no4 = FilterBoxGadget(#PB_Any, 10, 230, 200, 100)
no5 = FilterBoxGadget(#PB_Any, 220, 230, 200, 100)

filterBoxGadgetSetColor(no2, #PB_Gadget_FrontColor, $FF0000)
filterBoxGadgetSetColor(no2, #PB_Gadget_BackColor, $00FFFF)

filterBoxGadgetSetAttribute(no2, #FilterBox_Points, 8)
filterBoxGadgetSetAttribute(no2, #FilterBox_PointRadius, 3)
filterBoxGadgetSetAttribute(no2, #FilterBox_CatchRadius, 10)
filterBoxGadgetSetAttribute(no2, #FilterBoxX_Maximum, 50)
filterBoxGadgetSetAttribute(no2, #FilterBoxY_Maximum, 20)

disableFilterBoxGadget(no5, #True)

exit = #False
Repeat
 
  event = WaitWindowEvent()
 
  Select event
    Case #PB_Event_Gadget
      Select EventGadget()
        Case no1
          If FilterBoxGadgetEvent(no1) = 1
            If FilterBoxGadgetGetState(no1, filter())
              For i = 0 To ArraySize(filter())
                Debug "1: P" + Str(i + 1) + " (" + Str(filter(i)\x) + "/" + Str(filter(i)\y) + ")"
              Next i
            EndIf
          EndIf
        Case no2
          If FilterBoxGadgetEvent(no2) = 1
            If FilterBoxGadgetGetState(no2, filter())
              For i = 0 To ArraySize(filter())
                Debug "2: P" + Str(i + 1) + " (" + Str(filter(i)\x) + "/" + Str(filter(i)\y) + ")"
              Next i
            EndIf
          EndIf
        Case no3 : FilterBoxGadgetEvent(no3)
        Case no4 : FilterBoxGadgetEvent(no4)
        Case no5 : FilterBoxGadgetEvent(no5)
      EndSelect
    Case #PB_Event_CloseWindow
      exit = #True
  EndSelect
 
Until exit

Bernd

P.S.: But now I have todo my homework

[Demivec]

I have a small improvement to reduce duplicated code. Move the filterBoxGadgetSetAttribute() procedure so that it is before the filterBoxGadget() procedure and modify the code for filterBoxGadget() to be:

Code: Select all

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

Functionality will remain the same as version 7.

[infratec]

Hi,

I added Demivecs suggestion and added also some small corrections.
Biggest change: I renamed everything to CurveGadget

So save this as CurveGadget.pbi:

Code: Select all

; Program: CurveGadget.pbi
; Author: intratec, modified by Demivec and Little John
; version: 9
;
; History:
;
; 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
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
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())
            LineXY(x1, y1, \dataPoint()\x, \dataPoint()\y, \frontColor)
            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
      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
        
        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
    #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(3)
            
            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 + 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
              If xPos < \pointRadius: xPos = \pointRadius : EndIf
              If xPos > \width - \pointRadius: xPos = \width - \pointRadius : EndIf
              
              If xPos < pointArray(#PointBefore)\x
                xPos = pointArray(#PointBefore)\x
                
                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
                xPos = pointArray(#PointAfter)\x
                
                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
                \dataPoint()\x = xPos
                \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 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 modified CurveGadget 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)

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)

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

Please test it, because I'm sure that I it happens once, that the
'over each other placing' failed one time.
At the next program, start it was Ok.
I was not able to reproduce it.

Bernd

[infratec]

Found the bug

I have to calculate the direction of the curve before I can check
if it is allowed or not.

I changed the listing above.
V9 is now the latest version.

[Little John]

Nicely done again, infratec!

Best regards, LJ

[Danilo]

10 (Danilo) introduced attribute #CurveGadget_MinPointSpacing

Seach for 'Danilo' to see the 10 small modifications.
Added attribute #CurveGadget_MinPointSpacing to the first 2 gadgets for testing
and to see it.

Code: Select all

; Program: CurveGadget.pbi
; Author: intratec, modified by Demivec and Little John
; version: 10
;
; History:
;
; 10 (Danilo) introduced attribute #CurveGadget_MinPointSpacing
;  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_MinPointSpacing ; by Danilo
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
  minPointSpacing.i ; by Danilo
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())
            LineXY(x1, y1, \dataPoint()\x, \dataPoint()\y, \frontColor)
            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_minPointSpacing : \minPointSpacing = value ; by Danilo
      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
        ;\minPointSpacing = 0 ; by Danilo
        
        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
    #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(3)
            
            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 + 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
              If xPos < \pointRadius: xPos = \pointRadius : EndIf
              If xPos > \width - \pointRadius: xPos = \width - \pointRadius : EndIf
              
              If xPos < pointArray(#PointBefore)\x + *CurveGadget\minPointSpacing ; by Danilo
                xPos = pointArray(#PointBefore)\x + *CurveGadget\minPointSpacing  ; by Danilo
                
                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 - *CurveGadget\minPointSpacing ; by Danilo
                xPos = pointArray(#PointAfter)\x - *CurveGadget\minPointSpacing  ; by Danilo
                
                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
                \dataPoint()\x = xPos
                \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 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




;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)

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(No1, #CurveGadget_MinPointSpacing, 20) ; test by Danilo
CurveGadgetSetAttribute(No2, #CurveGadget_MinPointSpacing, 10) ; test by Danilo


CurveGadgetSetAttribute(No3, #CurveGadget_Points, 2)

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

[Lord]

Nice Gadget!

It would be also nice, if there were a flag #CurveGadget_No_X_Movement
in order to allow only changes in y axis.