Announcement

Collapse
No announcement yet.

Progress Bar

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Progress Bar

    I need to add a progress bar to a processing routine.
    I have it in the Dialog (with PBForms). , but can't up-date it.
    The main program has a "for 1 to 10" where I could add the up-date
    to the Progress Bar.
    The function now looks like:

    FUNCTION SampleProgress(BYVAL hDlg AS DWORD, BYVAL lID AS LONG) AS LONG
    CONTROL SEND hDlg, lID, %PBM_SETRANGE, 0, MAKDWD(0,100)
    CONTROL SEND hDlg, lID, %PBM_SETPOS, 50, 0
    END FUNCTION
    This is the CASE in the main callback:
    CASE %IDC_MSCTLS_PROGRESS32_1
    Obviously, I'm trying to learn
    Thanks, Dick


    ------------------

  • #2
    >case %idc_msctls_progress32_1

    normally you would never handle a message to the progress bar yourself, unless you wanted to owner-draw it or override the default behavior.

    here is a demo of using a progress bar...
    progress bar dialog for pb/cc programs october 24, 2002

    (don't try to use that 'as is'; that's just to show how you update the bar by sending it messages)

    and because i think they are handy, some macros i developed:
    Code:
    macro progressbar_setrange    (hctrl, pmin, pmax)  =  sendmessage hctrl, %pbm_setrange, 0, maklng(pmin, pmax)
    macro progressbar_setstep     (hctrl, istep)       =  sendmessage hctrl, %pbm_setstep, istep, 0
    macro progressbar_setbarcolor (hctrl, rgbcolor)    =  sendmessage hctrl, %pbm_setbarcolor, 0, rgbcolor
    macro progressbar_setbkcolor  (hctrl, rgbcolor)    =  sendmessage hctrl, %pbm_setbkcolor,  0, rgbcolor
    macro progressbar_setpos      (hctrl, newpos)      =  sendmessage hctrl, %pbm_setpos, newpos, 0
    macro progressbar_step        (hctrl)              =  sendmessage hctrl, %pbm_stepit, 0, 0

    you have basically two ways to use the progess bar. based on application, you either:

    -send the bar a "setpos" command.
    or
    - set the bar's 'step amount' and then one (1) "step" command for each increment passed.

    example: if you set your bar range from 0 to 100 you can..

    1. set a 'step value' of one (1), and send one (1) "step" command for each one (1) percent of the job which has been completed
    or
    2. do not set a step value; instead, when you discover the job is 40 percent done, you do a "setpos" to 40

    mcm


    Michael Mattias
    Tal Systems (retired)
    Port Washington WI USA
    [email protected]
    http://www.talsystems.com

    Comment


    • #3
      Dick,
      here is a little example...

      Pierre

      Code:
      #COMPILE EXE '#Win 8.01#
      #REGISTER NONE
      #INCLUDE "Win32Api.inc" '#2005-01-27#
      #INCLUDE "COMMCTRL.INC"
      OPTION EXPLICIT
       
      GLOBAL hDlg AS DWORD
       
      %ProgressBar01 = 101
      %ButtonStep    = 201
      %ButtonRead    = 202
      %ButtonSetTo3  = 203
      %LabelInfo     = 401
      '______________________________________________________________________________
       
      CALLBACK FUNCTION DlgProc
       LOCAl BarWidth AS LONG
       LOCAl BarPos   AS LONG 
       LOCAl Retval   AS LONG 
       
       SELECT CASE CBMSG
       
         CASE %WM_INITDIALOG
           BarWidth = 11
           CONTROL SEND hDlg, %ProgressBar01, %PBM_SETRANGE, 0, MAKLNG(0, BarWidth)
           CONTROL SEND hDlg, %ProgressBar01, %PBM_SETSTEP, 1, 0  
           BarPos = 5
           CONTROL SEND hDlg, %ProgressBar01, %PBM_SETPOS, BarPos, 0     
           CONTROL SET TEXT hDlg, %LabelInfo, "Position is" & STR$(BarPos)
       
         CASE %WM_COMMAND
           SELECT CASE LOWRD(CBWPARAM)
       
             CASE %ButtonStep
               IF CBCTLMSG = %BN_CLICKED THEN
                 CONTROL SEND hDlg, %ProgressBar01, %PBM_STEPIT, 0, 0
                 CONTROL SEND hDlg, %ProgressBar01, %PBM_GETPOS, 0, 0 TO Retval
                 CONTROL SET TEXT hDlg, %LabelInfo, "Position is" & STR$(Retval)
               END IF
       
             CASE %ButtonSetTo3
               IF CBCTLMSG = %BN_CLICKED THEN
                 CONTROL SEND hDlg, %ProgressBar01, %PBM_SETPOS, 3, 0
                 CONTROL SET TEXT hDlg, %LabelInfo, "Position is 3"
             END IF  
       
             CASE %ButtonRead
               IF CBCTLMSG = %BN_CLICKED THEN
                 CONTROL SEND hDlg, %ProgressBar01, %PBM_GETPOS, 0, 0 TO Retval
                 CONTROL SET TEXT hDlg, %LabelInfo, "Position read is" & STR$(Retval)
             END IF  
       
           END SELECT
       
        END SELECT
       
      END FUNCTION
      '______________________________________________________________________________
       
      FUNCTION PBMAIN()
       LOCAL icc AS INIT_COMMON_CONTROLSEX
       
       'Initialize progress bar
       icc.dwICC  = %ICC_PROGRESS_CLASS
       icc.dwSize = SIZEOF(icc)
       InitCommonControlsEx icc
       
       DIALOG NEW 0 ,"Progress bar", , , 200, 55, %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU, 0 TO hDlg
       SetClassLong hDlg, %GCL_HICON, LoadIcon(BYVAL %NULL, BYVAL %IDI_INFORMATION) 'For dialog icon
       
       CONTROL ADD "MsCtls_Progress32", hDlg, %ProgressBar01, "", 5, 5, 190, 12, _
                   %WS_CHILD OR %WS_VISIBLE OR %WS_BORDER 'OR %PBS_SMOOTH '%PBS_SMOOTH for undotted bar
       CONTROL ADD LABEL,   hDlg, %LabelInfo, "Position", 5, 20, 60,  8
       CONTROL ADD BUTTON,  hDlg, %ButtonStep, "Step", 5, 35, 35, 12
       CONTROL ADD BUTTON,  hDlg, %ButtonSetTo3, "Set to 3", 85, 35, 35, 12
       CONTROL ADD BUTTON,  hDlg, %ButtonRead, "Read", 160, 35, 35, 12
       
       DIALOG SHOW MODAL hDlg CALL DlgProc
       
      END FUNCTION
      '______________________________________________________________________________

      Comment


      • #4
        I have a multi-threaded app that uses up to 10 progress bars....

        I use the handle, works good.

        Code:
        %ID_PROGRESS1 = %WM_USER + 511
        %ID_PROGRESS2 = %WM_USER + 512
        %ID_PROGRESS3 = %WM_USER + 513
        %ID_PROGRESS4 = %WM_USER + 514
        %ID_PROGRESS5 = %WM_USER + 515
        %ID_PROGRESS6 = %WM_USER + 516
        %ID_PROGRESS7 = %WM_USER + 517
        %ID_PROGRESS8 = %WM_USER + 518
        %ID_PROGRESS9 = %WM_USER + 519
        %ID_PROGRESS10 = %WM_USER + 520
        
        '
        '
        Global g_ProgressHandle() As Long
        
        '
        '
        '
        ReDim g_ProgressHandle(1 To 10) As Long
        '
        '
        '
        'Create 10 progress bars as you please.
        ;
        ;
        Control Handle g_hDlg,%ID_PROGRESS1 To g_ProgressHandle(1)
        Control Handle g_hDlg,%ID_PROGRESS2 To g_ProgressHandle(2)
        Control Handle g_hDlg,%ID_PROGRESS3 To g_ProgressHandle(3)
        Control Handle g_hDlg,%ID_PROGRESS4 To g_ProgressHandle(4)
        Control Handle g_hDlg,%ID_PROGRESS5 To g_ProgressHandle(5)
        Control Handle g_hDlg,%ID_PROGRESS6 To g_ProgressHandle(6)
        Control Handle g_hDlg,%ID_PROGRESS7 To g_ProgressHandle(7)
        Control Handle g_hDlg,%ID_PROGRESS8 To g_ProgressHandle(8)
        Control Handle g_hDlg,%ID_PROGRESS9 To g_ProgressHandle(9)
        Control Handle g_hDlg,%ID_PROGRESS10 To g_ProgressHandle(10)   
        '
        '
        '
        '
        In Dialogproc:
        Select Case CbMsg
            Case %WM_INITDIALOG
                SetTimer CbHndl, %IDT_TIMER1,  2500, ByVal %NULL
                For lLoop = 1 To g_ListCount
                    SendMessage g_ProgressHandle(lLoop),%PBM_SETBARCOLOR,0,%NAVY
                    lResult = StartFileCopy(ByVal lLoop)
                Next    
        
        '
        '
        '
        'Threaded function:
        
        '------------------------------------------------------------------
        Function StartFileCopy(ByVal hDrive As Long) As Long
        Local hThread   As Long
        Local lResult As Long
        
        Thread Create ThreadProc(ByVal hDrive) To hThread
        Thread Close hThread To lResult
        'WaitForSingleObject hThread,%INFINITE
        Function = lResult
        End Function
        '------------------------------------------------------------------
        Function ThreadProc(ByVal hDrive As Long) As Long
        Local lLoop         As Long
        Local lResult       As Long
        Local ErrType       As Long
        Local sCount        As Long
        Local SourceFile    As String
        Local DestFile      As String
        Local sText         As String
        Local hTxtControl   As Long
        Local hProgCtl      As Long
        Local pbcancel      As Long
        Local FileList      As String
        Local ErrCount      As Long
        Local CurrentDrive  As String
        Local NewDrive      As String
        Local FileSize      As Double
        Local DiskSpace     As Quad
        
        Dim FilesToCopy(1 To %FILELIMIT) As String
        Sleep 250
        
        FileList = Parse$(g_Command,hDrive)
        sCount = ReadFileList(ByVal Parse$(g_Command,hDrive),FilesToCopy())
        hTxtControl = g_FileLabelHandle(hDrive)
        hProgCtl    = g_ProgressHandle(hDrive)
        SendMessage hProgCtl, %PBM_SETRANGE, 0 ,MakLng(0,sCount)
        SendMessage hProgCtl, %PBM_SETSTEP, 1, 0
        
        
        ' Thread code goes here
        For lLoop = 1 To sCount
            SourceFile = Trim$(Parse$(FilesToCopy(lLoop)," ",1))
            DestFile = Trim$(Parse$(FilesToCopy(lLoop)," ",2)) & Dir$(SourceFile)
        
            'Check if enough room on drive.
            CurrentDrive = Left$(DestFile,1)
            FileSize = GetSizeOfFile(ByVal SourceFile)
        
            CHECKDISKSPACE:
            DiskSpace = DiskFree(CurrentDrive)
            If FileSize >= DiskSpace Then
        
                Incr ErrCount
                If ErrCount = 3 Then
                    sText = "It appears there is not enough disk space on any drives to complete the task, exiting abnormally"
                    UpdateLogFile sText
                    UpdateIPMonLogFile sText
                    GoTo COMPLETED
                End If
                Select Case CurrentDrive
                    Case "D"
                        NewDrive = "E:"
                    Case "E"
                        NewDrive = "F:"
                    Case "F"
                        NewDrive = "D:"
                End Select
        
                DiskSpace = DiskFree(NewDrive)
                If FileSize >= DiskSpace Then
                    CurrentDrive = NewDrive
                    GoTo CHECKDISKSPACE
                Else
                    ErrCount = 0
                    sText = "The file: " & SourceFile & " will not fit on the " & Left$(DestFile,1) & " drive - Copying to the " &  NewDrive & " drive"
                    UpdateLogFile sText
                    UpdateIPMonLogFile sText
                    'DELETE OLD FILE FIRST so as not to have 2 of the same files in teh back up.
                    Kill DestFile
                    Mid$(DestFile,1,1) = NewDrive
                End If
            End If
        
            sText = Dir$(SourceFile)
            SendMessage hTxtControl, %WM_SETTEXT, 0, ByVal StrPtr(sText)
            SendMessage hProgCtl,%PBM_STEPIT,0,1
            'Returns zero if successful, or nonzero otherwise.
        
            lResult = ShellCopyFile(SourceFile, DestFile)
        '    lResult = CopyFileEx(ByVal StrPtr(SourceFile),  ByVal StrPtr(DestFile), ByVal %NULL, ByVal %NULL, pbCancel, ByVal %NULL)
            If IsTrue lresult Then
                sText = sText & " Failed"
                UpdateLogFile sText 'Regardless of drive etc
                ErrType = Err
                UpdateLogFile GetLastErrorDescription(ErrType)
                Function = ErrType
                Exit For
            Else
                sText = sText & " Done"
                UpdateLogFile sText 'Regardless of drive etc
                Incr g_FilesCopied
            End If
        Next
        If IsFalse lResult Then 'Success
            sText = "Done.."
            Function = %FALSE 'This will be good.
            'Clear progress bar on success
            SendMessage hProgCtl, %PBM_SETRANGE, 0 ,0
            SendMessage hProgCtl, %PBM_SETSTEP, 1, 0
            SendMessage hProgCtl,%PBM_STEPIT,0,1
            SendMessage hTxtControl, %WM_SETTEXT, 0, ByVal StrPtr(sText)
        End If
        COMPLETED:
        'Set finished flag
        g_Finished(hDrive) = %TRUE
        Erase FilesToCopy
        End Function
        '------------------------------------------------------------------


        ------------------
        Scott Turchin
        MCSE, MCP+I
        Computer Creations Software
        ----------------------
        Sometimes you give the world the best you got, and you get kicked in the teeth.
        Give the world the best you got anyway.
        - Ted Nugent (God, Guns, and Rock n' Roll)
        Scott Turchin
        MCSE, MCP+I
        http://www.tngbbs.com
        ----------------------
        True Karate-do is this: that in daily life, one's mind and body be trained and developed in a spirit of humility; and that in critical times, one be devoted utterly to the cause of justice. -Gichin Funakoshi

        Comment


        • #5
          Don't forget Borje's ultra-cool Progress Bar, easily found via POFFS.


          ------------------
          Mark Newman
          Mark Newman

          Comment


          • #6
            Thanks - I finally "get it". Dick

            Comment

            Working...
            X