Attribute VB_Name = "hlp_ctProgressB"
' modul for Visual Basic 6
' Copyright (C) 2004-2006 Jan Vorel

' This program is free software; you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation; either version 2 of the License, or
' (at your option) any later version.

' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.

' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

' This is a shared modul, class modul, usercontrol or form. It is also
' published under the GNU General Public License.

' If you have any questions, suggestions or bug reports about this product,
' contact me: info@ctuser.net; Do not contact me about general B.A.S.I.C.
' language or A.P.I. issues

Option Explicit
Option Base 0

' Please do not use the "Remove integer overflow checks" compiler options when using this module!

'#If (DoEventsEx_FlagA And &H20) = &H0 Then
Private Declare Function GetTickCount Lib "kernel32" () As Long
'  #End If

Private Declare Function SendMessageA Lib "user32" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, lParam As Any) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Public Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Public Sub ctProgressB_SetValue(ByVal ProgressControl As Long, ByVal ProgressPosition As Long, ByVal ProgressTotal As Long)
  Static xLong1 As Long
  Static xChar1 As String
  Static xLong2 As Long
  Const SleepValueLow As Long = 25&
  
'  Stop
  If DoEventsEx_IsTickCountElapsed(xLong2, 250&) Or (ProgressPosition = 0 Or ProgressPosition = 1) And ProgressTotal = 1& Then
    If Not (ProgressControl = 0& Or ProgressTotal = 0&) Then
      xLong1 = CLng(CInt(ProgressPosition / ProgressTotal * 100))
      'frmMain.Caption = Trim(Str(xLong1))
      xChar1 = Trim(Str(CInt(ProgressPosition / ProgressTotal * 10000) / 100 + 0.001))
      xChar1 = Left(xChar1, Len(xChar1) - 1) & "%"
      If ProgressPosition / ProgressTotal < 0.01 Then xChar1 = "0" & xChar1
      Call SendMessageA(ProgressControl, 1026&, ByVal xLong1, ByVal 0&)
      Call SendMessageA(ProgressControl, 12&, ByVal 0&, ByVal xChar1)
      'Form1.Caption = Trim(Str(CInt(Value * 1000) / 1000)) & " - " & xChar1
      'Debug.Print xChar1
      End If
  
    DoEventsEx_Sleep SleepValueLow
    xLong2 = GetTickCount And Not &HC0000000
    End If
  End Sub

#If (DoEventsEx_FlagA And &H20) = 0& Then
  Private Function DoEventsEx_IsTickCountElapsed(ByVal FirstTickCountValue As Long, ByVal TimeIntervalMs As Long) As Boolean
    Static xLong1 As Long
    xLong1 = GetTickCount And Not &HC0000000
    If xLong1 < FirstTickCountValue Then
      DoEventsEx_IsTickCountElapsed = (xLong1 + &H40000000 > FirstTickCountValue + TimeIntervalMs)
      Else
      DoEventsEx_IsTickCountElapsed = (xLong1 > FirstTickCountValue + TimeIntervalMs)
      End If
    End Function
  #End If


Public Function ctProgressB_Create(ByVal ParentHwnd As Long, ByVal Left As Long, ByVal Top As Long, ByVal Width As Long, Optional ByVal Height As Long = 17&) As Long
  ctProgressB_Create = CreateWindowEx(512&, "msctls_progress32", "", &H50000001, Left, Top, Width, Height, ParentHwnd, vbNull, App.hInstance, ByVal 0&)
  End Function

