ColorPicker AdobePhotoShop style

Applications, Games, Tools, User libs and useful stuff coded in PureBasic
SiggeSvahn
User
User
Posts: 40
Joined: Wed Oct 06, 2010 9:37 pm

ColorPicker AdobePhotoShop style

Post by SiggeSvahn »

Howdy!
Was so excited over this first attempt that I couldn't wait to post it on the Forum. I was then new to PB. This is a ported version of my even older VisualBasic6 code. Wish you much fun with this. Thanks forum for the error check. I have now adjusted to your suggestions. Code is divided in two posts because of the forums size limit.

Code: Select all

;Welcome to use, improve and share this utility. It gives you more control than the standard PB-colorpicker.
; As you might suspect this code is ported from VisualBasic6.
;Use and improve as you like.
EnableExplicit
;*****************    CONSTANTS   ****************************************

#WIN_WIDTH=492:#WIN_HEIGHT=352
#LMouseButtonDown=32768
#LMouseButtonUp=0
#iHue=0
#iSaturation=1
#iLumination=2
#SC_EVENT_UpKey=5
#SC_EVENT_DownKey=3
#imgColorBoxesY=28
;*************************************************************************
Structure HSL
;Private Type HSL ;IS USED FOR THE HSL FUNCTION FROM THE WEBSITE VBspeed.
    Hue.w; As Integer ;FROM 0 To 360.
    Saturation.w; As Byte
    Luminance.w; As Byte
EndStructure
;**************************************************************************
;                 D E F I N I T I O N S
;Define Float thus a number with decimal (4 bytes) similar to Vb6 datatype "Single".
;Define udtAngelSaturationBrightness.HSL
Define lFlagMainWinExist.l, lEvent.l,lEventType.l,lEventMenu.l, lMouse.l,lngColor.l
Dim arLongMarkerColorStore.l(11, 11)
Global.f mSngRValue, mSngGValue, mSngBValue
Global blnDrag.b, bteSaturationMax255.w, bteBrightnessMax255.w
Global intSystemColorAngleMax1530.f
Global mBlnRecentThinBoxPress.b, mBlnBigBoxReady.b, mBlnCursorRoutineReady.b
Global mLngRValue.l, mLngGValue.l, mLngBValue.l, bChosenOptGadget.b
Global mBlnRecentBigBoxPress.b, Xbox.l, Ybox.l
Global Dim arsPicPath.s(0)

Define RGBToHSL.HSL
Global *HSL.HSL = @RGBToHSL

Enumeration
  #WinColorPicker
  
  #imgBigBox;ImgGadget
  #imgThinBox
  #imgTriangel
  #imgMarker
  
  #BIGBOX_MEDIA;The picture inside the very image gadget.
  #THINBOX_MEDIA
  #TriangelBox_MEDIA
  #imgMarker_MEDIA
    
  #optH
  #optS
  #optLuma
  
  #optR
  #optG
  #optBlue
  
  #optLabL
  #optLABa
  #optLABb
  
  #optImage
  
  #TextH
  #TextS
  #TextBright
  
  #TextR
  #TextG
  #TextBlue
   
  #TextLabL
  #TextLABa
  #TextLABb
  
  #TextHex
  #lblHex
  
  #lblNewColor
  #lblOldColor
  #lblBorder
  #lblPicPath
  #Combo1
EndEnumeration
;*******************************************************************

;PB makes no discrimination between procedures versus "functions".
;The compilator has to scan all the code BEFORE it starts to execute the code fore a trial run.
;If this scan encounters a call to a procedure "further down" then it won't recognise it and will interupt and raise an error.
;An exception to this is if you use the command DECLARE SomeCrappyProcedure().
;In that case you can make jumps to code further down the code listing.
Procedure InStrRev(string$,match$)
  Define pos.b, a.b
  pos=1 : Repeat : a=FindString(string$,match$,pos) : If a<>0 : pos=a+1 : EndIf : Until a=0
  ProcedureReturn pos-1
EndProcedure

;===================================================================
Procedure cmdHelp_Click()
Define sAppPath.s, strPathStripC.s, strFusionPath.s, btePosEndLetter.w, sTest.s
Define bteErrCtr.w, strAppPath.s
Define strAPIpath.s, CSIDL_PERSONAL.w;fill pidl with the specified folder item.
;strAPIpath = Space$(260)
;IT IS PROBLEMATIC IF THE APPLICATION IS CONTAINED IN MyDocuments WHICH IS A FAKE FOLDER PATH - THE REAL FOLDER IS CONTAINED SOMEWHERE IN WINDOWS SYSTEM FOLDER.
;ALSO THE FOLDER MyDocuments MAY BE RENAMED BY THE USER. I THINK THERE IS A FOOL PROOF SOLUTION FOR THIS IN THE NEXT GENERATION VB.
;MY DIRTY SOLUTION IS TO FIRST TRUST THE app.path. IN CASE OF ERROR I RETRY WITH THE WINDOWS FOLDER WHICH PATH WE GET FROM THE SPECIAL API ROUTINE.
OnErrorGoto(?ErrorHandler)
strAppPath = GetCurrentDirectory(); App.Path

If InStrRev(strAppPath, "\") <> Len(strAppPath)
  strAppPath + "\"  ;Good windows-programming-virtue.
EndIf
RunProgram(strAppPath + "ColorpickerHelp\ColorPickerHelp.html")
;Exit

ErrorHandler:
  MessageRequester("MsgBox MsgRequester","There was an error while trying to open the helpfile!")
;k = Err.Number Error 53 = File not found.
;MsgBox "Tries to find the helpfile in windows directory. " & Err.Number & Err.Description
bteErrCtr + 1 ;COUNTING THE NUMBER OF TIMES THAT THE shell-funktion HAS FAILED.
strPathStripC = Mid(strAppPath, 4, Len(strAppPath) - 3)  ;SHOULD GET EITHER THE PATH My documents\ OR Mina dokument\
Select bteErrCtr
    Case 1
;CHECKING THE REAL PATH FOR MYDOCUMENTS
MessageRequester("MsgBox MsgRequester","Failed to find the location for My documents - sending you down to case2! "): bteErrCtr = 2
    Case 2
        MessageRequester("MsgBox MsgRequester","Failed in finding the helpfile ColorpickerHelp.html which should recide in the same folder as the programme ColorPicker. Would you like to browse for it manually?")
EndSelect
;Call Shell("C:\Test\ColorPickerHelp.html")
;App.Path & "\ColorpickerHelp\ColorPickerHelp.html", 0&, 0&, 0&)

EndProcedure
;=======================================================================================
Procedure MoveHexBox()
Define Ctr.l
;MsgBox "Move HexBox"
For Ctr = 336 To 286 Step -1
  ;txtHexColor.Move Ctr, 281, 56, 20
 StringGadget(#TextHex, Ctr, 281, 56, 19, "A5ECA4", #PB_String_UpperCase)
 ;Combo1.Move Ctr + 70, 281, 70 + 336 - Ctr ;Height-property in ComboBoxes is readonly.
ComboBoxGadget(#Combo1, Ctr + 70, 281, 70 + 336 - Ctr,200)
Next Ctr
EndProcedure
;=======================================================================================
Procedure.b ExecuteIniFile();Chooses the latest mode of optRadioButton.
Define bteFileHandle.b, Ctr.b, lTempChosenOptGadget.l, lNumberOfPaths.l
Define lColor.l, strFilename.s, Answer.s, Result.l, sFile.s, strAppPath.s, s.s
;Interna bilder to add to combo box:
AddGadgetItem(#Combo1, -1, "Winterlake.jpg");Combo1.AddItem "Winterlake.jpg"
AddGadgetItem(#Combo1, -1, "50;s Colormap.jpg");Combo1.AddItem "50;s Colormap.jpg"
;To remove from a combo box:
;RemoveGadgetItem(#Gadget, Position); Vb6 Combo1.RemoveItem Index (0 based)

;Opens too read from the ini-file of the form.
If OpenPreferences("ColorPicker.prefs") = #False
  MessageRequester("Welcome", "Welcome to the ColorPicker you FirstTimeUser!" + Chr(13) + "(If not a FirstTimeUser then the Preferences file was lost. I will try to create a new one!")
EndIf
  PreferenceGroup("Window")
  lColor = ReadPreferenceLong ("lColor", 0)
  SetGadgetColor(#lblOldColor,#PB_Gadget_BackColor,lColor)
  lTempChosenOptGadget = ReadPreferenceLong ("lTempChosenOptGadget", #optH)
  lNumberOfPaths = ReadPreferenceLong("lNumberOfPaths", 0)
  
ClosePreferences()


ReDim arsPicPath(lNumberOfPaths)

If lNumberOfPaths = 0
    ReDim arsPicPath(1): arsPicPath(1) = "" ;A flag of the save routine.
Else
    For Ctr = 1 To lNumberOfPaths
      ;Line Input #bteFileHandle, arsPicPath(Ctr): arsPicPath(Ctr) = Mid(arsPicPath(Ctr), 2, Len(arsPicPath(Ctr)) - 2) ;Removing the citation marks - the Trim command wasn;t sufficient.      Line Input #bteFileHandle, arsPicPath(Ctr): arsPicPath(Ctr) = Mid(arsPicPath(Ctr), 2, Len(arsPicPath(Ctr)) - 2) ;Removing the citation marks - the Trim command wasn;t sufficient.
      arsPicPath(ctr)=ReadPreferenceString("arsPicPath"+ Str(Ctr), "Empty")   
      ;Combo1.AddItem Mid(arsPicPath(Ctr), InStrRev(arsPicPath(Ctr), "\") + 1)  ;Extracting the file name from the pathen.
      s=Mid(arsPicPath(Ctr), InStrRev(arsPicPath(Ctr), "\") + 1)
      AddGadgetItem(#Combo1, -1, s);Extracting the file name from the pathen.
    Next Ctr
EndIf

ProcedureReturn lTempChosenOptGadget;bChosenOptGadget = lTempChosenOptGadget;There is a number between #optH and #optImage, Vb6 0-9.
SetGadgetState(lTempChosenOptGadget,#True);TEst
EndProcedure
;===================================================================================
Procedure.l HSLToRGB(intLocalColorAngle.l, Saturation.l, Luminance.l, blnUpdateTextBoxes.b); As Long
Define R.l, G.l, B.l, lMax.l, lMid.l, lMin.l, q.f
lMax = Luminance
lMin = (255 - Saturation) * lMax / 255 ;255 - (Saturation * lMax / 255)
q = (lMax - lMin) / 255

Select intLocalColorAngle
    Case 0 To 255
        lMid = (intLocalColorAngle - 0) * q + lMin
        R = lMax: G = lMid: B = lMin
    Case 256 To 510 ;This period surpasses the node border with one unit - over to gren color. CHECK by F8.
        lMid = -(intLocalColorAngle - 255) * q + lMax ;-(intLocalColorAngle - 256) * q + lMin
        R = lMid: G = lMax: B = lMin
    Case 511 To 765
        lMid = (intLocalColorAngle - 510) * q + lMin
        R = lMin: G = lMax: B = lMid
    Case 766 To 1020
        lMid = -(intLocalColorAngle - 765) * q + lMax
        R = lMin: G = lMid: B = lMax
    Case 1021 To 1275
        lMid = (intLocalColorAngle - 1020) * q + lMin
        R = lMid: G = lMin: B = lMax
    Case 1276 To 1530
        lMid = -(intLocalColorAngle - 1275) * q + lMax
        R = lMax: G = lMin: B = lMid
    Default
        MessageRequester("Msg","Error occured in HSLToRGB. intSystemColorAngleMax1530= " + Str(intLocalColorAngle))
EndSelect

;--- OPTIONAL UPDATE TEXTBOXES ------------------------------------
If blnUpdateTextBoxes = #True  ;Then the calling routine is not any of the complex automatic routines for fading etc.
;Since this is a single time called session I can safely update my system constants and convert my hifgh resolution system constants to textbox dito.
    mSngRValue = R: mSngGValue = G: mSngBValue = B ;Updating the system variables automatically. Perhaps must exclude this to give them protection.

    SetGadgetText(#TextH, Str(Round(intLocalColorAngle / 255 / 6 * 360,#PB_Round_Nearest)));Text1(0) = Round(intLocalColorAngle / 255 / 6 * 360)
    SetGadgetText(#TextS,Str(Round(Saturation / 255 * 100,#PB_Round_Nearest)));Text1(1) = Round(Saturation / 255 * 100)
    SetGadgetText(#TextBright,Str(Round(Luminance / 255 * 100,#PB_Round_Nearest)));Text1(2) = Round(Luminance / 255 * 100)
    SetGadgetText(#TextR,Str(mSngRValue));Text1(3) = mSngRValue
    SetGadgetText(#TextG,Str(mSngGValue));Text1(4) = mSngGValue
    SetGadgetText(#TextBlue, Str(mSngBValue));Text1(5) = mSngBValue
   
    ;txtHexColor = Hex$(mSngRValue * 65536 + mSngGValue * 256 + mSngBValue): txtHexColor.Refresh ;Applies To internetstandard<>VBstandard
    If mSngRValue < 16;&H10 
      ;txtHexColor = Right$("00000" & Hex$(mSngRValue * 65536 + mSngGValue * 256 + mSngBValue), 6) ;Padding with zeroletters to the left.
      SetGadgetText(#TextHex,Right("00000" + Hex(mSngRValue * 65536 + mSngGValue * 256 + mSngBValue), 6))
    Else
      ;txtHexColor = Hex$(mSngRValue * 65536 + mSngGValue * 256 + mSngBValue)
      SetGadgetText(#TextHex,Hex(mSngRValue * 65536 + mSngGValue * 256 + mSngBValue))
    EndIf
    ;txtHexColor.Refresh ;End of the Hexabox routine.
    SetGadgetColor(#lblNewColor,#PB_Gadget_BackColor,RGB(R,G,B));lblNewColor.BackColor = HSLToRGB
    ;UPDATING SYSTEM VARIABLES
    intSystemColorAngleMax1530 = intLocalColorAngle ;Sometimes there is only a mouse Y coordinate that is delivered from the calling routine.
    bteSaturationMax255 = Saturation
    bteBrightnessMax255 = Luminance
  EndIf
ProcedureReturn RGB(R,G,B);HSLToRGB = RGB(R,G,B) ;Delivers lngColor in VB-format.

EndProcedure
;===================================================================================================
Procedure RGBToHSL201(RGBValue.l, bUpdateTextBoxes.b);, RGBToHSL.HSL); As HSL
Define R.l, G.l, B.l
Define lMax.l, lMin.l, lDiff.l, lSum.l
;Define udtAngelSaturationBrightness.HSL
;Define RGBToHSL.HSL

R = Red(RGBValue)
G = Green(RGBValue)
B = Blue(RGBValue)

If R > G
  lMax = R: lMin = G
Else
  lMax = G: lMin = R ;Finds the Superior and inferior components.
EndIf

If B > lMax 
  lMax = B
Else
  If B < lMin
    lMin = B
  EndIf
EndIf

lDiff = lMax - lMin
lSum = lMax + lMin
;Luminance, thus brightness; Adobe photoshop uses the logic that the site VBspeed regards (regarded) As too primitive = superior decides the level of brightness.
*HSL\Luminance = lMax / 255 * 100
;Saturation******
If lMax <> 0;Protecting from the impossible operation of division by zero.
    *HSL\Saturation = 100 * lDiff / lMax ;The logic of Adobe Photoshops is this simple.
Else
    *HSL\Saturation = 0
EndIf
;Hue ************** R is situated at the angel of 360 or zero degrees; G vid 120 degrees; B vid 240 degrees. intSystemColorAngleMax1530
Define q.f;float.
If lDiff = 0
  q = 0
Else
  q = 60 / lDiff ;Protecting from the impossible operation of division by zero.
EndIf
Select lMax
    Case R
        If G < B 
            *HSL\Hue = 360 + q * (G - B)
            intSystemColorAngleMax1530 = (360 + q * (G - B)) * 4.25 ;Converting from degrees to my resolution of detail.
        Else
            *HSL\Hue = q * (G - B)
            intSystemColorAngleMax1530 = (q * (G - B)) * 4.25
        EndIf
    Case G
        *HSL\Hue = 120 + q * (B - R) ; (R - G)
        intSystemColorAngleMax1530 = (120 + q * (B - R)) * 4.25
    Case B
        *HSL\Hue = 240 + q * (R - G)
        intSystemColorAngleMax1530 = (240 + q * (R - G)) * 4.25
EndSelect ;The case of B was missing.
;---- OPTIONAL UPDATING TEXTBOXES! -------------------
If bUpdateTextBoxes = #True 
    ;txtHexColor = Hex$(R * 65536 + G * 256 + B): txtHexColor.Refresh ;Applying To internetstandard<>VBstandard
    If R < 16;&H10 
      ;txtHexColor = Right$("00000" & Hex$(R * 65536 + G * 256 + B), 6) ;Adds letters of zero to the left which is a necessary so called padding.
      SetGadgetText(#TextHex, Right("00000" + Hex(R * 65536 + G * 256 + B), 6))
    Else
      ;txtHexColor = Hex$(R * 65536 + G * 256 + B)
      SetGadgetText(#TextHex,Hex(R * 65536 + G * 256 + B))
    EndIf
    
    ;txtHexColor.Refresh ;End of hexabox routine.
    ;Text1(0) = Round(intSystemColorAngleMax1530 / 1530 * 360)
    SetGadgetText(#TextH,Str(Round((intSystemColorAngleMax1530 / 1530 * 360),#PB_Round_Nearest)))

    If lMax = 0 
        bteSaturationMax255 = 0 ;Protecting from the impossible operation of division by zero.
    Else
        bteSaturationMax255 = 255 * lDiff / lMax
        SetGadgetText(#TextS, Str(*HSL\Saturation)) ;= saturation both 0 To 255 and 0 To 100%.
    EndIf
    bteBrightnessMax255 = lMax: SetGadgetText(#TextBright, Str(*HSL\Luminance)) ;=Brightness both 0 To 255 and 0 To 100%.
EndIf
EndProcedure
;============================================================================================

Procedure PaintMarker(X.l, Y.l)
  Define lColor.l
If StartDrawing(ImageOutput(#BIGBOX_MEDIA))
    lcolor=Point(X,Y)    
    StopDrawing()
 EndIf
; If bteBrightnessMax255 < 200 Then ;White marker if the surroundings are grey.
;     picBigBox.Circle (X, Y), 5, vbWhite
;     Exit Sub
; EndIf
; 
; If Text1(0) < 26 Or Text1(0) > 200 Then ;Shades of blue.
;     If bteSaturationMax255 > 70 Then ; And bteSaturationMax255 < 150 Then ;White marker If the surroundings are grey..
;         picBigBox.Circle (X, Y), 5, vbWhite
;         Exit Sub
;     EndIf
; EndIf
;******* Creating strong contrast color for the circle imgMarker. **************
RGBToHSL201(lcolor,#False);Convert RGB to HSL.
*HSL\Saturation=255;Strong colored marker.
If *HSL\Hue < 180 : *HSL\Hue + 180
 Else
  *HSL\Hue-180;Inverting the Hue
EndIf

If *HSL\Luminance < 128 : *HSL\Luminance =255
 Else
  *HSL\Luminance = 0;Strong Contrast
EndIf

lColor=HSLToRGB(*HSL\Hue ,*HSL\Saturation ,*HSL\Luminance ,#False)
  
If StartDrawing(ImageOutput(#imgMarker_MEDIA))
    Circle(5,5,10,lColor)    
    StopDrawing()
EndIf

ResizeGadget(#imgMarker,X - 5, Y - 5,#PB_Ignore,#PB_Ignore)

EndProcedure


Procedure SplitlblNewColorToRGBboxes() ;Updating the system constants and textboxes regarding to RGB.
  mSngRValue = Red(GetGadgetColor(#lblNewColor, #PB_Gadget_BackColor))
  SetGadgetText(#TextR, Str(mSngRValue))
  mSngGValue = Green(GetGadgetColor(#lblNewColor, #PB_Gadget_BackColor))
  SetGadgetText(#TextG, Str(mSngGValue))
  mSngBValue = Blue(GetGadgetColor(#lblNewColor, #PB_Gadget_BackColor))
  SetGadgetText(#TextBlue, Str(mSngBValue))
EndProcedure
;============================================================================================

Procedure FadeThinBoxToGrey()
Define sng255saturation.f, sngLokalBrightness.f, X.l, Y.l ;, YCtr As Integer
;MessageRequester("","Procedure FadeThinBoxToGrey()");TEst
;*** Starting values *****
sng255saturation = 255: sngLokalBrightness = bteBrightnessMax255

If CreateImage(#THINBOX_MEDIA, 20, 256)
  If StartDrawing(ImageOutput(#THINBOX_MEDIA))

    For Y = 0 To 255 ;Interesting if there would raise an error, thus a leap directly to EndSub.
      ;SetPixelV picThinBox.hDC, X, Y, HSLToRGB(ByVal intSystemColorAngleMax1530, ByVal Round(sng255saturation - sng255saturation * Y / 255), ByVal sngLokalBrightness, False)
      LineXY(0, Y, 19, Y, HSLToRGB(intSystemColorAngleMax1530, Round(sng255saturation - sng255saturation * Y / 255,#PB_Round_Nearest), sngLokalBrightness, #False))      
    Next Y ;Because Y gets to big when the loop has finished.
    StopDrawing() 
  ImageGadget(#imgThinBox, 284, 31, 20, 256, ImageID(#THINBOX_MEDIA))
  EndIf 
EndIf
EndProcedure
;============================================================================================

Procedure FadeThinBoxToBlack()
Define sngR256delToBlack.f, sngG256delToBlack.f, sngB256delToBlack.f
Define R.f, G.f, B.f, lColor.l, X.l, Y.l, sngLokalSaturation.l,sngLokalBrightness.l
;*** Starting values *****
sngLokalSaturation=bteSaturationMax255: sngLokalBrightness = 255


If CreateImage(#THINBOX_MEDIA, 20, 256)
  If StartDrawing(ImageOutput(#THINBOX_MEDIA))
    ;For X = 0 To 19
    
lColor=HSLToRGB(intSystemColorAngleMax1530,sngLokalSaturation,sngLokalBrightness,#False) ;Reads the uppermost pixel MAX LIGHT which is to be faded.
R = Red(lColor)
G = Green(lColor)
B = Blue(lColor)
sngR256delToBlack = R / 255  ;Fractions which leads down to black.
sngG256delToBlack = G / 255
sngB256delToBlack = B / 255
;If blnVertical =#True Then R = Ro: G = Go: B = Bo ;If Vertical line then the original color will be reset For a new round.
For Y = 0 To 255
    LineXY(0, Y, 19, Y, RGB(R, G, B))
    R = R - sngR256delToBlack ;Darkening the shade of one 256th.
    G = G - sngG256delToBlack
    B = B - sngB256delToBlack
Next Y
StopDrawing() 
ImageGadget(#imgThinBox, 284, 31, 20, 256, ImageID(#THINBOX_MEDIA))
EndIf
EndIf
EndProcedure

;============================================================================================
Procedure RainBowBigbox(blnFadeToGrey, blnFadeToBlack) ;Is used by both radiobutton 1 & 2.
Define Ctr.l, blnUpdateTextBoxes.b, bteK4243.l
Define Saturation.f, Luminance.f
Static intNODE.l, YCtr.l, XCtr.l, intRainbowAngle.l
;MessageRequester("","RainBowBigbox")

;There is no risk for getting dull shades since I use the native principal by adding/subtracting values against at constant FF-component.
;The algoritm gives med decimal values which increases the importance for mathematical models for choosing color, not pic.point.
;XCtr = X
If CreateImage(#BIGBOX_MEDIA, 256, 256)
  If StartDrawing(ImageOutput(#BIGBOX_MEDIA))

intRainbowAngle = 0 ;Protects the systemcolorangel

If blnFadeToGrey = #True And blnFadeToBlack = #False
    Saturation = 255
    Luminance = bteBrightnessMax255 ;Starting value fully saturated. Brightness is to be the same for the whole of bigbox.
Else
    Saturation = bteSaturationMax255
    Luminance = 255 ;Fading from fully bright.
EndIf

;For intRainbowAngle = 0 To 1529
bteK4243 = 42 ;Has to alternate between 42 and 43 pixels per colorfield to make even at 256 pixels.
;For intNODE = 0 To 1275 Step 255

XCtr = 0 ;To255
For YCtr = 0 To 255
  Repeat ;X loopen 0 To 255.
    ;1 Red in in direction towards yellow. Green is counting up.
    For Ctr = 1 To bteK4243  ;Has to alternate between 42 and 43 pixels per colorfield to make even at 256 pixels.
      If blnFadeToBlack
        Luminance = 255 - YCtr ;Round(bteBrightnessMax255 - (bteBrightnessMax255 / 255 * YCtr))
       EndIf
       If blnFadeToGrey
         Saturation = 255 - YCtr ;Round(bteSaturationMax255 - (bteSaturationMax255 / 255 * YCtr))
        EndIf
        intRainbowAngle = intNODE + ((254 * (Ctr - 1)) / (bteK4243 - 1)) ;Wonderful solution: this logic about going from zero to the full value (here 254) I have been seeking for a long time.
        ;SetPixelV picBigBox.hDC, XCtr, YCtr, HSLToRGB(ByVal intRainbowAngle, ByVal Saturation, ByVal Luminance, False)
        Plot(XCtr, YCtr, HSLToRGB(intRainbowAngle, Saturation, Luminance, #False))
        XCtr + 1
    Next Ctr ;
    If bteK4243 = 43
      bteK4243 = 42
    Else
      bteK4243 = 43
    EndIf
    intNODE = intNODE + 255 ;Bistabile switch.
  Until XCtr > 254
    intRainbowAngle = 0 ;Painting the last fully red which lies outside the logic.
    ;picBigBox.PSet (XCtr, YCtr), HSLToRGB(ByVal intRainbowAngle, ByVal Saturation, ByVal Luminance, blnUpdateTextBoxes)
    LineXY(XCtr, YCtr,XCtr, YCtr, HSLToRGB(intRainbowAngle, Saturation, Luminance, blnUpdateTextBoxes))
    intNODE = 0: XCtr = 0
  Next YCtr
  StopDrawing() 
  ImageGadget(#imgBigBox, 10, 31, 256, 256, ImageID(#BIGBOX_MEDIA))
EndIf
EndIf
EndProcedure
;============================================================================================
Procedure lblComplementaryColor_Click(Index.b)
;If Text1(0) < 180 Then Text1(0) = Text1(0) + 180 Else Text1(0) = Text1(0) - 180
;Call Text1_LostFocus(0) ;Noll stands for Hue.
EndProcedure
;==========================================================================================

Procedure imgArrowsModeDepending()
 Define bFailure.b, Y.l
  ;PROVA ATT PLUSSA Y MED +28. AdjustingJusterar imgArrows depending on current mode.
Select #True
  Case GetGadgetState(#optH)
    ;TriangelMove(255 - (intSystemColorAngleMax1530 / 1530 * 255)) ;Animating the triangel.
    Y = 255 - (intSystemColorAngleMax1530 / 1530 * 255)
  Case GetGadgetState(#optH+1)
    Y=255 - Val(GetGadgetText(#optH+1)) * 2.55;Animating the triangel.
  Case GetGadgetState(#optH+2)
    Y=255 - Val(GetGadgetText(#optH+2)) * 2.55;Animating the triangel.
  Case GetGadgetState(#optH+3)
    ;TriangelMove(255 - Text1(3))   ;Animating the triangel.
  Y=255 - Val(GetGadgetText(#optH+3))
  Case GetGadgetState(#optImage)
    ;linTriang1Vert.Visible = False: linTriang1Rising.Visible = False: linTriang1Falling.Visible = False ;Top = 255 - (Text1(2) * 2.55) + 28  ;Animating the triangel.
   ResizeGadget(#imgTriangel,0,0,0,0)
  Default
    bFailure=#True
    MessageRequester("Error","No optionGadget is selected in Procedure picBigBox_Colorize()!")
EndSelect

If bFailure=#False
  ResizeGadget(#imgTriangel,#PB_Ignore,Y,#PB_Ignore,#PB_Ignore) 
EndIf

EndProcedure
Procedure Bigbox3D()
Define sngLokalSaturation.f, sngLokalBrightness.f, YRADNOLL.l
Define sngR256delToBlack.f, sngG256delToBlack.f, sngB256delToBlack.f
Define R.f, G.f, B.f, lColor.l, Y.l, X.l
;MessageRequester("","Procedure Bigbox3D()");TEst

sngLokalSaturation = 255: sngLokalBrightness = 255 ;There is a need for intense start color.
;********* Firstly a single fade from saturated to grey on the uppermost row.
If CreateImage(#BIGBOX_MEDIA, 256, 256)
  If StartDrawing(ImageOutput(#BIGBOX_MEDIA))
   Circle(0, 0, 19, RGB(35, 158, 70));Test

    For X = 0 To 255
      ;SetPixelV picBigBox.hDC, X, YRADNOLL, HSLToRGB(ByVal intSystemColorAngleMax1530, ByVal Round(sngLokalSaturation * X / 255), ByVal sngLokalBrightness, False)
      Plot(X, YRADNOLL, HSLToRGB(intSystemColorAngleMax1530, Round(sngLokalSaturation * X / 255,#PB_Round_Nearest), sngLokalBrightness, #False))
         ;StopDrawing()
    Next X ;Resets Y for a new row.

;********* Here will be an FADE TO BLACK for all columns ********

For X = 255 To 0 Step -1
;If blnVertical =#True Then R = Ro: G = Go: B = Bo ; If line is vertical the reset For a new round.
lColor = Point(X, 0) ;Reading the uppermost pixel which is to be faded.
R = Red(lColor)
G = Green(lColor)
B = Blue(lColor)
sngR256delToBlack = R / 255  ;The fraction blocks which lead down to black.
sngG256delToBlack = G / 255
sngB256delToBlack = B / 255
For Y = 0 To 255 ;Interesting if there would raise an error, thus a leap back to EndSub.
    ;objAnyPictureBox.PSet (X, Y), RGB(R, G, B)
    ;SetPixelV picBigBox.hDC, X, Y, RGB(R, G, B) ;Painting with API.
    Plot(X, Y, RGB(R, G, B))
    R = R - sngR256delToBlack ;Darkening the shade one of a 256:th.
    G = G - sngG256delToBlack
    B = B - sngB256delToBlack
Next Y
Y - 1 ;Because that Y gets too big when the loop is completed.
Next X
StopDrawing() 
ImageGadget(#imgBigBox, 10, 31, 256, 256, ImageID(#BIGBOX_MEDIA))
EndIf
EndIf
EndProcedure
;============================================================================================

;============================================================================================
Procedure opt3RedPaintPicBigBox()
Define R.l, G.l, B.l
;Paint the picBigBox
If CreateImage(#BIGBOX_MEDIA, 256, 256)
  If StartDrawing(ImageOutput(#BIGBOX_MEDIA))

R = Val(GetGadgetText(#TextR));Text1(3) ;Red
For B = 255 To 0 Step -1
 For G = 255 To 0 Step -1 ;Interesting if there is an error, thus a jump directly to EndSub.
   ;SetPixelV picBigBox.hDC, B, 255 - G, RGB(R, G, B) ;Painting by API.
   Plot(B, 255 - G, RGB(R, G, B))
 Next G
;G = G - 1 ;Because that G becomes too big when the loop has finishes.
Next B
StopDrawing() 
ImageGadget(#imgBigBox, 10, 31, 256, 256, ImageID(#BIGBOX_MEDIA))
EndIf
EndIf
EndProcedure
;============================================================================================
Procedure opt4GreenPaintPicBigBox()
Define R.l, G.l, B.l
;Paint picBigBox
If CreateImage(#BIGBOX_MEDIA, 256, 256)
  If StartDrawing(ImageOutput(#BIGBOX_MEDIA))
G = Val(GetGadgetText(#TextG));Text1(4) ;Green
For B = 255 To 0 Step -1
 For R = 255 To 0 Step -1 ;Interesting if there is an error, thus a jump directly to EndSub.
   ;SetPixelV picBigBox.hDC, B, 255 - R, RGB(R, G, B) ;Painting by API.
   Plot(B, 255 - R, RGB(R, G, B))
 Next R
R = R - 1 ;Because that R becomes too big when the loop has finishes.
Next B
StopDrawing() 
ImageGadget(#imgBigBox, 10, 31, 256, 256, ImageID(#BIGBOX_MEDIA))
EndIf
EndIf
EndProcedure
;============================================================================================
Procedure opt5BluePaintPicBigBox()
Define R.l, G.l, B.l
;Paint picBigBox
If CreateImage(#BIGBOX_MEDIA, 256, 256)
  If StartDrawing(ImageOutput(#BIGBOX_MEDIA))
B = Val(GetGadgetText(#TextBlue));Text1(5) ;Blue
For R = 255 To 0 Step -1
 For G = 255 To 0 Step -1 ;Interesting if there is an error, thus a jump directly to EndSub.
   ;SetPixelV picBigBox.hDC, R, 255 - G, RGB(R, G, B) ;Ritar medelst API.
   Plot(R, 255 - G, RGB(R, G, B))
 Next G
G = G - 1 ;Because that G becomes too big when the loop has finishes..
Next R
StopDrawing() 
ImageGadget(#imgBigBox, 10, 31, 256, 256, ImageID(#BIGBOX_MEDIA))
EndIf
EndIf
EndProcedure
;============================================================================================

;============================================================================================
Procedure picBigBox_Colorize()
Define blnFadeToGrey.b, R,f, G.f, B.f

;If objOption(9) Then Exit Sub ;IN CASE Option(9) THE bigbox SHALL BE LEFT ALONE.
If GetGadgetState(#optImage)=#False;THEN******************
;*****     ********     **********     **********
Select #True
    Case GetGadgetState(#optH)  ;IN CASE Option(0) WE SHALL FETCH a fully saturated version of color AND MAKE A 3-D FADE.;
        Bigbox3D() ;NEW VERSION
    Case GetGadgetState(#optH+1)
        RainBowBigbox(#False, #True) ;FadeToGrey=False & FadeToBlack=True
    Case GetGadgetState(#optH+2)
        RainBowBigbox(#True, #False) ;FadeToGrey=#True & FadeToBlack=false
    Case GetGadgetState(#optH+3)
        opt3RedPaintPicBigBox()
    Case GetGadgetState(#optH+4)
        opt4GreenPaintPicBigBox()
    Case GetGadgetState(#optH+5)
      opt5BluePaintPicBigBox()
    Default
      MessageRequester("Error","No optionGadget is selected in Procedure picBigBox_Colorize()!")
EndSelect

EndIf
EndProcedure


;============================================================================================
Procedure Text1To9_LostFocus(Index.l);Text1_LostFocus(Index As Integer)
Define lColor.l, s.s;udtAngelSaturationBrightness As HSL, ;Has to take care of intSystemColorAngleMax1530 0 To 1529.
;If mBlnBigBoxReady = False Then Exit Sub ;Even the computers own enters are giving undesired calls To this routine.
    mBlnBigBoxReady = #False ;Gives me fresh coordinates, but only in the RBG-model at this stage.
    ;blnNotFirstTimeMarker = #False ;-"-

;HAVE TO ADD THE FUNCTIONALITY: img.Pilars position is totally dependent of the actual mode.
Select Index
  Case #TextH ;The user adjusted Hue so RGB will be aproximately calculated.
    s=GetGadgetText(#TextH)
    If Val(s) > 360
      MessageRequester ("Colorpicker","An integer between 0 And 360 i required. Closest value inserted!")
      s="360"
      SetGadgetText(#TextH,s) ;Checking both the precense of decimals and numbers greater than 360.
     EndIf
    ;If Text1(0) < 0 Then MsgBox "An integer between 0 and 360 i required. Closest value inserted!", vbCritical, "Color Picker": Text1(0) = 0 ;Checking both the precense of decimals And numbers greater than 360.
    If Val(s) <> Round(Val(s),#PB_Round_Down) 
      MessageRequester ("Colorpicker","An integer between 0 And 360 i required. Closest value inserted!")
      SetGadgetText(#TextH, Str(Round(Val(s),#PB_Round_Down)));Checking both the precense of decimals and numbers greater than 360.
    EndIf
    
      lColor = HSLToRGB(ValF(s) / 360 * 255 * 6, bteSaturationMax255, bteBrightnessMax255, #True)
        ;imgArrows.Top = 255 - (intSystemColorAngleMax1530 / 1530 * 255) + 28 ;Animating imgArrows
   Case #TextS  ;The user adjusted Saturation so RGB will be aproximately calculated.
      s=GetGadgetText(#TextS)
      If Val(s) > 100
        MessageRequester ("Colorpicker","An integer between 0 And 100 is required. Closest value inserted!")
        s="100"
        SetGadgetText(#TextS, s);Checking both the precense of decimals and numbers greater than 360.
      EndIf  
      If Val(s) < 0 
        MessageRequester ("Colorpicker","An integer between 0 And 100 is required. Closest value inserted!")
        s="0"
        SetGadgetText(#TextS, s) ;Checking both the precense of decimals and numbers greater than 360.
      EndIf
      
      lColor = HSLToRGB(intSystemColorAngleMax1530, ValF(s) / 100 * 255, bteBrightnessMax255, #True)
   Case #TextBright  ;The user adjusted Luminance so RGB will be aproximately calculated.
      s=GetGadgetText(#TextBright)
      If Val(s) > 100 
        MessageRequester ("Colorpicker","An integer between 0 And 100 is required. Closest value inserted!")
        s="100"
        SetGadgetText(#TextBright, s);Checking both the precense of decimals and numbers greater than 360.
      EndIf
      If Val(s) < 0 
        MessageRequester ("Colorpicker","An integer between 0 And 100 is required. Closest value inserted!")
        s="0"
        SetGadgetText(#TextBright, s);Checking both the precense of decimals and numbers greater than 360.
      EndIf
         
      lColor = HSLToRGB(intSystemColorAngleMax1530, bteSaturationMax255, ValF(s) / 100 * 255, #True)
  EndSelect


;ByVal RGBValue As Long, ByVal blnUpdateTextBoxes As Boolean
If Index >= #TextR And Index <= #TextBlue;The user adjusted RGB so HSL is To be calculated aproximately.
    lColor = RGB(Val(GetGadgetText(#TextR)), Val(GetGadgetText(#TextG)), Val(GetGadgetText(#TextBlue)))
    ;udtAngelSaturationBrightness = RGBToHSL201(lColor, #True)
    RGBToHSL201(lColor,#True)
EndIf

;Adjust imgArrows depending on modus.
;If objOption(0) Then imgArrows.Top = 255 - (intSystemColorAngleMax1530 / 1530 * 255) + 28 ;Flyttar imgArrows
;If objOption(1) Then imgArrows.Top = 255 - (Text1(1) * 2.55) + 28  ;Flyttar imgArrows
;If objOption(2) Then imgArrows.Top = 255 - (Text1(2) * 2.55) + 28  ;Flyttar imgArrows
imgArrowsModeDepending()

picBigBox_Colorize();(mSngRValue, mSngGValue, mSngBValue);Redrawing BigBox

EndProcedure


Procedure txtHexColor_LostFocus()
;Dim udtAngelSaturationBrightness As HSL, lngColor As Long ;Must take care of intSystemColorAngleMax1530 0 To 1529.
Define sShift.s ;OBS! Must shift RGB into BGR to fit vb-standard.
sShift = GetGadgetText(#TextHex)
sShift = Mid(sShift, 5) + Mid(sShift, 3, 2) + Mid(sShift, 1, 2) ;Shifting RGB to BGR.
;SetGadgetColor(#lblNewColor,#PB_Gadget_BackColor,lColor)
SetGadgetColor(#lblNewColor,#PB_Gadget_BackColor,Val("$" + sShift));lblNewColor.BackColor = ("&H" + sShift) ;OBS! Must shift RGB into BGR to fit vb-standard.
SplitlblNewColorToRGBboxes() ;Automatic update of the RGB textboxes.
Text1To9_LostFocus(3) ;Simulating that the user adjusted the RGBtxtboxes->Total update. 3 means that the RedTextbox has been adjusted.
EndProcedure

;==========================================================================================

Last edited by SiggeSvahn on Sat Jan 11, 2020 7:10 am, edited 4 times in total.
Newbie
c4s
Addict
Addict
Posts: 1981
Joined: Thu Nov 01, 2007 5:37 pm
Location: Germany

Re: ColorPicker AdobePhotoShop style

Post by c4s »

Thank you. I'm certain I'll find a use for this someday.
If any of you native English speakers have any suggestions for the above text, please let me know (via PM). Thanks!
rsts
Addict
Addict
Posts: 2736
Joined: Wed Aug 24, 2005 8:39 am
Location: Southwest OH - USA

Re: ColorPicker AdobePhotoShop style

Post by rsts »

very nice.

thanks for sharing. :D

cheers
User avatar
idle
Always Here
Always Here
Posts: 5042
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: ColorPicker AdobePhotoShop style

Post by idle »

looks good

There's a bug if you choose image option at line 1174.
change to this

Code: Select all

StartDrawing(ImageOutput(#BIGBOX_MEDIA))
   lColor=Point(X, Y)
 StopDrawing()
Windows 11, Manjaro, Raspberry Pi OS
Image
Mistrel
Addict
Addict
Posts: 3415
Joined: Sat Jun 30, 2007 8:04 pm

Re: ColorPicker AdobePhotoShop style

Post by Mistrel »

Looks promising. I hope you learn a lot from porting this. I'd love to add something like this to my code snippets. Also, welcome to the forum. :)
SiggeSvahn
User
User
Posts: 40
Joined: Wed Oct 06, 2010 9:37 pm

Re: ColorPicker AdobePhotoShop style

Post by SiggeSvahn »

Here is the 2:nd part:

Code: Select all


Procedure opt3RedPaintPicThinBox(G.l, B.l)
Define bteX.l, intCtr.l
;Painting picThinBox (19, 255)
If CreateImage(#THINBOX_MEDIA, 20, 256)
  If StartDrawing(ImageOutput(#THINBOX_MEDIA))
For bteX = 0 To 19
 For intCtr = 0 To 255
   ;SetPixelV picThinBox.hDC, bteX, intCtr, RGB(255 - intCtr, G, B) ;Painting with API.
   Plot(bteX,intCtr,RGB(255 - intCtr, G, B))
 Next intCtr
Next bteX
StopDrawing() 
ImageGadget(#imgThinBox, 284, 31, 20, 256, ImageID(#THINBOX_MEDIA))
EndIf
EndIf
EndProcedure
;============================================================================================
Procedure opt4GreenPaintPicThinBox(R.l, B.l)
Define bteX.l, intCtr.l
;Painting picThinBox (19, 255)
If CreateImage(#THINBOX_MEDIA, 20, 256)
  If StartDrawing(ImageOutput(#THINBOX_MEDIA))
For bteX = 0 To 19
 For intCtr = 0 To 255
   Plot(bteX, intCtr, RGB(R, 255 - intCtr, B))
 Next intCtr
Next bteX
StopDrawing() 
ImageGadget(#imgThinBox, 284, 31, 20, 256, ImageID(#THINBOX_MEDIA))
EndIf
EndIf
EndProcedure
;============================================================================================
Procedure opt5BluePaintPicThinBox(R.l, G.l)
Define bteX.l, intCtr.l
;Painting picThinBox (19, 255)
If CreateImage(#THINBOX_MEDIA, 20, 256)
  If StartDrawing(ImageOutput(#THINBOX_MEDIA))
For bteX = 0 To 19
 For intCtr = 0 To 255
   Plot(bteX,intCtr,RGB(R, G, 255 - intCtr))
 Next intCtr
Next bteX
StopDrawing() 
ImageGadget(#imgThinBox, 284, 31, 20, 256, ImageID(#THINBOX_MEDIA))
EndIf
EndIf
EndProcedure
;============================================================================================
Procedure BigBoxOpt3Reaction(X.l, Y.l)
Define lColor.l;,udtAngelSaturationBrightness.HSL
If StartDrawing(ImageOutput(#BIGBOX_MEDIA))
lColor=Point(X,Y)
SetGadgetColor(#lblNewColor,#PB_Gadget_BackColor,lColor);lblNewColor.BackColor = picBigBox.Point(X, Y): lblNewColor.Refresh
SplitlblNewColorToRGBboxes() ;Updating the module global mSngRValue etc.
StopDrawing()
opt3RedPaintPicThinBox(mSngGValue, mSngBValue)
RGBToHSL201(lColor,#True)
Else
  MessageRequester("Error in BigBoxOpt3Reaction", "Failed StartDrawing(ImageOutput(#BIGBOX_MEDIA)")
EndIf

EndProcedure
;============================================================================================
Procedure BigBoxOpt4Reaction(X.l, Y.l)
Define lColor.l
If StartDrawing(ImageOutput(#BIGBOX_MEDIA))
lColor=Point(X,Y)
SetGadgetColor(#lblNewColor,#PB_Gadget_BackColor,lColor);lblNewColor.BackColor = picBigBox.Point(X, Y): lblNewColor.Refresh
SplitlblNewColorToRGBboxes() ;Updating the module global mSngRValue etc.
StopDrawing()
opt4GreenPaintPicThinBox(mSngRValue, mSngBValue)
RGBToHSL201(lColor,#True)
Else
  MessageRequester("Error in BigBoxOpt4Reaction", "Failed StartDrawing(ImageOutput(#BIGBOX_MEDIA)")
EndIf

EndProcedure
;============================================================================================
Procedure BigBoxOpt5Reaction(X.l, Y.l)
Define lColor.l
If StartDrawing(ImageOutput(#BIGBOX_MEDIA))
lColor=Point(X,Y)
SetGadgetColor(#lblNewColor,#PB_Gadget_BackColor,lColor);lblNewColor.BackColor = picBigBox.Point(X, Y): lblNewColor.Refresh
SplitlblNewColorToRGBboxes() ;Updating the module global mSngRValue etc.
StopDrawing()
opt5BluePaintPicThinBox(mSngRValue, mSngGValue)
RGBToHSL201(lColor,#True)
Else
  MessageRequester("Error in BigBoxOpt5Reaction", "Failed StartDrawing(ImageOutput(#BIGBOX_MEDIA)")
EndIf
EndProcedure

Procedure RainBowThinBox() ;By swapping the XY-vvalues at the call you can paint either horisontal or vertical.
Define Ctr.l, blnUpdateTextBoxes.b, bteK4243.l
Define blnHorizontal.b, Saturation.l, Luminance.w
Static intNODE.l, YCtr.l, XCtr.l, intRainbowAngle.l
;There is no risk for getting dull shades since I use the native principal by adding/subtracting values against at constant FF-component.
;The algoritm gives med decimal values which increases the importance for mathematical models for choosing color, not pic.point.
;MessageRequester("","Procedure RainBowThinBox()")

intRainbowAngle = 0 ;Protecting systemcolorangel
Saturation = 255: Luminance = 255 ;Fully shining colors.
;If blnFadeToGrey =#True And blnFadeToBlack = False Then Saturation = 255: Luminance = bteBrightnessMax255 ;Starting value is full saturation. Brightness is To be the same For the whole bigbox.
;Horizontal or vertical kan be chosen by intKoordSuperior/intKoordInferior.
YCtr = 255;: If XCtr = YCtr Then blnHorizontal =#True

;For intRainbowAngle = 0 To 1529
bteK4243 = 42 ;Has to alternate between 42 and 43 pixels per colorfield to make even at 256 pixels.
;For intNODE = 0 To 1275 Step 255

;ImageGadget(#imgThinBox, 284, 31, 20, 256, #PB_Image_Border)

If CreateImage(#THINBOX_MEDIA, 20, 256)
  If StartDrawing(ImageOutput(#THINBOX_MEDIA))
   Circle(0, 0, 19, RGB(35, 158, 70));Test
;Vertical
    Repeat ;Y loopen 255 To 0.
      ;1 Red in in direction towards yellow. Green is counting up.
        For Ctr = 1 To bteK4243  ;Has to alternate between 42 and 43 pixels per colorfield to make even at 256 pixels.
         intRainbowAngle = intNODE + ((254 * (Ctr - 1)) / (bteK4243 - 1)) ;Wonderful solution: this logic about going from zero to the full value (here 254) I have been seeking for a long time.
         LineXY(0, YCtr, 19, Yctr, HSLToRGB(intRainbowAngle, Saturation, Luminance, blnUpdateTextBoxes))
         YCtr = YCtr - 1
       Next Ctr ;
       If bteK4243 = 43
         bteK4243 = 42
       Else
         bteK4243 = 43
       EndIf
      intNODE = intNODE + 255 ;Bistabile switch.
    Until YCtr < 1
      
  intRainbowAngle = 0 ;Painting the last fully red which is outside the logic of the routine.
  LineXY(0, YCtr, 19, Yctr, HSLToRGB(intRainbowAngle, Saturation, Luminance, blnUpdateTextBoxes))
  StopDrawing()      
  intNODE = 0: YCtr = 255
 StopDrawing() 
 ImageGadget(#imgThinBox, 284, 31, 20, 256, ImageID(#THINBOX_MEDIA))
Else
  MessageRequester("Error","StartDrawing(ImageOutput(#THINBOX_MEDIA))")
EndIf
Else
  MessageRequester("Error","CreateImage(#THINBOX_MEDIA, ,20 256)")
EndIf
EndProcedure
;============================================================================================
 Procedure PaintThinBox(Index.b)
Define blnFadeToGrey.b, blnFadeToBlack.b

Select  Index
    Case #iHue  ;MsgBox "Hue"
        ;Call RainBowSurface(objAnyPictureBox, ,20 blnFadeToGrey, blnFadeToBlack)
        RainBowThinBox()
    Case #iSaturation
        ;MsgBox "Saturation" ;ColorAngle is now horizontal from left To right. Textboxes are important.
         FadeThinBoxToGrey()
    Case #iLumination; "Brightness"
        ;Crucial to give the thin box maximum lightness as a starting point for the lightness fade.
        ;picThinBox.BackColor = HSLToRGB(ByVal intSystemColorAngleMax1530, ByVal bteSaturationMax255, ByVal 255, False) ;Delivers a lighter shade of the active color. ;Setting the whole square For easy fading.
        SetGadgetColor(#imgThinBox,#PB_Gadget_BackColor,HSLToRGB(intSystemColorAngleMax1530, bteSaturationMax255, 255, #False))
        FadeThinBoxToBlack()
EndSelect
;ImageGadget(#imgThinBox, 284, 31, ,20 256, #PB_Image_Border);picThinBox.Visible =#True
EndProcedure

;============================================================================================
Procedure objOption_Click(Index.i) ;Choosing modus.
Define Ctr.i
If Index <> #optImage And GadgetX(#TextHex) = 286  ; Restore HexBox & Combo1.
  ;lblPicPath.Visible = False: cmdBrowse.Enabled = False: Combo1.Enabled = False
  TextGadget(#lblPicPath, 0, 0, 0, 1,"")
  ;MsgBox "Move HexBox"
  For Ctr = 286 To 336
    StringGadget(#TextHex, Ctr, 281, 56, 20,"")
    ;Combo1.Move Ctr + 70, 281, 70 + 336 - Ctr ;Height-property in ComboBoxes is readonly.
    ComboBoxGadget(#Combo1, Ctr + 70, 281, 70 + 336 - Ctr,20)
  Next Ctr
;DoEvents ;Problems with visual jam.
EndIf

Select Index
    Case #optH  ;MsgBox "Hue"
        ;picThinBox.Visible =#True
        PaintThinBox(#iHue)
        picBigBox_Colorize()
    Case #optS
        ;picThinBox.Visible =#True
        PaintThinBox(#iSaturation)
        picBigBox_Colorize ();Speciell design.
    Case #optLuma  ; "Brightness"
        ;MsgBox "Saturation" ;cOLOR ANGEL IS NOW HORIZONTAL FROM LEFT To RIGHT. TEXTBOXES ARE NOW IMPORTANT.
        ;picThinBox.Visible =#True
        PaintThinBox(#iLumination)
        picBigBox_Colorize() ;Speciell design.
    Case #optR ; "R"
        opt3RedPaintPicThinBox(Val(GetGadgetText(#TextG)),Val(GetGadgetText(#TextBlue))) ;(Text1(4), Text1(5))
        picBigBox_Colorize() ;Special design.
    Case #optG ; "G"
        ;Call PaintMarker(mBteMarkerOldX, mBteMarkerOldY) ;Repainting the Marker again (If there is any).
        opt4GreenPaintPicThinBox(Val(GetGadgetText(#TextR)),Val(GetGadgetText(#TextBlue)));(Text1(3), Text1(5))
        picBigBox_Colorize() ;Special design.
    Case #optBlue ; "B"
        ;Call PaintMarker(mBteMarkerOldX, mBteMarkerOldY) ;Repainting the Marker again (If there is any).
        opt5BluePaintPicThinBox(Val(GetGadgetText(#TextR)), Val(GetGadgetText(#TextG)))
        picBigBox_Colorize() ;Speciell design.
    Case #optImage ; "PictureBrowse"
        ;ImageGadget(#imgThinBox, 284, 31, 0, 256, #PB_Image_Border)
        MessageRequester("Test","Hiding imgThinBox")
        ;lblPicPath.Visible = #True: cmdBrowse.Enabled =#True: Combo1.Enabled =#True
        TextGadget(#lblPicPath,13, #WIN_HEIGHT-24, 133, 14, "Path to pictures.")
        MoveHexBox()
    Default
        MessageRequester("Error", "This version does not yet support the OptionGadget nr " + Str(Index) + " but I have no support yet for that one!")    
 EndSelect

 ;imgArrowsModeDepending() ;MOVING imgArrows
EndProcedure
;============================================================================================
Procedure SplitToRGBboxes(): ;ALSO THE SYSTEM CONSTANTS OF RGB GETS UPDATED.
  
  Define lC.l
lC=GetGadgetColor(#lblNewColor, #PB_Gadget_BackColor)
mLngRValue = Red(lC):SetGadgetText(#TextR,Str(mLngRValue))
mLngGValue = Green(lC):SetGadgetText(#TextG,Str(mLngGValue))
mLngBValue = Blue(lC):SetGadgetText(#TextBlue,Str(mLngBValue))
EndProcedure
;============================================================================================

;           PROCEDURE  FORM LOAD
;
;***********                             *****************
;
Procedure Form_Load()
  ;***** DEFINITIONS  *********************************
  Define x.w, y,w, lWinID.l, lC.l,lImgBoxID.l,lTriangelBoxID
;ReDim Preserve arsPicPath(1) ;arsPicPath NEEDS A FIRST INITIALISATION To ENABLE THE USE OF Ubound LATER.

Define Ctr.l, bteExtraWidth.l, bteExtraHeight.l
;STYLING THE FORM. STRANGELY FAILED TO SWITCH THE SCALEMODE TO PIXLES. 1 pixel=20 twips.

mBlnRecentThinBoxPress = #True ;TO GET RID OF GREY SQUARES IN THE PICTURE.
mBlnCursorRoutineReady = #True ;USED TO AVOID RECURSION CAUSING WHITE CIRCLES IN THE BIGBOX.
;*************                        ***********
;****************                 ***************

;****** SKAPAR MainForm ***** frmColorPicker.ScaleMode = vbPixels ;RESEMBLING PIXELS.
;frmColorPicker.Width = 7380
;frmColorPicker.Height = 5280

lWinID = OpenWindow(#WinColorPicker, 0, 0, #WIN_WIDTH, #WIN_HEIGHT, "ColorPicker Beta by SiggeSvahn")
SmartWindowRefresh(#WinColorPicker,#True);Taking care perhaps of some flicker problems when I.m moving gadgets.
; TEST lImgBoxID=CreateImage(#imgBigBox, 255, 255)
lImgBoxID=ImageGadget(#imgBigBox,#PB_Ignore,#PB_Ignore, 256, 256,0,#PB_Image_Border)

;*********** Skapar stora imgBoxen ***********
If OpenWindow(#WinColorPicker, 0, 0, #WIN_WIDTH, #WIN_HEIGHT, "ColorPicker Beta by SiggeSvahn", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  If CreateImage(#BIGBOX_MEDIA, 256, 256)
    If StartDrawing(ImageOutput(#BIGBOX_MEDIA))
      For x = 0 To 255
        For y = 0 To 255
          Plot(x, y, RGB(Random(255), Random(255), Random(255)))
        Next y
      Next x
      StopDrawing() 
      ImageGadget(#imgBigBox, 10, 31, 256, 256, ImageID(#BIGBOX_MEDIA))
    EndIf
   EndIf
 EndIf
 
 ;*********** Create #imgMarker ******************
 
If CreateImage(#imgMarker_MEDIA, 10, 10)
  If StartDrawing(ImageOutput(#imgMarker_MEDIA))
    Circle(10,31,10,RGB(256,256,256))
    ImageGadget(#imgMarker, 284, 31, 20, 256,#PB_Ignore, #PB_Image_Border)
    StopDrawing()
  EndIf
EndIf
     ;picThinBox.Move 284, 31, 19 + bteExtraWidth, 256 + bteExtraHeight ;FRAMES ARE 4 UNITS BROAD. CURIOSITY FACT IS THAT TEH FRAMES OF ALL VBCONTROLS EXCEPT FOR forms ARE MEASURED FROM THE FRAME CENTER, SO YOU ACTUALLY GET HALF THE WIDTH, BUT IT WORKS SINCE VB USE THE SAME LOGIC ALL THE WAY.
ImageGadget(#imgThinBox, 284, 31, 20, 256,#PB_Ignore, #PB_Image_Border)
GadgetToolTip(#imgThinBox,"imgThinBox")
;************** T E S T IMAGE of Random Spots ************************
If CreateImage(#THINBOX_MEDIA, 20, 256)
  If StartDrawing(ImageOutput(#THINBOX_MEDIA))
      For x = 0 To 19
        For y = 0 To 255
          Plot(x, y, RGB(Random(255), Random(255), Random(255)))
        Next y
      Next x
      StopDrawing()
      ImageGadget(#imgThinBox, 284, 31, 20, 256, ImageID(#THINBOX_MEDIA))
  EndIf
EndIf
   
 
;********* Skapar chbPREVIEW *****************
;chbPreview.Move 13, 299, 103, 15 ;Left,Top,Width,Height.
;chbPreview.Visible = False ;HIDES IT IN THIS BETAVERSION CAUSE IT DOESN;T YET HAVE A PURPOSE.
;imgMarker.Visible = False ;HIDING TO IMPROVE THE LOOKS.

;********* Skapar RadioKnappar ***************
For Ctr = 0 To 2
  ;objOption(Ctr).Move 320, 120 + Ctr * 25, 33, 17
  OptionGadget(#optH+Ctr, 320, 120 + Ctr * 25, 33, 17, Mid("HSL",ctr+1,1))
  GadgetToolTip(#optH+Ctr,StringField("Hue, Saturation, Brightness",ctr+1,","))
Next Ctr

For Ctr = 3 To 5
    ;objOption(Ctr).Move 320, 198 + (Ctr - 3) * 26, 33, 17
    OptionGadget(#optH+Ctr, 320, 198 + (Ctr - 3) * 26, 33, 17, Mid("RGB",ctr-2,1))
    GadgetToolTip(#optH+Ctr,StringField("Red, Green, Blue",ctr-2,","))
Next Ctr

For Ctr = 6 To 8
    ;objOption(Ctr).Move 407, 120 + (Ctr - 6) * 25, 25, 17
    OptionGadget(#optH+Ctr, 407, 120 + (Ctr - 6) * 25, 25, 17, Mid("Lab",ctr-5,1))
    GadgetToolTip(#optH+Ctr,StringField("LabColors L, LabColors a, LabColors b",ctr-5,","))
Next Ctr
  OptionGadget(#optImage, 413, 205, 55, 17, "Image")
  GadgetToolTip(#optImage,"Choose color from any picture!")
;*****************  Skapar TextBoxar  ***************
For Ctr = 0 To 2
  ;Text1(Ctr).Move 351, 117 + Ctr * 25, 30, 21
   StringGadget(#TextH+Ctr, 354, 120 + Ctr * 25, 30, 20,"",#PB_String_Numeric)
Next Ctr   
For Ctr = 3 To 5
   ;Text1(Ctr).Move 350, 196 + (Ctr - 3) * 26, 30, 21
   StringGadget(#TextH+Ctr, 354, 196 + (Ctr-3) * 26, 30, 20,"",#PB_String_Numeric)
Next Ctr
For Ctr = 6 To 8
  ;Text1(Ctr).Move 437, 117 + (Ctr - 6) * 26, 34, 21
  StringGadget(#TextH+Ctr, 437, 117 + (Ctr-6) * 26, 34, 20,"",#PB_String_Numeric)
Next Ctr
;*************    ************    ************************************
    ;txtHexColor.Move 336, 281, 56, 19
    StringGadget(#TextHex, 336, 281, 56, 19, "A5ECA4", #PB_String_UpperCase)
    GadgetToolTip(#TextHex,"Color in hexadecimal format")
;********** Skapar lilla eticketten med brädgårdstecknet!  ********
    ;Label1.Move 319, 283, 13, 14 ;tecknet #
    TextGadget(#lblHex, 319, 283, 13, 14, "#")

;********** Skapar lblNewColor respektive lblOldColor samt desras gemensamma container med en vacker ram. ****
    TextGadget(#lblNewColor, 322, 33, 58, 33,"");lblNewColor.Move 322, 33, 58, 33
    SetGadgetColor(#lblNewColor,#PB_Gadget_BackColor,$00FFFF)
    GadgetToolTip(#lblNewColor,"NewColor")
    TextGadget(#lblOldColor, 322, 66, 58, 33,"");lblOldColor.Move 322, 66, 58, 33
    SetGadgetColor(#lblOldColor,#PB_Gadget_BackColor,$000000)
    GadgetToolTip(#lblOldColor,"OldColor. Click to reset!")
    ;lblContainer.Move 321, 32, 60, 68
    TextGadget(#lblBorder, 321, 32, 60, 68, "TextGadget Border", #PB_Text_Border)
    ;****lblOldColor.BackColor = lblNewColor.BackColor ;STARTS AT THE SAME COLOR.
    

; linTriang1Vert.X1 = 277: linTriang1Vert.X2 = 277: linTriang1Vert.Y1 = 251: linTriang1Vert.Y2 = 261
; linTriang1Rising.X1 = 277: linTriang1Rising.X2 = 283: linTriang1Rising.Y1 = 261: linTriang1Rising.Y2 = 256
; linTriang1Falling.X1 = 277: linTriang1Falling.X2 = 283: linTriang1Falling.Y1 = 251: linTriang1Falling.Y2 = 256

lTriangelBoxID=ImageGadget(#imgTriangel,270,251, 13, 13,0,#PB_Image_Border)
GadgetToolTip(#imgTriangel,"imgTriangel")
If CreateImage(#TriangelBox_MEDIA, 13, 13)
    If StartDrawing(ImageOutput(#TriangelBox_MEDIA))
      ;The next 2D drawing commands draw a triangle
      ;FillArea(27, 27, $FFFFFF, $FFFFFF)
      LineXY(0, 0, 0, 13, $FFFFFF);Vertikal linje.
      LineXY(0, 13, 13, 6, $FFFFFF);Stigande linje
      LineXY(0, 0, 13, 6, $FFFFFF);Fallande linje
      
      StopDrawing()
      ImageGadget(#imgTriangel,270,251, 13, 13, ImageID(#TriangelBox_MEDIA))
    EndIf
EndIf
; linTriang2Vert.X1 = 314: linTriang2Vert.X2 = 314: linTriang2Vert.Y1 = 251: linTriang2Vert.Y2 = 261
; linTriang2Rising.X1 = 309: linTriang2Rising.X2 = 314: linTriang2Rising.Y2 = 261: linTriang2Rising.Y1 = 256
; linTriang2Falling.X1 = 309: linTriang2Falling.X2 = 314: linTriang2Falling.Y2 = 251: linTriang2Falling.Y1 = 256

TextGadget(#lblPicPath,13, #WIN_HEIGHT-24, 133, 14, "Path to pictures.");lblPicPath.Left = 13: lblPicPath.Width = 460
GadgetToolTip(#lblPicPath,"Path to pictures.")

ComboBoxGadget(#Combo1, 406, 279, 69, 21,#PB_ComboBox_Editable);, Börja med ICKE #PB_ComboBox_Editable)
AddGadgetItem(#Combo1, -1, "ComboBox editable...")
GadgetToolTip(#Combo1,"Choose a picture!")

;objOption(0) =#True ;STATES Hue As Default. ***ATT!!!!!  THIS BOOTS THE CLICK ROUTINE To DECORATE ThinBox And BigBox.
lC=GetGadgetColor(#lblNewColor, #PB_Gadget_BackColor)
SplitToRGBboxes();ALSO THE SYSTEM CONSTANTS OF RGB GETS UPDATED.


RGBToHSL201(lC, #True) ;TRUE MEANS THAT HSL IS UPDATING BOTH THE textboxes AND THE systemConstants.

EndProcedure
;============================================================================================
Procedure picBigBox_MouseMove(X.l, Y.l)
;PROBLEM: GIF-IMAGES ETC WONT REACT WHEN I SAVE THE OLD IMAGE AS A MATRIX. ON THE OTHER HAND I CAN PAINT OVER GIFS.
Define lColor.l;, udtAngelSaturationBrightness As HSL

If blnDrag = #True;Baile if mousebutton is not held down.

  If X > 255
    X = 255 ;LIMITER.
  EndIf
  If X < 0
    X = 0
  EndIf
  If Y > 255 
    Y = 255
  EndIf
  If Y < 0
     Y = 0
  EndIf

 Select #True
  Case GetGadgetState(#optH);objOption(0)
    lColor = HSLToRGB(intSystemColorAngleMax1530, X, 255 - Y,#True) ;CONVERT AND UPDATE TEXTBOXES.     
  Case GetGadgetState(#optS);objOption(1) 
    lColor = HSLToRGB(X * 6, bteSaturationMax255, 255 - Y,#True): PaintThinBox(#iSaturation) ;CONVERT AND UPDATE TEXTBOXES.
  Case GetGadgetState(#optLuma);objOption(2) 
    lColor = HSLToRGB(X * 6, 255 - Y, bteBrightnessMax255,#True): PaintThinBox(#iLumination) ;CONVERT AND UPDATE TEXTBOXES.
  Case GetGadgetState(#optR);objOption(3)
    BigBoxOpt3Reaction(X, Y) ;CONVERT AND UPDATE TEXTBOXES.
  Case GetGadgetState(#optG);objOption(4) 
    BigBoxOpt4Reaction(X, Y) ;CONVERT AND UPDATE TEXTBOXES.
  Case GetGadgetState(#optBlue);objOption(5) 
    BigBoxOpt5Reaction(X, Y) ;CONVERT AND UPDATE TEXTBOXES.
  Case GetGadgetState(#optImage);objOption(9)
    StartDrawing(ImageOutput(#BIGBOX_MEDIA))
    lColor=Point(X, Y)
    StopDrawing() ; Kuk
    SetGadgetColor(#lblNewColor,#PB_Gadget_BackColor,lColor)
    SplitlblNewColorToRGBboxes() : RGBToHSL201(lColor,#True) ; lblNewColor.BackColor = picBigBox.Point(X, Y): SplitlblNewColorToRGBboxes: udtAngelSaturationBrightness = RGBToHSL201(lblNewColor.BackColor,#True) ;True means that HSL uppdates both the textboxes and the system constants.
  Default
    MessageRequester("","Error: No optionbutton is selected! in Procedure picBigBox_MouseMove(X.l, Y.l)")
EndSelect

    mBlnRecentThinBoxPress = #False
EndIf
  EndProcedure

Procedure picThinBox_MouseMove(X.l, Y.l)
Define lColor.l

If blnDrag;---------------------------------------------------
  ;If Text1(1) = "Saturation" Then Text1(1) = 100 ;The program har been started recently.
  If Y < 0
    Y = 0 ;LIMITER
  EndIf
  If Y > 255
    Y = 255
  EndIf
  ;imgArrows.Top = Y + 28 ;Animering
  ResizeGadget(#imgTriangel,#PB_Ignore,Y+#imgColorBoxesY,#PB_Ignore,#PB_Ignore);TriangelMove(Y) ;ANIMATION
  
  Select #True
      Case GetGadgetState(#optH);objOption(0)
          lColor = HSLToRGB((255 - Y) * 6, bteSaturationMax255, bteBrightnessMax255, #True); Exit Sub ;Convert And update textboxes.
      Case GetGadgetState(#optS);objOption(1)
          lColor = HSLToRGB(intSystemColorAngleMax1530, 255 - Y, bteBrightnessMax255, #True); Exit Sub ;Convert and update textboxes.
      Case GetGadgetState(#optLuma);objOption(2)
          lColor = HSLToRGB(intSystemColorAngleMax1530, bteSaturationMax255, 255 - Y, #True) ;Convert and update textboxes.
      Case GetGadgetState(#optR);objOption(3)
        mSngRValue=(255 - Y)
        SetGadgetText(#TextR,Str(mSngRValue))
        lColor=RGB(mSngRValue,mSngGValue,mSngBValue)
        RGBToHSL201(lColor,#True);Convert and update textboxes.
        SetGadgetColor(#lblNewColor,#PB_Gadget_BackColor,lColor)
      Case GetGadgetState(#optG);objOption(4)
        mSngGValue=(255 - Y)
        SetGadgetText(#TextG,Str(mSngGValue))
        lColor=RGB(mSngRValue,mSngGValue,mSngBValue)
        RGBToHSL201(lColor,#True);Convert and update textboxes.
        SetGadgetColor(#lblNewColor,#PB_Gadget_BackColor,lColor)
      Case GetGadgetState(#optBlue);objOption(5)
          mSngBValue=(255 - Y)
        SetGadgetText(#TextBlue,Str(mSngBValue))
        lColor=RGB(mSngRValue,mSngGValue,mSngBValue)
        RGBToHSL201(lColor,#True);Convert and update textboxes.
        SetGadgetColor(#lblNewColor,#PB_Gadget_BackColor,lColor)
        Default
          MessageRequester("","Error: No optGadget selected!")
  EndSelect
EndIf
EndProcedure
;======================================================================

;============================================================================================
;************----------------------------*****************
;*******    MAIN LOOP - CHECK FOR ALL EVENTS; MOUSECLICKS ETC
;**********************************************************
Form_Load()
;ExecuteIniFile(bChosenOptGadget) ;Chooses the latest mode of optRadioButton.
bChosenOptGadget=ExecuteIniFile()
SetGadgetState(bChosenOptGadget,#True)
objOption_Click(bChosenOptGadget);Aktiverar uppritning av imgBoxMedia.

;------------ Create ShortcutKeys!
AddKeyboardShortcut(#WinColorPicker,#PB_Shortcut_Up,#SC_EVENT_UpKey)
AddKeyboardShortcut(#WinColorPicker,#PB_Shortcut_Down,#SC_EVENT_DownKey)

;Debug GadgetX(#TextR)
;Debug GadgetY(#TextR)
If InitMouse()
   ;If ExamineMouse()
  
  Repeat 
    lEvent = WaitWindowEvent()
    lEventType=EventType()
    ;SetWindowTitle(#WinColorPicker, Str(GetAsyncKeyState_(#VK_LBUTTON)))
    Select lEvent
      Case #PB_Event_Gadget
        Select EventGadget()
          Case #lblNewColor
            MessageRequester("", "Klick!")
            ;lblOldColor.BackColor = lblNewColor.BackColor
            SetGadgetColor(#lblOldColor,#PB_Gadget_BackColor,GetGadgetColor(#lblNewColor,#PB_Gadget_BackColor))
            mBlnBigBoxReady = #False ;Delivers fresh coordinates, but only in the HSL-model at this stage.
            ;blnNotFirstTimeMarker = #False ;-"-
            ;Call Form_Load
            ;Call SplitlblNewColorToRGBboxes ;Also the system constants RGB are updated.
            ;udtAngelSaturationBrightness = RGBToHSL201(lblNewColor.BackColor, True) ;True means that HSL is updating both the textboxes and the system constants.
            RGBToHSL201(GetGadgetColor(#lblNewColor,#PB_Gadget_BackColor),#True)
            
            If GetGadgetState(#optImage) =#False ;Skip if postcard view.
            
              ;TriangelMove(255 - (intSystemColorAngleMax1530 / 1530 * 255) + 28) ;Animates the triangeln.
              ResizeGadget(#imgTriangel,#PB_Ignore,255 - (intSystemColorAngleMax1530 / 1530 * 255) + #imgColorBoxesY,#PB_Ignore,#PB_Ignore) 
              picBigBox_Colorize() ;Redraw BigBox
            EndIf
                    
          Case #lblOldColor
           ;MsgBox "Klick!"
            SetGadgetColor(#lblNewColor,#PB_Gadget_BackColor,GetGadgetColor(#lblOldColor,#PB_Gadget_BackColor))
            mBlnBigBoxReady = #False ;Delivers fresh coordinates, but only in the HSL-model at this stage.
            ;blnNotFirstTimeMarker = False ;-"-
            ;Call Form_Load
            ;Call SplitlblNewColorToRGBboxes ;Also the system constants RGB are updated.
            ;udtAngelSaturationBrightness = RGBToHSL201(lblNewColor.BackColor, True) ;True means that HSL is updating both the textboxes and the system constants.
            RGBToHSL201(GetGadgetColor(#lblNewColor,#PB_Gadget_BackColor),#True)
            
            ;imgArrows.Top = 255 - (intSystemColorAngleMax1530 / 1530 * 255) + 28 ;Animates imgArrows
            ;TriangelMove(255 - (intSystemColorAngleMax1530 / 1530 * 255) + 28) ;Animates the triangel.
            ResizeGadget(#imgTriangel,#PB_Ignore,255 - (intSystemColorAngleMax1530 / 1530 * 255) + #imgColorBoxesY,#PB_Ignore,#PB_Ignore) 
            picBigBox_Colorize();Rita om BigBox
 
        Case #optH To #optLABb
          objOption_Click(EventGadget())
          ;Debug Str(EventGadget())
          ;Debug Str(#optH)
        Case #TextH To #TextLABb
          If lEventType=#PB_EventType_Change;Text has been changed.
            MessageRequester("","TextBox "+ Str(GetActiveGadget()) +" has been changed.")
            Text1To9_LostFocus(GetActiveGadget())
          EndIf
        Case #Combo1
          Debug "Combo1 was pressed."
         Case #imgBigBox
          mBlnRecentBigBoxPress = #True
          blnDrag = #True
          lEvent = #WM_MOUSEMOVE;Artificial stimulation of lEvent to kickstart the picThinBox_MouseMove.
  
         Case #imgThinBox
           ;Private Sub picThinBox_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
           ;Set flag To start drawing
          mBlnRecentThinBoxPress = #True
          blnDrag = #True
          lEvent = #WM_MOUSEMOVE;Artificial stimulation of lEvent to kickstart the picThinBox_MouseMove.
  
      EndSelect
  EndSelect
  
  ;---SENSE MOUSE MOVEMENTS -------------
  lMouse = GetAsyncKeyState_(#VK_LBUTTON) ; API MS_WINDOWS
  ;SetWindowTitle(#WinColorPicker, Str(GetAsyncKeyState_(#VK_LBUTTON)))
  If blnDrag 
    If lMouse <> #LMouseButtonUp;!Testing for MouseDown gives ambigous results. GetAsyncKeyState_(#VK_LBUTTON).
      If lEvent = #WM_MOUSEMOVE
    
    ;*********** #imgThinBox Sense mouse movement!  ********************
        Select #True
          Case mBlnRecentThinBoxPress
             Xbox=WindowMouseX(#WinColorPicker)-GadgetX(#imgThinBox);Homemade boundaries!           
             Ybox=WindowMouseY(#WinColorPicker)-GadgetY(#imgThinBox)
      
             picThinBox_MouseMove(Xbox, Ybox) ;REUSING THE UPDATE ROUTINES.
            
       ;*********** #imgBigBox Sense mouse movement!  ********************
        Case mBlnRecentBigBoxPress
           Xbox=WindowMouseX(#WinColorPicker)-GadgetX(#imgBigBox);Homemade boundaries!           
           Ybox=WindowMouseY(#WinColorPicker)-GadgetY(#imgBigBox)
    
           picBigBox_MouseMove(Xbox, Ybox) ;REUSING THE UPDATE ROUTINES.
        EndSelect
   ;-- MOUSE BUTTON RELEASED ON SOME GADGET ! *********************
   ;--- #imgThinBox Mouse button is released! ////////////////////
 EndIf
 
   Else; lMouse = #LMouseButtonUp. GetAsyncKeyState_(#VK_LBUTTON).
        ;MessageRequester("","Mouse up. GetAsyncKeyState")
        blnDrag = #False
        mBlnRecentBigBoxPress=#False
        If mBlnRecentThinBoxPress
          picBigBox_Colorize();Painting BigBox after being idle.
          mBlnRecentThinBoxPress=#False
        EndIf
  EndIf
EndIf
;- SENCE KEYPRESS **********************************************
;SetWindowTitle(#WinColorPicker, Str(EventMenu()));TEst
lEventMenu=EventMenu()
If lEventMenu= #SC_EVENT_UpKey Or lEventMenu=#SC_EVENT_DownKey
  ;MessageRequester("", Str(lEventMenu))
  Select #True
    Case GetGadgetState(#optH)
     ;1530 levels. The triangels are moving every sixth Step And are lying on the byte level of 1530/6.
    ;RGBtxtboxes tells the nudge level:
    ;*****  NudgeHueValues goes from ZERO to 1536.
    intSystemColorAngleMax1530 = intSystemColorAngleMax1530 + lEventMenu-4 ;Calculating the new value of intSystemColorAngleMax1530, thus +1 or -1.
    
    If intSystemColorAngleMax1530 > 1530;Dirty limiter.
      intSystemColorAngleMax1530 = 1530
    EndIf 
    If intSystemColorAngleMax1530 < 0
      intSystemColorAngleMax1530 = 0
    EndIf
    
    lngColor = HSLToRGB(intSystemColorAngleMax1530, bteSaturationMax255, bteBrightnessMax255, #True) ;lngColor as a function of HSLToRGB. System constants are being updated at the same time.
    ;TriangelMove(255 - (intSystemColorAngleMax1530 / 1530 * 255));Moving the triangel.
    SetWindowTitle(#WinColorPicker, "Y = " + Str(255 - ((intSystemColorAngleMax1530 / 1530 * 255))+#imgColorBoxesY));TEst
    ResizeGadget(#imgTriangel,#PB_Ignore,(255 - (intSystemColorAngleMax1530 / 1530 * 255))+#imgColorBoxesY,#PB_Ignore,#PB_Ignore)
     picBigBox_Colorize()
  
    Case GetGadgetState(#optS);******
        MessageRequester("", "Add code For radio1! Probably just writing in textbox Saturation!")
    Case GetGadgetState(#optLuma) ;*****
        MessageRequester("", "Add code for radio2!")
  EndSelect
EndIf

  Until lEvent = #PB_Event_CloseWindow
  
  Else
    MessageRequester("","Failed to InitMouse()")
EndIf

If lFlagMainWinExist<>#True;Used in bigger projects with several modules.
  End
EndIf
Last edited by SiggeSvahn on Sat Jan 11, 2020 7:05 am, edited 1 time in total.
Newbie
BarryG
Addict
Addict
Posts: 3292
Joined: Thu Apr 18, 2019 8:17 am

Re: ColorPicker AdobePhotoShop style

Post by BarryG »

Doesn't compile; too many errors.
User avatar
DK_PETER
Addict
Addict
Posts: 898
Joined: Sat Feb 19, 2011 10:06 am
Location: Denmark
Contact:

Re: ColorPicker AdobePhotoShop style

Post by DK_PETER »

BarryG wrote:Doesn't compile; too many errors.
It's not that bad.

Remove Enable Explicit or declare procedures

Line 124 strPathStripC <> change to strPathStripC.s
Llne 1178 SplitlblNewColorToRGBboxes - add parentheses
Line 1319 'API MS_WINDOWS - Semicolon instead of apostrophe.

That's it. :wink:
Current configurations:
Ubuntu 20.04/64 bit - Window 10 64 bit
Intel 6800K, GeForce Gtx 1060, 32 gb ram.
Amd Ryzen 9 5950X, GeForce 3070, 128 gb ram.
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: ColorPicker AdobePhotoShop style

Post by Kwai chang caine »

Thanks to DK_PETER that works :D
Nice stuff SiggeSvahn, thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
BarryG
Addict
Addict
Posts: 3292
Joined: Thu Apr 18, 2019 8:17 am

Re: ColorPicker AdobePhotoShop style

Post by BarryG »

DK_PETER wrote:It's not that bad.
Line 124 strPathStripC <> change to strPathStripC.s
Llne 1178 SplitlblNewColorToRGBboxes - add parentheses
Line 1319 'API MS_WINDOWS - Semicolon instead of apostrophe.
I fixed lines 124 and 1178 myself, but then 1319 also threw an error, so I gave up. I was so close without realising.
SiggeSvahn
User
User
Posts: 40
Joined: Wed Oct 06, 2010 9:37 pm

Re: ColorPicker AdobePhotoShop style

Post by SiggeSvahn »

Forum you are the greatest! I have now updated the first posts and the code is now working working on my computer PureBasic 5.71 LTS (Windows - x64).
Newbie
User avatar
Kiffi
Addict
Addict
Posts: 1353
Joined: Tue Mar 02, 2004 1:20 pm
Location: Amphibios 9

Re: ColorPicker AdobePhotoShop style

Post by Kiffi »

a screenshot would be nice. Because I have no idea how a ColorPicker in "AdobePhotoShop style" could look like.
Hygge
SiggeSvahn
User
User
Posts: 40
Joined: Wed Oct 06, 2010 9:37 pm

Re: ColorPicker AdobePhotoShop style

Post by SiggeSvahn »

Here are some screenshots but seems like a I have to use some webstorage account which I don't have:
[img]G:\Disken%20Backup%20F%20Stationär\Mina%20dokument\Programmering\PureBasic\Egna%20PB-projekt\ColorPicker\ColorPickerView1.jpg[/img]

[img]G:\Disken%20Backup%20F%20Stationär\Mina%20dokument\Programmering\PureBasic\Egna%20PB-projekt\ColorPicker\ColorPickerView2.jpg[/img]

[img]G:\Disken%20Backup%20F%20Stationär\Mina%20dokument\Programmering\PureBasic\Egna%20PB-projekt\ColorPicker\ColorPickerView3.jpg[/img]

[img]G:\Disken%20Backup%20F%20Stationär\Mina%20dokument\Programmering\PureBasic\Egna%20PB-projekt\ColorPicker\ColorPickerVie4.jpg[/img]

[img]G:\Disken%20Backup%20F%20Stationär\Mina%20dokument\Programmering\PureBasic\Egna%20PB-projekt\ColorPicker\ColorPickerView5.jpg[/img]

[img]G:\Disken%20Backup%20F%20Stationär\Mina%20dokument\Programmering\PureBasic\Egna%20PB-projekt\ColorPicker\ColorPickerView6.jpg[/img]

[img]G:\Disken%20Backup%20F%20Stationär\Mina%20dokument\Programmering\PureBasic\Egna%20PB-projekt\ColorPicker\ColorPickerView7.jpg[/img]
Newbie
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: ColorPicker AdobePhotoShop style

Post by Kwai chang caine »

SiggeSvahn wrote:Here are some screenshots but seems like a I have to use some webstorage account which I don't have:
[img]G:\Disken%20Backup%20F%20Stationär\Mina%20dokument\Programmering\PureBasic\Egna%20PB-projekt\ColorPicker\ColorPickerView1.jpg[/img]
[img]G:\Disken%20Backup%20F%20Stationär\Mina%20dokument\Programmering\PureBasic\Egna%20PB-projekt\ColorPicker\ColorPickerView2.jpg[/img]
[img]G:\Disken%20Backup%20F%20Stationär\Mina%20dokument\Programmering\PureBasic\Egna%20PB-projekt\ColorPicker\ColorPickerView3.jpg[/img]
[img]G:\Disken%20Backup%20F%20Stationär\Mina%20dokument\Programmering\PureBasic\Egna%20PB-projekt\ColorPicker\ColorPickerVie4.jpg[/img]
[img]G:\Disken%20Backup%20F%20Stationär\Mina%20dokument\Programmering\PureBasic\Egna%20PB-projekt\ColorPicker\ColorPickerView5.jpg[/img]
[img]G:\Disken%20Backup%20F%20Stationär\Mina%20dokument\Programmering\PureBasic\Egna%20PB-projekt\ColorPicker\ColorPickerView6.jpg[/img]
[img]G:\Disken%20Backup%20F%20Stationär\Mina%20dokument\Programmering\PureBasic\Egna%20PB-projekt\ColorPicker\ColorPickerView7.jpg[/img]
Hello SiggeSvahn :wink:
The path you give is local path on your machine, and it's impossible for the forum to read simply on a local path, fortunately i can say :mrgreen:

For show screenshot, like this forum not have this option :| , you must use one of several free sites, like:

https://paste.pics/

Past your image into it, and copy the link that the site give to you, and paste it on the forum
But also :

https://imgbb.com/
https://imgur.com/
https://www.noelshack.com/

and numerous others exists :D
Obviously, you can also create your own site (free exist) like me, and use a link of it :

Code: Select all

[img]Http://erdsjb.free.fr/purestorage/images/anim/animaux/BulldogAnglaisMotoMer.gif[/img]
Image
ImageThe happiness is a road...
Not a destination
PureLust
Enthusiast
Enthusiast
Posts: 477
Joined: Mon Apr 16, 2007 3:57 am
Location: Germany, NRW

Re: ColorPicker AdobePhotoShop style

Post by PureLust »

@SiggeSvahn: Nice one. :wink:

But seems to have a little bug:

When I start it, the first click into the Color-Area is recognized as a click for the Color-Range Slider instead.

Greetz, PL.
[Dynamic-Dialogs] - create complex GUIs the easy way
[DeFlicker] - easily deflicker your resizeable Windows
[WinFX] - Window Effects (incl. 'click-through' Window)
Post Reply