Добавляемая запись уже существует!
Поле строкового типа преобразуется в числовой тип. Все нечисловые значения будут преобразованы в 0. Продолжить? (при изменении типа поля из строкового в числовое все строки, которые нельзя преобразовать в целые числа, будут заменены 0).
Поле с названием XXX уже существует!
Окно настроек создаваемого поля:
Введенное значение не является целым числом. Преобразовано к '0'.
Главное окно:
Недостаточно прав для выполнения действия! (открыта БД, защищенная паролем, в режиме чтения и производится попытка изменения данных)
Ошибка удаления столбца!
Удалить столбец?
Ошибка удаления записи!
Удалить запись?
БД сохранена!
БД повреждена! (при загрузке БД произошла ошибка)
Пароль принят! (БД, защищенная паролем, открыта с корректно введенным паролем)
Только чтение! (БД, защищенная паролем, открыта в режиме чтения)
Пароль не принят! Доступ запрещён!
БД загружена!
БД создана с настройками по-умолчанию!
1. Microsoft Corporation Microsoft Visual Basic 6.0 Programmer’s Guide, Microsoft Press, 2003 г.
2. Microsoft® Win32® Programmer's Reference, 1996 г.
Исходный код программы
Форма: MainForm. frm
0' разница ширины и высоты формы и TabStrip'а
1Dim dW1%, dH1%
2' разница ширины и высоты TabStrip'а и ListView'а
3Dim dW2%, dH2%
4' последний выбранный элемент
5Dim saveItemIndex%
6' текущаятаблица
7Public DBCurIndex%
8' последний Image, над которым был курсор
9Dim OldImageIndex%
10
11Private Sub AboutProg_Click()
12 CoolTimer. Enabled = False
13 AboutForm. Show vbModal
14 CoolTimer. Enabled = True
15End Sub
16
17Private Sub CloseDB_Click()
18 CoolTimer. Enabled = False
19
20 If DBChanged Then
21 If (MsgForm. QuestMsg("В БД внесены не сохранённые изменения. Закрытьнесохраняя? ") <> resOk) Then GoTo exit_
22 End If
23
24 SB. Panels(3). Text = ""
25 Call ClearAll
26 Call ShowTable(-1)
27 Call DisEnImage(2, 1)
28 Call DisEnImage(3, 1)
29 Call DisEnImage(4, 1)
30
31exit_:
32
33 CoolTimer. Enabled = True
34End Sub
35
36' index,mode / сегмент, смещение
37Sub DisEnImage(Index%, Mode%)
38 CoolBut(Index). Picture = CoolImgs. ListImages(1 + (Index * 3 + Mode)). Picture
39 CoolBut(Index). Enabled = (Mode <> 1)
40End Sub
41
42Sub RetImage()
43 If (OldImageIndex > - 1) Then
44 If CoolBut(OldImageIndex). Enabled Then
45 Call DisEnImage(OldImageIndex, 0)
46 Else
47 Call DisEnImage(OldImageIndex, 1)
48 End If
49 End If
50 OldImageIndex = - 1
51End Sub
52
53Sub CoolMouseMove(Index%)
54 If (Index = OldImageIndex) Then Exit Sub
55 Call DisEnImage(Index, 2)
56 Call RetImage
57 OldImageIndex = Index
58End Sub
59
60Private Sub CoolBut_Click(Index As Integer)
61 Call DisEnImage(Index, 0)
62 Select Case Index
63 Case 0: Call CreateDB_Click
64 Case 1: Call OpenDB_Click
65 Case 2: Call SaveDB_Click
66 Case 3: Call CloseDB_Click
67 Case 4: Call ResCopyDB_Click
68 Case 5: Call ExitPr_Click
69 End Select
70End Sub
71
72Private Sub CoolTimer_Timer()
73 Dim Point As POINTAPI
74 Dim R As RECT, R2 As RECT
75 Call GetCursorPos(Point)
76 Call GetWindowRect(Frame1. hwnd, R)
77 For i% = 0 To 5
78 If (Not CoolBut(i). Enabled) Then GoTo loop_
79 x% = R. Left + CoolBut(i). Left / Screen. TwipsPerPixelX
80 y% = R. Top + CoolBut(i). Top / Screen. TwipsPerPixelY
81 X2% = x + CoolBut(i). Width / Screen. TwipsPerPixelX
82 Y2% = y + CoolBut(i). Height / Screen. TwipsPerPixelY
83 R2. Left = x
84 R2. Top = y
85 R2. Right = X2
86 R2. Bottom = Y2
87 If ((Point. x >= R2. Left) And (Point. x <= R2. Right) And (Point. y >= R2. Top) And (Point. y <= R2. Bottom)) Then
88 Call CoolMouseMove(i)
89 Exit Sub
90 End If
91loop_:
92 Next i
93 Call RetImage
94End Sub
95
96Private Sub CreateDB_Click()
97 CoolTimer. Enabled = False
98 Dlgs. FileName = ""
99 Dlgs. ShowSave
100 If (Dlgs. FileName <> "") Then
101 ' создаюновуюБД
102 Call NewDB(Dlgs. FileName)
103 ' вывожу путь к БД
104 SB. Panels(3). Text = DBPath
105 ' разрешения
106 Call DisEnImage(2, 0)
107 Call DisEnImage(3, 0)
108 Call DisEnImage(4, 0)
109 Call ShowTable(DBCurIndex)
110 End If
111 CoolTimer. Enabled = True
112End Sub
113
114Private Sub DiagDraw_Click()
115 CoolTimer. Enabled = False
116 DiagMasterForm. Show vbModal
117 CoolTimer. Enabled = True
118End Sub
119
120Private Sub ExitBut_Click()
121 Call ExitPr_Click
122End Sub
123
124Private Sub ExitPr_Click()
125 CoolTimer. Enabled = False
126 If Not DBChanged Then
127 End
128 Else
129 If (MsgForm. QuestMsg("В БД внесены не сохранённые изменения. Выйтинесохраняя? ") = resOk) Then End
130 End If
131 CoolTimer. Enabled = True
132End Sub
133
134Private Sub File_Click()
135 SaveDB. Enabled = DBPath <> ""
136 CloseDB. Enabled = SaveDB. Enabled
137 ResCopyDB. Enabled = SaveDB. Enabled
138End Sub
139
140Private Sub HelpProg_Click()
141 CoolTimer. Enabled = False
142 Call ShellExecute(hwnd, "open", "Help\index. html", "", "", 0)
143 CoolTimer. Enabled = True
144End Sub
145
146Sub CreateHTML(Path$)
147 Call DeleteFile(Path)
148 DBI% = FreeFile
149 Open Path For Binary As DBI
150
151 Capt$ = InputForm. InputVal("Введите заголовок для таблицы")
152
153 HTMLHeader$ = Replace("<html><head><meta http-equiv=~Content-Language~ content=~ru~>" + _
154 "<meta http-equiv=~Content-Type~ content=~text/html; charset=windows-1251~>", "~", Chr(34))
155
156 HTMLInfo$ = "<title>" + Capt + "</title>"
157
158 HTMLStart$ = Replace("</head><body><div align=~center~><table border=~1~ cellspacing=~2~ style=~border-collapse: collapse~>", "~", Chr(34))
159
160 HTMLEnd$ = "</table></div><br><br><br><hr><i>Файлсгенерированпрограммой DB Xtension посодержимомуБД </i><b>' " + DBPath + "' </b></body></html>"
161
162 HTMLCaption$ = Replace("<tr><td colspan=~" + CStr(DB(DBCurIndex). Header. ColCount) + "~ align=~center~ bgcolor=~#66CCFF~><font color=~#FFFF00~ size=~5~>" + Capt + "</font></td></tr>", "~", Chr(34))
163
164 HTMLRowS$ = "<tr>"
165 HTMLRowE$ = "</tr>"
166
167 If (DB(DBCurIndex). Header. ColCount > 0) Then ColWidth% = 100 \ DB(DBCurIndex). Header. ColCount
168
169 HTMLCols$ = Replace("<td bgcolor=~#999999~ width=~" + CStr(ColWidth) + "%~ align=~center~><b><font face=~Arial~ color=~#FFFFFF~>^</font></b></td>", "~", Chr(34))
170
171 HTMLCells$ = Replace("<td width=~" + CStr(ColWidth) + "%~ align=~center~>^</td>", "~", Chr(34))
172
173 Put DBI,, HTMLHeader
174 Put DBI,, HTMLInfo
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 EndIf
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