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

Тема в разделе "Visual Basic", создана пользователем Irichka, 25 дек 2010.

  1. Irichka

    Irichka Гость

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

    Код (LotusScript):
    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
     
  2. Tanya

    Tanya Гость

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

    Пример:
    Код (LotusScript):
    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
     
  3. Irichka

    Irichka Гость

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

    Код (LotusScript):
    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
    Только почему-то в результате я никакого движения против часовой стрелки не вижу. Подскажите, почему.
     
  4. Tanya

    Tanya Гость

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

Поделиться этой страницей