usercontrol1.ctl

能分班系统采用Z线分班方法：即由系统自动抽签(也可由班主任抽签)

    mini = defMin
    m_Value = def_m_Value
    m_Style = m_StyleDefault
End Sub

Private Sub UserControl_Resize() 'paints progress bar

    On Error Resume Next
    UserControl.ScaleMode = 3
    UserControl.Cls
    Dim X, Y, W, h As Integer
    X = UserControl.ScaleWidth - 3
    Y = UserControl.ScaleHeight - 3
    W = UserControl.ScaleWidth - 6
    h = UserControl.ScaleHeight - 6
    UserControl.PaintPicture img.Picture, 0, 0, 3, 3, 0, 0, 3, 3    'left-top corner
    UserControl.PaintPicture img.Picture, X, 0, 3, 3, 56, 0, 3, 3 'right-top corner
    UserControl.PaintPicture img.Picture, X, Y, 3, 3, 56, 10, 3, 3  'right-down corner
    UserControl.PaintPicture img.Picture, 0, Y, 3, 3, 0, 10, 3, 3 'left-down corner
    UserControl.PaintPicture img.Picture, 3, 0, W, 3, 3, 0, 12, 3  'top line
    UserControl.PaintPicture img.Picture, X, 3, 3, h, 56, 3, 3, 3 'right line
    UserControl.PaintPicture img.Picture, 3, Y, W, 3, 3, 10, 1, 3 'bottom line
    UserControl.PaintPicture img.Picture, 0, 3, 3, h, 0, 3, 3, 3 'left line
    UserControl.PaintPicture img.Picture, 3, 3, W, h, 4, 4, 51, 7 'and at the end, fill the progress bar
    searchpos = 4
    Reset
End Sub

Private Sub Reset()
    On Error Resume Next
    i = 4 ' when start drawing, don't draw on the border, take this as starting point
    If s = 1 Then
        cnt = setdef
        bx = setdef
        s = 0
    End If '  Else
    If mini <> 0 Then
        cnt = m_Value - mini
        bx = m_Value - mini
        startvalue = m_Value - mini
    Else
        cnt = m_Value
        bx = m_Value
        startvalue = m_Value
    End If


    ret = 0
    bg = 0
    bgcnt = 0
    wu = UserControl.ScaleWidth
    hu = UserControl.ScaleHeight - 6
    W = pc(0).Width
    h = pc(0).Height
    chend = 0
    dif = 0
End Sub

Private Sub DoIt() 'paints proces in progress bar
    On Error Resume Next
    If m_Value <= mini Then UserControl_Resize
    If m_Value < startvalue Then
        setdef = m_Value: s = 1: UserControl_Resize
    Else
        If startvalue = 0 And m_Value > 0 And mini = 0 Then
            dif = m_Value: startvalue = m_Value
        ElseIf mini > 0 And startvalue = mini And m_Value > mini Then
            dif = m_Value - mini: startvalue = m_Value
        Else
            If m_Value = mini Then
                startvalue = mini
            Else
                'first part
                'checking here if there was any change with dif(ex. was 1 and now is 5)
                'if user did make mistake or want to play, we will handle that
                If startvalue + dif <> m_Value And startvalue <> dif And dif <> 0 Then
                    dif = m_Value - startvalue: startvalue = m_Value
                ElseIf startvalue + dif <> m_Value And startvalue = dif Then
                    dif = m_Value - startvalue: startvalue = m_Value
                ElseIf startvalue + dif <> m_Value Then
                    dif = startvalue: startvalue = m_Value
                Else
                    startvalue = m_Value
                End If

            End If
        End If

    End If

    Dim per, mmax, m
    'Dim m As Integer

    per = wu * 0.01 ' 1% of our UserControl width
    m = maxi - mini 'not all the time min is 0 so we take care of it
    mmax = m * 0.01 '1% procent of data
    If m_Value > 0 And maxi <> 100 Then mmax = 0

    If m_Value < (cnt + mini) Then Exit Sub
    cnt = cnt + mmax

    Dim ok 'As Double
    ok = 100 / m 'this will handle everything !!! don't change it
    per = per * ok

    'this is second part
    If dif = 1 Then
        bx = bx + 1
    Else
        bx = bx + dif
    End If

Again:                     If i < (bx * per) Then   ' procent of data must be equal all the time with progress
    If i + 10 >= wu Then
        CheckEnd
    End If
    If chend = 0 Then
        UserControl.PaintPicture pc(2).Picture, i, 3, W, hu, 0, 0, W, h  'fill the progress bar
        i = i + 10
        GoTo Again
    End If
End If
End Sub

Private Sub CheckEnd()
OneMore:
If i + 10 = wu Or i + 10 > wu Then ' checking if its the end so don't draw on the border
    P = (wu - 3) - i
    If P = 0 Or P < 0 Then
        chend = 1
        Exit Sub
    End If

    If i + P < wu Then 'paint the space left
        UserControl.PaintPicture pc(2).Picture, i, 3, P, hu, 0, 0, W, h
        chend = 1
        Exit Sub
    End If
ElseIf i + 8 = wu Or i + 8 > wu Then
    chend = 1
    Exit Sub
End If
Dim ag As Integer
If m_Value = maxi And maxi <> 100 Then
    For ag = i To wu - 10 Step 10
        UserControl.PaintPicture pc(2).Picture, i, 3, W, hu, 0, 0, W, h  'fill the progress bar
        i = i + 10
    Next ag
    GoTo OneMore
End If

End Sub

Private Sub MakeSearch()
Dim cnt, l As Integer
a = searchpos

If a <> 2 And a <> 4 Then
    UserControl.PaintPicture blank.Picture, a - 5, 3, W / 2, hu, 0, 0, W, h
End If

If a + 20 < wu Then
    UserControl.PaintPicture pc(2).Picture, a + 10, 3, W / 2, hu, 0, 0, W, h 'paints first image
End If

If a + 10 < wu Then
    UserControl.PaintPicture pc(1).Picture, a + 5, 3, W / 2, hu, 0, 0, W, h 'paints image in the middle
End If
If a + 5 < wu Then
    UserControl.PaintPicture pc(0).Picture, a, 3, W / 2, hu, 0, 0, W, h 'paints last image(at the end)
End If

If a + 5 = wu Or a + 5 > wu Then
    l = (wu - 3) - a
    If l = 0 Or l < 0 Then
        searchpos = 2
        Exit Sub
    End If

    If a + l < wu Then 'paint the space left
        UserControl.PaintPicture blank.Picture, a, 3, l, hu, 0, 0, W, h
        searchpos = 2
        Exit Sub
    End If
ElseIf a + 4 = wu Or a + 4 > wu Then
    searchpos = 2
    Exit Sub
End If

a = a + 5
searchpos = a
End Sub

Private Sub MakeMeHappy()
If ProgressLook = XP_Default Then
    pc(0).Picture = master(0).Picture
    pc(1).Picture = master(1).Picture
    pc(2).Picture = master(2).Picture
ElseIf ProgressLook = XP_DarkBlue Then
    pc(0).Picture = bluemet(0).Picture
    pc(1).Picture = bluemet(1).Picture
    pc(2).Picture = bluemet(2).Picture
ElseIf ProgressLook = XP_Gold Then
    pc(0).Picture = goldmet(0).Picture
    pc(1).Picture = goldmet(1).Picture
    pc(2).Picture = goldmet(2).Picture
ElseIf ProgressLook = XP_Green Then
    pc(0).Picture = grmet(0).Picture
    pc(1).Picture = grmet(1).Picture
    pc(2).Picture = grmet(2).Picture
ElseIf ProgressLook = XP_Grey Then
    pc(0).Picture = greymet(0).Picture
    pc(1).Picture = greymet(1).Picture
    pc(2).Picture = greymet(2).Picture
ElseIf ProgressLook = XP_Orange Then
    pc(0).Picture = orangemet(0).Picture
    pc(1).Picture = orangemet(1).Picture
    pc(2).Picture = orangemet(2).Picture
ElseIf ProgressLook = XP_Red Then
    pc(0).Picture = redmet(0).Picture
    pc(1).Picture = redmet(1).Picture
    pc(2).Picture = redmet(2).Picture
ElseIf ProgressLook = XP_Blue Then
    pc(0).Picture = blue(0).Picture
    pc(1).Picture = blue(1).Picture
    pc(2).Picture = blue(2).Picture
End If
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
mini = PropBag.ReadProperty("Min", defMin)
maxi = PropBag.ReadProperty("Max", defMax)
m_Value = PropBag.ReadProperty("Value", def_m_Value)
m_Style = PropBag.ReadProperty("Style", m_StyleDefault)
ProgressLook = PropBag.ReadProperty("ProgressLook", m_PicDefault)
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("Min", mini, defMin)
Call PropBag.WriteProperty("Max", maxi, defMax)
Call PropBag.WriteProperty("Value", m_Value, def_m_Value)
Call PropBag.WriteProperty("Style", m_Style, m_StyleDefault)
Call PropBag.WriteProperty("ProgressLook", m_Pic, m_PicDefault)
End Sub

Public Property Get Value() As Long
Value = m_Value
End Property

Public Property Let Value(ByVal New_Value As Long)
If New_Value > maxi Then
    MsgBox "您输入的信息有误,但不影响智能分班进程", vbCritical, "提示"

    Exit Property
ElseIf New_Value < mini Then
    MsgBox "您输入的信息有误,但不影响智能分班进程", vbCritical, "提示"
    Exit Property
Else
    m_Value = New_Value
    PropertyChanged "Value"
End If

If m_Style = Default Then
    DoIt
Else
    If m_Value = maxi Then
        UserControl_Resize
        Exit Property
    Else
        MakeSearch
    End If
End If
End Property

Public Property Get Style() As TypeStyle
Style = m_Style
End Property

Public Property Let Style(ByVal New_Style As TypeStyle)
m_Style = New_Style
PropertyChanged "Style"
End Property

Public Property Get ProgressLook() As Pict
ProgressLook = m_Pic
End Property

Public Property Let ProgressLook(ByVal New_ProgressLook As Pict)
m_Pic = New_ProgressLook
PropertyChanged "ProgressLook"
MakeMeHappy
End Property

Public Property Get Min() As Long
Min = mini
End Property

Public Property Let Min(ByVal New_Mini As Long)
If New_Mini > maxi Then
    MsgBox "您输入的信息有误,但不影响智能分班进程", vbCritical, "提示"
    Exit Property
ElseIf New_Mini < 0 Then
    MsgBox "您输入的信息有误,但不影响智能分班进程", vbCritical, "提示"
    Exit Property
Else
    mini = New_Mini
    PropertyChanged "Min"
End If
End Property

Public Property Get Max() As Long
Max = maxi
End Property

Public Property Let Max(ByVal New_Maxi As Long)
If New_Maxi < mini Then
    MsgBox "您输入的信息有误,但不影响智能分班进程", vbCritical, "提示"
    Exit Property
Else
    maxi = New_Maxi
    PropertyChanged "Max"
End If
End Property                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            'Aki