以文本方式查看主题

-  Foxtable(狐表)  (http://www.foxtable.com/bbs/index.asp)
--  专家坐堂  (http://www.foxtable.com/bbs/list.asp?boardid=2)
----  甘特图时段的问题  (http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&id=85221)

--  作者:douglas738888
--  发布时间:2016/5/20 15:59:00
--  甘特图时段的问题
请教老师,根据帮助做了计划开始日期,计划完成日期,现在要加入实际完成日期,在内部函数部分不知道怎么修改了,DrawCell部分已经修改,

但是还没有形成,实际完成日期的单元格绘制

做了个例子,请老师指导指导

 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:编号.foxdb



--  作者:大红袍
--  发布时间:2016/5/20 16:42:00
--  

你到底想怎样显示?

 

If DrawGannt Then
    Dim r As Row  = Tables("计划表").Rows(e.Row.Index)
    Dim dt1 As Date = r("计划开始日期")
    Dim dt2 As Date = r("计划完成日期")
    Dim dt3 As Date = r("实际完成日期")
    Dim dt As Date = e.Col.Name.Replace("年","-").Replace("月_","-")
    If dt>=dt1 AndAlso dt<=dt2 Then
        e.StartDraw()
        If dt < Date.Today Then
            e.Graphics.FillRectangle(Brushes.Green,e.x ,e.y + 5, e.Width, e.Height - 10)
        Else
            e.Graphics.FillRectangle(Brushes.Red,e.x ,e.y + 5, e.Width, e.Height - 10)
        End If
        e.EndDraw()
    End If
    If dt>=dt1 AndAlso dt<=dt3 Then
        e.StartDraw()
        If dt < Date.Today Then
            e.Graphics.FillRectangle(Brushes.Yellow,e.x ,e.y + 5, e.Width, e.Height - 10)
        Else
            e.Graphics.FillRectangle(Brushes.Blue,e.x ,e.y + 5, e.Width, e.Height - 10)
        End If
        e.EndDraw()
    End If
End If


--  作者:douglas738888
--  发布时间:2016/5/20 16:47:00
--  
老师,我是这样设想的,实际完成日期,如果比计划完成日期提前了,就在对应的TBALE2 对应的日期单元格显示黄色,如果比计划完成日期逾期了,就显示黑色
--  作者:大红袍
--  发布时间:2016/5/20 16:56:00
--  
If DrawGannt Then
    Dim r As Row  = Tables("计划表").Rows(e.Row.Index)
    Dim dt1 As Date = r("计划开始日期")
    Dim dt2 As Date = r("计划完成日期")
    Dim dt3 As Date = r("实际完成日期")
    Dim dt As Date = e.Col.Name.Replace("年","-").Replace("月_","-")
    e.StartDraw()
    If dt>=dt1 AndAlso dt<=dt2 Then
        e.Graphics.FillRectangle(Brushes.Green,e.x ,e.y + 5, e.Width, e.Height - 10)
    End If
    If dt>=dt1 AndAlso dt<=dt3 Then
        If dt2 >= dt3 Then
            e.Graphics.FillRectangle(Brushes.Yellow,e.x ,e.y + 5, e.Width, e.Height - 10)
        Else
            If dt>=dt3 Then
                e.Graphics.FillRectangle(Brushes.black,e.x ,e.y + 5, e.Width, e.Height - 10)
            Else
                e.Graphics.FillRectangle(Brushes.red,e.x ,e.y + 5, e.Width, e.Height - 10)
            End If
        End If
    End If
    e.EndDraw()
End If

--  作者:douglas738888
--  发布时间:2016/5/23 10:15:00
--  
请老师,帮忙看看,以下代码,能根据不同时间显示颜色了,但是如果实际完成时间大于计划完成时间时,右表的最大时间是计划完成时间,不会延展绘制实际完成时间,

是否要调整内部函数才行?      实际完成时间有两种可能,大于或小于计划完成时间

If DrawGannt Then
    Dim r As Row  = Tables("投标策划副表时间审批").Rows(e.Row.Index)
    Dim dt1 As Date = r("计划开始时间")
    Dim dt2 As Date = r("计划完成时间")
    Dim dt3 As Date = r("实际完成时间")
    Dim dt As Date = e.Col.Name.Replace("年","-").Replace("月_","-")
    e.StartDraw()
    If dt>=dt1 AndAlso dt<=dt2 Then
        e.Graphics.FillRectangle(Brushes.Green,e.x ,e.y + 5, e.Width, e.Height - 10)
    End If
    If dt< Date.Today Then
    If dt>=dt1 AndAlso dt<=dt3 Then  \'If dt>dt1 AndAlso dt<=dt3 Then
        If dt2>= dt3 Then \'dt2 >=
            e.Graphics.FillRectangle(Brushes.DeepSkyBlue,e.x ,e.y + 5, e.Width, e.Height - 10)
        Else
    If dt>=dt2 AndAlso dt<=dt3 Then  \'dt>
            If dt>=dt3 Then  
                e.Graphics.FillRectangle(Brushes.red,e.x ,e.y + 5, e.Width, e.Height - 10)
            Else
                e.Graphics.FillRectangle(Brushes.red,e.x ,e.y + 5, e.Width, e.Height - 10)
                    End If
               End If
          End If
     End If
End If
    e.EndDraw()
End If

--  作者:大红袍
--  发布时间:2016/5/23 10:24:00
--  
 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:编号.foxdb