Foxtable(狐表)用户栏目专家坐堂 → 进度条显示异常


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

主题:进度条显示异常

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


加好友 发短信
等级:四尾狐 帖子:858 积分:6381 威望:0 精华:0 注册:2017/2/13 9:04:00
进度条显示异常  发帖心情 Post By:2018/5/25 9:13:00 [只看该作者]


图片点击可在新窗口打开查看此主题相关图片如下:未命名2.png
图片点击可在新窗口打开查看

在老师的指导下,甘特图完成的差不多了,但还有一个问题一直未解决,同一个班组的两个排产内容合并到一行后,进度条显示异常,没有完全跟到日期,怎么解决?另外能不能做到同一个班组的两个排产内容合并到一行后是两个不同的颜色
图片点击可在新窗口打开查看此主题相关图片如下:未命名.png
图片点击可在新窗口打开查看

甘特图表drawcell代码:
If DrawGannt Then
    Dim cr As Row  = Tables("生产计划").Rows(e.Row.Index)
    For Each r As DataRow In cr.Table.DataTable.Select("班组 = '" & cr("班组") & "'", "开始日期")
        Dim dt1 As Date = r("开始日期")
        Dim dt2 As Date = r("结束日期")
        Dim dt As Date = e.Col.Name.Replace("年","-").Replace("月_","-")
        
        If dt = dt1 Then
            e.StartDraw()
            e.Graphics.FillRectangle(Brushes.RoyalBlue,e.x ,e.y , e.Width , e.Height)
            Dim fnt As New Font("宋体",9)
            Dim msg As String = r("排产内容")
            e.Graphics.DrawString(msg,fnt,Brushes.LightGreen,e.x,e.y+2)
            e.EndDraw()

        End If
    Next
End If

合并显示按钮代码:
Tables("生产计划").RepeatFilter("班组", 1)
Functions.Execute("BuildGanttTable")
With Tables("甘特图_Table2").Grid
    .FocusRect = C1.Win.C1FlexGrid.FocusRectEnum.None '不显示焦点框
    .HighLight = C1.Win.C1FlexGrid.HighLightEnum.Never '不高亮显示选定区
    .SelectionMode = C1.Win.C1FlexGrid.SelectionModeEnum.Cell '每次只显示一个单元格
End With


Dim tb As Table = Tables("甘特图_Table2")
tb.Grid.AllowMerging = C1.Win.C1FlexGrid.AllowMergingEnum.Custom
Dim minD As Date = Tables("生产计划").Compute("min(开始日期)")
Dim ls As new List(of object)
For Each r As object In tb.Grid.MergedRanges
        ls.add(r)
Next
For Each r As object In ls
    tb.Grid.MergedRanges.Remove(r)
Next
For i As Integer = tb.HeaderRows To tb.Rows.Count+tb.HeaderRows
    Dim cr As Row  = Tables("生产计划").Rows(i-2)
    For Each r As DataRow In cr.Table.DataTable.Select("班组 = '" & cr("班组") & "'", "开始日期")
        Dim dt1 As Date = r("开始日期")
        Dim dt2 As Date = r("结束日期")
        Dim sp As TimeSpan = dt2 - dt1
        Dim sp2 As TimeSpan = dt1 - minD
        Dim rng As C1.Win.C1FlexGrid.CellRange = tb.Grid.GetCellRange(i, sp2.TotalDays+1, i, sp2.TotalDays+1+sp.TotalDays)
        tb.Grid.MergedRanges.add(rng)
    Next
Next
[此贴子已经被作者于2018/5/25 9:46:24编辑过]

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


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

上传具体实例测试。

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


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


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


加好友 发短信
等级:四尾狐 帖子:858 积分:6381 威望:0 精华:0 注册:2017/2/13 9:04:00
  发帖心情 Post By:2018/5/25 10:58:00 [只看该作者]

做到了同一个班组的两个排产内容合并到一行后是两个不同的颜色,但是同一个班组的两个排产内容合并到一行后,进度条显示异常,还是没有完全跟到日期
[此贴子已经被作者于2018/5/25 10:57:57编辑过]

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


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

上传具体实例说明问题。

 

要注意一点,你两个日期区间,是不能重叠的。


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


加好友 发短信
等级:四尾狐 帖子:858 积分:6381 威望:0 精华:0 注册:2017/2/13 9:04:00
  发帖心情 Post By:2018/5/25 11:09:00 [只看该作者]

同一个班组的排产内容没有重叠,不同班组的重叠不影响吧
 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:甘特图测试.foxdb


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


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

BuildGanttTable函数

 

Dim tbl As Table = Tables("生产计划")
Tables("甘特图_Table2").StopRedraw()
Dim StartDate As Date = tbl.DataTable.Compute("Min(开始日期)", "开始日期 IS NOT NULL")
Dim EndDate As Date = tbl.datatable.Compute("Max(结束日期)","结束日期 IS NOT NULL")

Dim dt As Date = StartDate
Dim Builder As New DataTableBuilder("统计")
Do
    Dim nm As String = dt.Year & "年" &  dt.Month & "月_" & dt.Day
    Builder.Adddef(nm,Gettype(String),1)
    dt = dt.Adddays(1)
    If dt > Enddate Then
            Exit Do
    End If
Loop
Tables("甘特图_Table2").DataSource = Builder.buildDataSource
For Each cl As Col In Tables("甘特图_Table2").Cols
    cl.width = 20
Next
Functions.Execute("AddGanttRows")
Tables("甘特图_Table2").ResumeRedraw()


 回到顶部