home *** CD-ROM | disk | FTP | other *** search
- 'Объявление процедуры DrawSlice, тело которой будет определено ниже.
- 'x1 и y1 - координаты центра окружности, которой принадлежит Slice.
- 'r - радиус этой окружности.
- 'iSumPercent - количество процентов, на которое начало сектора отстоит от начальной оси.
- 'iNewPercent - количество процентов, которое изображает этот Slice. В сумме с iSumPercent
- ' определяет iSumPercent для следующего Slice, если эти Slice составляют
- ' сплошную последовательность в пределах одной диаграммы.
- 'iR - цвет Red компоненты цвета Slice в RGB-представлении.
- 'iG - цвет Green компоненты цвета Slice в RGB-представлении.
- 'iB - цвет Blue компоненты цвета Slice в RGB-представлении.
- Declare Sub DrawSlice(x1 As Double,y1 As Double,r As Double,iSumPercent As Integer,iNewPercent as Integer,iR as Integer,iG as Integer,iB as Integer)
-
- Sub DrawSlices()
- Dim active_page As Page 'Ссылка на активную страницу текущего документа.
- Dim new_rect As Shape 'Ссылка на объект-шэйп, представляющий новый построенный прямоугольник.
- Dim dR As Double 'Радиус дмаграммы.
- Dim dCenterX As Double 'Координата X центра диаграммы
- Dim dCenterY As Double 'Координата Y центра диаграммы
- Dim iR As Integer 'Цвет Red компоненты цвета Slice в RGB-представлении.
- Dim iG As Integer 'Цвет Green компоненты цвета Slice в RGB-представлении.
- Dim iB As Integer 'Цвет Blue компоненты цвета Slice в RGB-представлении.
- Dim iNewPercent As Integer 'Количество процентов, которое изображает этот Slice. В сумме с dSumPercent
- 'определяет dSumPercent для следующего Slice, если эти Slice составляют
- 'сплошную последовательность в пределах одной диаграммы.
- Dim iSumPercent As Integer 'Счетчик заполнености круга диаграммы. Количество процентов, на которое
- 'начало нового сектора отстоит от начальной оси.
- 'Для первого сектора равен 0, после построения последнего сектора диаграммы
- 'принимает значение 100.
-
-
- 'Получаем ссылку на активную страницу текущего документа. Используем глобальную переменную thisDoc
- 'для доступа к объекту Document.
- Set active_page = thisDoc.ActivePage
-
- 'Очистить активную страницу документа от всех находящихся на ней сейчас шэйпов.
- active_page.RemoveAllShapes()
-
- 'Инициализация генератора случайных чисел
- Randomize
- 'Построение серии круговых диаграмм уменьшающихся радиусов: от 500 юнитов
- 'до 200, каждый новый радиус меньше на 50 юнитов.
- For dR=500 To 200 Step -50
- 'Обнуление счетчика заполнености круга (в процентах).
- iSumPercent = 0
- 'Определение координат центра диаграммы
- dCenterX = Rnd()*(1900 - 2 * dR) + (100 + dR)
- dCenterY = Rnd()*(2770 - 2 * dR) + (100 + dR)
- Do
- 'Определение величины следующего сектора (в процентах).
- 'Случайное целое число в интервале от 5% до 75% с шагом 5%
- iNewPercent = CInt(Int( Rnd() * 15) + 1) * 5
- 'Если новое значение в сумме с предыдущими превышает 100%, производится
- 'усечение полученного числа.
- If iSumPercent + iNewPercent > 100 Then
- iNewPercent = 100 - iSumPercent
- End If
- 'Определение случайным образом RGB-составляющих цвета.
- 'Чтобы цвет был не слишком темным, значения составляющих не меньше 125.
- iR = Int( Rnd() * 131) + 125
- iG = Int( Rnd() * 131) + 125
- iB = Int( Rnd() * 131) + 125
- 'Вызов процедуры DrawSlice для построения нового Slice.
- DrawSlice(dCenterX, dCenterY, dR, iSumPercent, iNewPercent, iR, iG, iB)
- 'Актуализация значения счетчика заполнености круга
- iSumPercent = iSumPercent + iNewPercent
- 'Выход из цикла, если круг заполнен на все 100%
- Loop While iSumPercent < 100
- Next
-
- End Sub
-
- 'Тело процедуры DrawSlice
- Sub DrawSlice(x1 As Double,y1 As Double,r As Double,iSumPercent As Integer,iNewPercent as Integer,iR as Integer,iG as Integer,iB as Integer)
- 'Координаты точек, используемых при построении сектора.
- 'Координаты начальной точки дуги сектора.
- Dim x2 As Double
- Dim y2 As Double
- 'Координаты конечной точки дуги сектора.
- Dim x3 As Double
- Dim y3 As Double
- 'Координаты середины дуги сектора.
- Dim x4 As Double
- Dim y4 As Double
- 'Угол, на который начало сектора отстоит от начальной оси.
- Dim dCurrAngle as Double
- 'Центральный угол сектора.
- Dim dSliceAngle as Double
- 'Ссылка на объект-шэйп, представляющий новый Slice.
- Dim new_Slice As Shape
- 'Ссылка на активную страницу текущего документа.
- Dim active_Page As Page
-
- 'Вычисление глобальных координат точек, по которым строится Slice.
- 'Координаты вычисляются по радиусу окружности и углу поворота относительно
- 'начальной оси.
- dCurrAngle = (2 * 3.14159265 * iSumPercent )/100
- dSliceAngle = (2 * 3.14159265 * iNewPercent )/100
- x2 = r * cos(dCurrAngle) + x1
- y2 = r * sin(dCurrAngle) + y1
- x3 = r * cos(dCurrAngle + dSliceAngle) + x1
- y3 = r * sin(dCurrAngle + dSliceAngle) + y1
- x4 = r * cos(dCurrAngle + dSliceAngle/2) + x1
- y4 = r * sin(dCurrAngle + dSliceAngle/2) + y1
-
- 'Получаем ссылку на активную страницу текущего документа. Используем глобальную переменную thisDoc
- 'для доступа к объекту Document.
- Set active_Page = thisDoc.ActivePage()
- 'Создаем шэйп, изображающий Slice.
- 'Построение шэйпа происходит между двумя функциями, объявляющими о начале
- 'создания шэйпа (метод BeginShape объекта Page) и о завершении его создания
- '(метод EndShape объекта Page). Ссылка на строящийся шэйп присваивается
- 'переменной new_Slice.
- Set new_Slice = active_Page.BeginShape()
- 'Устанавливаем цвет объекта, используя RGB-представление цвета.
- new_Slice.FillColor.SetRGB(iR, iG, iB)
- 'Устанавливаем текст объекта. Используем неявное преобразование переменной
- 'iNewPercent типа Integer к типу String.
- new_Slice.Text = iNewPercent & "%"
- 'Задаем глобальные координаты начала Slice относительно страницы.
- active_Page.MoveTo(x1,y1)
- 'Из текущей точки, заданной вызовом MoveTo, строим отрезок в точку c
- 'координатами (x2,y2).
- active_Page.LineTo(x2,y2)
- 'Из текущей точки, заданной вызовом LineTo, строим дугу окружности в точку (x3,y3),
- 'проходящую через (x4,y4).
- active_Page.ArcTo(x3, y3, x4, y4)
- 'Завершаем построения сектора: проводим отрезок в центр диаграммы.
- active_Page.LineTo(x1, y1)
- 'Завершение построения Shape.
- active_Page.EndShape()
- End Sub