home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual BASIC 5.0 (Ent. Edition) / Vb5ent Extractor.EXE / VB / SAMPLES / PGUIDE / PROGWOB / PWOFRIEN.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-11-26  |  5.8 KB  |  185 lines
  1. VERSION 5.00
  2. Begin VB.Form frmFriends 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "Friends Passing User-Defined Types"
  5.    ClientHeight    =   3210
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   5355
  9.    LinkTopic       =   "Form1"
  10.    MaxButton       =   0   'False
  11.    MinButton       =   0   'False
  12.    ScaleHeight     =   3210
  13.    ScaleWidth      =   5355
  14.    StartUpPosition =   3  'Windows Default
  15.    Begin VB.TextBox txtString 
  16.       Height          =   285
  17.       Left            =   1080
  18.       TabIndex        =   5
  19.       Top             =   2640
  20.       Width           =   4095
  21.    End
  22.    Begin VB.TextBox txtLong 
  23.       Height          =   285
  24.       Left            =   1080
  25.       MaxLength       =   9
  26.       TabIndex        =   3
  27.       Top             =   2160
  28.       Width           =   1815
  29.    End
  30.    Begin VB.TextBox txtInteger 
  31.       Height          =   285
  32.       Left            =   1080
  33.       MaxLength       =   4
  34.       TabIndex        =   1
  35.       Top             =   1680
  36.       Width           =   1215
  37.    End
  38.    Begin VB.CommandButton cmdMethod 
  39.       Caption         =   "Friend &Method"
  40.       Height          =   375
  41.       Left            =   3120
  42.       TabIndex        =   7
  43.       Top             =   2040
  44.       Width           =   2055
  45.    End
  46.    Begin VB.CommandButton cmdProperty 
  47.       Caption         =   "Friend &Property"
  48.       Height          =   375
  49.       Left            =   3120
  50.       TabIndex        =   6
  51.       Top             =   1560
  52.       Width           =   2055
  53.    End
  54.    Begin VB.Label Label4 
  55.       Alignment       =   1  'Right Justify
  56.       Caption         =   "&String:"
  57.       Height          =   255
  58.       Left            =   120
  59.       TabIndex        =   4
  60.       Top             =   2640
  61.       Width           =   855
  62.    End
  63.    Begin VB.Label Label3 
  64.       Alignment       =   1  'Right Justify
  65.       Caption         =   "&Long:"
  66.       Height          =   255
  67.       Left            =   120
  68.       TabIndex        =   2
  69.       Top             =   2160
  70.       Width           =   855
  71.    End
  72.    Begin VB.Label Label2 
  73.       Alignment       =   1  'Right Justify
  74.       Caption         =   "&Integer:"
  75.       Height          =   255
  76.       Left            =   120
  77.       TabIndex        =   0
  78.       Top             =   1680
  79.       Width           =   855
  80.    End
  81.    Begin VB.Label Label1 
  82.       Caption         =   $"PWOFrien.frx":0000
  83.       Height          =   1455
  84.       Left            =   120
  85.       TabIndex        =   8
  86.       Top             =   120
  87.       Width           =   5175
  88.    End
  89. Attribute VB_Name = "frmFriends"
  90. Attribute VB_GlobalNameSpace = False
  91. Attribute VB_Creatable = False
  92. Attribute VB_PredeclaredId = True
  93. Attribute VB_Exposed = False
  94. Option Explicit
  95. ' Demonstrates Friend properties and
  96. '   methods passing UDTs between objects.
  97. Private mtc1 As TestClass
  98. Private mtc2 As TestClass
  99. ' Use properties to assign/access a UDT.
  100. Private Sub cmdProperty_Click()
  101.     ' The SetDemoParts helper method assigns
  102.     '   the contents of the text boxes to
  103.     '   the user-defined type in the first
  104.     '   TestClass object, so there will be
  105.     '   something to pass to the second
  106.     '   TestClass object.
  107.     Call mtc1.SetDemoParts(CInt("0" & txtInteger), _
  108.         CLng("0" & txtLong), txtString)
  109.     '
  110.     ' Show the first TestClass object's
  111.     '   UDT elements before passing.
  112.     Call mtc1.ShowDemo("Passing a UDT using a Property", "To be passed from:")
  113.     '
  114.     ' Directly assign the UDT from the
  115.     '   first TestClass object to the
  116.     '   UDT in the second TestClass object,
  117.     '   using the Demo property.
  118.     mtc2.Demo = mtc1.Demo
  119.     '
  120.     ' Show the second TestClass object's
  121.     '   UDT elements.
  122.     Call mtc2.ShowDemo("Passing a UDT using a Property", "Passed to:")
  123.     '
  124.     ' When the procedure ends, tc1 and tc2
  125.     '   go out of scope and the TestClass
  126.     '   objects terminate.
  127. End Sub
  128. ' Use methods to assign/access a UDT.
  129. Private Sub cmdMethod_Click()
  130.     ' The SetDemoParts helper method assigns
  131.     '   the contents of the text boxes to
  132.     '   the user-defined type in the first
  133.     '   TestClass object, so there will be
  134.     '   something to pass to the second
  135.     '   TestClass object.
  136.     Call mtc1.SetDemoParts(CInt("0" & txtInteger), _
  137.         CLng("0" & txtLong), txtString)
  138.     '
  139.     ' Show the first TestClass object's
  140.     '   UDT elements before passing.
  141.     Call mtc1.ShowDemo("Passing a UDT using a Method", "To be passed from:")
  142.     '
  143.     ' The GetDemo method of the first
  144.     '   TestClass object returns the UDT,
  145.     '   which is passed to the SetDemo
  146.     '   method of the second TestClass
  147.     '   object.
  148.     Call mtc2.SetDemo(mtc1.GetDemo)
  149.     '
  150.     ' Show the second TestClass object's
  151.     '   UDT elements.
  152.     Call mtc2.ShowDemo("Passing a UDT using a Method", "Passed to:")
  153.     '
  154.     ' When the procedure ends, tc1 and tc2
  155.     '   go out of scope and the TestClass
  156.     '   objects terminate.
  157. End Sub
  158. Private Sub Form_Load()
  159.     ' Create TestClass objects.
  160.     Set mtc1 = New TestClass
  161.     Set mtc2 = New TestClass
  162. End Sub
  163. Private Sub Form_Unload(Cancel As Integer)
  164.     ' Free form's resources.
  165.     Set frmFriends = Nothing
  166. End Sub
  167. Private Sub txtInteger_KeyPress(KeyAscii As Integer)
  168.     Select Case KeyAscii
  169.         Case 48 To 57     ' Allow digits.
  170.         Case 8      ' Allow backspace.
  171.         Case Else   ' Suppress everything else.
  172.             Beep
  173.             KeyAscii = 0
  174.     End Select
  175. End Sub
  176. Private Sub txtLong_KeyPress(KeyAscii As Integer)
  177.     Select Case KeyAscii
  178.         Case 48 To 57     ' Allow digits.
  179.         Case 8      ' Allow backspace.
  180.         Case Else   ' Suppress everything else.
  181.             Beep
  182.             KeyAscii = 0
  183.     End Select
  184. End Sub
  185.