CPU % usage meter.

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
PaulSquires
Posts: 1002
Joined: Jul 14, 2005 23:41

Re: CPU % usage meter.

Post by PaulSquires »

dodicat wrote: May 31, 2022 11:53 Would it be troublesome to fix the (path names with spaces )?
Sadly, I have tried several times to find the source of why a compile would fail with the embedded folder spaces. I believe that I have one or two threads somewhere here on the forum where myself and fxm discuss it. The problem occurs during the createprocess used to "shell" to the compiler to create the exe. It doesn't always happen, but it seems to occur more often whenever a resource file is used with embedded references to images (that's just an educated guess on my part). I have read many places elsewhere on the web that the gcc toolchain has trouble with embedded path spaces given that it comes from a unix background. Granted, I have even tried double quoting the paths but the toolchain still threw errors but, like I said, only threw errors for some projects but not others. This has been an extremely frustrating bug for me to the point where I suggest that WinFBE simply be used with non-space folder names. Someday I will have an epiphany and find an answer.
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: CPU % usage meter.

Post by UEZ »

@dodicat: very nice :)

I added current CPU speed:

Code: Select all

'By dodicat
#include "windows.bi"
#include "win/powrprof.bi"

Function _WinAPI_GetCPUProcessors() As Long
	Dim As SYSTEM_INFO tSYSTEM_INFO
	GetSystemInfo(@tSYSTEM_INFO)
	Return tSYSTEM_INFO.dwNumberOfProcessors
End Function

Function getSystemCPUTime(ByRef totalTime  As ULongInt, ByRef idleTime As ULongInt)As boolean
	Dim As FILETIME ftSysIdle, ftSysKernel, ftSysUser
	If (GetSystemTimes(@ftSysIdle, @ftSysKernel, @ftSysUser))=0 Then Return false
	Dim As  ULARGE_INTEGER sysKernel, sysUser, sysIdle
	sysKernel.HighPart = ftSysKernel.dwHighDateTime
	sysKernel.LowPart = ftSysKernel.dwLowDateTime
	sysUser.HighPart = ftSysUser.dwHighDateTime
	sysUser.LowPart = ftSysUser.dwLowDateTime
	sysIdle.HighPart = ftSysIdle.dwHighDateTime
	sysIdle.LowPart = ftSysIdle.dwLowDateTime
	totalTime = sysKernel.QuadPart + sysUser.QuadPart
	idleTime = sysIdle.QuadPart
	Return True
End Function

Function pipeout(ByVal s As String="") ByRef As String
	Var f=FreeFile
	Dim As String tmp
	Open Pipe s For Input As #f
	s=""
	Do Until EOF(f)
		Line Input #f,tmp
		s+=tmp+Chr(10)
	Loop
	Close #f
	Return s
End Function

Function map(a As Double,b As Double,x As Double,c As Double,d As Double) As Double
	Return (d-c)*(x-a)/(b-a)+c
End Function

Sub Line_To(x1 As Long,y1 As Long,x2 As Long,y2 As Long,d As Single,Byref x As Long=0,Byref y As Long=0,i As Any Ptr=0)
	x=x1+(x2-x1)*d
	y=y1+(y2-y1)*d
End Sub

Sub thick_line(x1 As Long,y1 As Long,x2 As Long,y2 As Long,thickness As Single, colour As Ulong,im As Any Ptr=0)
	If thickness<2 Then
		Line im,(x1,y1)-(x2,y2),colour
	Else
		Var h=Sqr((x2-x1)^2+(y2-y1)^2)
		If h=0 Then h=1e-6
		Var s=(y1-y2)/h
		Var c=(x2-x1)/h
		Line im,(x1+s*thickness/2,y1+c*thickness/2)-(x2+s*thickness/2,y2+c*thickness/2),colour
		Line im,(x1-s*thickness/2,y1-c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),colour
		Line im,(x1+s*thickness/2,y1+c*thickness/2)-(x1-s*thickness/2,y1-c*thickness/2),colour
		Line im,(x2+s*thickness/2,y2+c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),colour
		Paint im,((x1+x2)/2, (y1+y2)/2), colour, colour
	End If
End Sub

Sub drawline(x As Long,y As Long,angle As Single,lngth As Double,Byref x2 As Long=0,Byref y2 As Long=0)
	angle=angle*Atn(1)/45
	x2=x+lngth*Cos(angle)
	y2=y-lngth*Sin(angle)
End Sub

Sub digits(t As String,x As Long,y As Long,clr As Ulong,sz As Single,gap As Long=1,img As Any Pointer=0)
	x=x-2*sz
	Dim As Single s=Any,c=Any
	Dim As Single  d =Iif(gap, sz/10,0)
	#macro thickline(x1,y1,x2,y2)
		s=(y1-y2)/10
		c=(x2-x1)/10
		Line img,(x1-s,y1-c)-(x2+s,y2+c),clr,bf
	#endmacro
	#macro display(_a,_b,_c,_d,_e,_f,_g)
		x=x+2*sz
		If _a=1 Then :thickline(x+d,y,(x-d+sz),y):End If
		If _b=1 Then :thickline((x+sz),y+d,(x+sz),(y-d+sz)):End If
		If _c=1 Then :thickline((x+sz),(y+d+sz),(x+sz),(y-d+2*sz)):End If
		If _d=1 Then :thickline((x-d+sz),(y+2*sz),x+d,(y+2*sz)):End If ''
		If _e=1 Then :thickline(x,(y-d+2*sz),x,(y+d+sz)):End If
		If _f=1 Then :thickline(x,(y-d+sz),x,y+d):End If
		If _g=1 Then :thickline(x+d,(y+sz),(x-d+sz),(y+sz)):End If
	#endmacro
	For z As Long=0 To Len(t)-1
		Select Case As Const t[z]
		Case 48 :display(1,1,1,1,1,1,0)             '"0"
		Case 49 :display(0,1,1,0,0,0,0)             '"1"
		Case 50 :display(1,1,0,1,1,0,1)             '"2"
		Case 51 :display(1,1,1,1,0,0,1)             '"3"
		Case 52 :display(0,1,1,0,0,1,1)             '"4"
		Case 53 :display(1,0,1,1,0,1,1)             '"5"
		Case 54 :display(1,0,1,1,1,1,1)             '"6"
		Case 55 :display(1,1,1,0,0,0,0)             '"7"
		Case 56 :display(1,1,1,1,1,1,1)             '"8"
		Case 57 :display(1,1,1,1,0,1,1)            '"9"
		Case 58                                     '":"
			Circle img,((x+2*sz),(y+sz/2)),(sz/5),clr,,,,f
			Circle img,((x+2*sz),(y+1.5*sz)),(sz/5),clr,,,,f
			x=x+sz
		Case 45 :display(0,0,0,0,0,0,1)              '"-"
		Case 46                                      '"."
			Circle img,((x+2*sz),(y+1.9*sz)),(sz/5),clr,,,,f
			x=x+sz
		Case 32                                      '" "
			x=x+sz
		End Select
	Next z
End Sub

Sub createdial(i As Any Ptr)
	Circle i,(400,300),265,Rgb(110,110,110),,,,f
	Circle i,(273,443),2,0,,,,f
	Circle i,(524,439),2,0,,,,f
	Dim As Any Ptr i2=Imagecreate(30,30,Rgb(110,110,110))
	thick_line(5,25,25,5,3,Rgb(200,200,200),i2)
	Circle i2,(15-4,5),3,Rgb(200,200,200)
	Circle i2,(15+4,25),3,Rgb(200,200,200)
	Put i,(435-10,345),i2,Pset
	Dim As Long a,b,x,y
	Var z=6
	For n As Single=-40-z To 220+z Step 1.7
		Dim As Long k=map(-40-z,220+z,n,100,0)
		If k Mod 10=0 Then
			drawline(400,300,n,220,a,b)
			Line_To(a,b,400,300,.2,x,y)
			Line i,(a,b)-(x,y),Rgb(0,0,0)
			Line_To(a,b,400,300,-.1,x,y)
			digits(Str(Int(k)),x-8-2,y-5,Rgb(255,255,255),6,0,i)
		End If
		If k Mod 5=0 And n Mod 10<>0  Then
			drawline(400,300,n,220,a,b)
			Line_To(a,b,400,300,.05,x,y)
			Line i,(a,b)-(x,y),Rgb(0,0,0)
		End If
	Next n
	Imagedestroy i2
End Sub

Sub rotateimage(Byref dest As Any Ptr=0,im As Any Ptr,angle As Single,shiftx As Long=0,shifty As Long=0,sc As Single=1,miss As Ulong=Rgb(255,0,255),fixedpivot As boolean=false)
	Static As Integer pitch,pitchs,xres,yres,runflag
	Static As Any Ptr row,rows
	Static As Integer ddx,ddy,resultx,resulty
	Imageinfo im,ddx,ddy,,pitch,row
	If dest=0 Then
		Screeninfo xres,yres,,,pitchS
		rowS=Screenptr
	Else
		If sc<>1 Then
			Dim As Integer x,y
			Imageinfo dest,x,y
			Imagedestroy dest:dest=0: dest=Imagecreate(x*sc,y*sc)
		End If
		Imageinfo dest, xres,yres,,pitchS,rows
	End If
	Dim As Long centreX=ddx\2,centreY=ddy\2
	Dim As Single sx=Sin(angle)
	Dim As Single cx=Cos(angle)
	Dim As Long mx=Iif(ddx>=ddy,ddx,ddy),shftx,shfty
	Var fx=sc*.7071067811865476,sc2=1/sc
	If fixedpivot=false Then
		shiftx+=centreX*sc-centrex
		shiftY+=centrey*sc-centrey
	End If
	For y As Long=centrey-fx*mx+1 To centrey+ fx*mx
		Dim As Single sxcy=Sx*(y-centrey),cxcy=Cx*(y-centrey)
		shfty=y+shifty
		For x As Long=centrex-mx*fx To centrex+mx*fx
			If x+shiftx >=0 Then 'on the screen
				If x+shiftx <xres Then
					If shfty >=0 Then
						If shfty<yres Then
							resultx=sc2*(Cx*(x-centrex)-Sxcy) +centrex:resulty=sc2*(Sx*(x-centrex)+Cxcy) +centrey
							If resultx >=0 Then 'on the image
								If resultx<ddx Then
									If resulty>=0 Then
										If resulty<ddy Then
											Dim As Ulong u=*Cast(Ulong Ptr,row+pitch*((resultY))+((resultX)) Shl 2 ) 'point(image)
											If u<>miss Then *Cast(Ulong Ptr,rowS+pitchS*(y+shifty)+(x+shiftx) Shl 2)= u 'pset (screen)
										End If:End If:End If:End If
						End If:End If:End If:End If
		Next x
	Next y
End Sub

Function odometer(v As Long, mhz As Long = 0) As Long
	Const pi=4*Atn(1)
	Static As Long s=0
	Static As Any Ptr tmp,hnd
	If tmp=0 Then tmp=Imagecreate(1600,100,Rgb(255,255,255))
	If hnd=0 Then
		hnd=Imagecreate(400,20)
		Var dx=20
		thick_line(dx+5,10,220,10,2,Rgb(200,200,219),hnd)
		Line hnd,(dx,10)-(15+dx,0),Rgb(200,00,00)
		Line hnd,(dx,10)-(15+dx,20),Rgb(200,00,00)
		Line hnd,(15+dx,0)-(15+dx,20),Rgb(200,00,00)
		Paint hnd,(10+dx,10),Rgb(200,00,00),Rgb(200,00,00)
		circle hnd,(230,10),10,rgb(200,200,200),,,.9,f
	End If
	Static As Any Ptr strip
	If strip=0 Then
		strip=Imagecreate(1600,100,Rgb(255,255,255))
		For n As Long=10 To 90 Step 10
			Line strip,(0,n)-(1600,n),Rgb(220,220,220)
		Next n
	End If
	Dim As Long w,h,ctrx,ctry
	Imageinfo hnd,w,h
	ctrx=400-w/2
	ctry=300-h/2
	Dim As Double k=map(100,0,v,-46,226)
	rotateimage(,hnd,k*0.0174533-pi,ctrx,ctry,1,,0)
	Circle(400,300),2,Rgb(0,0,0),,,,f
	digits(Right("000"+Str((v))+"%",4),380-10,350,Rgb(200,200,200),10)
	Var ypos=map(0,100,v,99,0)
	If s>=800 Then
		Get strip,(800,0)-(1600-1,100-1),tmp
		Line strip,(0,0)-(1600,100),Rgb(255,255,255),bf
		For n As Long=10 To 90 Step 10
			Line strip,(0,n)-(1600,n),Rgb(220,220,220)
		Next n
		Put strip,(0,0),tmp,Pset
		s=0
	End If
	thick_line(800+s,100,800+s,ypos,3,Rgb(150,150,150),strip)
	Draw String(370, 450), Str(mhz) & " MHz", 0
	Put (0-s,600),strip,Pset
	s+=5
	For n As Long=10 To 90 Step 10
		digits(Str(n),5,700-n-3,Rgb(0,0,0),3,1)
	Next n
	Return v
End Function

Sub Remove(Text As String,Char As String)
	Var index = 0,asci=Asc(char)
	For i As Integer = 0 To Len(Text) - 1
		If Text[i] <> asci Then Text[index] = Text[i] : index =index+ 1
Next : Text = Left(Text,index)
End Sub

Sub title()
	Dim As String g
	Var s=pipeout("wmic cpu get maxclockspeed")
	remove(s,Chr(10))
	g+=s
	s=pipeout("wmic cpu get numberofcores")
	remove(s,Chr(10))
	Screenres 800,700,32
	Color ,Rgb(170,170,170)
	Width 800\8,700\14
	Windowtitle g+s+" Close window to finish"
End Sub

Function GetCPU() As Long
	title()
	Static As Any Ptr im
	If im=0 Then
		im=Imagecreate(800,700,Rgb(170,170,170))
		createdial(im)
	End If
	Dim As Ulong interval = 999
	Dim As ULONGLONG totalPrev = 0, totalCurr = 0
	Dim As ULONGLONG idlePrev = 0, idleCurr = 0
	Dim As ULONGLONG tmp
	Dim As String key
	Dim As Ulong totalCPUUsage = 0, CPUCores = _WinAPI_GetCPUProcessors()
	
	Type tPROCESSOR_POWER_INFORMATION
		As ULONG Number
		As ULONG MaxMhz
		As ULONG CurrentMhz
		As ULONG MhzLimit
		As ULONG MaxIdleState
		As ULONG CurrentIdleState
	End Type
	
	Dim As tPROCESSOR_POWER_INFORMATION PROCESSOR_POWER_INFORMATION(0 To CPUCores - 1)
	
	Dim As Long result = getSystemCPUTime(totalPrev, idlePrev), tsize = SizeOf(tPROCESSOR_POWER_INFORMATION) * CPUCores
	Dim As ULong mhz, i
	While True
		Sleep(interval)
		
		key=Inkey
		If (getSystemCPUTime(totalCurr, idleCurr)) Then
			Dim As  LONGLONG total = totalCurr - totalPrev
			If (total > 0) Then
				CallNtPowerInformation(ProcessorInformation, 0, 0, @PROCESSOR_POWER_INFORMATION(0), tsize)
				mhz = 0
				For i = 0 To Ubound(PROCESSOR_POWER_INFORMATION)
					mhz += PROCESSOR_POWER_INFORMATION(i).CurrentMhz
				Next
				Dim As  LONGLONG idle = idleCurr - idlePrev
				totalCPUUsage = (100 * (total - idle) / (total))
				ScreenLock
				Put(0,0),im,PSet
				odometer(totalCPUUsage, mhz \ CPUCores)
				ScreenUnlock
				If key=Chr(27) Or key=Chr(255)+"k" Then Return 0
			End If
			totalPrev = totalCurr
			idlePrev = idleCurr
		End If
	Wend
	Return 0
End Function


End GetCPU()
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: CPU % usage meter.

Post by dodicat »

Thanks UEZ, that is a nice addition.
I can get the current speed via wmic, but this means putting it in the loop via shell (pipe), which really means something like
https://en.wikipedia.org/wiki/Observer_effect_(physics)
or if you like, the
Heisenberg's uncertainty principle applied to freebasic.
Which in forum terms probably means that in order to view the %CPU and current clock speed I would have to use quite a % CPU for the task.
But your method adds very little to the CPU usage.
Thanks again.
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: CPU % usage meter.

Post by UEZ »

Yes, that the problem with reading out CPU usage.

If you want you can add memory usage, too:

Code: Select all

#include "string.bi"
#include "windows.bi"
#include "win/psapi.bi"

Dim As _PERFORMANCE_INFORMATION PERFORMANCE_INFORMATION
GetPerformanceInfo(@PERFORMANCE_INFORMATION, Sizeof(_PERFORMANCE_INFORMATION))
With PERFORMANCE_INFORMATION
	? "Total: " & Format((.PhysicalTotal * .PageSize) / 1024 ^ 3, "#,##0.00 gb") 
	? "Available: " & Format((.PhysicalAvailable * .PageSize) / 1024 ^ 3, "#,##0.00 gb / ") & Format(1 - (.PhysicalAvailable * .PageSize) / (.PhysicalTotal * .PageSize), "0.00%")
End With
Sleep
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: CPU % usage meter.

Post by dodicat »

Could you double check UEZ

Code: Select all

shell("systeminfo | find /I ""Physical Memory""") 
My results:
Total Physical Memory: 8,080 MB
Available Physical Memory: 4,360 MB
Press any key to continue . . .

Your results:
Total: 3.89 gb
Available: 0.37 gb / 90.53%
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: CPU % usage meter.

Post by UEZ »

Hmmm, for me it works properly:

FB:

Code: Select all

Total: 13,93 gb
Available: 4,45 gb / 68,04%
Systeminfo:

Code: Select all

Total Physical Memory:     14.269 MB
Available Physical Memory: 4.555 MB
Can you please test this app? Autoit SysInfo Clock
After you have started the app just hover the mouse over the meter on the right side (left to 3 o'clock). What is the value there?

Edit: it seems to work properly only for x64 - with x86 it fails for some reason.
srvaldez
Posts: 3379
Joined: Sep 25, 2005 21:54

Re: CPU % usage meter.

Post by srvaldez »

for what it's worth, both codes work on my PC but UEZ's code is quicker
the reported memory by UEZ'z code is off a bit but close enough
srvaldez
Posts: 3379
Joined: Sep 25, 2005 21:54

Re: CPU % usage meter.

Post by srvaldez »

maybe this will easier to debug

Code: Select all

#include "string.bi"
#inclib "psapi"

type SIZE_T as uinteger
type DWORD as ulong

type _PERFORMANCE_INFORMATION
    cb as DWORD
    CommitTotal as SIZE_T
    CommitLimit as SIZE_T
    CommitPeak as SIZE_T
    PhysicalTotal as SIZE_T
    PhysicalAvailable as SIZE_T
    SystemCache as SIZE_T
    KernelTotal as SIZE_T
    KernelPaged as SIZE_T
    KernelNonpaged as SIZE_T
    PageSize as SIZE_T
    HandleCount as DWORD
    ProcessCount as DWORD
    ThreadCount as DWORD
end type

type PERFORMANCE_INFORMATION as _PERFORMANCE_INFORMATION
type PPERFORMANCE_INFORMATION as _PERFORMANCE_INFORMATION ptr
type PERFORMACE_INFORMATION as _PERFORMANCE_INFORMATION
type PPERFORMACE_INFORMATION as _PERFORMANCE_INFORMATION ptr

extern "windows"
    declare function GetPerformanceInfo( byval as PPERFORMANCE_INFORMATION, byval as DWORD) as boolean
end extern

Dim As _PERFORMANCE_INFORMATION PERFORMANCE_INFORMATION

GetPerformanceInfo(@PERFORMANCE_INFORMATION, Sizeof(_PERFORMANCE_INFORMATION))
With PERFORMANCE_INFORMATION
    ? "Total: " & Format((.PhysicalTotal * .PageSize) / 1024 ^ 3, "#,##0.00 gb") 
    ? "Available: " & Format((.PhysicalAvailable * .PageSize) / 1024 ^ 3, "#,##0.00 gb / ") & Format(1 - (.PhysicalAvailable * .PageSize) / (.PhysicalTotal * .PageSize), "0.00%")
End With
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: CPU % usage meter.

Post by dodicat »

UEZ
It is OK here 64 bits (as you suggest)
srvaldez
Yes, I need the fast method which doesn't use much CPU.
UEZ
I think that Autoit Sysinfo Clock needs to be bought (9.199 euros) , it is only a 30 day trial?
srvaldez
Posts: 3379
Joined: Sep 25, 2005 21:54

Re: CPU % usage meter.

Post by srvaldez »

@UEZ
it works if you re-arrange the expression to avoid overflow

Code: Select all

#include "string.bi"
#include "windows.bi"
#include "win/psapi.bi"

Dim As _PERFORMANCE_INFORMATION PERFORMANCE_INFORMATION
GetPerformanceInfo(@PERFORMANCE_INFORMATION, Sizeof(_PERFORMANCE_INFORMATION))
With PERFORMANCE_INFORMATION
    ? "Total: " & Format(.PhysicalTotal / 1024 ^ 3 * .PageSize, "#,##0.00 gb") 
    ? "Available: " & Format(.PhysicalAvailable / 1024 ^ 3 * .PageSize, "#,##0.00 gb / ") & Format(1 - (.PhysicalAvailable / .PhysicalTotal), "0.00%")
End With
Sleep
better

Code: Select all

#include "string.bi"
#include "windows.bi"
#include "win/psapi.bi"

extern "c"
    declare function ceiling alias "ceil" (byval as double) as double
end extern

Dim As _PERFORMANCE_INFORMATION PERFORMANCE_INFORMATION
dim as uinteger fm
GetPerformanceInfo(@PERFORMANCE_INFORMATION, Sizeof(_PERFORMANCE_INFORMATION))
With PERFORMANCE_INFORMATION
    fm = ceiling(.PhysicalTotal / 1024 ^ 3 * .PageSize)
    ? "Total: " & Format(fm, "#,##0.00 gb") 
    ? "Available: " & Format(.PhysicalAvailable / 1024 ^ 3 * .PageSize, "#,##0.00 gb / ") & Format(1 - (.PhysicalAvailable / .PhysicalTotal), "0.00%")
End With
Sleep
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: CPU % usage meter.

Post by dodicat »

I have applied some fixes.

Code: Select all

'By dodicat
#include "windows.bi"
#include "win/powrprof.bi"
#include "win/psapi.bi"

Function _WinAPI_GetCPUProcessors() As Long
	Dim As SYSTEM_INFO tSYSTEM_INFO
	GetSystemInfo(@tSYSTEM_INFO)
	Return tSYSTEM_INFO.dwNumberOfProcessors
End Function

Function getSystemCPUTime(ByRef totalTime  As ULongInt, ByRef idleTime As ULongInt)As boolean
	Dim As FILETIME ftSysIdle, ftSysKernel, ftSysUser
	If (GetSystemTimes(@ftSysIdle, @ftSysKernel, @ftSysUser))=0 Then Return false
	Dim As  ULARGE_INTEGER sysKernel, sysUser, sysIdle
	sysKernel.HighPart = ftSysKernel.dwHighDateTime
	sysKernel.LowPart = ftSysKernel.dwLowDateTime
	sysUser.HighPart = ftSysUser.dwHighDateTime
	sysUser.LowPart = ftSysUser.dwLowDateTime
	sysIdle.HighPart = ftSysIdle.dwHighDateTime
	sysIdle.LowPart = ftSysIdle.dwLowDateTime
	totalTime = sysKernel.QuadPart + sysUser.QuadPart
	idleTime = sysIdle.QuadPart
	Return True
End Function

Function pipeout(ByVal s As String="") ByRef As String
	Var f=FreeFile
	Dim As String tmp
	Open Pipe s For Input As #f
	s=""
	Do Until EOF(f)
		Line Input #f,tmp
		s+=tmp+Chr(10)
	Loop
	Close #f
	Return s
End Function

Function map(a As Double,b As Double,x As Double,c As Double,d As Double) As Double
	Return (d-c)*(x-a)/(b-a)+c
End Function

Sub Line_To(x1 As Long,y1 As Long,x2 As Long,y2 As Long,d As Single,Byref x As Long=0,Byref y As Long=0,i As Any Ptr=0)
	x=x1+(x2-x1)*d
	y=y1+(y2-y1)*d
End Sub

Sub thick_line(x1 As Long,y1 As Long,x2 As Long,y2 As Long,thickness As Single, colour As Ulong,im As Any Ptr=0)
	If thickness<2 Then
		Line im,(x1,y1)-(x2,y2),colour
	Else
		Var h=Sqr((x2-x1)^2+(y2-y1)^2)
		If h=0 Then h=1e-6
		Var s=(y1-y2)/h
		Var c=(x2-x1)/h
		Line im,(x1+s*thickness/2,y1+c*thickness/2)-(x2+s*thickness/2,y2+c*thickness/2),colour
		Line im,(x1-s*thickness/2,y1-c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),colour
		Line im,(x1+s*thickness/2,y1+c*thickness/2)-(x1-s*thickness/2,y1-c*thickness/2),colour
		Line im,(x2+s*thickness/2,y2+c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),colour
		Paint im,((x1+x2)/2, (y1+y2)/2), colour, colour
	End If
End Sub

Sub drawline(x As Long,y As Long,angle As Single,lngth As Double,Byref x2 As Long=0,Byref y2 As Long=0)
	angle=angle*Atn(1)/45
	x2=x+lngth*Cos(angle)
	y2=y-lngth*Sin(angle)
End Sub

Sub digits(t As String,x As Long,y As Long,clr As Ulong,sz As Single,gap As Long=1,img As Any Pointer=0)
	x=x-2*sz
	Dim As Single s=Any,c=Any
	Dim As Single  d =Iif(gap, sz/10,0)
	#macro thickline(x1,y1,x2,y2)
		s=(y1-y2)/10
		c=(x2-x1)/10
		Line img,(x1-s,y1-c)-(x2+s,y2+c),clr,bf
	#endmacro
	#macro display(_a,_b,_c,_d,_e,_f,_g)
		x=x+2*sz
		If _a=1 Then :thickline(x+d,y,(x-d+sz),y):End If
		If _b=1 Then :thickline((x+sz),y+d,(x+sz),(y-d+sz)):End If
		If _c=1 Then :thickline((x+sz),(y+d+sz),(x+sz),(y-d+2*sz)):End If
		If _d=1 Then :thickline((x-d+sz),(y+2*sz),x+d,(y+2*sz)):End If ''
		If _e=1 Then :thickline(x,(y-d+2*sz),x,(y+d+sz)):End If
		If _f=1 Then :thickline(x,(y-d+sz),x,y+d):End If
		If _g=1 Then :thickline(x+d,(y+sz),(x-d+sz),(y+sz)):End If
	#endmacro
	For z As Long=0 To Len(t)-1
		Select Case As Const t[z]
		Case 48 :display(1,1,1,1,1,1,0)             '"0"
		Case 49 :display(0,1,1,0,0,0,0)             '"1"
		Case 50 :display(1,1,0,1,1,0,1)             '"2"
		Case 51 :display(1,1,1,1,0,0,1)             '"3"
		Case 52 :display(0,1,1,0,0,1,1)             '"4"
		Case 53 :display(1,0,1,1,0,1,1)             '"5"
		Case 54 :display(1,0,1,1,1,1,1)             '"6"
		Case 55 :display(1,1,1,0,0,0,0)             '"7"
		Case 56 :display(1,1,1,1,1,1,1)             '"8"
		Case 57 :display(1,1,1,1,0,1,1)            '"9"
		Case 58                                     '":"
			Circle img,((x+2*sz),(y+sz/2)),(sz/5),clr,,,,f
			Circle img,((x+2*sz),(y+1.5*sz)),(sz/5),clr,,,,f
			x=x+sz
		Case 45 :display(0,0,0,0,0,0,1)              '"-"
		Case 46                                      '"."
			Circle img,((x+2*sz),(y+1.9*sz)),(sz/5),clr,,,,f
			x=x+sz
		Case 32                                      '" "
			x=x+sz
		End Select
	Next z
End Sub

Sub createdial(i As Any Ptr)
	Circle i,(400,300),265,Rgb(110,110,110),,,,f
	Circle i,(273,443),2,0,,,,f
	Circle i,(524,439),2,0,,,,f
	Dim As Any Ptr i2=Imagecreate(30,30,Rgb(110,110,110))
	thick_line(5,25,25,5,3,Rgb(200,200,200),i2)
	Circle i2,(15-4,5),3,Rgb(200,200,200)
	Circle i2,(15+4,25),3,Rgb(200,200,200)
	Put i,(435-10,345),i2,Pset
	Dim As Long a,b,x,y
	Var z=6
	For n As Single=-40-z To 220+z Step 1.7
		Dim As Long k=map(-40-z,220+z,n,100,0)
		If k Mod 10=0 Then
			drawline(400,300,n,220,a,b)
			Line_To(a,b,400,300,.2,x,y)
			Line i,(a,b)-(x,y),Rgb(0,0,0)
			Line_To(a,b,400,300,-.1,x,y)
			digits(Str(Int(k)),x-8-2,y-5,Rgb(255,255,255),6,0,i)
		End If
		If k Mod 5=0 And n Mod 10<>0  Then
			drawline(400,300,n,220,a,b)
			Line_To(a,b,400,300,.05,x,y)
			Line i,(a,b)-(x,y),Rgb(0,0,0)
		End If
	Next n
	Imagedestroy i2
End Sub

Sub rotateimage(Byref dest As Any Ptr=0,im As Any Ptr,angle As Single,shiftx As Long=0,shifty As Long=0,sc As Single=1,miss As Ulong=Rgb(255,0,255),fixedpivot As boolean=false)
	Static As Integer pitch,pitchs,xres,yres,runflag
	Static As Any Ptr row,rows
	Static As Integer ddx,ddy,resultx,resulty
	Imageinfo im,ddx,ddy,,pitch,row
	If dest=0 Then
		Screeninfo xres,yres,,,pitchS
		rowS=Screenptr
	Else
		If sc<>1 Then
			Dim As Integer x,y
			Imageinfo dest,x,y
			Imagedestroy dest:dest=0: dest=Imagecreate(x*sc,y*sc)
		End If
		Imageinfo dest, xres,yres,,pitchS,rows
	End If
	Dim As Long centreX=ddx\2,centreY=ddy\2
	Dim As Single sx=Sin(angle)
	Dim As Single cx=Cos(angle)
	Dim As Long mx=Iif(ddx>=ddy,ddx,ddy),shftx,shfty
	Var fx=sc*.7071067811865476,sc2=1/sc
	If fixedpivot=false Then
		shiftx+=centreX*sc-centrex
		shiftY+=centrey*sc-centrey
	End If
	For y As Long=centrey-fx*mx+1 To centrey+ fx*mx
		Dim As Single sxcy=Sx*(y-centrey),cxcy=Cx*(y-centrey)
		shfty=y+shifty
		For x As Long=centrex-mx*fx To centrex+mx*fx
			If x+shiftx >=0 Then 'on the screen
				If x+shiftx <xres Then
					If shfty >=0 Then
						If shfty<yres Then
							resultx=sc2*(Cx*(x-centrex)-Sxcy) +centrex:resulty=sc2*(Sx*(x-centrex)+Cxcy) +centrey
							If resultx >=0 Then 'on the image
								If resultx<ddx Then
									If resulty>=0 Then
										If resulty<ddy Then
											Dim As Ulong u=*Cast(Ulong Ptr,row+pitch*((resultY))+((resultX)) Shl 2 ) 'point(image)
											If u<>miss Then *Cast(Ulong Ptr,rowS+pitchS*(y+shifty)+(x+shiftx) Shl 2)= u 'pset (screen)
										End If:End If:End If:End If
						End If:End If:End If:End If
		Next x
	Next y
End Sub

Function odometer(v As Long, mhz As Long = 0,p as _PERFORMANCE_INFORMATION) As Long
	Const pi=4*Atn(1)
    #define _round(x,N) rtrim(rtrim(left(str((x)+(.5*sgn((x)))/(10^(N))),instr(str((x)+(.5*sgn((x)))/(10^(N))),".")+(N)),"0"),".")
	Static As Long s=0
    dim as double totalmem=(p.PhysicalTotal / 1024 ^ 3 * p.PageSize)'(p.PhysicalTotal * p.PageSize) / 1024 ^ 3
    dim as double availablemem=(p.PhysicalAvailable * p.PageSize) / 1024 ^ 3
	Static As Any Ptr tmp,hnd
	If tmp=0 Then tmp=Imagecreate(1600,100,Rgb(255,255,255))
	If hnd=0 Then
		hnd=Imagecreate(400,20)
		Var dx=20
		thick_line(dx+5,10,220,10,2,Rgb(200,200,219),hnd)
		Line hnd,(dx,10)-(15+dx,0),Rgb(200,00,00)
		Line hnd,(dx,10)-(15+dx,20),Rgb(200,00,00)
		Line hnd,(15+dx,0)-(15+dx,20),Rgb(200,00,00)
		Paint hnd,(10+dx,10),Rgb(200,00,00),Rgb(200,00,00)
		circle hnd,(230,10),10,rgb(200,200,200),,,.9,f
	End If
	Static As Any Ptr strip
	If strip=0 Then
		strip=Imagecreate(1600,100,Rgb(255,255,255))
		For n As Long=10 To 90 Step 10
			Line strip,(0,n)-(1600,n),Rgb(220,220,220)
		Next n
	End If
	Dim As Long w,h,ctrx,ctry
	Imageinfo hnd,w,h
	ctrx=400-w/2
	ctry=300-h/2
	Dim As Double k=map(100,0,v,-46,226)
	rotateimage(,hnd,k*0.0174533-pi,ctrx,ctry,1,,0)
	Circle(400,300),2,Rgb(0,0,0),,,,f
	digits(Right("000"+Str((v))+"%",4),380-10,350,Rgb(200,200,200),10)
	Var ypos=map(0,100,v,99,0)
	If s>=800 Then
		Get strip,(800,0)-(1600-1,100-1),tmp
		Line strip,(0,0)-(1600,100),Rgb(255,255,255),bf
		For n As Long=10 To 90 Step 10
			Line strip,(0,n)-(1600,n),Rgb(220,220,220)
		Next n
		Put strip,(0,0),tmp,Pset
		s=0
	End If
	thick_line(800+s,100,800+s,ypos,3,Rgb(150,150,150),strip)
    digits(Str(mhz),370,410,Rgb(200,200,200),8)
	'
    draw string(280+10,155),"Total mem",Rgb(200,200,200)
    draw string(440+10,155),"Gb",Rgb(200,200,200)
    digits(_round(totalmem,2),370+10+10,150,Rgb(200,200,200),8,1)
    draw string(280-32+10,185),"Available mem",Rgb(200,200,200)
    Draw String(440+10,185),"Gb", Rgb(200,200,200)
    digits(_round(availablemem,2),370+10+10,180,Rgb(200,200,200),8,1)
    Draw String(450, 415),"Mhz",Rgb(200,200,200)
	Put (0-s,600),strip,Pset
	s+=5
	For n As Long=10 To 90 Step 10
		digits(Str(n),5,700-n-3,Rgb(0,0,0),3,1)
	Next n
	Return v
End Function

Sub Remove(Text As String,Char As String)
	Var index = 0,asci=Asc(char)
	For i As Integer = 0 To Len(Text) - 1
		If Text[i] <> asci Then Text[index] = Text[i] : index =index+ 1
Next : Text = Left(Text,index)
End Sub

Sub title()
	Dim As String g
	Var s=pipeout("wmic cpu get maxclockspeed")
	remove(s,Chr(10))
	g+=s
	s=pipeout("wmic cpu get numberofcores")
	remove(s,Chr(10))
	Screenres 800,700,32
	Color ,Rgb(170,170,170)
	Width 800\8,700\14
	Windowtitle g+s+" Close window to finish"
End Sub

Function GetCPU() As Long
	title()
	Static As Any Ptr im
	If im=0 Then
		im=Imagecreate(800,700,Rgb(170,170,170))
		createdial(im)
	End If
	Dim As Ulong interval = 999
	Dim As ULONGLONG totalPrev = 0, totalCurr = 0
	Dim As ULONGLONG idlePrev = 0, idleCurr = 0
	Dim As ULONGLONG tmp
	Dim As String key
	Dim As Ulong totalCPUUsage = 0, CPUCores = _WinAPI_GetCPUProcessors()
	
	Type tPROCESSOR_POWER_INFORMATION
		As ULONG Number
		As ULONG MaxMhz
		As ULONG CurrentMhz
		As ULONG MhzLimit
		As ULONG MaxIdleState
		As ULONG CurrentIdleState
	End Type
	
	Dim As tPROCESSOR_POWER_INFORMATION PROCESSOR_POWER_INFORMATION(0 To CPUCores - 1)
	
	Dim As Long result = getSystemCPUTime(totalPrev, idlePrev), tsize = SizeOf(tPROCESSOR_POWER_INFORMATION) * CPUCores
	Dim As ULong mhz, i
    dim  As _PERFORMANCE_INFORMATION p
	While True
		Sleep(interval)
		
		key=Inkey
		If (getSystemCPUTime(totalCurr, idleCurr)) Then
			Dim As  LONGLONG total = totalCurr - totalPrev
			If (total > 0) Then
                GetPerformanceInfo(@p, Sizeof(_PERFORMANCE_INFORMATION))

				CallNtPowerInformation(ProcessorInformation, 0, 0, @PROCESSOR_POWER_INFORMATION(0), tsize)
				mhz = 0
				For i = 0 To Ubound(PROCESSOR_POWER_INFORMATION)
					mhz += PROCESSOR_POWER_INFORMATION(i).CurrentMhz
				Next
				Dim As  LONGLONG idle = idleCurr - idlePrev
				totalCPUUsage = (100 * (total - idle) / (total))
				ScreenLock
				Put(0,0),im,PSet
				odometer(totalCPUUsage, mhz \ CPUCores,p)
				ScreenUnlock
				If key=Chr(27) Or key=Chr(255)+"k" Then Return 0
			End If
			totalPrev = totalCurr
			idlePrev = idleCurr
		End If
	Wend
	Return 0
End Function


End GetCPU() 
I have left a digit spaces enough for memory > 10 Gb.
srvaldez
Posts: 3379
Joined: Sep 25, 2005 21:54

Re: CPU % usage meter.

Post by srvaldez »

nice dodicat :)
some suggestions, total mem needs to the ceil of the expression p.PhysicalTotal / 1024 ^ 3 * p.PageSize
to make this useful it needs to have a relatively small window and instead of the odometer show digital output and have 1 decimal place
then you could leave it running and be able to spot the CPU usage
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: CPU % usage meter.

Post by UEZ »

dodicat wrote: Jun 02, 2022 16:28 UEZ
I think that Autoit Sysinfo Clock needs to be bought (9.199 euros) , it is only a 30 day trial?
I wrote it several years ago and it is freeware and the source code can be found on my HD or at autoitscript.com/forum. :D
I didn't want to advertise it, but wanted to know if the memory display is correct for you, since the API call is the same. :)
Btw, I like the digits chars - looks cool.

@srvaldez: indeed, the Format function works only with 32-bit range when compiled the code as x86 - good catch (hopefully can remember that for the future). :)
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: CPU % usage meter.

Post by dodicat »

OK UEZ, since you wrote it I will download it.
I'll report later on.
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: CPU % usage meter.

Post by dodicat »

Thanks UEZ, I got it from mediafire.
The free memory in the watch sits a little higher
fb 3.75 ish Mb
watch 3835 ish Kb
The cpu speeds match quite well.
One of our cats was sitting on top of the computer (it always does), but when I clicked (about) it was gone, probably didn't like that tune.
AutoIt script language looks powerful, the graphics look polished.
Thanks for the link.
Post Reply