PureBasic Forums - English

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

Gauge display

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

Page 1 of 3

Gauge display

Posted: Thu Feb 17, 2011 10:02 pm
by Trond
This is a not completely complete gauge display. What's lacking the most is a nicer drawn hand. The code was made to be easily stylable, as the gauge is comprised out of several layers, all of which can have their drawing handler overridden per gauge instance.

The layers are:
background, which is currently transparent/unused except for a border for debugging purposes.
wheel, which contains the actual gauge display, including the text.
description, which contains the text of the two labels under the gauge.
hand, which is not really a separate layer, as it's painted on top of all the other layers composed (so don't start by blanking the image in the paint handler).

The layers are cached to improve display speed.

Currently the hand paint handler just paints a thin line and a circle, I'm sure some of you will find a way to improve that!

Code: Select all


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

Re: Gauge display

Posted: Thu Feb 17, 2011 11:27 pm
by c4s
Nice code, thank you.

Re: Gauge display

Posted: Fri Feb 18, 2011 2:08 am
by LuaDev
Wow, that's pretty amazing, thanks

Re: Gauge display

Posted: Fri Feb 18, 2011 4:45 am
by WilliamL
Very nice! I'm studying your code and have many questions. It works on a Mac too. :)

Code: Select all

CompilerSelect #PB_Compiler_OS
  CompilerCase #PB_OS_Linux
    FontName.s = "Liberation Sans"
  CompilerCase #PB_OS_Windows
    FontName.s = "Tahoma"
  CompilerCase #PB_OS_MacOS
    FontName.s="Geneva"
CompilerEndSelect

Re: Gauge display

Posted: Fri Feb 18, 2011 11:45 am
by Kwai chang caine
Wonderfull !! :shock: :D
It's exactely what i dream to have since several years for use in my "soft" :oops:

Thousand thanks for sharing 8)

Re: Gauge display

Posted: Fri Feb 18, 2011 12:58 pm
by ts-soft
Yes, looking wonderfull :D

Re: Gauge display

Posted: Fri Feb 18, 2011 2:49 pm
by GeBonet
Really, very, very beautiful !
Congratulation...:lol:
Thank-you

Re: Gauge display

Posted: Fri Feb 18, 2011 4:12 pm
by Rook Zimbabwe
fantastic work Trond :mrgreen: I wonder if this could be updated to use actual images (PNG) instead of selfdraw??? I have never included images as code but I don't usually build in PUREform...

Re: Gauge display

Posted: Fri Feb 18, 2011 5:00 pm
by Demivec
Excellent! Thanks for sharing. :)

Re: Gauge display

Posted: Fri Feb 18, 2011 9:34 pm
by Trond
Rook Zimbabwe wrote:fantastic work Trond :mrgreen: I wonder if this could be updated to use actual images (PNG) instead of selfdraw??? I have never included images as code but I don't usually build in PUREform...
That's the purpose of the drawing override. You can replace one of the drawing functions with your own, which can draw a png image.

Re: Gauge display

Posted: Fri Feb 18, 2011 10:44 pm
by Rook Zimbabwe
just have pity on my trond... I will figure it out eventually!

Re: Gauge display

Posted: Fri Feb 18, 2011 10:50 pm
by DoubleDutch
Looks great, but there is a problem is you use

Code: Select all

SmartWindowRefresh(0,#True)
...

Re: Gauge display

Posted: Fri Feb 18, 2011 11:10 pm
by ts-soft
DoubleDutch wrote:Looks great, but there is a problem is you use

Code: Select all

SmartWindowRefresh(0,#True)
...
workaround:

Code: Select all

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

Re: Gauge display

Posted: Fri Feb 18, 2011 11:35 pm
by DoubleDutch
Didn't know you could do that, nice. :)

Re: Gauge display

Posted: Sun Feb 20, 2011 8:18 pm
by Guimauve
Hello everyone,

My tiny contribution. I have done some modification in the Trond original code.

Best Regards.
Guimauve

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : GaugeGadget
; File Name : GaugeGadget.pb
; File version: 1.0.0
; Programmation : OK
; Programmed by : Trond
; Modified by : Guimauve
; Date : 20-02-2011
; Mise à jour : 20-02-2011
; PureBasic cade : 4.50
; Plateform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Notes :
;
; The Image Rotation routines programmed by Luis 
; are needed to rotate the gauge needle.
;
; Some field in the Gauge Structure has been 
; renamed or suppressed.
; 
; A layer has been added for the Needle. The size 
; for this layer is 4 times larger than other 
; layer. This is needed to draw the needle more 
; smootly. 
;
; Finally, the GaugeGadget shape can be square
; only.
;
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

IncludeFile "Image Rotation routines.pb"

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Déclaration de la Structure <<<<<

Structure Gauge
  
  PosX.w
  PosY.w
  Size.w
  Center.w
  ScaleRadius.w
  Min.l
  Max.l
  BigStep.l
  SmallStep.l
  SectorDegrees.w
  Value.l
  Text.s
  SubText.s
  GadgetID.l
  GadgetHandle.l
  BackGroundColor.l
  ScaleColor.l
  ScaleBackGroundColor.l
  TextColor.l
  SubTextColor.l
  NeedleColor.l
  ScaleFontHandle.i
  TextFontHandle.i
  SubTextFontHandle.i
  LayerSize.w
  BackGroundLayer.l
  ScaleLayer.l
  DescriptionLayer.l
  NeedleLayer.l
  ComposedLayer.l
  
EndStructure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Les observateurs <<<<<

Macro GetGaugePosX(GaugeA)
  
  GaugeA\PosX
  
EndMacro

Macro GetGaugePosY(GaugeA)
  
  GaugeA\PosY
  
EndMacro

Macro GetGaugeSize(GaugeA)
  
  GaugeA\Size
  
EndMacro

Macro GetGaugeCenter(GaugeA)
  
  GaugeA\Center
  
EndMacro

Macro GetGaugeScaleRadius(GaugeA)
  
  GaugeA\ScaleRadius
  
EndMacro

Macro GetGaugeMin(GaugeA)
  
  GaugeA\Min
  
EndMacro

Macro GetGaugeMax(GaugeA)
  
  GaugeA\Max
  
EndMacro

Macro GetGaugeBigStep(GaugeA)
  
  GaugeA\BigStep
  
EndMacro

Macro GetGaugeSmallStep(GaugeA)
  
  GaugeA\SmallStep
  
EndMacro

Macro GetGaugeSectorDegrees(GaugeA)
  
  GaugeA\SectorDegrees
  
EndMacro

Macro GetGaugeValue(GaugeA)
  
  GaugeA\Value
  
EndMacro

Macro GetGaugeText(GaugeA)
  
  GaugeA\Text
  
EndMacro

Macro GetGaugeSubText(GaugeA)
  
  GaugeA\SubText
  
EndMacro

Macro GetGaugeGadgetID(GaugeA)
  
  GaugeA\GadgetID
  
EndMacro

Macro GetGaugeGadgetHandle(GaugeA)
  
  GaugeA\GadgetHandle
  
EndMacro

Macro GetGaugeBackGroundColor(GaugeA)
  
  GaugeA\BackGroundColor
  
EndMacro

Macro GetGaugeScaleColor(GaugeA)
  
  GaugeA\ScaleColor
  
EndMacro

Macro GetGaugeScaleBackGroundColor(GaugeA)
  
  GaugeA\ScaleBackGroundColor
  
EndMacro

Macro GetGaugeTextColor(GaugeA)
  
  GaugeA\TextColor
  
EndMacro

Macro GetGaugeSubTextColor(GaugeA)
  
  GaugeA\SubTextColor
  
EndMacro

Macro GetGaugeNeedleColor(GaugeA)
  
  GaugeA\NeedleColor
  
EndMacro

Macro GetGaugeScaleFontHandle(GaugeA)
  
  GaugeA\ScaleFontHandle
  
EndMacro

Macro GetGaugeTextFontHandle(GaugeA)
  
  GaugeA\TextFontHandle
  
EndMacro

Macro GetGaugeSubTextFontHandle(GaugeA)
  
  GaugeA\SubTextFontHandle
  
EndMacro

Macro GetGaugeLayerSize(GaugeA)
  
  GaugeA\LayerSize
  
EndMacro

Macro GetGaugeBackGroundLayer(GaugeA)
  
  GaugeA\BackGroundLayer
  
EndMacro

Macro GetGaugeScaleLayer(GaugeA)
  
  GaugeA\ScaleLayer
  
EndMacro

Macro GetGaugeDescriptionLayer(GaugeA)
  
  GaugeA\DescriptionLayer
  
EndMacro

Macro GetGaugeNeedleLayer(GaugeA)
  
  GaugeA\NeedleLayer
  
EndMacro

Macro GetGaugeComposedLayer(GaugeA)
  
  GaugeA\ComposedLayer
  
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Les mutateurs <<<<<

Macro SetGaugePosX(GaugeA, P_PosX)
  
  GetGaugePosX(GaugeA) = P_PosX
  
EndMacro

Macro SetGaugePosY(GaugeA, P_PosY)
  
  GetGaugePosY(GaugeA) = P_PosY
  
EndMacro

Macro SetGaugeSize(GaugeA, P_Size)
  
  GetGaugeSize(GaugeA) = P_Size
  
EndMacro

Macro SetGaugeCenter(GaugeA, P_Center)
  
  GetGaugeCenter(GaugeA) = P_Center
  
EndMacro

Macro SetGaugeScaleRadius(GaugeA, P_ScaleRadius)
  
  GetGaugeScaleRadius(GaugeA) = P_ScaleRadius
  
EndMacro

Macro SetGaugeMin(GaugeA, P_Min)
  
  GetGaugeMin(GaugeA) = P_Min
  
EndMacro

Macro SetGaugeMax(GaugeA, P_Max)
  
  GetGaugeMax(GaugeA) = P_Max
  
EndMacro

Macro SetGaugeBigStep(GaugeA, P_BigStep)
  
  GetGaugeBigStep(GaugeA) = P_BigStep
  
EndMacro

Macro SetGaugeSmallStep(GaugeA, P_SmallStep)
  
  GetGaugeSmallStep(GaugeA) = P_SmallStep
  
EndMacro

Macro SetGaugeSectorDegrees(GaugeA, P_SectorDegrees)
  
  GetGaugeSectorDegrees(GaugeA) = P_SectorDegrees
  
EndMacro

Macro SetGaugeValue(GaugeA, P_Value)
  
  GetGaugeValue(GaugeA) = P_Value
  
EndMacro

Macro SetGaugeText(GaugeA, P_Text)
  
  GetGaugeText(GaugeA) = P_Text
  
EndMacro

Macro SetGaugeSubText(GaugeA, P_SubText)
  
  GetGaugeSubText(GaugeA) = P_SubText
  
EndMacro

Macro SetGaugeGadgetID(GaugeA, P_GadgetID)
  
  GetGaugeGadgetID(GaugeA) = P_GadgetID
  
EndMacro

Macro SetGaugeGadgetHandle(GaugeA, P_GadgetHandle)
  
  GetGaugeGadgetHandle(GaugeA) = P_GadgetHandle
  
EndMacro

Macro SetGaugeBackGroundColor(GaugeA, P_BackGroundColor)
  
  GetGaugeBackGroundColor(GaugeA) = P_BackGroundColor
  
EndMacro

Macro SetGaugeScaleColor(GaugeA, P_ScaleColor)
  
  GetGaugeScaleColor(GaugeA) = P_ScaleColor
  
EndMacro

Macro SetGaugeScaleBackGroundColor(GaugeA, P_ScaleBackGroundColor)
  
  GetGaugeScaleBackGroundColor(GaugeA) = P_ScaleBackGroundColor
  
EndMacro

Macro SetGaugeTextColor(GaugeA, P_TextColor)
  
  GetGaugeTextColor(GaugeA) = P_TextColor
  
EndMacro

Macro SetGaugeSubTextColor(GaugeA, P_SubTextColor)
  
  GetGaugeSubTextColor(GaugeA) = P_SubTextColor
  
EndMacro

Macro SetGaugeNeedleColor(GaugeA, P_NeedleColor)
  
  GetGaugeNeedleColor(GaugeA) = P_NeedleColor
  
EndMacro

Macro SetGaugeScaleFontHandle(GaugeA, P_ScaleFontHandle)
  
  GetGaugeScaleFontHandle(GaugeA) = P_ScaleFontHandle
  
EndMacro

Macro SetGaugeTextFontHandle(GaugeA, P_TextFontHandle)
  
  GetGaugeTextFontHandle(GaugeA) = P_TextFontHandle
  
EndMacro

Macro SetGaugeSubTextFontHandle(GaugeA, P_SubTextFontHandle)
  
  GetGaugeSubTextFontHandle(GaugeA) = P_SubTextFontHandle
  
EndMacro

Macro SetGaugeLayerSize(GaugeA, P_LayerSize)
  
  GetGaugeLayerSize(GaugeA) = P_LayerSize
  
EndMacro

Macro SetGaugeBackGroundLayer(GaugeA, P_BackGroundLayer)
  
  GetGaugeBackGroundLayer(GaugeA) = P_BackGroundLayer
  
EndMacro

Macro SetGaugeScaleLayer(GaugeA, P_ScaleLayer)
  
  GetGaugeScaleLayer(GaugeA) = P_ScaleLayer
  
EndMacro

Macro SetGaugeDescriptionLayer(GaugeA, P_DescriptionLayer)
  
  GetGaugeDescriptionLayer(GaugeA) = P_DescriptionLayer
  
EndMacro

Macro SetGaugeNeedleLayer(GaugeA, P_NeedleLayer)
  
  GetGaugeNeedleLayer(GaugeA) = P_NeedleLayer
  
EndMacro

Macro SetGaugeComposedLayer(GaugeA, P_ComposedLayer)
  
  GetGaugeComposedLayer(GaugeA) = P_ComposedLayer
  
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< L'opérateur Reset <<<<<

Macro ResetGauge(GaugeA)
  
  SetGaugePosX(GaugeA, 0)
  SetGaugePosY(GaugeA, 0)
  SetGaugeSize(GaugeA, 0)
  SetGaugeScaleRadius(GaugeA, 0)
  SetGaugeMin(GaugeA, 0)
  SetGaugeMax(GaugeA, 0)
  SetGaugeBigStep(GaugeA, 0)
  SetGaugeSmallStep(GaugeA, 0)
  SetGaugeValue(GaugeA, 0)
  SetGaugeText(GaugeA, "")
  SetGaugeSubText(GaugeA, "")
  SetGaugeGadgetID(GaugeA, 0)
  SetGaugeGadgetHandle(GaugeA, 0)
  SetGaugeBackGroundColor(GaugeA, 0)
  SetGaugeScaleColor(GaugeA, 0)
  SetGaugeScaleBackGroundColor(GaugeA, 0)
  SetGaugeTextColor(GaugeA, 0)
  SetGaugeSubTextColor(GaugeA, 0)
  SetGaugeNeedleColor(GaugeA, 0)
  SetGaugeLayerSize(GaugeA, 0)
  
  If GetGaugeScaleFontHandle(GaugeA)
    FreeFont(GetGaugeScaleFontHandle(GaugeA))
    SetGaugeScaleFontHandle(GaugeA, 0)
  EndIf
  
  If GetGaugeTextFontHandle(GaugeA)
    FreeFont(GetGaugeTextFontHandle(GaugeA))
    SetGaugeTextFontHandle(GaugeA, 0)
  EndIf
  
  If GetGaugeSubTextFontHandle(GaugeA)
    FreeFont(GetGaugeSubTextFontHandle(GaugeA))
    SetGaugeSubTextFontHandle(GaugeA, 0)
  EndIf
  
  If GetGaugeBackGroundLayer(GaugeA)
    FreeImage(GetGaugeBackGroundLayer(GaugeA))
    SetGaugeBackGroundLayer(GaugeA, 0)
  EndIf 
  
  If GetGaugeScaleLayer(GaugeA)
    FreeImage(GetGaugeScaleLayer(GaugeA))
    SetGaugeScaleLayer(GaugeA, 0)
  EndIf 
  
  If GetGaugeDescriptionLayer(GaugeA)
    FreeImage(GetGaugeDescriptionLayer(GaugeA))
    SetGaugeDescriptionLayer(GaugeA, 0)
  EndIf
  
  If GetGaugeNeedleLayer(GaugeA)
    FreeImage(GetGaugeNeedleLayer(GaugeA))
    SetGaugeNeedleLayer(GaugeA, 0)
  EndIf 
  
  If GetGaugeComposedLayer(GaugeA)
    FreeImage(GetGaugeComposedLayer(GaugeA))
    SetGaugeComposedLayer(GaugeA, 0)
  EndIf 
  
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Code généré en : 00.018 secondes (26111.11 lignes/seconde) <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Macro ResizeGaugeGadget(GaugeA)
  
  If GetGaugeGadgetID(GaugeA) <> #PB_Any
    ResizeGadget(GetGaugeGadgetID(GaugeA), GetGaugePosX(GaugeA), GetGaugePosY(GaugeA), #PB_Ignore, #PB_Ignore)
  Else     
    ResizeGadget(GetGaugeGadgetHandle(GaugeA), GetGaugePosX(GaugeA), GetGaugePosY(GaugeA), #PB_Ignore, #PB_Ignore)
  EndIf 
  
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Dessiner un texte centré en x, y <<<<<

Macro DrawTextCentered(x, y, Text, FrontColor, BackColor)
  
  DrawText(x - TextWidth(Text) >> 1, y - TextHeight("Wg") >> 1, Text, FrontColor, BackColor)
  
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Trouver la plus grande valeur de type double <<<<<

Procedure.d MaxDouble(P_Number01.d, P_Number02.d)
  
  Biggest_Double.d = P_Number01
  
  If P_Number02 > Biggest_Double
    Biggest_Double = P_Number02
  EndIf
  
  ProcedureReturn Biggest_Double
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Trouver la plus grande valeur de type long <<<<<

Procedure.l MaxLong(P_Number01.l, P_Number02.l)
  
  Biggest_Long.l = P_Number01
  
  If P_Number02 > Biggest_Long
    Biggest_Long = P_Number02
  EndIf
  
  ProcedureReturn Biggest_Long
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Les mutateurs spéciaux <<<<<

Macro SetGaugePositionSize(GaugeA, P_X, P_Y, P_Size)
  
  SetGaugePosX(GaugeA, P_X)
  SetGaugePosY(GaugeA, P_Y)
  SetGaugeSize(GaugeA, P_Size)
  
EndMacro 

Macro SetGaugeTextEx(GaugeA, Text, Color_RGBA)
  
  SetGaugeText(GaugeA, Text)
  SetGaugeTextColor(GaugeA, Color_RGBA)
  
EndMacro 

Macro SetGaugeSubTextEx(GaugeA, SubText, Color_RGBA)
  
  SetGaugeSubText(GaugeA, SubText)
  SetGaugeSubTextColor(GaugeA, Color_RGBA)
  
EndMacro 

Macro SetGaugeMinMaxSteps(GaugeA, P_Min, P_Max, P_BigStep, P_SmallStep)
  
  SetGaugeMin(GaugeA, P_Min)
  SetGaugeMax(GaugeA, P_Max)
  SetGaugeBigStep(GaugeA, P_BigStep)
  SetGaugeSmallStep(GaugeA, P_SmallStep)
  
EndMacro 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< L'opérateur PaintGaugeBackground <<<<<

Macro PaintGaugeBackground(GaugeA)
  
  DrawingMode(#PB_2DDrawing_AllChannels)
  Box(0, 0, GetGaugeSize(GaugeA), GetGaugeSize(GaugeA), GetGaugeBackGroundColor(GaugeA))
  
  ; DrawingMode(#PB_2DDrawing_AllChannels | #PB_2DDrawing_Outlined)
  ; Box(0, 0, GetGaugeSize(GaugeA), GetGaugeSize(GaugeA), RGBA(0, 0, 0, 32))
  
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< L'opérateur PaintGaugeScale <<<<<

Macro PaintGaugeScale(GaugeA)
  
  StartDegree.i = ((360 - GetGaugeSectorDegrees(GaugeA)) >> 1)
  
  wpx = GetGaugeSize(GaugeA) / 33
  wpx2 = wpx / 4.0 * 3 - 1
  
  SmallStepDegrees.d = GetGaugeSmallStep(GaugeA)/ GetGaugeMax(GaugeA) * GetGaugeSectorDegrees(GaugeA)
  BigStepDegrees.d = GetGaugeBigStep(GaugeA) / GetGaugeMax(GaugeA) * GetGaugeSectorDegrees(GaugeA)
  
  DrawingMode(#PB_2DDrawing_AllChannels)
  
  For I = 0 To GetGaugeSectorDegrees(GaugeA)
    x = GetGaugeCenter(GaugeA) + Sin(Radian(StartDegree + I)) * GetGaugeScaleRadius(GaugeA)
    y = GetGaugeCenter(GaugeA) + Cos(Radian(StartDegree + I)) * GetGaugeScaleRadius(GaugeA)
    Circle(x, y, wpx, GetGaugeScaleColor(GaugeA))
  Next
  
  DrawingMode(#PB_2DDrawing_AllChannels)
  
  For I = 0 To GetGaugeSectorDegrees(GaugeA)
    x = GetGaugeCenter(GaugeA) + Sin(Radian(StartDegree + I)) * GetGaugeScaleRadius(GaugeA)
    y = GetGaugeCenter(GaugeA) + Cos(Radian(StartDegree + I)) * GetGaugeScaleRadius(GaugeA)
    Circle(x, y, wpx2, GetGaugeScaleBackGroundColor(GaugeA))
  Next
  
  dI.d = 0
  
  While dI <= GetGaugeSectorDegrees(GaugeA)
    x1 = GetGaugeCenter(GaugeA) + Sin(Radian(StartDegree + dI)) * (GetGaugeScaleRadius(GaugeA) - wpx2)
    y1 = GetGaugeCenter(GaugeA) + Cos(Radian(StartDegree + dI)) * (GetGaugeScaleRadius(GaugeA) - wpx2)
    x2 = GetGaugeCenter(GaugeA) + Sin(Radian(StartDegree + dI)) * (GetGaugeScaleRadius(GaugeA) - (wpx2 / 2))
    y2 = GetGaugeCenter(GaugeA) + Cos(Radian(StartDegree + dI)) * (GetGaugeScaleRadius(GaugeA) - (wpx2 / 2))
    LineXY(x1, y1, x2, y2, GetGaugeScaleColor(GaugeA))
    dI + SmallStepDegrees
  Wend
  
  dI = 0
  
  While dI <= GetGaugeSectorDegrees(GaugeA) + 1 ;?!
    x1 = GetGaugeCenter(GaugeA) + Sin(Radian(StartDegree + dI)) * (GetGaugeScaleRadius(GaugeA) - wpx)
    y1 = GetGaugeCenter(GaugeA) + Cos(Radian(StartDegree + dI)) * (GetGaugeScaleRadius(GaugeA) - wpx)
    x2 = GetGaugeCenter(GaugeA) + Sin(Radian(StartDegree + dI)) * (GetGaugeScaleRadius(GaugeA) + wpx)
    y2 = GetGaugeCenter(GaugeA) + Cos(Radian(StartDegree + dI)) * (GetGaugeScaleRadius(GaugeA) + wpx)
    LineXY(x1, y1, x2, y2, GetGaugeScaleColor(GaugeA))
    dI + BigStepDegrees
  Wend
  
  DrawingMode(#PB_2DDrawing_AlphaBlend | #PB_2DDrawing_Transparent)
  DrawingFont(FontID(GetGaugeScaleFontHandle(GaugeA)))
  
  dI = 0
  I = 0
  
  While dI <= GetGaugeSectorDegrees(GaugeA) + 1 ; not sure why that is needed
    
    Offset.w = MaxLong(3, Len(Str(GetGaugeMax(GaugeA) - I)))
    
    x = GetGaugeCenter(GaugeA) + Sin(Radian(StartDegree + dI)) * (GetGaugeScaleRadius(GaugeA) + wpx * Offset)
    y = GetGaugeCenter(GaugeA) + Cos(Radian(StartDegree + dI)) * (GetGaugeScaleRadius(GaugeA) + wpx * Offset)
    DrawTextCentered(x, y, Str(GetGaugeMax(GaugeA) - I), GetGaugeTextColor(GaugeA), RGBA(0, 0, 0, 0))
    dI + BigStepDegrees
    I + GetGaugeBigStep(GaugeA)
    
  Wend
  
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< L'opérateur PaintGaugeDescription <<<<<

Macro PaintGaugeDescription(GaugeA)
  
  DrawingMode(#PB_2DDrawing_AlphaBlend | #PB_2DDrawing_Transparent)
  DrawingFont(FontID(GetGaugeTextFontHandle(GaugeA)))
  
  x = GetGaugeCenter(GaugeA)
  y = 8 * GetGaugeSize(GaugeA) / 10
  
  DrawTextCentered(x, y, GetGaugeText(GaugeA), GetGaugeTextColor(GaugeA), RGBA(0, 0, 0, 0))
  y + TextHeight("Wg")
  
  DrawingFont(FontID(GetGaugeSubTextFontHandle(GaugeA)))
  DrawTextCentered(x, y, GetGaugeSubText(GaugeA), GetGaugeSubTextColor(GaugeA), RGBA(0, 0, 0, 0))
  
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< L'opérateur PaintGaugeHand <<<<<

Macro PaintGaugeNeedle(GaugeA)
  
  DrawingMode(#PB_2DDrawing_AllChannels)
  
  HalfSize = GetGaugeLayerSize(GaugeA) >> 1
  x1 = HalfSize + 15
  y1 = HalfSize
  x2 = HalfSize - 15
  y2 = y1
  x3 = HalfSize - 4
  y3 = GetGaugeLayerSize(GaugeA) - GetGaugeScaleRadius(GaugeA) * 5 / 2
  x4 = HalfSize + 4
  y4 = y3
  
  LineXY(x1, y1, x2, y2, GetGaugeNeedleColor(GaugeA))
  LineXY(x2, y2, x3, y3, GetGaugeNeedleColor(GaugeA))
  LineXY(x3, y3, x4, y4, GetGaugeNeedleColor(GaugeA))
  LineXY(x4, y4, x1, y1, GetGaugeNeedleColor(GaugeA))
  
  FillArea(x3, y2+5, GetGaugeNeedleColor(GaugeA), GetGaugeNeedleColor(GaugeA))
  
  Circle(HalfSize, HalfSize, 40, GetGaugeNeedleColor(GaugeA))
  
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< L'opérateur LoadGaugeFont <<<<<

Procedure LoadGaugeFont(*GaugeA.Gauge, FontName.s)
  
  If GetGaugeScaleFontHandle(*GaugeA)
    FreeFont(GetGaugeScaleFontHandle(*GaugeA))
  EndIf
  
  If GetGaugeTextFontHandle(*GaugeA)
    FreeFont(GetGaugeTextFontHandle(*GaugeA))
  EndIf
  
  If GetGaugeSubTextFontHandle(*GaugeA)
    FreeFont(GetGaugeSubTextFontHandle(*GaugeA))
  EndIf
  
  SetGaugeScaleFontHandle(*GaugeA, LoadFont(#PB_Any, FontName, MaxDouble(7, 0.04 * GetGaugeSize(*GaugeA))))
  SetGaugeTextFontHandle(*GaugeA, LoadFont(#PB_Any, FontName, MaxDouble(8, 0.056 * GetGaugeSize(*GaugeA)), #PB_Font_Bold))
  SetGaugeSubTextFontHandle(*GaugeA, LoadFont(#PB_Any, FontName, MaxDouble(7, 0.04 * GetGaugeSize(*GaugeA))))
  
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< L'opérateur GaugeGadget <<<<<

Procedure GaugeGadget(*GaugeA.Gauge, GaugeID.l, x.w, y.w, Size.w, FontName.s = "", Options.l = 0)
  
  SetGaugeGadgetID(*GaugeA, GaugeID)
  SetGaugeGadgetHandle(*GaugeA, ImageGadget(GetGaugeGadgetID(*GaugeA), x, y, Size, Size, 0, Options))
  SetGaugePositionSize(*GaugeA, x, y, Size)
  
  SetGaugeCenter(*GaugeA, Size >> 1)
  SetGaugeScaleRadius(*GaugeA, Size * 3 / 10)
  
  SetGaugeLayerSize(*GaugeA, Size * 4)
  
  If FontName <> ""
    SetGaugeScaleFontHandle(*GaugeA, LoadFont(#PB_Any, FontName, MaxDouble(8, 0.04 * GetGaugeSize(*GaugeA))))
    SetGaugeTextFontHandle(*GaugeA, LoadFont(#PB_Any, FontName, MaxDouble(9, 0.056 * GetGaugeSize(*GaugeA)), #PB_Font_Bold))
    SetGaugeSubTextFontHandle(*GaugeA, LoadFont(#PB_Any, FontName, MaxDouble(8, 0.04 * GetGaugeSize(*GaugeA))))
  EndIf 
  
  SetGaugeSectorDegrees(*GaugeA, 270)
  
  SetGaugeBackGroundColor(*GaugeA, RGBA(0, 0, 0, 0))
  SetGaugeScaleColor(*GaugeA, RGBA(62, 62, 128, 192))
  SetGaugeScaleBackGroundColor(*GaugeA, RGBA(64, 64, 64, 32))
  SetGaugeTextColor(*GaugeA, RGBA(0, 0, 0, 255))
  SetGaugeSubTextColor(*GaugeA, RGBA(92, 92, 92, 255))
  SetGaugeNeedleColor(*GaugeA, RGBA(255, 000, 000, 255))
  SetGaugeMin(*GaugeA, 0)
  SetGaugeMax(*GaugeA, 100)
  SetGaugeBigStep(*GaugeA, 10)
  SetGaugeSmallStep(*GaugeA, 5)
  SetGaugeValue(*GaugeA, 0)
  SetGaugeText(*GaugeA, "Value")
  SetGaugeSubText(*GaugeA, "in units")
  
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< L'opérateur RefreshGaugeGadget <<<<<

Procedure RefreshGaugeGadget(*GaugeA.Gauge)
  
  If GetGaugeBackGroundLayer(*GaugeA)
    FreeImage(GetGaugeBackGroundLayer(*GaugeA))
  EndIf 
  
  SetGaugeBackGroundLayer(*GaugeA, CreateImage(#PB_Any, GetGaugeSize(*GaugeA), GetGaugeSize(*GaugeA), 32 | #PB_Image_Transparent))
  
  If StartDrawing(ImageOutput(GetGaugeBackGroundLayer(*GaugeA)))
    PaintGaugeBackground(*GaugeA)
    StopDrawing()
  EndIf   
  
  If GetGaugeNeedleLayer(*GaugeA)
    FreeImage(GetGaugeNeedleLayer(*GaugeA))
  EndIf 
  
  SetGaugeNeedleLayer(*GaugeA, CreateImage(#PB_Any, GetGaugeLayerSize(*GaugeA), GetGaugeLayerSize(*GaugeA), 32 | #PB_Image_Transparent))
  
  If StartDrawing(ImageOutput(GetGaugeNeedleLayer(*GaugeA)))
    PaintGaugeNeedle(*GaugeA)
    StopDrawing()
  EndIf 
  
  ResizeImage(GetGaugeNeedleLayer(*GaugeA), GetGaugeSize(*GaugeA), GetGaugeSize(*GaugeA))
  
  If GetGaugeScaleLayer(*GaugeA)
    FreeImage(GetGaugeScaleLayer(*GaugeA))
  EndIf 
  
  SetGaugeScaleLayer(*GaugeA, CreateImage(#PB_Any, GetGaugeSize(*GaugeA), GetGaugeSize(*GaugeA), 32 | #PB_Image_Transparent))
  
  If StartDrawing(ImageOutput(GetGaugeScaleLayer(*GaugeA)))
    PaintGaugeScale(*GaugeA)
    StopDrawing()
  EndIf 
  
  If GetGaugeDescriptionLayer(*GaugeA)
    FreeImage(GetGaugeDescriptionLayer(*GaugeA))
  EndIf 
  
  SetGaugeDescriptionLayer(*GaugeA, CreateImage(#PB_Any, GetGaugeSize(*GaugeA), GetGaugeSize(*GaugeA), 32 | #PB_Image_Transparent))
  
  If StartDrawing(ImageOutput(GetGaugeDescriptionLayer(*GaugeA)))
    PaintGaugeDescription(*GaugeA)
    StopDrawing()
  EndIf 
  
  StartDegree.i = ((360 - GetGaugeSectorDegrees(*GaugeA)) >> 1)
  DirDegrees.d = StartDegree + (GetGaugeMax(*GaugeA) - GetGaugeValue(*GaugeA)) / GetGaugeMax(*GaugeA) * GetGaugeSectorDegrees(*GaugeA)
  
  TempNeedle1 = RotateImageFree(GetGaugeNeedleLayer(*GaugeA), DirDegrees, #True, $ffffff)
  TempNeedle2 = GrabImage(TempNeedle1, #PB_Any, (ImageWidth(TempNeedle1) - GetGaugeSize(*GaugeA)) >> 1, (ImageHeight(TempNeedle1) - GetGaugeSize(*GaugeA)) >> 1, GetGaugeSize(*GaugeA), GetGaugeSize(*GaugeA))
  
  If GetGaugeComposedLayer(*GaugeA)
    FreeImage(GetGaugeComposedLayer(*GaugeA))
  EndIf
  
  SetGaugeComposedLayer(*GaugeA, CreateImage(#PB_Any, GetGaugeSize(*GaugeA), GetGaugeSize(*GaugeA), 32 | #PB_Image_Transparent))
  
  If StartDrawing(ImageOutput(GetGaugeComposedLayer(*GaugeA)))
    
    DrawingMode(#PB_2DDrawing_AlphaBlend)
    DrawImage(ImageID(GetGaugeBackGroundLayer(*GaugeA)), 0, 0)
    DrawImage(ImageID(GetGaugeScaleLayer(*GaugeA)), 0, 0)
    DrawImage(ImageID(GetGaugeDescriptionLayer(*GaugeA)), 0, 0)
    DrawImage(ImageID(TempNeedle2), 0, 0)
    StopDrawing()
    
  EndIf 
  
  If TempNeedle1
    FreeImage(TempNeedle1)
  EndIf 
  
  If TempNeedle2
    FreeImage(TempNeedle2)
  EndIf 
  
  If GetGaugeGadgetID(*GaugeA) <> #PB_Any
    SetGadgetState(GetGaugeGadgetID(*GaugeA), ImageID(GetGaugeComposedLayer(*GaugeA)))
  Else     
    SetGadgetState(GetGaugeGadgetHandle(*GaugeA), ImageID(GetGaugeComposedLayer(*GaugeA)))
  EndIf 
  
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
; <<<<< !!! WARNING - YOU ARE NOW IN A TESTING ZONE - WARNING !!! <<<<< 
; <<<<< !!! WARNING - THIS CODE SHOULD BE COMMENTED - WARNING !!! <<<<< 
; <<<<< !!! WARNING - BEFORE THE FINAL COMPILATION. - WARNING !!! <<<<< 
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 

#W = 610
#H = 245

CompilerSelect #PB_Compiler_OS
    
  CompilerCase #PB_OS_Linux
    FontName.s = "Liberation Sans"
    
  CompilerCase #PB_OS_Windows
    FontName.s = "Tahoma"
    
CompilerEndSelect

If OpenWindow(0, 0, 0, #W, #H, "Gauge Gadget Demo", #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
  
  TrackBarGadget(0, 245, 10, 360, 22, 0, 360)
  TrackBarGadget(1, 245, 40, 360, 22, 1, 360)
  
  GaugeGadget(GaugeA.Gauge, 5, 5, 5, 230, FontName, #PB_Image_Border)
  SetGaugeMinMaxSteps(GaugeA, 0, 360, 30, 5)
  SetGaugeText(GaugeA, "Pressure")
  SetGaugeSubText(GaugeA, "in kPa")
  
  RefreshGaugeGadget(GaugeA)
  
  SetGadgetState(0, 0)
  SetGadgetState(1, 280)
  
  Repeat
    
    Select WaitWindowEvent()
        
      Case #PB_Event_Gadget 
        
        Select EventGadget()
            
          Case 0 ; Change value
            SetGaugeValue(GaugeA, GetGadgetState(0))
            RefreshGaugeGadget(GaugeA)
            
          Case 1 ; Change size in degrees
            SetGaugeSectorDegrees(GaugeA, GetGadgetState(1))
            RefreshGaugeGadget(GaugeA)
            
        EndSelect
        
      Case #PB_Event_CloseWindow
        Break
        
    EndSelect
    
  ForEver
  
  ResetGauge(GaugeA)
  
EndIf 

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<
And the Luis's Image rotation routines.

Code: Select all

;******************************************************************************
;*
;* Image Rotation routines for 24/32 bit with optional AA
;* by Luis, http://luis.no-ip.net
;* v1.02 for PB 4.40
;*
;* Tested under Windows 32/64 bit and Linux 32 bit with PB 4.40 B2
;*
;* These routines can deal with both 24/32 bit images and with the alpha channel.
;* The output of the routines will be an image with the same number of BPP
;* as the one passed in input to them.
;*
;* ---------------------------------------------------------------------------- 
;* 
;* RotateImageFree (nSrcImage, fDegRot.f, flgAntiAliasing, iFillColor)
;* 
;*  nSrcImage           The 24/32 bit PureBasic's image to rotate
;*  fDegRot             Float angle in degrees (+/-) 0.0 -> 360.0
;*  flgAntiAliasing     0 for simpler rotation, 1 for antialiased rotation
;*  iFillColor          Used to fill the new areas of the resulting image
;*  
;*  Return              a 24/32 bit image rotated by fDegRot
;* 
;* NOTES : 
;*  iFillColor is not used with 32 bit images, the new areas are always transparent.
;* 
;*  iFillColor can be set to a unique color with 24 bit images if you want to
;*  draw the resulting image with masking using GDI functions under Windows,
;*  for example. Or maybe to simply match a certain background color.
;* 
;*  The anti aliasing use 4 pixels to do the AA, this is useful especially
;*  when text is present on the image to be rotated to obtain a good quality
;*  at the expense of speed. A free-angle rotation really need AA !
;*
;* ---------------------------------------------------------------------------- 
;*
;* RotateImage (nSrcImage, iDegRot)
;*
;*  nSrcImage           The 24/32 bit PureBasic's image to rotate
;*  iDegRot             Integer angle in degrees (+/-) 90/180/270
;*
;*  Return              a 24/32 bit image rotated by iDegRot
;*
;* NOTES :
;*   Use this procedure to rotate by multiples of 90 degrees instead of
;*   RotateImageFree(). It's faster and it's not subject to rounding errors.
;*
;* ----------------------------------------------------------------------------
;*
;* FlipImage (nSrcImage)
;*
;*  nSrcImage           The 24/32 bit PureBasic's image to flip
;*
;*  Return              a 24/32 bit image flipped vertically
;*
;* ----------------------------------------------------------------------------
;*
;* MirrorImage (nSrcImage)
;*
;*  nSrcImage           The 24/32 bit PureBasic's image to mirror
;*
;*  Return              a 24/32 bit image mirrored horizontally
;* 
;******************************************************************************

; Image Direct Memory.pbi

Structure T_RGBA
  B.a
  G.a
  R.a
  A.a
EndStructure

Macro RGB_B(color)
  ((color & $FF0000) >> 16) 
EndMacro

Macro RGB_G(color)
  ((color & $FF00) >> 8) 
EndMacro

Macro RGB_R(color)
  (color & $FF) 
EndMacro 

Macro RGB_Mix (r, g, b)
  ((((b) << 8 + (g)) << 8) + (r))
EndMacro

Macro CopyPixel32 (iXs, iYs, iXd, iYd, iBufferPitchSrc, iBufferPitchDest, ptRGBAs, ptRGBAd, pMemSrc, pMemDest)
  ptRGBAs = pMemSrc  + (iYs) * iBufferPitchSrc + (iXs) << 2
  ptRGBAd = pMemDest + (iYd) * iBufferPitchDest + (iXd) << 2        
  ptRGBAd\R = ptRGBAs\R
  ptRGBAd\G = ptRGBAs\G
  ptRGBAd\B = ptRGBAs\B        
  ptRGBAd\A = ptRGBAs\A
EndMacro

Macro CopyPixel24 (iXs, iYs, iXd, iYd, iBufferPitchSrc, iBufferPitchDest, ptRGBAs, ptRGBAd, pMemSrc, pMemDest)
  ptRGBAs = pMemSrc  + (iYs) * iBufferPitchSrc + (iXs) * 3
  ptRGBAd = pMemDest + (iYd) * iBufferPitchDest + (iXd) * 3        
  ptRGBAd\R = ptRGBAs\R
  ptRGBAd\G = ptRGBAs\G
  ptRGBAd\B = ptRGBAs\B        
EndMacro

Macro ReadPixel32 (iX, iY, iBufferPitchSrc, ptRGBA, pMemSrc) 
  ptRGBA = pMemSrc + (iY) * iBufferPitchSrc + (iX) << 2
EndMacro

Macro ReadPixel24 (iX, iY, iBufferPitchSrc, ptRGBA, pMemSrc) 
  ptRGBA = pMemSrc + (iY) * iBufferPitchSrc + (iX) * 3
EndMacro

Macro WritePixel32 (tPixel, iX, iY, iBufferPitchDest, ptRGBA, pMemDest)
  ptRGBA = pMemDest + (iY) * iBufferPitchDest + (iX) << 2                       
  ptRGBA\R = tPixel\R
  ptRGBA\G = tPixel\G
  ptRGBA\B = tPixel\B
  ptRGBA\A = tPixel\A
EndMacro

Macro WritePixel24 (tPixel, iX, iY, iBufferPitchDest, ptRGBA, pMemDest)
  ptRGBA = pMemDest + (iY) * iBufferPitchDest + (iX) * 3
  ptRGBA\R = tPixel\R
  ptRGBA\G = tPixel\G
  ptRGBA\B = tPixel\B
EndMacro

; support procedures

Macro JMP_IF_ZERO(var, label, exec=0)
  ; If 'var' equals zero, then execute 'exec' and jump to 'label'
  ; Yes, I like GOTOs for error handling. 
  If var = 0
    ;exec
    Goto label 
  EndIf
EndMacro

Procedure.i AllocateImageData(nImage, *iBufferPitch.Integer, iFillColor = -1)
  
  Protected *ImageMem, *AllocMem, iBufferPitch
  
  StartDrawing(ImageOutput(nImage))
  
  *ImageMem = DrawingBuffer()
  iBufferPitch = DrawingBufferPitch()
  
  If iFillColor <> -1
    Select ImageDepth(nImage)
      Case 24
        Box(0, 0, ImageWidth(nImage), ImageHeight(nImage), iFillColor) 
      Case 32
        DrawingMode(#PB_2DDrawing_AlphaChannel)    
        Box(0, 0, ImageWidth(nImage), ImageHeight(nImage), $00) ; full transparent
    EndSelect 
  EndIf
  
  *AllocMem = AllocateMemory(iBufferPitch * ImageHeight(nImage)) 
  
  If *AllocMem
    CopyMemory(*ImageMem, *AllocMem, MemorySize(*AllocMem))
    *iBufferPitch\i = iBufferPitch
  Else
    *iBufferPitch\i = 0
  EndIf 
  
  StopDrawing()
  
  ProcedureReturn *AllocMem
EndProcedure

Macro CopyImageData(nImage, DestMem) 
  
  StartDrawing(ImageOutput(nImage))  
  CopyMemory(DestMem, DrawingBuffer(), MemorySize(DestMem))
  StopDrawing()
  
EndMacro

; user procedures

Procedure.i RotateImageFree(nSrcImage, fDegRot.f, flgAntiAliasing, iFillColor = $ffffff)
  ; Inspired by a simpler Visual Basic code from Robert Rayment. Thank you.
  ; http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=23476&lngWId=1
  
  ; Rotate 24 bit images at any angle optionally with anti-aliasing filling the new area 
  ; of the resulting image with the specified color
  
  ; Rotate 32 bit images at any angle optionally with anti-aliasing preserving the alpha-channel
  
  ; This one uses the DrawingBuffer() ability to work with images available in PB 4.40
  
  Protected *tRGBAs.T_RGBA, *tRGBAd.T_RGBA, tPixel.T_RGBA 
  Protected *SrcMem, *DestMem, iBufferPitchSrc, iBufferPitchDest 
  Protected fzCos.f, fzSin.f 
  Protected iSrcWidth, iSrcHeight, iDestWidth, iDestHeight, nDestImage
  Protected iX, iY, iXs, iYs, iXc1, iYc1, iXc2, iYc2, iColor 
  Protected iBitPlanes
  
  CompilerIf (#PB_Compiler_OS = #PB_OS_Linux)
    fDegRot = -fDegRot
  CompilerEndIf
  
  ; sanity checks
  If IsImage(nSrcImage) = 0
    ProcedureReturn 0
  EndIf
  
  iBitPlanes = ImageDepth(nSrcImage)
  
  If iBitPlanes <> 24 And iBitPlanes <> 32
    ProcedureReturn 0
  EndIf
  
  fzCos = Cos(fDegRot / 180.0 * #PI) 
  fzSin = Sin(fDegRot / 180.0 * #PI) 
  
  iSrcWidth = ImageWidth(nSrcImage)
  iSrcHeight = ImageHeight(nSrcImage) 
  
  iDestWidth = Int(iSrcWidth * Abs(fzCos) + iSrcHeight * Abs(fzSin))
  iDestHeight = Int(iSrcHeight * Abs(fzCos) + iSrcWidth * Abs(fzSin))
  
  iXc1 = iSrcWidth >> 1
  iYc1 = iSrcHeight >> 1
  iXc2 = iDestWidth >> 1
  iYc2 = iDestHeight >> 1
  
  ; create 24/32 bit destination image  
  nDestImage = CreateImage(#PB_Any, iDestWidth, iDestHeight, iBitPlanes)
  JMP_IF_ZERO (nDestImage, lbl_RotateImageFree_ERR)
  
  ; copy src image to allocated memory 
  *SrcMem = AllocateImageData (nSrcImage, @iBufferPitchSrc)
  JMP_IF_ZERO (*SrcMem, lbl_RotateImageFree_Alloc_ERR)
  
  ; copy dest image to allocated memory and fill with backcolor
  *DestMem = AllocateImageData(nDestImage, @iBufferPitchDest, iFillColor)
  JMP_IF_ZERO (*DestMem, lbl_RotateImageFree_Alloc_ERR)
  
  
  Select flgAntiAliasing
      
    Case #False   
      
      Select iBitPlanes 
        Case 24
          
          For iY = 0 To iDestHeight - 1
            For iX = 0 To iDestWidth - 1
              
              ; For each nDestImage point find rotated nSrcImage source point
              iXs = iXc1 + (iX - iXc2) * fzCos + (iY - iYc2) * fzSin
              iYs = iYc1 + (iY - iYc2) * fzCos - (iX - iXc2) * fzSin
              
              If iXs >= 0 And iXs < iSrcWidth  And iYs >= 0 And iYs < iSrcHeight 
                ; Move valid rotated nSrcImage source points to nDestImage                   
                CopyPixel24 (iXs, iYs, iX, iY, iBufferPitchSrc, iBufferPitchDest, *tRGBAs, *tRGBAd, *SrcMem, *DestMem)
              EndIf
              
            Next
          Next   
          
        Case 32
          
          For iY = 0 To iDestHeight - 1
            For iX = 0 To iDestWidth - 1
              ; For each nDestImage point find rotated nSrcImage source point
              iXs = iXc1 + (iX - iXc2) * fzCos + (iY - iYc2) * fzSin
              iYs = iYc1 + (iY - iYc2) * fzCos - (iX - iXc2) * fzSin
              
              If iXs >= 0 And iXs < iSrcWidth  And iYs >= 0 And iYs < iSrcHeight 
                ; Move valid rotated nSrcImage source points to nDestImage                   
                CopyPixel32 (iXs, iYs, iX, iY, iBufferPitchSrc, iBufferPitchDest, *tRGBAs, *tRGBAd, *SrcMem, *DestMem)
              EndIf
              
            Next
          Next   
          
      EndSelect
      
    Case #True
      Protected iXs0, iYs0, icr, icg, icb, icr0, icg0, icb0, icr1, icg1, icb1
      Protected fXs.f, fYs.f, fXfs1.f, fYfs1.f
      Protected fXfs1less.f, fYfs1less.f
      
      Select iBitPlanes 
          
        Case 24
          
          For iY = 0 To iDestHeight - 1
            For iX = 0 To iDestWidth - 1
              
              ; For each nDestImage point find rotated nSrcImage source point
              fXs = iXc1 + (iX - iXc2) * fzCos + (iY - iYc2) * fzSin
              fYs = iYc1 + (iY - iYc2) * fzCos - (iX - iXc2) * fzSin
              
              ; Bottom left coords of bounding floating point rectangle on nSrcImage
              iXs0 = Int(fXs)   
              iYs0 = Int(fYs)
              
              If iXs0 > 0 And iXs0 < iSrcWidth -1 And iYs0 > 0 And iYs0 < iSrcHeight - 1                        
                fXfs1 = fXs - Int(fXs)
                fYfs1 = fYs - Int(fYs)
                
                fXfs1less = 1 - fXfs1 - 0.000005 : If fXfs1less < 0 : fXfs1less = 0 : EndIf
                fYfs1less = 1 - fYfs1 - 0.000005 : If fYfs1less < 0 : fYfs1less = 0 : EndIf
                
                ReadPixel24 (iXs0, iYs0, iBufferPitchSrc, *tRGBAs, *SrcMem)                                                                                                                               
                icr = *tRGBAs\R * fXfs1less 
                icg = *tRGBAs\G * fXfs1less 
                icb = *tRGBAs\B * fXfs1less 
                
                ReadPixel24 (iXs0 + 1, iYs0, iBufferPitchSrc, *tRGBAs, *SrcMem)
                icr0 = *tRGBAs\R * fXfs1 + icr 
                icg0 = *tRGBAs\G * fXfs1 + icg 
                icb0 = *tRGBAs\B * fXfs1 + icb 
                
                ReadPixel24 (iXs0, iYs0 + 1, iBufferPitchSrc, *tRGBAs, *SrcMem)
                icr = *tRGBAs\R * fXfs1less 
                icg = *tRGBAs\G * fXfs1less 
                icb = *tRGBAs\B * fXfs1less 
                
                ReadPixel24 (iXs0 + 1, iYs0 + 1, iBufferPitchSrc, *tRGBAs, *SrcMem)
                icr1 = *tRGBAs\R * fXfs1 + icr 
                icg1 = *tRGBAs\G * fXfs1 + icg 
                icb1 = *tRGBAs\B * fXfs1 + icb 
                
                ; Weight along axis Y
                tPixel\R = fYfs1less * icr0 + fYfs1 * icr1 
                tPixel\G = fYfs1less * icg0 + fYfs1 * icg1 
                tPixel\B = fYfs1less * icb0 + fYfs1 * icb1                            
                
                WritePixel24 (tPixel, iX, iY, iBufferPitchDest, *tRGBAd, *DestMem)                                
              EndIf            
            Next
          Next           
          
        Case 32
          
          Protected ica, ica0, ica1
          
          For iY = 0 To iDestHeight - 1
            For iX = 0 To iDestWidth - 1
              
              ; For each nDestImage point find rotated nSrcImage source point
              fXs = iXc1 + (iX - iXc2) * fzCos + (iY - iYc2) * fzSin
              fYs = iYc1 + (iY - iYc2) * fzCos - (iX - iXc2) * fzSin
              
              ; Bottom left coords of bounding floating point rectangle on nSrcImage
              iXs0 = Int(fXs)   
              iYs0 = Int(fYs)
              
              If iXs0 > 0 And iXs0 < iSrcWidth -1 And iYs0 > 0 And iYs0 < iSrcHeight - 1
                
                fXfs1 = fXs - Int(fXs)
                fYfs1 = fYs - Int(fYs)
                
                fXfs1less = 1 - fXfs1 - 0.000005 : If fXfs1less < 0 : fXfs1less = 0 : EndIf
                fYfs1less = 1 - fYfs1 - 0.000005 : If fYfs1less < 0 : fYfs1less = 0 : EndIf
                
                ReadPixel32 (iXs0, iYs0, iBufferPitchSrc, *tRGBAs, *SrcMem)                                                                                                                                                        
                icr = *tRGBAs\R * fXfs1less
                icg = *tRGBAs\G * fXfs1less
                icb = *tRGBAs\B * fXfs1less
                ica = *tRGBAs\A * fXfs1less
                
                ReadPixel32 (iXs0 + 1, iYs0, iBufferPitchSrc, *tRGBAs, *SrcMem)
                icr0 = *tRGBAs\R * fXfs1 + icr 
                icg0 = *tRGBAs\G * fXfs1 + icg 
                icb0 = *tRGBAs\B * fXfs1 + icb 
                ica0 = *tRGBAs\A * fXfs1 + ica 
                
                ReadPixel32 (iXs0, iYs0 + 1, iBufferPitchSrc, *tRGBAs, *SrcMem)
                icr = *tRGBAs\R * fXfs1less 
                icg = *tRGBAs\G * fXfs1less 
                icb = *tRGBAs\B * fXfs1less 
                ica = *tRGBAs\A * fXfs1less 
                
                ReadPixel32 (iXs0 + 1, iYs0 + 1, iBufferPitchSrc, *tRGBAs, *SrcMem)
                icr1 = *tRGBAs\R * fXfs1 + icr 
                icg1 = *tRGBAs\G * fXfs1 + icg 
                icb1 = *tRGBAs\B * fXfs1 + icb 
                ica1 = *tRGBAs\A * fXfs1 + ica 
                
                ; Weight along axis Y
                tPixel\R = fYfs1less * icr0 + fYfs1 * icr1 
                tPixel\G = fYfs1less * icg0 + fYfs1 * icg1 
                tPixel\B = fYfs1less * icb0 + fYfs1 * icb1
                tPixel\A = fYfs1less * ica0 + fYfs1 * ica1                            
                
                WritePixel32 (tPixel, iX, iY, iBufferPitchDest, *tRGBAd, *DestMem)
              EndIf            
            Next
          Next           
          
      EndSelect
  EndSelect 
  
  CopyImageData (nDestImage, *DestMem)
  
  FreeMemory(*SrcMem)
  FreeMemory(*DestMem)
  
  ProcedureReturn nDestImage 
  
  
  lbl_RotateImageFree_Alloc_ERR:
  ; check if one was successfull and free it
  If *SrcMem <> 0 : FreeMemory(*SrcMem) : EndIf
  If *DestMem <> 0 : FreeMemory(*DestMem) : EndIf
  
  ; image was already created, free it
  FreeImage(nDestImage)
  
  lbl_RotateImageFree_ERR: 
  ProcedureReturn 0
  
EndProcedure


Procedure.i RotateImage(nSrcImage, iDegRot)
  
  ; Rotate 24 bit images at (+/-) 90/180/270 degrees
  
  ; Rotate 32 bit images at (+/-) 90/180/270 degrees preserving the alpha-channel
  
  ; This one uses the DrawingBuffer() ability to work with images available in PB 4.40
  
  Protected *tRGBAs.T_RGBA, *tRGBAd.T_RGBA, tPixel.T_RGBA, iType
  Protected *SrcMem, *DestMem, iBufferPitchSrc, iBufferPitchDest 
  Protected iSrcWidth, iSrcHeight, iDestWidth, iDestHeight, nDestImage
  Protected iX, iY, iXs, iYs
  Protected iBitPlanes
  
  ; sanity checks
  If IsImage(nSrcImage) = 0
    ProcedureReturn 0
  EndIf
  
  iBitPlanes = ImageDepth(nSrcImage)
  
  If iBitPlanes <> 24 And iBitPlanes <> 32
    ProcedureReturn 0
  EndIf
  
  ; sanity checks
  If iDegRot % 90  
    ProcedureReturn 0
  EndIf
  
  iDegRot % 360
  
  If iDegRot = 0 Or iDegRot = 360
    ProcedureReturn 0
  EndIf
  
  CompilerIf (#PB_Compiler_OS = #PB_OS_Linux)
    iDegRot = -iDegRot
  CompilerEndIf
  
  
  iSrcWidth = ImageWidth(nSrcImage)
  iSrcHeight = ImageHeight(nSrcImage) 
  
  Select iDegRot
    Case 90, -270
      iDestWidth = iSrcHeight
      iDestHeight = iSrcWidth
      iType = 1
    Case 180, -180
      iType = 2
      iDestWidth = iSrcWidth
      iDestHeight = iSrcHeight
    Case 270, -90
      iType = 3
      iDestWidth = iSrcHeight
      iDestHeight = iSrcWidth
  EndSelect
  
  ; create 24/32 bit destination image 
  nDestImage = CreateImage(#PB_Any, iDestWidth, iDestHeight, iBitPlanes)
  JMP_IF_ZERO (nDestImage, lbl_RotateImage_ERR)
  
  ; copy src image to allocated memory
  *SrcMem = AllocateImageData(nSrcImage, @iBufferPitchSrc)
  JMP_IF_ZERO (*SrcMem, lbl_RotateImage_Alloc_ERR)
  
  ; copy dest image to allocated memory 
  *DestMem = AllocateImageData(nDestImage, @iBufferPitchDest)
  JMP_IF_ZERO (*DestMem, lbl_RotateImage_Alloc_ERR)
  
  Select iBitPlanes
    Case 24
      For iY = 0 To iDestHeight - 1 
        For iX = 0 To iDestWidth - 1
          
          Select iType
            Case 1
              iYs = iSrcHeight - iX - 1
              iXs = iY
            Case 2
              iYs = iSrcHeight - iY - 1
              iXs = iSrcWidth - iX - 1    
            Case 3
              iYs = iX
              iXs = iSrcWidth - iY - 1
          EndSelect
          
          CopyPixel24 (iXs, iYs, iX, iY, iBufferPitchSrc, iBufferPitchDest, *tRGBAs, *tRGBAd, *SrcMem, *DestMem) 
          
        Next
      Next    
    Case 32
      For iY = 0 To iDestHeight - 1 
        For iX = 0 To iDestWidth - 1
          
          Select iType
            Case 1
              iYs = iSrcHeight - iX - 1
              iXs = iY
            Case 2
              iYs = iSrcHeight - iY - 1
              iXs = iSrcWidth - iX - 1    
            Case 3
              iYs = iX
              iXs = iSrcWidth - iY - 1
          EndSelect
          
          CopyPixel32 (iXs, iYs, iX, iY, iBufferPitchSrc, iBufferPitchDest, *tRGBAs, *tRGBAd, *SrcMem, *DestMem)                    
          
        Next
      Next    
  EndSelect  
  
  CopyImageData(nDestImage, *DestMem)
  
  FreeMemory(*SrcMem)
  FreeMemory(*DestMem)
  
  ProcedureReturn nDestImage 
  
  
  lbl_RotateImage_Alloc_ERR:
  ; check if one was successfull and free it
  If *SrcMem <> 0 : FreeMemory(*SrcMem) : EndIf
  If *DestMem <> 0 : FreeMemory(*DestMem) : EndIf
  
  ; image was already created, free it
  FreeImage(nDestImage)
  
  lbl_RotateImage_ERR: 
  ProcedureReturn 0
  
EndProcedure

Procedure.i FlipImage(nSrcImage)
  
  ; Flip vertically a 24/32 bit image preserving the alpha-channel
  
  ; This one uses the DrawingBuffer() ability to work with images available in PB 4.40
  
  Protected *tRGBAs.T_RGBA, *tRGBAd.T_RGBA, tPixel.T_RGBA, iType
  Protected *SrcMem, *DestMem, iBufferPitchSrc, iBufferPitchDest 
  Protected iSrcWidth, iSrcHeight, iDestWidth, iDestHeight, nDestImage
  Protected iX, iY
  Protected iBitPlanes
  
  ; sanity checks
  If IsImage(nSrcImage) = 0
    ProcedureReturn 0
  EndIf
  
  iBitPlanes = ImageDepth(nSrcImage)
  
  If iBitPlanes <> 24 And iBitPlanes <> 32
    ProcedureReturn 0
  EndIf 
  
  iSrcWidth = ImageWidth(nSrcImage)
  iSrcHeight = ImageHeight(nSrcImage)
  
  iDestWidth = iSrcWidth
  iDestHeight = iSrcHeight
  
  
  ; create 24/32 bit destination image  
  nDestImage = CreateImage(#PB_Any, iDestWidth, iDestHeight, iBitPlanes)
  JMP_IF_ZERO (nDestImage, lbl_FlipImage_ERR)
  
  ; copy src image to allocated memory
  *SrcMem = AllocateImageData(nSrcImage, @iBufferPitchSrc)
  JMP_IF_ZERO (*SrcMem, lbl_FlipImage_Alloc_ERR)
  
  ; copy dest image to allocated memory 
  *DestMem = AllocateImageData(nDestImage, @iBufferPitchDest)
  JMP_IF_ZERO (*DestMem, lbl_FlipImage_Alloc_ERR)
  
  Select iBitPlanes
    Case 24
      For iY = 0 To iDestHeight - 1 
        For iX = 0 To iDestWidth - 1           
          CopyPixel24 (iX, iSrcHeight - iY - 1, iX, iY, iBufferPitchSrc, iBufferPitchDest, *tRGBAs, *tRGBAd, *SrcMem, *DestMem)
        Next
      Next        
    Case 32
      For iY = 0 To iDestHeight - 1 
        For iX = 0 To iDestWidth - 1           
          CopyPixel32 (iX, iSrcHeight - iY - 1, iX, iY, iBufferPitchSrc, iBufferPitchDest, *tRGBAs, *tRGBAd, *SrcMem, *DestMem)
        Next
      Next    
  EndSelect
  
  CopyImageData(nDestImage, *DestMem)
  
  FreeMemory(*SrcMem)
  FreeMemory(*DestMem)
  
  ProcedureReturn nDestImage 
  
  
  lbl_FlipImage_Alloc_ERR:
  ; check if one was successfull and free it
  If *SrcMem <> 0 : FreeMemory(*SrcMem) : EndIf
  If *DestMem <> 0 : FreeMemory(*DestMem) : EndIf
  
  ; image was already created, free it
  FreeImage(nDestImage)
  
  lbl_FlipImage_ERR: 
  ProcedureReturn 0
  
EndProcedure

Procedure.i MirrorImage(nSrcImage)
  
  ; Mirror horizontally a 24/32 bit image preserving the alpha-channel
  
  ; This one uses the DrawingBuffer() ability to work with images available in PB 4.40
  
  Protected *tRGBAs.T_RGBA, *tRGBAd.T_RGBA, tPixel.T_RGBA, iType
  Protected *SrcMem, *DestMem, iBufferPitchSrc, iBufferPitchDest 
  Protected iSrcWidth, iSrcHeight, iDestWidth, iDestHeight, nDestImage
  Protected iX, iY
  Protected iBitPlanes
  
  ; sanity checks
  If IsImage(nSrcImage) = 0
    ProcedureReturn 0
  EndIf
  
  iBitPlanes = ImageDepth(nSrcImage)
  
  If iBitPlanes <> 24 And iBitPlanes <> 32
    ProcedureReturn 0
  EndIf 
  
  iSrcWidth = ImageWidth(nSrcImage)
  iSrcHeight = ImageHeight(nSrcImage)
  
  iDestWidth = iSrcWidth
  iDestHeight = iSrcHeight
  
  
  ; create 24/32 bit destination image  
  nDestImage = CreateImage(#PB_Any, iDestWidth, iDestHeight, iBitPlanes)
  JMP_IF_ZERO (nDestImage, lbl_MirrorImage_ERR)
  
  ; copy src image to allocated memory
  *SrcMem = AllocateImageData(nSrcImage, @iBufferPitchSrc)
  JMP_IF_ZERO (*SrcMem, lbl_MirrorImage_Alloc_ERR)
  
  ; copy dest image to allocated memory 
  *DestMem = AllocateImageData(nDestImage, @iBufferPitchDest)
  JMP_IF_ZERO (*DestMem,lbl_MirrorImage_Alloc_ERR)
  
  Select iBitPlanes
    Case 24
      For iY = 0 To iDestHeight - 1 
        For iX = 0 To iDestWidth - 1
          CopyPixel24 (iSrcWidth - iX - 1, iY, iX, iY, iBufferPitchSrc, iBufferPitchDest, *tRGBAs, *tRGBAd, *SrcMem, *DestMem)      
        Next
      Next    
    Case 32
      For iY = 0 To iDestHeight - 1 
        For iX = 0 To iDestWidth - 1
          CopyPixel32 (iSrcWidth - iX - 1, iY, iX, iY, iBufferPitchSrc, iBufferPitchDest, *tRGBAs, *tRGBAd, *SrcMem, *DestMem)      
        Next
      Next    
  EndSelect
  
  CopyImageData(nDestImage, *DestMem)
  
  FreeMemory(*SrcMem)
  FreeMemory(*DestMem)
  
  ProcedureReturn nDestImage 
  
  lbl_MirrorImage_Alloc_ERR:
  ; check if one was successfull and free it
  If *SrcMem <> 0 : FreeMemory(*SrcMem) : EndIf
  If *DestMem <> 0 : FreeMemory(*DestMem) : EndIf
  
  ; image was already created, free it
  FreeImage(nDestImage)
  
  lbl_MirrorImage_ERR: 
  ProcedureReturn 0
  
EndProcedure
All times are UTC+01:00
Page 1 of 3

Powered by phpBB® Forum Software © phpBB Limited