strongm Re: Cards.dll and Win98

[RMS001]

Hi strongm
I think I have corrected my code to match your revision:
rem'd the original LoadLibrary and FreeLibrary Declares,
added the new Library16 ones, and changed the calls to point to the new ones,
but get this error message - "Can't find DLL entry point 35 in kernal32".

This module produces the problem:

Private Sub vbcdtInit(cdtWidth As Long, cdtHeight As Long)
Dim hModule As Long

[ I get this error message 'Can't find entry point 35 in kernel32' from the
[ folowing line of code ]

hModule = LoadLibrary16("cards.dll&quot


cdtWidth = HiMetricToPixels(getCardBitmap(hModule, 1).Width, ctWidth)
cdtHeight = HiMetricToPixels(getCardBitmap(hModule, 1).Height, ctHeight)
FreeLibrary16 hModule
End Sub


Here is the code as I have entered it.
If you can steer me right I would be grateful, - Ron


Option Explicit

Private Declare Function LoadLibrary16 Lib "kernel32" Alias "#35" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary16 Lib "kernel32" Alias "#36" (ByVal hLibModule As Long) As Long

'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 LoadBitmap Lib "user32" Alias "LoadBitmapA" (ByVal hInstance As Long, ByVal lpBitmapName As String) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Type PicBmp
Size As Long
Type As Long
hBmp As Long
hPal As Long
Reserved As Long
End Type

Public Enum cdtSuit
ecsClubs = 0
ecsDiamonds = 1
ecsHearts = 2
ecsSpades = 3
End Enum

Public Enum cdtBacks
ecbCROSSHATCH = 53
ecbWEAVE1 = 54
ecbWEAVE2 = 55
ecbROBOT = 56
ecbFLOWERS = 57
ecbVINE1 = 58
ecbVINE2 = 59
ecbFISH1 = 60
ecbFISH2 = 61
ecbSHELLS = 62
ecbCASTLE = 63
ecbISLAND = 64
ecbCARDHAND = 65
ecbUNUSED = 66
ecbTHE_X = 67
ecbTHE_O = 68
End Enum

Private Enum ConversionType
ctWidth
ctHeight
End Enum

Public cdtWidth As Long
Public cdtHeight As Long

Private Sub Command1_Click()
Dim Card As Long
Dim Suit As cdtSuit
vbcdtInit cdtWidth, cdtHeight
For Suit = ecsClubs To ecsSpades
For Card = 1 To 13
vbcdtDraw Form1.hdc, (Card - 1) * cdtWidth / 3 + Suit * 16, Suit * cdtHeight / 3, GetCard(Card, Suit), 0, RGB(127, 127, 127)
Next
Next
Refresh
End Sub

' This is the important bit, that extracts the card bitmap from the loaded DLL
' and returns it as a StdPicture
Private Function getCardBitmap(hCardDLL As Long, CardVal As Long) As StdPicture
Dim hBitmap As Long
hBitmap = LoadBitmap(hCardDLL, "#" & CStr(CardVal)) ' Ace Clubs
Set getCardBitmap = BitmapToPicture(hBitmap)
End Function

Private Function BitmapToPicture(ByVal hBmp As Long) As StdPicture
Dim oNewPic As Picture
Dim tPicConv As PicBmp
Dim IGuid As GUID

With tPicConv
.Size = Len(tPicConv)
.Type = vbPicTypeBitmap
.hBmp = hBmp
End With

With IGuid
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With

OleCreatePictureIndirect tPicConv, IGuid, True, oNewPic
Set BitmapToPicture = oNewPic
End Function

Private Function HiMetricToPixels(lVal As Long, eType As ConversionType) As Long
If eType = ctWidth Then
HiMetricToPixels = Form1.ScaleX(lVal, vbHimetric, vbPixels)
Else
HiMetricToPixels = Form1.ScaleY(lVal, vbHimetric, vbPixels)
End If
End Function

Private Function PixelsToHiMetric(lVal As Long, eType As ConversionType) As Long
If eType = ctWidth Then
PixelsToHiMetric = Form1.ScaleX(lVal, vbPixels, vbHimetric)
Else
PixelsToHiMetric = Form1.ScaleY(lVal, vbPixels, vbHimetric)
End If
End Function

' CardValue ranges from 1 to 13
Private Function GetCard(CardValue As Long, Suit As cdtSuit) As Long
GetCard = Suit * 13 + CardValue ' Note the is different from the 32-bit card selection '(CardValue - 1) '* 4
End Function

Private Sub vbcdtDraw(ByVal hdc As Long, ByVal x As Single, ByVal Y As Single, ByVal iCard As Long, ByVal iDraw As Long, ByVal clr As Long)
Dim hModule As Long
Dim oleX As OLE_XPOS_HIMETRIC
Dim oleY As OLE_YPOS_HIMETRIC
hModule = LoadLibrary16("cards.dll&quot
With getCardBitmap(hModule, iCard)
' Render method uses Pixels for the first 4 parameters (Destination Left, Top, Width, Height)
' and uses HiMetric for the next 4 parameters (Source Left, Top, Width, and Height)
.Render Form1.hdc, x, Y + HiMetricToPixels(.Height, ctHeight), HiMetricToPixels(.Width, ctWidth), -HiMetricToPixels(.Height, ctHeight), 0, 0, .Width, .Height, 0&
End With
FreeLibrary16 hModule
End Sub

Private Sub vbcdtInit(cdtWidth As Long, cdtHeight As Long)
Dim hModule As Long
hModule = LoadLibrary16("cards.dll&quot
cdtWidth = HiMetricToPixels(getCardBitmap(hModule, 1).Width, ctWidth)
cdtHeight = HiMetricToPixels(getCardBitmap(hModule, 1).Height, ctHeight)
FreeLibrary16 hModule
End Sub

 

[strongm]

Hmm...I'll have to have a dig around in my old code. However, it is worth pointing out that the 32-bit CARDS.DLL was made redistributable for a while, and you should be able to find that redistributable version on the web (often as CARDS32.DLL). You can download it and copy it onto your W98 machines (as CARDS32.DLL, don't overwrite the original CARDS.DLL), and then my original code will work.