Заранее извиняюсь если тема обсуждалась.
У меня задача разукрасить кружок определённым градиентом с помощью макроса.
Я вижу как минимум 2 варианта решения задачи, но не знаю нужных функций.
1) Данный путь указанный ниже в макросе не стабильный, и градиент прыгает
2) 2 вариант копировать готовый кружок и задавать ему параметры координат и радиуса. Но сложность что мне надо ещё синий кружок, точнее только часть его нужно нарисовать. Но как я могу его трансформировать не знаю.
Кто может подскажите пожалуйста!!) Был бы рад узнать на оба варианта решение)
Set sCircleLiquid = ActiveLayer.CreateEllipse2(xwell, ywell, rwell, AntirWell)
sCircleLiquid.Fill.ApplyNoFill
sCircleLiquid.Outline.SetPropertiesEx 0.007874, OutlineStyles(0), CreateCMYKColor(0, 0, 0, 100), ArrowHeads(0), ArrowHeads(0), cdrFalse, cdrFalse, cdrOutlineButtLineCaps, cdrOutlineMiterLineJoin, 0#, 100, MiterLimit:=5#, Justification:=cdrOutlineJustificationMiddle
sCircleLiquid.Fill.UniformColor.CMYKAssign 3, 54, 94, 10 ' krasit odnotonno
Call PaintToQL(xWell, yWell, rWell, sCircleLiquid) 'paint circles QL
____________________________________________________
Function PaintToQL(ByVal xx1 As Single, ByVal yy1 As Single, ByVal xx2 As Single, ByVal nameShape2 As Shape)
With nameShape2.Fill.ApplyFountainFill(CreateCMYKColor(3, 54, 94, 10), CreateCMYKColor(0, 0, 0, 0), cdrLinearFountainFill, 42.959293, 0, 13, 50, cdrDirectFountainFillBlend)
.StartX = xx1 - xx2
.StartY = yy1 + xx2
.EndX = xx1 + xx2
.EndY = yy1 - xx2
End With
End Function
У меня задача разукрасить кружок определённым градиентом с помощью макроса.
Я вижу как минимум 2 варианта решения задачи, но не знаю нужных функций.
1) Данный путь указанный ниже в макросе не стабильный, и градиент прыгает
2) 2 вариант копировать готовый кружок и задавать ему параметры координат и радиуса. Но сложность что мне надо ещё синий кружок, точнее только часть его нужно нарисовать. Но как я могу его трансформировать не знаю.
Кто может подскажите пожалуйста!!) Был бы рад узнать на оба варианта решение)
Set sCircleLiquid = ActiveLayer.CreateEllipse2(xwell, ywell, rwell, AntirWell)
sCircleLiquid.Fill.ApplyNoFill
sCircleLiquid.Outline.SetPropertiesEx 0.007874, OutlineStyles(0), CreateCMYKColor(0, 0, 0, 100), ArrowHeads(0), ArrowHeads(0), cdrFalse, cdrFalse, cdrOutlineButtLineCaps, cdrOutlineMiterLineJoin, 0#, 100, MiterLimit:=5#, Justification:=cdrOutlineJustificationMiddle
sCircleLiquid.Fill.UniformColor.CMYKAssign 3, 54, 94, 10 ' krasit odnotonno
Call PaintToQL(xWell, yWell, rWell, sCircleLiquid) 'paint circles QL
____________________________________________________
Function PaintToQL(ByVal xx1 As Single, ByVal yy1 As Single, ByVal xx2 As Single, ByVal nameShape2 As Shape)
With nameShape2.Fill.ApplyFountainFill(CreateCMYKColor(3, 54, 94, 10), CreateCMYKColor(0, 0, 0, 0), cdrLinearFountainFill, 42.959293, 0, 13, 50, cdrDirectFountainFillBlend)
.StartX = xx1 - xx2
.StartY = yy1 + xx2
.EndX = xx1 + xx2
.EndY = yy1 - xx2
End With
End Function