Sorry to reopen a very old topic but I have completely rebuilt the original code of the LEDGadget(). I
have suppress the Global LinkedList used to store the Gadget related informations and I have make
them compatible with the use of #PB_Any for the GadgetID. The Gadget can be used like any other
standard Gadget. By the way I have change the name to TaskMeterGadget().
Since the code only use PureBasic internal drawing command so the code should run on all platforms
without any problems.
Edit : V1.0.3
- UserData added
Best regards.
Guimauve
Code: Select all
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; AUTOMATICALLY GENERATED CODE, DO NOT MODIFY
; UNLESS YOU REALLY, REALLY, REALLY MEAN IT !!
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Code generated by : Dev-Type V3.159.723
; Project name : TaskMeterGadget
; File Name : TaskMeterGadget.pb
; File version: 1.0.3
; Programming : OK
; Programmed by : Guimauve
; Creation Date : 11-05-2012
; Last update : 17-05-2012
; Coded for PureBasic V4.61
; Platform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Structure declaration <<<<<
Structure TaskMeter
Width.l
Height.l
State.l
Ticks.l ; Special, Increment
OnColor.l
OffColor.l
ImageHandle.l
UserData.i
EndStructure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The observators <<<<<
Macro GetTaskMeterWidth(TaskMeterA)
TaskMeterA\Width
EndMacro
Macro GetTaskMeterHeight(TaskMeterA)
TaskMeterA\Height
EndMacro
Macro GetTaskMeterState(TaskMeterA)
TaskMeterA\State
EndMacro
Macro GetTaskMeterTicks(TaskMeterA)
TaskMeterA\Ticks
EndMacro
Macro GetTaskMeterOnColor(TaskMeterA)
TaskMeterA\OnColor
EndMacro
Macro GetTaskMeterOffColor(TaskMeterA)
TaskMeterA\OffColor
EndMacro
Macro GetTaskMeterImageHandle(TaskMeterA)
TaskMeterA\ImageHandle
EndMacro
Macro GetTaskMeterUserData(TaskMeterA)
TaskMeterA\UserData
EndMacro
; <<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The mutators <<<<<
Macro SetTaskMeterWidth(TaskMeterA, P_Width)
GetTaskMeterWidth(TaskMeterA) = P_Width
EndMacro
Macro SetTaskMeterHeight(TaskMeterA, P_Height)
GetTaskMeterHeight(TaskMeterA) = P_Height
EndMacro
Macro SetTaskMeterState(TaskMeterA, P_State)
GetTaskMeterState(TaskMeterA) = P_State
EndMacro
Macro SetTaskMeterTicks(TaskMeterA, P_Ticks)
GetTaskMeterTicks(TaskMeterA) = P_Ticks
EndMacro
Macro SetTaskMeterOnColor(TaskMeterA, P_OnColor)
GetTaskMeterOnColor(TaskMeterA) = P_OnColor
EndMacro
Macro SetTaskMeterOffColor(TaskMeterA, P_OffColor)
GetTaskMeterOffColor(TaskMeterA) = P_OffColor
EndMacro
Macro SetTaskMeterImageHandle(TaskMeterA, P_ImageHandle)
GetTaskMeterImageHandle(TaskMeterA) = P_ImageHandle
EndMacro
Macro SetTaskMeterUserData(TaskMeterA, P_UserData)
GetTaskMeterUserData(TaskMeterA) = P_UserData
EndMacro
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The specials operators <<<<<
Macro IncrementTaskMeterTicks(TaskMeterA, P_Increment = 1)
SetTaskMeterTicks(TaskMeterA, GetTaskMeterTicks(TaskMeterA) + P_Increment)
EndMacro
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Reset operator <<<<<
Macro ResetTaskMeter(TaskMeterA)
SetTaskMeterWidth(TaskMeterA, 0)
SetTaskMeterHeight(TaskMeterA, 0)
SetTaskMeterState(TaskMeterA, 0)
SetTaskMeterTicks(TaskMeterA, 0)
SetTaskMeterOnColor(TaskMeterA, 0)
SetTaskMeterOffColor(TaskMeterA, 0)
If GetTaskMeterImageHandle(TaskMeterA) <> #Null
FreeImage(GetTaskMeterImageHandle(TaskMeterA))
SetTaskMeterImageHandle(TaskMeterA, 0)
EndIf
SetTaskMeterUserData(TaskMeterA, 0)
EndMacro
; <<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Constructor <<<<<
Procedure.i CreateNewTaskMeter()
*TaskMeterA.TaskMeter = AllocateMemory(SizeOf(TaskMeter))
If *TaskMeterA = #Null
MessageRequester("Fatal Error", "CreateNewTaskMeter() - Impossible to Allocate Memory !")
End
EndIf
ProcedureReturn *TaskMeterA
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Code generated in : 00.011 seconds (16181.82 lines/second) <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Procedure TaskMeterGadget(GadgetID.l, x.l, y.l, Width.l, Height.l, OnColor.l, OffColor.l)
*TaskMeterA.TaskMeter = CreateNewTaskMeter()
If *TaskMeterA <> #Null
SetTaskMeterWidth(*TaskMeterA, Width)
SetTaskMeterHeight(*TaskMeterA, Height)
SetTaskMeterImageHandle(*TaskMeterA, CreateImage(#PB_Any, Width, Height))
SetTaskMeterOnColor(*TaskMeterA, OnColor)
SetTaskMeterOffColor(*TaskMeterA, OffColor)
SetTaskMeterTicks(*TaskMeterA, 1)
If IsImage(GetTaskMeterImageHandle(*TaskMeterA))
LED_Height = GetTaskMeterHeight(*TaskMeterA) - 20
LED_Width = (GetTaskMeterWidth(*TaskMeterA) - 11) >> 1
If StartDrawing(ImageOutput(GetTaskMeterImageHandle(*TaskMeterA)))
Box(0,0, Width, Height, 0)
For a = 0 To LED_Height Step 4
IncrementTaskMeterTicks(*TaskMeterA)
Box(5, a, LED_Width, 3, GetTaskMeterOffColor(*TaskMeterA))
Box(LED_Width + 6, a, LED_Width, 3, GetTaskMeterOffColor(*TaskMeterA))
Next
Str_Percent.s = "0%"
Box(0, Height - TextHeight(Str_Percent), Width, TextHeight(Str_Percent), 0)
DrawText((Width - TextWidth(Str_Percent)) >> 1, Height - TextHeight(Str_Percent), Str_Percent, GetTaskMeterOnColor(*TaskMeterA), 0)
StopDrawing()
EndIf
EndIf
GadgetHandle = ImageGadget(GadgetID, x, y, width, height, ImageID(GetTaskMeterImageHandle(*TaskMeterA)), #PB_Image_Border)
If GadgetID = #PB_Any
GadgetID = GadgetHandle
EndIf
SetGadgetData(GadgetID, *TaskMeterA)
EndIf
ProcedureReturn GadgetID
EndProcedure
Procedure SetTaskMeterGadgetState(GadgetID.l, Percent.l)
If IsGadget(GadgetID)
*TaskMeterA.TaskMeter = GetGadgetData(GadgetID)
If *TaskMeterA <> #Null
SetTaskMeterState(*TaskMeterA, Percent)
LED_Height = GetTaskMeterHeight(*TaskMeterA) - 20
LED_Width = (GetTaskMeterWidth(*TaskMeterA) - 11) >> 1
FinalResult = GetTaskMeterTicks(*TaskMeterA) - Round((Percent/100) * GetTaskMeterTicks(*TaskMeterA), 1)
If StartDrawing(ImageOutput(GetTaskMeterImageHandle(*TaskMeterA)))
TickCount = 0
For a = 0 To LED_Height Step 4
TickCount = TickCount + 1
If TickCount >= FinalResult
Box(5, a, LED_Width,3,GetTaskMeterOnColor(*TaskMeterA))
Box(LED_Width + 6, a, LED_Width, 3, GetTaskMeterOnColor(*TaskMeterA))
Else
Box(5, a, LED_Width, 3, GetTaskMeterOffColor(*TaskMeterA))
Box(LED_Width + 6, a, LED_Width, 3, GetTaskMeterOffColor(*TaskMeterA))
EndIf
Next
Str_Percent.s = Str(Percent) + "%"
Box(0, GetTaskMeterHeight(*TaskMeterA) - TextHeight(Str_Percent), GetTaskMeterWidth(*TaskMeterA), TextHeight(Str_Percent), 0)
DrawText((GetTaskMeterWidth(*TaskMeterA) - TextWidth(Str_Percent)) >> 1, GetTaskMeterHeight(*TaskMeterA) - TextHeight(Str_Percent), Str_Percent, GetTaskMeterOnColor(*TaskMeterA), 0)
StopDrawing()
SetGadgetState(GadgetID, ImageID(GetTaskMeterImageHandle(*TaskMeterA)))
EndIf
EndIf
EndIf
EndProcedure
Procedure.l GetTaskMeterGadgetState(GadgetID.l)
If IsGadget(GadgetID)
*TaskMeterA.TaskMeter = GetGadgetData(GadgetID)
If *TaskMeterA <> #Null
CurrentState = GetTaskMeterState(*TaskMeterA)
EndIf
EndIf
ProcedureReturn CurrentState
EndProcedure
Procedure SetTaskMeterGadgetColors(GadgetID.l, OnColor.l, OffColor.l)
If IsGadget(GadgetID)
*TaskMeterA.TaskMeter = GetGadgetData(GadgetID)
If *TaskMeterA <> #Null
If OnColor <> -1
SetTaskMeterOnColor(*TaskMeterA, OnColor)
EndIf
If OffColor <> -1
SetTaskMeterOffColor(*TaskMeterA, OffColor)
EndIf
EndIf
EndIf
EndProcedure
Procedure SetTaskMeterGadgetData(GadgetID, P_UserData.i)
If IsGadget(GadgetID)
*TaskMeterA.TaskMeter = GetGadgetData(GadgetID)
If *TaskMeterA <> #Null
SetTaskMeterUserData(*TaskMeterA, P_UserData)
EndIf
EndIf
EndProcedure
Procedure.i GetTaskMeterGadgetData(GadgetID)
If IsGadget(GadgetID)
*TaskMeterA.TaskMeter = GetGadgetData(GadgetID)
If *TaskMeterA <> #Null
P_UserData.i = GetTaskMeterUserData(*TaskMeterA)
EndIf
EndIf
ProcedureReturn P_UserData
EndProcedure
Procedure FreeTaskMeterGadget(GadgetID.l)
If IsGadget(GadgetID)
*TaskMeterA.TaskMeter = GetGadgetData(GadgetID)
If *TaskMeterA <> #Null
ResetTaskMeter(*TaskMeterA)
FreeMemory(*TaskMeterA)
FreeGadget(GadgetID)
EndIf
EndIf
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< !!! WARNING - YOU ARE NOW IN A TESTING ZONE - WARNING !!! <<<<<
; <<<<< !!! WARNING - THIS CODE SHOULD BE COMMENTED - WARNING !!! <<<<<
; <<<<< !!! WARNING - BEFORE THE FINAL COMPILATION. - WARNING !!! <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Macro GadgetRight(GadgetID, Gap = 0)
GadgetX(GadgetID) + GadgetWidth(GadgetID) + (Gap)
EndMacro
#WindowWidth = 425
#WindowHeight = 350
If OpenWindow(0, 100, 200, #WindowWidth, #WindowHeight, "Task Meter Gadget Demo", #PB_Window_MinimizeGadget)
TrackBarGadget(0, 5, #WindowHeight - 25, #WindowWidth - 10, 20, 0, 100)
TaskMeterGadget(1, 005, 5, 75, 200, RGB(255, 000, 000), RGB(127, 000, 000))
TaskMeterGadget(2, GadgetRight(1, 5), 5, 75, 225, RGB(000, 255, 000), RGB(000, 127, 000))
TaskMeterGadget(3, GadgetRight(2, 5), 5, 75, 250, RGB(255, 000, 128), RGB(127, 000, 064))
TaskMeterGadget(4, GadgetRight(3, 5), 5, 75, 275, RGB(255, 255, 000), RGB(127, 127, 000))
TaskMeterGadget(5, GadgetRight(4, 5), 5, 75, 300, RGB(000, 127, 255), RGB(000, 064, 127))
Repeat
EventID = WaitWindowEvent()
Select EventID
Case #PB_Event_Gadget
Select EventGadget()
Case 0
SetTaskMeterGadgetState(1, GetGadgetState(0))
SetTaskMeterGadgetState(2, GetGadgetState(0))
SetTaskMeterGadgetState(3, GetGadgetState(0))
SetTaskMeterGadgetState(4, GetGadgetState(0))
SetTaskMeterGadgetState(5, GetGadgetState(0))
EndSelect
EndSelect
Until EventID = #PB_Event_CloseWindow
; The FreeTaskMeterGadget() instructions are important to avoid Memory leaks.
; It's very important in the case the TaskMeterGadget() is used inside a Prompt
; or a PopUp Windows, otherwise it's not necessary to use them.
FreeTaskMeterGadget(1)
FreeTaskMeterGadget(2)
FreeTaskMeterGadget(3)
FreeTaskMeterGadget(4)
FreeTaskMeterGadget(5)
EndIf
; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<