vb 如何 添加 标准模块 到自己的 工程里

vb 如何 添加 标准模块 到自己的 工程里,第1张

标准模块就是指的模块。

因为广义上窗体、类、用户定义控件都叫模块。故用“标准模块”来指代“模块”。

======================================================

菜单:“工程”=>“添加模块”=>“打开”

这样就在工程里添加了一个标准模块。这时按“保存”按钮就可以保存为Bas文件。

逐字逐句地看完这个帖子以后,我的心久久不能平静。

凡需要在整个工程范围内使用的变量、过程、类型和API函数声明都可放在标准模块中使用。

1.标准模块,只包含过程、类型以及数据的声明和定义的模块。在标准模块中,模块级别声明和定义都被默认为 Public。在 Visual Basic 的早期版本中将标准模块看作代码模块。是将那些与特定窗体或控件无关的代码(文件扩展名为 .BAS )中。

标准模块中可以包含变量、常数、类型、外部过程和全局过程的全局(在整个应用程序范围内有效的)声明或模块级声明。

2.一个过程可能用来响应几个不同对象中的事件,应该将这个过程放在标准模块中,而不应在每一个对象的事件过程中重复相同的代码。

3.在数据存储方式上,标准模块的数据不可能多于一份。这意味着若程序中某个部分改动了标准模块的公共变量,随后程序的其它部分读取该变量会得到该值。

4.标准模块中的数据在程序作用域内存在,也就是说,它存在于程序的存活期中。

5.当变量在标准模块中声明为 Public 时,则它在工程中任何地方都是可见的。

标准模块代码实例,其中声明了API函数和对象类型及将位图转换为JPG格式的过程,供整个应用程序的存活期中使用图形格式转换用。

Option Explicit

    Public Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, ByVal outputbuf As Long) As Long

    Public Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long

    Public Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" (ByVal hbm As Long, ByVal hpal As Long, Bitmap As Long) As Long

    Public Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal Image As Long) As Long

    Public Declare Function GdipSaveImageToFile Lib "GDIPlus" (ByVal Image As Long, ByVal fileName As Long, clsidEncoder As GUID, encoderParams As Any) As Long

    Public Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long

    Public Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal fileName As Long, Bitmap As Long) As Long

    Public Type GUID

        Data1 As Long

        Data2 As Integer

        Data3 As Integer

        Data4(0 To 7) As Byte

    End Type

    Public Type GdiplusStartupInput

        GdiplusVersion As Long

        DebugEventCallback As Long

        SuppressBackgroundThread As Long

        SuppressExternalCodecs As Long

    End Type

    Public Type EncoderParameter

        GUID As GUID

        NumberOfValues As Long

        type As Long

        Value As Long

    End Type

    Public Type EncoderParameters

        Count As Long

        Parameter As EncoderParameter

    End Type

Public Function PictureBoxSaveJPG(ByVal pict As StdPicture, ByVal fileName As String, Optional ByVal quality As Byte = 80) As Boolean

    Dim tSI As GdiplusStartupInput

    Dim lRes As Long

    Dim lGDIP As Long

    Dim lBitmap As Long

    '初始化 GDI+

    tSI.GdiplusVersion = 1

    lRes = GdiplusStartup(lGDIP, tSI, 0)

    If lRes = 0 Then

        '从句柄创建 GDI+ 图像

        lRes = GdipCreateBitmapFromHBITMAP(pict.Handle, 0, lBitmap)

        

        If lRes = 0 Then

            Dim tJpgEncoder As GUID

            Dim tParams As EncoderParameters

            

            '初始化解码器的GUID标识

            CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder

            

            '设置解码器参数

            tParams.Count = 1

            With tParams.Parameter ' Quality

                '得到Quality参数的GUID标识

                CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID

                .NumberOfValues = 1

                .type = 4

                .Value = VarPtr(quality)

            End With

            

            '保存图像

            lRes = GdipSaveImageToFile(lBitmap, StrPtr(fileName), tJpgEncoder, tParams)

            

            '销毁GDI+图像

            GdipDisposeImage lBitmap

        End If

        

        '销毁 GDI+

        GdiplusShutdown lGDIP

    End If

    

    If lRes Then

        PictureBoxSaveJPG = False

    Else

        PictureBoxSaveJPG = True

    End If

End Function

调用标准模块中转换图片格式PictureBoxSaveJPG过程的某窗体按钮事件代码实例代码:

Private Sub Command3_Click()

    ' 设置“CancelError”为 True

    CommonDialog1.CancelError = True

    On Error GoTo ErrHandler

    ' 设置标志

    CommonDialog1.Flags = cdlOFNHideReadOnly

    ' 设置过滤器

    CommonDialog1.Filter = "JPEG Files" & "(*.jpg)|*.jpg"

    ' 指定缺省的过滤器

    CommonDialog1.FilterIndex = 2

    ' 显示“打开”对话框

    CommonDialog1.ShowSave

    ' 显示选定文件的名字

    'MsgBox CommonDialog1.fileName

    Set Picture2.Picture = Picture1.Image '转移Picture1所绘图为Picture2.Picture赋值

    Dim ret As Boolean

    ret = PictureBoxSaveJPG(Picture2, CommonDialog1.fileName) '保存压缩后的图片

    If ret = False Then

        MsgBox "保存失败"

    End If

    Exit Sub

    

ErrHandler:

    ' 用户按了“取消”按钮

    Exit Sub

End Sub


欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/bake/11688755.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-18
下一篇 2023-05-18

发表评论

登录后才能评论

评论列表(0条)

保存