Foxtable(狐表)用户栏目专家坐堂 → 甘特图实际开始日期和结束日期


  共有4377人关注过本帖树形打印复制链接

主题:甘特图实际开始日期和结束日期

帅哥哟,离线,有人找我吗?
nuoyan88
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:九尾狐 帖子:2159 积分:14971 威望:0 精华:0 注册:2017/10/12 13:00:00
甘特图实际开始日期和结束日期  发帖心情 Post By:2018/4/16 20:42:00 [只看该作者]

用户已被锁定

 回到顶部
帅哥,在线噢!
有点蓝
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:105473 积分:536350 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2018/4/16 21:07:00 [只看该作者]

drawcell事件

If DrawGannt
    If e.Row.Index Mod 2 = 0 Then
        Dim r As Row  = Tables("项目资料_Table1").Rows(e.Row.Index/2)
        Dim dt1 As Date = r("计划_开始日期")
        Dim dt2 As Date = r("计划_结束日期")
        Dim sdt1 As Date = r("实际_开始日期")
        Dim sdt2 As Date = r("实际_结束日期")
        Dim dt As Date = e.Col.Name.Replace("年","-").Replace("月_","-")
        If dt>=dt1 AndAlso dt<=dt2 OrElse dt>=sdt1 AndAlso dt<=sdt2 Then
            e.StartDraw()
            If dt>=sdt1 AndAlso dt<=sdt2
                e.Graphics.FillRectangle(Brushes.Purple,e.x ,e.y + 5, e.Width, e.Height - 10)
            Else
                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 + 3, e.Width, e.Height - 7)
                End If
            End If
            e.EndDraw()
        End If
    Else
        Dim dt As Date = e.Col.Name.Replace("年","-").Replace("月_","-")
        Dim r As Row  = Tables("项目资料_Table1").Rows(e.Row.Index\2)
        Dim fdr As DataRow = DataTables("工作记录总表").find("计划日期=#" & dt & "# and 节点代号='" & r("节点代号") & "' and 项目代号='" & r("项目代号") & "'")
        If fdr IsNot Nothing Then
            e.text = fdr("总用时")
        End If
    End If
End If

 回到顶部
帅哥哟,离线,有人找我吗?
nuoyan88
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:九尾狐 帖子:2159 积分:14971 威望:0 精华:0 注册:2017/10/12 13:00:00
  发帖心情 Post By:2018/4/16 21:54:00 [只看该作者]

用户已被锁定

 回到顶部
帅哥,在线噢!
有点蓝
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:105473 积分:536350 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2018/4/16 22:01:00 [只看该作者]

增加一个判断,写到If e.Row.Index Mod 2 = 1 的条件中去

 回到顶部
帅哥哟,离线,有人找我吗?
nuoyan88
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:九尾狐 帖子:2159 积分:14971 威望:0 精华:0 注册:2017/10/12 13:00:00
  发帖心情 Post By:2018/4/16 22:09:00 [只看该作者]

用户已被锁定

 回到顶部
帅哥,在线噢!
有点蓝
  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:105473 积分:536350 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2018/4/16 22:34:00 [只看该作者]

If DrawGannt
    Dim dt As Date = e.Col.Name.Replace("年","-").Replace("月_","-")
    If e.Row.Index Mod 2 = 0 Then
        Dim r As Row  = Tables("项目资料_Table1").Rows(e.Row.Index/2)
        Dim dt1 As Date = r("计划_开始日期")
        Dim dt2 As Date = r("计划_结束日期")
        
        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 + 3, e.Width, e.Height - 7)
            End If
            e.EndDraw()
        End If
    Else
        Dim sdt1 As Date = r("实际_开始日期")
        Dim sdt2 As Date = r("实际_结束日期")
        If  dt>=sdt1 AndAlso dt<=sdt2 Then
            e.StartDraw()
            e.Graphics.FillRectangle(Brushes.Purple,e.x ,e.y + 5, e.Width, e.Height - 10)
            e.EndDraw()
        End If
        
        Dim r As Row  = Tables("项目资料_Table1").Rows(e.Row.Index\2)
        Dim fdr As DataRow = DataTables("工作记录总表").find("计划日期=#" & dt & "# and 节点代号='" & r("节点代号") & "' and 项目代号='" & r("项目代号") & "'")
        If fdr IsNot Nothing Then
            e.text = fdr("总用时")
        End If
    End If
End If

 回到顶部
帅哥哟,离线,有人找我吗?
nuoyan88
  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:九尾狐 帖子:2159 积分:14971 威望:0 精华:0 注册:2017/10/12 13:00:00
  发帖心情 Post By:2018/4/16 22:43:00 [只看该作者]

用户已被锁定

 回到顶部
帅哥,在线噢!
有点蓝
  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:105473 积分:536350 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2018/4/16 23:02:00 [只看该作者]

这么明显的提示和简单的错误,自己学会分析一下原因和排错

 回到顶部
帅哥哟,离线,有人找我吗?
nuoyan88
  9楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:九尾狐 帖子:2159 积分:14971 威望:0 精华:0 注册:2017/10/12 13:00:00
  发帖心情 Post By:2018/4/17 8:26:00 [只看该作者]

用户已被锁定

 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  10楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2018/4/17 8:45:00 [只看该作者]

改成这样测试

 

        Dim s As Row  = Tables("项目资料_Table1").Rows(e.Row.Index/2)
        Dim sdt1 As Date = s("实际_开始日期")
        Dim sdt2 As Date = s("实际_结束日期")
        If  dt>=sdt1 AndAlso dt<=sdt2 Then
            e.StartDraw()
            e.Graphics.FillRectangle(Brushes.Purple,e.x ,e.y + 5, e.Width, e.Height - 10)
            e.EndDraw()
        End If
        'Dim r As Row  = Tables("项目资料_Table1").Rows(e.Row.Index\2)
        'Dim fdr As DataRow = DataTables("工作记录总表").find("计划日期=#" & dt & "# and 节点代号='" & r("节点代号") & "' and 项目代号='" & r("项目代号") & "'")
        'If fdr IsNot Nothing Then
            'e.text = fdr("总用时")
        'End If

 

如果可以,就用gdi把总用时也画上去 http://www.foxtable.com/webhelp/scr/1482.htm

 


 回到顶部
总数 12 1 2 下一页