Курсовая работа: Создание базы данных
175
176 If (DB(DBCurIndex). Header. ColCount
> 0) Then
177 Put DBI,, HTMLStart
178 Put DBI,, HTMLCaption
179
180 Put DBI,, HTMLRowS
181 For c% = 0 To DB(DBCurIndex). Header. ColCount
- 1
182 Put DBI,, Replace(HTMLCols,
"^", CStr(DB(DBCurIndex). Cols(c). title))
183 Next c
184 Put DBI,, HTMLRowE
185
186 For R% = 0 To DB(DBCurIndex). Header. RowCount
- 1
187 Put DBI,, HTMLRowS
188 For c% = 0 To DB(DBCurIndex). Header. ColCount
- 1
189 tmp$ = CStr(DB(DBCurIndex). Rows(R). Fields(c))
190 If (Trim(tmp) = "") Then tmp
= " "
191 Put DBI,, Replace(HTMLCells,
"^", tmp)
192 Next c
193 Put DBI,, HTMLRowE
194 Next R
195
196 Put DBI,, HTMLEnd
197 Else
198 Put DBI,,
"</head><body>База не содержит данных</body></html>"
199 End If
200
201 Close DBI
202
203 If (MsgForm. QuestMsg("Файл
'" + Path + "' создан. Открыть? ") = resOk) Then
204 Call ShellExecute(hwnd,
"open", Path, "", "", 0)
205 End If
206End Sub
207
208Private Sub HTMLCreator_Click()
209 CoolTimer. Enabled = False
210 HTMLPath. FileName = ""
211 HTMLPath. ShowSave
212 If (HTMLPath. FileName <>
"") Then
213 Call CreateHTML(HTMLPath. FileName)
214 Else
215 Call MsgForm. ErrorMsg("Формирование HTML-документа отменено!
")
216 End If
217 CoolTimer. Enabled = True
218End Sub
219
220Private Sub ListView_DblClick()
221 If (saveItemIndex > 0) Then
222 Load EditRecordForm
223 With EditRecordForm
224. CellList. Clear
225. ERFDBIndex = DBCurIndex
226 Call. LoadData(saveItemIndex - 1)
227 Call. OverloadList
228. Show vbModal
229 End With
230 End If
231End Sub
232
233Private Sub ListView_ItemClick(ByVal
Item As MSComctlLib. ListItem)
234 saveItemIndex = Item. Index
235End Sub
236
237Private Sub ListView_MouseDown(Button As
Integer, Shift As Integer, x As Single, y As Single)
238 saveItemIndex = 0
239End Sub
240
241Private Sub OptDB_Click()
242 Security. Enabled = DBPath <>
""
243End Sub
244
245Private Sub Form_Load()
246' регистрации расширения
247 Call ShellExecute(0, "",
"assoc. exe", App. Path + "\" + App. EXEName + ". exe",
"", 0)
248 DBCurIndex = 0
249 UserIsAdmin = True
250 saveItemIndex = 0
251 OldImageIndex = - 1
252 Call ClearAll
253 dW1 = Width - TabStrip. Width
254 dH1 = Height - TabStrip. Height
255 dW2 = Width - ListView. Width
256 dH2 = Height - ListView. Height
257 Call DisEnImage(0, 0)
258 Call DisEnImage(1, 0)
259 Call DisEnImage(2, 1)
260 Call DisEnImage(3, 1)
261 Call DisEnImage(4, 1)
262 Call DisEnImage(5, 0)
263End Sub
264
265Private Sub Form_Resize()
266 CoolBar1. Width = 2 * Width
267
268 Min% = MainForm. Width - dW2
269 If (Min < 0) Then: Min = 0
270 ListView. Width = Min
271
272 Min = MainForm. Height - dH2
273 If (Min < 0) Then: Min = 0
274 ListView. Height = Min
275
276 Min = MainForm. Width - dW1
277 If (Min < 0) Then: Min = 0
278 TabStrip. Width = Min
279
280 Min = MainForm. Height - dH1
281 If (Min < 0) Then: Min = 0
282 TabStrip. Height = Min
283End Sub
284
285Private Sub Form_Unload(Cancel%)
286 If DBChanged Then
287 If (MsgForm. QuestMsg("Выйти?
") = resNo) Then Cancel = 1
288 End If
289 Close ' пожалуй, это лишнее, но да мало ли:)
290End Sub
291
292Private Sub OpenDB_Click()
293 CoolTimer. Enabled = False
294 Dlgs. FileName = ""
295 Dlgs. ShowOpen
296 If (Dlgs. FileName <>
"") Then
297 ' открываю БД
298 If LoadDB(DBCurIndex, Dlgs. FileName) Then
299 ' вывожу путь к БД
300 SB. Panels(3). Text = DBPath
301 Call DisEnImage(2, 0)
302 Call DisEnImage(3, 0)
303 Call DisEnImage(4, 0)
304 Call ShowTable(DBCurIndex)
305 End If
306 End If
307 CoolTimer. Enabled = True
308End Sub
309
310Private Sub QueryDB_Click()
311 QueryM. Enabled = DBPath <>
""
312End Sub
313
314Private Sub ResDB_Click()
315 DiagDraw. Enabled = DBPath <>
""
316 HTMLCreator. Enabled = DBPath <>
""
317End Sub
318
319Private Sub QueryM_Click()
320 CoolTimer. Enabled = False
321 With QueryMasterForm
322. QMFDBIndex = DBCurIndex
323. Show vbModal
324 End With
325 CoolTimer. Enabled = True
326End Sub
327
328Private Sub ResCopyDB_Click()
329 CoolTimer. Enabled = False
330 Dlgs. FileName = ""
331 Dlgs. ShowSave
332 If (Dlgs. FileName <>
"") Then
333 If (Dlgs. FileName = DBPath) Then
334 Call MsgForm. ErrorMsg("Нельзя копировать файл сам в себя! ")
335 Else
336 Call CopyFile(DBPath, Dlgs. FileName,
False)
337 Call MsgForm. InfoMsg("Архивная копия БД создана. ")
338 End If
339 Else
340 Call MsgForm. ErrorMsg("Резервное копирование БД отменено! ")
341 End If
342 CoolTimer. Enabled = True
343End Sub
344
345Private Sub SaveDB_Click()
346 CoolTimer. Enabled = False
347 Dlgs. FileName = ""
348 Dlgs. ShowSave
349 If (Dlgs. FileName <>
"") Then
350 DBPath = Dlgs. FileName
351 Call FlushDB(DBCurIndex)
352 End If
353 CoolTimer. Enabled = True
354End Sub
355
356Private Sub Security_Click()
357 CoolTimer. Enabled = False
358 If UserIsAdmin Then
359 With PasswordForm
360. SetPassText = DB(DBCurIndex). Password
361
362 If (DB(DBCurIndex). Header. Flags And
flCoded) Then
363. CheckCoded = 1
364 Else
365. CheckCoded = 0
366 End If
367 If (DB(DBCurIndex). Header. Flags And
flReadOnlyEnable) Then
368. CheckNoRO = 1
369 Else
370. CheckNoRO = 0
371 End If
372. CaptionLabel = "Настройка защиты"
373. TextLabel = "Вы можете изменить пароль и
права доступа к данной БД. Наличие пароля предполагает ограниченный доступ. "
374. Frame1. Visible = False
375. Frame2. Visible = True
376. Show vbModal
377 If (. res) Then
378 DB(DBCurIndex). Header. Flags = 0
379 If (Trim(. SetPassText) <>
"") Then
380 DB(DBCurIndex). Password = Trim(. SetPassText)
381 DB(DBCurIndex). Header. Flags =
flPasswordNeed
382 Call MsgForm. InfoMsg("Был задан пароль! ")
383 End If
384 DB(DBCurIndex). Header. Flags =
DB(DBCurIndex). Header. Flags + (flCoded *. CheckCoded) + (flReadOnlyEnable *. CheckNoRO)
385 End If
386 Unload PasswordForm
387 End With
388 Else
389 Call ProtectedMsg
390 End If
391 CoolTimer. Enabled = True
392End Sub
393
394Private Sub TabStrip_Click()
395 If (TabStrip. Tabs. Count = 0) Then
Exit Sub
396 If (DBCurIndex <> TabStrip. SelectedItem.
Index - 1) Then
397 DBCurIndex = TabStrip. SelectedItem. Index
- 1
398 Call ShowTable(DBCurIndex)
399End If
400End Sub
401
402Private Sub TabStrip_MouseDown(Button As
Integer, Shift As Integer, x As Single, y As Single)
403 If (Shift = vbCtrlMask) Then PopupMenu
TSMenu
404End Sub
405
406Private Sub TSClose_Click()
407 If (MsgForm. QuestMsg("Закрыть закладку? ") = resOk) Then
408 TabIndex% = TabStrip. SelectedItem. Index
409 TabStrip. Tabs. Remove (TabIndex)
410 Call DelTable(TabIndex - 1)
411
412 If (TabStrip. Tabs. Count = 0) Then
413 DBChanged = False
414 Call DisEnImage(2, 1)
415 Call DisEnImage(3, 1)
416 Call DisEnImage(4, 1)
417 Call ShowTable(-1)
418 Else
419 TabStrip. SelectedItem = TabStrip. Tabs.
Item(1)
420 End If
421 End If
422End Sub
Форма:
TableForm. frm
423Dim tmp As String
424
425Public Function AddColDlg(DBIndex%) As
String
426 tmp = ""
427 With StCol
428. Clear
429 For i% = 1 To DB(DBIndex). Header. ColCount
430. AddItem DB(DBIndex). Cols(i - 1). title
431 Next
432. ListIndex =. ListCount - 1
433 End With
434 ColType. ListIndex = 0
435 Me. Show vbModal
436 AddColDlg = tmp
437 Unload Me
438End Function
439
440Private Sub ColType_Click()
441 ' изменение допустимых длин
442 If Visible Then
443 Select Case ColType. ListIndex
444 Case ccInteger: InitValue. MaxLength =
4
445 Case ccString: InitValue. MaxLength =
255
446 End Select
447 End If
448
449' контроль ввода
450 If Visible And (ColType. ListIndex =
ccInteger) Then
451 If (Not IsInteger(InitValue. Text)) Then
InitValue. Text = "0"
Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20 |
