XProfan

Dietmar
Horn

Salut,

cela Thema Cards.dll avons Frank et je dernier semaine aussi seulement durchgekaut.

mon Tests ergaben:

- sous Win 95 et 98 ist qui DLL zwar vorhanden, mais probablement seulement 16 Bit (jedenfalls funktioniert vous avec XProfan pas).
- sous Windows XP klappts wunderbar.
- Vue scheint sa Spielkarten woanders herzunehmen, jedenfalls konnte je là rien dans direction *cards*.dll trouver. si on qui Cards.dll de XP dans den Vue-Systemordner reinkopiert, klappts aussi avec XProfan.
- sous Windows 2000 pourrait je peut-être. am vendredi testen, Windows ME habe je aktuell pas zur Disposition.

une Alternative pourrait une private Cards.dll son (Freeware), trop qui Frank une Link fand: [...]

Diesem paquet liegen aussi encore plusieurs différent Sätze Spielkarten im Gif-Format chez.

Salut
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

Vue hat un Kartenset dans einer Dossier system32/cardgames.dll gespeichert, sowie diverse autre Grafiken et données. qui Resourcen sommes cependant völlig anders aufgebaut, comment qui qui cards.dll aus älteren Systemen.
qui cardgames-Dll scheint aussi une Com-Dll trop son, jedenfalls konnte je aucun Funktionen dans qui Dll lokalisieren. qui cards.dll hingegen bietet diverse Funktionen à, um z.B. Karten sur une HDC darzustellen. Ist alors schwer un älteres Kartenspiel umzuschreiben de cards.dll pour cardgames.dll.

Frank
Abbing

je starte la fois une Versuch:
Kompilieren Marque Séparation

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
ef='./../../funktionsreferenzen/XProfan/end/'>Fin

Frank
Abbing

encore kleine Bugs trouvé et Code erneuert.

@Frank
si maintenant encore quelqu'un une Routine en supplément écrit, qui doppelte Karten verhindert, ist alles OK !
Im anliegenden "Wurf" sommes z. B.
qui Karo-8 dreimal et
qui Croix-la dame dreimal vorhanden.

doppelkarte.jpg	154 kB

Hochgeladen:	06.11.2008

Downloadcounter:
		Herunterladen

@Frank: Hehe super déjà très appétissant!

Habe la fois une kleinen ombre hinzugefügt et vom mcls abgekoppelt zum hPic...
Kompilieren Marque Séparation

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

href='./../../funktionsreferenzen/XProfan/end/'>Fin

cardsschatten.png	2 kB

Hochgeladen:	06.11.2008

Downloadcounter:
		Herunterladen

Frank
Abbing

Sollte déjà avec Version 10 courir, iF.

@Horst: Derartige Routinen sommes déjà fertig. Habe cela dans mon Artikel pour Dietmars livre en détails beschrieben.

Dietmar
Horn

Salut,

eigentlich voulais je avec dem prochain Update meines Lehrbuches encore attendre jusqu'à je avec cela quelque chose plus suis (jusqu'à maintenant sinds justement la fois ca. 480 Seiten).
Doch weil que voici eh bien déjà la fois zur Discours gekommen ist, werde je am Freitagabend un Update hochladen, si jusqu'à dahin rien dazwischenkommt.

là wird ensuite im Anhang sous "Projekte" qui Artikel de Frank avec enthalten son:

"Mein eigenes Freecell - ou bien comment on selber un Spiel programmiert",

einschließlich des Quellcodes et qui o.g. Freeware-Cards-DLL. Im Text wird Schritt pour Schritt, aussi pour Programmieranfänger verständlich, erklärt, comment qui Prozeduren et Funktionen aufgebaut sommes et quelle Logik derrière den individuel Programmierschritten steckt. Lauffähig ist cet Light-Version de "BlackJack" ab XProfan 10 - läßt sich mais léger aussi pour ältere XProfan-Versionen paraphraser. j'ai den Code pour mich à XProfan 8.0 ajusté, avec cela je mon Schüler demain avec cela "quälen" peux.

Salut
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: [...]