[VBnet Forms] GetSystemMetrics: How to Create a Popup Colour Selector


	Visual Basic Window/Form Routines GetSystemMetrics: How to Create a Popup Colour Selector

Posted:	Thursday December 26, 1996
Updated:	Monday December 26, 2011

Applies to:	VB4-32, VB5, VB6, and VB3, VB4-16 with appropriate declarations
Developed with:	VB4-32, Windows 95
OS restrictions:	None
Author:	VBnet - Randy Birch

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.

PayPal Link