Foxtable(狐表) → 用户栏目 → 专家坐堂 → 求助甘特图


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

主题：求助甘特图
帅哥哟，离线，有人找我吗？
zoyong
 小大  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：三尾狐 帖子：668 积分：7918 威望：0 精华：0 注册：2015/8/24 9:02:00 		求助甘特图  发帖心情 Post By：2020/8/29 15:35:00 [显示全部帖子]

Dim Chart As WinForm.Chart
Chart= Forms("窗口1").Controls("Chart1")
Chart.ChartType = ChartTypeEnum.Gantt '图表类型为甘特图
Chart.Inverted = True '对调X轴和Y轴位置
Chart.AxisY.DateType= True 'Y轴为日期型
Chart.AxisY.AnnoFormatString = "MM-dd" '设置Y轴的标示格式
Chart.AxisY.MinDate = #01/01/2010# '设置Y轴的起始日期
Chart.AxisY.MaxDate = #04/30/2010# '设置Y轴的终止日期
Chart.AxisX.GridMajorVisible = False '隐藏X轴的网格线
With Chart.SeriesList
.AddGanttSeries("任务一", #1/1/2010#, #3/9/2010#)
.AddGanttSeries("任务二", #1/23/2010#, #2/14/2010#)
.AddGanttSeries("任务三", #1/21/2010#, #2/24/2010#)
.AddGanttSeries("任务四", New DateTime() {#1/22/2010#, #2/28/2010#}, New DateTime() {#2/12/2010#, #3/24/2010#})
.AddGanttSeries("任务五", New DateTime() {#2/13/2010#, #3/8/2010#}, New DateTime() {#3/5/2010#, #3/31/2010#})
.AddGanttSeries("任务六", #3/15/2010#, #4/20/2010#)
.AddGanttSeries("任务七", #4/6/2010#, #4/30/2010#)
.AddGanttLabels("M月d日")
End with


红色代码如何用表格的形式展示，代码无效



With Chart.SeriesList

    For Each r As Row In Tables("表A").Rows

        If r("任务") IsNot Nothing Then

            Dim rq1 As Date = r("开始日期")

            Dim rq2 As Date = r("结束日期")

            .AddGanttSeries(r("任务"), rq1, rq2)

        End If

    Next

    .AddGanttLabels("M月d日")

End With


[此贴子已经被作者于2020/8/29 15:47:56编辑过]
 回到顶部
帅哥哟，离线，有人找我吗？
zoyong
 小大  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：三尾狐 帖子：668 积分：7918 威望：0 精华：0 注册：2015/8/24 9:02:00 		  发帖心情 Post By：2020/8/29 16:01:00 [显示全部帖子]

  
 下载信息  [文件大小：   下载次数： ]
图片点击可在新窗口打开查看点击浏览该文件:管理项目2.foxdb
 回到顶部
帅哥哟，离线，有人找我吗？
zoyong
 小大  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：三尾狐 帖子：668 积分：7918 威望：0 精华：0 注册：2015/8/24 9:02:00 		  发帖心情 Post By：2020/9/8 15:35:00 [显示全部帖子]

Dim TbName As String = eform.name & "_活动书目"
Dim r As Row = Tables(TbName).Current

'创建目录新建目录
If FileSys.DirectoryExists("d:\temp") = False Then    '是否存在
    FileSys.CreateDirectory("d:\temp")
End If

Dim ex As New Exporter
ex.SourceTableName = TbName    '指定导出表
ex.FilePath = "d:\temp\" '指定目标文件路径
ex.Format = "Delimited" '导出格式为符号分割的文本文件
ex.NewTableName = "书号" & r("目录期号")  '指定文件名,注意无须扩展名
ex.Fields = "书号" '指定导出列字段
ex.Header = False  '不包括列名称
ex.Export() '开始导出
Dim mc As String = "书号" & r("目录期号") & ".txt"


If FileSys.FileExists("d:\temp\" & mc) Then '如果指定的文件存在
    FileSys.DeleteFile("d:\temp\" & mc,2,2) '则彻底删除之
End If

Dim str As String = FileSys.ReadAllText("d:\temp\" & mc, Encoding.Default)
str = str.Replace("""", "")
str = str.Replace(",", " ")
FileSys.WriteAllText("d:\temp\" & mc, str, False, Encoding.Default)
'End If
MessageBox.Show("已成功导出书号,文本存放在d:\temp\" & mc,"提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
Dim Proc As New Process '定义一个新的Process
Proc.File = "d:\temp\" '指定要打开的文件
Proc.Start()



输出乱码
生成一个名为schema配置文件

[书号1.txt]
ColNameHeader=False
CharacterSet=936
Format=CSVDelimited
Col1=书号 Char Width 26
 回到顶部
帅哥哟，离线，有人找我吗？
zoyong
 小大  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：三尾狐 帖子：668 积分：7918 威望：0 精华：0 注册：2015/8/24 9:02:00 		  发帖心情 Post By：2020/9/19 9:24:00 [显示全部帖子]

Dim ja As JArray = jo("data")("items")
For i As Integer = 0 To ja.Count - 1
    For j As Integer = 0 To ja(i).Count - 1
        cmd.CommandText = "se lect * from {XQ_订单明细} where 下次日期 = '" & ja(i)(1).ToString & "' and 商品代码 ='" & ja(i)(0).ToString & "'"
        Dim dt As DataTable = cmd.ExecuteReader(True)
        If dt.DataRows.count = 0 Then
            Dim dr As DataRow = dt.AddNew()
            dr("商品代码") = ja(i)(0).ToString
            dr("日期") = ja(i)(1).ToString
            dr("商品全称") = ja(i)(2).ToString
            dr("数量") = ja(i)(3).ToString
            dr.Save
        End If
    Next
Next

上面代码有效，但是下载的数据会重复，一条数据保存了5次
 回到顶部
帅哥哟，离线，有人找我吗？
zoyong
 小大  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：三尾狐 帖子：668 积分：7918 威望：0 精华：0 注册：2015/8/24 9:02:00 		  发帖心情 Post By：2020/9/19 9:59:00 [显示全部帖子]

代码

{
    "request_id": "93625048a11dafefd84c45b160a11eaa739b7a0263700966",
    "code": 0,
    "msg": "",
    "data": {
        "fields": [
            "code",
            "date",
            "mkv",
            "stkmkv",
        ],
        "items": [
            [
                "515100",
                "20200630",
                "900023SH",
                2.00,
            ],
            [
                "515101",
                "20200630",
                "901288SH",
                18.80,
            ],
            [
                "515102",
                "20200630",
                "860108SH",
                20.80,
            ],
        ],
        "more": true
    }
}
 回到顶部
帅哥哟，离线，有人找我吗？
zoyong
 小大  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：三尾狐 帖子：668 积分：7918 威望：0 精华：0 注册：2015/8/24 9:02:00 		  发帖心情 Post By：2020/9/22 19:25:00 [显示全部帖子]

For Each file As String In dlg.FileNames
        Dim Book As New XLS.Book(file)
        Dim Sheet As XLS.Sheet = Book.Sheets(0)
        Tables(TbName).StopRedraw()             '注意以下数组中列名称的顺序,必须和Excel表中的列顺序一致
        'msgbox(1)
        Dim nms() As String = {"商品标识","书号","书名","活动_参加否","活动_开始时间","活动_结束时间"}
        Dim lsh As String = sheet(0,0).Text    '第一行第一列
        '注意下面的循环变量从3开始,而不是从0开始,因为Excel表的第一行是标题
        For n As Integer = 1 To Sheet.Rows.Count -1
            Dim bh0 As String = sheet(n,3).Text
            Dim bh1 As String = sheet(n,4).Text
            Dim filter As String = "1=1"
            If bh0 > "" Then
                filter &= " and 商品标识 = '" & bh0 & "'"
            Else
                filter &= " And 商品标识 Is null"
            End If
            If bh1 > "" Then
                filter &= " and 书号 = '" & bh1 & "'"
            Else
                filter &= " And 书号 Is null"
            End If
            'msgbox(2)
            Dim cmd As New SQLCommand        '后台查找
            cmd.C
            cmd.CommandText = "sel ect * from {JD_ERP品种配置} where 1=2"   '不加载数据
            Dim dt As DataTable = cmd.ExecuteReader(True)
            Dim dr As DataRow = dt.sqlFind(filter)
            If dr Is Nothing Then       '如果不存在同编号的订单
                Dim dr1 As Row = Tables(TbName).AddNew()
                For m As Integer = 0 To nms.Length - 1    '开始导入
                    dr1(nms(m)) = Sheet(n,m).Value
                Next
                dr1("创建人") = user_rename
                dr1("创建日期") = Date.Now
                dr1("创建人编号") = user_ID
                hj = hj + 1   '记录导入的条数
            Else
                Dim dr1 As DataRow = dt.DataRows(0)
                For m As Integer = 0 To nms.Length - 1    '开始导入
                    dr1(nms(m)) = Sheet(n,m).Value
                Next
                dr1("编辑人") = user_rename
                dr1("编辑日期") = Date.Now
                dr1("编辑人编号") = user_ID
                hj = hj + 1   '记录导入的条数
            End If
        Next
        
        Tables(TbName).ResumeRedraw()  '停止绘制
        CurrentTable.Save    '保存
    Next         ''-----合计导入--------------


红色代码无效，会重复导入数据
 回到顶部
帅哥哟，离线，有人找我吗？
zoyong
 小大  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：三尾狐 帖子：668 积分：7918 威望：0 精华：0 注册：2015/8/24 9:02:00 		  发帖心情 Post By：2020/9/24 17:13:00 [显示全部帖子]

Dim p As New prt.RenderImage
p.Image = GetImage("c:\1.png") 
Dim g As Graphics = p.Graphics
g.DrawImage(getImage("c:\2.jpg"),50,10)
p.Repaint()


将图片2合并到图片1
[此贴子已经被作者于2020/9/24 17:13:23编辑过]
 回到顶部
帅哥哟，离线，有人找我吗？
zoyong
 小大  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：三尾狐 帖子：668 积分：7918 威望：0 精华：0 注册：2015/8/24 9:02:00 		  发帖心情 Post By：2020/9/24 17:27:00 [显示全部帖子]

Dim img = getimage("c:\1.png")
Dim bmp As new bitmap(img.Width,img.Height) '宽高
Dim g = graphics.fromimage(bmp)
g.DrawImage(img,0,0)
Dim img2 =  getimage("c:\2.jpg")
g.DrawImage(img2,0,0)
bmp.save("c:\3.jpg",img.RawFormat)
bmp.dispose



图片点击可在新窗口打开查看此主题相关图片如下：微信截图_20200924172454.png
图片点击可在新窗口打开查看
 回到顶部
RSS2.0 | Xhtml无图版 | Xslt无图版 Copyright © 2000 - 2018 foxtable.com Tel: 4000-810-820 粤ICP备11091905号
   Powered By Dvbbs Version 8.3.0
页面执行时间 0.06250 秒, 6 次数据查询