50133 (Создание базы данных), страница 6
Описание файла
Документ из архива "Создание базы данных", который расположен в категории "". Всё это находится в предмете "информатика" из 1 семестр, которые можно найти в файловом архиве . Не смотря на прямую связь этого архива с , его также можно найти и в других разделах. Архив можно найти в разделе "курсовые/домашние работы", в предмете "информатика, программирование" в общих файлах.
Онлайн просмотр документа "50133"
Текст 6 страницы из документа "50133"
1108 Call sndPlaySound("Data\Info. wav", SND_ASYNC + SND_FILENAME + SND_LOOP + SND_APPLICATION)
1109 Show vbModal
1110 InfoMsg = res
1111 Unload Me
1112End Function
1113
1114Public Function QuestMsg(str$, Optional showcancel As Boolean = False) As Integer
1115 Caption = "Вопрос"
1116 Text = str
1117
1118 If showcancel Then
1119 YesFrame. Visible = True
1120 NoFrame. Visible = True
1121 CancelFrame. Visible = True
1122
1123 YesFrame. Move 360
1124 NoFrame. Move 4380
1125 CancelFrame. Move 2400
1126
1127 Else
1128 YesFrame. Visible = True
1129 NoFrame. Visible = True
1130 CancelFrame. Visible = False
1131
1132 YesFrame. Move 900
1133 NoFrame. Move 3840
1134 End If
1135
1136 InfoImage. Visible = False
1137 ErrImage. Visible = False
1138 QuestImage. Visible = True
1139
1140 res = 0
1141 Call sndPlaySound("Data\Quest. wav", SND_ASYNC + SND_FILENAME + SND_LOOP + SND_APPLICATION)
1142 Show vbModal
1143 QuestMsg = res
1144 Unload Me
1145End Function
1146
1147Private Sub CancelBut_Click()
1148 res = resCancel
1149 Call SoundClick
1150 Hide
1151End Sub
1152
1153Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
1154 Select Case KeyCode
1155 Case 13
1156 Call YesBut_Click
1157 Case 27
1158 Call NoBut_Click
1159 Case 8
1160 If (CancelFrame. Visible = True) Then Call CancelBut_Click
1161 End Select
1162End Sub
1163
1164Private Sub Form_Load()
1165 Call ButEnabled(YesImg, YesBut, True)
1166 Call ButEnabled(CancelImg, CancelBut, True)
1167 Call ButEnabled(NoImg, NoBut, True)
1168End Sub
1169
1170Private Sub NoBut_Click()
1171 res = resNo
1172 Call SoundClick
1173 Hide
1174End Sub
1175
1176Private Sub YesBut_Click()
1177 res = resOk
1178 Call SoundClick
1179 Hide
1180End Sub
1181
Форма: DiagMasterForm. frm
1182Dim DiagData()
1183
1184Private Sub DiagTypeCombo_Click()
1185 DiagTypeImage. Picture = DiagTypeImgs. ListImages(DiagTypeCombo. ListIndex + 1). Picture
1186 Select Case DiagTypeCombo. ListIndex
1187 Case 0, 2: Frame2. Visible = False
1188 Case 1, 3: Frame2. Visible = True
1189 End Select
1190End Sub
1191
1192Private Sub Enabled3DCheck_Click()
1193 DimImg. Picture = DiagTypeImgs. ListImages(5 + Enabled3DCheck. value). Picture
1194End Sub
1195
1196Private Sub Form_Load()
1197 Call ButEnabled(OkImg, OkBut, False)
1198 Call ButEnabled(CancelImg, CancelBut, True)
1199 TopImg. Picture = MainForm. TopImageList. ListImages(1). Picture
1200 DiagTypeCombo. ListIndex = 0
1201 DimImg. Picture = DiagTypeImgs. ListImages(5). Picture
1202
1203 TableIndexCombo. Clear
1204 SelectColList. Clear
1205 For i% = 1 To MainForm. TabStrip. Tabs. Count
1206 TableIndexCombo. AddItem MainForm. TabStrip. Tabs(i). Caption
1207 Next i
1208 TableIndexCombo. ListIndex = 0
1209End Sub
1210
1211' по строке "{x, YYY} ZZZ" возвращает номер таблицы (x)
1212Sub GetTableIndex(ByVal str As String, TI As Integer)
1213 s$ = Trim$(Mid$(str, 2, InStr(1, str, ",") - 2))
1214 TI = CInt(s)
1215End Sub
1216
1217' по строке "{x, YYY} ZZZ" и номеру таблицы возвращает номер поля с заголовком ZZZ
1218Sub GetColIndex(ByVal str As String, ByVal TI As Integer, CI As Integer)
1219 s$ = Trim$(Mid$(str, InStr(1, str, "}") + 1))
1220 For i% = 0 To DB(TI). Header. ColCount - 1
1221 If (s = Trim(DB(TI). Cols(i). title)) Then
1222 CI = i
1223 Exit Sub
1224 End If
1225 Next i
1226 CI = - 1 ' событие невозможное но вероятное
1227End Sub
1228
1229Function GettingDiagData(OnlyOneCol As Boolean) As Boolean
1230 GettingDiagData = False
1231
1232 Dim TI As Integer, CI As Integer
1233
1234 Select Case OnlyOneCol
1235 Case True ' ************************************************************************
1236 Call GetTableIndex(SelectColList. List(0), TI)
1237 Call GetColIndex(SelectColList. List(0), TI, CI)
1238 ' зная номер таблицы и номер поля данных нужно проверить тип поля
1239 If (DB(TI). Cols(CI). Class <> ccInteger) Then
1240 Call MsgForm. ErrorMsg("Нельзя строить диаграмму по нечисленным данным! ")
1241 Exit Function
1242 End If
1243 ' заполнение массива данных
1244 ReDim DiagData(2 * DB(TI). Header. RowCount)
1245 For i% = 0 To DB(TI). Header. RowCount - 1
1246 DiagData(2 * i) = DB(TI). Rows(i). Fields(CI)
1247 DiagData(2 * i + 1) = DiagData(2 * i)
1248 Next i
1249 GettingDiagData = True
1250
1251 Case False ' ************************************************************************
1252 ReDim DiagData(2 * SelectColList. ListCount)
1253 For R% = 0 To SelectColList. ListCount - 1
1254 Call GetTableIndex(SelectColList. List(R), TI)
1255 Call GetColIndex(SelectColList. List(R), TI, CI)
1256 ' зная номер таблицы и номер поля данных нужно проверить тип поля
1257 If (DB(TI). Cols(CI). Class <> ccInteger) Then
1258 Call MsgForm. ErrorMsg("Нельзя строить диаграмму по нечисленным данным! ")
1259 Exit Function
1260 End If
1261 Dim Summary As Integer
1262 Summary = 0
1263 For i% = 0 To DB(TI). Header. RowCount - 1
1264 Summary = Summary + DB(TI). Rows(i). Fields(CI)
1265 Next i
1266 ' заполнение массива данных
1267 DiagData(2 * R) = Summary
1268 DiagData(2 * R + 1) = MainForm. TabStrip. Tabs(TI + 1). Caption + ". " + DB(TI). Cols(CI). title
1269 Next R
1270 GettingDiagData = True
1271 End Select
1272
1273End Function
1274
1275Private Sub OkBut_Click()
1276 If (OkBut. Tag = 0) Then Exit Sub
1277 Call SoundClick
1278
1279 If GettingDiagData(SelectColList. ListCount = 1) Then
1280 Load DiagResForm
1281 Call DiagResForm. InitDiagData(DiagData, DiagTypeCombo. ListIndex, (Enabled3DCheck. value = 1))
1282 DiagResForm. Show vbModal
1283 End If
1284End Sub
1285
1286Private Sub CancelBut_Click()
1287 Call SoundClick
1288 Unload Me
1289End Sub
1290
1291Private Sub TableColList_DblClick()
1292 i% = TableColList. ListIndex
1293 s$ = "{ " + CStr(TableIndexCombo. ListIndex) + ", " + TableIndexCombo. Text + " } " + TableColList. List(i)
1294 For j% = 0 To SelectColList. ListCount - 1
1295 If (SelectColList. List(j) = s) Then Exit Sub
1296 Next j
1297 Call ButEnabled(OkImg, OkBut, True)
1298 SelectColList. AddItem s
1299End Sub
1300
1301Private Sub SelectColList_DblClick()
1302 If (SelectColList. ListIndex > - 1) Then SelectColList. RemoveItem SelectColList. ListIndex
1303 Call ButEnabled(OkImg, OkBut, (SelectColList. ListCount > 0))
1304End Sub
1305
1306Private Sub TableIndexCombo_Click()
1307 DBI% = TableIndexCombo. ListIndex
1308 TableColList. Clear
1309 For i% = 0 To DB(DBI). Header. ColCount - 1
1310 TableColList. AddItem DB(DBI). Cols(i). title
1311 Next i
1312 If (TableColList. ListCount > 0) Then TableColList. ListIndex = 0
1313End Sub
Форма: PasswordForm. frm
1314Public res As Boolean
1315
1316Private Sub Form_Activate()
1317 res = False
1318 If Frame1. Visible Then
1319 PassText. SetFocus
1320 Else
1321 SetPassText. SetFocus
1322 End If
1323End Sub
1324
1325Private Sub Form_Load()
1326 Call ButEnabled(OkImg, OkBut, True)
1327 Call ButEnabled(CancelImg, CancelBut, True)
1328 TopImg. Picture = MainForm. TopImageList. ListImages(1). Picture
1329End Sub
1330
1331Private Sub OkBut_Click()
1332 res = True
1333 Call SoundClick
1334 Hide
1335End Sub
1336
1337Private Sub CancelBut_Click()
1338 Call SoundClick
1339 Hide
1340End Sub
1341
1342Private Sub PassText_KeyDown(KeyCode As Integer, Shift As Integer)
1343 If (KeyCode = 13) Then Call OkBut_Click
1344End Sub
1345
1346Private Sub SetPassText_KeyDown(KeyCode As Integer, Shift As Integer)
1347 If (KeyCode = 13) Then Call OkBut_Click
1348End Sub
Форма: AboutForm. frm
1349Private Sub Form_Load()
1350 Call MInit
1351 Call ButEnabled(OkImg, OkBut, True)
1352 Label6. Caption = "v. " + CStr(App. Major) + ". " + CStr(App. Minor) + ". " + CStr(App. Revision)
1353End Sub
1354
1355Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
1356 Call MDown(x, y)
1357End Sub
1358
1359Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
1360 Call MMove(hwnd, x, y)
1361End Sub
1362
1363Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
1364 Call MUp
1365End Sub
1366
1367Private Sub Image2_Click()
1368 Call ShellExecute(0, "", "mailto: xerx@nightmail. ru", "", "", 1)
1369End Sub
1370
1371Private Sub NoViewLabel_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
1372 Call MDown(x, y)
1373End Sub
1374
1375Private Sub NoViewLabel_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
1376 Call MMove(hwnd, x, y)
1377End Sub
1378
1379Private Sub NoViewLabel_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
1380 Call MUp
1381End Sub
1382
1383Private Sub OkBut_Click()
1384 Unload Me
1385End Sub
Форма: DiagResForm. frm
1386Dim dW%, dH%, dX%, dH2%
1387Dim DiagData() As TDiagElem
1388Dim DrawingMode As Byte, Use3D As Boolean
1389
1390' константы для вывода куска более 270 градусов (выводимая часть)
1391Const mode270begin As Byte = 1
1392Const mode270end As Byte = 2
1393
1394' данные для процедур рисования
1395 Const Pi_180 As Double = 1.74532925199433E-02
1396 Const Pi_2 As Double = 1.5707963267949
1397 Const NearZero As Double = 1E-45
1398
1399 Dim Xc%, Yc% ' центр диаграммы
1400 Dim Radius# ' радиус кусков
1401 Dim InRad# ' радиус разноса кусков
1402 Dim OneGradus# ' единиц в одном градусе
1403 Dim ChartHeight% ' высота графика
1404 Dim ChartWidth% ' ширина графика
1405 Dim ChartTop% ' верх графика
1406 Dim ChartDown% ' низ графика
1407 Dim ItemCount% ' кол-во элементов
1408 Dim Max%, Sum% ' максимальное значение и сумма всех значений
1409 Dim OldGrad# ' предыдущий угол
1410 Dim LineCount As Long ' количество полос заливки
1411 Dim d3D% ' смещение в 3D, в пикселях
1412 Dim dWidth As Single ' ширина одного столбца
1413 Dim dHeight As Single ' высота 'единицы высоты'
1414 Dim StartFillColor As Long
1415 Dim EndFillColor As Long
1416 Dim LineColor As Long
1417 Dim LineWidth As Byte
1418 Dim PointRadius%
1419 Dim Ellipce#
1420 Dim UseColorFill As Boolean
1421 Dim UseCircleLegend As Boolean
1422 Dim UseLineLeftValues As Boolean
1423
1424Public Sub InitDiagData(Data(), ByVal Mode As Byte, ByVal May3D As Boolean)
1425 ReDim DiagData(UBound(Data) \ 2 - 1)
1426 d# = 255 / (UBound(Data) \ 2 - 1)
1427 For i% = 0 To (UBound(Data) \ 2 - 1)
1428 DiagData(i). Val = Abs(Data(2 * i))
1429 DiagData(i). Text = Data(2 * i + 1)
1430 DiagData(i). Color = RGB(i * d, i * d, i * d)
1431 Next i
1432 DrawingMode = Mode
1433 Use3D = May3D
1434
1435 Label2. Visible = (DrawingMode <> 3)
1436 Label3. Visible = Label2. Visible
1437 VScroll. Enabled = Not Label2. Visible
1438End Sub
1439
1440Public Sub ColorFill(PB As PictureBox, ByVal StColor As Long, ByVal EnColor As Long)
1441 Dim dR#, dG#, DB#, dC1 As Long, dC2 As Long
1442 Dim R#, G#, B#
1443 Dim intLoop As Long