Home
Search
 
What's New
Index
Books
Links
Q & A
Newsletter
Banners
 
Feedback
Tip Jar
 
C# Helper...
 
XML RSS Feed
Follow VBHelper on Twitter
 
 
 
MSDN Visual Basic Community
 
 
 
 
 
TitleMake a series of color samples
DescriptionThis example shows how to make a series of color samples in Visual Basic 6.
Keywordscolor, color sample, pick color
CategoriesGraphics, 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
 
 
Copyright © 1997-2010 Rocky Mountain Computer Consulting, Inc.   All rights reserved.
  Updated