Custom StringGadget

collectordave · Post by **collectordave** » Mon Jan 02, 2017 8:48 am

This started with me attempting to code a custom grid gadget and wanting to edit text in the selected cell.

Thought it maybe usefull to have masks to restrict user input to what I want for dates or numbers etc.

Started testing on a small canvas gadget and thought it could be a custom string gadget.

Using only native PureBasic no api calls etc should be crossplatform.

All the events on a cancas gadget are available so should only be limited by our imagination.

I have included a small mask which only displays a few lower case letters all others rejected as a test.

Backspace key used to delete last letter typed.

Has anyone attempted this before if so is there any code available?

If anyone can suggest better fonts or better ways to do this please do.

You only need to change the DrawGadget() procedure to what you want.

Here is the code:_

First resize.pbi used to capture resize events for the gadget

Code: Select all

Procedure _ResizeGadget(Gadget, x, y, Width, Height)
  If IsGadget(Gadget)
    If GadgetType(Gadget) = #PB_GadgetType_Canvas 
        Window = GetGadgetData(Gadget)  
        If IsWindow(Window)   
          ResizeGadget(Gadget, x, y, Width, Height)
          PostEvent(#PB_Event_Gadget, Window, Gadget, #PB_Event_FirstCustomValue, 15)
        EndIf        
    EndIf
  EndIf
  
EndProcedure

Macro ResizeGadget(Gadget, x, y, Width, Height)
  _ResizeGadget(Gadget, x, y, Width, Height)
EndMacro

Second CGString.pbi the main include module for the gadget

Code: Select all

;Resize.pbi needed to capture resize events
XIncludeFile "Resize.pbi"

DeclareModule CGString
  
  ;{ ==Gadget Event Enumerations=================================
;        Name/title: Enumerations
;       Description: Part of custom gadget template
;                  : Enumeration of Custom Gagdet event constants 
;                  : Started at 100 to Avoid Using 0
;                  : as creation events etc can still be recieved
;                  : in main event loop
; ================================================================
;} 
  Enumeration #PB_Event_FirstCustomValue
    #CgEvent1
    #CgEvent2
    #CgEvent3
  EndEnumeration
    
  ;Public procedures for the gadget 
  Declare New(Gadget.i, x.i,y.i,width.i,height.i,Flags.i)
  
EndDeclareModule

Module CGString

  ;The Main Gadget Structure
  Structure MyGadget
    Window_ID.i
    Gadget_ID.i
    Content.s
  EndStructure
  Global Dim MyGadgetArray.MyGadget(0) 
  Global Currentgadget.i
   
  Procedure SetCurrentGadgetID(Gadget.i)
  ;{ ==Procedure Header Comment==============================
;        Name/title: GetgadgetID
;       Description: Part of custom gadget template
;                  : Procedure to return the MyGadgetArray() element number 
;                  : for the gadget on which the event occurred
; 
; ====================================================
;}     
    Define iLoop.i

    For iLoop = 0 To ArraySize(MyGadgetArray())
     
      If Gadget = MyGadgetArray(iLoop)\Gadget_ID

        CurrentGadget = iLoop
        Break
    
      EndIf
      
    Next iLoop 
  
  EndProcedure
  
  Procedure.s MaskInput(InputChar.s)
   
    If FindString("abcdefg",InputChar) > 0
      ProcedureReturn InputChar
    EndIf
   
    ProcedureReturn ""

 EndProcedure

  Procedure DrawGadget(Gadget.i)
  ;{ ==Procedure Header Comment==============================
  ;        Name/title: DrawGadget
  ;       Description: Part of custom gadget template
  ;                  : Procedure to draw the gadget on the canvas
  ; 
  ; ====================================================
  ;}    
    
    LoadFont(0,"Ariel",10)
    
    SetCurrentGadgetID(Gadget)
   
    MyGadgetArray(CurrentGadget)\Content = MyGadgetArray(CurrentGadget)\Content + MaskInput(Chr(GetGadgetAttribute(MyGadgetArray(CurrentGadget)\Gadget_ID, #PB_Canvas_Input )))
   
    StartDrawing(CanvasOutput(MyGadgetArray(CurrentGadget)\Gadget_ID))

    DrawingMode(#PB_2DDrawing_Default|#PB_2DDrawing_Transparent) 
    DrawingFont(FontID(0))
    ;Clear Junk from grid image
    Box(0, 0, OutputWidth(), OutputHeight(), RGB(255,255,255))
    ;Draw This Gadgets Text
    DrawText(1, 1, MyGadgetArray(CurrentGadget)\Content,RGB(0,0,0))
    StopDrawing()

  EndProcedure 
     
  Procedure AddGadget(ThisWindow.i,ThisGadget.i)
 ;{ ==Procedure Header Comment==============================
;        Name/title: AddGadget
;       Description: Part of custom gadget template
;                  : Adds the Id of the newly created gadget to the gadget array
; ====================================================
;}

    MyGadgetArray(ArraySize(MyGadgetArray()))\Window_ID = ThisWindow
    MyGadgetArray(ArraySize(MyGadgetArray()))\Gadget_ID = ThisGadget
    ReDim MyGadgetArray(ArraySize(MyGadgetArray())+1)
    
  EndProcedure
  
  Procedure SendEvents(Event.i,CGData.i=0)
;{ ==Procedure Header Comment==============================
;        Name/title: SendEvents
;       Description: Part of custom gadget template
;                  : Used to send custom events to the main event loop
; ====================================================
;}   
    
    ;Post The Event
    PostEvent(#PB_Event_Gadget, MyGadgetArray(CurrentGadget)\Window_ID, MyGadgetArray(CurrentGadget)\Gadget_ID, Event,CGData)
    
 EndProcedure
 
  Procedure GadgetEvents()
  ;{ ==Procedure Header Comment==============================
;        Name/title: GadgetEvents
;       Description: Part of custom gadget template
;                  : Handles all events for this custom gadget
; ====================================================
;}
   
    SetCurrentGadgetID(EventGadget())

    ;Captures the custom event 15 which means this gadget has been resized or moved
     If EventData() = 15
       ;Process Resize Event
     EndIf   
      
    Select EventType()
       
      Case #PB_EventType_MouseEnter
        
        ;Debug "Mouse Entered Gadget " + Str(CurrentGadget)
        
      Case #PB_EventType_MouseLeave 
        
        ;Debug "Mouse Left Gadget " + Str(CurrentGadget)       
        
      Case #PB_EventType_MouseMove 
        
        ;Debug "MouseMove On Gadget " + Str(CurrentGadget)        
        
      Case #PB_EventType_MouseWheel
        
        ;Debug "MouseWheel  On Gadget " + Str(CurrentGadget)           
        
      Case #PB_EventType_LeftButtonDown
        
        ;Debug "LeftButtonDown On Gadget " + Str(CurrentGadget)        
        
      Case #PB_EventType_LeftButtonUp
        
        ;Debug "LeftButtonUp On Gadget " + Str(CurrentGadget)        
        
      Case #PB_EventType_LeftClick 
        
        SetGadgetAttribute(MyGadgetArray(CurrentGadget)\Gadget_ID,#PB_Canvas_Cursor ,#PB_Cursor_IBeam)
        SendEvents(#CgEvent1,1)
        
      Case #PB_EventType_LeftDoubleClick
        
        ;Debug "LeftDoubleClick On Gadget " + Str(CurrentGadget)           
        
      Case #PB_EventType_RightButtonDown
        
        ;Debug "RightButtonDown On Gadget " + Str(CurrentGadget)        
         
       Case #PB_EventType_RightButtonUp
        
        ;Debug "RightButtonUp On Gadget " + Str(CurrentGadget)        
        
      Case #PB_EventType_RightClick
        
        ;Debug "RightClick On Gadget " + Str(CurrentGadget)           
        
      Case #PB_EventType_RightDoubleClick
        
        ;Debug "RightDoubleClick On Gadget " + Str(CurrentGadget)           
        
      Case #PB_EventType_MiddleButtonDown
        
        ;Debug "MiddleButtonDown On Gadget " + Str(CurrentGadget)         
        
      Case #PB_EventType_MiddleButtonUp
        
        ;Debug "MiddleButtonUp On Gadget " + Str(CurrentGadget) 
        
      Case    #PB_EventType_Focus
        
        ;Debug "Got Focus On Gadget " + Str(CurrentGadget)   
        
      Case      #PB_EventType_LostFocus
        
        ;Debug "lost Focus On Gadget " + Str(CurrentGadget)   
        
      Case      #PB_EventType_KeyDown
 
        Select GetGadgetAttribute(MyGadgetArray(CurrentGadget)\Gadget_ID,#PB_Canvas_Key )
              
          Case #PB_Shortcut_Return
                
            SetGadgetAttribute(MyGadgetArray(CurrentGadget)\Gadget_ID,#PB_Canvas_Cursor ,#PB_Cursor_Default  )                  
            DrawGadget(MyGadgetArray(CurrentGadget)\Gadget_ID)
      
          Case #PB_Shortcut_Back
                
            MyGadgetArray(CurrentGadget)\Content = Left(MyGadgetArray(CurrentGadget)\Content,Len(MyGadgetArray(CurrentGadget)\Content)-1)
            DrawGadget(MyGadgetArray(CurrentGadget)\Gadget_ID)
            
        EndSelect
          
      Case      #PB_EventType_KeyUp
        
        ;Debug "Key Up On Gadget " + Str(CurrentGadget)   
        
       
      Case      #PB_EventType_Input
 
        DrawGadget(MyGadgetArray(CurrentGadget)\Gadget_ID)
        
    EndSelect
    
  EndProcedure
  
  Procedure.i New(Gadget.i, x.i,y.i,width.i,height.i,Flags.i)
    ;{ ==Procedure Header Comment==============================
;        Name/title: CreateGadget
;       Description: Part of custom gadget template
;                  : procedure to create the canvas used for the gadget
; ====================================================
;}  
    Define ThisWindow.i,ThisGadget.i,ThisColour.i
  
    ;Create The Canvas For The Gadget
    If Gadget = #PB_Any
      ThisGadget = CanvasGadget(#PB_Any, x,y,width,height,#PB_Canvas_Keyboard)
    Else
      ThisGadget = Gadget
      CanvasGadget(Gadget, x,y,width,height,#PB_Canvas_Keyboard)
    EndIf
  
    ;Bind This Gadgets Events
    BindGadgetEvent(ThisGadget, @GadgetEvents())

    ;The Window On Which It Is Created
    ThisWindow = GetActiveWindow()
    
    ;Add the window id as data to the gadget
    SetGadgetData(ThisGadget,ThisWindow)    
    
    ;Add To The Custom Gadget Array
    AddGadget(ThisWindow,ThisGadget)

    SetCurrentGadgetID(ThisGadget)
    
    ;Draw the actual gadget
    DrawGadget(ThisGadget)
    
    ProcedureReturn ThisGadget 
    
  EndProcedure 
  
EndModule

Lastly WinMain.pb Simple test programme for the gadget

Code: Select all

IncludeFile "CGString.pbi"

Enumeration FormGadget
  #CGString1
EndEnumeration

Global Window_0,CustomGadget1.i

  Window_0 = OpenWindow(#PB_Any, 0, 0, 600, 400, "", #PB_Window_SystemMenu)
  CGString::New(#CGString1,10, 10, 200, 20,0)
  CustomGadget1 = CGString::New(#PB_Any,10, 50, 500, 25,0)
  
  Repeat
    
  Event = WaitWindowEvent()
    
  Select Event
    Case #PB_Event_CloseWindow
      
      End

    Case #PB_Event_Gadget

      Select EventGadget()
          
        Case #CGString1

          Select EventType()
              
              Case CGString::#CgEvent1
                
                Select EventData()
              
                  Case 1
                    
                    Debug "CGString 0 Event 1"
             
                EndSelect
                
          EndSelect        
      
        Case CustomGadget1

          Select EventType()
              
              Case CGString::#CgEvent1
                
                Select EventData()
              
                  Case 1
                    
                    Debug "CGString 1 Event 1"
             
                EndSelect
                
          EndSelect

Thoughts and help appreciated

King regards

cd

davido · Post by **davido** » Mon Jan 02, 2017 3:12 pm

@collectordave,

Herewith a link to a Canvas String Gadget by STARGÅTE:

http://www.purebasic.fr/english/viewtop ... 07#p378607

collectordave · Post by **collectordave** » Mon Jan 02, 2017 4:01 pm

Thanks Davido

Will save me hours!

Regards

cd

davido · Post by **davido** » Mon Jan 02, 2017 5:42 pm

@collectordave,
You might also like to look at TabBarGadget written by STARGÅTE, which, I understand, is used in the PureBasic IDE.

http://www.purebasic.fr/english/viewtop ... 12&t=47588

collectordave · Post by **collectordave** » Tue Jan 03, 2017 5:54 am

Another brilliant gadget.

I will be downloading and trying that out. Be good to see a thread on the forum pulling all the custom gadgets together. It is one reason why I have just programmed a small code library. As I browse the forum I keep finding some real gems from applications to simple macros and procedures and where I see these as usefull I store them locally and check they run on PB5.51 for use in my own projects.

I am trying to concentrate on the stringgadget at the moment though.

Other things are like this gadget where there are requests on the forum for masked string gadgets etc so a roll your own can be that to all if I can get this working all anyone will need to do is change the Mask procedure using the string functions to whatever they like and they have a masked stringgadget. This could take some load off the PB development team extending the language at the same time.

Thanks again

cd

PureBasic Forums - English

Custom StringGadget

Custom StringGadget

Re: Custom StringGadget

Re: Custom StringGadget

Re: Custom StringGadget

Re: Custom StringGadget