Prerequisites |
Grid control (not MS FlexGrid). |
|
The
following creates a popup colour selector that you can attach to any command button on a form or toolbar, or use as a popup colour selector.
The colour selector uses a grid on a standard form as the means to present the user with available colours, and provides code to move (align)
the selector to any button you assign as the 'select colour' button.
|
|
BAS
Module Code |
None. |
|
|
Form
Code - Form1 |
|
Begin a new project and add a form (Form1).
On Form1, add a Shape control (named
Shape1), and a Label
(Label1) with text, font and font size of your choice. Add two command buttons (Command1 and Command2). Position the label, shape and buttons
as you see fit. Add the following to Form1: |
|
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const SM_CYCAPTION As Long = 4
Public CaptionHeight
Private Sub Command2_Click()
Unload Form2
Unload Me
End Sub
Private Sub Form_Load()
Me.Move (Screen.Width - Me.Width) / 2, _
(Screen.Height - Me.Height) / 2
'in order to reposition, we need to
'offset by the titlebar
CaptionHeight = (GetSystemMetrics(SM_CYCAPTION) * Screen.TwipsPerPixelY)
End Sub
Private Sub Command1_MouseDown(Button As Integer, _
Shift As Integer, _
X As Single, Y As Single)
Dim bLeft As Integer
Dim bTop As Integer
'calculate the position of the left
'and bottom of the command button
bLeft = Form1.Left + Command1.Left + 50
bTop = Form1.Top + Command1.Top + _
Command1.Height + CaptionHeight + 50
'move the popup form to that
'position & show
Form2.Move bLeft, bTop
Form2.Show
End Sub/font> |
|
Form
Code - Form2 |
|
On Form2, add a Grid control (not MSFlexGrid). Set the
grid's FixedRows and FixedColumns properties to 0, its BorderStyle to None, and the GridLine and Highlight properties to False. Remove the
Caption ( ""), and set the window style to fixed dialog. Also
assure that the Control box, Minimize and Maximize properties are
false. Finally, add a picture box (Picture1) ...its Visible property can be False, but its AutoRedraw property must be True.
Add the following to Form2: |
|
Option Explicit
Private Sub Form_Load()
Dim i As Integer
'create the colour selector
With Grid1
.BackColor = &H8000000F
.Width = 1200
.Height = (.RowHeight(0) * 8) + 120
'make it 2 columns x 8 rows
.Rows = 8
.Cols = 2
.ColWidth(0) = (.Width \ 2) - 60
'select the first column
.Col = 0
'to add the colours, set a
'pixbox to the same size as a cell
Picture1.BorderStyle = 0
Picture1.Height = .RowHeight(0)
Picture1.Width = .ColWidth(0)
'loop through the 16 QB colours
For i = 0 To 15
'if i > 7, then subtract 8 from the
'count for the row (because we're back to
'row 0, but column 2), and add to the
'second column
If i > 7 Then
.Row = i - 8: .Col = 1
Else
.Row = i%
End If
'clear any existing picture
Picture1.Cls
'set the picture background colour
'to that of a form
Picture1.Line (0, 0)-(Picture1.Width, Picture1.Height), _
QBColor(7), BF
'create a line of the specified QB colour
Picture1.Line (45, 45)-(Picture1.Width - 45, Picture1.Height - 45), _
QBColor(i%), BF
'put a frame around the grey one (colour 7)
If i = 7 Then Picture1.Line (45, 45)-(Picture1.Width - 45, Picture1.Height - 45), _
QBColor(0), B
'assign the colour to the specified grid row
.Picture = Picture1.Image
Next i
End With
'size the dropdown colour form
Me.Width = Grid1.Width
Me.Height = Grid1.Height
End Sub
Private Sub Grid1_Click()
Dim bump As Integer
'display the colour based on the selected row (0-7) if the column is 0,
'but add 8 to use the next set of colours if the column is 1
If Grid1.Col = 1 Then bump = 8
'reflect the selection in the sample shape and text
Form1!Label1.ForeColor = QBColor(Grid1.Row + bump)
Form1!Shape1.BackColor = QBColor(Grid1.Row + bump)
'once something has been chosen, hide the selector
Me.Hide
End Sub |
|
|
Comments |
You will also want to code to hide the colour selector
should focus move from the selector back to the form without the user making any colour change selection. |
|