frmtabujsp.frm

采用面向负荷控制技术

        Else
            While h <> vt And flag = False
                pstime = Vertex(vt).StartTime
                If pstime > etime Then
                    '编号vt的任务之开始时间在任务h的上道工序结束时间之后，
                    '看vt开始时间与vt前道任务结束时间之差是否可以放下本任务h
                    etime = Vertex(pt).StartTime + ProcessTime(Vertex(pt).PartNo, Vertex(pt).ProcessNo)
                    If Vertex(vt).StartTime - etime > ProcessTime(Vertex(h).PartNo, Vertex(h).ProcessNo) Then
                        flag = True
                        tt = j
                    End If
                End If
                pt = vt
                nta = Vertex(pt).FirstArc
                nta = Edge(nta).nextArc
                vt = Edge(nta).VertexNo
                j = j + 1
            Wend
        '找到这样的任务，判断其后的任务之间是否有足够的空闲时间可以插入本任务
            If flag = True Then
'                'vt是第一个这样的任务，找其下一任务pt，用下一任务pt开始时间与vt的完成时间作差，若差大于本任务时间，
'                '说明本任务可以插入此空闲时间
'                flag = False
'                While vt <> h   '若vt=h，说明未找到这样一个任务
'                    nta = Vertex(vt).FirstArc
'                    nta = Edge(nta).nextArc
'                    pt = Edge(nta).VertexNo
'                    etime = Vertex(vt).StartTime + ProcessTime(Vertex(vt).PartNo, Vertex(vt).ProcessNo)
'                    If pt <> h Then '已经找至前一个结点，不用再交换
'                        If Vertex(pt).StartTime - etime > ProcessTime(Vertex(h).PartNo, Vertex(h).ProcessNo) Then
'                            tt = j
'                            flag = True
'                        End If
'                    End If
'                    vt = pt
'    '                nta = Vertex(vt).FirstArc
'    '                nta = Edge(nta).nextArc
'    '                pt = Edge(nta).VertexNo
'                Wend
'                If flag = True Then
'                    Call GetAllTaskInDevice
'                    Call ShowQueue(TaskQH, TaskQT, qtask)
                    If j <> 0 And tt <> 0 Then
                        Call PutTaskAhead(vtdn, tt, j)
                    End If
'                End If
            End If
       End If
        pstime = Vertex(h).StartTime
        Vertex(h).StartTime = GetStartTime(h)
        If Vertex(h).StartTime > 1000 Then
        Vertex(h).StartTime = 900
        End If
        If Vertex(h).StartTime <> pstime Then
            '若开始时间有变化，则找工序的所有后继任务
            vt = h
            nta = Vertex(vt).FirstArc
            nta = Edge(nta).nextArc
            vt = Edge(nta).VertexNo
            '是否有后继任务,有则进入队列
            While (vt <> DeviceCount * PartCount + 1)
                If TaskQT < 35000 Then      '????not ok???
                qtask(TaskQT) = vt
                TaskQT = TaskQT + 1
                ReDim Preserve qtask(TaskQT)
                End If
                nta = Vertex(vt).FirstArc
                nta = Edge(nta).nextArc
                vt = Edge(nta).VertexNo
            Wend
        End If
'找下道工序
        nta = Vertex(h).FirstArc
        h = Edge(nta).VertexNo
    Wend
'    Call GetAllTaskInDevice
    '队首指针加1，队列向前移动
    TaskQH = TaskQH + 1
    I = TaskQT
Wend
Call GetLongest(j, pstime)
Vertex(DeviceCount * PartCount + 1).StartTime = pstime
End Sub
Sub ShowQueue(ph As Integer, pt As Integer, qtask() As Integer)
'use for debugging
Dim I As Integer
For I = ph To pt
    Debug.Print qtask(I)
Next I
End Sub
Sub GetLongest(ByRef pno As Integer, ByRef ptime As Double)
Dim I As Integer, h As Integer, nta As Integer, h1 As Integer
Dim x1 As Double, Longest As Double

I = 0: Longest = 0
For I = 0 To DeviceCount - 1
    h = Task(I) '各设备的首任务
    nta = Vertex(h).FirstArc
    nta = Edge(nta).nextArc
    While nta <> -1
        h = Edge(nta).VertexNo
        nta = Vertex(h).FirstArc
        If nta <> -1 Then '最后一个结点无firstarc域
            x1 = Vertex(h).StartTime + Edge(nta).weight
            nta = Edge(nta).nextArc
            h1 = h
        End If
    Wend
    If x1 > Longest Then
        Longest = x1
        pno = Vertex(h1).PartNo
    End If
Next I
ptime = Longest
End Sub

Sub DrawGantt()
Dim I As Integer, j As Integer, h As Integer, nta As Integer
Dim Y As Integer, x1 As Integer, x2 As Integer, VStep As Integer, HStep As Integer
Dim ptime As Double, Longest As Double, pno As Integer, StepShow As Integer 'StepShow为标尺刻度显示跨度
Dim r1 As Integer, g1 As Integer, b1 As Integer, k As Integer, sLong As Long 'sLong为刻度尺长度
Dim LineColor() As RGBColorType  '不同的零件用不同的颜色表示
    '比较复杂，应根据零件个数尽量使颜色不同以醒目，涉及排列组合问题？？？？
    '相当于有n个数m个位置，问可以组合成多少种数，各位置的数允许重复，应为n的m次方
    '例如：二进制数有二个数字，则三个位置有8种组合，四个位置有16种组合……
Dim candi() As Integer  '组合备选的数字
'lblColor()  '各零件的颜色情况；lblDev（）设备号；lblScale()为刻度尺


'得到侯选数字个数
Call GetLongest(j, Longest)
If ptime < 600 Then
Longest = 800
End If
If ptime > 3000 Then
Longest = 3000
End If
For I = 2 To 10
    If I ^ 3 > DeviceCount Then
        Exit For
    End If
Next I
ReDim candi(I)
ReDim Preserve LineColor(I ^ 3)
I = I - 1
If I > 0 Then
    j = 255 / I
    For k = 0 To I
        candi(k) = j * k
    Next k
End If
k = 0
For r1 = 0 To I
    For g1 = 0 To I
        For b1 = 0 To I
            LineColor(k).red = candi(r1)
            LineColor(k).blue = candi(b1)
            LineColor(k).green = candi(g1)
            k = k + 1
        Next b1
    Next g1
Next r1
'设置颜色显示提示
For I = 1 To lblColor.UBound    '卸载多余的控件
    Unload lblColor(I)
Next I
For I = 0 To 2 * PartCount - 1
    Load lblColor(lblColor.UBound + 1)
Next I
For I = 0 To PartCount - 1
    If I = 0 Then
        lblColor(I).Left = 960
    Else
        lblColor(2 * I).Left = lblColor(2 * I - 1).Left + 220
    End If
    With lblColor(2 * I)
        .Caption = "零件" & I & "："
        .Width = 630
        .Visible = True
    End With
    With lblColor(2 * I + 1)
        .Left = lblColor(2 * I).Left + 630
        .Caption = "  "
        .Width = 200
        .Visible = True
    End With
    r1 = LineColor(I).red
    b1 = LineColor(I).green
    g1 = LineColor(I).blue
    lblColor(2 * I + 1).BackColor = RGB(r1, g1, b1)
Next I
'Call GetLongest(pno, Longest)

PicGantt.Cls
If Longest <= 50 Then
    StepShow = 5
    sLong = 50
Else
    sLong = ((Longest + 99) / 100)
    sLong = sLong * 100
    StepShow = sLong / 10
End If
VStep = PicGantt.Height / DeviceCount
HStep = PicGantt.Width / sLong
'设置零件号提示
For I = 1 To lblDev.UBound    '卸载多余的控件
    Unload lblDev(I)
Next I

For I = 0 To DeviceCount - 1
    Load lblDev(lblDev.UBound + 1)
    With lblDev(I)
        .Left = 200
        .Caption = "设备" & I
        .Top = PicGantt.Top + 100 + I * VStep - 30 '加100使之与所对应的线对齐，减30使线对应字的中部
        .Visible = True
    End With
Next I
'设置刻度尺提示
For I = 1 To lblScale.UBound    '卸载多余的控件
    Unload lblScale(I)
Next I

j = sLong / StepShow
For I = 0 To j
    Load lblScale(lblScale.UBound + 1)
    With lblScale(I)
        .Left = PicGantt.Left + I * StepShow * HStep
        .Top = PicGantt.Top + PicGantt.Height + 50
        .Caption = I * StepShow
        .Visible = True
    End With
Next I
Load lblScale(lblScale.UBound + 1)
With lblScale(lblScale.UBound)
        .Left = PicGantt.Left + Longest * HStep
        .Top = PicGantt.Top + PicGantt.Height + 50
        .Caption = Longest
        .Visible = True
End With
For I = 0 To DeviceCount - 1
    j = 0
    Y = 100 + I * VStep
    h = Task(I) '各设备的首任务
    x1 = Vertex(h).StartTime * HStep
    nta = Vertex(h).FirstArc
    x2 = x1 + Edge(nta).weight * HStep
    nta = Edge(nta).nextArc
    r1 = LineColor(Vertex(h).PartNo).red
    b1 = LineColor(Vertex(h).PartNo).green
    g1 = LineColor(Vertex(h).PartNo).blue
    PicGantt.ForeColor = RGB(r1, g1, b1)
    PicGantt.Line (x1, Y)-(x2, Y)
    PicGantt.Line (x1, Y - 20)-(x1, Y + 20) '使各线的端点稍突出,以区分各工序
    PicGantt.Line (x2, Y - 20)-(x2, Y + 20)
    While nta <> -1
        h = Edge(nta).VertexNo
        x1 = Vertex(h).StartTime * HStep
        nta = Vertex(h).FirstArc
        If nta <> -1 Then '最后一个结点不画
            x2 = x1 + Edge(nta).weight * HStep
            nta = Edge(nta).nextArc
        End If
        j = j + 1
        If h <> DeviceCount * PartCount + 1 Then
            r1 = LineColor(Vertex(h).PartNo).red
            b1 = LineColor(Vertex(h).PartNo).green
            g1 = LineColor(Vertex(h).PartNo).blue
            PicGantt.ForeColor = RGB(r1, g1, b1)
            PicGantt.Line (x1, Y)-(x2, Y)
            PicGantt.Line (x1, Y - 20)-(x1, Y + 20) '使各线的端点稍突出
            PicGantt.Line (x2, Y - 20)-(x2, Y + 20)
        End If
    Wend
Next I
PicGantt.Refresh
End Sub

Sub DrawGanttNT()
Dim I As Integer, j As Integer, h As Integer, nta As Integer
Dim Y As Integer, x1 As Integer, x2 As Integer, VStep As Integer, HStep As Integer
Dim ptime As Double, Longest As Double, pno As Integer, StepShow As Integer 'StepShow为标尺刻度显示跨度
Dim r1 As Integer, g1 As Integer, b1 As Integer, k As Integer, sLong As Integer 'sLong为刻度尺长度
Dim LineColor() As RGBColorType  '不同的零件用不同的颜色表示
    '比较复杂，应根据零件个数尽量使颜色不同以醒目，涉及排列组合问题？？？？
    '相当于有n个数m个位置，问可以组合成多少种数，各位置的数允许重复，应为n的m次方
    '例如：二进制数有二个数字，则三个位置有8种组合，四个位置有16种组合……
Dim candi() As Integer  '组合备选的数字
'lblColor()  '各零件的颜色情况；lblDev（）设备号；lblScale()为刻度尺


'得到侯选数字个数
For I = 2 To 10
    If I ^ 3 > DeviceCount Then
        Exit For
    End If
Next I
ReDim candi(I)
ReDim Preserve LineColor(I ^ 3)
I = I - 1
If I > 0 Then
    j = 255 / I
    For k = 0 To I
        candi(k) = j * k
    Next k
End If
k = 0
For r1 = 0 To I
    For g1 = 0 To I
        For b1 = 0 To I
            LineColor(k).red = candi(r1)
            LineColor(k).blue = candi(b1)
            LineColor(k).green = candi(g1)
            k = k + 1
        Next b1
    Next g1
Next r1
'设置颜色显示提示
For I = 0 To 2 * PartCount - 1
    Load lblColor(lblColor.UBound + 1)
Next I
For I = 0 To PartCount - 1
    If I = 0 Then
        lblColor(I).Left = 960
    Else
        lblColor(2 * I).Left = lblColor(2 * I - 1).Left + 220
    End If
    With lblColor(2 * I)
        .Caption = "零件" & I & "："
        .Width = 630
        .Visible = True
    End With
    With lblColor(2 * I + 1)
        .Left = lblColor(2 * I).Left + 630
        .Caption = "  "
        .Width = 200
        .Visible = True
    End With
    r1 = LineColor(I).red
    b1 = LineColor(I).green
    g1 = LineColor(I).blue
    lblColor(2 * I + 1).BackColor = RGB(r1, g1, b1)
Next I
Call GetLongest(pno, Longest)
PicGantt.Cls
If BestValue <= 50 Then
    StepShow = 5
    sLong = 50
Else
    sLong = ((BestValue + 99) / 100)
    sLong = sLong * 100
    StepShow = sLong / 10
End If
VStep = PicGantt.Height / DeviceCount
HStep = PicGantt.Width / sLong
'设置零件号提示
For I = 0 To DeviceCount - 1
    Load lblDev(lblDev.UBound + 1)
    With lblDev(I)
        .Left = 200
        .Caption = "设备" & I
        .Top = PicGantt.Top + 100 + I * VStep - 30 '加100使之与所对应的线对齐，减30使线对应字的中部
        .Visible = True
    End With
Next I
'设置刻度尺提示
For I = 1 To lblScale.UBound    '卸载多余的控件
    Unload lblScale(I)
Next I

j = sLong / StepShow
For I = 0 To j
    Load lblScale(lblScale.UBound + 1)
    With lblScale(I)
        .Left = PicGantt.Left + I * StepShow * HStep
        .Top = PicGantt.Top + PicGantt.Height + 50
        .Caption = I * StepShow
        .Visible = True
    End With
Next I
Load lblScale(lblScale.UBound + 1)
With lblScale(lblScale.UBound)
        .Left = PicGantt.Left + Longest * HStep
        .Top = PicGantt.Top + PicGantt.Height + 50
        .Caption = BestValue
        .Visible = True
End With
For I = 0 To DeviceCount - 1
    j = 0
    Y = 100 + I * VStep
    h = Task(I) '各设备的首任务
    x1 = Vertex(h).StartTime * HStep
    nta = Vertex(h).FirstArc
    x2 = x1 + Edge(nta).weight * HStep
    nta = Edge(nta).nextArc
    r1 = LineColor(Vertex(h).PartNo).red
    b1 = LineColor(Vertex(h).PartNo).green
    g1 = LineColor(Vertex(h).PartNo).blue
    PicGantt.ForeColor = RGB(r1, g1, b1)
    PicGantt.Line (x1, Y)-(x2, Y)
    PicGantt.ForeColor = vbWhite        '使各线的端点稍突出的线用白色
    PicGantt.Line (x1, Y - 20)-(x1, Y + 20) '使各线的端点稍突出,以区分各工序