PureBasic Forums - English

Posted: **Mon May 14, 2012 5:04 pm**

Tenaja wrote:Another option would be to precalculate and store the graphics so you don't have to do it on the fly. Sure, much more memory intensive, but all of the heavy CPU work would be done at creation.

One more solution is to use OpenGL or DirectX to perform Off-screen rendering then display the result directly in the window. Or a more direct approach is to render the Gadget in real time using OpenGL or DirectX.

Best regards
Guimauve

Posted: **Tue May 15, 2012 9:46 am**

And not to forget that taking advantage of symetry in both axes can reduce / simplify some processes by up to 4:1.

Posted: **Sun Jun 03, 2012 2:44 pm**

Interestingly when I hit F5 on Trond's version I frequently get "Invalid memory access" on line 154 (the DrawingFont statement in procedure SGauge_PaintHand) on Linux (Debian Squeeze). It doesn't happen all the time, but frequently. The first time this error popped up while I was trying to move the upper slider.

So far Guimauve's version works fine. I haven't studied both versions yet, just wanted to report this.

Posted: **Sun Jun 03, 2012 2:48 pm**

It appears to be the font. Replacing Tahoma with Liberation Sans solved the problem.

Posted: **Sun Sep 04, 2022 12:58 am**

Trond's code bug-fixed to work with PureBasic v6.00.

Code: Select all

; Original code by Trond.

Procedure.d MaxD(A.d, B.d)
  If A > B
    ProcedureReturn A
  EndIf
  ProcedureReturn B
EndProcedure

Procedure MinI(A, B)
  If A < B
    ProcedureReturn A
  EndIf
  ProcedureReturn B
EndProcedure

Procedure DrawTextCentered(x, y, T.s, FrontColor, BackColor)
  x = x - TextWidth(T)/2
  y = y - TextHeight("Wg")/2
  DrawText(x, y, T, FrontColor, BackColor)
EndProcedure

Macro GaugeValueType
  i
EndMacro

Prototype SGauge_PaintProto(*Gauge, Image)

Structure SGauge
  X.i
  Y.i
  W.i
  H.i
  Min.GaugeValueType
  Max.GaugeValueType
  BigStep.GaugeValueType    ; A text is drawn for every BigStep
  SmallStep.GaugeValueType  ; A nub is drawn for every SmallStep
  Value.i
  Text.s
  SubText.s
  Gadget.i
  ; Style:
  SectorDegrees.i
  InnerCircleRadius.i
  BgColor.i
  WheelColor.i
  WheelBgColor.i
  TextColor.i
  SubTextColor.i
  HandColor.i
  WheelFont.i
  TextFont.i
  SubTextFont.i
  ; Style override:
  PaintBackground.SGauge_PaintProto
  PaintWheel.SGauge_PaintProto
  PaintDescription.SGauge_PaintProto
  PaintHand.SGauge_PaintProto
  ; Repaint cache (set to 1 after changing style override)
  ; (The hand is always repainted)
  BgNeedRepaint.i
  WheelNeedRepaint.i
  DescriptionNeedRepaint.i
  ; Image cache (don't touch)
  BgImg.i
  WheelImg.i
  DescriptionImg.i
  ComposedImg.i
EndStructure

; Default paint functions
Procedure SGauge_PaintBackground(*G.SGauge, Image)
  DrawingMode(#PB_2DDrawing_AllChannels)
  Box(0, 0, *G\w, *g\H, *G\BgColor)
  DrawingMode(#PB_2DDrawing_AllChannels | #PB_2DDrawing_Outlined)
  Box(0, 0, *G\w, *g\H, RGBA(0, 0, 0, 32))
EndProcedure

Procedure SGauge_PaintWheel(*G.SGauge, Image)
  With *G
    StartDegree.i = 0 + ((360-\SectorDegrees)/2)
    wpx = \W / 33
    wpx2 = wpx/4.*3-1
    centerX = \w/2
    centerY = \H/2
    r = MinI(centerX, centerY) - TextWidth("12345")
    SmallStepDegrees.d  = \SmallStep / \Max * \SectorDegrees
    BigStepDegrees.d    = \BigStep / \Max * \SectorDegrees
    DrawingMode(#PB_2DDrawing_AllChannels)
    For I = 0 To \SectorDegrees
      x = centerX + Sin(Radian(StartDegree+I))*r
      y = centerY + Cos(Radian(StartDegree+I))*r
      Circle(x, y, wpx, \WheelColor)
    Next
    DrawingMode(#PB_2DDrawing_AllChannels)
    For I = 0 To \SectorDegrees
      x = centerX + Sin(Radian(StartDegree+I))*r
      y = centerY + Cos(Radian(StartDegree+I))*r
      Circle(x, y, wpx2, \WheelBgColor)
    Next
    dI.d = 0
    While dI <= \SectorDegrees
      x1 = centerX + Sin(Radian(StartDegree+dI))*(r-wpx2)
      y1 = centerY + Cos(Radian(StartDegree+dI))*(r-wpx2)
      x2 = centerX + Sin(Radian(StartDegree+dI))*(r-wpx2/2)
      y2 = centerY + Cos(Radian(StartDegree+dI))*(r-wpx2/2)
      LineXY(x1, y1, x2, y2, \WheelColor)
      dI + SmallStepDegrees
    Wend
    dI = 0
    While dI <= \SectorDegrees + 1 ;?!
      x1 = centerX + Sin(Radian(StartDegree+dI))*(r-wpx)
      y1 = centerY + Cos(Radian(StartDegree+dI))*(r-wpx)
      x2 = centerX + Sin(Radian(StartDegree+dI))*(r+wpx)
      y2 = centerY + Cos(Radian(StartDegree+dI))*(r+wpx)
      LineXY(x1, y1, x2, y2, \WheelColor)
      dI + BigStepDegrees
    Wend
    DrawingMode(#PB_2DDrawing_AlphaBlend | #PB_2DDrawing_Transparent)
    DrawingFont(FontID(\WheelFont))
    dI = 0
    I = 0
    While dI <= \SectorDegrees+1 ; not sure why that is needed
      T.s = Str(\Max-I)
      x = centerX + Sin(Radian(StartDegree+dI))*(r+wpx*3)
      y = centerY + Cos(Radian(StartDegree+dI))*(r+wpx*3)
      DrawTextCentered(x, y, T, RGBA(0, 0, 0, 255), RGBA(0, 0, 0, 0))
      dI + BigStepDegrees
      I + \BigStep
    Wend
  EndWith
EndProcedure

Procedure SGauge_PaintDescription(*G.SGauge, Image)
  With *G
    DrawingMode(#PB_2DDrawing_AlphaBlend | #PB_2DDrawing_Transparent)
    DrawingFont(FontID(\TextFont))
    x = 0.5 * \w
    y = 0.8 * \h
    DrawTextCentered(x, y, \Text, \TextColor, 0)
    y + TextHeight("Wg")
    DrawingFont(FontID(\SubTextFont))
    DrawTextCentered(x, y, \SubText, \SubTextColor, 0)
  EndWith
EndProcedure

Procedure SGauge_PaintHand(*G.SGauge, Image)
  With *G
    StartDegree.i = 0 + ((360-\SectorDegrees)/2)
    
    DrawVal = \Max - \Value
    DirDegrees.d = StartDegree + DrawVal / \Max * \SectorDegrees
    centerX = \W / 2
    centerY = \H / 2
    DrawingFont(\WheelFont)
    r = MinI(centerX, centerY) - TextWidth("12345")
    tipX = centerX + Sin(Radian(DirDegrees)) * r
    tipY = centerY + Cos(Radian(DirDegrees)) * r
    innerx = centerX + Sin(Radian(DirDegrees)) * \InnerCircleRadius
    innery = centerY + Cos(Radian(DirDegrees)) * \InnerCircleRadius
    LineXY(innerx, innery, tipx, tipy, RGBA(255, 0, 0, 255))
    Circle(innerx, innery, 2, RGBA(255, 0, 0, 255))
  EndWith
EndProcedure

Procedure SoftFreeImage(Image)
  If Image
    FreeImage(Image)
  EndIf
EndProcedure

Procedure SoftFreeFont(Font)
  If Font
    FreeFont(Font)
  EndIf
EndProcedure

; Set sane default settings for a gauge
; (except x and y which must be set manually unless already done)
; Better call this first, or your gauge won't show up
Procedure Gauge_InitDefaults(*G.SGauge, X = #PB_Ignore, Y = #PB_Ignore, W = #PB_Ignore, H = #PB_Ignore)
  With *G
    If X <> #PB_Ignore
      \X = X
    EndIf
    If Y <> #PB_Ignore
      \Y = Y
    EndIf
    If W <> #PB_Ignore
      \W = W
    EndIf
    If H <> #PB_Ignore
      \H = H
    EndIf
    \Min = 0
    \Max = 100
    \BigStep = 10
    \SmallStep = 5
    \Value = 0
    \Text = "Value"
    \SubText = "in percent"
    \Gadget = -1
    \SectorDegrees = 270
    \InnerCircleRadius = 0
    \BgColor = RGBA(0, 0, 0, 0)
    \WheelColor = RGBA(62, 62, 128, 192)
    \WheelBgColor = RGBA(64, 64, 0, 32)
    \TextColor = RGBA(0, 0, 0, 255)
    \SubTextColor = RGBA(92, 92, 92, 255)
    \HandColor = RGBA(255, 255, 192, 255)
    SoftFreeFont(\WheelFont)
    SoftFreeFont(\TextFont)
    SoftFreeFont(\SubTextFont)
    \WheelFont.i = LoadFont(#PB_Any, "Tahoma", MaxD(7, 0.04*\W))
    \TextFont.i  = LoadFont(#PB_Any, "Tahoma", MaxD(8, 0.056*\W), #PB_Font_Bold)
    \SubTextFont.i  = LoadFont(#PB_Any, "Tahoma", MaxD(7, 0.04*\W))
    
    \PaintBackground  = @SGauge_PaintBackground()
    \PaintWheel       = @SGauge_PaintWheel()
    \PaintDescription = @SGauge_PaintDescription()
    \PaintHand        = @SGauge_PaintHand()
    
    \BgNeedRepaint.i = 1
    \WheelNeedRepaint.i = 1
    \DescriptionNeedRepaint.i = 1
    
    \BgImg = SoftFreeImage(\BgImg)
    \WheelImg = SoftFreeImage(\WheelImg)
    \DescriptionImg = SoftFreeImage(\DescriptionImg)
    \ComposedImg = SoftFreeImage(\ComposedImg)
  EndWith
EndProcedure

; Called to redraw gauge
Procedure Gauge_UpdateDisplay(*G.SGauge)
  With *G
    If \BgNeedRepaint
      SoftFreeImage(\BgImg)
      \BgImg = CreateImage(#PB_Any, \w, \H, 32, #PB_Image_Transparent)
      StartDrawing(ImageOutput(\BgImg))
      \PaintBackground(*G, \BgImg)
      StopDrawing()
    EndIf
    If \WheelNeedRepaint
      SoftFreeImage(\WheelImg)
      \WheelImg= CreateImage(#PB_Any, \w, \h, 32 , #PB_Image_Transparent)
      StartDrawing(ImageOutput(\WheelImg))
      \PaintWheel(*G, \WheelImg)
      StopDrawing()
    EndIf
    If \DescriptionNeedRepaint
      SoftFreeImage(\DescriptionImg)
      \DescriptionImg= CreateImage(#PB_Any, \w, \h, 32 , #PB_Image_Transparent)
      StartDrawing(ImageOutput(\DescriptionImg))
      \PaintDescription(*G, \DescriptionImg)
      StopDrawing()
    EndIf
    SoftFreeImage(\ComposedImg)
    \ComposedImg = CreateImage(#PB_Any, \w, \h, 32 , #PB_Image_Transparent)
    StartDrawing(ImageOutput(\ComposedImg))
    DrawingMode(#PB_2DDrawing_AlphaBlend)
    DrawImage(ImageID(\BgImg), 0, 0)
    DrawImage(ImageID(\WheelImg), 0, 0)
    DrawImage(ImageID(\DescriptionImg), 0, 0)
    \PaintHand(*G, \ComposedImg)
    StopDrawing()
    If \Gadget = -1
      \Gadget = ImageGadget(#PB_Any, \x, \y, \w, \h, ImageID(\ComposedImg))
    Else
      ResizeGadget(\Gadget, \x, \y, #PB_Ignore, #PB_Ignore)
      SetGadgetState(\Gadget, ImageID(\ComposedImg))
    EndIf
  EndWith
EndProcedure

; If changing some other setting than value, call this
; before Gauge_UpdateDisplay() or it won't be redrawn properly
Procedure Gauge_SettingsChanged(*G.SGauge)
  With *G
    \BgNeedRepaint.i = 1
    \WheelNeedRepaint.i = 1
    \DescriptionNeedRepaint.i = 1
  EndWith
EndProcedure

;- Example
#W = 640
#H = 384

OpenWindow(0, 0, 0, #W, #H, "", #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
; SpinGadget(0, 300, 10, 100, 22, 0, 100, #PB_Spin_Numeric)
TrackBarGadget(0, 220, 10, 200, 22, 0, 100)
SetGadgetState(0, 0)
; SpinGadget(1, 300, 40, 100, 22, 1, 360, #PB_Spin_Numeric)
TrackBarGadget(1, 220, 40, 360, 22, 1, 360)
SetGadgetState(1, 270)
;SpinGadget(2, 300, 70, 100, 22, 0, 80, #PB_Spin_Numeric)
TrackBarGadget(2, 220, 70, 200, 22, 0, 40)
SetGadgetState(2, 0)

g.SGauge

Gauge_InitDefaults(@G, 10, 10, 200, 200)
Gauge_UpdateDisplay(@G)

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 0: ; Change value
          g\Value = GetGadgetState(0)
          Gauge_UpdateDisplay(@g)
        Case 1: ; Change size in degrees
          g\SectorDegrees = GetGadgetState(1)
          Gauge_SettingsChanged(@G)
          Gauge_UpdateDisplay(@g)
        Case 2: ; Change hand origin radius
          g\InnerCircleRadius = GetGadgetState(2)
          Gauge_SettingsChanged(@G)
          Gauge_UpdateDisplay(@g)
      EndSelect
    Case #PB_Event_CloseWindow
      Break
  EndSelect
ForEver

Posted: **Tue Sep 13, 2022 3:42 am**

This was written 4 years before the Vector Drawing library was introduced in version 5.4, it would look much better if it were converted to use that. There are flickers in moving the gauge needle as well that need addressed. Nice little project for someone, I don't know, maybe Trond?

PureBasic Forums - English

Gauge display

Re: Gauge display

Re: Gauge display

Re: Gauge display

Re: Gauge display

Re: Gauge display

Re: Gauge display