Графические объекты

[Irichka]

Ромб, находящийся внутри окружности, изменяет цвет и размеры. Центр фигуры постоянно находится в центре формы.
Вот набросок программы. Но у ромба получается менять только цвет линий. Подскажите пожалуйста, что нужно сделать, чтоб ромб полностью закрашивался???

Private Sub Form_Load()
With Picture1
.Width = SSTab1.Width - .Left * 2
.Height = SSTab1.Height - .Top - .Left
XCentr = .Width / 2
YCentr = .Height / 2
End With
Radius = 500
End Sub


Private Sub Process1()
Timer1.Enabled = True
Randomize (100#)
KoordX = XCentr - Radius
KoordX2 = XCentr + Radius
KoordY = YCentr - Radius
KoordY2 = YCentr + Radius
ColorKont = 10000000 * Rnd
ColorZalivki = 1000000 * Rnd

Picture1.Circle (XCentr, YCentr), Radius, &O0
'Рисую ромб: 
Picture1.Line (KoordX, YCentr)-(XCentr, KoordY), ColorKont
Picture1.Line (XCentr, KoordY)-(KoordX2, YCentr), ColorKont
Picture1.Line (KoordX2, YCentr)-(XCentr, KoordY2), ColorKont
Picture1.Line (XCentr, KoordY2)-(KoordX, YCentr), ColorKont

End Sub

 

[Tanya]

Можно при помощи Win API.

Пример:

Private Type POINTAPI
x As Long
y As Long
End Type

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As Any, ByVal nCount As Long) As Long
Private Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Private Radius As Long

Private Sub Form_Load()

Radius = 100

End Sub


Private Sub Process1()

Dim r As RECT
Dim XCentr As Long
Dim YCentr As Long
Dim KoordX, KoordX2, KoordY, KoordY2, ColorKont, ColorZalivki
Dim Romb(0 To 3) As POINTAPI
Dim i As Integer

Randomize (100#)
ColorKont = 10000000 * Rnd
ColorZalivki = 1000000 * Rnd

With Picture1
.Cls

'определяем клиентскую область Picture1
Call GetClientRect(.hwnd, r)

'находим центр Picture1
XCentr = 0.5 * (r.Right - r.Left)
YCentr = 0.5 * (r.Bottom - r.Top)

KoordX = XCentr - Radius
KoordX2 = XCentr + Radius
KoordY = YCentr - Radius
KoordY2 = YCentr + Radius

Romb(0).x = KoordX
Romb(0).y = YCentr

Romb(1).x = XCentr
Romb(1).y = KoordY

Romb(2).x = KoordX2
Romb(2).y = YCentr

Romb(3).x = XCentr
Romb(3).y = KoordY2

'окружность
.DrawWidth = 1
.ForeColor = Form1.ForeColor
.FillColor = .BackColor

Call Ellipse(.hdc, KoordX, KoordY, KoordX2, KoordY2)

'Ромб - рисуется как полигон с заданным количеством вершин,
'координаты которых передаются в массиве Romb
.DrawWidth = 2
.ForeColor = ColorKont
.FillColor = ColorZalivki
.FillStyle = vbFSSolid

Call Polygon(.hdc, Romb(0), 4)

.ForeColor = Form1.ForeColor

End With
End Sub

Private Sub Picture1_DblClick()
Timer1.Interval = 500
End Sub

Private Sub Timer1_Timer()
Call Process1
End Sub

 

[Irichka]

Большое спасибо! Нужно будет попробовать так сделать.
А если, например, нужно реализовать вращение фигур (набор пересекающихся линий) против часовой стрелки, и чтоб линии постепенно уменьшались в размерах? Нужно делать четыре цикла относительно точки пересечения и следить, в какие из этих четвертей попадают координаты Х1, У1, Х2, У2 и в зависимости от этого добавлять или отнимать значение координаты? Или всё-таки можно как-то проще сделать эту задачу???

Private Sub Process2()
Dim i As Byte
'делаю из массива линий, линии пересекающиеся в одной точке
For i=0 To Razm Step 1
With Line1(i)
Line1(i).X1=XCentr+(i*300)
Line1(i).Y1=(YCentr-1500)+((i*300)+500)
Line1(i).X2=XCentr-(i*300)
Line1(i).Y2=(YCentr+1500)-((i*300)+300
End With
Next

'1 четверть
For i=0 To Razm Step 1
If Line1(i).Y1<YCentr And Line1(i).X1>XCentr Then
With Line1(i)
Line1(i).X1=Line1(i).X1-50
Line1(i).Y1=Line1(i).Y1-50
Line1(i).X2=Line1(i).X2+50
Line1(i).Y2=Line1(i).Y2+50
End With
End If
Next

'2 четверть 
For i=0 To Razm Step 1
If Line1(i).Y1<YCentr And Line1(i).X1<XCentr Then
With Line1(i)
Line1(i).X1=Line1(i).X1-50
Line1(i).Y1=Line1(i).Y1+50
Line1(i).X2=Line1(i).X2+50
Line1(i).Y2=Line1(i).Y2-50
End With
End If
Next

'3 четверть 
For i=0 To Razm Step 1
If Line1(i).Y1>YCentr And Line1(i).X1<XCentr Then
With Line1(i)
Line1(i).X1=Line1(i).X1+50
Line1(i).Y1=Line1(i).Y1+50
Line1(i).X2=Line1(i).X2-50
Line1(i).Y2=Line1(i).Y2-50
End With
End If
Next

'4 четверть 
For i=0 To Razm Step 1
If Line1(i).Y1>YCentr And Line1(i).X1>XCentr Then
With Line1(i)
Line1(i).X1=Line1(i).X1+50
Line1(i).Y1=Line1(i).Y1-50
Line1(i).X2=Line1(i).X2-50
Line1(i).Y2=Line1(i).Y2+50
End With
End If
Next
End Sub

Private Sub Timer2_Timer()
Process2
End Sub

Только почему-то в результате я никакого движения против часовой стрелки не вижу. Подскажите, почему.

 

[Tanya]

1) По поводу уменьшающихся и вращающихся линий - да, нужно отслеживать координаты в соответствии с вашим алгоритмом уменьшения /вращения линий.
2) Почему нет никакого движения - очевидно: вы ничего не рисуете, а просто изменяете координаты. Как минимум, где-то должна стоять инструкция типа Line (X1, Y1)-(X2,Y2).
К тому же в вашей функции вы 4 раза изменяете координаты. Т.е. если бы вы в каждом цикле прорисовывали линии, то это было бы не вращение. А одновременно отображаемые линии.
Для получения эффекта вращения цикл в вашей функции должен выполняться только один раз. При этом в нем выполняется сначала определение координат, а потом прорисовка линий.