PureBasic Forums - English

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

Slider Gadget

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

Page 1 of 1

Slider Gadget

Posted: Thu Aug 29, 2013 10:33 am
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

Re: Slider Gadget

Posted: Thu Aug 29, 2013 11:12 am
by sec
Nice :)

my comment:
DialogBackgroundColor=GetSysColor_(#COLOR_BTNFACE) should replace with what that can portable (Linux for example) , it will 8)

Re: Slider Gadget

Posted: Thu Aug 29, 2013 1:32 pm
by davido
Very nice. :D

Re: Slider Gadget

Posted: Thu Aug 29, 2013 3:34 pm
by luis
Nice, thanks :)

Re: Slider Gadget

Posted: Thu Aug 29, 2013 11:26 pm
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 :|

Re: Slider Gadget

Posted: Thu Aug 29, 2013 11:34 pm
by Bisonte
Image

Re: Slider Gadget

Posted: Sun Sep 01, 2013 8:02 pm
by minimy
very pretty! and very useful!
Thanks friend!

Re: Slider Gadget

Posted: Tue Sep 03, 2013 2:51 am
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

Re: Slider Gadget

Posted: Tue Sep 03, 2013 6:48 am
by Michael Vogel
StarBootics, don't know about this function (new in 5.20?), will try to check that as soon as possible.

Re: Slider Gadget

Posted: Tue Sep 03, 2013 9:28 am
by kvitaliy
Very nice :idea:

Re: Slider Gadget

Posted: Tue Sep 03, 2013 12:49 pm
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

Re: Slider Gadget

Posted: Tue Sep 03, 2013 1:53 pm
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....

Re: Slider Gadget

Posted: Tue Sep 03, 2013 2:58 pm
by Kwai chang caine
Top cool !!!
Thanks for sharing 8)

Re: Slider Gadget

Posted: Wed Mar 09, 2016 1:28 am
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 <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited