vb图像柔化代码百度贴吧的简单介绍
admin 发布:2022-12-19 19:20 143
今天给各位分享vb图像柔化代码百度贴吧的知识,其中也会对进行解释,如果能碰巧解决你现在面临的问题,别忘了关注本站,现在开始吧!
本文目录一览:
vb 请教高手
如何实现浮雕效果的深度及灯光效果的角度均可调节,并增加水彩的效果的图像处理?
首先,你先学习一下美术吧,里面会有介绍的;
其次,到网上搜索一下吧,浮雕效果的制作等;
然后,再考虑怎么用VB实现吧;
最后,请选择SDK来实现。
程序说明
可以对512*512的256色位图进行锐化、浮雕效果处理。
锐化图像 锐化图像就是要突出形体的边缘。边缘也就是颜色值发生显著变化的地方,在程序中采取了下列算法。
New_color=original_color+0.5* different
differert表示相邻像素之间的差值。0.5为锐化系数,系数越大,锐化效果就越突出。
浮雕效果 浮雕效果是只取相邻像素的差值。这时,图像的平淡区被完全“抹平”,只能看到图像的边缘,程序中采用的算法如下:
new_color=different+128
扩散效果 扩散效果在图像中引入了一定的随机性,使图像有油画般的效果。应在当前像素点周围5*5的像素块中随机取一点作为当前像素值。
柔化图像 柔化操作使原图看起来更加柔和,有种蒙胧感。柔化可以削减图像中颜色的显著变化,使形体的边界趋于平滑。柔化图像,就是要减少像素之间较大的差别。取以当前像素为中心的3*3的像素块,取这个像素块中颜色的平均值和周围像素趋于一致,这样就削减了颜色的显著变化。对图像中每个像素点都进行同样的操作,就构成了对整幅图像的柔化。
影响柔化程度的一个因素是选取像素块的大小。所选取的像素块越大,产生的柔化效果越强烈,加强柔化效果,即通过改变像素块的大小来调节柔化强度。
马赛克效果 将欲生成马赛克效果的图像分成n*n个像素块,每个像素块的像素取平均值作为这n*n个像素点的值。
VB图像保存程序代码
因为默认的保存无论你选择什么格式后缀,其实都是bmp位图,你看文件尺寸就知道了。
通常保存图片代码:(默认pictrebox名称)
dim filepath as string
SavePicture Picture1.Image,filepath
当然,filepath路径的获得你可以用对话框确定一下。
我要给你的代码是可以保存多种格式的。需要添加一个模块,模块代码最后贴
调用示范:
'先正常保存文件
Dim fileStr As String
fileStr = App.Path "\temp\mymp.gif" '定义临时文件,并检查是否有同名文件,有则清除
If Dir(fileStr) "" Then Kill fileStr
SavePicture Picture1.Image, fileStr
'再转换格式,这里转成gif
Dim stdpic As StdPicture
Set stdpic = LoadPicture(fileStr)
Call SavePic(stdpic, fileStr, ".gif")
Set stdpic = Nothing
'模块代码:
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Type EncoderParameter
GUID As GUID
NumberOfValues As Long
type As Long
Value As Long
End Type
Private Type EncoderParameters
count As Long
Parameter As EncoderParameter
End Type
Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long
Private Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" (ByVal hbm As Long, ByVal hPal As Long, BITMAP As Long) As Long
Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal Image As Long) As Long
Private Declare Function GdipSaveImageToFile Lib "GDIPlus" (ByVal Image As Long, ByVal FileName As Long, clsidEncoder As GUID, encoderParams As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal Str As Long, id As GUID) As Long
Private Declare Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb As Long) As Long
'*************************************************************************
'** 作 者 : laviewpbt
'** 函 数 名 : SavePic
'** 输 入 : pic(StdPicture) - 图象句柄
'** : FileName(String) - 保存路径
'** : Quality(Byte) - JPG图象质量
'** : TIFF_ColorDepth(Long) - TTF格式的颜色深度
'** : TIFF_Compression(Long) - TTF格式的压缩比
'** 输 出 : 无
'** 功能描述 : 把图象保存为JPG、TIFF、PNG、GIF、BMP格式
'** 日 期 :
'** 修 改 人 : laviewpbt
'** 日 期 : 2005-10-23 14.43.52
'** 版 本 : Version 1.2.1
'*************************************************************************
Public Sub SavePic(ByVal pict As StdPicture, ByVal FileName As String, PicType As String, _
Optional ByVal Quality As Byte = 80, _
Optional ByVal TIFF_ColorDepth As Long = 24, _
Optional ByVal TIFF_Compression As Long = 6)
Screen.MousePointer = vbHourglass
Dim tSI As GdiplusStartupInput
Dim lRes As Long
Dim lGDIP As Long
Dim lBitmap As Long
Dim aEncParams() As Byte
On Error GoTo ErrHandle:
tSI.GdiplusVersion = 1 ' 初始化 GDI+
lRes = GdiplusStartup(lGDIP, tSI)
If lRes = 0 Then ' 从句柄创建 GDI+ 图像
lRes = GdipCreateBitmapFromHBITMAP(pict.Handle, 0, lBitmap)
If lRes = 0 Then
Dim tJpgEncoder As GUID
Dim tParams As EncoderParameters '初始化解码器的GUID标识
Select Case PicType
Case ".jpg"
CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder
tParams.count = 1 ' 设置解码器参数
With tParams.Parameter ' Quality
CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID ' 得到Quality参数的GUID标识
.NumberOfValues = 1
.type = 4
.Value = VarPtr(Quality)
End With
ReDim aEncParams(1 To Len(tParams))
Call CopyMemory(aEncParams(1), tParams, Len(tParams))
Case ".png"
CLSIDFromString StrPtr("{557CF406-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder
ReDim aEncParams(1 To Len(tParams))
Case ".gif"
CLSIDFromString StrPtr("{557CF402-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder
ReDim aEncParams(1 To Len(tParams))
Case ".tiff"
CLSIDFromString StrPtr("{557CF405-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder
tParams.count = 2
ReDim aEncParams(1 To Len(tParams) + Len(tParams.Parameter))
With tParams.Parameter
.NumberOfValues = 1
.type = 4
CLSIDFromString StrPtr("{E09D739D-CCD4-44EE-8EBA-3FBF8BE4FC58}"), .GUID ' 得到ColorDepth参数的GUID标识
.Value = VarPtr(TIFF_Compression)
End With
Call CopyMemory(aEncParams(1), tParams, Len(tParams))
With tParams.Parameter
.NumberOfValues = 1
.type = 4
CLSIDFromString StrPtr("{66087055-AD66-4C7C-9A18-38A2310B8337}"), .GUID ' 得到Compression参数的GUID标识
.Value = VarPtr(TIFF_ColorDepth)
End With
Call CopyMemory(aEncParams(Len(tParams) + 1), tParams.Parameter, Len(tParams.Parameter))
Case ".bmp" '可以提前写保存为BMP的代码,因为并没有用GDI+
SavePicture pict, FileName
Screen.MousePointer = vbDefault
Exit Sub
End Select
lRes = GdipSaveImageToFile(lBitmap, StrPtr(FileName), tJpgEncoder, aEncParams(1)) '保存图像
GdipDisposeImage lBitmap ' 销毁GDI+图像
End If
GdiplusShutdown lGDIP '销毁 GDI+
End If
Screen.MousePointer = vbDefault
Erase aEncParams
Exit Sub
ErrHandle:
Screen.MousePointer = vbDefault
MsgBox "在保存图片的过程中发生错误:" vbCrLf vbCrLf "错误号: " Err.Number vbCrLf "错误描述: " Err.Description, vbInformation Or vbOKOnly, "错误"
End Sub
我想在VB中做界面美化,界面有很多按钮,想加载一张(JPG或PNG的)图片变成背景,又不遮住按钮。求代码
Private Sub Form_Load()
Form1.Picture = LoadPicture("D:\1\2\3\4.jpg")
End Sub
就少少少 1个 “1”啊
vb图像柔化代码百度贴吧的介绍就聊到这里吧,感谢你花时间阅读本站内容,更多关于、vb图像柔化代码百度贴吧的信息别忘了在本站进行查找喔。
版权说明:如非注明,本站文章均为 AH站长 原创,转载请注明出处和附带本文链接;
相关推荐
- 03-29青岛seo的简单介绍
- 03-29网络广告的形式有哪些(网络广告的形式有哪些简单介绍)
- 03-29一个人免费观看高清在线观看的简单介绍
- 03-28工商注册代理的简单介绍
- 03-28html网页布局模板(html网页布局模板代码)
- 03-28html简单网页代码成品(用html制作网站代码)
- 03-28最简单的网页制作软件(网页制作教程软件)
- 03-28web前端网页设计代码(web前端网页设计代码作业)
- 03-28简单的个人主页网站制作(简单的个人主页网站制作)
- 03-28简单搜索网页版入口(简单搜索app下载安装)
取消回复欢迎 你 发表评论:
- 标签列表
- 最近发表
- 友情链接