load_dll.bas

数据库打印例子宫

'These example files are the property of E&B Systems
'E & B Systems  gives no guarantees as to the reliability or suitability
'of this system and accepts no liability in respect of any loss,
'damage or expense arising from use and shall not be liable for any
'consequential damages or expenses or any loss of profit or any
'liability to third parties incurred by anyone relying on this system.



Option Explicit
Declare Function FindResource% Lib "Kernel" (ByVal hInstance%, ByVal lpName$, ByVal lpType As Any)
Declare Function LoadResource% Lib "Kernel" (ByVal hInstance%, ByVal hResInfo%)
Declare Function LockResource& Lib "Kernel" (ByVal hResData%)
Declare Function GlobalUnlock% Lib "Kernel" (ByVal hMem%)
Declare Function sndplaysound Lib "mmsystem" (ByVal filenae As Any, ByVal snd_async As Any) As Integer
Declare Function LoadLibrary Lib "Kernel" (ByVal lpLibFileName As String) As Integer
Declare Function LoadBitmap Lib "User" (ByVal hInstance As Integer, ByVal lpBitmapName As Any) As Integer
Declare Function GetObj Lib "GDI" Alias "GetObject" (ByVal hObject As Integer, ByVal nCount As Integer, lpObject As Any) As Integer
Declare Function CreateCompatibleDC Lib "GDI" (ByVal hDC As Integer) As Integer
Declare Function SelectObject Lib "GDI" (ByVal hDC As Integer, ByVal hObject As Integer) As Integer
Declare Function BitBlt Lib "GDI" (ByVal hDestDC As Integer, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal XSrc As Integer, ByVal YSrc As Integer, ByVal dwRop As Long) As Integer
Declare Function DeleteDC Lib "GDI" (ByVal hDC As Integer) As Integer
Declare Sub FreeLibrary Lib "Kernel" (ByVal hLibModule As Integer)
Declare Function DeleteObject Lib "GDI" (ByVal hObject As Integer) As Integer
Declare Function LoadIcon% Lib "User" (ByVal hInstance%, ByVal lpIconName As Any)
Declare Function DrawIcon% Lib "User" (ByVal hDC%, ByVal x%, ByVal y%, ByVal hicon%)


Type BITMAP '14 bytes
        bmType As Integer
        bmWidth As Integer
        bmHeight As Integer
        bmWidthBytes As Integer
        bmPlanes As String * 1
        bmBitsPixel As String * 1
        bmBits As Long
End Type

Global Const SRCCOPY = &HCC0020

Sub load_icon (icon_pic As String)
Dim hLibInst As Integer
Dim hicon As Integer
Dim ret As Integer

hLibInst = LoadLibrary(app.Path & "\dlltalk.dll")
hicon = LoadIcon(hLibInst, icon_pic)
ret = DrawIcon(form1.Picture2.hDC, 19, 19, hicon)
FreeLibrary (hLibInst)

End Sub

Sub load_pic (pic_pic As String)
Dim hLibInst As Integer
Dim hdcMemory, hLoadedbitmap, hOldBitmap As Integer
Dim ret As Integer
Dim bmpInfo As BITMAP
Dim bmpnum As Long


On Error GoTo no_dll
hLibInst = LoadLibrary(app.Path & "\dlltalk.dll")  'make the DLL Available by est a handle name
On Error GoTo 0
hLoadedbitmap = LoadBitmap(hLibInst, pic_pic)  'Load the bitmap from DLL using the resource name in the DLL
ret = GetObj(hLoadedbitmap, Len(bmpInfo), bmpInfo) 'get the necessary bmp info
hdcMemory = CreateCompatibleDC(form1.Picture1.hDC)  'create a container for the image
hOldBitmap = SelectObject(hdcMemory, hLoadedbitmap)
ret = BitBlt(form1.Picture1.hDC, 0, 0, bmpInfo.bmWidth, bmpInfo.bmHeight, hdcMemory, 0, 0, SRCCOPY)
ret = SelectObject(hdcMemory, hOldBitmap)
ret = DeleteObject(hLoadedbitmap)
ret = DeleteDC(hdcMemory)
FreeLibrary (hLibInst)
Exit Sub
no_dll:
  MsgBox "Make sure the file USMAPS.DLL is in the same directory as the executable.", 64, "Warning"
  End

End Sub

Sub load_sound (wav_pic)
Dim hloadwave As Integer
Dim hwaveres As Integer
Dim hsound As Long
Dim hrelease As Integer
Dim res As Integer
Dim hLibInst As Integer

On Error GoTo no_dll2
hLibInst = LoadLibrary(app.Path & "\dlltalk.dll")  'make the DLL Available by est a handle name
On Error GoTo 0
hwaveres = FindResource(hLibInst, wav_pic, "WAVE")  'In the DLL there is a resource
'named WAVE,  You pass the DLL Handle established above, the name of the sound and the name of the resource

hloadwave = LoadResource(hLibInst, hwaveres)  'now load the resource into memory
hsound = LockResource(hloadwave)  'lock the resource
res = sndplaysound(hsound, 4)     'sndplaysound with option 4 plays the sound from memory

hrelease = GlobalUnlock(hloadwave)  'release the mem holding the sound info
FreeLibrary (hLibInst)  'release the DLL
Exit Sub

no_dll2:
  MsgBox "Make sure the file USMAPS.DLL is in the same directory as the executable.", 64, "Warning"
  End

End Sub