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