Foxtable(狐表) → 用户栏目 → 专家坐堂 → [分享][原创]列截图功能（解决）谢谢老师们 最后的代码有效


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

主题：[分享][原创]列截图功能（解决）谢谢老师们 最后的代码有效
帅哥哟，离线，有人找我吗？
yifan3429
 小大  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：九尾狐 帖子：2466 积分：22761 威望：0 精华：0 注册：2011/3/29 17:14:00 		[分享][原创]列截图功能（解决）谢谢老师们 最后的代码有效  发帖心情 Post By：2016/8/5 7:18:00 [只看该作者]

现在fox 有内置的截图功能   
我现在有一个图片列  想直接再点击增加的时候就会出现截图功能  直接截图能行吗  哪里有案例  谢谢



解决代码如下  ：

If e.Col.name = "图片" Then
baseMainForm.WindowState= Windows.forms.FormWindowState.Minimized（最小化）
    ClipBoard.Clear
    Dim proc As new Process
    proc.File = ApplicationPath & "/capture.exe"
    proc.WaitForClose = True
    proc.Start
    If ClipBoard.GetImage IsNot Nothing Then
        Dim f As String =  e.Row("项目") & "\"  & "报价配图"  & "\"& Format( date.Today,"yyyy-MM-dd") & "/" & e.Row("产品名") & e.Row("工艺用材说明") & ".jpg"
        Dim path As String = e.Col.DataCol.DefaultFolder
        If path = "" Then
            path = ProjectPath & "Attachments/"
        End If
        basemainform.WindowState = 2（最大化）
        Dim dir As String = FileSys.GetParentPath(path & "/" & f)
        If FileSys.DirectoryExists(dir) = False Then FileSys.CreateDirectory(dir)
        ClipBoard.GetImage.save(path & "/" & f)
        e.Row(e.Col.name) = f
        
    End If
    e.cancel = True
End If
[此贴子已经被作者于2016/8/5 22:06:54编辑过]
 回到顶部
帅哥哟，离线，有人找我吗？
yifan3429
 小大  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：九尾狐 帖子：2466 积分：22761 威望：0 精华：0 注册：2011/3/29 17:14:00 		  发帖心情 Post By：2016/8/5 8:13:00 [只看该作者]

实例
 下载信息  [文件大小：   下载次数： ]
图片点击可在新窗口打开查看点击浏览该文件:列截图自动增加到当前行.zip
 回到顶部
帅哥哟，离线，有人找我吗？
大红袍
 小大  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：贵宾 帖子：39310 积分：196782 威望：0 精华：1 注册：2015/4/25 9:23:00 		  发帖心情 Post By：2016/8/5 10:06:00 [只看该作者]

CellButtonClick事件

 

If e.Col.name = "截图功能" Then
    ClipBoard.Clear
    Dim proc As new Process
    proc.File = ApplicationPath & "/capture.exe"
    proc.WaitForClose = True
    proc.Start
    If ClipBoard.GetImage IsNot Nothing Then
        Dim f As String = ProjectPath & format(Date.now, "yyyyMMddHHmmss") & ".jpg"
        ClipBoard.GetImage.save(ProjectPath & format(Date.now, "yyyyMMddHHmmss") & ".jpg")
        e.Row(e.Col.name) = f
    End If
    e.cancel = True
End If
 回到顶部
帅哥哟，离线，有人找我吗？
yifan3429
 小大  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：九尾狐 帖子：2466 积分：22761 威望：0 精华：0 注册：2011/3/29 17:14:00 		  发帖心情 Post By：2016/8/5 14:45:00 [只看该作者]

If e.Col.name = "图片" Then
    ClipBoard.Clear
    Dim proc As new Process
    proc.File = ApplicationPath & "/capture.exe"
    proc.WaitForClose = True
    proc.Start
    If ClipBoard.GetImage IsNot Nothing Then
        Select Case e.DataCol.Name
            Case "图片"
                e.SubFolder =  dr("项目") & "\"  & "报价配图"  & "\"& Format( date.Today,"yyyy-MM-dd")
                Dim s As String = e.filename
                Dim Index As Integer = s.LastIndexOf(".")
                Dim hz As String = s.SubString(Index,s.length-Index)
                e.filename=e.DataRow("产品名") & e.DataRow("工艺用材说明")& hz
                SystemReady = True
        End Select
    End If
    e.cancel = True
End If

---------------------------
提示
---------------------------
找不到自定义函数"处理快捷键"！
---------------------------
确定   
---------------------------



---------------------------
错误
---------------------------
编译错误:“DataCol”不是“RowColEventArgs”的成员。



错误代码：Select Case e.DataCol.Name
---------------------------
确定   
---------------------------


我改成这样不好使  
需求 
启动截屏时最小化项目  完成后  回到项目界面   
[此贴子已经被作者于2016/8/5 14:46:12编辑过]
 回到顶部
帅哥哟，离线，有人找我吗？
大红袍
 小大  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：贵宾 帖子：39310 积分：196782 威望：0 精华：1 注册：2015/4/25 9:23:00 		  发帖心情 Post By：2016/8/5 14:57:00 [只看该作者]

If e.Col.name = "图片" Then
    ClipBoard.Clear
    Dim proc As new Process
    proc.File = ApplicationPath & "/capture.exe"
    proc.WaitForClose = True
    proc.Start
    If ClipBoard.GetImage IsNot Nothing Then
        Dim f As String =  e.row("项目") & "\"  & "报价配图"  & "\"& Format( date.Today,"yyyy-MM-dd") & "/" & e.Row("产品名") & e.Row("工艺用材说明") & ".jpg"
        Dim path As String = e.Col.DataCol.DefaultFolder
        If path = "" Then
            path = ProjectPath & "Attachments/"
        End If
        Dim dir As String = FileSys.GetParentPath(path & "/" & f)
        If FileSys.DirectoryExists(dir) = False Then FileSys.CreateDirectory(dir)
        ClipBoard.GetImage.save(path & "/" & f)
        e.Row(e.Col.name) = f
    End If
    e.cancel = True
End If

 回到顶部
帅哥哟，离线，有人找我吗？
yifan3429
 小大  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：九尾狐 帖子：2466 积分：22761 威望：0 精华：0 注册：2011/3/29 17:14:00 		  发帖心情 Post By：2016/8/5 20:46:00 [只看该作者]

解决了 

[此贴子已经被作者于2016/8/5 22:05:32编辑过]
 回到顶部
帅哥哟，离线，有人找我吗？
yifan3429
 小大  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：九尾狐 帖子：2466 积分：22761 威望：0 精华：0 注册：2011/3/29 17:14:00 		  发帖心情 Post By：2016/8/6 8:17:00 [只看该作者]


If e.Col.name = "图片" Then
baseMainForm.WindowState= Windows.forms.FormWindowState.Minimized
    ClipBoard.Clear
    Dim proc As new Process
    proc.File = ApplicationPath & "/capture.exe"
    proc.WaitForClose = True
    proc.Start
    If ClipBoard.GetImage IsNot Nothing Then
        Dim f As String =  e.Row("项目") & "\"  & "报价配图"  & "\"& Format( date.Today,"yyyy-MM-dd") & "/" & e.Row("产品名") & ".png"
        Dim path As String = e.Col.DataCol.DefaultFolder
        If path = "" Then
            path = ProjectPath & "Attachments/"
        End If
        basemainform.WindowState = 2
        Dim dir As String = FileSys.GetParentPath(path & "/" & f)
        If FileSys.DirectoryExists(dir) = False Then FileSys.CreateDirectory(dir)
        ClipBoard.GetImage.save(path & "/" & f)
        e.Row(e.Col.name) = f        
    End If
    e.cancel = True
End If


Dim dr As DataRow = e.DataRow
If dr.IsNull ("客户") Or Dr.IsNull("订单名称")  Then
    MessageBox.show("本次结果,订单名称  主题列为必填项目","提示")
    e.cancel = True
Else
    


上面针对于一个图片列

下面是一个表有多个图片列  

我想请教简化后的代码如何写  不同的焦点  选择对应存储位置和存储条件

    Select Case e.DataCol.Name
        Case "主要工艺"
            e.SubFolder =  dr("文件编号") & "\"  & "主要工艺"  & "\"
            SystemReady = True
        Case "基层图"
            e.SubFolder =  dr("文件编号") & "\"  & "基层图"  & "\"& Format( date.Today,"yyyy-MM-dd")
            SystemReady = True
        Case "效果图"
            e.SubFolder =  dr("文件编号") & "\"  & "效果图"  & "\"& Format( date.Today,"yyyy-MM-dd")
            SystemReady = True
        Case "客来文件"
            e.SubFolder =  dr("文件编号") & "\"  & "客来文件"  & "\"& Format( date.Today,"yyyy-MM-dd")
            SystemReady = True
        Case "设计文件"
            e.SubFolder =  dr("文件编号") & "\"  & "设计文件"  & "\"& Format( date.Today,"yyyy-MM-dd")
            SystemReady = True
        Case "定稿文件"
            e.SubFolder =  dr("文件编号") & "\"  & "定稿文件"  & "\"& Format( date.Today,"yyyy-MM-dd")
            SystemReady = True
    End Select
End If
[此贴子已经被作者于2016/8/6 8:17:43编辑过]
 回到顶部
RSS2.0 | Xhtml无图版 | Xslt无图版 Copyright © 2000 - 2018 foxtable.com Tel: 4000-810-820 粤ICP备11091905号
   Powered By Dvbbs Version 8.3.0
页面执行时间 0.07031 秒, 5 次数据查询