PureBasic Forums - English

Code: Select all

;-TOP by mk-soft, v1.02.1, 24.09.2023

;- Gadget Common

CompilerIf Not #PB_Compiler_Thread
  CompilerError "Use Compiler Option ThreadSafe!"
CompilerEndIf

; ----

DeclareModule MyGadgetCommon
  
  Declare WindowPB(Object)
  Declare FreeGadgetWithData(Gadget)
  
EndDeclareModule

Module MyGadgetCommon
  
  CompilerSelect #PB_Compiler_OS
    CompilerCase #PB_OS_Windows
      Procedure WindowPB(Object)
        Protected r1
        r1 = GetProp_(Object, "PB_WINDOWID")
        If r1 > 0
          ProcedureReturn r1 - 1
        Else
          ProcedureReturn -1
        EndIf
      EndProcedure
      
    CompilerCase #PB_OS_Linux
      Procedure WindowPB(Object)
        ProcedureReturn g_object_get_data_(Object, "pb_id" )
      EndProcedure
      
    CompilerCase #PB_OS_MacOS
      Import ""
        PB_Window_GetID(Object) 
      EndImport
      
      Procedure WindowPB(Object)
        ProcedureReturn PB_Window_GetID(Object)
      EndProcedure
      
  CompilerEndSelect
  
  ; ----
  
  Procedure FreeGadgetWithData(Gadget)
    Protected *This
    
    If IsGadget(Gadget)
      *This = GetGadgetData(Gadget)
      If *This
        FreeStructure(*This)
      EndIf
      FreeGadget(Gadget)
    EndIf
  EndProcedure
  
EndModule

;- MyGadget 1

DeclareModule MyGadget
  
  Declare CreateMyGadget(Gadget, x, y, Width, Height, Text.s, Flags = 0)
  Declare FreeMyGadget(Gadget)
  Declare SetText(Gadget, Text.s)
  Declare.s GetText(Gadget)
  
EndDeclareModule

Module MyGadget
  
  UseModule MyGadgetCommon
  
  Enumeration #PB_EventType_FirstCustomValue
    #MyEventType_AnimateEnter
    #MyEventType_AnimateLeave
  EndEnumeration
  
  Structure udtMyGadget
    ; Base
    Window.i
    Gadget.i
    EventType.i
    ; Param
    Text.s
    Flags.i
    ; Data Animation
    AnimateValue.i
    AnimateMin.i
    AnimateMax.i
    AnimateDelay.i
    AnimateEnter.i
    AnimateLeave.i
  EndStructure
  
  ; ----
  
  Procedure DrawGadget(*This.udtMyGadget)
    Protected dx, dy, dx2, dy2, dy3
    
    With *This
      dx = GadgetWidth(\Gadget)
      dy = GadgetHeight(\Gadget)
      
      If StartDrawing(CanvasOutput(\Gadget))
        ; Draw background
        Box(0, 0, dx, dy, $8B8B00)
        DrawingMode(#PB_2DDrawing_Outlined)
        Box(0, 0, dx, dy, $FF901E)
        ; Draw contents
        DrawingMode(#PB_2DDrawing_Default)
        Box(10, 10, dx-20, dy-20, #Black)
        DrawText(20, 20, \Text, #White, #Black)
        ; Draw animation
        dx2 = dx - 20 - 2
        dy2 = (dy - 20) * (\AnimateMax - \AnimateValue) / \AnimateMax - 2
        Box(11, 11, dx2, dy2, #Gray)
        StopDrawing()
      EndIf
      
    EndWith
  EndProcedure
  
  ; ----
  
  Procedure DoAnimateEnter(*This.udtMyGadget)
    
    With *This
      If Not \AnimateEnter
        \AnimateEnter = #True
        \AnimateLeave = #False
        While \AnimateEnter
          \AnimateValue + 1
          PostEvent(#PB_Event_Gadget, \Window, \Gadget, #MyEventType_AnimateEnter, \AnimateValue)
          If \AnimateValue >= \AnimateMax
            \AnimateEnter = #False
            Break
          EndIf
          Delay(\AnimateDelay)
        Wend
      EndIf
    EndWith
  EndProcedure
  
  ; ----
  
  Procedure DoAnimateLeave(*This.udtMyGadget)
    
    With *This
      If Not \AnimateLeave
        \AnimateLeave = #True
        \AnimateEnter = #False
        While \AnimateLeave
          \AnimateValue - 1
          PostEvent(#PB_Event_Gadget, \Window, \Gadget, #MyEventType_AnimateLeave, \AnimateValue)
          If \AnimateValue <= \AnimateMin
            \AnimateLeave = #False
            Break
          EndIf
          Delay(\AnimateDelay)
        Wend
      EndIf
    EndWith
  EndProcedure
  
  ; ----
  
  Procedure DoEvents()
    Protected *this.udtMyGadget = GetGadgetData(EventGadget())
    
    With *this
      If *this
        \EventType = EventType()
        Select \EventType
          Case #PB_EventType_MouseEnter
            ; Start trigger enter gadget
            CreateThread(@DoAnimateEnter(), *this)
              
          Case #PB_EventType_MouseLeave
            ; Start trigger leave gadget
            CreateThread(@DoAnimateLeave(), *this)
            
          Case #PB_EventType_MouseMove
          Case #PB_EventType_MouseWheel
          Case #PB_EventType_LeftButtonDown
          Case #PB_EventType_LeftButtonUp
          Case #PB_EventType_LeftClick
          Case #PB_EventType_LeftDoubleClick
          Case #PB_EventType_RightButtonDown
          Case #PB_EventType_RightButtonUp
          Case #PB_EventType_RightClick
          Case #PB_EventType_RightDoubleClick
          Case #PB_EventType_MiddleButtonDown
          Case #PB_EventType_MiddleButtonUp
          Case #PB_EventType_Focus
          Case #PB_EventType_LostFocus
          Case #PB_EventType_KeyDown
          Case #PB_EventType_KeyUp
          Case #PB_EventType_Input
          Case #PB_EventType_Resize
            
          Case #MyEventType_AnimateEnter
            DrawGadget(*this)
            
          Case #MyEventType_AnimateLeave
            DrawGadget(*this)
            
        EndSelect
      EndIf
    EndWith
  EndProcedure
  
  ; ----
  
  Procedure SetText(Gadget, Text.s)
    Protected *this.udtMyGadget
    
    With *this
      *this = GetGadgetData(Gadget)
      If *this
        \Text = Text
        DrawGadget(*this)
      EndIf
    EndWith
  EndProcedure
  
  ; ----
      
  Procedure.s GetText(Gadget)
    Protected *this.udtMyGadget
    
    With *this
      *this = GetGadgetData(Gadget)
      If *this
        ProcedureReturn \Text
      EndIf
    EndWith
  EndProcedure
  
  ; ----
      
  Procedure CreateMyGadget(Gadget, x, y, Width, Height, Text.s, Flags = 0)
    Protected r1, *this.udtMyGadget
    
    With *this
      ; Create memory for gadget
      *this = AllocateStructure(udtMyGadget)
      If Not *this
        ProcedureReturn 0
      EndIf
      ; Create Gadget
      r1 = CanvasGadget(Gadget, x, y, Width, Height, Flags)
      If r1
        \Window = WindowPB(UseGadgetList(0))
        If Gadget = #PB_Any
          \Gadget = r1
        Else
          \Gadget = Gadget
        EndIf
        ; Store pointers to own data in gadget data
        SetGadgetData(\Gadget, *This)
        ; Parameter
        \Text = Text
        \Flags = Flags
        ; Default values
        \AnimateMin = 0
        \AnimateMax = 20
        \AnimateDelay = 15 ; ms
        ; Draw gadget
        DrawGadget(*This)
        ; Bind gadget events
        BindGadgetEvent(\Gadget, @DoEvents())
      Else
        FreeStructure(*this)
      EndIf
      
    EndWith
    ProcedureReturn r1
  EndProcedure
  
  ; ----
  
  Procedure FreeMyGadget(Gadget)
    Protected *This
    
    If IsGadget(Gadget)
      *This = GetGadgetData(Gadget)
      If *This
        FreeStructure(*This)
      EndIf
      FreeGadget(Gadget)
    EndIf
  EndProcedure
  
EndModule

;-Example

;-TOP

#ProgramTitle = "Own Gadget with Animation"
#ProgramVersion = "v1.02.1"

Enumeration Windows 1
  #Main
EndEnumeration

Enumeration MenuBar
  #MainMenu
EndEnumeration

Enumeration MenuItems
  #MainMenuAbout
  #MainMenuExit
EndEnumeration

Enumeration Gadgets
  #MainGadget1
  #MainGadget2
EndEnumeration

Enumeration StatusBar
  #MainStatusBar
EndEnumeration

Procedure UpdateWindow()
  Protected dx, dy
  dx = WindowWidth(#Main)
  dy = WindowHeight(#Main) - StatusBarHeight(#MainStatusBar) - MenuHeight()
  ; Resize gadgets
EndProcedure

Procedure Main()
  Protected dx, dy
  
  #MainStyle = #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget
  
  If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, 800, 600, #ProgramTitle , #MainStyle)
    ; Menu
    CreateMenu(#MainMenu, WindowID(#Main))
    MenuTitle("&File")
    CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
      MenuItem(#PB_Menu_About, "")
    CompilerElse
      MenuItem(#MainMenuAbout, "About")
    CompilerEndIf
    ; Menu File Items
    
    CompilerIf Not #PB_Compiler_OS = #PB_OS_MacOS
      MenuBar()
      MenuItem(#MainMenuExit, "E&xit")
    CompilerEndIf
    
    ; StatusBar
    CreateStatusBar(#MainStatusBar, WindowID(#Main))
    AddStatusBarField(#PB_Ignore)
    
    ; Gadgets
    dx = WindowWidth(#Main)
    dy = WindowHeight(#Main) - StatusBarHeight(#MainStatusBar) - MenuHeight()
    MyGadget::CreateMyGadget(#MainGadget1, 10, 10, 200, 100, "Hello World!")
    MyGadget::CreateMyGadget(#MainGadget2, 220, 10, 200, 100, "I like PureBasic!")
    
    MyGadget::SetText(#MainGadget1, "Hello User!")
    
    ; Bind Events
    BindEvent(#PB_Event_SizeWindow, @UpdateWindow(), #Main)
    
    ; Event Loop
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_CloseWindow
          Select EventWindow()
            Case #Main
              Break
              
          EndSelect
          
        Case #PB_Event_Menu
          Select EventMenu()
            CompilerIf #PB_Compiler_OS = #PB_OS_MacOS   
              Case #PB_Menu_About
                PostEvent(#PB_Event_Menu, #Main, #MainMenuAbout)
                
              Case #PB_Menu_Preferences
                
              Case #PB_Menu_Quit
                PostEvent(#PB_Event_CloseWindow, #Main, #Null)
                
            CompilerEndIf
            
          Case #MainMenuAbout
            MessageRequester("About", #ProgramTitle + #LF$ + #ProgramVersion, #PB_MessageRequester_Info)
              
          Case #MainMenuExit
            PostEvent(#PB_Event_CloseWindow, #Main, #Null)
            
          EndSelect
          
        Case #PB_Event_Gadget
          Select EventGadget()
              
          EndSelect
          
      EndSelect
    ForEver
    
    MyGadget::FreeMyGadget(#MainGadget1)
    MyGadgetCommon::FreeGadgetWithData(#MainGadget2)
        
  EndIf
  
EndProcedure : Main()