XProfan

Dietmar
Horn

Hallo,

das Thema Cards.dll haben Frank und ich letzte Woche auch erst durchgekaut.

Meine Tests ergaben:

- Unter Win 95 und 98 ist die DLL zwar vorhanden, aber vermutlich nur 16 Bit (jedenfalls funktioniert sie mit XProfan nicht).
- Unter Windows XP klappts wunderbar.
- Vista scheint seine Spielkarten woanders herzunehmen, jedenfalls konnte ich da nichts in Richtung *cards*.dll finden. Wenn man die Cards.dll von XP in den Vista-Systemordner reinkopiert, klappts auch mit XProfan.
- Unter Windows 2000 könnte ich evtl. am Freitag testen, Windows ME habe ich aktuell nicht zur Verfügung.

Eine Alternative könnte eine private Cards.dll sein (Freeware), zu der Frank einen Link fand: [...]

Diesem Paket liegen auch noch mehrere unterschiedliche Sätze Spielkarten im Gif-Format bei.

Gruß
Dietmar

Multimedia für Jugendliche und junge Erwachsene - MMJ Hoyerswerda e.V. [...]

Windows 95 bis Windows 7
Profan² 6.6 bis XProfan X2 mit XPSE

Das große XProfan-Lehrbuch: [...]

Frank
Abbing

Vista hat ein Kartenset in einer Datei system32/cardgames.dll gespeichert, sowie diverse andere Grafiken und Daten. Die Resourcen sind jedoch völlig anders aufgebaut, wie die der cards.dll aus älteren Systemen.
Die cardgames-Dll scheint auch eine Com-Dll zu sein, jedenfalls konnte ich keine Funktionen in der Dll lokalisieren. Die cards.dll hingegen bietet diverse Funktionen an, um z.B. Karten auf einen HDC darzustellen. Ist also schwer ein älteres Kartenspiel umzuschreiben von cards.dll nach cardgames.dll.

Frank
Abbing

Ich starte mal einen Versuch:
Kompilieren Markieren Separieren

Declare x&,y&,text$

Proc paintCard

    Declare ktext$,kb&,kmod&,kcol&,kpie&,ksize#
    Dim ksize#,8
    Def GetTextExtentPoint32(4) ! "GDI32","GetTextExtentPoint32A"
    Parameters kx1&,ky1&,kx2&,ky2&, kpos&
    StartPaint -1
    Cls
    kcol&=0
    kmod&=kpos& MOD 4
    Case ((kmod&=1) or (kmod&=2)):kcol&=Rgb(255,0,0)
    ktext$="AAAA222233334444555566667777888899990000BBBBDDDDKKKK"
    RoundRect 0, 0 - kx2&, ky2&; 8,8
    ktext$=Mid$(ktext$, kpos&+1, 1)
    Case ktext$="0": ktext$="10"
    Usefont "Times New Roman",36,0,0,0,0
    TextColor 0,-1
    DrawText 4, 2, ktext$
    kpie&=GetTextExtentPoint32(%hdc,Addr(ktext$),Len(ktext$),ksize#)
    kpie&=Long(ksize#,0)+6
    ktext$="§"
    Case kmod&=1:ktext$="¨"
    Case kmod&=2:ktext$="©"
    Case kmod&=3:ktext$="ª"
    Usefont "Symbol",36,0,0,0,0
    TextColor kcol&,-1
    DrawText 4, 26, ktext$
    Usefont "Symbol",24,0,0,0,0
    TextColor kcol&,-1
    DrawText kpie&, 2, ktext$
    Usefont "Symbol",148,0,0,0,0
    TextColor kcol&,-1
    DrawText 4, (-10), ktext$
    EndPaint
    MCopyBmp 0,0 - 77,102 > kx1&,ky1&; 0
    Dispose ksize#

EndProc

Cls
MCls 77, 102
Randomize
y&=20

Whileloop 3

    Whileloop 14

        paintCard((&loop-1)*40, y&, 77, 102, Rnd(52))     52 verschiedene Karten im Set

    EndWhile

    y&=y&+120

EndWhile

WaitInput
End

Frank
Abbing

Noch kleine Bugs gefunden und Code erneuert.

@Frank
Wenn jetzt noch jemand eine Routine dazu schreibt, die doppelte Karten verhindert, ist alles OK !
Im anliegenden "Wurf" sind z. B.
die Karo-8 dreimal und
die Kreuz-Dame dreimal vorhanden.

doppelkarte.jpg	154 kB

Hochgeladen:	06.11.2008

Ladeanzahl:
		Herunterladen

@Frank: Hehe klasse schon sehr lecker!

Habe mal einen kleinen Schatten hinzugefügt und vom mcls abgekoppelt zum hPic...
Kompilieren Markieren Separieren

Gemerkt/Separiert von http://xprofan.com/thread.core?p=46942#46942
Declare x&,y&,text$
Def GetTextExtentPoint32(4) ! "GDI32","GetTextExtentPoint32A"

Proc paintCard

    Parameters kx1&,ky1&,kx2&,ky2&, kpos&
    Declare ktext$,kb&,kmod&,kcol&,kpie&,ksize#
    Dim ksize#,8
    var hPic&=create("hNewPic",kx2&,ky2&,$123456)
    StartPaint hPic&
    Cls
    kcol&=0
    kmod&=kpos& MOD 4
    Case ((kmod&=1) or (kmod&=2)):kcol&=Rgb(255,0,0)
    ktext$="AAAA222233334444555566667777888899990000BBBBDDDDKKKK"
    usepen 0,0,$AAAAAA
    useBrush 1,$AAAAAA
    RoundRect 1, 1 - kx2&, ky2&; 8,8
    dec kx2&,1
    dec ky2&,1
    usepen 0,0,$666666
    useBrush 1,$FFFFFF
    RoundRect 0, 0 - kx2&, ky2&; 8,8
    ktext$=Mid$(ktext$, kpos&+1, 1)
    Case ktext$="0": ktext$="10"
    Usefont "Times New Roman",36,0,0,0,0
    TextColor 0,-1
    DrawText 4, 2, ktext$
    kpie&=GetTextExtentPoint32(%hdc,Addr(ktext$),Len(ktext$),ksize#)
    kpie&=Long(ksize#,0)+6
    ktext$="§"
    Case kmod&=1:ktext$="¨"
    Case kmod&=2:ktext$="©"
    Case kmod&=3:ktext$="ª"
    Usefont "Symbol",36,0,0,0,0
    TextColor kcol&,-1
    DrawText 4, 26, ktext$
    Usefont "Symbol",24,0,0,0,0
    TextColor kcol&,-1
    DrawText kpie&, 2, ktext$
    Usefont "Symbol",148,0,0,0,0
    TextColor kcol&,-1
    DrawText 4, (-10), ktext$
    EndPaint
    Dispose ksize#
    drawPic hPic&,kx1&,ky1&;-1,$123456
    deleteObject hPic&

EndProc

Cls

while 1

    paintCard(100,100, 77, 102, Rnd(52))
    paintCard(250,100, 77*2, 102*2, Rnd(52))
    WaitInput

wend

End

cardsschatten.png	2 kB

Hochgeladen:	06.11.2008

Ladeanzahl:
		Herunterladen

Frank
Abbing

Sollte schon mit Version 10 laufen, iF.

@Horst: Derartige Routinen sind schon fertig. Habe das in meinem Artikel für Dietmars Buch ausführlich beschrieben.

Dietmar
Horn

Hallo,

eigentlich wollte ich mit dem nächsten Update meines Lehrbuches noch warten bis ich damit etwas weiter bin (bis jetzt sinds gerade mal ca. 480 Seiten).
Doch weil das hier nun schon mal zur Sprache gekommen ist, werde ich am Freitagabend ein Update hochladen, wenn bis dahin nichts dazwischenkommt.

Da wird dann im Anhang unter "Projekte" der Artikel von Frank mit enthalten sein:

"Mein eigenes Freecell - oder wie man selber ein Spiel programmiert",

einschließlich des Quellcodes und der o.g. Freeware-Cards-DLL. Im Text wird Schritt für Schritt, auch für Programmieranfänger verständlich, erklärt, wie die Prozeduren und Funktionen aufgebaut sind und welche Logik hinter den einzelnen Programmierschritten steckt. Lauffähig ist diese Light-Version von "BlackJack" ab XProfan 10 - läßt sich aber leicht auch für ältere XProfan-Versionen umschreiben. Ich habe den Code für mich an XProfan 8.0 angepaßt, damit ich meine Schüler morgen damit "quälen" kann.

Gruß
Dietmar

Multimedia für Jugendliche und junge Erwachsene - MMJ Hoyerswerda e.V. [...]

Windows 95 bis Windows 7
Profan² 6.6 bis XProfan X2 mit XPSE

Das große XProfan-Lehrbuch: [...]