home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Chip 2004 April
/
CMCD0404.ISO
/
Software
/
Demo
/
conceptdraw
/
data1.cab
/
Samples__Basic
/
SimpleDrawing
/
DrawSlices
/
DrawSlices.cdb
next >
Wrap
Text File
|
2004-02-13
|
9KB
|
131 lines
'Объявление процедуры 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