progressbar.ctl

Visual Basic image processing. Mainly it occupies some filters to detect some prperties of image. Re

VERSION 5.00
Begin VB.UserControl ProgressBar 
   CanGetFocus     =   0   'False
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   ScaleHeight     =   3600
   ScaleWidth      =   4800
   ToolboxBitmap   =   "ProgressBar.ctx":0000
End
Attribute VB_Name = "ProgressBar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit


' ======================================================================================
' cProgBar control
' Steve McMahon
' 02 June 1998
'
' A simple implementation of the Common Control Progress Bar
' ======================================================================================

' ======================================================================================
' API declares:
' ======================================================================================

' Memory functions:
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
' Window functions
Private 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
Private Const WS_VISIBLE = &H10000000
Private Const WS_CHILD = &H40000000
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Const SW_HIDE = 0
Private Const SW_SHOW = 5
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
' Window style bit functions:
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
    (ByVal hwnd As Long, ByVal nIndex As Long, _
    ByVal dwNewLong As Long _
    ) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
    (ByVal hwnd As Long, ByVal nIndex As Long _
    ) As Long
' Window Long indexes:
Private Const GWL_EXSTYLE = (-20)
Private Const GWL_HINSTANCE = (-6)
Private Const GWL_HWNDPARENT = (-8)
Private Const GWL_ID = (-12)
Private Const GWL_STYLE = (-16)
Private Const GWL_USERDATA = (-21)
Private Const GWL_WNDPROC = (-4)
' Style:
Private Const WS_EX_CLIENTEDGE = &H200&
Private Const WS_EX_STATICEDGE = &H20000

 ' Window relationship functions:
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
' WIndow position:
Private 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
Private Const SWP_SHOWWINDOW = &H40
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_FRAMECHANGED = &H20        '  The frame changed: send WM_NCCALCSIZE
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_NOCOPYBITS = &H100
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOOWNERZORDER = &H200      '  Don't do owner Z ordering
Private Const SWP_NOREDRAW = &H8
Private Const SWP_NOREPOSITION = SWP_NOOWNERZORDER
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOZORDER = &H4
Private Const SWP_DRAWFRAME = SWP_FRAMECHANGED
Private Const HWND_NOTOPMOST = -2
Private Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal fEnable As Long) As Long
' Messages
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SendMessageStr Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Const WM_USER = &H400

Private Declare Function OleTranslateColor Lib "OLEPRO32.DLL" (ByVal OLE_COLOR As Long, ByVal HPALETTE As Long, pccolorref As Long) As Long
Private Const CLR_INVALID = -1

' common controls:
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()

' progress bar:
Private Const PROGRESS_CLASSA = "msctls_progress32"

'Style
Private Const PBS_SMOOTH = &H1
Private Const PBS_VERTICAL = &H4
Private Const PBM_SETRANGE = (WM_USER + 1)
Private Const PBM_SETPOS = (WM_USER + 2)
Private Const PBM_DELTAPOS = (WM_USER + 3)
Private Const PBM_SETSTEP = (WM_USER + 4)
Private Const PBM_STEPIT = (WM_USER + 5)
Private Const PBM_SETRANGE32 = (WM_USER + 6)
Private Const PBM_GETRANGE = (WM_USER + 7)
Private Const PBM_GETPOS = (WM_USER + 8)
Private Const PBM_SETBARCOLOR = (WM_USER + 9)
Private Const CCM_FIRST = &H2000
Private Const CCM_SETBKCOLOR = (CCM_FIRST + 1)
Private Const SB_SETBKCOLOR = CCM_SETBKCOLOR

Private Type PPBRange
   iLow As Long
   iHigh As Long
End Type


' ======================================================================================
' Implementation:
' ======================================================================================
Public Enum EPBBorderStyle
    epbBorderStyleNone
    epbBorderStyleSingle
    epdBorderStyle3d
End Enum
Public Enum EPBOrientation
    epbHorizontal
    epbVertical
End Enum

' ======================================================================================
' Private variables:
' ======================================================================================
Private m_hWnd As Long
Private m_oBackColor As OLE_COLOR
Private m_oForeColor As OLE_COLOR
Private m_bSmooth As Boolean
Private m_eOrientation As EPBOrientation
Private m_eBorderStyle As EPBBorderStyle
Private m_lPosition As Long
Private m_lMin As Long
Private m_lMax As Long
Private m_lStep As Long

Public Property Get Orientation() As EPBOrientation
Attribute Orientation.VB_Description = "Gets/sets the orientation of the progress bar control (for vertical orientation requires COMCTL32.DLL v4.70 or above)"
Attribute Orientation.VB_ProcData.VB_Invoke_Property = ";Appearance"
   Orientation = m_eOrientation
End Property
Public Property Let Orientation(ByVal eOrientation As EPBOrientation)
   If (m_eOrientation <> eOrientation) Then
      m_eOrientation = eOrientation
      If (m_hWnd <> 0) Then
         ' set style...
         pRecreate
      End If
      PropertyChanged "Orientation"
   End If
End Property
Public Property Get Min() As Long
Attribute Min.VB_Description = "Gets/sets the minimum value of the progress bar control (for values > 64k requires COMCTL32.DLL v4.70 or above)"
Attribute Min.VB_ProcData.VB_Invoke_Property = ";Behavior"
   Min = m_lMin
End Property
Public Property Let Min(ByVal lMin As Long)
   If (m_lMin <> lMin) Then
      m_lMin = lMin
      If (m_hWnd <> 0) Then
         pSetRange
      End If
      PropertyChanged "Min"
   End If
End Property
Public Property Get Max() As Long
Attribute Max.VB_Description = "Gets/sets the maximum value of the progress bar control (for values > 64k requires COMCTL32.DLL v4.70 or above)"
Attribute Max.VB_ProcData.VB_Invoke_Property = ";Behavior"
   Max = m_lMax
End Property
Public Property Let Max(ByVal lMax As Long)
   If (m_lMax <> lMax) Then
      m_lMax = lMax
      If (m_hWnd <> 0) Then
         pSetRange
      End If
      PropertyChanged "Max"
   End If
End Property
Public Property Let Smooth(ByVal bSmooth As Boolean)
Attribute Smooth.VB_Description = "Gets/sets whether the progress bar is shown as a smooth bar rather than a segmented one. (Smooth bars require COMCTL32.DLL v4.70 or above)"
Attribute Smooth.VB_ProcData.VB_Invoke_PropertyPut = ";Appearance"
Dim lStyle As Long
Dim hP As Long
   If (m_bSmooth <> bSmooth) Then
      m_bSmooth = bSmooth
      If (m_hWnd <> 0) Then
         ' set style..
         pRecreate
      End If
      PropertyChanged "Smooth"
   End If
End Property
Public Property Get Smooth() As Boolean
   Smooth = m_bSmooth
End Property
Public Property Get hwnd() As Long
Attribute hwnd.VB_Description = "Gets the hWnd of the control.  The progress bar itself is the only child of the control."
Attribute hwnd.VB_UserMemId = -515
   hwnd = m_hWnd
End Property
Public Property Get BorderStyle() As EPBBorderStyle
Attribute BorderStyle.VB_Description = "Gets/sets the border style of the progress bar."
Attribute BorderStyle.VB_ProcData.VB_Invoke_Property = ";Appearance"
Attribute BorderStyle.VB_UserMemId = -504
   BorderStyle = m_eBorderStyle
End Property
Property Let BorderStyle(ByVal eBorderStyle As EPBBorderStyle)
Dim lStyle As Long
Dim lCStyle As Long
   If (m_eBorderStyle <> eBorderStyle) Then
      m_eBorderStyle = eBorderStyle
      lStyle = GetWindowLong(UserControl.hwnd, GWL_EXSTYLE)
      If (m_hWnd <> 0) Then
         lCStyle = GetWindowLong(m_hWnd, GWL_EXSTYLE)