B4J Code Snippet [ABMaterial] Thermometer Canvas Method

For the UI of my Domotica i needed a Therometer and addional a aneometer. No much to find on the net in js. Build in a short time with Canvas

Sub BuilTempGauge(width As Int, height As Int,value As temperature,id As String) As ABMCanvasObject
'   value.templo=value.temp
   Dim tpg As ABMCanvasObject
   width=height/3
   Dim thick=width/7 As Int
   Dim startpoint=height*9/10 As Int
   Dim endpoint=height/6 As Int
   Dim Radius As Double = width*1.8

   tpg.InitializeAsRectangle(page, id, 0,0,width,height, True)

   Radius = Radius * 0.9
   ''paint outline mercury reservoir
   tpg.beginPath
   tpg.fillStyleColor("#ff00ff")
   tpg.arc(width/2, height-width/6, Radius*0.1, 0, 2*cPI)
   tpg.stroke
   ''file mercury reservoir
   tpg.beginPath
   tpg.arc(width/2, height-width/6, Radius*0.1, 0, 2*cPI)
   tpg.fillStyleColor("#FF0000")
   tpg.fill
   ''paint low temp level
   If value.temphi>40 Then value.temphi=40
   If value.templo<-20 Then value.templo=-20
   If value.temphi<-20 Then value.temphi=-20
   If value.templo>40 Then value.temphi=40

   Dim lengte=(startpoint-endpoint)*(value.templo+20)/60 As Double
   Log(lengte)
   tpg.beginPath
   tpg.rect(width/2-thick/2,startpoint+10,thick,-lengte-10)
   tpg.fillStyleColor("#FF0000")
   tpg.fill
   ''paint temp difference Hi temp-lo temp
'   Dim lengte=(value.templo+20)/60*height As Int
   Dim ld=(value.temphi-value.templo)/60*(startpoint-endpoint) As Double
   tpg.beginPath
   tpg.rect(width/2-thick/2,startpoint-lengte,thick,-ld)
   tpg.fillStyleColor("#ffff00")
   tpg.fill
   ''print temperature value+ id temperature
   tpg.fillStyleColor("#ff00ff")
   tpg.font("arial", Radius*0.15)
   tpg.textBaseline(ABM.CANVAS_TEXTBASELINE_MIDDLE)
   tpg.textAlign(ABM.CANVAS_TEXTALIGN_CENTER)
   tpg.fillText(id, width/2, height/30)
   tpg.fillText(NumberFormat(value.temp,1,1)& Chr(176), width/2, height/10)
   tpg.font("arial", Radius*0.09)
   ';print scale left
   For x=-20 To 40 Step 5
     If x Mod 10 =0 Then
       tpg.fillText(x, width/4,startpoint-(startpoint-endpoint)*(x+20)/60)
       tpg.beginPath
       tpg.moveTo(width/2-thick,startpoint-(startpoint-endpoint)*(x+20)/60)
       tpg.lineto(width/2-thick/2,startpoint-(startpoint-endpoint)*(x+20)/60)
       tpg.stroke
     Else
       tpg.fillText(x, width*3/4,startpoint-(startpoint-endpoint)*(x+20)/60)
       tpg.beginPath
       tpg.moveTo(width/2+thick/2,startpoint-(startpoint-endpoint)*(x+20)/60)
       tpg.lineto(width/2+thick,startpoint-(startpoint-endpoint)*(x+20)/60)
       tpg.stroke
     End If
   Next
''outline tube
   tpg.beginPath
   tpg.moveto(width/2-thick/2,startpoint)
   tpg.lineTo(width/2-thick/2,endpoint)
   tpg.lineto(width/2+thick/2,endpoint)
   tpg.lineto(width/2+thick/2,startpoint)
   tpg.stroke

   Return tpg
End Sub

Call it in the connectpage with:

  Dim canvas2 As ABMCanvas

   canvas2.Initialize(page, "canvas2", ABM.COLOR_TRANSPARENT, ABM.INTENSITY_NORMAL, 100,300, False)

   Dim Tempgauge1 As ABMCanvasObject = BuilTempGauge(100,200,Main.meteovalues.t1,"Buiten")
   canvas2.AddObject(Tempgauge1)
   page.Cell(1,1).AddComponent(canvas2)

 

[alwaysbusy]

Thanks for sharing!