PureBasic Forums - English

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

Module Advanced Gadget Functions (All OS)

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

Page 2 of 2

Re: Module Advanced Gadget Functions (All OS)

Posted: Sun Aug 05, 2018 11:36 am
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]

Re: Module Advanced Gadget Functions (All OS)

Posted: Sun Aug 05, 2018 2:09 pm
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

Re: Module Advanced Gadget Functions (All OS)

Posted: Sun Aug 05, 2018 4:59 pm
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]

Re: Module Advanced Gadget Functions (All OS)

Posted: Mon Aug 06, 2018 4:38 pm
by Kwai chang caine
The "#My_EventType_ChangeGadgetData" is not found :|

Re: Module Advanced Gadget Functions (All OS)

Posted: Mon Aug 06, 2018 5:16 pm
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)

Re: Module Advanced Gadget Functions (All OS)

Posted: Mon Aug 06, 2018 5:28 pm
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)

Re: Module Advanced Gadget Functions (All OS)

Posted: Mon Aug 06, 2018 6:39 pm
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]

Re: Module Advanced Gadget Functions (All OS)

Posted: Wed Aug 08, 2018 8:34 am
by mk-soft
Update v1.20
- Bugfix Memoryleak EventFreeMemoryPool()

Re: Module Advanced Gadget Functions (All OS)

Posted: Wed Aug 08, 2018 8:56 am
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

Re: Module Advanced Gadget Functions (All OS)

Posted: Wed Aug 08, 2018 9:07 am
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

Re: Module Advanced Gadget Functions (All OS)

Posted: Wed Aug 08, 2018 9:29 am
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:
All times are UTC+01:00
Page 2 of 2

Powered by phpBB® Forum Software © phpBB Limited