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 ConstPi_2 AsDouble = 1.5707963267949
1397 ConstNearZeroAsDouble = 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' рисование круговой диаграммы
1673SubDrawCircle()
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' рисование линейной, точечной и столбчатой диаграмм
1749SubDrawPoint()
1750 Dimd3DX%
1751 Dimd3DY%
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