VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)

VB爱好者乐园(VBGood)

 找回密码
 立即注册
搜索
查看: 6558|回复: 11

电脑作图-模拟手绘(附源码)

[复制链接]
 楼主| 发表于 2011-8-3 17:20:12 | 显示全部楼层 |阅读模式
本帖最后由 freehack 于 2011-8-3 17:20 编辑

读取一张 黑白图片
电脑根据线条模拟手绘

界面很粗糙...不过意思很明白

把鼠标换成画笔,就可以看的很形象了...哇..电脑在画画...

换上好友照片(转换为黑白,程序附带转换黑白功能,以及黑白阀值)发给好友....哇哈哈哈....

那个..画图顺序是从左到右...哪位有兴趣的改动下..从随机位置开始....这样就更逼真了....




电脑绘图.rar

182.19 KB, 下载次数: 651

发表于 2011-8-4 11:00:45 | 显示全部楼层
程序附带转换黑白功能,没有发现
回复 支持 反对

使用道具 举报

 楼主| 发表于 2011-8-4 11:59:10 | 显示全部楼层
打开 源代码,工程文件..在窗体上有转换按钮....不过设置的很凌乱..代码过程都有..exe运行窗体里面按钮我给visible=false 了
回复 支持 反对

使用道具 举报

 楼主| 发表于 2011-8-4 12:05:25 | 显示全部楼层
这个是彩色转换黑白的代码



Pic1.Cls

Dim W As Integer, H As Integer, I As Integer, J As Integer
Dim W2 As Integer, H2 As Integer, I2 As Integer, J2 As Integer

Dim BI As BITMAPINFO
'1 获得图片2数据
W2 = ScaleX(Pic2.Picture.Width, vbHimetric, vbPixels)
H2 = ScaleY(Pic2.Picture.Height, 8, 3)

With BI.bmiHeader
    .biSize = Len(BI.bmiHeader)
    .biWidth = W2
    .biHeight = -H2
    .biBitCount = 32
    .biPlanes = 1
End With

ReDim yPic(3, W2 - 1, H2 - 1)

'将一幅位图P2的二进制位 复制到一幅与设备无关的位图里
I = GetDIBits(Pic2.hdc, Pic2.Picture.Handle, 0, H2, yPic(0, 0, 0), BI, DIB_RGB_COLORS)
'Debug.Print I
'如果在这里处理一下,图像大的话,可能会快一点。

        For I2 = 0 To W2 - 1
            For J2 = 0 To H2 - 1
                If (yPic(2, I2, J2) * 0.9 + yPic(1, I2, J2) * 0.9 + yPic(0, I2, J2) * 0.9) / 3 < Val(Text1.Text) Then  '这里的text是转换阀值,也就是深度
                    Pic2.PSet (I2, J2), 0
                Else
                   Pic2.PSet (I2, J2), RGB(255, 255, 255)
                End If
               
            Next J2
             DoEvents
        Next I2

Pic2.Picture = Pic2.Image

ReleaseDC 0, hDCPS
回复 支持 反对

使用道具 举报

发表于 2012-2-19 18:41:48 | 显示全部楼层
学习下
回复 支持 反对

使用道具 举报

发表于 2012-2-25 15:46:11 | 显示全部楼层
学习啦!
回复 支持 反对

使用道具 举报

发表于 2012-2-25 18:11:34 | 显示全部楼层
玩玩  哈哈!@
回复 支持 反对

使用道具 举报

发表于 2012-3-1 05:46:33 | 显示全部楼层
哈哈,好玩。
回复 支持 反对

使用道具 举报

发表于 2014-1-12 20:45:31 | 显示全部楼层
很不错,谢谢分享!
回复 支持 反对

使用道具 举报

发表于 2014-3-4 17:33:57 | 显示全部楼层
谢谢分享,,
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

文字版|手机版|小黑屋|VBGood  

GMT+8, 2020-6-7 03:46

VB爱好者乐园(VBGood)
快速回复 返回顶部 返回列表