طیف رنگ زیبا روی فرم:

 

Private Sub Form_Load()

    Me.DrawWidth = 2

    Me.AutoRedraw = True

    Me.Caption = "Click Me."

End Sub

 

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

    On Error Resume Next

   

    Me.ScaleWidth = 1530

    Me.ScaleHeight = 255

    'Me.Cls

    intAddNum = 1

    intLevel = 1

   

    If Button = vbLeftButton Then

        intColorLevel1 = 255

        intColorLevel2 = 0

        intRGB(1) = 255

        intRGB(2) = 0

        intRGB(3) = 0

        Y = 0

    ElseIf Button = vbRightButton Then

        intColorLevel1 = 255

        intColorLevel2 = 0

        intRGB(1) = 255

        intRGB(2) = 0

        intRGB(3) = 0

        Y = 255

    End If

   

    For Y = 0 To Me.ScaleHeight

        For X = 0 To Me.ScaleWidth

           

            Select Case intLevel

                Case 1:

                    intRGB(2) = intRGB(2) + intAddNum

                    If intRGB(2) >= intColorLevel1 Then intLevel = 2

                Case 2:

                     intRGB(1) = intRGB(1) - intAddNum

                    If intRGB(1) <= intColorLevel2 Then intRGB(1) = Abs(intRGB(1)): intLevel = 3

                Case 3:

                    intRGB(3) = intRGB(3) + intAddNum

                    If intRGB(3) >= intColorLevel1 Then intLevel = 4

                Case 4:

                    intRGB(2) = intRGB(2) - intAddNum

                    If intRGB(2) <= intColorLevel2 Then intRGB(2) = Abs(intRGB(2)): intLevel = 5

                Case 5:

                    intRGB(1) = intRGB(1) + intAddNum

                    If intRGB(1) >= intColorLevel1 Then intLevel = 6

                Case 6:

                    intRGB(3) = intRGB(3) - intAddNum

                    If intRGB(3) <= intColorLevel2 Then intRGB(3) = Abs(intRGB(3))

            End Select

           

            Me.PSet (X, Y), RGB(intRGB(1), intRGB(2), intRGB(3))

           

        Next X

        DoEvents

                                                                             If Button = vbLeftButton Then

            intColorLevel1 = intColorLevel1 - 1

            intAddNum = (intColorLevel1 / 256)

            intRGB(1) = intColorLevel1

            intRGB(2) = 0

            intRGB(3) = 0

        ElseIf Button = vbRightButton Then

            intColorLevel2 = intColorLevel2 + 1

            intAddNum = ((255 - intColorLevel2) / 256)

            intRGB(1) = 255

            intRGB(2) = intColorLevel2

            intRGB(3) = intColorLevel2

        End If

        intLevel = 1

        Me.Caption = CStr((Y * 100) \ Me.ScaleHeight) & "%"

    Next Y

    Me.Caption = "Complated."

End Sub

نوشته شده در تاریخ سه شنبه 17 آذر 1388    | توسط: محمد و مجید َ    |    |
نظرات()