Farvevælger i Photoshop

Hmm, hvad er spørgsmålet ? Du fortæller blot, hvad du vil lave i teksten ?

Hmm, jeg vil gerne lave den der farvevælger, som også er i PS, jeg ved ikke hvordan jeg laver det farvespektre der vha. en løkke.

For X = 1 To 300
For Y = 1 To 300
Picture1.PSet (X, Y), rgb()
Next
Next

Jeg har jo ovenstående løkke, som udfylder hele Picture1, men jeg ved ikke hvordan jeg tegner det farvespektre som passer til samme indstillinger i PS...

Smid en commondialog (Commondialog1) og en command (Command1) på en form.
Du har sikekrt ikke ikke en commondialog på din toolbox, så tast Ctrl+T og hak af i Microsoft CommonDialog control 6.0 (eller hvilket nummer den nu har)

copy-paste følgende kode, og se om det er det du vil...

Private Sub Command1_Click()
  CommonDialog1.Flags = cdlCCFullOpen Or cdlCCPreventFullOpen
  CommonDialog1.ShowColor
  MsgBox "Du valgte farven " & CommonDialog1.Color
End Sub

martin, der kommer jo bare den der popup, som ikke er den samme som i PS, jeg vil lave så den ligner den samme som i PS, den behøver ikke virke, så man kan klikke på den og få en farve, den skal bare vises, sådan set..

<ole>

Du kan åbenbart selv hitte ud af at hente farven, så her er to pictureboxe med AutoRedraw=true. Pictue1 er 255x255px og Picture2 er 20x255px (ca. som Photoshop):

-------------------------------

Option Explicit

Private rgbA(3) As Variant

Private Sub hsb2rgb(hue As Integer, saturation As Integer, brightness As Integer)
    Dim map(6) As Variant
    Dim I As Integer
    Dim min As Integer
    Dim max As Integer
    Dim color As Integer
   
    map(0) = Array("1", "+", "0")
    map(1) = Array("-", "1", "0")
    map(2) = Array("0", "1", "+")
    map(3) = Array("0", "-", "1")
    map(4) = Array("+", "0", "1")
    map(5) = Array("1", "0", "-")
   
    hue = hue Mod 360
   
    I = Int(hue / 60)
   
    min = 255 * brightness / 100 * (100 - saturation) / 100
    max = 255 * brightness / 100
   
    For color = 0 To 2
        Select Case map(I)(color)
            Case "0":
                rgbA(color) = min
            Case "1":
                rgbA(color) = max
            Case "+":
                rgbA(color) = min + (hue Mod 60) / 60 * (max - min)
            Case "-":
                rgbA(color) = max - (hue Mod 60) / 60 * (max - min)
        End Select
    Next color
End Sub

Private Sub initColorPicker(R As Integer, G As Integer, B As Integer)
    Dim X As Integer
    Dim Y As Integer
    Dim xR As Single
    Dim xG As Single
    Dim xB As Single
    Dim yR As Single
    Dim yG As Single
    Dim yB As Single
    Dim pR As Integer
    Dim pG As Integer
    Dim pB As Integer
   
    For Y = 0 To 255
        For X = 255 To 0 Step -1
            yR = R - (R / 255) * Y
            yG = G - (G / 255) * Y
            yB = B - (B / 255) * Y
           
            xR = (255 - (yR + Y)) / 255
            xG = (255 - (yG + Y)) / 255
            xB = (255 - (yB + Y)) / 255
   
            pR = yR + (xR * (255 - X))
            pG = yG + (xG * (255 - X))
            pB = yB + (xB * (255 - X))
           
            Picture1.PSet (X, Y), rgb(pR, pG, pB)
        Next X
    Next Y
   
    For Y = 0 To 255
        hsb2rgb 360 - ((360 / 255) * Y), 100, 100
        For X = 0 To 20
            Picture2.PSet (X, Y), rgb(rgbA(0), rgbA(1), rgbA(2))
        Next X
    Next Y
   
    Picture1.Visible = True
    Picture2.Visible = True
End Sub

Private Sub Form_Load()
    Picture1.Visible = False
    Picture2.Visible = False
   
    initColorPicker 255, 0, 0
End Sub

--------------------------------------------------

Koden til at fylde den store palette kan sikkert skrives lidt mere 'sexy'. Jeg orker ikke at skrumpe den nu ... det må du selv sørge for  :)

/mvh
</bole>

olebole, det ser for mig ikke ud til at virke, har tilføjet en ekstra picturebox, men der sker ingenting, hvis jeg skriver nogle tegn, trykker på nogle knapper, der sker faktisk ingenting, hvad gør jeg galt?

Jeg glemte at skrive, at begge picture-boxe skal have sat ScaleMode til 'Pixel'

Kan du ikke sige hvad der skal ske, for der sker seriøst ingenting ligemeget hvad jeg gør..?

Jeg aner ikke, hvad jeg skal fortælle, andet end jeg har skrevet her - men du kan hente et eksempel her:
  http://www.tjenester.dk/x-codes.dk/eksperten/vb_colpick/vb_colpick.zip

Dit script spiller bare, så tilpasser jeg det lige med mit eget, takker mange gange olebole :)

... anytime  ;o)
Det er ikke den fede måde at lave det på - men det var den 'panik-løsning', jeg lige kunne komme op med en sen nattetime  :)

olebole, har du noget imod at forklare mig hvordan nedenstående kode fungerer?

Private Sub ColorPicker(R As Integer, G As Integer, B As Integer)
    Dim X As Integer
    Dim Y As Integer
    Dim xR As Single
    Dim xG As Single
    Dim xB As Single
    Dim yR As Single
    Dim yG As Single
    Dim yB As Single
    Dim pR As Integer
    Dim pG As Integer
    Dim pB As Integer
   
    For Y = 0 To 255
        For X = 255 To 0 Step -1
            yR = R - (R / 255) * Y
            yG = G - (G / 255) * Y
            yB = B - (B / 255) * Y
           
            xR = (255 - (yR + Y)) / 255
            xG = (255 - (yG + Y)) / 255
            xB = (255 - (yB + Y)) / 255
   
            pR = yR + (xR * (255 - X))
            pG = yG + (xG * (255 - X))
            pB = yB + (xB * (255 - X))
           
            Picture1.PSet (X, Y), RGB(pR, pG, pB)
        Next X
    Next Y
   
    For Y = 0 To 255
        hsb2rgb 360 - ((360 / 255) * Y), 100, 100
        For X = 0 To 20
            Picture2.PSet (X, Y), RGB(rgbA(0), rgbA(1), rgbA(2))
        Next X
    Next Y
   
    Picture1.Visible = True
    Picture2.Visible = True
End Sub