home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / pa32v303 / test40.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-05-11  |  7.2 KB  |  232 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 
  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          =   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.       ItemData        =   "TEST40.frx":1910
  50.       Left            =   60
  51.       List            =   "TEST40.frx":191D
  52.       MouseIcon       =   "TEST40.frx":1939
  53.       MousePointer    =   99  'Custom
  54.       TabIndex        =   2
  55.       Top             =   360
  56.       Width           =   915
  57.    End
  58.    Begin VB.CommandButton Quit 
  59.       Appearance      =   0  'Flat
  60.       BackColor       =   &H80000005&
  61.       Caption         =   "Quit"
  62.       Height          =   330
  63.       Left            =   3780
  64.       TabIndex        =   0
  65.       Top             =   630
  66.       Width           =   1275
  67.    End
  68.    Begin VB.Image Image2 
  69.       Appearance      =   0  'Flat
  70.       Height          =   240
  71.       Left            =   4320
  72.       Picture         =   "TEST40.frx":1A8B
  73.       Top             =   120
  74.       Width           =   240
  75.    End
  76.    Begin VB.Image Image1 
  77.       Appearance      =   0  'Flat
  78.       Height          =   240
  79.       Left            =   3960
  80.       Picture         =   "TEST40.frx":1B8D
  81.       Top             =   120
  82.       Width           =   240
  83.    End
  84.    Begin VB.Label Label1 
  85.       Appearance      =   0  'Flat
  86.       BackColor       =   &H80000005&
  87.       BackStyle       =   0  'Transparent
  88.       Caption         =   "This program will not do anything"
  89.       ForeColor       =   &H80000008&
  90.       Height          =   225
  91.       Left            =   210
  92.       TabIndex        =   1
  93.       Top             =   90
  94.       Width           =   3000
  95.    End
  96. Attribute VB_Name = "TestForm"
  97. Attribute VB_Creatable = False
  98. Attribute VB_Exposed = False
  99. ' A test project for Project Analyzer
  100. ' (C)1996 MyCompany Ltd.
  101. ' This is the form of the main screen
  102. ' This file also includes some important database routines
  103. DefStr W
  104. Public DatabaseName$
  105. Dim Weekdays(0 To 6)
  106. ' Project Analyzer doesn't understand MAX_BUTTONS isn't dead
  107. Const MAX_BUTTONS = 50
  108. Dim Button(0 To MAX_BUTTONS) As CommandButton
  109. Dim FName As String
  110. ' This is a module-level variable that overrides the
  111. ' global variable FName in Test40.bas
  112. Public FName2 As String
  113. ' This is a completely legal declaration in VB 4.0
  114. ' There is already a Public FName2 declared in Test40.bas
  115. ' This is another one
  116. ' Dim and Private mean the same here
  117. Dim TestObject As TestClass
  118. Private AnotherTestObject As New TestClass
  119. Private Sub CloseDatabase()
  120. ' Close the database
  121. ' Check that all information is up-to-date
  122. ReDim Preserve Button(0 To MAX_BUTTONS / 2) As CommandButton
  123. End Sub
  124. Private Function ExtensionOnly(ByVal File As String) As String
  125. ' Returns file name extension "BAS"
  126. ' This is a module-level function that will override
  127. ' the global function ExtensionOnly defined in FILETEST.BAS
  128. ExtensionOnly = Right(File, 3)
  129. End Function
  130. Private Function Fibonacci(ByVal n As Integer)
  131. ' Sample of a recursive call sequence
  132. ' This function is only called by SumFibonacci
  133. ' but not by any other procedure
  134. ' -> Fibonacci and SumFibonacci are dead code
  135. If n = 1 Then
  136.     Fibonacci = 1
  137. ElseIf n = 2 Then
  138.     Fibonacci = 1
  139.     Fibonacci = SumFibonacci(n - 1, n - 2)
  140. End If
  141. End Function
  142. Private Sub Form_Load()
  143. ' Start of the program
  144. Set Button(0) = Quit
  145. Set TestObject = New TestClass
  146. Dim TestObject2 As TestClass
  147. Set TestObject2 = TestObject
  148. ' This is a reference to Property Let Value in TestClass
  149. TestObject2.Value = 18
  150. ' These are 1) a reference to Property Let Value
  151. ' and 2) a reference to Property Get Value in TestClass
  152. TestObject2.Value = TestObject2.Value + 1
  153. ReadINIFile
  154. OpenDB
  155. RunTheProgram
  156. End Sub
  157. Private Sub Form_Unload(Cancel As Integer)
  158. ' Quit the program
  159. ' First close the database
  160. Set TestObject = Nothing
  161. CloseDatabase
  162. End Sub
  163. Private Sub OpenDB()
  164. ' Opening the DB
  165. ' Check for user rights
  166. ' Lock appropriate tables
  167. ' Now we reference ExtensionOnly in this file
  168. If ExtensionOnly(FName) = "TXT" Then
  169.     '
  170. ' Then we reference ExtensionOnly in FileTest
  171. ElseIf FileModule.ExtensionOnly(FName) = "TXT" Then
  172. ElseIf IsDir("C:\WINDOWS") Then
  173.     If DriveType("C:", Drive1) <> DRIVE_FIXED Then
  174.         ' Panic
  175.     Else
  176.         ' Don't panic
  177.     End If
  178. End If
  179. End Sub
  180. Private Sub Image1_Click()
  181. ' This procedure tests the With statement
  182. Const Value = 88
  183. With TestObject
  184.     ' Reference a property and a local const
  185.     .Value = .Value + Value
  186.     ' Call TestClass.ShowPublicHello
  187.     .ShowPublicHello
  188.     ' Call TestForm.ShowPublicHello
  189.     ShowPublicHello
  190. End With
  191. ' Another with statement
  192. With Me
  193.     ' Call TestForm.ShowPublicHello again
  194.     .ShowPublicHello
  195. End With
  196. End Sub
  197. Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  198. If Button > 1 Then AnotherTestObject.ShowPublicHello
  199. End Sub
  200. Private Sub Quit_Click()
  201. Unload Me
  202. End Sub
  203. Private Sub ReadINIFile()
  204. ' Read the configuration in PROJTEST.INI
  205. ' Note: If PROJTEST.INI doesn't exist, use defaults
  206. IsThere = IsFile("PROJTEST.INI")
  207. End Sub
  208. Private Sub RunTheProgram()
  209. ' Run the program only if there is at least 1 MB free
  210. ' disk space
  211. ' Otherwise show error message
  212. If DiskSpaceFree("C:") < 1024 ^ 2 Then
  213. End If
  214. End Sub
  215. Private Function SumFibonacci(a, b)
  216. ' Sample of a recursive call sequence
  217. ' This function is only called by Fibonacci
  218. ' but not by any other procedure
  219. ' -> Fibonacci and SumFibonacci are dead code
  220. SumFibonacci = Fibonacci(a) + Fibonacci(b)
  221. End Function
  222. Public Sub Blink()
  223. Attribute Blink.VB_Description = "This sub changes the background color\r\nof the form"
  224. BackColor = &HFF00FF
  225. End Sub
  226. Public Sub ShowPublicHello()
  227. ' This sub is here to assure that Project Analyzer
  228. ' can make difference between
  229. ' TestClass.ShowPublicHello and TestForm.ShowPublicHello
  230. MsgBox "Hellos from TestForm too!"
  231. End Sub
  232.