Newsgroup: it.comp.lang.visual-basic
Titolo: Continuo di Richiesta Particolare...

 Un saluto....!
Adesso scrivo...
Ma nn è che per caso gia esiste un progettino in giro per il web già
fatto...?
Prenderi volentieri un exe compilato...ma il problema è che questo software
deve essere realizzato per una scuola..e deve essere personalizzato in
parecchi punti(Animazioni, Suoni, Facilità, Deve giocare in rete..!). Me
l'hanno richiesto esplicitamente...!
A me servirebbero le Immagini delle Carte (Napoletane Possibilmente..!) e
magari il codice die processi di gioco(Azione del Computer, Conto dei
Punti..ecc..!)
Un Saluto..!
Ps Ricordo che "IO PROGRAMMO" parlò di questo progetto sul numero 49....!
Sbaglio ?

Le carte franciose sono in tutti i Windows...
Cards32.dll, quelle del solitario...
Qui c'è tutto ciò che serve a programmarci dentro...
Servono:
1 form
    (Form1)
1 Picture
    (Picture1) abbastanza grande da contenere le carte...
4 Command
    cmdDrawCardFace (capt: &Draw Cards Face Up)
    cmdDrawCardBack (capt: Draw &Cards Face Down)
    cmdAnimate (capt: Start Card Animation)
    cmdShuffle (capt: Shuffle Dee Deck)
Inserire il tutto in un VB e premere F5...
</PASTE>
Option Explicit
Private Enum Suits
    Clubs& = 0
    Diamonds& = 1
    Hearts& = 2
    Spades& = 3
End Enum
Private Enum CardFaces
    face_Ace& = 0
    face_Two& = 4
    face_Three& = 8
    face_Four& = 12
    face_Five& = 16
    face_Six& = 20
    face_Seven& = 24
    face_Eight& = 28
    face_Nine& = 32
    face_Ten& = 36
    face_Jack& = 40
    face_Queen& = 44
    face_King& = 48
End Enum
Private Enum CardBacks
    cb_CrossHatch& = 53
    cb_Plaid& = 54
    cb_Weave& = 55
    cb_Robot& = 56
    cb_Roses& = 57
    cb_IvyBlack& = 58
    cb_IvyBlue& = 59
    cb_FishCyan& = 60
    cb_FishBlue& = 61
    cb_Shell& = 62
    cb_Castle& = 63
    cb_Beach& = 64
    cb_CardHand& = 65
    cb_Unused& = 66
    cb_X& = 67
    cb_O& = 68
End Enum
Private Enum Card
    Front& = 0
    Back& = 1
    Highlighted& = 2
End Enum
'//Contructor
Private Declare Function cdtInit Lib "cards32.dll" (_
    dx As Long, _
    dy As Long) As Long
'//Terminator
Private Declare Sub cdtTerm Lib "cards32.dll" ()
'//Standard Drawing function
Private Declare Function cdtDraw Lib "cards32.dll" (_
    ByVal hDC As Long, _
    ByVal X As Long, _
    ByVal Y As Long, _
    ByVal lSuit As Suits, _
     ByVal lCard As Card, _
    ByVal clr As Long) As Long
'//Extended Drawing function
Private Declare Function cdtDrawExt Lib "cards32.dll" (_
    ByVal hDC As Long, _
    ByVal X As Long, _
    ByVal Y As Long, _
    ByVal dx As Long, _
    ByVal dy As Long, _
    ByVal lSuit As Suits, _
    ByVal lCard As Card, _
    ByVal clr As Long) As Long
'//Aniation function to animate certain backs
Private Declare Function cdtAnimate Lib "cards32.dll" (_
    ByVal hDC As Long, _
    ByVal lBack As CardBacks, _
    ByVal X As Long, _
    ByVal Y As Long, _
    ByVal lState As Long) As Long
Private Const mc_TotalCards& = 51
Private Const mc_BrightWhite& = 15
Private m_CardX            As Long
Private m_CardY            As Long
Private m_Animate          As Boolean
Private m_AnimationFrame   As Long
Private m_CardFaceDown     As Boolean
Private m_Initialised      As Boolean
Private m_Cards(0 To mc_TotalCards)
Private Sub cmdAnimate_Click()
On Error GoTo cmdAnimate_ClickError
   Const STR = " Card Animation"
   If m_Animate Then
      With cmdAnimate
         If InStr(.Caption, "Start") Then
            .Caption = "Stop" & STR
            Timer1.Enabled = True
         Else
            .Caption = "Start" & STR
            Timer1.Enabled = False
         End If
      End With
   End If
cmdAnimate_ClickExit:
   Exit Sub
cmdAnimate_ClickError:
   MsgBox Err.Description & vbCrLf & _
        "Error Number: " & _
        Err.Number, vbExclamation, "OOPS"
   Resume cmdAnimate_ClickExit
End Sub
Private Sub cmdDrawCardBack_Click()
On Error GoTo cmdDrawCardBack_ClickError
   Const X_INCREMENT& = 80
   Const Y_INCREMENT& = 100
   Const ENDOFPICTURE& = 320
   Dim lRetVal       As Long
   Dim lPattern      As Long
   Dim lXCoor        As Long
   Dim lYCoor        As Long
   With Picture1
      .Cls
      For lPattern = CardBacks.cb_CrossHatch To CardBacks.cb_O
         lRetVal = cdtDraw(.hDC, lXCoor, lYCoor, _
                lPattern, Back, vbWhite)
         lXCoor = lXCoor + X_INCREMENT
         If lXCoor = ENDOFPICTURE Then
            lYCoor = lYCoor + Y_INCREMENT
            lXCoor = 0
         End If
      Next lPattern
   End With
   m_Animate = True
cmdDrawCardBack_ClickExit:
   Exit Sub
cmdDrawCardBack_ClickError:
   m_Animate = False
   MsgBox Err.Description & vbCrLf & _
        "Error Number: " & _
        Err.Number, vbExclamation, "OOPS"
   Resume cmdDrawCardBack_ClickExit
End Sub
Private Sub cmdDrawCardFace_Click()
On Error GoTo cmdDrawCardFace_ClickError
   Const Y_INCREMENT# = 6.25
   Const X_INCREMENT& = 80
   Const X_MAX& = 320
   Dim lRetVal    As Long
   Dim lCounter   As Long
   Dim lXCoor     As Long
   Dim lSuit      As Long
   With Picture1
      .Cls
      For lCounter = 0 To 48 Step 4
         For lSuit = Suits.Spades To Suits.Clubs Step -1
            lRetVal = cdtDraw(.hDC, lXCoor, _
                lCounter * Y_INCREMENT, _
                lSuit + lCounter, Front, vbWhite)
            lXCoor = lXCoor + X_INCREMENT
            If lXCoor >= X_MAX Then
               lXCoor = 0
            End If
         Next lSuit
      Next lCounter
   End With
cmdDrawCardFace_ClickExit:
   m_Animate = False
   Exit Sub
cmdDrawCardFace_ClickError:
   MsgBox Err.Description & vbCrLf & _
        "Error Number: " & _
        Err.Number, vbExclamation, "OOPS"
   Resume cmdDrawCardFace_ClickExit
End Sub
Private Sub cmdShuffle_Click()
On Error GoTo cmdShuffle_ClickError
   Const SEED& = 25
   Const INCREMENT& = 13
   Dim lCounter      As Long
   Dim lRetVal       As Long
   Dim lYCoor        As Long
   Dim lXCoor        As Long
   Dim lCountEnd     As Long
   Dim lCountStart   As Long
   If Not m_Animate Then
      ms_ShuffelCards
      With Picture1
         .Cls
         lCountEnd = 12
         lCountStart = 0
         For lXCoor = 0 To 240 Step 80
            For lYCoor = lCountStart To lCountEnd
               lRetVal = cdtDraw(.hDC, lXCoor, _
                (lYCoor - lCountStart) * SEED, _
                m_Cards(lYCoor), Front, vbWhite)
            Next lYCoor
            lCountStart = lYCoor
            lCountEnd = lCountEnd + INCREMENT
         Next lXCoor
      End With
   End If
cmdShuffle_ClickExit:
   Exit Sub
cmdShuffle_ClickError:
   MsgBox Err.Description & vbCrLf & _
        "Error Number: " & _
        Err.Number, vbExclamation, "OOPS"
   Resume cmdShuffle_ClickExit
End Sub
Private Sub Form_Load()
On Error GoTo Form_LoadError
   Dim lRetVal As Long
   lRetVal = cdtInit(m_CardX, m_CardY)
   m_Initialised = True
Form_LoadExit:
   If Not m_Initialised Then
      ms_DisableProgram
   End If
   Exit Sub
Form_LoadError:
   MsgBox "Error Initialising Cards32.DLL"
   Resume Form_LoadExit
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   '/*Clean up things*/
   cdtTerm
End Sub
Private Sub Timer1_Timer()
On Error GoTo Timer1_TimerError
   Const MAX_FRAME& = 4
   Dim lReturnValue  As Long
   If m_Animate Then
      '/*You can see I am an ex-C++ coder B-)*/
      lReturnValue = cdtAnimate(Picture1.hDC, _
        cb_CardHand, 0, 300, m_AnimationFrame)
      lReturnValue = cdtAnimate(Picture1.hDC, _
        cb_Beach, 240, 200, m_AnimationFrame)
      lReturnValue = cdtAnimate(Picture1.hDC, _
        cb_Castle, 160, 200, m_AnimationFrame Mod 2) '/*Only 2 frames */
      lReturnValue = cdtAnimate(Picture1.hDC, _
        cb_Robot, 240, 0, m_AnimationFrame)
      m_AnimationFrame = m_AnimationFrame + 1
      If m_AnimationFrame = MAX_FRAME Then
         m_AnimationFrame = 0
      End If
   End If
Timer1_TimerExit:
   Exit Sub
Timer1_TimerError:
   MsgBox "Ooops I did it again" & _
        vbCrLf & Err.Description & _
        "Error Number: " & Err.Number, vbExclamation, "OOPS"
   '//don't forget to disable timer otherwise....
   Timer1.Enabled = False
   Resume Timer1_TimerExit
End Sub
Private Sub ms_ShuffelCards()
'/* NO error trapping because I want to trap it in cmdShuffle_Click */
'/* That's the only routine that calls this routine
   Dim lLoop   As Long
   Dim lRnd    As Long
   Dim lCtr    As Long
   Dim bMatch  As Boolean
   For lLoop = 0 To mc_TotalCards
      m_Cards(lLoop) = -1
   Next lLoop
   Randomize
   For lLoop = 0 To mc_TotalCards
      Do
         lRnd = Int((mc_TotalCards + 1) * Rnd((mc_TotalCards + 1)))
         bMatch = False
         For lCtr = 0 To lLoop
            If m_Cards(lCtr) = lRnd Then
               bMatch = True
               Exit For
            Else
               bMatch = False
            End If
         Next lCtr
      Loop While bMatch = True
      m_Cards(lLoop) = lRnd
   Next lLoop
ms_ShuffelCardsExit:
   Exit Sub
ms_ShuffelCardsError:
   MsgBox Err.Description & vbCrLf & _
        "Error Number: " & _
        Err.Number, vbExclamation, "Watch Out!"
   Resume ms_ShuffelCardsExit
End Sub
Private Sub ms_DisableProgram()
   Dim lCount As Long
   For lCount = 0 To Me.Controls.Count - 1
      On Error Resume Next
      Me.Controls(lCount).Enabled = False
   Next lCount
End Sub
</PASTE>
Attento agli accapo...
Magari qualcosa è anda
taccapo
Dove l'ho preso?
Chi l'ha fatto?
E chi si ricorda?
Ce l'avrò da 3 anni...
Volevo scrivere un prg per il Bridge...
-> GbC
http://www.gbcweb.com

 ha scritto nel messaggio
news:j1F18.7301$tl3.1...@twister2.libero.it...


Veramente sull'ultimo numero (54 di Gennaio) c'è la seconda parte.
Ciao, Claudio.

mando la scuola al diavolo...!?!??! :)))))
  Intanto al diavolo ti mandiamo noi perche' hai riportato interamente
un messaggio lunghissimo per aggiungere poche righe!
  Ciao :-)
  Massimo
  Nell'indirizzo, inserire una "h" tra la "t" e la "u"
  In the address, insert an "h" between the "t" and the "u"

 Veramente sull'ultimo numero (54 di Gennaio) c'è la seconda parte.
Il quoting è sempre un optional... o troppo o niente...
Ciao

 ha scritto nel messaggio
news:sm8e4ukqsueeul5t5...@4ax.com...


 ha scritto nel messaggio
news:KEF18.2882$RQ5....@news1.tin.it...


OOOps .. hai ragione. Scusa
 Ma se magari ci sono le carte, quelle sono le stesse. No?
Ciao, Claudio.


Perché non ho avuto tempo.
-> GbC
http://www.gbcweb.com

 ha scritto nel messaggio
news:naI18.4101$ly.1...@twister1.libero.it...


 ha scritto nel messaggio
news:naI18.4101$ly.1...@twister1.libero.it...


 4 Command [...]
Bel sorgente, grazie.
Volevo solo aggiungere che nella form bisogna anche aggiungere un timer di
nome Timer1, e che sotto Windows 2000 la dll in questione si chiama
"cards.dll" e non "cards32.dll".
Ciao
*Roby*


mooolto bene :)
ciao Roby
-> GbC
http://www.gbcweb.com

 wrote in message
j1F18.7301$tl3.1...@twister2.libero.it...


Come devo fare? non me ne intendo molto...
  Ti ci metti anche tu a quotare messaggi lunghissimi per aggiungere
un paio di righe? Cos'e', la riunione degli azionisti telecom?
