Создание базы данных

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

1444

1445 PB. Line (0, 0) - (PB. Width, PB. Height), EnColor, BF

1446

1447 ' get Red

1448 dC1 = StColor - (StColor \ &H100) * &H100

1449 R = dC1

1450 dC2 = EnColor - (EnColor \ &H100) * &H100

1451 dR = (dC1 - dC2) / LineCount

1452

1453 ' get Green

1454 dC1 = (StColor - (StColor \ &H10000) * &H10000 - dC1) \ &H100

1455 G = dC1

1456 dC2 = (EnColor - (EnColor \ &H10000) * &H10000 - dC2) \ &H100

1457 dG = (dC1 - dC2) / LineCount

1458

1459 ' get Blue

1460 dC1 = StColor \ &H10000

1461 B = dC1

1462 dC2 = EnColor \ &H10000

1463 DB = (dC1 - dC2) / LineCount

1464

1465 With PB

1466. DrawStyle = 1

1467. DrawMode = vbCopyPen

1468. ScaleMode = vbPixels

1469. DrawWidth = 2

1470. ScaleHeight = LineCount

1471 For intLoop = 0 To LineCount - 1

1472 PB. Line (0, intLoop) - (PB. Width, intLoop - 1), RGB(R, G, B), BF

1473 R = R - dR: If (R < 0) Then R = 255: If (R > 255) Then R = 0

1474 G = G - dG: If (G < 0) Then G = 255: If (G > 255) Then G = 0

1475 B = B - DB: If (B < 0) Then B = 255: If (B > 255) Then B = 0

1476 Next intLoop

1477. ScaleMode = vbTwips

1478. DrawWidth = 1

1479 End With

1480End Sub

1481

1482Sub OutOneElem(ElemIndex As Integer, StAn#, EnAn#, Optional Mode270Mode As Byte = 0)

1483 ' центральный угол

1484 angle# = (StAn + (EnAn - StAn) / 2) * Pi_180

1485

1486 ' динамическая глубина

1487 d3D_% = Round(d3D / 100 * (100 - Round(100 * Ellipce)))

1488 If (d3D_ = 0) Then d3D_ = 1

1489 ' динамическое смещение центров кусков

1490 r_# = Ellipce * d3D / 100

1491

1492 X1# = Xc + Radius * Cos(angle)

1493 Y1# = Yc - Radius * Sin(angle)

1494

1495 x# = Xc + InRad / Radius * (X1 - Xc)

1496 y# = Yc + InRad / Radius * (Y1 - Yc) * r_

1497

1498 If (Not Use3D) Then

1499 Chart. FillStyle = 0

1500 Chart. FillColor = DiagData(ElemIndex). Color

1501 If (StAn <> 0) Then

1502 Chart. Circle (x, y), Radius, LineColor, - StAn * Pi_180, - EnAn * Pi_180, Ellipce

1503 Else

1504 Chart. Circle (x, y), Radius, LineColor, - 1E-45, - EnAn * Pi_180, Ellipce

1505 End If

1506 Chart. FillStyle = 1

1507

1508 ' вывод значений

1509 R# = 1.3. * Radius

1510 X2# = x + R * Cos(angle)

1511 Y2# = y - Ellipce * R * Sin(angle)

1512

1513 x0# = x + Radius * Cos(angle)

1514 y0# = y - Ellipce * Radius * Sin(angle)

1515

1516 str_1$ = CStr(DiagData(ElemIndex). Text)

1517 d1# = Chart. TextWidth(str_1)

1518 str_2$ = CStr(DiagData(ElemIndex). Val)

1519 d2# = Chart. TextWidth(str_2)

1520

1521 If UseCircleLegend Then

1522 Chart. DrawStyle = 4

1523 Chart. Line (x0, y0) - (X2, Y2), LineColor

1524 Chart. DrawStyle = 0

1525

1526 If Not ((angle > Pi_2) And (angle <= 3 * Pi_2)) Then

1527 Chart. Line (X2, Y2) - (X2 + d1, Y2), LineColor

1528 Chart. CurrentX = X2

1529 Chart. CurrentY = Y2

1530 Chart. Print CStr(str_1)

1531

1532 Chart. CurrentX = X2

1533 Chart. CurrentY = Y2 - Chart. TextHeight(str_2)

1534 Chart. Print CStr(str_2)

1535 Else

1536 Chart. Line (X2, Y2) - (X2 - d1, Y2), LineColor

1537 Chart. CurrentX = X2 - d1

1538 Chart. CurrentY = Y2

1539 Chart. Print CStr(str_1)

1540

1541 Chart. CurrentX = X2 - d1

1542 Chart. CurrentY = Y2 - Chart. TextHeight(str_2)

1543 Chart. Print CStr(str_2)

1544 End If

1545 End If

1546

1547 Else

1548 Chart. FillStyle = 0

1549 Chart. FillColor = DiagData(ElemIndex). Color

1550

1551 Select Case Mode270Mode

1552 Case 0

1553 sa# = StAn

1554 If (sa = 0) Then sa = 1E-45 Else sa = sa * Pi_180

1555 For i% = d3D_ To 1 Step - 1

1556 If (i = d3D_) Then

1557 Chart. DrawStyle = vbSolid

1558 Chart. Circle (x, Screen. TwipsPerPixelY * (i - 1) + y), Radius, LineColor, - sa, - EnAn * Pi_180, Ellipce

1559 Chart. DrawStyle = vbInvisible

1560 ElseIf (i = 1) Then

1561 Chart. DrawStyle = vbSolid

1562 Chart. Circle (x, y), Radius, LineColor, - sa, - EnAn * Pi_180, Ellipce

1563 Chart. DrawStyle = vbInvisible

1564 Else

1565 Chart. Circle (x, Screen. TwipsPerPixelY * (i - 1) + y), Radius, LineColor, - sa, - EnAn * Pi_180, Ellipce

1566 End If

1567 Next i

1568

1569 Case mode270begin

1570 For i% = d3D_ To 1 Step - 1

1571 If (i = d3D_) Then

1572 Chart. DrawStyle = vbSolid

1573 Chart. Circle (x, Screen. TwipsPerPixelY * (i - 1) + y), Radius, LineColor, - StAn * Pi_180, - EnAn * Pi_180, Ellipce

1574 Chart. DrawStyle = vbInvisible

1575 Else

1576 Chart. Circle (x, Screen. TwipsPerPixelY * (i - 1) + y), Radius, LineColor, - StAn * Pi_180, - angle, Ellipce

1577 End If

1578 Next i

1579

1580 Case mode270end

1581 For i% = d3D_ To 1 Step - 1

1582 If (i = 1) Then

1583 Chart. DrawStyle = vbSolid

1584 Chart. Circle (x, y), Radius, LineColor, - StAn * Pi_180, - EnAn * Pi_180, Ellipce

1585 Else

1586 Chart. DrawStyle = vbInvisible

1587 Chart. Circle (x, Screen. TwipsPerPixelY * (i - 1) + y), Radius, LineColor, - angle, - EnAn * Pi_180, Ellipce

1588 End If

1589 Next i

1590 End Select

1591

1592 Chart. FillStyle = 1

1593 Chart. DrawStyle = vbSolid

1594

1595 ' вывод значений

1596 R# = 1.3. * Radius

1597 X2# = x + R * Cos(angle)

1598 Y2# = y - Ellipce * R * Sin(angle)

1599

1600 x0# = x + Radius * Cos(angle)

1601 y0# = y - Ellipce * Radius * Sin(angle)

1602

1603 str_1$ = CStr(DiagData(ElemIndex). Text)

1604 d1# = Chart. TextWidth(str_1)

1605 str_2$ = CStr(DiagData(ElemIndex). Val)

1606 d2# = Chart. TextWidth(str_2)

1607

1608 If UseCircleLegend Then

1609 Chart. DrawStyle = 4

1610 Chart. Line (x0, y0) - (X2, Y2), LineColor

1611 Chart. DrawStyle = 0

1612

1613 If Not ((angle > Pi_2) And (angle <= 3 * Pi_2)) Then

1614 Chart. Line (X2, Y2) - (X2 + d1, Y2), LineColor

1615 Chart. CurrentX = X2

1616 Chart. CurrentY = Y2

1617 Chart. Print CStr(str_1)

1618

1619 Chart. CurrentX = X2

1620 Chart. CurrentY = Y2 - Chart. TextHeight(str_2)

1621 Chart. Print CStr(str_2)

1622 Else

1623 Chart. Line (X2, Y2) - (X2 - d1, Y2), LineColor

1624 Chart. CurrentX = X2 - d1

1625 Chart. CurrentY = Y2

1626 Chart. Print CStr(str_1)

1627

1628 Chart. CurrentX = X2 - d1

1629 Chart. CurrentY = Y2 - Chart. TextHeight(str_2)

1630 Chart. Print CStr(str_2)

1631 End If

1632 End If

1633

1634 ' а теперь вывод боковых линий

1635 Chart. DrawStyle = 0

1636

1637 ' начальный угол

1638 If Not ((StAn > 90) And (StAn < 180)) Then

1639 sa# = StAn * Pi_180

1640 x0 = x + Radius * Cos(sa)

1641 y0 = y - Radius * Ellipce * Sin(sa)

1642

1643 If (Mode270Mode <> mode270end) Then

1644 Chart. Line (x0, y0) - (x0, y0 + d3D_ * Screen. TwipsPerPixelY), LineColor

1645 End If

1646 End If

1647

1648 ' конечный угол

1649 If Not ((EnAn > 0) And (EnAn < 90)) Then

1650 x0 = x + Radius * Cos(EnAn * Pi_180)

1651 y0 = y - Radius * Ellipce * Sin(EnAn * Pi_180)

1652

1653 Chart. Line (x0, y0) - (x0, y0 + d3D_ * Screen. TwipsPerPixelY), LineColor

1654 End If

1655

1656 ' центр

1657 If Not ((EnAn >= 270) And (StAn <= 270)) Then

1658 Chart. Line (x, y) - (x, y + d3D_ * Screen. TwipsPerPixelY), LineColor

1659 End If

1660

1661 ' левый край

1662 If ((StAn <= 180) And (EnAn >= 180)) Then

1663 Chart. Line (x - Radius, y) - (x - Radius, y + d3D_ * Screen. TwipsPerPixelY), LineColor

1664 End If

1665

1666 End If

1667

1668 OldGrad = Grad

1669End Sub

1670

1671

1672' рисование круговой диаграммы

1673Sub DrawCircle()

1674 Dim Mode270 As Boolean

1675 Dim Item270%

1676

1677 ItemCount = UBound(DiagData) + 1

1678

1679 With Chart

1680 Max = - 1

1681 Sum = 0

1682 For i% = 1 To ItemCount

1683 If (DiagData(i - 1). Val > Max) Then Max = DiagData(i - 1). Val

1684 Sum = Sum + DiagData(i - 1). Val

1685 Next i

1686

1687 Mode270 = (Max > 3 / 4 * Sum)

1688

1689 OneGradus = 360 / Sum

1690 OldGrad = 0.00001

1691

1692 Xc = Chart. Width \ 2

1693 Yc = Chart. Height \ 2

1694

1695 Dim pos90%, pos270% ' индексы ключевых элементов

1696 pos90 = - 1

1697 pos270 = - 1

1698 OldGrad = 0

1699

1700 Dim Angles() As Double

1701 ReDim Angles(ItemCount - 1, 1)

1702

1703 For i% = 1 To ItemCount

1704 If Mode270 Then If (DiagData(i - 1). Val = Max) Then Item270 = i - 1

1705 Grad# = DiagData(i - 1). Val * OneGradus + OldGrad

1706 If (OldGrad <= 90) And (Grad >= 90) Then pos90 = i - 1

1707 If (OldGrad <= 270) And (Grad >= 270) Then pos270 = i - 1

1708 Angles(i - 1, 0) = OldGrad

1709 Angles(i - 1, 1) = Grad

1710 OldGrad = Grad

1711 Next i

1712

1713 Chart. DrawStyle = 0

1714

1715 If Not Mode270 Then

1716

1717 For i% = pos90 To 0 Step - 1

1718 Call OutOneElem(i, Angles(i, 0), Angles(i, 1))

1719 Next i

1720

1721 For i% = pos90 + 1 To pos270 - 1

1722 Call OutOneElem(i, Angles(i, 0), Angles(i, 1))

1723 Next i

1724

1725 For i% = ItemCount - 1 To pos270 Step - 1

1726 Call OutOneElem(i, Angles(i, 0), Angles(i, 1))

1727 Next i

1728 Else

1729

1730 i% = pos90 - 1

1731 If (i < 0) Then i = ItemCount - 1

1732

1733 Call OutOneElem(Item270, Angles(Item270, 0), Angles(Item270, 1), mode270begin)

1734

1735 Do While (i <> Item270)

1736 Call OutOneElem(i, Angles(i, 0), Angles(i, 1))

1737

1738 i = i - 1

1739 If (i < 0) Then i = ItemCount - 1

1740 Loop

1741

1742 Call OutOneElem(Item270, Angles(Item270, 0), Angles(Item270, 1), mode270end)

1743

1744 End If

1745 End With

1746End Sub

1747

1748' рисование линейной, точечной и столбчатой диаграмм

1749Sub DrawPoint()

1750 Dim d3DX%

1751 Dim d3DY%

1752 Dim OldX%, OldY% ' координаты предыдущей точки

1753

1754 ItemCount = UBound(DiagData) + 1

1755 ChartHeight = Chart. Height * 0.8

1756 ChartTop = Chart. Height * 0.1

1757 ChartDown = Chart. Height * 0.9

1758

1759 With Chart

1760 dWidth = Chart. Width / (2 * ItemCount + 1)

1761

1762 Max = - 1

1763 Sum = 0

1764 For i% = 1 To ItemCount

1765 If (DiagData(i - 1). Val > Max) Then Max = DiagData(i - 1). Val

1766 Sum = Sum + DiagData(i - 1). Val

1767 Next i

1768

1769 dHeight = ChartHeight / Max

1770

1771 d3DX = Screen. TwipsPerPixelX

1772 d3DY = Screen. TwipsPerPixelY

1773

1774 With Chart

1775. DrawWidth = 1

1776. DrawStyle = 3

1777 Chart. Line (dWidth * 0.9, ChartTop \ 2) - (dWidth * 0.9, ChartDown), LineColor

1778 Chart. Line (dWidth * 0.9, ChartDown) - ((2 * ItemCount + 0.5) * dWidth, ChartDown), LineColor

1779. DrawStyle = 0

1780

1781. FontSize =. FontSize + 3

1782. FontUnderline = True

1783

1784. CurrentX = 2 * d3DX

1785. CurrentY = 2 * d3DY

1786 Chart. Print "Значения"

1787

1788 str_$ = "Подписи"

1789. CurrentX =. Width - . TextWidth(str_) - 10 * d3DX

1790. CurrentY = ChartDown +. TextHeight(str_)

1791 Chart. Print str_

1792

1793. FontSize =. FontSize - 3

1794. FontUnderline = False

1795 End With

1796

1797

1798 For i% = 1 To ItemCount

1799 j% = 2 * i - 1

1800 Dim y#, x#

1801 y = ChartTop + dHeight * (Max - DiagData(i - 1). Val)

1802

1803 Select Case DrawingMode

1804 Case 0 ' // // // // // // // // // // // // // // // // / ЛИНИИ // // // // // // // // // // // // // // // // // // // // /

1805 x# = (j + 0.5) * dWidth

1806

1807 If (i > 1) Then

1808 Chart. DrawWidth = LineWidth

1809 Chart. Line (OldX, OldY) - (x, y), DiagData(i - 1). Color

1810 Chart. DrawWidth = 1

1811 End If

1812 Chart. DrawStyle = 1

1813 Chart. Line (x, y) - (x, ChartDown), DiagData(i - 1). Color

1814 Chart. DrawStyle = 0

1815 OldX = x

1816 OldY = y

1817

1818 str_$ = CStr(DiagData(i - 1). Text)

1819 Chart. CurrentX = j * dWidth + (dWidth - Chart. TextWidth(str_)) \ 2

1820 Chart. CurrentY = ChartDown + Chart. TextHeight(str_) \ 10

1821 Chart. Print str_

1822

1823 str_ = CStr(Round(DiagData(i - 1). Val / Sum * 100)) + "%"

1824 Chart. CurrentX = j * dWidth + (dWidth - Chart. TextWidth(str_)) \ 2

1825 Chart. CurrentY = y - Chart. TextHeight(str_) * 1.2

1826 Chart. Print str_

1827

1828 ' значение слева с засечкой и линией

1829 str_ = CStr(DiagData(i - 1). Val)

1830 If UseLineLeftValues Then

1831 Chart. CurrentX = dWidth * 0.8 - Chart. TextWidth(str_)

1832 Chart. DrawStyle = 2

1833 Chart. Line (dWidth * 0.9, y) - (x, y), LineColor

1834 Chart. DrawStyle = 0

1835 End If

1836

1837 Chart. DrawWidth = 2

1838 Chart. Line (dWidth * 0.85, y) - (dWidth * 0.95, y), LineColor

1839 Chart. DrawWidth = 1

1840 x# = dWidth * 0.8 - Chart. TextWidth(str_)

1841 Chart. CurrentX = x

1842 Chart. CurrentY = y - Chart. TextHeight(str_) \ 2

1843 Chart. Print str_

1844

1845 Case 1 ' // // // // // // // // // // // // // // // // / КОЛОНКИ // // // // // // // // // // // // // // // // // // // /

1846 If (Not Use3D) Then

1847 Chart. Line (j * dWidth, y) - ((j + 1) * dWidth, ChartDown), DiagData(i - 1). Color, BF

1848 Chart. Line (j * dWidth, y) - ((j + 1) * dWidth, ChartDown), LineColor, B

1849

1850 str_ = CStr(DiagData(i - 1). Text)

1851 Chart. CurrentX = j * dWidth + (dWidth - Chart. TextWidth(str_)) \ 2

1852 Chart. CurrentY = ChartDown + Chart. TextHeight(str_) \ 10

1853 Chart. Print str_

1854

1855 str_ = CStr(Round(DiagData(i - 1). Val / Sum * 100)) + "%"

1856 Chart. CurrentX = j * dWidth + (dWidth - Chart. TextWidth(str_)) \ 2

1857 Chart. CurrentY = y - Chart. TextHeight(str_) * 1.2

1858 Chart. Print str_

1859

1860 ' значение слева с засечкой и линией

1861 str_ = CStr(DiagData(i - 1). Val)

1862 If UseLineLeftValues Then

1863 Chart. CurrentX = dWidth * 0.8 - Chart. TextWidth(str_)

1864 Chart. DrawStyle = 2

1865 Chart. Line (dWidth * 0.9, y) - (j * dWidth, y), LineColor

1866 Chart. DrawStyle = 0

1867 End If

1868

1869 x# = dWidth * 0.8 - Chart. TextWidth(str_)

1870 Chart. CurrentX = x

1871 Chart. CurrentY = y - Chart. TextHeight(str_) \ 2

1872 Chart. Print str_

1873 Chart. CurrentX = x

1874 Chart. CurrentY = y

1875 Chart. DrawWidth = 2

1876 Chart. Line (dWidth * 0.85, y) - (dWidth * 0.95, y), LineColor

1877 Chart. DrawWidth = 1

1878 Else

1879 For k% = 0 To d3D - 1

1880 Chart. Line (j * dWidth + k * d3DX, y - k * d3DY) - ((j + 1) * dWidth + k * d3DX, ChartDown - k * d3DY), DiagData(i - 1). Color, B

1881 Next k

1882 Chart. Line (j * dWidth, y) - ((j + 1) * dWidth, ChartDown), DiagData(i - 1). Color, BF

1883 ' верхняя левая в глубине

1884 ltdx% = j * dWidth + (d3D - 1) * d3DX

1885 ltdy% = y - (d3D - 1) * d3DY

1886 ' верхняя правая в глубине

1887 rtdx% = (j + 1) * dWidth + (d3D - 1) * d3DX

1888 rtdy% = y - (d3D - 1) * d3DY

1889 ' нижняя правая в глубине

1890 rddx% = (j + 1) * dWidth + (d3D - 1) * d3DX

1891 rddy% = ChartDown - (d3D - 1) * d3DY

1892 ' верхняя в глубине

1893 Chart. Line (rtdx, rtdy) - (rddx, rddy), LineColor

1894 ' правая в глубине

1895 Chart. Line (ltdx, ltdy) - (rtdx, rtdy), LineColor

1896

1897 ' левая переходная

1898 Chart. Line (ltdx, ltdy) - (ltdx - d3D * d3DX, ltdy + d3D * d3DY), LineColor

1899 ' правая верхняя переходная

1900 Chart. Line (rtdx, rtdy) - (rtdx - d3D * d3DX, rtdy + d3D * d3DY), LineColor

1901 ' правая нижняя переходная

1902 Chart. Line (rddx, rddy) - (rddx - d3D * d3DX, rddy + d3D * d3DY), LineColor

1903 Chart. Line (j * dWidth, y) - ((j + 1) * dWidth, ChartDown), LineColor, B

1904

1905 ' надпись внизу

1906 str_ = CStr(DiagData(i - 1). Text)

1907 Chart. CurrentX = j * dWidth + (dWidth - Chart. TextWidth(str_)) \ 2

1908 Chart. CurrentY = ChartDown + Chart. TextHeight(str_) \ 10

1909 Chart. Print str_

1910 ' процент вверху

1911 str_ = CStr(Round(DiagData(i - 1). Val / Sum * 100)) + "%"

1912 Chart. CurrentX = d3D * d3DX + j * dWidth + (dWidth - Chart. TextWidth(str_)) \ 2

1913 Chart. CurrentY = y - d3D * d3DY - Chart. TextHeight(str_) * 1.2

1914 Chart. Print str_

1915 ' значение слева с засечкой и линией

1916 str_ = CStr(DiagData(i - 1). Val)

1917 If UseLineLeftValues Then

1918 Chart. CurrentX = dWidth * 0.8 - Chart. TextWidth(str_)

1919 Chart. DrawStyle = 2

1920 Chart. Line (dWidth * 0.9, y) - (j * dWidth, y), LineColor

1921 Chart. DrawStyle = 0

1922 End If

1923

1924 x# = dWidth * 0.8 - Chart. TextWidth(str_)

1925 Chart. CurrentX = x

1926 Chart. CurrentY = y - Chart. TextHeight(str_) \ 2

1927 Chart. Print str_

1928 Chart. CurrentX = x

1929 Chart. CurrentY = y

1930 Chart. DrawWidth = 2

1931 Chart. Line (dWidth * 0.85, y) - (dWidth * 0.95, y), LineColor

1932 Chart. DrawWidth = 1

1933 End If

1934

1935 Case 2 ' // // // // // // // // // // // // // // // // / ТОЧКИ // // // // // // // // // // // // // // // // // // // // /

1936 Chart. FillStyle = 0

1937 Chart. FillColor = DiagData(i - 1). Color

1938 x# = (j + 0.5) * dWidth

1939 Chart. Circle (x, y), PointRadius * d3DX, LineColor

1940 Chart. FillStyle = 1

1941 Chart. DrawStyle = 1

1942 Chart. Line (x, y) - (x, ChartDown), DiagData(i - 1). Color

1943 Chart. DrawStyle = 0

1944

1945 str_ = CStr(DiagData(i - 1). Text)

1946 Chart. CurrentX = j * dWidth + (dWidth - Chart. TextWidth(str_)) \ 2

1947 Chart. CurrentY = ChartDown + Chart. TextHeight(str_) \ 10

1948 Chart. Print str_

1949

1950 str_ = CStr(Round(DiagData(i - 1). Val / Sum * 100)) + "%"

1951 Chart. CurrentX = j * dWidth + (dWidth - Chart. TextWidth(str_)) \ 2

1952 Chart. CurrentY = y - PointRadius * d3D - Chart. TextHeight(str_) * 1.2

1953 Chart. Print str_

1954

1955 ' значение слева с засечкой и линией

1956 str_ = CStr(DiagData(i - 1). Val)

1957 Chart. CurrentX = dWidth * 0.8 - Chart. TextWidth(str_)

1958 Chart. DrawStyle = 2

1959 Chart. Line (dWidth * 0.9, y) - (x, y), LineColor

1960 Chart. DrawStyle = 0

1961

1962 Chart. DrawWidth = 2

1963 Chart. Line (dWidth * 0.85, y) - (dWidth * 0.95, y), LineColor

1964 Chart. DrawWidth = 1

1965 x# = dWidth * 0.8 - Chart. TextWidth(str_)

1966 Chart. CurrentX = x

1967 Chart. CurrentY = y - Chart. TextHeight(str_) \ 2

1968 Chart. Print str_

1969 End Select

1970 Next i

1971

1972 End With

1973End Sub

1974

1975Sub DrawDiagram()

1976 If (Chart. Height > Screen. TwipsPerPixelX * 5) And (UseColorFill) Then

1977 Call ColorFill(Chart, StartFillColor, EndFillColor)

1978 Else

1979 Chart. Line (0, 0) - (Chart. Width, Chart. Height), StartFillColor, BF

1980 End If

1981

1982 Select Case DrawingMode

1983 Case 3: Call DrawCircle

1984 Case Else: Call DrawPoint

1985 End Select

1986End Sub

1987

1988Private Sub Chart_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

1989 If (DrawingMode <> 3) Then

1990 y = Round((ChartDown - y) * Max / (ChartDown - ChartTop))

1991 Label3. Caption = CStr(y)

1992 End If

1993End Sub

1994

1995Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

1996 If (KeyCode = vbKeyF5) Then Call DrawDiagram

1997End Sub

1998

1999Private Sub Form_Load()

2000 dW = Width - Chart. Width

2001 dH = Height - Chart. Height

2002 dX = Width - VScroll. Left

2003 dH2 = Height - VScroll. Height

2004 DrawingMode = 0

2005 Use3D = False

2006 LineCount = 100

2007 d3D = 15

2008 StartFillColor = RGB(255, 255, 128)

2009 EndFillColor = RGB(0, 128, 255)

2010 LineColor = 0

2011 LineWidth = 1

2012 Ellipce = 2 / 5

2013 PointRadius = 15

2014

2015 UseColorFill = True

2016 UseCircleLegend = True

2017 UseLineLeftValues = True

2018

2019 ChartHeight = Chart. Height * 0.85

2020 ChartWidth = Chart. Width * 0.85

2021 ChartTop = Chart. Height * 0.075

2022 ChartDown = Chart. Height * 0.925

2023 If (ChartWidth < ChartHeight) Then Radius = ChartWidth Else Radius = ChartHeight

2024 Radius = Radius * 0.5

2025 InRad = 0.1 * Radius

2026End Sub

2027

2028Private Sub Form_Resize()

2029 Min% = Width - dW + 5 * Screen. TwipsPerPixelX

2030 If (Min < 0) Then Min = 0

2031 Chart. Width = Min

2032

2033 Min% = Height - dH + Screen. TwipsPerPixelY

2034 If (Min < 0) Then Min = 0

2035 Chart. Height = Min

2036

2037 VScroll. Left = Width - dX

2038

2039 Min% = Height - dH2 + Screen. TwipsPerPixelY

2040 If (Min < 0) Then Min = 0

2041 VScroll. Height = Min

2042

2043 Call DrawDiagram

2044End Sub

2045

2046Private Sub Image1_Click()

2047 CD. FileName = ""

2048 CD. ShowSave

2049 If (CD. FileName <> "") Then

2050 Call SavePicture(Chart. Image, CD. FileName)

2051 End If

2052End Sub

2053

2054Private Sub Image2_Click()

2055 With DiagOptForm

2056 ' цвета

2057. Frame2(0). BackColor = StartFillColor

2058. Frame2(1). BackColor = EndFillColor

2059. Frame2(2). BackColor = Chart. ForeColor

2060. Frame2(3). BackColor = LineColor

2061 ' размеры

2062. UpDown1. value = LineWidth

2063. UpDown2. value = d3D

2064. UpDown3. value = PointRadius

2065. UpDown4. value = LineCount

2066. UpDown5. value = Round(Ellipce * 100)

2067

2068. UpDown6. Max = Chart. Width

2069 If (Chart. Height < Chart. Width) Then. UpDown6. Max = Chart. Width

2070. UpDown6. Max = Round(. UpDown6. Max / Screen. TwipsPerPixelX)

2071. UpDown6. value = Round(Radius / Screen. TwipsPerPixelX)

2072

2073. UpDown7. Max =. UpDown6. Max * 0.9

2074. UpDown7. value = Round(InRad / Screen. TwipsPerPixelX)

2075

2076 ' цвета и надписи

2077. List1. Clear

2078 For i% = 1 To ItemCount

2079. List1. AddItem (DiagData(i - 1). Text)

2080. List1. ItemData(i - 1) = DiagData(i - 1). Color

2081 Next i

2082 If (. List1. ListCount > 0) Then. List1. ListIndex = 0

2083

2084 ' флаги

2085. Check1. value = - CInt(UseColorFill)

2086. Check3. value = - CInt(UseCircleLegend)

2087. Check2. value = - CInt(UseLineLeftValues)

2088

2089. Show vbModal

2090 If (. res = 1) Then

2091 ' цвета

2092 StartFillColor =. Frame2(0). BackColor

2093 EndFillColor =. Frame2(1). BackColor

2094 Chart. ForeColor =. Frame2(2). BackColor

2095 LineColor =. Frame2(3). BackColor

2096 ' размеры

2097 LineWidth =. UpDown1. value

2098 d3D =. UpDown2. value

2099 PointRadius =. UpDown3. value

2100 LineCount =. UpDown4. value

2101 Ellipce =. UpDown5. value / 100

2102 Radius =. UpDown6. value * Screen. TwipsPerPixelX

2103 InRad =. UpDown7. value * Screen. TwipsPerPixelX

2104 ' цвета и надписи

2105 For i% = 1 To ItemCount

2106 DiagData(i - 1). Text =. List1. List(i - 1)

2107 DiagData(i - 1). Color =. List1. ItemData(i - 1)

2108 Next i

2109 ' флаги

2110 UseColorFill = (. Check1. value = 1)

2111 UseCircleLegend = (. Check3. value = 1)

2112 UseLineLeftValues = (. Check2. value = 1)

2113 Call DrawDiagram

2114 End If

2115 End With

2116End Sub

2117

2118Private Sub Image3_Click()

2119 Hide

2120End Sub

2121

2122Private Sub VScroll_Change()

2123 Ellipce = VScroll. value / 100

2124 Call DrawDiagram

2125End Sub

Форма: InputForm. frm

2126Dim res%

2127

2128Private Sub CancelBut_Click()

2129 Call SoundClick

2130 Hide

2131End Sub

2132

2133Private Sub Form_Activate()

2134 Text1. SetFocus

2135End Sub

2136

2137Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

2138 Select Case KeyCode

2139 Case 13: Call YesBut_Click

2140 Case 27: Call CancelBut_Click

2141 End Select

2142End Sub

2143

2144Private Sub Form_Load()

2145 Call ButEnabled(YesImg, YesBut, True)

2146 Call ButEnabled(CancelImg, CancelBut, True)

2147End Sub

2148

2149Public Function InputVal(str$) As String

2150 Label1. Caption = str

2151 Text1. Text = ""

2152 res = 0

2153 Me. Show vbModal

2154 If (res = 1) Then InputVal = Text1. Text

2155 Unload Me

2156End Function

2157

2158Private Sub YesBut_Click()

2159 Call SoundClick

2160 res = 1

2161 Hide

2162End Sub

Форма: DiagOpt. frm

2163Public res%

2164

2165Private Sub Form_Load()

2166 res = 0

2167 Call ButEnabled(SelectImg, SelectBut, True)

2168 Call ButEnabled(CancelImg, CancelBut, True)

2169End Sub

2170

2171Private Sub Form_Paint()

2172 Call DiagResForm. ColorFill(Picture1, Frame2(0). BackColor, Frame2(1). BackColor)

2173End Sub

2174

2175Private Sub Frame2_Click(Index As Integer)

2176 ColorDlg. Color = Frame2(Index). BackColor

2177 ColorDlg. ShowColor

2178 Frame2(Index). BackColor = ColorDlg. Color

2179 If (Index < 2) Then Call DiagResForm. ColorFill(Picture1, Frame2(0). BackColor, Frame2(1). BackColor)

2180 If (Index = 4) Then List1. ItemData(List1. ListIndex) = Frame2(4). BackColor

2181End Sub

2182

2183Private Sub Label10_Click()

2184 res = 1

2185 Hide

2186End Sub

2187

2188Private Sub Label15_Click()

2189 Hide

2190End Sub

2191

2192Private Sub List1_Click()

2193 If (List1. ListIndex > - 1) Then

2194 Text1. Text = List1. List(List1. ListIndex)

2195 Frame2(4). BackColor = List1. ItemData(List1. ListIndex)

2196 End If

2197End Sub

2198

2199Private Sub List1_KeyPress(KeyAscii As Integer)

2200 Call List1_Click

2201End Sub

2202

2203Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)

2204 If (KeyCode = 13) Then

2205 List1. List(List1. ListIndex) = Text1. Text

2206 List1. ItemData(List1. ListIndex) = Frame2(4). BackColor

2207 End If

2208End Sub

Форма: SplashScreenForm. frm

2209Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

2210 If (KeyCode = 27) Or (KeyCode = 13) Then

2211 MainForm. Show

2212 Unload Me

2213 End If

2214End Sub

2215

2216Private Sub Form_Load()

2217 Label2. Caption = "v. " + CStr(App. Major) + ". " + CStr(App. Minor)

2218End Sub

2219

2220Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

2221 Call MDown(x, y)

2222End Sub

2223

2224Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

2225 Call MMove(hwnd, x, y)

2226End Sub

2227

2228Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

2229 Call MUp

2230End Sub

Форма: MonthForm. frm

2231Public res%

2232

2233Private Sub CancelBut_Click()

2234 Hide

2235End Sub

2236

2237Private Sub EditBut_Click()

2238 res = - 1

2239 Hide

2240End Sub

2241

2242Private Sub Form_Load()

2243 Call ButEnabled(YesImg, YesBut, True)

2244 Call ButEnabled(EditImg, EditBut, True)

2245 Call ButEnabled(CancelImg, CancelBut, True)

2246 res = 0

2247End Sub

2248

2249Private Sub YesBut_Click()

2250 res = 1

2251 Hide

2252End Sub

Модуль: DBTypes. bas

2253'************************************

2254' модуль DBTypes. bas

2255' вся работа с файлом БД

2256'************************************

2257

2258'************************************** Описание типов **************************************

2259

2260' заголовок файла

2261Type TDBHeader

2262 ' "DBX" - проверка файла

2263 Header As String * 3

2264 ' флаги

2265 Flags As Byte

2266 ' количество полей

2267 ColCount As Long

2268 ' количество записей

2269 RowCount As Long

2270End Type

2271

2272' имеет ли пользователь права на редактирование

2273Public UserIsAdmin As Boolean

2274

2275' данные о столбце

2276Type TDBElemData

2277 ' тип данных

2278 Class As Byte

2279 ' длина заголовка

2280 TitleLen As Byte

2281 ' заголовок, длины TitleLen

2282 title As String

2283 ' значение по-умолчанию

2284 DefValue As Variant

2285End Type

2286

2287' запись

2288Type TDBElem

2289 ' поля записи

2290 Fields() As Variant

2291End Type

2292

2293' элемент в массиве DB

2294Type TDBCell

Страницы: 1, 2, 3, 4