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

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

  1. Irichka

    Irichka Гость

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

    Код:
    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 Гость

    Репутация:
    0
    Можно при помощи 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
     
  3. Irichka

    Irichka Гость

    Репутация:
    0
    Большое спасибо! Нужно будет попробовать так сделать.
    А если, например, нужно реализовать вращение фигур (набор пересекающихся линий) против часовой стрелки, и чтоб линии постепенно уменьшались в размерах? Нужно делать четыре цикла относительно точки пересечения и следить, в какие из этих четвертей попадают координаты Х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
    Только почему-то в результате я никакого движения против часовой стрелки не вижу. Подскажите, почему.
     
  4. Tanya

    Tanya Гость

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

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