progressbar.ctl

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

      End If
      If (eBorderStyle <> epdBorderStyle3d) Then
         lStyle = lStyle And Not WS_EX_CLIENTEDGE
         If (eBorderStyle = epbBorderStyleSingle) Then
            lCStyle = lCStyle Or WS_EX_STATICEDGE
         Else
            lCStyle = lCStyle And Not WS_EX_STATICEDGE
         End If
      Else
         lStyle = lStyle Or WS_EX_CLIENTEDGE
         lCStyle = lCStyle And Not WS_EX_STATICEDGE
      End If
      If (m_hWnd <> 0) Then
         SetWindowLong m_hWnd, GWL_EXSTYLE, lCStyle
         SetWindowPos m_hWnd, 0, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_FRAMECHANGED
      End If
      SetWindowLong UserControl.hwnd, GWL_EXSTYLE, lStyle
      SetWindowPos UserControl.hwnd, 0, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_FRAMECHANGED
      PropertyChanged "BorderStyle"
   End If
End Property

'Set BackColor
Public Property Let BackColor(ByVal oNewBackColor As OLE_COLOR)
Attribute BackColor.VB_Description = "Gets/sets the back color of the progress bar control (requires COMCTL32.DLL v4.71 or above)"
Attribute BackColor.VB_ProcData.VB_Invoke_PropertyPut = "StandardColor"
   If (oNewBackColor <> m_oBackColor) Then
      m_oBackColor = oNewBackColor
      If (m_hWnd <> 0) Then
         SendMessageLong m_hWnd, SB_SETBKCOLOR, 0, TranslateColor(oNewBackColor)
      End If
      PropertyChanged "BackColor"
   End If
End Property
Public Property Get BackColor() As OLE_COLOR
   BackColor = m_oBackColor
End Property

'SetForeColor
Public Property Let ForeColor(ByVal oNewForeColor As OLE_COLOR)
Attribute ForeColor.VB_Description = "Gets/sets the bar color of the progress bar control (requires COMCTL32.DLL v4.71 or above)"
Attribute ForeColor.VB_ProcData.VB_Invoke_PropertyPut = "StandardColor;Appearance"
   If (oNewForeColor <> m_oForeColor) Then
      m_oForeColor = oNewForeColor
      If (m_hWnd <> 0) Then
         SendMessageLong m_hWnd, PBM_SETBARCOLOR, 0, TranslateColor(oNewForeColor)
      End If
      PropertyChanged "ForeColor"
   End If
End Property

Public Property Get ForeColor() As OLE_COLOR
   ForeColor = m_oForeColor
End Property

Public Property Get Position() As Long
Attribute Position.VB_Description = "Gets/sets the position of the progress bar control l (for values > 64k requires COMCTL32.DLL v4.70 or above)"
Attribute Position.VB_ProcData.VB_Invoke_Property = ";Behavior"
Attribute Position.VB_UserMemId = 0
Attribute Position.VB_MemberFlags = "200"
   Position = m_lPosition
End Property
Public Property Let Position(ByVal lPos As Long)
   If (lPos <> m_lPosition) Then
      m_lPosition = lPos
      If (m_hWnd <> 0) Then
         SendMessage m_hWnd, PBM_SETPOS, m_lPosition, 0
      End If
      PropertyChanged "Position"
   End If
End Property
Public Property Get Step() As Long
Attribute Step.VB_Description = "Gets/sets the amount the progress position will be incremented when the StepIt method is called."
   Step = m_lStep
End Property
Public Property Let Step(ByVal lStep As Long)
   If (lStep <> m_lStep) Then
      m_lStep = lStep
      If (m_hWnd <> 0) Then
         SendMessage m_hWnd, PBM_SETSTEP, m_lStep, 0
      End If
      PropertyChanged "Step"
   End If
End Property
Public Sub StepIt()
Attribute StepIt.VB_Description = "Steps the progress position up by the amount specified in the Step property."
    If (m_hWnd <> 0) Then
        SendMessage m_hWnd, PBM_STEPIT, 0, 0
    Else
        m_lPosition = m_lPosition + m_lStep
    End If
End Sub

Private Sub pSetRange()
Dim tPR As PPBRange
Dim tPA As PPBRange
Dim lR As Long
    If (m_hWnd <> 0) Then
        ' try v4.70 PBM_SETRANGE32:
        SendMessageLong m_hWnd, PBM_SETRANGE32, m_lMin, m_lMax
        
        ' check whether PBM_SETRANGE32 was supported:
        tPA.iHigh = SendMessage(m_hWnd, PBM_GETRANGE, 0, tPR)
        tPA.iLow = SendMessage(m_hWnd, PBM_GETRANGE, 1, tPR)
        If (tPA.iHigh = m_lMax) And (tPA.iLow = m_lMin) Then
            ' ok
        Else
            ' use the original set range message:
            lR = (m_lMin And &HFFFF&)
            CopyMemory VarPtr(lR) + 2, (m_lMax And &HFFFF&), 2
            SendMessage m_hWnd, PBM_SETRANGE, 0, lR
        End If
    End If
End Sub

' Convert Automation color to Windows color
Private Function TranslateColor(ByVal clr As OLE_COLOR, _
                        Optional hPal As Long = 0) As Long
    If OleTranslateColor(clr, hPal, TranslateColor) Then
        TranslateColor = CLR_INVALID
    End If
End Function

Private Sub pCreate()
Dim dwStyle As Long
   pDestroy
   InitCommonControls
   dwStyle = WS_VISIBLE Or WS_CHILD
   If (m_eOrientation = epbVertical) Then
      dwStyle = dwStyle Or PBS_VERTICAL
   End If
   If (m_bSmooth) Then
      dwStyle = dwStyle Or PBS_SMOOTH
   End If
   m_hWnd = CreateWindowEX(0, PROGRESS_CLASSA, "", _
              dwStyle, 0, 0, UserControl.ScaleWidth \ Screen.TwipsPerPixelX, UserControl.ScaleHeight \ Screen.TwipsPerPixelY, _
              UserControl.hwnd, 0&, App.hInstance, 0&)
   If (m_hWnd <> 0) Then
      ' success
      SendMessage m_hWnd, PBM_SETPOS, m_lPosition, 0
   End If
   
End Sub
Private Sub pDestroy()
   If (m_hWnd <> 0) Then
      ShowWindow m_hWnd, SW_HIDE
      SetParent m_hWnd, 0
      DestroyWindow m_hWnd
   End If
End Sub
Private Sub pRecreate()
Dim lPosition As Long
Dim eBorder As EPBBorderStyle
Dim oBackColor As OLE_COLOR
Dim oForeColor As OLE_COLOR

   eBorder = BorderStyle
   lPosition = Position
   oBackColor = BackColor
   oForeColor = ForeColor
   
   pCreate
   
   pSetRange
   m_lPosition = -1
   Position = m_lPosition
   m_eBorderStyle = -1
   BorderStyle = eBorder
   m_oBackColor = -1
   BackColor = oBackColor
   m_oForeColor = -1
   ForeColor = oForeColor
   
End Sub

Private Sub UserControl_Initialize()
   m_lMin = 1
   m_lMax = 100
   m_oForeColor = vbHighlight
   m_lStep = 1
End Sub

Private Sub UserControl_InitProperties()
   Smooth = False
   Orientation = epbHorizontal
   pCreate
   BorderStyle = epbBorderStyleSingle
   m_oBackColor = UserControl.Ambient.BackColor
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
   Smooth = PropBag.ReadProperty("Smooth", False)
   Orientation = PropBag.ReadProperty("Orientation", epbHorizontal)
   pCreate
   m_eBorderStyle = -1
   BorderStyle = PropBag.ReadProperty("BorderStyle", epbBorderStyleSingle)
   ForeColor = PropBag.ReadProperty("ForeColor", vbHighlight)
   BackColor = PropBag.ReadProperty("BackColor", vbButtonFace)
   Min = PropBag.ReadProperty("Min", 0)
   Max = PropBag.ReadProperty("Max", 100)
   Step = PropBag.ReadProperty("Step", 1)
End Sub

Private Sub UserControl_Resize()
   If (m_hWnd <> 0) Then
      MoveWindow m_hWnd, 0, 0, UserControl.ScaleWidth \ Screen.TwipsPerPixelX, UserControl.ScaleHeight \ Screen.TwipsPerPixelY, 1
   End If
End Sub

Private Sub UserControl_Terminate()
   pDestroy
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
   PropBag.WriteProperty "BorderStyle", BorderStyle, epbBorderStyleSingle
   PropBag.WriteProperty "Smooth", Smooth, False
   PropBag.WriteProperty "Orientation", Orientation, epbHorizontal
   PropBag.WriteProperty "ForeColor", m_oForeColor, vbHighlight
   PropBag.WriteProperty "BackColor", m_oBackColor, vbButtonFace
   PropBag.WriteProperty "Min", Min, 0
   PropBag.WriteProperty "Max", Max, 100
   PropBag.WriteProperty "Step", Step, 1
End Sub