home *** CD-ROM | disk | FTP | other *** search
/ ActiveX Programming Unleashed CD / AXU.iso / activex / demos / oletrial / samples / vb / mhcard / mhcd20_a.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-11-30  |  18.6 KB  |  544 lines
  1. VERSION 4.00
  2. Begin VB.Form frmMain 
  3.    Caption         =   "MicroHelp MhCard Example"
  4.    ClientHeight    =   6150
  5.    ClientLeft      =   1980
  6.    ClientTop       =   1695
  7.    ClientWidth     =   8040
  8.    BeginProperty Font 
  9.       name            =   "MS Sans Serif"
  10.       charset         =   0
  11.       weight          =   700
  12.       size            =   8.25
  13.       underline       =   0   'False
  14.       italic          =   0   'False
  15.       strikethrough   =   0   'False
  16.    EndProperty
  17.    ForeColor       =   &H80000008&
  18.    Height          =   6585
  19.    Left            =   1920
  20.    LinkTopic       =   "Form1"
  21.    ScaleHeight     =   6150
  22.    ScaleWidth      =   8040
  23.    Top             =   1320
  24.    Width           =   8160
  25.    Begin VB.CommandButton cmdReshuffle 
  26.       Appearance      =   0  'Flat
  27.       BackColor       =   &H80000005&
  28.       Caption         =   "cmdReshuffle"
  29.       BeginProperty Font 
  30.          name            =   "MS Sans Serif"
  31.          charset         =   0
  32.          weight          =   700
  33.          size            =   8.25
  34.          underline       =   0   'False
  35.          italic          =   0   'False
  36.          strikethrough   =   0   'False
  37.       EndProperty
  38.       Height          =   375
  39.       Left            =   225
  40.       TabIndex        =   5
  41.       Top             =   4545
  42.       Width           =   1275
  43.    End
  44.    Begin VB.Frame frmCard 
  45.       Caption         =   "frmCard"
  46.       BeginProperty Font 
  47.          name            =   "MS Sans Serif"
  48.          charset         =   0
  49.          weight          =   400
  50.          size            =   8.25
  51.          underline       =   0   'False
  52.          italic          =   0   'False
  53.          strikethrough   =   0   'False
  54.       EndProperty
  55.       Height          =   1950
  56.       Left            =   132
  57.       TabIndex        =   1
  58.       Top             =   108
  59.       Width           =   3300
  60.       Begin VB.ComboBox cboBack 
  61.          Appearance      =   0  'Flat
  62.          BeginProperty Font 
  63.             name            =   "MS Sans Serif"
  64.             charset         =   0
  65.             weight          =   400
  66.             size            =   8.25
  67.             underline       =   0   'False
  68.             italic          =   0   'False
  69.             strikethrough   =   0   'False
  70.          EndProperty
  71.          Height          =   315
  72.          Left            =   1440
  73.          Style           =   2  'Dropdown List
  74.          TabIndex        =   4
  75.          Top             =   1485
  76.          Width           =   1635
  77.       End
  78.       Begin VB.ComboBox cboValue 
  79.          Appearance      =   0  'Flat
  80.          BeginProperty Font 
  81.             name            =   "MS Sans Serif"
  82.             charset         =   0
  83.             weight          =   400
  84.             size            =   8.25
  85.             underline       =   0   'False
  86.             italic          =   0   'False
  87.             strikethrough   =   0   'False
  88.          EndProperty
  89.          Height          =   315
  90.          Left            =   1440
  91.          Style           =   2  'Dropdown List
  92.          TabIndex        =   3
  93.          Top             =   1125
  94.          Width           =   1635
  95.       End
  96.       Begin VB.ComboBox cboSuit 
  97.          Appearance      =   0  'Flat
  98.          BeginProperty Font 
  99.             name            =   "MS Sans Serif"
  100.             charset         =   0
  101.             weight          =   400
  102.             size            =   8.25
  103.             underline       =   0   'False
  104.             italic          =   0   'False
  105.             strikethrough   =   0   'False
  106.          EndProperty
  107.          Height          =   315
  108.          Left            =   1440
  109.          Style           =   2  'Dropdown List
  110.          TabIndex        =   2
  111.          Top             =   765
  112.          Width           =   1635
  113.       End
  114.       Begin VB.Label lblSettings 
  115.          Appearance      =   0  'Flat
  116.          BackColor       =   &H80000005&
  117.          BackStyle       =   0  'Transparent
  118.          Caption         =   "lblSettings"
  119.          BeginProperty Font 
  120.             name            =   "MS Sans Serif"
  121.             charset         =   0
  122.             weight          =   400
  123.             size            =   8.25
  124.             underline       =   0   'False
  125.             italic          =   -1  'True
  126.             strikethrough   =   0   'False
  127.          EndProperty
  128.          ForeColor       =   &H80000008&
  129.          Height          =   420
  130.          Left            =   180
  131.          TabIndex        =   12
  132.          Top             =   270
  133.          Width           =   2895
  134.       End
  135.       Begin VB.Label lblCard 
  136.          Appearance      =   0  'Flat
  137.          BackColor       =   &H80000005&
  138.          BackStyle       =   0  'Transparent
  139.          Caption         =   "lblCard"
  140.          BeginProperty Font 
  141.             name            =   "MS Sans Serif"
  142.             charset         =   0
  143.             weight          =   400
  144.             size            =   8.25
  145.             underline       =   0   'False
  146.             italic          =   0   'False
  147.             strikethrough   =   0   'False
  148.          EndProperty
  149.          ForeColor       =   &H80000008&
  150.          Height          =   240
  151.          Index           =   2
  152.          Left            =   180
  153.          TabIndex        =   7
  154.          Top             =   1530
  155.          Width           =   1185
  156.       End
  157.       Begin VB.Label lblCard 
  158.          Appearance      =   0  'Flat
  159.          BackColor       =   &H80000005&
  160.          BackStyle       =   0  'Transparent
  161.          Caption         =   "lblCard"
  162.          BeginProperty Font 
  163.             name            =   "MS Sans Serif"
  164.             charset         =   0
  165.             weight          =   400
  166.             size            =   8.25
  167.             underline       =   0   'False
  168.             italic          =   0   'False
  169.             strikethrough   =   0   'False
  170.          EndProperty
  171.          ForeColor       =   &H80000008&
  172.          Height          =   240
  173.          Index           =   1
  174.          Left            =   180
  175.          TabIndex        =   8
  176.          Top             =   1170
  177.          Width           =   1185
  178.       End
  179.       Begin VB.Label lblCard 
  180.          Appearance      =   0  'Flat
  181.          BackColor       =   &H80000005&
  182.          BackStyle       =   0  'Transparent
  183.          Caption         =   "lblCard"
  184.          BeginProperty Font 
  185.             name            =   "MS Sans Serif"
  186.             charset         =   0
  187.             weight          =   400
  188.             size            =   8.25
  189.             underline       =   0   'False
  190.             italic          =   0   'False
  191.             strikethrough   =   0   'False
  192.          EndProperty
  193.          ForeColor       =   &H80000008&
  194.          Height          =   240
  195.          Index           =   0
  196.          Left            =   180
  197.          TabIndex        =   6
  198.          Top             =   810
  199.          Width           =   1185
  200.       End
  201.    End
  202.    Begin VB.CommandButton cmdDeal 
  203.       Appearance      =   0  'Flat
  204.       BackColor       =   &H80000005&
  205.       Caption         =   "cmdDeal"
  206.       BeginProperty Font 
  207.          name            =   "MS Sans Serif"
  208.          charset         =   0
  209.          weight          =   700
  210.          size            =   8.25
  211.          underline       =   0   'False
  212.          italic          =   0   'False
  213.          strikethrough   =   0   'False
  214.       EndProperty
  215.       Height          =   375
  216.       Left            =   225
  217.       TabIndex        =   0
  218.       Top             =   4140
  219.       Width           =   1275
  220.    End
  221.    Begin Mhcd200Lib.MhCardDeck MhCardDeck1 
  222.       Height          =   1425
  223.       Index           =   0
  224.       Left            =   315
  225.       TabIndex        =   14
  226.       Top             =   2655
  227.       Width           =   1065
  228.       _Version        =   65536
  229.       _ExtentX        =   1879
  230.       _ExtentY        =   2514
  231.       _StockProps     =   65
  232.       BackColor       =   12632256
  233.       TintColor       =   16711935
  234.       Autosize        =   -1  'True
  235.       Suit            =   3
  236.       CustomBack      =   "mhcd20_a.frx":0000
  237.    End
  238.    Begin VB.Label lblDeal 
  239.       Alignment       =   2  'Center
  240.       Appearance      =   0  'Flat
  241.       BackColor       =   &H80000005&
  242.       BackStyle       =   0  'Transparent
  243.       Caption         =   "lblDeal"
  244.       BeginProperty Font 
  245.          name            =   "MS Sans Serif"
  246.          charset         =   0
  247.          weight          =   400
  248.          size            =   8.25
  249.          underline       =   0   'False
  250.          italic          =   -1  'True
  251.          strikethrough   =   0   'False
  252.       EndProperty
  253.       ForeColor       =   &H80000008&
  254.       Height          =   960
  255.       Left            =   90
  256.       TabIndex        =   13
  257.       Top             =   4950
  258.       Width           =   1545
  259.    End
  260.    Begin VB.Label lblTable 
  261.       Alignment       =   1  'Right Justify
  262.       Appearance      =   0  'Flat
  263.       BackColor       =   &H80000005&
  264.       Caption         =   "lblTable"
  265.       BeginProperty Font 
  266.          name            =   "MS Sans Serif"
  267.          charset         =   0
  268.          weight          =   400
  269.          size            =   8.25
  270.          underline       =   0   'False
  271.          italic          =   -1  'True
  272.          strikethrough   =   0   'False
  273.       EndProperty
  274.       ForeColor       =   &H80000008&
  275.       Height          =   1095
  276.       Left            =   3825
  277.       TabIndex        =   11
  278.       Top             =   2970
  279.       Width           =   1950
  280.    End
  281.    Begin VB.Label lblDescription 
  282.       Alignment       =   2  'Center
  283.       Appearance      =   0  'Flat
  284.       BackColor       =   &H80000005&
  285.       BackStyle       =   0  'Transparent
  286.       Caption         =   "lblDescription"
  287.       BeginProperty Font 
  288.          name            =   "MS Sans Serif"
  289.          charset         =   0
  290.          weight          =   400
  291.          size            =   8.25
  292.          underline       =   0   'False
  293.          italic          =   0   'False
  294.          strikethrough   =   0   'False
  295.       EndProperty
  296.       ForeColor       =   &H80000008&
  297.       Height          =   1455
  298.       Left            =   3690
  299.       TabIndex        =   10
  300.       Top             =   225
  301.       Width           =   2445
  302.    End
  303.    Begin VB.Label lblCardTable 
  304.       Alignment       =   2  'Center
  305.       Appearance      =   0  'Flat
  306.       BackColor       =   &H80000005&
  307.       BackStyle       =   0  'Transparent
  308.       Caption         =   "lblCardTable"
  309.       BeginProperty Font 
  310.          name            =   "MS Sans Serif"
  311.          charset         =   0
  312.          weight          =   700
  313.          size            =   12
  314.          underline       =   0   'False
  315.          italic          =   -1  'True
  316.          strikethrough   =   0   'False
  317.       EndProperty
  318.       ForeColor       =   &H80000008&
  319.       Height          =   330
  320.       Left            =   0
  321.       TabIndex        =   9
  322.       Top             =   2205
  323.       Width           =   6270
  324.    End
  325.    Begin VB.Shape shpDeckUp 
  326.       FillColor       =   &H00FFFFFF&
  327.       FillStyle       =   0  'Solid
  328.       Height          =   2805
  329.       Left            =   1710
  330.       Top             =   2835
  331.       Width           =   4200
  332.    End
  333.    Begin VB.Shape shpTable 
  334.       FillColor       =   &H00008000&
  335.       FillStyle       =   0  'Solid
  336.       Height          =   3435
  337.       Left            =   0
  338.       Top             =   2565
  339.       Width           =   6270
  340.    End
  341. Attribute VB_Name = "frmMain"
  342. Attribute VB_Creatable = False
  343. Attribute VB_Exposed = False
  344. Option Explicit
  345. Const iInch = 1440
  346. Dim sSuit(0 To 3) As String
  347. Dim sValue(0 To 13) As String
  348. Dim sBack(0 To 12) As String
  349. Dim iCardCount As Integer
  350. Dim iDragging As Integer
  351. Private Sub cboBack_Change()
  352.     MhCardDeck1(0).CardBack = cboBack.ListIndex
  353. End Sub
  354. Private Sub cboBack_Click()
  355.     cboBack_Change
  356. End Sub
  357. Private Sub cmdDeal_Click()
  358. Dim iSuit As Integer
  359. Dim iValue As Integer
  360. Dim iLeft As Integer
  361. Dim iTop As Integer
  362. Dim iTest1 As Integer
  363. Dim iTest2 As Integer
  364. Dim iTest3 As Integer
  365. Dim iTest4 As Integer
  366.     ' Don't deal if no more cards will fit on screen
  367.     ' (first card will always show).
  368.     iTest1 = MhCardDeck1(iCardCount).Left + MhCardDeck1(iCardCount).Width
  369.     iTest2 = shpDeckUp.Left + shpDeckUp.Width
  370.     iTest3 = MhCardDeck1(iCardCount).Top + MhCardDeck1(iCardCount).Height
  371.     iTest4 = shpDeckUp.Top + shpDeckUp.Height
  372.     If (iTest1 > iTest2 - (0.25 * iInch)) Or (iTest3 > iTest4 - (0.25 * iInch)) Then Exit Sub
  373.     ' Get settings of the card to be dealt from the combo boxes.
  374.     iSuit = cboSuit.ListIndex
  375.     iValue = cboValue.ListIndex
  376.     ' Create new instance of the card and configure it
  377.     ' with the selected values.
  378.     iCardCount = iCardCount + 1
  379.     Load MhCardDeck1(iCardCount)
  380.     MhCardDeck1(iCardCount).Visible = False
  381.     MhCardDeck1(iCardCount).Suit = iSuit
  382.     MhCardDeck1(iCardCount).Value = iValue
  383.     MhCardDeck1(iCardCount).CardBack = MhCardDeck1(0).CardBack
  384.     ' Reposition card to white area and shift it to the right
  385.     ' of the card underneath.
  386.     iLeft = shpDeckUp.Left + (0.25 * iInch) + iCardCount * (0.1 * iInch)
  387.     iTop = shpDeckUp.Top + (0.25 * iInch) + iCardCount * (0.1 * iInch)
  388.     MhCardDeck1(iCardCount).Move iLeft, iTop
  389.     ' Display.
  390.     MhCardDeck1(iCardCount).Visible = True
  391.     ' Now cycle through card types.
  392.     If cboSuit.ListIndex < cboSuit.ListCount - 1 Then
  393.         cboSuit.ListIndex = cboSuit.ListIndex + 1
  394.     Else
  395.         cboSuit.ListIndex = 0
  396.     End If
  397.     If cboValue.ListIndex < cboValue.ListCount - 1 Then
  398.         cboValue.ListIndex = cboValue.ListIndex + 1
  399.     Else
  400.         cboValue.ListIndex = 0
  401.     End If
  402.     If cboBack.ListIndex < cboBack.ListCount - 1 Then
  403.         cboBack.ListIndex = cboBack.ListIndex + 1
  404.     Else
  405.         cboBack.ListIndex = 0
  406.     End If
  407.     MhCardDeck1(iCardCount).ZOrder
  408. End Sub
  409. Private Sub cmdReshuffle_Click()
  410. Dim iCount As Integer
  411.     ' Unload all card controls that were loaded
  412.     ' and reset the card count to zero.
  413.     For iCount = 1 To iCardCount
  414.         Unload MhCardDeck1(iCount)
  415.     Next
  416.     iCardCount = 0
  417. End Sub
  418. Private Sub Form_Load()
  419.     LoadCaptions
  420.     ' Load the names of the card settings into their
  421.     ' string arrays so that they can be easily set.
  422.     Set_Defaults
  423.     iCardCount = 0
  424.     ' Set default type of card that will be displayed on
  425.     ' the first deal (two of clubs with a red check back).
  426.     cboSuit.ListIndex = 0
  427.     cboValue.ListIndex = 2
  428.     cboBack.ListIndex = 0
  429.     ' center form to screen
  430.     Move Abs(Screen.Width - Width) \ 2, Abs(Screen.Height - Height) \ 2
  431. End Sub
  432. Private Sub Form_Resize()
  433.     ' Don't get too small.
  434.     If Me.ScaleWidth < 5025 Then Exit Sub
  435.     If Me.ScaleHeight < 5025 Then Exit Sub
  436.     ' Resize shapes.
  437.     shpTable.Width = frmMain.ScaleWidth
  438.     shpTable.Height = frmMain.ScaleHeight - shpTable.Top
  439.     shpDeckUp.Top = shpTable.Top + (0.25 * iInch)
  440.     shpDeckUp.Width = shpTable.Width - shpDeckUp.Left - (0.25 * iInch)
  441.     shpDeckUp.Height = shpTable.Height - (0.5 * iInch)
  442.     ' Resize labels.
  443.     lblCardTable.Width = frmMain.ScaleWidth
  444.     lblTable.Left = shpDeckUp.Left + shpDeckUp.Width - lblTable.Width - (0.1 * iInch)
  445. End Sub
  446. ' KEY:          caption text
  447. ' PURPOSE:      Load default text into controls.
  448. ' PARAMETERS:   {none}
  449. ' RETURNS:      {nothing}
  450. Private Sub LoadCaptions()
  451. Dim sCaption As String
  452.     frmCard.Caption = "Card Settings"
  453.     lblCard(0).Caption = "&Suit:"
  454.     lblCard(1).Caption = "&Value:"
  455.     lblCard(2).Caption = "&Back Image:"
  456.     lblCardTable.Caption = "Dealers-R-Us"
  457.     cmdDeal.Caption = "&Deal"
  458.     cmdReshuffle.Caption = "&Reshuffle"
  459.     sCaption = "The MhCard control gives you a quick way to start "
  460.     sCaption = sCaption & "your game application.  Specify the Card "
  461.     sCaption = sCaption & "Settings you want and press Deal to have that "
  462.     sCaption = sCaption & "card dealt."
  463.     lblDescription.Caption = sCaption
  464.     sCaption = "The top card dealt can be dragged back to the deck "
  465.     sCaption = sCaption & "or right-clicked to be flipped over."
  466.     lblTable.Caption = sCaption
  467.     sCaption = "Specify the suit, value, and card back for the next "
  468.     sCaption = sCaption & "card to be dealt."
  469.     lblSettings.Caption = sCaption
  470.     sCaption = "Press Deal to deal a new card to the table.  Press "
  471.     sCaption = sCaption & "Reshuffle to get rid of all dealt cards."
  472.     lblDeal.Caption = sCaption
  473. End Sub
  474. Private Sub MhCardDeck1_DragDrop(Index As Integer, Source As Control, X As Single, Y As Single)
  475.     ' Stop dragging card and drop it;
  476.     ' this puts it back on the deck.
  477.     If iDragging And Index = 0 Then
  478.         MhCardDeck1(iCardCount).Drag 2
  479.         Unload MhCardDeck1(iCardCount)
  480.         iCardCount = iCardCount - 1
  481.     End If
  482. End Sub
  483. Private Sub MhCardDeck1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  484.     ' Begin draggin card (if it is the last card dealt).
  485.     If Button = 1 And Index = iCardCount And Index <> 0 Then
  486.         MhCardDeck1(Index).Drag 1
  487.         iDragging = True
  488.     ' Flip card over if this is a right click.
  489.     ElseIf Button = 2 And Index > 0 Then
  490.         ' Show back.
  491.         If MhCardDeck1(Index).Value <> 0 Then
  492.             MhCardDeck1(Index).Value = 0
  493.         ' Show front.
  494.         Else
  495.             MhCardDeck1(Index).Value = cboValue.ListIndex
  496.         End If
  497.     End If
  498. End Sub
  499. ' KEY:          default suit value back card
  500. ' PURPOSE:      Fill arrays for card settings and
  501. '               load values into combo boxes.
  502. ' PARAMETERS:   {none}
  503. ' RETURNS:      {nothing}
  504. Private Sub Set_Defaults()
  505. Dim iCount As Integer
  506.     ' Name of the suits.
  507.     sSuit(0) = "Clubs"
  508.     sSuit(1) = "Diamonds"
  509.     sSuit(2) = "Hearts"
  510.     sSuit(3) = "Spades"
  511.     For iCount = 0 To UBound(sSuit)
  512.         cboSuit.AddItem sSuit(iCount)
  513.     Next
  514.     ' Value of the card (major or minor).
  515.     sValue(0) = "Back"
  516.     sValue(1) = "Ace"
  517.     For iCount = 2 To 10
  518.         sValue(iCount) = Format$(iCount)
  519.     Next
  520.     sValue(11) = "Jack"
  521.     sValue(12) = "Queen"
  522.     sValue(13) = "King"
  523.     For iCount = 0 To UBound(sValue)
  524.         cboValue.AddItem sValue(iCount)
  525.     Next
  526.     ' Name of the image displayed on the back of cards.
  527.     sBack(0) = "Red Checks"
  528.     sBack(1) = "Blue Checks"
  529.     sBack(2) = "Red Hatch"
  530.     sBack(3) = "Blue Hatch"
  531.     sBack(4) = "Robot"
  532.     sBack(5) = "Roses"
  533.     sBack(6) = "Leaves 1"
  534.     sBack(7) = "Leaves 2"
  535.     sBack(8) = "Fish"
  536.     sBack(9) = "Conch"
  537.     sBack(10) = "Castle"
  538.     sBack(11) = "Beach"
  539.     sBack(12) = "Hand"
  540.     For iCount = 0 To UBound(sBack)
  541.         cboBack.AddItem sBack(iCount)
  542.     Next
  543. End Sub
  544.