当前位置:首页 > 代码 > 正文

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站长 原创,转载请注明出处和附带本文链接;

本文地址:http://ahzz.com.cn/post/20018.html


取消回复欢迎 发表评论:

分享到

温馨提示

下载成功了么?或者链接失效了?

联系我们反馈

立即下载