Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Wanet Telecoms Ltd on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

CARDS.DLL or CARDS32.DLL? 1

Status
Not open for further replies.

RMS001

Programmer
Nov 12, 2002
45
CA
The only thread that I could find with a reference to these libraries contains expired links.
I have tried to use the Bruce McKinney DLL and info from his web-site... Can't get it to work.

If anyone has made a card game using the MS cards library I would sure like to see how.
 
Yep, I put together a demo in forum222, but the thread seems to have vanished (at least I can't find it), so here is a cut-down version that just illustrates the 32-bit library:

In a module:
[tt]
Option Explicit

Public Declare Function cdtInit Lib "CARDS.DLL" (dx As Long, dy As Long) As Long
Public Declare Function cdtDrawExt Lib "CARDS.DLL" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal dx As Long, ByVal dy As Long, ByVal ordCard As Long, ByVal iDraw As Long, ByVal clr As Long) As Long

Public Declare Function cdtDraw Lib "CARDS.DLL" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal iCard As Long, ByVal iDraw As Long, ByVal clr As Long) As Long
Public Declare Function cdtTerm Lib "CARDS.DLL" () As Long

Public cdtWidth As Long
Public cdtHeight As Long

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


Public Enum iDraw
Front = 0
Back = 1 'iCard parameter should range from 53 to 68 if IDraw parameter is set to this
End Enum
[/tt]
And now you need a form with a command button:
[tt]
Option Explicit

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

' CardValue ranges from 1 to 13
Private Function GetCard(CardValue As Long, Suit As cdtSuit) As Long
GetCard = Suit + (CardValue - 1) * 4
End Function
 
Wow! That was very good. Thanks strongm.
I have been able to display a random card where I want it on the screen, but my problem is bitmap persistance.
Autoredraw does not solve the problem.
Form_Paint procedure only works if I display more than 6 cards. (try it...)
Do you know how to get the bitmaps to redraw consistantly?
After finally being shown how to get the cards (McKinney was not much help) I can't get them to remain visible if the form is uncovered or dragged to the edge of the screen.
Thanx again - Ron (using XP Pro, if that is significant)
 
Ok, and here's how to do it with the 16-bit CARDS.DLL as requested in thread711-637308. I've put the code here to keep everything in one thread. As mentioned there, the trick is to load the DLL as a resource library and then pull out the graphical resources that represent the cards. I've provided some wrapper code to make it look a bit like the 32-bit solution. Again you'll need a form with a command button:
[tt]
Option Explicit

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
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 = LoadLibrary("cards.dll")
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
FreeLibrary hModule
End Sub

Private Sub vbcdtInit(cdtWidth As Long, cdtHeight As Long)
Dim hModule As Long
hModule = LoadLibrary("cards.dll")
cdtWidth = HiMetricToPixels(getCardBitmap(hModule, 1).Width, ctWidth)
cdtHeight = HiMetricToPixels(getCardBitmap(hModule, 1).Height, ctHeight)
FreeLibrary hModule
End Sub
 
Aaargghh! The above is, of course, my interim version where I was testing the concept against the 32-bit DLL before going on to the 16-bit version.

I am once more away from the office, but I believe that all you should need to do is add the following declarations:

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

and then modify the various LoadLibrary and FreeLibrary calls to use the 16-bit versions instead.
 
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".
(As an aside: I copied the sol.exe, 168KB, 7/11/1995, from my original Win95 disc and ran it under WinXP. It works OK.)
Would you assume that the 16-bit solution you have created (if I use it correctly) would run under both 98 and XP? Just curious if MS would have forseen both systems being eventually used when they designed Solitaire?
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top