Foxtable(狐表)用户栏目专家坐堂 → [下载][分享]一个全屏截图的函数


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

主题:[下载][分享]一个全屏截图的函数

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


加好友 发短信
等级:四尾狐 帖子:936 积分:7725 威望:0 精华:0 注册:2013/7/7 13:37:00
[下载][分享]一个全屏截图的函数  发帖心情 Post By:2013/10/14 1:07:00 [只看该作者]

做了一个全屏截图的函数,方便对窗体画面进行即时保存,当然如果把窗体缩小也可以发布成一个小截图软件(全屏的,不可选区域)
最大优点是可以放在窗体控件中任何事件里,比如 click,mouseMove,甚至是表事件都可以。
你去掉几行代码还可以神不知鬼不觉的自动保存。嘿嘿
函数里有详细注释,大家导入函数就可看到
 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:截图函数.zip




[此贴子已经被作者于2013-10-14 1:30:27编辑过]

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


加好友 发短信
等级:五尾狐 帖子:1128 积分:11041 威望:0 精华:2 注册:2008/9/1 10:45:00
  发帖心情 Post By:2013/10/14 6:10:00 [只看该作者]

凌晨还在分享,非常感谢。

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


加好友 发短信
等级:版主 帖子:5246 积分:33163 威望:0 精华:8 注册:2013/1/17 21:28:00
  发帖心情 Post By:2013/10/14 7:46:00 [只看该作者]

这样的帖子,就得顶。

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


加好友 发短信
等级:四尾狐 帖子:832 积分:5867 威望:0 精华:6 注册:2011/5/27 11:41:00
  发帖心情 Post By:2013/10/14 8:40:00 [只看该作者]

收藏学习,谢谢楼主!

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


加好友 发短信
等级:幼狐 帖子:172 积分:1914 威望:0 精华:0 注册:2012/6/6 17:08:00
  发帖心情 Post By:2013/10/17 19:03:00 [只看该作者]

'截图函数 Functions.Execute("PainterDraw")  可以加给窗体中任何事件比如button的click事件,必须是窗体中才可以
Dim frm As WinForm.Form = Forms.ActiveForm
If frm IsNot Nothing Then
    
    Dim PainterDraw As WinForm.Painter
    PainterDraw = Forms(Forms.ActiveForm.Name).CreateControl("Painter123321", ControlTypeEnum.Painter)
    PainterDraw.SetBounds(-10,-10,6,6) '指定位置和尺寸
    Forms(Forms.ActiveForm.Name).AddControl(PainterDraw)
    '===============
    Dim memoryImage As Bitmap
    Dim p As WinForm.Painter = Forms(Forms.ActiveForm.Name).Controls("Painter123321")
    Dim myGraphics As Graphics = p.Graphics
    'Dim myGraphics As Graphics = Me.CreateGraphics()
    Dim s As Size = New Size(SysInfo.ScreenWidth,SysInfo.ScreenHeight)
    memoryImage = New Bitmap(s.Width, s.Height, myGraphics)
    Dim memoryGraphics As Graphics = Graphics.FromImage(memoryImage)
    memoryGraphics.CopyFromScreen(0, 0, 0, 0, s)
    '=========以上截图=============
    Dim fnt As New Font("宋体",16)
    Dim msg As String
    msg = "【计算机名】" & SysInfo.ComputerName  & vbcrlf '计算机名
    msg = msg & "【操作系统】" &  SysInfo.OSFullName & vbcrlf '操作系统名称
    msg = msg & "【版-本-号】" &  SysInfo.OSVersion & vbcrlf '操作系统版本号
    msg = msg & "【用-户-名】" &  SysInfo.UserName & vbcrlf '登陆操作系统的用户名
    msg = msg & "【可用内存】" &  SysInfo.AvailablePhysicalMemory \ (1024 * 1024) & "MB" & vbcrlf '可用的物理内存
    msg = msg & "【总-内-存】" &  SysInfo.TotalPhysicalMemory \ (1024 * 1024) & "MB"   & vbcrlf '总的物理内存
    msg = msg & "【截图时间】" &  Date.Now & vbcrlf '截图时间
    memoryGraphics.DrawString(msg,fnt,Brushes.Red,10,10)
    '=========以上水印文字============
    Dim str As String = "自动截图(" & Format(Date.Now,"yyMMddHHmm") & ")" &  Rand.Next(1,10000) &  ".jpg"
     memoryImage.Save(ProjectPath & Str)  '这是自动保存,以下是选择保存
    '========选择保存======
    'Dim dlg As New SaveFileDialog '定义一个新的SaveFileDialog
    'dlg.Filter = "图像文件|*.jpg" '设置筛选器
    'dlg.Title = "截图保存为" '设置对话框标题
    'dlg.FileName = str '设置默认文件名
    'If dlg.ShowDialog = DialogResult.Ok Then '如果用户单击了确定按钮
        ' MessageBox.Show("你要保存为:" & dlg.FileName,"提示") '提示用户选择的文件
        'memoryImage.Save(dlg.FileName)
    'End If
    '========选择保存======
    Forms(Forms.ActiveForm.Name).RemoveControl("Painter123321") '从窗口删除指定名称的控件
Else
    MessageBox.Show("无活动窗口!无法截图" )
End If

你好.请教:如何保存截图到指定的文件夹下面?

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


加好友 发短信
等级:四尾狐 帖子:936 积分:7725 威望:0 精华:0 注册:2013/7/7 13:37:00
  发帖心情 Post By:2013/10/17 19:38:00 [只看该作者]

 memoryImage.Save(ProjectPath & Str)  '这是自动保存,以下是选择保存

ProjectPath  改为其它路径

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


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

 呵呵原来最新版可以导入函数了!

 顶一下先。

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


加好友 发短信 一级勋章
等级:超级版主 帖子:7237 积分:40614 威望:0 精华:16 注册:2008/8/31 23:23:00
  发帖心情 Post By:2013/10/17 19:50:00 [只看该作者]

顶一下!

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


加好友 发短信
等级:童狐 帖子:266 积分:2724 威望:0 精华:0 注册:2013/6/29 9:35:00
顶一下  发帖心情 Post By:2015/11/7 15:31:00 [只看该作者]

顶一下

 回到顶部