|
|
|
| Title | Make a series of color samples |
|---|
| Description | This example shows how to make a series of color samples in Visual Basic 6. |
|---|
| Keywords | color, color sample, pick color |
|---|
| Categories | Graphics, Controls |
|---|
|
|
|
When the program starts, the form's Load event handler uses the Load statement to make a control array of Labels arranged in rows and columns. It then calls subroutine InterpolateColumn to set the BackColor properties for the Labels in each column.
|
|
Private Const NUM_ROWS As Integer = 8
Private Const NUM_COLS As Integer = 7
Private Sub Form_Load()
Const GAP As Single = 30
Dim row As Integer
Dim col As Integer
Dim i As Integer
' Make the color sample labels.
i = 0
For row = 0 To NUM_ROWS - 1
For col = 0 To NUM_COLS - 1
If row > 0 Or col > 0 Then
Load lblColor(i)
With lblColor(i)
If col = 0 Then
.Left = lblColor(0).Left
.Top = lblColor(i - NUM_COLS).Top + _
.Height + GAP
Else
.Left = lblColor(i - 1).Left + _
.Width + GAP
.Top = lblColor(i - 1).Top
End If
.Visible = True
End With
End If
i = i + 1
Next col
Next row
' Color the samples.
InterpolateColumn 0, 255, 0, 0
InterpolateColumn 1, 255, 255, 0
InterpolateColumn 2, 0, 255, 0
InterpolateColumn 3, 0, 255, 255
InterpolateColumn 4, 0, 0, 255
InterpolateColumn 5, 255, 0, 255
InterpolateColumn 6, 128, 128, 128
' Position the color component labels.
i = (NUM_ROWS - 1) * NUM_COLS
lblR.Top = lblColor(i).Top + lblColor(i).Height + 4 * _
GAP
lblG.Top = lblR.Top
lblB.Top = lblR.Top
i = (NUM_ROWS - 1) * NUM_COLS + NUM_COLS - 1
Me.Width = lblColor(i).Left + lblColor(i).Width + _
lblColor(0).Left + Me.Width - Me.ScaleWidth
Me.Height = lblR.Top + lblR.Height + lblColor(0).Top + _
Me.Height - Me.ScaleHeight
End Sub
|
|
|
Subroutine InterpolateColumn sets the BackColor properties for the Labels in a column. It sets BackColor to the indicated color in the middle Label. It gives Labels above that one lighter shades of the same color and it gives Labels below that one darker shades.
|
|
Private Sub InterpolateColumn(ByVal col As Integer, ByVal _
mid_r As Integer, ByVal mid_g As Integer, ByVal mid_b _
As Integer)
Dim mid As Integer
Dim row As Integer
Dim r As Single
Dim g As Single
Dim b As Single
Dim dr As Single
Dim dg As Single
Dim db As Single
' Lighter colors.
mid = (NUM_ROWS - 1) \ 2
dr = (255 - mid_r) / (mid + 1)
dg = (255 - mid_g) / (mid + 1)
db = (255 - mid_b) / (mid + 1)
r = 255
g = 255
b = 255
For row = 0 To mid
r = r - dr
g = g - dg
b = b - db
lblColor(row * NUM_COLS + col).BackColor = RGB(r, _
g, b)
Next row
' Darker colors.
mid = (NUM_ROWS - 1) \ 2
dr = mid_r / (NUM_ROWS - 1 - mid + 1)
dg = mid_g / (NUM_ROWS - 1 - mid + 1)
db = mid_b / (NUM_ROWS - 1 - mid + 1)
For row = mid + 1 To NUM_ROWS - 1
r = r - dr
g = g - dg
b = b - db
lblColor(row * NUM_COLS + col).BackColor = RGB(r, _
g, b)
Next row
End Sub
Private Sub UnRGB(ByRef color As OLE_COLOR, ByRef r As _
Byte, ByRef g As Byte, ByRef b As Byte)
r = color And &HFF&
g = (color And &HFF00&) \ &H100&
b = (color And &HFF0000) \ &H10000
End Sub
|
| |
|
| |
|
|
