home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD53704302000.psc / CodeLib_V2 / Cat1.frm (.txt) next >
Encoding:
Visual Basic Form  |  2000-01-22  |  4.2 KB  |  156 lines
  1. VERSION 5.00
  2. Begin VB.Form Cat1 
  3.    AutoRedraw      =   -1  'True
  4.    Caption         =   "CodeLib V2.0"
  5.    ClientHeight    =   3480
  6.    ClientLeft      =   60
  7.    ClientTop       =   345
  8.    ClientWidth     =   4680
  9.    Icon            =   "Cat1.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    Moveable        =   0   'False
  14.    ScaleHeight     =   232
  15.    ScaleMode       =   3  'Pixel
  16.    ScaleWidth      =   312
  17.    StartUpPosition =   2  'CenterScreen
  18.    Begin VB.CommandButton Command2 
  19.       BackColor       =   &H00C0C000&
  20.       Caption         =   "Exit"
  21.       Height          =   285
  22.       Left            =   3690
  23.       MaskColor       =   &H00C0C000&
  24.       Style           =   1  'Graphical
  25.       TabIndex        =   5
  26.       Top             =   2970
  27.       Width           =   825
  28.    End
  29.    Begin VB.CommandButton Command1 
  30.       BackColor       =   &H00C0C000&
  31.       Caption         =   "Accept"
  32.       Height          =   285
  33.       Left            =   2655
  34.       MaskColor       =   &H00C0C000&
  35.       Style           =   1  'Graphical
  36.       TabIndex        =   4
  37.       Top             =   2970
  38.       Width           =   870
  39.    End
  40.    Begin VB.TextBox Text1 
  41.       BackColor       =   &H00E0E0E0&
  42.       Height          =   240
  43.       Left            =   225
  44.       TabIndex        =   3
  45.       Top             =   2520
  46.       Width           =   4200
  47.    End
  48.    Begin VB.ListBox List1 
  49.       Appearance      =   0  'Flat
  50.       BackColor       =   &H00E0E0E0&
  51.       Height          =   1590
  52.       Left            =   2430
  53.       TabIndex        =   1
  54.       Top             =   720
  55.       Width           =   1995
  56.    End
  57.    Begin VB.Label Label2 
  58.       Alignment       =   2  'Center
  59.       Caption         =   "Present categories"
  60.       Height          =   195
  61.       Left            =   225
  62.       TabIndex        =   2
  63.       Top             =   720
  64.       Width           =   1995
  65.    End
  66.    Begin VB.Label Label1 
  67.       Alignment       =   2  'Center
  68.       Caption         =   "Adding a new category"
  69.       BeginProperty Font 
  70.          Name            =   "MS Sans Serif"
  71.          Size            =   12
  72.          Charset         =   0
  73.          Weight          =   700
  74.          Underline       =   0   'False
  75.          Italic          =   0   'False
  76.          Strikethrough   =   0   'False
  77.       EndProperty
  78.       ForeColor       =   &H000000C0&
  79.       Height          =   330
  80.       Left            =   225
  81.       TabIndex        =   0
  82.       Top             =   180
  83.       Width           =   4200
  84.    End
  85. Attribute VB_Name = "Cat1"
  86. Attribute VB_GlobalNameSpace = False
  87. Attribute VB_Creatable = False
  88. Attribute VB_PredeclaredId = True
  89. Attribute VB_Exposed = False
  90. Option Compare Text
  91. Private Sub Command1_Click()
  92. For xx = 0 To 99
  93. If Trim(Text1.Text) = Cat(xx) Then
  94. xx = 99
  95. GoTo SaveCat3:
  96. End If
  97. Next xx
  98. For xx = 0 To 99
  99. If Cat(xx) = "" Then
  100. Cat(xx) = Trim(Text1.Text)
  101. Exit For
  102. End If
  103. Next xx
  104. 'Save categories
  105. On Error GoTo SaveCat2
  106. ff = FreeFile
  107. Open App.Path & "\Data\Cat.ini" For Output As #ff
  108. For xx = 0 To 99
  109. 'If Cat(xx) = "" Then Exit For
  110. Print #ff, Cat(xx)
  111. Next xx
  112. Close #ff
  113. LoadCat
  114. Cat1.Hide
  115. Exit Sub
  116. SaveCat2:
  117. Close #ff
  118. Msbox "There's an error while" & vbCr & "saving the category-data..." & vbCr & vbCr & "Error: " & Err & "  " & Err.Description, Title, mbOkonly, mbCritical
  119. Exit Sub
  120. SaveCat3:
  121. Msbox "This category already exists !", Title, mbOkonly, mbCritical
  122. Text1.SelStart = 0
  123. Text1.SelLength = Len(Text1.Text)
  124. Text1.SetFocus
  125. Cat1.Command1.Enabled = False
  126. End Sub
  127. Private Sub Command2_Click()
  128. Cat1.Hide
  129. End Sub
  130. Private Sub Form_Activate()
  131. List1.Clear
  132. For xx = 0 To 99
  133. If Cat(xx) <> "" Then
  134. List1.AddItem Format(xx, "00") & "  " & Cat(xx)
  135. End If
  136. Next xx
  137. On Error Resume Next
  138. Text1.SetFocus
  139. End Sub
  140. Private Sub Form_Load()
  141. T3D Cat1, Cat1.Label1, 5, T3dRaiseRaise
  142. T3D Cat1, Cat1.Label2, 5, T3dRaiseRaise
  143. T3D Cat1, Cat1.Text1, 5, T3dRaiseRaise
  144. T3D Cat1, Cat1.List1, 5, T3dRaiseRaise
  145. End Sub
  146. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  147. Cancel = True
  148. Cat1.Hide
  149. End Sub
  150. Private Sub Text1_Change()
  151. If Text1.Text <> "" Then
  152. Command1.Enabled = True
  153. Command1.Enabled = False
  154. End If
  155. End Sub
  156.