以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  [求助]甘特图的DrawCell代码问题  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=162136)

--  作者:swimmer01
--  发布时间:2021/4/6 22:44:00
--  [求助]甘特图的DrawCell代码问题
老师,您好!
我将甘特图的时间单位从日改为上、中、下旬后,在编写DrawCell事件代码时,运行不对,烦请诊断一下,谢谢!
If DrawGannt Then
    Dim r As Row  = Tables(_Sys_lsb2+"_Table1").Rows(e.Row.Index,True)
    Dim t2 As Table = Tables(_Sys_lsb2+"_Table2")
    
    Dim xt As String =  r("阶段码")
    Dim dt1 As Date = r("计划开始")
    Dim dt2 As Date = r("计划完成")
    
    Dim str1 As String     \'开始列名
    Dim ks As Integer      \'开始偏移量
    ks=dt1.Day
    If dt1.Day <=10 Then
        str1 = "上旬"
        ks=dt1.Day
    ElseIf dt1.Day <=20 Then
        str1 = "中旬"
        ks=(dt1.Day - 10)
    ElseIf dt1.Day >20 Then
        str1 = "下旬"
        ks=(dt1.Day - 20)
    End If
    str1=dt1.Year & "年" &  dt1.Month & "月_" & str1
    Dim ids As Integer= t2.cols(str1).Index
    
    Dim str2 As String     \'完成列名
    Dim ke As Integer      \'完成偏移量
    ke=dt2.Day
    If dt2.Day <=10 Then
        str2 = "上旬"
        ke=dt2.Day
    ElseIf dt2.Day <=20 Then
        str2 = "中旬"
        ke=(dt2.Day - 10)
    ElseIf dt2.Day >20 Then
        str2 = "下旬"
        ke=(dt2.Day - 20)
    End If
    str2=dt2.Year & "年" &  dt2.Month & "月_" & str2
    Dim ide As Integer= t2.cols(str2).Index
    
    \'********************确定画笔颜色和线条宽度
    Dim colr As Brush     \'画笔颜色
    Dim kw As Integer  = 16      \'线条宽度
    If r.IsGroup \'如果是分组行
        If r.Level = 0 Then
            colr = Brushes.Red
        ElseIf r.level = 1 Then
            colr = Brushes.DarkOliveGreen
        ElseIf r.level = 2 Then
            colr = Brushes.Sienna
        End If
    Else
        If xt.length=4 Then
            colr = Brushes.DarkOrchid
        Else
            colr = Brushes.YellowGreen
            kw = 18
        End If
    End If
    \'*****************画甘特图
    For Each dc As DataCol In DataTables(_Sys_lsb2+"_Table2").DataCols
        Dim idx As Integer=t2.cols(dc.Name).Index
        If idx>=ids AndAlso idx<=ide Then
            e.StartDraw()

                e.Graphics.FillRectangle(colr,e.x ,e.y + 8, e.Width, e.Height - kw)

            e.EndDraw()
        End If
    Next
End If

涂红部分好像不起作业,画出来全是从头到尾的一条线,与起止时间没关联。

--  作者:有点蓝
--  发布时间:2021/4/6 22:45:00
--  
请上传实例测试
--  作者:swimmer01
--  发布时间:2021/4/6 22:51:00
--  

图片点击可在新窗口打开查看此主题相关图片如下:屏幕截图 2021-04-06 225020.jpg
图片点击可在新窗口打开查看

--  作者:swimmer01
--  发布时间:2021/4/7 0:39:00
--  
已解决,谢谢