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

freehack · 发表于 2011-8-3 17:20:12

本帖最后由 freehack 于 2011-8-3 17:20 编辑

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

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

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

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

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

jwen · 发表于 2011-8-4 11:00:45

程序附带转换黑白功能，没有发现

freehack · 发表于 2011-8-4 11:59:10

打开源代码,工程文件..在窗体上有转换按钮....不过设置的很凌乱..代码过程都有..exe运行窗体里面按钮我给visible=false 了

freehack · 发表于 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

kuna9429 · 发表于 2012-2-19 18:41:48

学习下

kuna9429 · 发表于 2012-2-25 15:46:11

学习啦！

?金灯剑客? · 发表于 2012-2-25 18:11:34

玩玩哈哈！@

zest24 · 发表于 2012-3-1 05:46:33

哈哈，好玩。

luorl · 发表于 2014-1-12 20:45:31

很不错，谢谢分享！

djrm_yb · 发表于 2014-3-4 17:33:57

谢谢分享，，

		自动登录	找回密码
密码			立即注册

VBGood网站全文搜索

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