PureBasic Forums - English

Posted: **Thu Jan 28, 2016 2:19 am**

Hello everyone,

I'm going to release many source code some of them will be from me some other, like this one, are from various authors. I'm releasing them back on the forum in hope they can be useful.

Best regards
StarBootics

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : ProgressBarEx - Module
; File Name : ProgressBarEx - Module.pb
; File version: 1.0.0
; Programming : OK
; Programmed by : StarBootics
; Date : 27-01-2016
; Last Update : 27-01-2016
; PureBasic code : V5.41 LTS
; Platform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; This code was originally created by two 
; different authors. David and Le Soldat Inconnu
;
; I deserve credit only to convert the original 
; code into a Module.
;
; This code is free to be use where ever you like 
; but you use it at your own risk.
;
; The authors can in no way be held responsible 
; for data loss, damage or other annoying 
; situations that may occur.
;
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

DeclareModule ProgressBarEx
  
  Declare Refresh(GadgetID, Progression.l)
  Declare Gadget(GadgetID, X, Y, Largeur, Hauteur, Progression.l)
  Declare SetBackGroundColors(GadgetID, BGStartColor.l, BGEndColor.l)
  Declare SetTextColors(GadgetID, TextStartColor.l, TextEndColor.l)
  Declare SetBorderColor(GadgetID, BorderColor.l)
  Declare SetBackColor(GadgetID, BackColor.l)
  Declare SetGradiantMode(GadgetID, GradiantMode.l)
  Declare SetFont(GadgetID, FontName.s)
  Declare SetUserData(GadgetID, P_UserData.i)
  Declare.i GetUserData(GadgetID)
  Declare Free(GadgetID)
  
EndDeclareModule

Module ProgressBarEx
  
  Structure ProgressBarEx
    
    FontName.s
    Width.l
    Height.l
    BorderColor.l
    BackColor.l
    BGColor01.l
    BGColor02.l
    TextColor01.l
    TextColor02.l
    GradiantMode.l
    State.l
    ImageHandle.l
    FontHandle.l
    UserData.i
    
  EndStructure
  
  Procedure.i CreateNewProgressBarEx()
    
    *ProgressBarExA.ProgressBarEx = AllocateMemory(SizeOf(ProgressBarEx))
    
    If *ProgressBarExA = #Null
      MessageRequester("Fatal Error", "CreateNewProgressBarEx() - Impossible to Allocate Memory !")
      End
    EndIf
    
    ProcedureReturn *ProgressBarExA
  EndProcedure
  
  Procedure Refresh(GadgetID, Progression.l)
    
    *ProgressBarExA.ProgressBarEx = GetGadgetData(GadgetID)
    
    If *ProgressBarExA <> #Null
      
      *ProgressBarExA\State = Progression
      
      If StartDrawing(ImageOutput(*ProgressBarExA\ImageHandle))
        
        Box(0, 0, *ProgressBarExA\Width, *ProgressBarExA\Height, *ProgressBarExA\BackColor)
        
        DrawingMode(#PB_2DDrawing_Gradient)
        
        FrontColor(*ProgressBarExA\BGColor01)
        BackColor(*ProgressBarExA\BGColor02)
        
        If *ProgressBarExA\GradiantMode = 0
          LinearGradient(*ProgressBarExA\Width, *ProgressBarExA\Height, 1, *ProgressBarExA\Height)
        ElseIf *ProgressBarExA\GradiantMode = 1
          LinearGradient(1, *ProgressBarExA\Height, 1, 1)
        EndIf
        
        Box(1, 1, Int(Progression * ((*ProgressBarExA\Width - 2) / 100)), *ProgressBarExA\Height, *ProgressBarExA\BackColor)
        
        If IsFont(*ProgressBarExA\FontHandle)
          DrawingFont(FontID(*ProgressBarExA\FontHandle))
        Else
          DrawingFont(#PB_Default)
        EndIf
        
        FormatedProgression.s = Str(Progression) + " %"
        TextHeight = TextHeight(FormatedProgression) 
        TextWidth = TextWidth(FormatedProgression) 
        
        FrontColor(*ProgressBarExA\TextColor01)
        BackColor(*ProgressBarExA\TextColor02)
        
        LinearGradient(*ProgressBarExA\Width - ((*ProgressBarExA\Width - TextWidth) >> 1), *ProgressBarExA\Height, (*ProgressBarExA\Width - TextWidth) >> 1, *ProgressBarExA\Height) 
        DrawRotatedText((*ProgressBarExA\Width - TextWidth) >> 1, (*ProgressBarExA\Height - TextHeight) >> 1, FormatedProgression, 0) 
        
        DrawingMode(#PB_2DDrawing_Outlined)
        Box(0, 0, *ProgressBarExA\Width, *ProgressBarExA\Height, *ProgressBarExA\BackColor)
        
        StopDrawing()
        
      EndIf
      
      SetGadgetState(GadgetID, ImageID(*ProgressBarExA\ImageHandle))
      
    EndIf
    
  EndProcedure
  
  Procedure Gadget(GadgetID, X, Y, Largeur, Hauteur, Progression.l)
    
    *ProgressBarA.ProgressBarEx = CreateNewProgressBarEx()
    
    *ProgressBarA\Width = Largeur
    *ProgressBarA\Height = Hauteur
    *ProgressBarA\BorderColor = RGB(0, 0, 255)
    *ProgressBarA\BackColor = RGB(0, 0, 0)
    *ProgressBarA\BGColor01 = RGB(255, 0, 0)
    *ProgressBarA\BGColor02 = RGB(255, 190, 0)
    *ProgressBarA\TextColor01 = RGB(255, 0, 0)
    *ProgressBarA\TextColor02 = RGB(0, 0, 255)
    *ProgressBarA\GradiantMode = 0
    *ProgressBarA\State = Progression
    
    *ProgressBarA\ImageHandle = CreateImage(#PB_Any, Largeur, Hauteur)
    
    CompilerSelect #PB_Compiler_OS
        
      CompilerCase #PB_OS_Windows 
        *ProgressBarA\FontName = "Cambria"
        *ProgressBarA\FontHandle = LoadFont(#PB_Any, *ProgressBarA\FontName, Hauteur >> 1, #PB_Font_HighQuality | #PB_Font_Bold)
        
      CompilerCase #PB_OS_Linux
        *ProgressBarA\FontName = "Mint Spirit"
        *ProgressBarA\FontHandle = LoadFont(#PB_Any, *ProgressBarA\FontName, Hauteur >> 1, #PB_Font_Bold)
        
      CompilerCase #PB_OS_MacOS
        *ProgressBarA\FontName = "Cantarell"
        *ProgressBarA\FontHandle = LoadFont(#PB_Any, *ProgressBarA\FontName, Hauteur >> 1, #PB_Font_Bold)
        
    CompilerEndSelect
    
    GadgetHandle = ImageGadget(GadgetID, X, Y, Largeur, Hauteur, ImageID(*ProgressBarA\ImageHandle))
    
    If GadgetID = #PB_Any
      GadgetID = GadgetHandle
    EndIf
    
    SetGadgetData(GadgetID, *ProgressBarA)
    Refresh(GadgetID, Progression)
    
    ProcedureReturn GadgetID
  EndProcedure
  
  Procedure SetBackGroundColors(GadgetID, BGStartColor.l, BGEndColor.l)
    
    If IsGadget(GadgetID)
      
      *ProgressBarExA.ProgressBarEx = GetGadgetData(GadgetID)
      
      If *ProgressBarExA <> #Null
        *ProgressBarExA\BGColor01 = BGStartColor
        *ProgressBarExA\BGColor02 = BGEndColor
        Refresh(GadgetID, *ProgressBarExA\State)
      EndIf
      
    EndIf
    
  EndProcedure
  
  
  Procedure SetTextColors(GadgetID, TextStartColor.l, TextEndColor.l)
    
    If IsGadget(GadgetID)
      
      *ProgressBarExA.ProgressBarEx = GetGadgetData(GadgetID)
      
      If *ProgressBarExA <> #Null
        *ProgressBarExA\TextColor01 = TextStartColor
        *ProgressBarExA\TextColor02 = TextEndColor
        Refresh(GadgetID, *ProgressBarExA\State)
      EndIf
      
    EndIf
    
  EndProcedure
  
  Procedure SetBorderColor(GadgetID, BorderColor.l)
    
    If IsGadget(GadgetID)
      
      *ProgressBarExA.ProgressBarEx = GetGadgetData(GadgetID)
      
      If *ProgressBarExA <> #Null
        *ProgressBarExA\BorderColor = BorderColor
        Refresh(GadgetID, *ProgressBarExA\State)
      EndIf
      
    EndIf
    
  EndProcedure
  
  Procedure SetBackColor(GadgetID, BackColor.l)
    
    If IsGadget(GadgetID)
      
      *ProgressBarExA.ProgressBarEx = GetGadgetData(GadgetID)
      
      If *ProgressBarExA <> #Null
        *ProgressBarExA\BackColor = BackColor
        Refresh(GadgetID, *ProgressBarExA\State)
      EndIf
      
    EndIf
    
  EndProcedure
  
  Procedure SetGradiantMode(GadgetID, GradiantMode.l)
    
    If IsGadget(GadgetID)
      
      *ProgressBarExA.ProgressBarEx = GetGadgetData(GadgetID)
      
      If *ProgressBarExA <> #Null
        
        If GradiantMode <= 0
          *ProgressBarExA\GradiantMode = 0
        ElseIf GradiantMode >= 1
          *ProgressBarExA\GradiantMode = 1
        EndIf
        
        Refresh(GadgetID, *ProgressBarExA\State)
        
      EndIf
      
    EndIf
    
  EndProcedure
  
  Procedure SetFont(GadgetID, FontName.s)
    
    If IsGadget(GadgetID)
      
      *ProgressBarExA.ProgressBarEx = GetGadgetData(GadgetID)
      
      If *ProgressBarExA <> #Null
        
        If *ProgressBarExA\FontHandle <> #Null
          FreeFont(*ProgressBarExA\FontHandle)
        EndIf
        
        *ProgressBarExA\FontName = FontName
        
        CompilerIf #PB_Compiler_OS = #PB_OS_Windows 
          *ProgressBarExA\FontHandle = LoadFont(#PB_Any, *ProgressBarExA\FontName, *ProgressBarExA\Height >> 1, #PB_Font_HighQuality | #PB_Font_Bold)
        CompilerElse
          *ProgressBarExA\FontHandle = LoadFont(#PB_Any, *ProgressBarExA\FontName, *ProgressBarExA\Height >> 1, #PB_Font_Bold)
        CompilerEndIf
        
        Refresh(GadgetID, *ProgressBarExA\State)
        
      EndIf
      
    EndIf
    
  EndProcedure
  
  Procedure SetUserData(GadgetID, P_UserData.i)
    
    If IsGadget(GadgetID)
      
      *ProgressBarA.ProgressBarEx = GetGadgetData(GadgetID)
      
      If *ProgressBarA <> #Null
        *ProgressBarA\UserData = P_UserData
      EndIf
      
    EndIf
    
  EndProcedure
  
  Procedure.i GetUserData(GadgetID)
    
    If IsGadget(GadgetID)
      
      *ProgressBarA.ProgressBarEx = GetGadgetData(GadgetID)
      
      If *ProgressBarA <> #Null
        P_UserData.i = *ProgressBarA\UserData
      EndIf
      
    EndIf
    
    ProcedureReturn P_UserData
  EndProcedure
  
  Procedure Free(GadgetID)
    
    If IsGadget(GadgetID)
      
      *ProgressBarA.ProgressBarEx = GetGadgetData(GadgetID)
      
      If *ProgressBarA <> #Null
        
        *ProgressBarA\FontName = ""
        *ProgressBarA\Width = 0
        *ProgressBarA\Height = 0
        *ProgressBarA\BorderColor = 0
        *ProgressBarA\BackColor = 0
        *ProgressBarA\BGColor01 = 0
        *ProgressBarA\BGColor02 = 0
        *ProgressBarA\TextColor01 = 0
        *ProgressBarA\TextColor02 = 0
        *ProgressBarA\GradiantMode = 0
        *ProgressBarA\State = 0
        
        If IsImage(*ProgressBarA\ImageHandle)
          FreeImage(*ProgressBarA\ImageHandle)
          *ProgressBarA\ImageHandle = 0
        EndIf
        
        If IsFont(*ProgressBarA\FontHandle)
          FreeFont(*ProgressBarA\FontHandle)
          *ProgressBarA\FontHandle = 0
        EndIf
        
        *ProgressBarA\UserData = 0
        
        FreeMemory(*ProgressBarA)
        FreeGadget(GadgetID)
        
      EndIf   
      
    EndIf
    
  EndProcedure
  
EndModule

CompilerIf #PB_Compiler_IsMainFile
  
  ToolBoxFile "Gadget Locate - Module.pb"
  
  If OpenWindow(0, 0, 0, 400, 300, "ProgressBarGadgetEx", #PB_Window_SystemMenu | #PB_Window_ScreenCentered) 
    
    ProgressBarEx::Gadget(0, 5, 50, 390, 30, 0) 
    
    
    ProgressBarEx::Gadget(1, 5, GadgetLocate::DownOf(0, 5), 390, 30, 0)
    ProgressBarEx::SetBackGroundColors(1, RGB(000, 000, 255), RGB(000, 255, 000))
    ProgressBarEx::SetGradiantMode(1, 1)
    
    TrackBarGadget(2, 5, GadgetLocate::DownOf(1, 5), 390, 25, 0, 100) 
    SetGadgetState(2, 0)
    
    Repeat
      
      EventID = WaitWindowEvent()
      
      Select EventID
          
        Case #PB_Event_Gadget
          
          Select EventGadget()
              
            Case 2
              ProgressBarEx::Refresh(0, GetGadgetState(2)) 
              ProgressBarEx::Refresh(1, GetGadgetState(2)) 
              
          EndSelect
          
      EndSelect
      
    Until EventID = #PB_Event_CloseWindow
    
    ProgressBarEx::Free(0)
    ProgressBarEx::Free(1)
    
  EndIf
 
CompilerEndIf

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

Posted: **Thu Jan 28, 2016 4:51 am**

What does this do?

Code: Select all

ToolBoxFile "Gadget Locate - Module.pb"

Posted: **Thu Jan 28, 2016 6:35 am**

Demivec wrote:What does this do?
Code: Select all
ToolBoxFile "Gadget Locate - Module.pb"

It will include this file :

Code: Select all

DeclareModule GadgetLocate
  
  Declare DownOf(GadgetID, Gap = 0)
  Declare RightOf(GadgetID, Gap = 0)
  
EndDeclareModule

Module GadgetLocate
  
  Procedure DownOf(GadgetID, Gap = 0)
    
    ProcedureReturn (GadgetY(GadgetID) + GadgetHeight(GadgetID) + (Gap))
  EndProcedure
  
  Procedure RightOf(GadgetID, Gap = 0)
    
    ProcedureReturn (GadgetX(GadgetID) + GadgetWidth(GadgetID) + (Gap))
  EndProcedure
  
EndModule

Sorry, my bad I didn't pay attention when I have posted my code. That said you should take a look here :
http://www.purebasic.fr/english/viewtop ... 14&t=49190

Best regards
StarBootics

Posted: **Thu Jan 28, 2016 11:57 am**

Without "ToolBoxFile "Gadget Locate - Module.pb" line
"http://pages.videotron.com/gsaumure/fil ... r_V104.zip" link of GUIMAUVE are broken
The progressBar works fine on W7
Thanks

PureBasic Forums - English

ProgressBarEx - Module

ProgressBarEx - Module

Re: ProgressBarEx - Module

Re: ProgressBarEx - Module

Re: ProgressBarEx - Module