Slider Gadget

Share your advanced PureBasic knowledge/code with the community.
User avatar
Michael Vogel
Addict
Addict
Posts: 2678
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Slider Gadget

Post by Michael Vogel »

It's just a simple start (no real sliding for now, no keyboard support etc.), but maybe it gives some inspirations...

Code: Select all

#WinX=640
#WinY=400

#Undefined=-1

Procedure InitDialog()
	
	#Orange=$00A1FF
	#DarkGray=$808080
	#LightGray=$D0D0D0
	#DarkWhite=$FFFFFF
	
	#SliderCornerSize=3
	#SliderWidth=40; %

	#Draw100=$FF000000
	#Draw050=$80000000
	#Draw025=$40000000
	#Draw015=$1F000000
	#Draw010=$10000000

	#DrawBackShadow=#Draw050
	#DrawSliderShadow=#Draw015


	Structure SliderGadgetListType
		Gadget.i
		State.i
		w.i
		h.i
		Text.s
		ColorText.i
		ColorBack.i
		ColorSlider.i
	EndStructure

	Global DialogBackgroundColor
	Global SliderGadgetCount
	Global Dim SliderGadgetList.SliderGadgetListType(0)

	DialogBackgroundColor=GetSysColor_(#COLOR_BTNFACE)

	DialogBackgroundColor=$F0E0FF

EndProcedure

Procedure GetSliderGadgetIndex(gadget)

	Protected n

	Repeat
		n+1
		If SliderGadgetList(n)\Gadget=gadget
			ProcedureReturn n
		EndIf
	Until n=SliderGadgetCount

	ProcedureReturn #False

EndProcedure
Procedure SetSliderGadget(gadget,mode,extra=0)

	Enumeration
		#SliderGadget_Draw
		#SliderGadget_Moving
	EndEnumeration

	Protected c
	Protected pt,px,pw
	Protected s.s

	gadget=GetSliderGadgetIndex(gadget)
	If gadget
		With SliderGadgetList(gadget)
			Select mode

			Case #SliderGadget_Draw
				StartDrawing(CanvasOutput(\Gadget))

				s=StringField(\Text,1+\State,"|")
				pw=#SliderWidth;			pw=MulDiv_(\w,#SliderWidth,100) for %
				pt=TextWidth(s)

				If \State
					px=\w-pw
					pt=(px-pt)/2
					cb=\ColorBack
					ct=\ColorText
				Else
					pt=pw+(\w-pw-pt)/2
					cb=#DarkWhite
					ct=#DarkGray
				EndIf

				Box(0,0,\w,\h,DialogBackgroundColor)
			
				RoundBox(0,0,\w,\h,#SliderCornerSize,#SliderCornerSize,#Draw100|cb)
				DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Gradient)
				LinearGradient(0,0,0,\h)
				FrontColor(#Null)
				BackColor(#DrawBackShadow)
				GradientColor(0.02,#DrawBackShadow)
				GradientColor(0.1,#DrawBackShadow>>1)
				GradientColor(0.2,#DrawBackShadow>>2)
				RoundBox(0,0,\w,\h,#SliderCornerSize,#SliderCornerSize)

				DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Transparent)
				;DrawText((\State!1)*\w/2+(\w/2-TextWidth(s))/2,(\h-TextHeight(s))/2,s,#Draw100|\ColorText)
				DrawText(pt,(\h-TextHeight(s))/2,s,#Draw100|ct)

				DrawingMode(#PB_2DDrawing_Default)
				RoundBox(px,0,pw,\h,#SliderCornerSize,#SliderCornerSize,#Draw100|\ColorSlider)

				DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Gradient)
				LinearGradient(0,\h,0,0)
				BackColor(#DrawSliderShadow)
				RoundBox(px,0,pw,\h,#SliderCornerSize,#SliderCornerSize,#Draw100|\ColorBack)

				DrawingMode(#PB_2DDrawing_Outlined)
				RoundBox(px,0,pw,\h,#SliderCornerSize,#SliderCornerSize,#Draw100|#Black)
				RoundBox(0,0,\w,\h,#SliderCornerSize,#SliderCornerSize,#Draw100|#Black)

				StopDrawing()

			EndSelect
		EndWith

		ProcedureReturn gadget

	Else
		ProcedureReturn #False

	EndIf

EndProcedure
Procedure SetSliderGadgetState(gadget,state)
	
	Protected n
	n=GetSliderGadgetIndex(gadget)
	If n
		;Debug "Set ("+Str(gadget)+"="+Str(state)+")"
		SliderGadgetList(n)\State=state&1
		SetSliderGadget(gadget,#SliderGadget_Draw)
	EndIf

EndProcedure
Procedure GetSliderGadgetState(gadget)
	
	gadget=GetSliderGadgetIndex(gadget)
	If gadget
		;Debug "Get (#"+Str(gadget)+"="+Str(SliderGadgetList(gadget)\State)+")"
		ProcedureReturn SliderGadgetList(gadget)\State
	Else
		ProcedureReturn #Undefined
	EndIf

EndProcedure
Procedure SliderGadget(gadget,x,y,w,h,text.s,slidercolor,backgroundcolor,textcolor=#Black)

	SliderGadgetCount+1
	ReDim SliderGadgetList(SliderGadgetCount)

	With SliderGadgetList(SliderGadgetCount)
		\Gadget=gadget
		\w=w
		\h=h
		\Text=text
		\ColorSlider=slidercolor
		\ColorBack=backgroundcolor
		\ColorText=textcolor
	EndWith

	CanvasGadget(gadget,x,y,w,h,#PB_Canvas_Keyboard); |#PB_Canvas_DrawFocus)
	SetSliderGadget(gadget,#SliderGadget_Draw)

EndProcedure
Procedure SliderGadgetEvents()
	
	Protected gadget
	
	If GadgetType(EventGadget())=#PB_GadgetType_Canvas
		
		gadget=EventGadget()
		
		Select EventType()
		Case #PB_Canvas_LeftButton
		Case #PB_EventType_MouseMove
			;	Debug "move"
		Case #PB_EventType_LeftButtonDown
			Debug "Click ("+Str(EventGadget())+")"
		Case #PB_EventType_LeftButtonUp
			Debug "Up ("+Str(EventGadget())+")"
			SetSliderGadgetState(gadget,GetSliderGadgetState(gadget)!1)
		EndSelect

		ProcedureReturn #True

	Else
		ProcedureReturn #False

	EndIf

EndProcedure

InitDialog()

OpenWindow(0,0,0,#WinX,#WinY,"Shadow",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)

SetWindowColor(0,DialogBackgroundColor)
SliderGadget(666,50,50,100,25,"Off|On",#White,#Yellow)
SliderGadget(667,50,100,100,25,"Low|High",#White,#LightGray)
SliderGadget(668,50,150,100,30,"Min|Max",#White,#Orange)
SliderGadget(669,200,150,120,30,"Pure...|Basic",#Red,#DarkGray,#White)
ButtonGadget(111,50,200,100,25,"Ok")
AddKeyboardShortcut(0,#PB_Shortcut_Escape,111)

Repeat
	Event = WaitWindowEvent()
	
	Select event
	Case #PB_Event_Gadget,#PB_Event_Menu
		If SliderGadgetEvents()=#Null
			If EventGadget()=111
				End
			EndIf
		EndIf
	EndSelect

Until Event=#PB_Event_CloseWindow

sec
Enthusiast
Enthusiast
Posts: 790
Joined: Sat Aug 09, 2003 3:13 am
Location: 90-61-92 // EU or ASIA
Contact:

Re: Slider Gadget

Post by sec »

Nice :)

my comment:
DialogBackgroundColor=GetSysColor_(#COLOR_BTNFACE) should replace with what that can portable (Linux for example) , it will 8)
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: Slider Gadget

Post by davido »

Very nice. :D
DE AA EB
User avatar
luis
Addict
Addict
Posts: 3876
Joined: Wed Aug 31, 2005 11:09 pm
Location: Italy

Re: Slider Gadget

Post by luis »

Nice, thanks :)
"Have you tried turning it off and on again ?"
A little PureBasic review
User avatar
Michael Vogel
Addict
Addict
Posts: 2678
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Re: Slider Gadget

Post by Michael Vogel »

sec wrote: my comment:
DialogBackgroundColor=GetSysColor_(#COLOR_BTNFACE) should replace with what that can portable (Linux for example) , it will 8)
You're right, wouldn't need that, if canvas gadgets could be used in a transparent mode :|
User avatar
Bisonte
Addict
Addict
Posts: 1232
Joined: Tue Oct 09, 2007 2:15 am

Re: Slider Gadget

Post by Bisonte »

Image
PureBasic 6.10 LTS (Windows x86/x64) | Windows10 Pro x64 | Asus TUF X570 Gaming Plus | R9 5900X | 64GB RAM | GeForce RTX 3080 TI iChill X4 | HAF XF Evo | build by vannicom​​
English is not my native language... (I often use DeepL to translate my texts.)
User avatar
minimy
Enthusiast
Enthusiast
Posts: 349
Joined: Mon Jul 08, 2013 8:43 pm

Re: Slider Gadget

Post by minimy »

very pretty! and very useful!
Thanks friend!
If translation=Error: reply="Sorry, Im Spanish": Endif
User avatar
StarBootics
Addict
Addict
Posts: 984
Joined: Sun Jul 07, 2013 11:35 am
Location: Canada

Re: Slider Gadget

Post by StarBootics »

Very nice gadget. An alternative is always good because even if the GTK 3 subsystem is available I'm not sure if we can use the similar gadget already available.

But one question : Why did you not use the BindGadgetEvent() instruction to automatically manage the state toggling event of your SliderGadget() ?

Regards
StarBootics
The Stone Age did not end due to a shortage of stones !
User avatar
Michael Vogel
Addict
Addict
Posts: 2678
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Re: Slider Gadget

Post by Michael Vogel »

StarBootics, don't know about this function (new in 5.20?), will try to check that as soon as possible.
kvitaliy
Enthusiast
Enthusiast
Posts: 162
Joined: Mon May 10, 2010 4:02 pm

Re: Slider Gadget

Post by kvitaliy »

Very nice :idea:
User avatar
Guimauve
Enthusiast
Enthusiast
Posts: 742
Joined: Wed Oct 22, 2003 2:51 am
Location: Canada

Re: Slider Gadget

Post by Guimauve »

Hello,

Yes this command is new and very easy to use. In your case in the command creating the SliderGadget() just add BindGadgetEvent(gadget, @SliderGadgetEvents()) and that it I guess.

Nice gadget by the way but it require little modification to allow the use of #PB_Any.

Best regards
Guimauve
Dear Optimist, Pessimist,
and Realist,

While you guys were
busy arguing about the
glass of water, I DRANK IT !

Sincerely,
the Opportunist
User avatar
Bisonte
Addict
Addict
Posts: 1232
Joined: Tue Oct 09, 2007 2:15 am

Re: Slider Gadget

Post by Bisonte »

But the problem is missing of an event like #PB_Event_FreeGadget.
If you bind a gadget to a procedure, and then free it with FreeGadget()
the next Gadget with that number have this bind. Equal what gadgettype it is...

Fred says, that you have to unbind the events or you maybe get some ugly effects....
PureBasic 6.10 LTS (Windows x86/x64) | Windows10 Pro x64 | Asus TUF X570 Gaming Plus | R9 5900X | 64GB RAM | GeForce RTX 3080 TI iChill X4 | HAF XF Evo | build by vannicom​​
English is not my native language... (I often use DeepL to translate my texts.)
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5353
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Slider Gadget

Post by Kwai chang caine »

Top cool !!!
Thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
User avatar
StarBootics
Addict
Addict
Posts: 984
Joined: Sun Jul 07, 2013 11:35 am
Location: Canada

Re: Slider Gadget

Post by StarBootics »

Hello everyone,

A module version of the original code.

Best regards
StarBootics

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : SliderGadget - Module
; File Name : SliderGadget - Module.pb
; File version: 1.0.0
; Programming : OK
; Programmed by : StarBootics
; Date : 08-03-2016
; Last Update : 08-03-2016
; PureBasic code : V5.42 LTS
; Platform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; This code was originally created by Michel 
; Vogel..
;
; I deserve credit only to convert the original 
; code into a Module.
;
; This code is free to be use where ever you like 
; but you use it at your own risk.
;
; The author can in no way be held responsible 
; for data loss, damage or other annoying 
; situations that may occur.
;
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

DeclareModule Slider
  
  Declare Gadget(GadgetID, P_x, P_y, P_Width, P_Height, P_Text.s, P_ColorSlider, P_ColorBack, P_ColorText=0)
  Declare SetUserData(GadgetID, P_UserData.i)
  Declare.i GetUserData(GadgetID)
  Declare SetState(GadgetID, P_State)
  Declare GetState(GadgetID)
  Declare Free(GadgetID)
  
EndDeclareModule

Module Slider
  
  Enumeration
    #SliderGadget_Draw
    #SliderGadget_Moving
  EndEnumeration
 
  #SliderCornerSize = 3
  #SliderWidth = 40; %
  
  #Black = 0
  #Yellow = $00FFFF
  #White = $FFFFFF
  #Red = $0000FF
  #Orange = $00A1FF
  #DarkGray = $808080
  #LightGray = $D0D0D0
  #DarkWhite = $FFFFFF
  
  #Draw100 = $FF000000
  #Draw050 = $80000000
  #Draw025 = $40000000
  #Draw015 = $1F000000
  #Draw010 = $10000000
  
  #DrawBackShadow = #Draw050
  #DrawSliderShadow = #Draw015
  
  #Undefined=-1
  
  Structure Slider
    
    ControlName.s
    CurrentState.i
    Width.i
    Height.i
    Text.s
    ColorText.i
    ColorBack.i
    ColorSlider.i
    UserData.i
    
  EndStructure
  
  Procedure.i CreateNewSlider()
    
    *SliderA.Slider = AllocateMemory(SizeOf(Slider))
    
    If *SliderA = #Null
      MessageRequester("Fatal Error", "CreateNewSlider() - Impossible to Allocate Memory !")
      End
    Else 
      *SliderA\ControlName = "Slider"
    EndIf
    
    ProcedureReturn *SliderA
  EndProcedure
  
  Procedure Refresh(GadgetID, P_Mode, P_Extra = 0)
    
    Protected c
    Protected pt,px
    Protected s.s
    
    *SliderA.Slider = GetGadgetData(GadgetID)
    
    If *SliderA
      
      If *SliderA\ControlName = "Slider"
        
        Select P_Mode
            
          Case #SliderGadget_Draw
            If StartDrawing(CanvasOutput(GadgetID))
              
              s = StringField(*SliderA\Text, 1 + *SliderA\CurrentState, "|")
              pt = TextWidth(s)
              
              If *SliderA\CurrentState
                px = *SliderA\Width - #SliderWidth
                pt = (px - pt) >> 1
                cb = *SliderA\ColorBack
                ct = *SliderA\ColorText
              Else
                pt = #SliderWidth + (*SliderA\Width- #SliderWidth - pt) >> 1
                cb = #DarkWhite
                ct = #DarkGray
              EndIf
              
              RoundBox(0,0,*SliderA\Width,*SliderA\Height,#SliderCornerSize,#SliderCornerSize,#Draw100|cb)
              DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Gradient)
              LinearGradient(0,0,0,*SliderA\Height)
              FrontColor(#Null)
              BackColor(#DrawBackShadow)
              GradientColor(0.02, #DrawBackShadow)
              GradientColor(0.10, #DrawBackShadow >> 1)
              GradientColor(0.20, #DrawBackShadow >> 2)
              RoundBox(0,0,*SliderA\Width,*SliderA\Height,#SliderCornerSize,#SliderCornerSize)
              
              DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Transparent)
              DrawText(pt,(*SliderA\Height-TextHeight(s)) >> 1, s, #Draw100|ct)
              
              DrawingMode(#PB_2DDrawing_Default)
              RoundBox(px,0,#SliderWidth ,*SliderA\Height,#SliderCornerSize,#SliderCornerSize,#Draw100|*SliderA\ColorSlider)
              
              DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Gradient)
              LinearGradient(0,*SliderA\Height,0,0)
              BackColor(#DrawSliderShadow)
              RoundBox(px,0,#SliderWidth ,*SliderA\Height,#SliderCornerSize,#SliderCornerSize,#Draw100|*SliderA\ColorBack)
              
              DrawingMode(#PB_2DDrawing_Outlined)
              RoundBox(px,0,#SliderWidth ,*SliderA\Height,#SliderCornerSize,#SliderCornerSize,#Draw100|#Black)
              RoundBox(0,0,*SliderA\Width,*SliderA\Height,#SliderCornerSize,#SliderCornerSize,#Draw100|#Black)
              
              StopDrawing()
              
            EndIf
            
        EndSelect
        
      EndIf
      
      ProcedureReturn #True
      
    Else
      
      ProcedureReturn #False
      
    EndIf
    
  EndProcedure
  
  Procedure SetState(GadgetID, P_State)
    
    *SliderA.Slider = GetGadgetData(GadgetID)
    
    If *SliderA
      If *SliderA\ControlName = "Slider"
        *SliderA\CurrentState = P_State & 1
        Refresh(GadgetID, #SliderGadget_Draw)
      EndIf
    EndIf
    
  EndProcedure
  
  Procedure GetState(GadgetID)
    
    *SliderA.Slider = GetGadgetData(GadgetID)
    
    If *SliderA
      
      If *SliderA\ControlName = "Slider"
        ProcedureReturn *SliderA\CurrentState
      Else
        ProcedureReturn #Undefined
      EndIf
      
    EndIf
    
  EndProcedure
  
  Procedure ToogleState(GadgetID)
    
    *SliderA.Slider = GetGadgetData(GadgetID)
    
    If *SliderA
      If *SliderA\ControlName = "Slider"
        *SliderA\CurrentState = *SliderA\CurrentState ! 1
        Refresh(GadgetID, #SliderGadget_Draw)
      EndIf
    EndIf
    
  EndProcedure
  
  Procedure SliderGadgetEvents()
    
    Protected GadgetID
    
    GadgetID = EventGadget()
    
    If GadgetType(GadgetID) = #PB_GadgetType_Canvas
      
      Select EventType()
          
        Case #PB_Canvas_LeftButton
          
        Case #PB_EventType_MouseMove
          
        Case #PB_EventType_LeftButtonDown
          
        Case #PB_EventType_LeftButtonUp
          *SliderA.Slider = GetGadgetData(GadgetID)
          
          If *SliderA
            If *SliderA\ControlName = "Slider"
              *SliderA\CurrentState = *SliderA\CurrentState ! 1
              Refresh(GadgetID, #SliderGadget_Draw)
            EndIf
          EndIf
          
      EndSelect
      
    EndIf
    
  EndProcedure
  
  Procedure Gadget(GadgetID, P_x, P_y, P_Width, P_Height, P_Text.s, P_ColorSlider, P_ColorBack, P_ColorText=0)
    
    GadgetHandle = CanvasGadget(GadgetID, P_x, P_y, P_Width, P_Height, #PB_Canvas_Keyboard)
    
    If GadgetID = #PB_Any
      GadgetID = GadgetHandle
    EndIf
    
    *SliderA.Slider = CreateNewSlider()
    *SliderA\Width = P_Width
    *SliderA\Height = P_Height
    *SliderA\Text = P_Text
    *SliderA\ColorText = P_ColorText
    *SliderA\ColorBack = P_ColorBack
    *SliderA\ColorSlider = P_ColorSlider
    SetGadgetData(GadgetID, *SliderA)
    
    Refresh(GadgetID, #SliderGadget_Draw)
    BindGadgetEvent(GadgetID, @SliderGadgetEvents())  
    
    ProcedureReturn GadgetID
  EndProcedure
  
  Procedure Free(GadgetID)
    
    *SliderA.Slider = GetGadgetData(GadgetID)
    
    If *SliderA
      
      If *SliderA\ControlName = "Slider"
        UnbindGadgetEvent(GadgetID, @SliderGadgetEvents())
        
        *SliderA\ControlName = ""
        *SliderA\CurrentState = 0
        *SliderA\Width = 0
        *SliderA\Height = 0
        *SliderA\Text = ""
        *SliderA\ColorText = 0
        *SliderA\ColorBack = 0
        *SliderA\ColorSlider = 0
        *SliderA\UserData = 0
        
        FreeMemory(*SliderA)
      EndIf
      
    EndIf
    
  EndProcedure
  
  Procedure SetUserData(GadgetID, P_UserData.i)
    
    If IsGadget(GadgetID)
      
      *SliderA.Slider = GetGadgetData(GadgetID)
      
      If *SliderA <> #Null
        
        If *SliderA\ControlName = "Slider"
          *SliderA\UserData = P_UserData
        EndIf
        
      EndIf
      
    EndIf
    
  EndProcedure
  
  Procedure.i GetUserData(GadgetID)
    
    If IsGadget(GadgetID)
      
      *SliderA.Slider = GetGadgetData(GadgetID)
      
      If *SliderA <> #Null
        
        If *SliderA\ControlName = "Slider"
          P_UserData.i = *SliderA\UserData
        EndIf
        
      EndIf
      
    EndIf
    
    ProcedureReturn P_UserData
  EndProcedure
  
EndModule

CompilerIf #PB_Compiler_IsMainFile
  
  #Black = 0
  #Yellow = $00FFFF
  #White = $FFFFFF
  #Red = $0000FF
  #Orange = $00A1FF
  #DarkGray = $808080
  #LightGray = $D0D0D0
  #DarkWhite = $FFFFFF
  
  #WinX=640
  #WinY=400
  
  If OpenWindow(0,0,0,#WinX,#WinY,"Shadow",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
    
    Slider::Gadget(66,50,50,135,25,"Macro|Procedure",#White,#Yellow)
    Slider::Gadget(67,50,100,100,25,"Low|High",#White,#LightGray)
    Slider::Gadget(68,50,150,100,30,"Min|Max",#White,#Orange)
    Slider::Gadget(69,200,150,120,30,"Pure...|Basic",#Red,#DarkGray,#White)
    ButtonGadget(11,50,200,100,25,"Ok")

    Slider::SetState(66, 1)
    
    Repeat
      EventID = WaitWindowEvent()
      
      Select EventID
          
        Case #PB_Event_Gadget
          
          Select EventGadget()
              
            Case 66
              If EventType() = #PB_EventType_LeftButtonUp
                Debug "Macro/Procedure Slider : " + Str(Slider::GetState(66))
              EndIf
              
            Case 11
              EventID = #PB_Event_CloseWindow
              
          EndSelect
          
      EndSelect
      
    Until EventID = #PB_Event_CloseWindow
    
    For Index = 66 To 69
      Slider::Free(Index)
    Next 
    
  EndIf
  
CompilerEndIf

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<
The Stone Age did not end due to a shortage of stones !
Post Reply