复件 frmshow.frm

一款漂亮的控件。 快

VERSION 5.00
Begin VB.Form frmShow 
   Caption         =   "渐变色彩展示"
   ClientHeight    =   3015
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4905
   Icon            =   "frmShow.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   ScaleHeight     =   3015
   ScaleWidth      =   4905
   StartUpPosition =   3  '窗口缺省
   Begin VB.HScrollBar hsDn 
      Height          =   255
      Index           =   2
      Left            =   3240
      TabIndex        =   12
      Top             =   2640
      Width           =   1575
   End
   Begin VB.HScrollBar hsDn 
      Height          =   255
      Index           =   1
      Left            =   3240
      TabIndex        =   10
      Top             =   2280
      Width           =   1575
   End
   Begin VB.HScrollBar hsDn 
      Height          =   255
      Index           =   0
      Left            =   3240
      TabIndex        =   8
      Top             =   1920
      Width           =   1575
   End
   Begin VB.HScrollBar hsUp 
      Height          =   255
      Index           =   2
      Left            =   3240
      TabIndex        =   6
      Top             =   1200
      Width           =   1575
   End
   Begin VB.HScrollBar hsUp 
      Height          =   255
      Index           =   1
      Left            =   3240
      TabIndex        =   4
      Top             =   840
      Width           =   1575
   End
   Begin VB.HScrollBar hsUp 
      Height          =   255
      Index           =   0
      Left            =   3240
      TabIndex        =   2
      Top             =   480
      Width           =   1575
   End
   Begin VB.PictureBox picShow 
      AutoRedraw      =   -1  'True
      Height          =   2775
      Left            =   120
      ScaleHeight     =   181
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   157
      TabIndex        =   0
      Top             =   120
      Width           =   2415
   End
   Begin VB.Shape ShpDn 
      Height          =   255
      Left            =   2640
      Top             =   1560
      Width           =   2175
   End
   Begin VB.Shape shpUp 
      Height          =   255
      Left            =   2640
      Top             =   120
      Width           =   2175
   End
   Begin VB.Label labDn 
      AutoSize        =   -1  'True
      Caption         =   "B : "
      Height          =   180
      Index           =   2
      Left            =   2640
      TabIndex        =   11
      Top             =   2670
      Width           =   255
   End
   Begin VB.Label labDn 
      AutoSize        =   -1  'True
      Caption         =   "G : "
      Height          =   180
      Index           =   1
      Left            =   2640
      TabIndex        =   9
      Top             =   2310
      Width           =   255
   End
   Begin VB.Label labDn 
      AutoSize        =   -1  'True
      Caption         =   "R : "
      Height          =   180
      Index           =   0
      Left            =   2640
      TabIndex        =   7
      Top             =   1950
      Width           =   255
   End
   Begin VB.Label labUp 
      AutoSize        =   -1  'True
      Caption         =   "B : "
      Height          =   180
      Index           =   2
      Left            =   2640
      TabIndex        =   5
      Top             =   1230
      Width           =   255
   End
   Begin VB.Label labUp 
      AutoSize        =   -1  'True
      Caption         =   "G : "
      Height          =   180
      Index           =   1
      Left            =   2640
      TabIndex        =   3
      Top             =   870
      Width           =   255
   End
   Begin VB.Label labUp 
      AutoSize        =   -1  'True
      Caption         =   "R : "
      Height          =   180
      Index           =   0
      Left            =   2640
      TabIndex        =   1
      Top             =   510
      Width           =   255
   End
End
Attribute VB_Name = "frmShow"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load()
Dim i As Integer
shpUp.FillStyle = 0
ShpDn.FillStyle = 0
For i = 0 To 2
    With hsUp(i)
        .Min = 0
        .Max = 255
        .LargeChange = 10
        .SmallChange = 1
    End With
    With hsDn(i)
        .Min = 0
        .Max = 255
        .LargeChange = 10
        .SmallChange = 1
    End With
Next i
Call PaintColor(picShow, hsUp(0).Value, hsUp(1).Value, hsUp(2).Value, _
                hsDn(0).Value, hsDn(1).Value, hsDn(2).Value)
End Sub

Private Sub hsUp_Change(Index As Integer)
Dim strTemp As String
shpUp.FillColor = RGB(hsUp(0).Value, hsUp(1).Value, hsUp(2).Value)
Select Case Index
    Case 0
        labUp(0).Caption = "R : " & hsUp(0).Value
    Case 1
        labUp(1).Caption = "G : " & hsUp(1).Value
    Case 2
        labUp(2).Caption = "B : " & hsUp(2).Value
End Select
Call PaintColor(picShow, hsUp(0).Value, hsUp(1).Value, hsUp(2).Value, _
                hsDn(0).Value, hsDn(1).Value, hsDn(2).Value)
End Sub

Private Sub hsDn_Change(Index As Integer)
ShpDn.FillColor = RGB(hsDn(0).Value, hsDn(1).Value, hsDn(2).Value)
Select Case Index
    Case 0
        labDn(0).Caption = "R : " & hsDn(0).Value
    Case 1
        labDn(1).Caption = "G : " & hsDn(1).Value
    Case 2
        labDn(2).Caption = "B : " & hsDn(2).Value
End Select
Call PaintColor(picShow, hsUp(0).Value, hsUp(1).Value, hsUp(2).Value, _
                hsDn(0).Value, hsDn(1).Value, hsDn(2).Value)
End Sub

Sub PaintColor(objName As Object, sigRedUp As Single, sigGreenUp As Single, sigBlueUp As Single, _
               sigRedDn As Single, sigGreenDn As Single, sigBlueDn As Single)
On Error Resume Next
Dim objHeight As Single
Dim RedInfo As Single, GreenInfo As Single, BlueInfo As Single
Dim Red As Single, Green As Single, Blue As Single
objHeight = objName.ScaleHeight
RedInfo = (sigRedDn - sigRedUp) / objHeight
GreenInfo = (sigGreenDn - sigGreenUp) / objHeight
BlueInfo = (sigBlueDn - sigBlueUp) / objHeight
For i = 0 To objHeight - 1
    Red = sigRedUp + i * RedInfo
    Green = sigGreenUp + i * GreenInfo
    Blue = sigBlueUp + i * BlueInfo
    objName.ForeColor = RGB(Red, Green, Blue)
    objName.Line (0, i)-(objName.ScaleWidth - 1, i)
Next i
End Sub

Private Sub labDn_Click(Index As Integer)

End Sub