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 <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

