VB动态加载纯DLL资源

一、纯DLL资源的制作

           打开VC6.0 创建一个基于win32的动态链接库

下一步中，要选择A sinmple Dll project

             然后加载资源（注意对于超过256色的位图，VC不能编辑，不过这没关系）

可以加载位图、图标、字符串等，这是加载后的情况

 资源添加完毕后，编译。（最好设为发布模式）

这样，一个纯资源DLL就编译完毕了。

 二、VB动态调用资源DLL

           调用很简单，源码如下:

'*************************************************************************

'**                   叶帆源码     CSDN：yefanqiu

'**-----------------------------------------------------------------------

Option Explicit

Private Const IDS_STRING1     As Long = 1

Private Const IDS_STRING2     As Long = 2

Private Const IDS_STRING3     As Long = 3

Private Const IDI_ICON1       As Long = 101

Private Const IDB_BITMAP1     As Long = 102

Private Const IDB_BITMAP2     As Long = 103

Private Const DST_BITMAP = 4

Private Const OBJ_BITMAP = 7

'位图结构

Private Type BITMAPINFOHEADER '40 bytes

        biSize As Long

        biWidth As Long

        biHeight As Long

        biPlanes As Integer

        biBitCount As Integer

        biCompression As Long

        biSizeImage As Long

        biXPelsPerMeter As Long

        biYPelsPerMeter As Long

        biClrUsed As Long

        biClrImportant As Long

End Type

Private Type RGBQUAD

        rgbBlue As Byte

        rgbGreen As Byte

        rgbRed As Byte

        rgbReserved As Byte

Private Type BITMAPINFO

        bmiHeader As BITMAPINFOHEADER

        bmiColors As RGBQUAD

Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long

Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long

Private Declare Function LoadString Lib "user32" Alias "LoadStringA" (ByVal hInstance As Long, ByVal wID As Long, ByVal lpBuffer As String, ByVal nBufferMax As Long) As Long

Private Declare Function LoadBitmap Lib "user32" Alias "LoadBitmapA" (ByVal hInstance As Long, ByVal lpBitmapName As Long) As Long

Private Declare Function LoadIcon Lib "user32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As Long) As Long

Private Declare Function GetObjectType Lib "gdi32" (ByVal hgdiobj As Long) As Long

Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

Private Declare Function DrawIcon Lib "user32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long

Private Declare Function DrawState Lib "user32" Alias "DrawStateA" (ByVal hDC As Long, ByVal hBrush As Long, ByVal lpDrawStateProc As Long, ByVal lParam As Long, ByVal wParam As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal n3 As Long, ByVal n4 As Long, ByVal un As Long) As Long

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

'**函 数 名：LoadRes

'**输    入：无

'**输    出：无

'**功能描述：资源加载

'**全局变量：

'**调用模块：

'**作    者：叶帆

'**日    期：2005-03-15 12:27:34

'**修 改 人：

'**日    期：

'**版    本：V1.0.0

Private Sub LoadRes()

    Dim hRes As Long

    Dim strData As String

    Dim hBmp As Long

    Dim hIcon As Long

    Dim bitBmp As BITMAPINFO

    '加载DLL

    hRes = LoadLibrary(Combo1.Text)

    '字符串

    strData = Space(255)

    LoadString hRes, IDS_STRING1, strData, 255

    Label1(0).Caption = Trim(strData)

    LoadString hRes, IDS_STRING2, strData, 255

    Label1(1).Caption = Trim(strData)

    LoadString hRes, IDS_STRING3, strData, 255

    Label1(2).Caption = Trim(strData)

    '位图

    hBmp = LoadBitmap(hRes, IDB_BITMAP1)

    If GetObjectType(hBmp) = OBJ_BITMAP Then

      GetObject hBmp, Len(bitBmp), bitBmp

      DrawState Picture1(0).hDC, 0, ByVal 0, hBmp, 0, 0, 0, bitBmp.bmiHeader.biWidth, bitBmp.bmiHeader.biHeight, DST_BITMAP

    End If

    '图标

    hIcon = LoadIcon(hRes, IDI_ICON1)

    DrawIcon Picture1(1).hDC, 0, 0, hIcon

    '释放资源

    DeleteObject hBmp

    DeleteObject hIcon

    '释放DLL

    FreeLibrary hRes

End Sub

'**函 数 名：Combo1_Click

'**功能描述：更换DLL

'**日    期：2005-03-15 12:28:49

Private Sub Combo1_Click()

   LoadRes

'**函 数 名：Form_Load

'**功能描述：初始化

'**日    期：2005-03-15 12:28:58

Private Sub Form_Load()

    Combo1.ListIndex = 0

    LoadRes

'**函 数 名：Picture1_Paint

'**输    入：Index(Integer) -

'**功能描述：刷新

'**日    期：2005-03-15 12:29:03

Private Sub Picture1_Paint(Index As Integer)

        运行后的界面：

  运行后的界面：