1. Получи 30.000 рублей. Для получения денег необходимо принять участие в конкурсе авторов codeby. С условиями и призами можно ознакомиться на этой странице ...

    Внимание! Регистрация авторов на конкурс закрыта.

    Скрыть объявление
  2. Требуются разработчики и тестеры для проекта codebyOS. Требования для участия в проекте: Знание принципов работы ОС на базе Linux; Знание Bash; Крайне желательное знание CPP, Python, Lua; Навыки системного администрирования. Подробнее ...

    Скрыть объявление

Задача с массивами и графикой

Тема в разделе "Visual Basic", создана пользователем Vyacheslavovich, 18 ноя 2009.

  1. Vyacheslavovich

    Vyacheslavovich Гость

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

    Код:
    Dim color(14) As Integer
    Dim colorNotBlack(14) As Integer
    
    Private Sub Mass_rnd()
    Randomize
    
    Dim i As Integer
    For i = 0 To 14
    color(i) = Int(14 * Rnd)
    Next i
    End Sub
    
    Private Sub Draw()
    Mass_rnd
    Dim i As Integer
    Picture1.FillStyle = 0
    Picture1.Scale (0, 0)-(20, 10)
    For i = 0 To 14
    Select Case color(i)
    Case 1
    Picture1.FillColor = 16776960
    Case 2
    Picture1.FillColor = 255
    Case 3
    Picture1.FillColor = 65280
    Case 4
    Picture1.FillColor = 65535
    Case 5
    Picture1.FillColor = 16711680
    Case 6
    Picture1.FillColor = 16777215
    Case 7
    Picture1.FillColor = 16711935
    Case 8, 9, 10, 11, 12, 13, 14
    Picture1.FillColor = 0
    End Select
    Picture1.Circle (1 + 1 * i, 5), 0.3
    Next i
    End Sub
    
    Private Sub Command1_Click()
    Draw
    Picture2.Cls
    End Sub
    
    Private Sub Command2_Click()
    Picture2.FillStyle = 0
    Dim i As Integer
    Dim b As Integer
    b = 0
    For i = 0 To 14
    If color(i) >= 8 Then
    b = b + 1
    Помогите, как далее реализовать сжатие массива со смещением всех кругов к левому краю в Picture2??????
     
  2. Vyacheslavovich

    Vyacheslavovich Гость

    Репутация:
    0
    Всё, сам сообразил.. Тема закрыта

    Код:
    Dim bw_array(13) As Integer
    
    Private Sub random_array()
    Randomize
    Dim random_number, i As Integer
    
    For i = 0 To 13
    bw_array(i) = Round(Rnd * 6)
    Next i
    End Sub
    
    Private Sub Command1_Click()
    draw
    Picture2.Cls
    End Sub
    
    Private Sub Command2_Click()
    Picture2.FillStyle = vbSolid
    Dim i As Integer
    
    Dim count_black As Integer
    count_black = 0
    For i = 0 To 13
    If (bw_array(i) = 0) Then
    count_black = count_black + 1
    Else
    Select Case bw_array(i)
    Case 1: Picture2.FillColor = vbBlue
    Case 2: Picture2.FillColor = vbGreen
    Case 3: Picture2.FillColor = vbRed
    Case 4: Picture2.FillColor = vbYellow
    Case 5: Picture2.FillColor = vbWhite
    Case 6: Picture2.FillColor = &HC000C0
    End Select
    
    Picture2.Circle (250 + 500 * (i - count_black), 250), 250, vbBlack
    End If
    Next i
    
    If (count_black = 0) Then
    MsgBox "Нет кругов черного цвета."
    End If
    
    Refresh
    End Sub
    
    
    Private Sub Form_Load()
    draw
    End Sub
    
    Private Sub draw()
    random_array
    
    Dim i As Integer
    
    Picture1.FillStyle = vbSolid
    
    For i = 0 To 13
    Select Case bw_array(i)
    Case 0: Picture1.FillColor = vbBlack
    Case 1: Picture1.FillColor = vbBlue
    Case 2: Picture1.FillColor = vbGreen
    Case 3: Picture1.FillColor = vbRed
    Case 4: Picture1.FillColor = vbYellow
    Case 5: Picture1.FillColor = vbWhite
    Case 6: Picture1.FillColor = &HC000C0
    End Select
    
    Picture1.Circle (250 + 500 * i, 250), 250, vbBlack
    Next i
    End Sub
     
Загрузка...

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