VBNet - Форум - Градиенты: Режем RGB куб по всем плоскостям!

Вопрос: Градиенты: Режем RGB куб по всем плоскостям! Добавлено: 23.03.07 20:03

Автор вопроса: Morpheus | Web-сайт: xury.zx6.ru

Здрасьте!
Давно думал как сделать таки градиенты для выбора цветов как в фотошопе... до меня только щас дошло. Вот пример разрезания кветового куба по 3 плоскостям. Если кому интересно, можно поробывать сделать "косое" сечение (от угла)... а чё, прикольно будет!

Ну, ладно, тем кто знает, будет не интересно, а вот на тех кто нет, может произвести впечатление :)

п.с. могут быть косячки с графикой и оптимизацией, но основная идея работает:

VERSION 5.00
Begin VB.Form frmMain
   Caption         =   "Color Cube"
   ClientHeight    =   7365
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   12735
   LinkTopic       =   "Form1"
   ScaleHeight     =   491
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   849
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdDraw
      Caption         =   "Draw"
      Height          =   705
      Left            =   4950
      TabIndex        =   9
      Top             =   5820
      Width           =   3255
   End
   Begin VB.HScrollBar valueBlue
      Height          =   345
      Left            =   1170
      Max             =   255
      TabIndex        =   5
      Top             =   5220
      Width           =   10965
   End
   Begin VB.HScrollBar valueGreen
      Height          =   345
      Left            =   1170
      Max             =   255
      TabIndex        =   4
      Top             =   4740
      Width           =   10965
   End
   Begin VB.HScrollBar valueRed
      Height          =   345
      Left            =   1170
      Max             =   255
      TabIndex        =   3
      Top             =   4230
      Width           =   10965
   End
   Begin VB.PictureBox alongR
      BackColor       =   &H000000C0&
      BorderStyle     =   0  'None
      Height          =   3840
      Left            =   8280
      ScaleHeight     =   3840
      ScaleWidth      =   3840
      TabIndex        =   2
      Top             =   210
      Width           =   3840
   End
   Begin VB.PictureBox alongG
      BackColor       =   &H0000C000&
      BorderStyle     =   0  'None
      Height          =   3840
      Left            =   4290
      ScaleHeight     =   3840
      ScaleWidth      =   3840
      TabIndex        =   1
      Top             =   210
      Width           =   3840
   End
   Begin VB.PictureBox alongB
      BackColor       =   &H00C00000&
      BorderStyle     =   0  'None
      Height          =   3840
      Left            =   300
      ScaleHeight     =   3840
      ScaleWidth      =   3840
      TabIndex        =   0
      Top             =   180
      Width           =   3840
   End
   Begin VB.Label Label3
      AutoSize        =   -1  'True
      Caption         =   "B"
      Height          =   195
      Left            =   600
      TabIndex        =   8
      Top             =   5310
      Width           =   105
   End
   Begin VB.Label Label2
      AutoSize        =   -1  'True
      Caption         =   "G"
      Height          =   195
      Left            =   600
      TabIndex        =   7
      Top             =   4800
      Width           =   120
   End
   Begin VB.Label Label1
      AutoSize        =   -1  'True
      Caption         =   "R"
      Height          =   195
      Left            =   600
      TabIndex        =   6
      Top             =   4320
      Width           =   120
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Dim Cube(0 To 255, 0 To 255, 0 To 255) As Long
Dim i As Long, j As Long, k As Long
Dim R As Long, G As Long, B As Long
Dim T As String

Private Sub cmdDraw_Click()
'R & G Plane

For i = 0 To 255
    For j = 0 To 255
        SetPixel alongB.hdc, j, i, Cube(i, j, B)
    Next j
Next i

DoEvents

'R & B Plane

For i = 0 To 255
    For k = 0 To 255
        SetPixel alongG.hdc, k, i, Cube(i, G, k)
    Next k
Next i

DoEvents

'B & B Plane

For k = 0 To 255
    For j = 0 To 255
        SetPixel alongR.hdc, j, k, Cube(R, j, k)
    Next j
Next k

DoEvents

End Sub

Private Sub Form_Load()
Show
Me.MousePointer = 11
Refresh
T = Me.Caption

For k = 0 To 255
    For i = 1 To 255
        For j = 1 To 255
            Cube(i, j, k) = RGB(i, j, k)
        Next j
    Next i
    Me.Caption = 256 - k
    DoEvents
Next k
Me.Caption = T
Me.MousePointer = 1
End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub

Private Sub valueBlue_Change()
B = valueBlue.Value
Me.Caption = T & " (" & R & ", " & G & ", " & B & ")"
cmdDraw_Click
End Sub

Private Sub valueGreen_Change()
G = valueGreen.Value
Me.Caption = T & " (" & R & ", " & G & ", " & B & ")"
cmdDraw_Click
End Sub

Private Sub valueRed_Change()
R = valueRed.Value
Me.Caption = T & " (" & R & ", " & G & ", " & B & ")"
cmdDraw_Click
End Sub

Ответить

Ответы Всего ответов: 2

Номер ответа: 1 Автор ответа: HACKER Разработчик Offline Client Вопросов: 236 Ответов: 8362	Профиль \| \| #1	Добавлено: 23.03.07 20:51
	Морфеус, я скриншот с фотошопа делал, и вырезал тот разноцветный квадратик, и все дИла )))) Но пример ничё, красиво... Ответить

Номер ответа: 2 Автор ответа: Morpheus Вопросов: 224 Ответов: 3777	Web-сайт: xury.zx6.ru Профиль \| \| #2	Добавлено: 23.03.07 20:58
	Ну, тоже ничё решение, пока не понадобится увеличить масштаб типа 1 цвет=1 пиксел, как у меня. Да кстати, с "косым сечением" идеи есть? Я так посмотрел - не так то просто у 3Д матрицы угол отрезать! то есть на бумаге то - 3 движения карандашом, а вот преобразовать поверхность сечения в 2Д матрицу - это интереснее Ответить

Страница: 1 |