home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / pa16v319 / test40.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-07-07  |  7.8 KB  |  248 lines
  1. VERSION 4.00
  2. Begin VB.Form TestForm 
  3.    Caption         =   "This is a test project for Project Analyzer"
  4.    ClientHeight    =   1080
  5.    ClientLeft      =   1095
  6.    ClientTop       =   1485
  7.    ClientWidth     =   5160
  8.    BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  9.       Name            =   "MS Sans Serif"
  10.       Size            =   8.25
  11.       Charset         =   0
  12.       Weight          =   700
  13.       Underline       =   0   'False
  14.       Italic          =   0   'False
  15.       Strikethrough   =   0   'False
  16.    EndProperty
  17.    ForeColor       =   &H80000008&
  18.    Height          =   1485
  19.    Icon            =   "TEST40.frx":0000
  20.    Left            =   1035
  21.    LinkTopic       =   "Form1"
  22.    ScaleHeight     =   1080
  23.    ScaleWidth      =   5160
  24.    Top             =   1140
  25.    Width           =   5280
  26.    Begin VB.PictureBox Picture1 
  27.       Height          =   495
  28.       Left            =   3180
  29.       MouseIcon       =   "TEST40.frx":030A
  30.       MousePointer    =   99  'Custom
  31.       Picture         =   "TEST40.frx":074C
  32.       ScaleHeight     =   435
  33.       ScaleWidth      =   555
  34.       TabIndex        =   4
  35.       Top             =   60
  36.       Width           =   615
  37.    End
  38.    Begin VB.DriveListBox Drive1 
  39.       Height          =   315
  40.       Left            =   1140
  41.       MouseIcon       =   "TEST40.frx":14CE
  42.       MousePointer    =   99  'Custom
  43.       TabIndex        =   3
  44.       Top             =   660
  45.       Width           =   2475
  46.    End
  47.    Begin VB.ListBox List1 
  48.       Height          =   645
  49.       Index           =   0
  50.       ItemData        =   "TEST40.frx":1910
  51.       Left            =   60
  52.       List            =   "TEST40.frx":191D
  53.       MouseIcon       =   "TEST40.frx":1939
  54.       MousePointer    =   99  'Custom
  55.       TabIndex        =   2
  56.       Top             =   360
  57.       Width           =   915
  58.    End
  59.    Begin VB.CommandButton Quit 
  60.       Appearance      =   0  'Flat
  61.       BackColor       =   &H80000005&
  62.       Caption         =   "Quit"
  63.       Height          =   330
  64.       Left            =   3780
  65.       TabIndex        =   0
  66.       Top             =   630
  67.       Width           =   1275
  68.    End
  69.    Begin VB.Image Image2 
  70.       Appearance      =   0  'Flat
  71.       Height          =   240
  72.       Left            =   4320
  73.       Picture         =   "TEST40.frx":1A8B
  74.       Top             =   120
  75.       Width           =   240
  76.    End
  77.    Begin VB.Image Image1 
  78.       Appearance      =   0  'Flat
  79.       Height          =   240
  80.       Left            =   3960
  81.       Picture         =   "TEST40.frx":1B8D
  82.       Top             =   120
  83.       Width           =   240
  84.    End
  85.    Begin VB.Label Label1 
  86.       Appearance      =   0  'Flat
  87.       BackColor       =   &H80000005&
  88.       BackStyle       =   0  'Transparent
  89.       Caption         =   "This program will not do anything"
  90.       ForeColor       =   &H80000008&
  91.       Height          =   225
  92.       Left            =   210
  93.       TabIndex        =   1
  94.       Top             =   90
  95.       Width           =   3000
  96.    End
  97. Attribute VB_Name = "TestForm"
  98. Attribute VB_Creatable = False
  99. Attribute VB_Exposed = False
  100. ' A test project for Project Analyzer
  101. ' (C)1996 MyCompany Ltd.
  102. ' This is the form of the main screen
  103. ' This file also includes some important database routines
  104. DefStr W
  105. Public DatabaseName$
  106. Dim Weekdays(0 To 6)
  107. ' Project Analyzer doesn't understand MAX_BUTTONS isn't dead
  108. Const MAX_BUTTONS = 50
  109. Dim DynamicButton() As CommandButton
  110. Dim StaticButton(0 To MAX_BUTTONS) As CommandButton
  111. Dim FName As String
  112. ' This is a module-level variable that overrides the
  113. ' global variable FName in Test40.bas
  114. Public FName2 As String
  115. ' This is a completely legal declaration in VB 4.0
  116. ' There is already a Public FName2 declared in Test40.bas
  117. ' This is another one
  118. ' Dim and Private mean the same here
  119. Dim TestObject As testclass
  120. Private AnotherTestObject As New testclass
  121. Private Sub CloseDatabase(ByRef NumberArray() As Long, Optional ByRef DeadParam As Variant)
  122. ' Close the database
  123. ' Check that all information is up-to-date
  124. ReDim Preserve DynamicButton(0 To MAX_BUTTONS / 2) As CommandButton
  125. ReDim NumberArray(1 To 2)
  126. End Sub
  127. Private Function ExtensionOnly(ByVal File As String) As String
  128. ' Returns file name extension "BAS"
  129. ' This is a module-level function that will override
  130. ' the global function ExtensionOnly defined in FILETEST.BAS
  131. ExtensionOnly = Right(File, 3)
  132. End Function
  133. Private Function Fibonacci(ByVal n As Integer)
  134. ' Sample of a recursive call sequence
  135. ' This function is only called by SumFibonacci
  136. ' but not by any other procedure
  137. ' -> Fibonacci and SumFibonacci are dead code
  138. If n = 1 Then
  139.     Fibonacci = 1
  140. ElseIf n = 2 Then
  141.     Fibonacci = 1
  142.     Fibonacci = SumFibonacci(n - 1, n - 2)
  143. End If
  144. End Function
  145. Private Sub Form_Load()
  146. ' Start of the program
  147. Set StaticButton(0) = quit
  148. Set TestObject = New testclass
  149. Dim TestObject2 As testclass
  150. testclass
  151. Set TestObject2 = TestObject
  152. ' This is a reference to Property Let Value in TestClass
  153. TestObject2.Value = 18
  154. ' These are 1) a reference to Property Let Value
  155. ' and 2) a reference to Property Get Value in TestClass
  156. TestObject2.Value = TestObject2.Value + 1
  157. ReadINIFile
  158. OpenDB
  159. RunTheProgram
  160. End Sub
  161. Private Sub Form_Unload(Cancel As Integer)
  162. ' Quit the program
  163. ' First close the database
  164. Dim Array(1 To 2) As Long
  165. Set TestObject = Nothing
  166. CloseDatabase Array
  167. End Sub
  168. Private Sub OpenDB(ParamArray DeadArray() As Variant)
  169. ' Opening the DB
  170. ' Check for user rights
  171. ' Lock appropriate tables
  172. ' Now we reference ExtensionOnly in this file
  173. If ExtensionOnly(FName) = "TXT" Then
  174.     '
  175. ' Then we reference ExtensionOnly in FileTest
  176. ElseIf FileModule.ExtensionOnly(FName) = "TXT" Then
  177. ElseIf IsDir("C:\WINDOWS") Then
  178.     If DriveType("C:", Drive1) <> DRIVE_FIXED Then
  179.         ' Panic
  180.     Else
  181.         ' Don't panic
  182.     End If
  183. End If
  184. End Sub
  185. Private Sub Image1_Click()
  186. ' This procedure tests the With statement
  187. Const Value = 88
  188. With TestObject
  189.     ' Reference a property and a local const
  190.     .Value = .Value + Value
  191.     ' Call TestClass.ShowPublicHello
  192.     .showpublichello
  193.     ' Call TestForm.ShowPublicHello
  194.     showpublichello
  195. End With
  196. ' Another with statement
  197. With Me
  198.     ' Call TestForm.ShowPublicHello again
  199.     .showpublichello
  200. End With
  201. End Sub
  202. Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  203. If Button > 1 Then AnotherTestObject.showpublichello
  204. End Sub
  205. Private Sub Quit_Click()
  206. Unload Me
  207. End Sub
  208. Private Sub ReadINIFile()
  209. ' Read the configuration in PROJTEST.INI
  210. ' Note: If PROJTEST.INI doesn't exist, use defaults
  211. Dim Test$
  212. IsThere = IsFile("PROJTEST.INI")
  213. End Sub
  214. Private Sub RunTheProgram()
  215. ' Run the program only if there is at least 1 MB free
  216. ' disk space
  217. ' Otherwise show error message
  218. If DiskSpaceFree("C:") < 1024 ^ 2 Then
  219. End If
  220. End Sub
  221. Private Function SumFibonacci(a, b)
  222. ' Sample of a recursive call sequence
  223. ' This function is only called by Fibonacci
  224. ' but not by any other procedure
  225. ' -> Fibonacci and SumFibonacci are dead code
  226. SumFibonacci = Fibonacci(a) + Fibonacci(b)
  227. End Function
  228. Public Sub Blink()
  229. Attribute Blink.VB_Description = "This sub changes the background color\r\nof the form"
  230. Const MAXB = MAX_BUTTONS, MAXC = MAX_BUTTONS
  231. BackColor = &HFF00FF
  232. End Sub
  233. Public Sub showpublichello()
  234. ' This sub is here to assure that Project Analyzer
  235. ' can make difference between
  236. ' TestClass.ShowPublicHello and TestForm.ShowPublicHello
  237. MsgBox "Hellos from TestForm too!"
  238. End Sub
  239. Public Sub testclass()
  240. ' This is a sub that uses name shadowing extensively
  241. Dim FName As Boolean
  242. Dim List1 As Integer
  243. Dim testclass As Integer
  244. FName = True
  245. List1 = 3
  246. TestForm.List1(0).Clear
  247. End Sub
  248.