Results 1 to 2 of 2

Thread: Progress Bar

  1. #1
    Join Date
    Jul 2006
    Posts
    157

    Unanswered: Progress Bar

    Hi: This is the copy of another program which shows the estimated time and percentage of works done in progress bar. The progress bar which i desigend in my program is simple count the value when it reaces to 100 it turns to zero. Can any one please help me there how to i change my progress bar with that program so that it also shows the estimated time and value of work done in percentage
    If ProgressBar1.Value >= 100 Then ProgressBar1.Value = 1
    ProgressBar1.Value = ProgressBar1.Value + 1

    Thanks.
    -----------------------------------------------------------------------
    Code:
    'COPY FROM ANOTHER PROGRAM
    Option Explicit
    Public Event CancelClicked()
    Public Event QueryUnload(Cancel As Integer)
    Public CancelClicked As Boolean
    Public PromptConfirmCancel As Boolean
    Private mProgress As Single
    Private mTitle As String
    Private mStatus As String
    Private startdate As Date
    Private AbsoluteStart As Variant
    
    Private Sub cmdCancel_Click()
      If Not PromptConfirmCancel Then
        CancelClicked = True
      Else
        If MsgBox("Are you sure you want to cancel the process?", vbYesNo, "Processing") = vbYes Then
          CancelClicked = True
        Else
          CancelClicked = False
        End If
      End If
      If CancelClicked Then RaiseEvent CancelClicked
    End Sub
    
    Private Sub Form_Initialize()
      ResetProgress
    End Sub
    
    Public Property Let Progress(nProgress As Single)
      Dim tlstring As String
      Dim telp
      Static lasttlstring As String
      On Error Resume Next
      If nProgress = 0 Then
        AbsoluteStart = Empty
      End If
      telp = ", Elapsed:" & Format(TimeSerial(0, 0, DateDiff("s", Now(), AbsoluteStart)), "hh:mm:ss")
      If IsEmpty(AbsoluteStart) Then AbsoluteStart = Now()
      If Int(mProgress * 100) <> Int(nProgress * 100) Or Int(nProgress * 100) = 0 Then
        mProgress = nProgress
        tlstring = Format((Now - startdate) * CLng((100 - (mProgress) * 100&)), "hh:mm:ss")
        If tlstring = "00:00:00" Then tlstring = lasttlstring Else tlstring = "Time left:" & tlstring: lasttlstring = tlstring
        picProgress.Visible = (mProgress > 0)
        lblProgress.Visible = (mProgress > 0)
        lblProgress = Format(mProgress * 100, "0.0") & "%" & " done. " & tlstring & telp
        shpProgress.Width = picProgress.Width * nProgress
        startdate = Now()
      End If
      'DoEvents
    End Property
    
    Public Property Get Progress() As Single
      Progress = mProgress
    End Property
    
    Public Sub ResetProgress()
      Progress = 0
      CancelClicked = False
      Title = ""
      StatusText = ""
      startdate = Now()
    End Sub
    
    Private Sub Form_Load()
      lblStatus.Caption = ""
    End Sub
    
    Private Sub Form_Paint()
      Progress = mProgress
    End Sub
    
    Public Property Let Title(ByVal nTitle As String)
      mTitle = nTitle
      Caption = mTitle
    End Property
    
    Public Property Get Title() As String
      Title = mTitle
    End Property
    
    Public Property Let StatusText(ByVal nStatus As String)
      If mStatus <> nStatus Then
        mStatus = nStatus
        lblStatus.Caption = mStatus
      End If
      'DoEvents
    End Property
    
    Public Property Get StatusText() As String
      StatusText = mStatus
    End Property
    
    Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
      RaiseEvent QueryUnload(Cancel)
    End Sub
    
    Private Sub Form_Unload(Cancel As Integer)
      CancelClicked = True
    End Sub
    ------------------------------------------
    'MY PROGRAM
    Private Sub QueryProcess()
    Dim DBConn
    Dim TotCnt1 As Double
    Dim xlApp As Excel.Application
    Dim xlWb As Excel.Workbook
    Dim xlWS As Excel.Worksheet
    Dim rngColumn As Excel.Range
    Dim rngCell As Excel.Range
    Dim strSource As String
    Dim mysheet As String
    Dim lngRow As Long
    ProgressBar1.Value = 1
    
    Dim rs
    'This is Adaptive Server Enterprise Connection
    Set DBConn = CreateObject("ADODB.Connection")
    DBConn.Open "ODBC; Driver=Adaptive Server Anywhere 6.0; DSN=Debtmaster; uid=dm; pwd=,,PeAches..;"
    Dim sSQL As String
    sSQL = "select clt_ref_no as CFG_ACCOUNT, " & _
    "(case  " & _
    "         when r.status_code in ('400','404','407') then 'OVBK' " & _
    "        when r.status_code in ('210','420','430','470','630') then 'OVUN' " & _
    "        when r.status_code in ('435') then 'OVRC' " & _
    "        when r.status_code in ('450') then 'OVDC' " & _
    "        when r.status_code in ('487') then 'OVFA' " & _
    "        when r.status_code = '491' then 'OCAC' " & _
    "        when r.status_code = '510' then 'OSIF' " & _
    "        when r.status_code='520' then 'OPIF' " & _
    "        else 'CHECK STATUS' " & _
    "       END) as REASON, " & _
    "(SELECT LONGSTR FROM DBTRUDF U WHERE R.DEBTOR_ID=U.DEBTOR_ID AND LABEL='BANKRUPTCYCHAPTER') AS BANKRUPTCYCHAPTER, " & _
    "(SELECT LONGSTR FROM DBTRUDF U WHERE R.DEBTOR_ID=U.DEBTOR_ID AND LABEL='CASENUMBER') AS CASENUM, " & _
    "CONVERT(CHAR(10),(SELECT DATE1 FROM DBTRUDF U WHERE R.DEBTOR_ID=U.DEBTOR_ID AND LABEL='FILEDATE'),101) AS BKTFILEDATE, " & _
    "CONVERT(CHAR(10),(SELECT DATE1 FROM DBTRUDF U WHERE R.DEBTOR_ID=U.DEBTOR_ID AND LABEL='DECEASEDDATE'),101) AS DATEOFDEATH, " 
    
    & _
    "    STATUS_DESCR AS COMMENTS, " & _
    "    substring(DEBT_DESCR,(LOCATE(DEBT_DESCR,':',1)+1), 30) AS ORIGINALACCOUNT " & _
    "FROM DEBT_VIEW S JOIN DBTR R ON S.DEBT_ID=R.DEBTOR_ID " & _
    "WHERE CLT_ID LIKE 'IDTC%' AND R.STATUS_CODE>='400'  AND R.STATUS_DATE>'2007-02-25' ; "
    Set rs = DBConn.Execute(sSQL)
    
    strSource = "\\usnymel1fs001\new claims\IDT Carmel\upload\" & Format(Date, "MM-DD-YY") & "\" & "Close And Returns File" & " " 
    
    & Format(Date, "MMDDYY") & ".xls"
    Set xlApp = New Excel.Application
    Set xlWb = xlApp.Workbooks.Add
    mysheet = xlApp.Worksheets(1).Name
    xlApp.Columns("A:H").EntireColumn.AutoFit
    Set xlWS = xlWb.Worksheets(mysheet)
    xlWS.Range("A1").Value = "CFG_ACCOUNT"
    xlWS.Range("B1").Value = "STATUS"
    xlWS.Range("C1").Value = "BKT CAHPTER"
    xlWS.Range("D1").Value = "BKT CASE#"
    xlWS.Range("E1").Value = "BKT FILE DATE"
    xlWS.Range("F1").Value = "DATE OF DEATH"
    xlWS.Range("G1").Value = "COMMENTS"
    xlWS.Range("H1").Value = "ORIGINAL ACCOUNT"
    lngRow = 2
    Do While Not rs.EOF
        If ProgressBar1.Value >= 100 Then ProgressBar1.Value = 1
        ProgressBar1.Value = ProgressBar1.Value + 1
        xlWS.Cells(lngRow, 1).Value = rs!CFG_ACCOUNT
        xlWS.Cells(lngRow, 2).Value = rs!REASON
        xlWS.Cells(lngRow, 3).Value = rs!BANKRUPTCYCHAPTER
        xlWS.Cells(lngRow, 4).Value = rs!CASENUM
        xlWS.Cells(lngRow, 5).Value = rs!BKTFILEDATE
        xlWS.Cells(lngRow, 6).Value = rs!DATEOFDEATH
        xlWS.Cells(lngRow, 7).Value = rs!Comments
        xlWS.Cells(lngRow, 8).Value = rs!ORIGINALACCOUNT
        lngRow = lngRow + 1
        Debug.Print lngRow
        rs.MoveNext
    Loop
    
    xlWb.Close SaveChanges:=True, FileName:=strSource
    Set xlWb = Nothing
    Set xlWS = Nothing
    xlApp.Quit
    Set xlApp = Nothing
    ShellExecute 0, vbNullString, Chr(34) & strSource & Chr(34), vbNullString, strSource, vbMaximizedFocus
    End Sub
    Last edited by loquin; 03-30-07 at 17:01. Reason: add [code] [/code] tags around code for clarity

  2. #2
    Join Date
    Jun 2004
    Location
    Arizona, USA
    Posts
    1,848
    Well, to display the amount of work done, you first need to calculate WHAT forms 100% of the work.

    If you assume something simple, like the number of records, fetch that to begin with. With a client-side cursor, you can simply use rs.Recordcount. With a server-side cursor, before actually retrieving the recordset, first retrieve the recordcount by issuing a SELECT Count(*) From YourTable, using the same where clauses as in the existing query. The value of rs.Fields(0) will be the recordcount.

    Now that you have the maximum recordcount, simply divide current recordcount by maxrecordcount and multiply by 100 to obtain the percentage of work done.

    NOTE: You should NOT update the progress bar every record. It will cause your processing to slow to a crawl. Remember, the smallest change that you can even SEE on a progress bar is one pixel, with the progress bar set to smooth scrolling. There is absolutely no need to update the bar several hundred times (or more) when there will be no visible change, is there?

    You can calculate the number of records per pixel by dividing the number of records by the number of pixels in the bar.

    Code:
    lngRecsPerPixel = lngRecordCount \  (Me.pbRecords.Width / Screen.TwipsPerPixelX)
    Then, inside the DO loop where you are processing the recordset, add a check to see if the current record number is evenly divisible by the recordsperpixel. If it is, update the progress bar, and issue a DoEvents, so that Windows can refresh the display.

    Code:
    If lngRecCount Mod lngRecsPerPixel = 0 then
      me.pbRecords.Value = lngRecord / lngRecordCount * 100
      doEvents
    End If
    Now, to calculate remaining time, first store the time just prior to when you start your processing loop. Then, when you update the records processed progress bar, get the current time, subtract the pre-loop time to get the elapsed time, divide by the number of records processed to calculate the time per record, and multiply by the records remaining to obtain the time remaining.

    The only problem is that displaying remaining time is NOT a good use of a progress bar, since you can't know how much time will actually be needed. Instead, just display the estimated time to completion as a time, in minutes and seconds, close to the work completed progress bar. (assume a label)

    The code would look something like
    Code:
      Dim tmStart as Double
      Dim tmElapsed as Double
      '...
      tmStart = Timer
      Do While not rs.EOF
        ' Do stuff with the record
        If lngRecCount Mod lngRecsPerPixel = 0 then
          me.pbRecords.Value = lngRecord / lngRecordCount * 100
          tmElapsed = Timer-tmStart
          lblRemaining.Caption = format(tmElapsed / lngRecord * (lngRecordCount - lngRecord), "n:ss")
          doEvents
        End If
        rs.MoveNext
      Loop
    Last edited by loquin; 04-05-07 at 04:42.
    Lou
    使大吃一惊
    "Lisa, in this house, we obey the laws of thermodynamics!" - Homer Simpson
    "I have my standards. They may be low, but I have them!" - Bette Middler
    "It's a book about a Spanish guy named Manual. You should read it." - Dilbert


Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •