GFColorSlider/GFColorSlider.frm

VERSION 5.00
Begin VB.Form Testfrm
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4695
   BeginProperty Font
      Name            =   "Small Fonts"
      Size            =   6
      Charset         =   0
      Weight          =   400
      Underline       =   0 'False
      Italic          =   0 'False
      Strikethrough   =   0 'False
   EndProperty
   ForeColor       =   &H00000000&
   LinkTopic       =   "Form1"
   ScaleHeight     =   213
   ScaleMode       =   3 'Pixel
   ScaleWidth      =   313
   StartUpPosition =   3 'Windows‑Standard
   Begin VB.CommandButton GFColorSliderNextPaletteCommand
      Caption         =   ">"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0 'False
         Italic          =   0 'False
         Strikethrough   =   0 'False
      EndProperty
      Height          =   435
      Left            =   3900
      TabIndex        =   3
      ToolTipText     =   "next legend page"
      Top             =   180
      Width           =   315
   End
   Begin VB.CommandButton GFColorSliderPreviousPaletteCommand
      Caption         =   "<"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0 'False
         Italic          =   0 'False
         Strikethrough   =   0 'False
      EndProperty
      Height          =   435
      Left            =   3600
      TabIndex        =   2
      ToolTipText     =   "previous legend page"
      Top             =   180
      Width           =   315
   End
   Begin VB.CommandButton Command1
      Caption         =   "Progress walk‑trough"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0 'False
         Italic          =   0 'False
         Strikethrough   =   0 'False
      EndProperty
      Height          =   435
      Left            =   420
      TabIndex        =   1
      Top             =   180
      Width           =   2655
   End
   Begin VB.PictureBox GFColorSliderPicture
      BackColor       =   &H00000000&
      BorderStyle     =   0 'Kein
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0 'False
         Italic          =   0 'False
         Strikethrough   =   0 'False
      EndProperty
      Height          =   195
      Left            =   392
      ScaleHeight     =   195
      ScaleWidth      =   3855
      TabIndex        =   0
      Top             =   784
      Width           =   3855
   End
End
Attribute VB_Name = "Testfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)2001, 2003, 2004 by Louis.
'
'Downloaded from www.louis‑coder.com.
'The GFColorSlider makes a cool looking progress bar out of a picture box.
'It is meant to display mainly drive accessing progresses.
'Sample implementation: Toricxs (www.toricxs.com).
'Uses GFColormod, containing useful functions to deal with colors
'(brightness & contrast change, mix colors, inverse RGB()).
'
'DEBUG
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'DEBUG
Dim X As New GFColorSlidercls
'GFColorSLider
Dim GFColorSliderPaletteCurrent As Integer

Private Sub Command1_Click()
    'on error resume next
    Dim Temp As Long
    'NOTE: Testfrm's ForeColor must NOT be a 'Windows‑color'.
    X.EffectsEnabled = True
    Call X.GFColorSlider_Reset(GFColorSliderPicture)
    Call X.GFColorSliderArea_Add(1, RGB(200, 0, 0), 0, "c:\")
    Call X.GFColorSliderArea_Add(2, RGB(0, 200, 0), 0, "\\CLIENT\C\")
    Call X.GFColorSliderArea_Add(3, RGB(150, 150, 0), 0, "\\CLIENT\D\")
    Call X.GFColorSliderArea_Add(4, RGB(0, 150, 150), 0, "\\SERVER\C\")
    Call X.GFColorSliderArea_Add(5, RGB(150, 0, 150), 0, "\\SERVER\D\")
    Call X.GFColorSlider_Verify
    Call X.GFColorSliderFrame_SetColor(RGB(128, 128, 128), RGB(96, 96, 96))
    Call X.GFColorSlider_ShowProgress(GFColorSliderPicture, 0)
    Call X.GFColorSlider_ShowAreaLegend(Testfrm, 10, 85, Testfrm.ScaleWidth ‑ 10, Testfrm.ScaleHeight ‑ 85, GFColorSliderPaletteCurrent, 1)
    Debug.Print "START"
    For Temp = 3000 To 1 Step (‑1) 'speed & bug test
        'Call Sleep(100)
        Call X.GFColorSlider_ShowProgress(GFColorSliderPicture, CSng(Temp / 30!))
        'DoEvents
    Next Temp
    Debug.Print "END"
End Sub

Public Sub GFColorSliderNextPaletteCommand_Click()
    'on error resume next
    GFColorSliderPaletteCurrent = GFColorSliderPaletteCurrent + 1
    Call X.GFColorSlider_ShowAreaLegend(Testfrm, 10, 85, Testfrm.ScaleWidth ‑ 10, Testfrm.ScaleHeight ‑ 85, GFColorSliderPaletteCurrent, 1)
End Sub

Public Sub GFColorSliderPreviousPaletteCommand_Click()
    'on error resume next
    GFColorSliderPaletteCurrent = GFColorSliderPaletteCurrent ‑ 1
    Call X.GFColorSlider_ShowAreaLegend(Testfrm, 10, 85, Testfrm.ScaleWidth ‑ 10, Testfrm.ScaleHeight ‑ 85, GFColorSliderPaletteCurrent, 1)
End Sub


[END OF FILE]