Module Advanced Gadget Functions (All OS)

Share your advanced PureBasic knowledge/code with the community.
User avatar
mk-soft
Always Here
Always Here
Posts: 5409
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module Advanced Gadget Functions (All OS)

Post by mk-soft »

Update v1.15
- Added InitMouseOver() for Events MouseEnter and MouseLeave
- Added CheckCanvasMouse() for Events MouseClicks and MouseWheel

Example

Code: Select all

;- Example Canvas Mouse Events

IncludeFile "AdvancedGadgetFunctions.pb"

UseModule AGF

Define Event

If OpenWindow(0, 0, 0, 220, 220, "Canvas Mouse Clicks", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  
  CanvasGadget(0, 10, 10, 200, 200)
  BindGadgetEvent(0, @CheckCanvasMouse())
  
  Repeat
    Event = WaitWindowEvent()
    
    If Event = #PB_Event_Gadget
      Select EventGadget()
        Case 0
          Select EventType()
            Case #My_EventType_LeftButtonClick
              Debug "Left Button Click"
            Case #My_EventType_LeftButtonDoubleClick
              Debug "Left Button DoubleClick"
            Case #My_EventType_MiddleButtonClick
              Debug "Middle Button Click"
            Case #My_EventType_MiddleButtonDoubleClick
              Debug "Middle Button DoubleClick"
            Case #My_EventType_RightButtonClick
              Debug "Right Button Click"
            Case #My_EventType_RightButtonDoubleClick
              Debug "Right Button DoubleClick"
            Case #My_EventType_MouseWheelUp
              Debug "MouseWheel Up: " + EventData()
            Case #My_EventType_MouseWheelDown
              Debug "MouseWheel Down: " + EventData()
          EndSelect
      EndSelect
      
    EndIf
    
  Until Event = #PB_Event_CloseWindow
EndIf
[/size]
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5357
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Module Advanced Gadget Functions (All OS)

Post by Kwai chang caine »

Works very well on W10 x64 / v5.61 x86 8)
Thanks for sharing 8)
Left Button Click
Right Button Click
Right Button Click
Right Button DoubleClick
Right Button Click
Right Button DoubleClick
Left Button Click
Left Button DoubleClick
Middle Button Click
Middle Button Click
Middle Button DoubleClick
MouseWheel Down: -1
MouseWheel Down: -1
MouseWheel Down: -1
MouseWheel Down: -1
MouseWheel Down: -1
MouseWheel Up: 1
MouseWheel Up: 1
MouseWheel Up: 1
MouseWheel Up: 1
MouseWheel Up: 1
MouseWheel Up: 1
MouseWheel Up: 1
MouseWheel Up: 1
ImageThe happiness is a road...
Not a destination
User avatar
mk-soft
Always Here
Always Here
Posts: 5409
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module Advanced Gadget Functions (All OS)

Post by mk-soft »

Thanks :wink:

Update v1.17
- Added EnableGadgetDataEvent(State)
- Added Event #My_EventType_NewGadgetData and #My_EventType_ChangeGadgetData

Example with Named GadgetData and used events for a own CanvasButton (Update)

Code: Select all

;-TOP

IncludeFile "AdvancedGadgetFunctions.pb"

UseModule AGF

; Events

Myfont = LoadFont(0, "Arial", 14, #PB_Font_Bold)


Procedure DrawCanvasButton(Gadget)
  Protected text_dx, text_dy, text.s
  Protected state, dx, dy, BorderSize
  Protected BackColor, FrontColor
  
  text = GetGadgetDataString(Gadget, "Text")
  dx = GetGadgetDataInteger(Gadget, "Width")
  dy = GetGadgetDataInteger(Gadget, "Height")
  state = GetGadgetDataInteger(Gadget, "State")
  BorderSize = GetGadgetDataInteger(Gadget, "BorderSize")
  If state = 1
    BackColor = GetGadgetDataInteger(Gadget, "BackColorMouseOver")
  Else
    BackColor = GetGadgetDataInteger(Gadget, "BackColor")
  EndIf 
  FrontColor = GetGadgetDataInteger(Gadget, "FrontColor")
  If StartDrawing(CanvasOutput(Gadget))
    DrawingFont(FontID(0))
    text_dx = TextWidth(text)
    text_dy = TextHeight(text) 
    Box(0, 0, dx, dy, GetGadgetDataInteger(Gadget, "BorderColor"))
    Box(BorderSize, BorderSize, dx - BorderSize * 2, dy - BorderSize * 2, BackColor)
    DrawText(dx / 2 - text_dx / 2, dy / 2 - text_dy / 2, text, FrontColor, BackColor) 
    StopDrawing()
  EndIf
  
EndProcedure

Procedure EventHandler_CanvasButton()
  
  Protected gadget, *property.string
  
  gadget = EventGadget()
  
  Select EventType()
    Case #PB_EventType_LeftButtonDown
      SetGadgetDataInteger(gadget, 2 , "State")  
    Case #PB_EventType_LeftButtonUp
      SetGadgetDataInteger(gadget, 1 , "State")  
    Case #PB_EventType_MouseEnter
      SetGadgetDataInteger(gadget, 1 , "State")  
    Case #PB_EventType_MouseLeave
      SetGadgetDataInteger(gadget, 0 , "State")  
    Case #My_EventType_ChangeGadgetData
      *property = EventData()
      Debug "Change GadgetData " + gadget + ": " + *property\s
      DrawCanvasButton(gadget)
  EndSelect
  
EndProcedure

Procedure CanvasButton(Gadget, x, y, Width, Height, Text.s)
  Protected id, result
  
  id = CanvasGadget(Gadget, x, y, Width, Height)
  If id = 0
    ProcedureReturn 0
  EndIf
  If Gadget = #PB_Any
    result = id
  Else
    result = Gadget
  EndIf
  
  SetGadgetDataInteger(result, 0, "State")
  SetGadgetDataInteger(result, x, "x")
  SetGadgetDataInteger(result, x, "y")
  SetGadgetDataInteger(result, Width, "Width")
  SetGadgetDataInteger(result, Height, "Height")
  SetGadgetDataString(result, Text, "Text")
  
  SetGadgetDataInteger(result, $F0F0F0, "FrontColor")
  SetGadgetDataInteger(result, $FF7070, "BackColor")
  SetGadgetDataInteger(result, $7070FF, "BackColorMouseOver")
  
  SetGadgetDataInteger(result, $FF4040, "BorderColor")
  SetGadgetDataInteger(result, 2, "BorderSize")
  
  DrawCanvasButton(result)
  
  BindEvent(#PB_Event_Gadget, @EventHandler_CanvasButton(), 0, result, #PB_All)
  
EndProcedure

Procedure Main()
  
  Protected event, color
  Protected *property.string
  
  If OpenWindow(0, #PB_Ignore, #PB_Ignore, 600, 400, "Advanced Gadget Functions - GadgetData")
    CanvasButton(0, 10, 10, 200, 40, "Button 0")
    CanvasButton(1, 220, 10, 200, 40, "Button 1")
    StringGadget(2, 10, 60, 200, 25, "Button 0")
    StringGadget(3, 220, 60, 200, 25, "Button 1")
    SpinGadget(4, 10, 95, 50, 25, 0, 4, #PB_Spin_Numeric)
    SpinGadget(5, 220, 95, 50, 25, 0, 4, #PB_Spin_Numeric)
    SetGadgetState(4, 2)
    SetGadgetState(5, 2)
  EndIf
  
  EnableGadgetDataEvent(#True)
  
  Repeat
    event = WaitWindowEvent()
    Select event
      Case #PB_Event_CloseWindow
        Break
      Case #PB_Event_Gadget
        Select EventGadget()
          Case 0
            Select EventType()
              Case #PB_EventType_LeftClick
                color = ColorRequester(GetGadgetDataInteger(0, "BackColor"))
                SetGadgetDataInteger(0, color, "BackColor")
            EndSelect
            
          Case 1
            Select EventType()
              Case #PB_EventType_LeftClick
                color = ColorRequester(GetGadgetDataInteger(1, "FrontColor"))
                SetGadgetDataInteger(1, color, "FrontColor")
            EndSelect
            
          Case 2
            Select EventType()
              Case #PB_EventType_Change
                SetGadgetDataString(0, GetGadgetText(2), "Text")
            EndSelect
            
          Case 3
            Select EventType()
              Case #PB_EventType_Change
                SetGadgetDataString(1, GetGadgetText(3), "Text")
            EndSelect
            
          Case 4
            Select EventType()
              Case #PB_EventType_Change
                SetGadgetDataInteger(0, GetGadgetState(4), "BorderSize")
            EndSelect
            
          Case 5
            Select EventType()
              Case #PB_EventType_Change
                SetGadgetDataInteger(1, GetGadgetState(5), "BorderSize")
            EndSelect
          
        EndSelect
        
    EndSelect
    
  ForEver
  
EndProcedure : Main()
[/size]
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5357
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Module Advanced Gadget Functions (All OS)

Post by Kwai chang caine »

The "#My_EventType_ChangeGadgetData" is not found :|
ImageThe happiness is a road...
Not a destination
User avatar
mk-soft
Always Here
Always Here
Posts: 5409
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module Advanced Gadget Functions (All OS)

Post by mk-soft »

No problem her...

AGF v1.17 or later

MacOS, Win 7 Pro, Linux Ubuntu 1604 (x86) and 1804 (x64)
PB v5.62 (x86/x64)
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5357
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Module Advanced Gadget Functions (All OS)

Post by Kwai chang caine »

What an idiot :oops: excuse me, i have forgotten to update the first post "AdvancedGadgetFunctions.pbi"
That works perfectly now with W10 x64 / v5.61 x86
Thanks 8)
ImageThe happiness is a road...
Not a destination
User avatar
mk-soft
Always Here
Always Here
Posts: 5409
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module Advanced Gadget Functions (All OS)

Post by mk-soft »

Update v1.19
- Bugfix DebugGadgetData

Named GadgetData is Threadsafe :wink:

Example - Change GadgetData from Thread

Code: Select all

;-TOP

IncludeFile "AdvancedGadgetFunctions.pb"

UseModule AGF

; Events

Myfont = LoadFont(0, "Arial", 14, #PB_Font_Bold)


Procedure DrawCanvasButton(Gadget)
  Protected text_dx, text_dy, text.s
  Protected state, dx, dy, BorderSize
  Protected BackColor, FrontColor
  
  text = GetGadgetDataString(Gadget, "Text")
  dx = GetGadgetDataInteger(Gadget, "Width")
  dy = GetGadgetDataInteger(Gadget, "Height")
  state = GetGadgetDataInteger(Gadget, "State")
  BorderSize = GetGadgetDataInteger(Gadget, "BorderSize")
  If state = 1
    BackColor = GetGadgetDataInteger(Gadget, "BackColorMouseOver")
  Else
    BackColor = GetGadgetDataInteger(Gadget, "BackColor")
  EndIf 
  FrontColor = GetGadgetDataInteger(Gadget, "FrontColor")
  If StartDrawing(CanvasOutput(Gadget))
    DrawingFont(FontID(0))
    text_dx = TextWidth(text)
    text_dy = TextHeight(text) 
    Box(0, 0, dx, dy, GetGadgetDataInteger(Gadget, "BorderColor"))
    Box(BorderSize, BorderSize, dx - BorderSize * 2, dy - BorderSize * 2, BackColor)
    DrawText(dx / 2 - text_dx / 2, dy / 2 - text_dy / 2, text, FrontColor, BackColor) 
    StopDrawing()
  EndIf
  
EndProcedure

Procedure EventHandler_CanvasButton()
  
  Protected gadget, *property.string
  
  gadget = EventGadget()
  
  Select EventType()
    Case #PB_EventType_LeftButtonDown
      SetGadgetDataInteger(gadget, 2 , "State")  
    Case #PB_EventType_LeftButtonUp
      SetGadgetDataInteger(gadget, 1 , "State")  
    Case #PB_EventType_MouseEnter
      SetGadgetDataInteger(gadget, 1 , "State")  
    Case #PB_EventType_MouseLeave
      SetGadgetDataInteger(gadget, 0 , "State")  
    Case #My_EventType_ChangeGadgetData
      *property = EventData()
      Debug DebugGadgetData(gadget, *property\s)
      DrawCanvasButton(gadget)
  EndSelect
  
EndProcedure

Procedure CanvasButton(Gadget, x, y, Width, Height, Text.s)
  Protected id, result
  
  id = CanvasGadget(Gadget, x, y, Width, Height)
  If id = 0
    ProcedureReturn 0
  EndIf
  If Gadget = #PB_Any
    result = id
  Else
    result = Gadget
  EndIf
  
  SetGadgetDataInteger(result, 0, "State")
  SetGadgetDataInteger(result, x, "x")
  SetGadgetDataInteger(result, x, "y")
  SetGadgetDataInteger(result, Width, "Width")
  SetGadgetDataInteger(result, Height, "Height")
  SetGadgetDataString(result, Text, "Text")
  
  SetGadgetDataInteger(result, $F0F0F0, "FrontColor")
  SetGadgetDataInteger(result, $FF7070, "BackColor")
  SetGadgetDataInteger(result, $7070FF, "BackColorMouseOver")
  
  SetGadgetDataInteger(result, $FF4040, "BorderColor")
  SetGadgetDataInteger(result, 2, "BorderSize")
  
  DrawCanvasButton(result)
  
  BindEvent(#PB_Event_Gadget, @EventHandler_CanvasButton(), 0, result, #PB_All)
  
EndProcedure

Structure udtThread
  ThreadID.i
  Exit.i
  Gadget.i
EndStructure

Procedure thTimer(*data.udtThread)
  Protected cnt
  With *data
    Repeat
      Delay(1000)
      SetGadgetDataString(\Gadget, "Start " + cnt, "Text")
      cnt + 1
    Until \Exit
    SetGadgetDataString(\Gadget, "Stop " + cnt, "Text")
    \Exit = 0
  EndWith  
EndProcedure


Procedure Main()
  
  Protected event, color, thTimer0.udtThread, thTimer1.udtThread
  
  If OpenWindow(0, #PB_Ignore, #PB_Ignore, 600, 400, "Advanced Gadget Functions - GadgetData and Thread")
    CanvasButton(0, 10, 10, 200, 40, "Start Timer 0")
    CanvasButton(1, 220, 10, 200, 40, "Start Timer 1")
  EndIf
  
  EnableGadgetDataEvent(#True)
  
  Repeat
    event = WaitWindowEvent()
    Select event
      Case #PB_Event_CloseWindow
        If IsThread(thTimer0\ThreadID)
          KillThread(thTimer0\ThreadID)
        EndIf
        If IsThread(thTimer1\ThreadID)
          KillThread(thTimer1\ThreadID)
        EndIf
        Break
      Case #PB_Event_Gadget
        Select EventGadget()
          Case 0
            Select EventType()
              Case #PB_EventType_LeftClick
                If Not IsThread(thTimer0\ThreadID)
                  thTimer0\Gadget = 0
                  thTimer0\ThreadID = CreateThread(@thTimer(), thTimer0)
                Else
                  thTimer0\Exit = 1
                EndIf
            EndSelect
            
          Case 1
            Select EventType()
              Case #PB_EventType_LeftClick
                If Not IsThread(thTimer1\ThreadID)
                  thTimer1\Gadget = 1
                  thTimer1\ThreadID = CreateThread(@thTimer(), thTimer1)
                Else
                  thTimer1\Exit = 1
                EndIf
            EndSelect
          
        EndSelect
        
    EndSelect
    
  ForEver
  
EndProcedure : Main()
[/size]
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
mk-soft
Always Here
Always Here
Posts: 5409
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module Advanced Gadget Functions (All OS)

Post by mk-soft »

Update v1.20
- Bugfix Memoryleak EventFreeMemoryPool()
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

Re: Module Advanced Gadget Functions (All OS)

Post by ts-soft »

Why don't you use CommonConstants?

Code: Select all

CompilerIf Defined(CommonConstants, #PB_Module) = 0
  DeclareModule CommonConstants
    ; Form
    Enumeration FormWindow
    EndEnumeration
    Enumeration FormGadget
    EndEnumeration
    Enumeration FormMenu
    EndEnumeration
    Enumeration FormImage
    EndEnumeration
    Enumeration FormFont
    EndEnumeration
    ; Event
    Enumeration EventCustom #PB_Event_FirstCustomValue
    EndEnumeration
    Enumeration EventTypeCustom #PB_EventType_FirstCustomValue
    EndEnumeration
  EndDeclareModule
  
  Module CommonConstants
  EndModule
CompilerEndIf

UseModule CommonConstants

DeclareModule AGF
  ;- Begin of Declare Module
 
  ;TODO Check Enumeration
  UseModule CommonConstants
  
  Enumeration EventCustom ; #PB_Event_FirstCustomValue
    #My_Event_FreeMemoryPool    ; Free Memory Pool of EventData
  EndEnumeration
 
  Enumeration EventTypeCustom ; #PB_EventType_FirstCustomValue
                                ; GadgetData
    #My_EventType_NewGadgetData
    #My_EventType_ChangeGadgetData
    ; CanvasGadget
    #My_EventType_LeftButtonClick
    #My_EventType_LeftButtonDoubleClick
    #My_EventType_MiddleButtonClick
    #My_EventType_MiddleButtonDoubleClick
    #My_EventType_RightButtonClick
    #My_EventType_RightButtonDoubleClick
    #My_EventType_MouseWheelUp
    #My_EventType_MouseWheelDown
  EndEnumeration
PureBasic 5.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image
User avatar
mk-soft
Always Here
Always Here
Posts: 5409
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module Advanced Gadget Functions (All OS)

Post by mk-soft »

I think this is a right way, but not everyone use this Module!

You forget one Enumeration "FormMenuItem" 8)

Code: Select all

CompilerIf Defined(CommonConstants, #PB_Module) = 0
  DeclareModule CommonConstants
    ; Form
    Enumeration FormWindow
    EndEnumeration
    Enumeration FormGadget
    EndEnumeration
    Enumeration FormMenu
    EndEnumeration
    Enumeration FormMenuItem
    EndEnumeration
    Enumeration FormImage
    EndEnumeration
    Enumeration FormFont
    EndEnumeration
    ; Event
    Enumeration EventCustom #PB_Event_FirstCustomValue
    EndEnumeration
    Enumeration EventTypeCustom #PB_EventType_FirstCustomValue
    EndEnumeration
  EndDeclareModule
 
  Module CommonConstants
  EndModule
CompilerEndIf
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

Re: Module Advanced Gadget Functions (All OS)

Post by ts-soft »

mk-soft wrote:I think this is a right way, but not everyone use this Module!
With you we already have 2 :wink:
PureBasic 5.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image
Post Reply