| Вопрос: Помогите пожайлуста...! | Добавлено: 22.04.05 15:01 |
Автор вопроса:  LaMeR
|
|
На форме у меня есть 10000 точек и они у меня одного цвета, как сделать чтобы цвета у точек были разного цвета?
Заранее благодарен |
| Ответы | Всего ответов: 5 |
|
Номер ответа: 1 Автор ответа:  Morpheus Вопросов: 224 Ответов: 3777 |
Web-сайт: Профиль | Цитата | #1 | Добавлено: 22.04.05 15:32 |
|
вот этот тод вроде полностью рабочий
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Const cDef = 0 'default color Dim i As Integer Dim j As Integer Dim x As Integer, y As Integer Dim c As Long Private Sub Form_Load() Me.AutoRedraw = True Show 'ðàññòàâëÿåì òî÷êè For i = 1 To 10000 x = Int(Rnd * Me.Width \ Screen.TwipsPerPixelX) y = Int(Rnd * Me.Height \ Screen.TwipsPerPixelY) SetPixel Me.hdc, x, y, cDef Next Refresh Sleep 400 For j = 0 To Me.Width \ Screen.TwipsPerPixelY For i = 0 To Me.Height \ Screen.TwipsPerPixelX c = GetPixel(Me.hdc, i, j) If c = cDef Then SetPixel Me.hdc, i, j, RGB(Rnd * 255, Rnd * 255, Rnd * 255) End If Next Next Refresh End Sub |
||
|
Номер ответа: 2 Автор ответа: Neco ICQ: 247906854 Вопросов: 133 Ответов: 882 |
Web-сайт: Профиль | Цитата | #2 | Добавлено: 22.04.05 23:57 |
| а ещё можно сделать тип "tochka" состоящий из координат и текущего цвета и задав один раз координаты потом менять цвет, не меняя положения точек. Если каждую 1/10 секунды прибавлять к каждому цвету по 1 (первоначально ест-но цвета по рандому), то возможно неплохо получится... | ||
|
Номер ответа: 3 Автор ответа: MorpheusВопросов: 224 Ответов: 3777 |
Web-сайт: Профиль | Цитата | #3 | Добавлено: 23.04.05 00:27 |
|
2 Neco:
А ты классно с цветами придумал!!! А если сделать вот так : Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Const cDef = vbWhite 'default color Dim i As Integer Dim j As Integer Dim k As Integer Dim x As Integer, y As Integer Dim c As Long Private Type Point_NOT_API x As Long y As Long c As Long End Type Dim p(1 To 10000) As Point_NOT_API Dim gx As Integer, gy As Integer Dim cn As Long Private Sub Form_Load() Timer1.Interval = 110 Timer1.Enabled = False Me.AutoRedraw = True Me.BackColor = vbBlack Me.Caption = "Superb" Show ' Randomize gy = Me.Width \ Screen.TwipsPerPixelY gx = Me.Height \ Screen.TwipsPerPixelX For i = 1 To 10000 x = Int(Rnd * gx) y = Int(Rnd * gy) SetPixel Me.hdc, x, y, cDef Next Refresh Sleep 400 k = 0 For j = 0 To gy For i = 0 To gx c = GetPixel(Me.hdc, i, j) If c = cDef Then cn = RGB(Rnd * 255, Rnd * 255, Rnd * 255) SetPixel Me.hdc, i, j, cn k = k + 1 p(k).x = i p(k).y = j p(k).c = cn End If Next Next Refresh Timer1.Enabled = True End Sub Private Sub Timer1_Timer() Cls For k = 1 To 10000 p(k).x = p(k).x - 2 If p(k).x <= 0 Then p(k).x = gx SetPixel Me.hdc, p(k).x, p(k).y, p(k).c Next Refresh End Sub ...то почти звёзды получатся. Мы с другом делали такую же ерунду только трёхслойную т.е. задний слой из маленьких точек двигался оч мееедленно, средний из точек чуть подольше бвигался побыстрее а передний слой двигался ещё побыстрее, тогда получалость почти 3D |
||
|
Номер ответа: 4 Автор ответа: LaMeR Вопросов: 1 Ответов: 1 |
Профиль | Цитата | #4 | Добавлено: 24.04.05 20:42 |
|
Это конечно все хорошо, но не то что мне нужно, RGB(Rnd * 255, Rnd * 255, Rnd * 255) этой строчкой он задает цвета, а мне нужны 7 конкретных цветов например: желтый, зеленый, темно-зеленый, салатовый и тд, и еще как можно сделать чтобы он цвета задавал по формуле, например: зеленых должно быть 500 и тд.
Заранее благодарен |
||
|
Номер ответа: 5 Автор ответа: MorpheusВопросов: 224 Ответов: 3777 |
Web-сайт: Профиль | Цитата | #5 | Добавлено: 24.04.05 21:04 |
|
дык какие проблемы?
можно задать счётчик K в цикле (код 1), потом замени RGB(Rnd * 255, Rnd * 255, Rnd * 255) на какую нить переменную color а потом писать: if k<500 then color=vbGreen ' color- an example avriable
if k>=500 and k<1000 then color=vbRed 'for example '..... |
||
Страница: 1 |