vbAccelerator - Contents of code file: Stevemac_VB_Develop_Gfx_Hls_Form1.frm

VERSION 5.00
Begin VB.Form frmHLS 
   Caption         =   "Simple Hue Lightness Saturation Demo"
   ClientHeight    =   4200
   ClientLeft      =   3120
   ClientTop       =   1725
   ClientWidth     =   5835
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   4200
   ScaleWidth      =   5835
   Begin VB.PictureBox picColorSample 
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   855
      Left            =   4500
      ScaleHeight     =   795
      ScaleWidth      =   975
      TabIndex        =   2
      Top             =   60
      Width           =   1035
   End
   Begin VB.PictureBox picLuminance 
      AutoRedraw      =   -1  'True
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   3855
      Left            =   3960
      ScaleHeight     =   3795
      ScaleWidth      =   135
      TabIndex        =   1
      Top             =   60
      Width           =   195
   End
   Begin VB.PictureBox picHLS 
      AutoRedraw      =   -1  'True
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   3840
      Left            =   240
      ScaleHeight     =   3780
      ScaleWidth      =   3540
      TabIndex        =   0
      Top             =   60
      Width           =   3600
   End
   Begin VB.Label lblLuminance 
      Caption         =   "L u m i n a n c e"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2535
      Left            =   4260
      TabIndex        =   6
      Top             =   60
      Width           =   135
   End
   Begin VB.Label lblSaturation 
      Caption         =   "S a t u r a t  i  o n"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2535
      Left            =   60
      TabIndex        =   5
      Top             =   60
      Width           =   135
   End
   Begin VB.Label lblHue 
      Caption         =   "Hue"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   240
      TabIndex        =   4
      Top             =   3960
      Width           =   3615
   End
   Begin VB.Label lblInfo 
      Caption         =   "Click on the Hue/Saturation Box and then the
       Luminance box to select a colour.  Drag with mouse down to see
       variations."
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1935
      Left            =   4500
      TabIndex        =   3
      Top             =   960
      Width           =   1275
   End
End
Attribute VB_Name = "frmHLS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim mr As Long, mg As Long, mb As Long
Dim h As Single, s As Single, l As Single




Private Sub Form_Load()
   DrawHLSBox picHLS
End Sub

Private Sub picHLS_MouseDown(Button As Integer, Shift As Integer, X As Single,
 Y As Single)
Dim h As Single, s As Single, l As Single
Dim r As Long, g As Long, b As Long

   If (X > 0) And (Y > 0) And (X < picHLS.ScaleWidth) And (Y <
    picHLS.ScaleHeight) Then
      h = (X \ Screen.TwipsPerPixelX) - 40
      s = 128 - (Y \ (2 * Screen.TwipsPerPixelY))
      DrawLuminanceBox picLuminance, h / 40, s / 128
      picHLS.Tag = "h" & h / 40 & ":s" & s / 128
      If (picLuminance.Tag <> "") Then
         l = CSng(picLuminance.Tag)
         HLSToRGB h / 40, s / 128, l, r, g, b
         picColorSample.BackColor = RGB(r, g, b)
      End If
   End If
End Sub

Private Sub picHLS_MouseMove(Button As Integer, Shift As Integer, X As Single,
 Y As Single)
   If (Button And vbLeftButton) = vbLeftButton Then
      picHLS_MouseDown Button, Shift, X, Y
   End If
End Sub

Private Sub picLuminance_MouseDown(Button As Integer, Shift As Integer, X As
 Single, Y As Single)
Dim h As Single, s As Single, l As Single
Dim iPos As Long, sTag As String
Dim r As Long, g As Long, b As Long

   sTag = picHLS.Tag
   iPos = InStr(sTag, ":")
   If (iPos <> 0) Then
      h = CSng(Mid$(sTag, 2, (iPos - 2)))
      s = CSng(Mid$(sTag, iPos + 2))
      If (Y > 0) And (Y < picLuminance.ScaleHeight) Then
         l = 1 - (Y / picLuminance.ScaleHeight)
         picLuminance.Tag = l
         HLSToRGB h, s, l, r, g, b
         picColorSample.BackColor = RGB(r, g, b)
      End If
   End If
End Sub

Private Sub picLuminance_MouseMove(Button As Integer, Shift As Integer, X As
 Single, Y As Single)
   If (Button And vbLeftButton) = vbLeftButton Then
      picLuminance_MouseDown Button, Shift, X, Y
   End If

End Sub