PureBasic Forums - English

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

uneven gauge?

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

Page 1 of 1

uneven gauge?

Posted: Sat Sep 03, 2022 9:47 pm
by vwidmer
Any one ever make a gauge like this? or know how to?

Image

It is not even separations.

Screenshot from: https://openspeedtest.com

Re: uneven gauge?

Posted: Sun Sep 04, 2022 12:13 am
by mk-soft
Yes, but oop

Link: Own Flat Gadget

Re: uneven gauge?

Posted: Sun Sep 04, 2022 12:59 am
by BarryG
Some other gauge gadget links:

viewtopic.php?p=588848#p588848
viewtopic.php?f=12&t=75842

Re: uneven gauge?

Posted: Sun Sep 04, 2022 9:08 am
by collectordave
Just rescued some code.

Draws a circular gauge with pointer first up to maximum (300) then back to zero

Any use?

Code: Select all

Global Pathx,Pathy

Global Reverse.i

Procedure DrawGauge(Value.i)
  
  Define EndAngle.i
  
  
  EndAngle = 120 + Value
  
  If EndAngle > 360
    
    EndAngle = EndAngle - 360
    
  EndIf
  
  
  
     If StartVectorDrawing(CanvasVectorOutput(0))
       
       ;Clear the gauge
       AddPathBox(0,0,400,200)
       VectorSourceColor(RGBA(255, 255, 255, 255))
       FillPath()
       
       
       
      ; partial circle
      AddPathCircle(100, 100, 75, 120, EndAngle)
      
      VectorSourceColor(RGBA(255, 0, 0, 255))
      
      Pathx = PathCursorX()
      Pathy = PathCursorY()    
      
      
      StrokePath(10, #PB_Path_RoundEnd)
      

      
      MovePathCursor(Pathx,Pathy)
      
      
      AddPathLine(100,100)
      
      VectorSourceColor(RGBA(0, 255, 0, 255))
      StrokePath(1)
  
        StopVectorDrawing()
      EndIf
      
    EndProcedure
    
  
  OpenWindow(0, 0, 0, 400, 200, "VectorDrawing", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    CanvasGadget(0, 0, 0, 400, 200)
    
    AddWindowTimer(0,123,10)

    
    Repeat
      Event = WaitWindowEvent()
      
   If Event = #PB_Event_Timer And EventTimer() = 123
     If Reverse = #True
       iLoop = iLoop - 1
       If iLoop < 0
         Reverse = #False
         iLoop = 0
         EndIf
     Else
       
     iLoop = iLoop + 1
   EndIf
   
   If iLoop < 300
     Drawgauge(iLoop)
   Else
     reverse = #True
     
    EndIf
  EndIf
  
      
    Until Event = #PB_Event_CloseWindow
Of course the trick is to convert your value to be displayed into a number between 0 and 300 which will depend on the scale of the gauge you are using.

Re: uneven gauge?

Posted: Sun Sep 04, 2022 9:17 am
by Olli
With Log10() (and/or Log() ) you get such a scale.

Re: uneven gauge?

Posted: Sun Sep 04, 2022 9:50 am
by collectordave
As a small example to display %

First a small procedure to change your % value to 0-300

Code: Select all

 Procedure.i DisplayPercent(Value.i)
  
  Define Result.f


Result = (Value/100) * 300

ProcedureReturn Result

EndProcedure
Then in the event loop add this

Code: Select all

   If Event = #PB_Event_Timer And EventTimer() = 123
     
     If iLoop > -1
     
     
     Drawgauge(DisplayPercent(iLoop * 25))

     iLoop = iLoop + 1
     If iLoop >4
       iLoop = -1
     EndIf
     
     EndIf
     endif
this will display 0%,25%,50%,75% and 100%

To see it change the timer interval to 1000

Re: uneven gauge?

Posted: Sun Sep 04, 2022 12:22 pm
by vwidmer
Thanks, I have seen most of the gauges, but what I am looking for is not a gauge that goes like 10 - 20 - 30 - 40 - 50 - 60 - 70 -80 - 90 - 100, but that does like the gauge in the original post. .5 - 1 - 10 - 100 - 500 - 1000

So like the first quarter is .5% then next is 10 and next 100 etc.. I am not sure if uneven is the correct term for the gauge.

Thanks again,

Re: uneven gauge?

Posted: Sun Sep 04, 2022 1:07 pm
by Michael Vogel
You'd need an exponential function to do the scaling - for your example it's not a continous system so you will have to check each segment...

...was to lazy to do the first segment (0..5) correctly, so this is handled in a linear manner.

Code: Select all

#Segments=6
Global Dim limit.d(#Segments)

; Init
For i=0 To #Segments
	n=i+(i&1)
	m=i&1+1
	limit(i)=Pow(10,n*0.5)/m
	Debug limit(i)
Next i

; Convert real number to gauge position
Procedure.d scale(value,maximum)

	Protected n
	Protected a.d,b.d
	
	If value<=0
		ProcedureReturn 0
		
	ElseIf value>=limit(#Segments)
		ProcedureReturn maximum
		
	Else
		n=#Segments
		While value<limit(n)
			n-1
		Wend
	EndIf
	
	If n
		a=Log10(limit(n))
		b=Log10(limit(n+1))
		
		ProcedureReturn (n+(Log10(value)-a)/(b-a))*maximum/#Segments
		
	Else
		ProcedureReturn value/limit(1)*maximum/#Segments
		
	EndIf

EndProcedure


Debug "---"

Debug scale(1,100)
Debug scale(9,100)

Re: uneven gauge?

Posted: Sun Sep 04, 2022 2:42 pm
by collectordave
When you something which just cannot be expressed as a linear or exponential function such as in your case the way to go is to use a lookup table.

For example

Your value Gauge Value
0 0
0.1 50
1 100
10 150
100 200
500 250
1000 300

You can keep adding pairs of values up to the gauge limit of 300 for example you could have

0.01 5
0.02 10
0.03 15
0.04 20
0.05 25

up to

0.09 45

So when you have your measurement you check the table for that value on the left and set the gauge to the value on the right.

Clear as mud?

Re: uneven gauge?

Posted: Sun Sep 04, 2022 5:38 pm
by Michael Vogel
Still just a very simplified example, but maybe a good start...

BTW - if you change the value 40.1 to 40.01 you might see some flickering...

Code: Select all

#DrawOpaque=	$FF000000
#LightGray=		$E0E0E0
#DarkGray=		$808080
#LightCyan=		$FFC050

LoadFont(0,"segoe ui",12)

#Segments=6
DataSection
	Data.d 0,0.5,1,10,100,500,1000
EndDataSection

Global Dim limit.d(#Segments)

For i=0 To #Segments
	Read.d limit(i)
Next i

Procedure.d scale(value,maximum)

	Protected n
	Protected a.d,b.d

	If value<=0
		ProcedureReturn 0

	ElseIf value>=limit(#Segments)
		ProcedureReturn maximum

	Else
		n=#Segments
		While value<limit(n)
			n-1
		Wend
	EndIf

	If n
		a=Log10(limit(n))
		b=Log10(limit(n+1))

		ProcedureReturn (n+(Log10(value)-a)/(b-a))*maximum/#Segments

	Else
		ProcedureReturn value/limit(1)*maximum/#Segments

	EndIf

EndProcedure
Procedure DrawGauge(Value.d)

	Protected s.s
	
	StartVectorDrawing(CanvasVectorOutput(0))

	VectorSourceColor(#DrawOpaque|#White)
	FillVectorOutput()

	VectorFont(FontID(0))
	VectorSourceColor(#DrawOpaque|#DarkGray)

	For i=0 To #Segments
		s=StrD(limit(#Segments-i))
		MovePathCursor(200+120*Sin(Radian(40+280/#Segments*i))-VectorTextWidth(s)/2,200+120*Cos(Radian(40+280/#Segments*i))-VectorTextHeight(s)/2)
		DrawVectorText(s)
	Next i
	
	VectorSourceColor(#DrawOpaque|#Black)
	VectorFont(FontID(0),26)
	
	s=Str(Value)
	MovePathCursor(200-VectorTextWidth(s)/2,170)
	DrawVectorText(s)
	
	Value=scale(Value,280)
	s=Str(Value)
	MovePathCursor(200-VectorTextWidth(s)/2,200)
	DrawVectorText(s)
	
	RotateCoordinates(200,200,90)

	AddPathCircle(200,200,150,40,320)
	VectorSourceColor(#DrawOpaque|#LightGray)
	StrokePath(26,#PB_Path_RoundEnd)

	AddPathCircle(200,200,150,40,40+value)
	VectorSourceColor(#DrawOpaque|#LightCyan)
	StrokePath(26,#PB_Path_RoundEnd)

	AddPathCircle(200,200,150,40+value,40.1+value)
	VectorSourceColor(#DrawOpaque|#White)
	StrokePath(20,#PB_Path_RoundEnd)

	StopVectorDrawing()

EndProcedure


OpenWindow(0,0,0,400,400,"The Gauge",#PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CanvasGadget(0,0,0,400,400)

AddWindowTimer(0,123,40)

dir=1

Repeat
	Event = WaitWindowEvent()

	If Event = #PB_Event_Timer And EventTimer() = 123
		iLoop+dir
		If iloop=1000 Or iloop=0
			dir*-1
		EndIf
		Drawgauge(iLoop)
	EndIf
Until Event = #PB_Event_CloseWindow

Re: uneven gauge?

Posted: Sun Sep 04, 2022 11:13 pm
by vwidmer
Michael Vogel wrote: Sun Sep 04, 2022 5:38 pm Still just a very simplified example, but maybe a good start...

BTW - if you change the value 40.1 to 40.01 you might see some flickering...
Very nice, it does more or less what I was hoping though doesnt seem to handle anything less then 1. But very cool.

Thanks so much for this example and to every one who gave me some input.

Re: uneven gauge?

Posted: Mon Sep 05, 2022 6:39 am
by netmaestro
Windows OK? If so, would you like it to morph to a different color as it rises?

Re: uneven gauge?

Posted: Mon Sep 05, 2022 6:48 am
by VB6_to_PBx
Dark Mode version :

Code: Select all


#DrawOpaque=	$FF000000
#LightGray=		$E0E0E0
#DarkGray=		$808080
#LightCyan=		$FFC050

LoadFont(0,"Verdana",12)

#Segments=6
DataSection
	Data.d 0,0.5,1,10,100,500,1000
EndDataSection

Global Dim limit.d(#Segments)

For i=0 To #Segments
	Read.d limit(i)
Next i

Procedure.d scale(value,maximum)

	Protected n
	Protected a.d,b.d

	If value<=0
		ProcedureReturn 0

	ElseIf value>=limit(#Segments)
		ProcedureReturn maximum

	Else
		n=#Segments
		While value<limit(n)
			n-1
		Wend
	EndIf

	If n
		a=Log10(limit(n))
		b=Log10(limit(n+1))

		ProcedureReturn (n+(Log10(value)-a)/(b-a))*maximum/#Segments

	Else
		ProcedureReturn value/limit(1)*maximum/#Segments

	EndIf

EndProcedure
Procedure DrawGauge(Value.d)

	Protected s.s
	
	StartVectorDrawing(CanvasVectorOutput(0))

	VectorSourceColor(#DrawOpaque|RGB(034,034,034))
	FillVectorOutput()

	VectorFont(FontID(0))
	VectorSourceColor(#DrawOpaque|RGBA(255,255,255,255))

	For i=0 To #Segments
		s=StrD(limit(#Segments-i))
		MovePathCursor(200+120*Sin(Radian(40+280/#Segments*i))-VectorTextWidth(s)/2,200+120*Cos(Radian(40+280/#Segments*i))-VectorTextHeight(s)/2)
		DrawVectorText(s)
	Next i
	
	VectorSourceColor(#DrawOpaque|RGBA(255,255,255,255))
	VectorFont(FontID(0),26)
	
	s=Str(Value)
	MovePathCursor(200-VectorTextWidth(s)/2,170)
	DrawVectorText(s)
	
	Value=scale(Value,280)
	s=Str(Value)
	MovePathCursor(200-VectorTextWidth(s)/2,200)
	DrawVectorText(s)
	
	RotateCoordinates(200,200,90)

	AddPathCircle(200,200,150,40,320)
	VectorSourceColor(#DrawOpaque|RGB(0,0,0))
	StrokePath(26,#PB_Path_RoundEnd)

	AddPathCircle(200,200,150,40,40+value)
	VectorSourceColor(#DrawOpaque|#LightCyan)
	StrokePath(26,#PB_Path_RoundEnd)

	AddPathCircle(200,200,150,40+value,40.1+value)
	VectorSourceColor(#DrawOpaque|RGBA(0,0,255,255))
	StrokePath(20,#PB_Path_RoundEnd)

	StopVectorDrawing()

EndProcedure


OpenWindow(0,0,0,400,400,"The Gauge",#PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CanvasGadget(0,0,0,400,400)

AddWindowTimer(0,123,40)

dir=1

Repeat
	Event = WaitWindowEvent()

	If Event = #PB_Event_Timer And EventTimer() = 123
		iLoop+dir
		If iloop=1000 Or iloop=0
			dir*-1
		EndIf
		Drawgauge(iLoop)
	EndIf
Until Event = #PB_Event_CloseWindow

Re: uneven gauge?

Posted: Mon Sep 05, 2022 3:03 pm
by Michael Vogel
Works also for values below 1, just change the procedure parameter to a float type (see below)

Code: Select all

#DrawOpaque=	$FF000000
#LightGray=		$E0E0E0
#DarkGray=		$808080
#LightCyan=		$FFC050

LoadFont(0,"segoe ui",12)

#Segments=6
DataSection
	Data.d 0,0.5,1,10,100,500,1000
EndDataSection

Global Dim limit.d(#Segments)

For i=0 To #Segments
	Read.d limit(i)
Next i

Procedure.d scale(value.d,maximum)

	Protected n
	Protected a.d,b.d

	If value<=0
		ProcedureReturn 0

	ElseIf value>=limit(#Segments)
		ProcedureReturn maximum

	Else
		n=#Segments
		While value<limit(n)
			n-1
		Wend
	EndIf

	If n
		a=Log10(limit(n))
		b=Log10(limit(n+1))

		ProcedureReturn (n+(Log10(value)-a)/(b-a))*maximum/#Segments

	Else
		ProcedureReturn value/limit(1)*maximum/#Segments

	EndIf

EndProcedure
Procedure DrawGauge(Value.d)

	Protected s.s

	StartVectorDrawing(CanvasVectorOutput(0))

	VectorSourceColor(#DrawOpaque|#White)
	FillVectorOutput()

	VectorFont(FontID(0))
	VectorSourceColor(#DrawOpaque|#DarkGray)

	For i=0 To #Segments
		s=StrD(limit(#Segments-i))
		MovePathCursor(200+120*Sin(Radian(40+280/#Segments*i))-VectorTextWidth(s)/2,200+120*Cos(Radian(40+280/#Segments*i))-VectorTextHeight(s)/2)
		DrawVectorText(s)
	Next i

	VectorSourceColor(#DrawOpaque|#Black)
	VectorFont(FontID(0),26)

	s=StrD(Value,1)
	MovePathCursor(200-VectorTextWidth(s)/2,170)
	DrawVectorText(s)

	Value=scale(Value,280)
	s=StrD(Value,1)
	MovePathCursor(200-VectorTextWidth(s)/2,200)
	DrawVectorText(s)

	RotateCoordinates(200,200,90)

	AddPathCircle(200,200,150,40,320)
	VectorSourceColor(#DrawOpaque|#LightGray)
	StrokePath(26,#PB_Path_RoundEnd)
	
	AddPathCircle(200,200,150,40,40.1+value)
	VectorSourceColor(#DrawOpaque|#LightCyan)
	StrokePath(26,#PB_Path_RoundEnd)

	AddPathCircle(200,200,150,40+value,40.1+value)
	VectorSourceColor(#DrawOpaque|#White)
	StrokePath(20,#PB_Path_RoundEnd)

	StopVectorDrawing()

EndProcedure


OpenWindow(0,0,0,400,430,"The Gauge",#PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CanvasGadget(0,0,0,400,400)
StringGadget(1,0,400,400,30,"0.1")
AddWindowTimer(0,123,100)
AddKeyboardShortcut(0,#PB_Shortcut_Space,999)
SetActiveGadget(1)

dir=1
run=0
val.d=0
old.d=0

Repeat
	Select WaitWindowEvent()
			
	Case #PB_Event_Menu
		If EventMenu()=999
			run!1
		EndIf
		
	Case #PB_Event_Timer
		If run
			iLoop+dir*(1+4*Bool(iLoop>=10)+15*Bool(iLoop>=100))
			If iloop=1000 Or iloop=0
				dir*-1
			EndIf
			Drawgauge(iLoop)
			
		Else
			val=ValD(GetGadgetText(1))
			If val<>old
				Drawgauge(val)
				old=val
			EndIf
				
		EndIf
		
	Case #PB_Event_CloseWindow
		Break

	EndSelect
ForEver

Re: uneven gauge?

Posted: Mon Sep 05, 2022 5:40 pm
by vwidmer
@VB6_to_PBx: Like the dark mode :)

@Michael Vogel: PERFECT!!! Thanks so much beautiful...
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited