VPF::Разукраска - Форум программистов

Gannibal

Дата 27.11.2004, 16:01 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 742
Регистрация: 15.4.2003
Где: 010101

Репутация: 18
Всего: 17

функции для покраски ФОРМЫ, как её можно изменить неупотребляя картинок просто цветами полностю обясните или пример покажите smile

--------------------

Я родился в этом безумном мире - и Я сделаю всё чтобы в нём выжить!

cardinal

Дата 27.11.2004, 16:58 (ссылка)

(нет голосов)

Загрузка ...

Инженер

Профиль
Группа: Экс. модератор
Сообщений: 6003
Регистрация: 26.3.2002
Где: Германия

Репутация: 19
Всего: 99

http://hrestomvb.h11.ru/faq/faq_43.php

--------------------

Немецкая оппозиция потребовала упростить натурализацию иммигрантов
В моем блоге: Разные истории из жизни в Германии

"Познание бесконечности требует бесконечного времени, а потому работай не работай - все едино". А. и Б. Стругацкие

COLOMBO

Дата 27.11.2004, 19:56 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 36
Регистрация: 26.11.2004

Репутация: нет
Всего: нет

Дак это же просто:
Создаёшь например кнопку и прописываеш:

Код


Private Sub Command1_Click()
Form1.BackColor = &HC0& 'Красим в красный цвет по нажатию кнопки
End Sub

И всё

~FoX~

Дата 30.11.2004, 09:40 (ссылка)

(нет голосов)

Загрузка ...

НЕ рыжий!!!

Профиль
Группа: Участник Клуба
Сообщений: 2819
Регистрация: 8.10.2003
Где: Зеленоград

Репутация: 10
Всего: 68

Код


Private Sub Command1_Click()
 For Y = 1 To kol
        For X = 1 To kol
            a(X, Y) = 0
        Next X
    Next Y
    radius = 250 ' радиус ячейки в пикселя
    kol = 20 ' Количество рядов
    a(Int(kol / 2), 0) = 1 ' первая единица, от которой и растет треугольник
    DrawWidth = 1 ' Толщина линии
    For Y = 0 To kol
        For X = 1 To kol
            sdvig = radius / 2 * (-1) ^ Y ' Сдвиг каждого ряда то влево, то вправо
            If Y > 0 Then
                If sdvig > 0 Then
                    a(X, Y) = a(X + 1, Y - 1) + a(X - 0, Y - 1)
                Else
                    a(X, Y) = a(X + 0, Y - 1) + a(X - 1, Y - 1)
                End If
            End If
            X1 = 60 + X * radius * 2 + sdvig
            Y1 = 10 + Y * radius * 1.7
            If a(X, Y) > 0 Then
                ForeColor = RGB(0, 0, 0)
                Form1.PSet (X1, Y1), RGB(255, 255, 255)
                Print a(X, Y)
            End If
        Next X
    Next Y
End Sub

Private Sub Command2_Click()
    For Y = 1 To kol
        For X = 1 To kol
            a(X, Y) = 0
        Next X
    Next Y
    radius = 250 ' радиус ячейки в пикселя
    kol = 20 ' Количество рядов
    a(Int(kol / 2), 0) = 1 ' первая единица, от которой и растет треугольник
    DrawWidth = 1 ' Толщина линии
    For Y = 0 To kol
        For X = 1 To kol
            sdvig = radius / 2 * (-1) ^ Y ' Сдвиг каждого ряда то влево, то вправо
            If Y > 0 Then
                If sdvig > 0 Then
                    a(X, Y) = a(X + 1, Y - 1) + a(X - 0, Y - 1)
                Else
                    a(X, Y) = a(X + 0, Y - 1) + a(X - 1, Y - 1)
                End If
            End If
            X1 = 60 + X * radius * 2 + sdvig
            Y1 = 10 + Y * radius * 1.7
            FillStyle = 0
            FillColor = RGB(255, 255, 255) ' Цвет заливки
            If a(X, Y) > 0 Then
                If a(X, Y) Mod 2 = 1 Then
                    FillColor = RGB(0, 0, 0)
                    Circle (X1, Y1), radius, RGB(90, 90, 90)
                End If
            End If
        Next X
    Next Y
End Sub

Private Sub Command3_Click()
    For Y = 1 To kol
    For X = 1 To kol
        a(X, Y) = 0
    Next X
    Next Y
    radius = 250 ' радиус ячейки в пикселя
    kol = 20 ' Количество рядов
    a(Int(kol / 2), 0) = 1 ' первая единица, от которой и растет треугольник
    DrawWidth = 1 ' Толщина линии
    For Y = 0 To kol
        For X = 1 To kol
            sdvig = radius / 2 * (-1) ^ Y ' Сдвиг каждого ряда то влево, то вправо
            If Y > 0 Then
                If sdvig > 0 Then
                    a(X, Y) = a(X + 1, Y - 1) + a(X - 0, Y - 1)
                Else
                    a(X, Y) = a(X + 0, Y - 1) + a(X - 1, Y - 1)
                End If
            End If
            X1 = 60 + X * radius * 2 + sdvig
            Y1 = 10 + Y * radius * 1.7
            FillStyle = 0
            r = 0: g = 0: b = 0
            If a(X, Y) > 0 Then
                If (a(X, Y) - Int(a(X, Y) / 2) * 2) = 0 Then r = 250
                'If (a(X, Y) / 4) - Int(a(X, Y) / 4) = 0 Then r = 120
                'If (a(X, Y) / 8) - Int(a(X, Y) / 8) = 0 Then r = 180
                'If (a(X, Y) / 16) - Int(a(X, Y) / 16) = 0 Then r = 250
                'If (a(X, Y) / 3) -  Int(a(X, Y) / 3) = 0 Then g = 60
                If (a(X, Y) / 9) - Int(a(X, Y) / 9) = 0 Then g = 250
                'If (a(X, Y) / 7) - Int(a(X, Y) / 7) = 0 Then g = 180
                'If (a(X, Y) / 5) - Int(a(X, Y) / 5) = 0 Then g = 250
                If (a(X, Y) / 11) - Int(a(X, Y) / 11) = 0 Then b = 250
                'If (a(X, Y) / 13) - Int(a(X, Y) / 13) = 0 Then b = 120
                'If (a(X, Y) / 17) - Int(a(X, Y) / 17) = 0 Then b = 180
                'If (a(X, Y) / 19) - Int(a(X, Y) / 19) = 0 Then b = 250
                ForeColor = RGB(r, g, b)
                FillColor = RGB(r, g, b) ' Цвет заливки
                Circle (X1, Y1), radius, RGB(90, 90, 90)
            End If
        Next X
    Next Y
End Sub

Рисует на форме треугольник паскаля, цветной, с цифорками.
Добавлено @ 09:42
Ой забыл, закоментированный строчки, можно разкоментить и получишь другие цвета заполнения кружков.

Код


                'If (a(X, Y) / 4) - Int(a(X, Y) / 4) = 0 Then r = 120
                'If (a(X, Y) / 8) - Int(a(X, Y) / 8) = 0 Then r = 180
                'If (a(X, Y) / 16) - Int(a(X, Y) / 16) = 0 Then r = 250
                'If (a(X, Y) / 3) -  Int(a(X, Y) / 3) = 0 Then g = 60
                If (a(X, Y) / 9) - Int(a(X, Y) / 9) = 0 Then g = 250
                'If (a(X, Y) / 7) - Int(a(X, Y) / 7) = 0 Then g = 180
                'If (a(X, Y) / 5) - Int(a(X, Y) / 5) = 0 Then g = 250
                If (a(X, Y) / 11) - Int(a(X, Y) / 11) = 0 Then b = 250
                'If (a(X, Y) / 13) - Int(a(X, Y) / 13) = 0 Then b = 120
                'If (a(X, Y) / 17) - Int(a(X, Y) / 17) = 0 Then b = 180
                'If (a(X, Y) / 19) - Int(a(X, Y) / 19) = 0 Then b = 250

--------------------

…множественность никогда не следует полагать без необходимости…

cardinal

Дата 30.11.2004, 15:35 (ссылка)

(нет голосов)

Загрузка ...

Инженер

Профиль
Группа: Экс. модератор
Сообщений: 6003
Регистрация: 26.3.2002
Где: Германия

Репутация: 19
Всего: 99

А а() это что?

--------------------

~FoX~

Дата 30.11.2004, 16:22 (ссылка)

(нет голосов)

Загрузка ...

НЕ рыжий!!!

Профиль
Группа: Участник Клуба
Сообщений: 2819
Регистрация: 8.10.2003
Где: Зеленоград

Репутация: 10
Всего: 68

Простите, забыл.

Код


Dim a(100, 100) As Double
Dim radius As Byte, i As Byte, kol As Byte
Dim sdvig As Integer, X As Integer, Y As Integer, X1 As Integer, Y1 As Integer

--------------------

…множественность никогда не следует полагать без необходимости…

cardinal

Дата 30.11.2004, 21:00 (ссылка)

(нет голосов)

Загрузка ...

Инженер

Профиль
Группа: Экс. модератор
Сообщений: 6003
Регистрация: 26.3.2002
Где: Германия

Репутация: 19
Всего: 99

Цитата

Рисует на форме треугольник паскаля, цветной, с цифорками.

А можно такой тупой вопрос: А на фига он нужен цветной? smile

--------------------

Staruha

Дата 30.11.2004, 21:15 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1292
Регистрация: 1.2.2004
Где: Казань

Репутация: 2
Всего: 27

Окно с плавным переходом цвета(с верху вниз) :
Этот способ намного эффективнеe - заливается быстрее. Цвет – синий. Код:

Код


 Private Sub Form_load()
    AutoRedraw = False
 End Sub

    Private Sub Form_Paint() ' Объявление переменных
  Dim lY As Long
  Dim lScaleHeight As Long
  Dim lScaleWidth As Long

        ScaleMode = vbPixels 'Единицу измерения устанавливаем равной   пикселу
       lScaleHeight = ScaleHeight 'Получаем кол-во пикселов по высоте
       lScaleWidth = ScaleWidth 'Получаем кол-во пикселов по ширине
       DrawStyle = vbInvisible 'Устанавливаем стиль заливки и рисования
       FillStyle = vbFSSolid
       For lY = 0 To lScaleHeight 'Запускаем цикл закраски 'Закрашиваем
  FillColor = RGB(0, 0, 255 - (lY * 255) \ lScaleHeight)
  Line (-1, lY - 1)-(lScaleWidth, lY + 1), , B
  Next lY
  End Sub

Добавлено @ 21:16
Код от Падре

--------------------

Возмездие настигнет

~FoX~

Дата 1.12.2004, 13:00 (ссылка)

(нет голосов)

Загрузка ...

НЕ рыжий!!!

Профиль
Группа: Участник Клуба
Сообщений: 2819
Регистрация: 8.10.2003
Где: Зеленоград

Репутация: 10
Всего: 68

Старуха
А он не говорил про градиентную заливку, он как я понял, хотел отделным кускам формы цвет менять.

--------------------

…множественность никогда не следует полагать без необходимости…

Гость_Старуха

Дата 1.12.2004, 14:07 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

Плавный переход цвета. От темного к светлому.У него это здорово получается

cardinal

Дата 1.12.2004, 18:16 (ссылка)

(нет голосов)

Загрузка ...

Инженер

Профиль
Группа: Экс. модератор
Сообщений: 6003
Регистрация: 26.3.2002
Где: Германия

Репутация: 19
Всего: 99

Старуха, ~FoX~ не об этом smile

--------------------

Staruha

Дата 1.12.2004, 21:18 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1292
Регистрация: 1.2.2004
Где: Казань

Репутация: 2
Всего: 27

Я особо Интерфейсу внимание не уделяю.Главное что бы комп соображал. Но теперь придется копаться о чем это FoX.

--------------------

Возмездие настигнет

~FoX~

Дата 2.12.2004, 11:01 (ссылка)

(нет голосов)

Загрузка ...

НЕ рыжий!!!

Профиль
Группа: Участник Клуба
Сообщений: 2819
Регистрация: 8.10.2003
Где: Зеленоград

Репутация: 10
Всего: 68

Цитата(cardinal @ 30.11.2004, 21:00)

Рисует на форме треугольник паскаля, цветной, с цифорками.

А можно такой тупой вопрос: А на фига он нужен цветной?

А прикольно это.
Сам посмотри. Там закономерности проявляются.
Точно не помню, по моему на http://arbuz.uz/ нашел, но могу и ошибаться.

--------------------

…множественность никогда не следует полагать без необходимости…

Staruha

Дата 2.12.2004, 13:20 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1292
Регистрация: 1.2.2004
Где: Казань

Репутация: 2
Всего: 27

А он не говорил про градиентную заливку - это что заливка рисунком?

--------------------

Возмездие настигнет

~FoX~

Дата 2.12.2004, 15:03 (ссылка)

(нет голосов)

Загрузка ...

НЕ рыжий!!!

Профиль
Группа: Участник Клуба
Сообщений: 2819
Регистрация: 8.10.2003
Где: Зеленоград

Репутация: 10
Всего: 68

Градиентная - плавный переход цвета от более темного/светлого к более светлому/темному

--------------------

…множественность никогда не следует полагать без необходимости…

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| VB6 \| Следующая тема »