It is currently Thu Oct 01, 2020 2:56 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 15 posts ] 
Author Message
 Post subject: ColorPicker AdobePhotoShop style
PostPosted: Fri Nov 05, 2010 4:55 pm 
Offline
User
User

Joined: Wed Oct 06, 2010 9:37 pm
Posts: 34
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:
;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

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


_________________
Newbie


Last edited by SiggeSvahn on Sat Jan 11, 2020 7:10 am, edited 4 times in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: ColorPicker AdobePhotoShop style
PostPosted: Fri Nov 05, 2010 5:14 pm 
Offline
Addict
Addict

Joined: Thu Nov 01, 2007 5:37 pm
Posts: 1981
Location: Germany
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!


Top
 Profile  
Reply with quote  
 Post subject: Re: ColorPicker AdobePhotoShop style
PostPosted: Fri Nov 05, 2010 5:19 pm 
Offline
Addict
Addict

Joined: Wed Aug 24, 2005 8:39 am
Posts: 2736
Location: Southwest OH - USA
very nice.

thanks for sharing. :D

cheers


Top
 Profile  
Reply with quote  
 Post subject: Re: ColorPicker AdobePhotoShop style
PostPosted: Fri Nov 05, 2010 5:25 pm 
Offline
Addict
Addict
User avatar

Joined: Fri Sep 21, 2007 5:52 am
Posts: 3545
Location: New Zealand
looks good

There's a bug if you choose image option at line 1174.
change to this
Code:
StartDrawing(ImageOutput(#BIGBOX_MEDIA))
   lColor=Point(X, Y)
 StopDrawing()


Top
 Profile  
Reply with quote  
 Post subject: Re: ColorPicker AdobePhotoShop style
PostPosted: Sat Nov 06, 2010 12:31 am 
Offline
Addict
Addict

Joined: Sat Jun 30, 2007 8:04 pm
Posts: 3370
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. :)


Top
 Profile  
Reply with quote  
 Post subject: Re: ColorPicker AdobePhotoShop style
PostPosted: Fri Jan 10, 2020 1:50 pm 
Offline
User
User

Joined: Wed Oct 06, 2010 9:37 pm
Posts: 34
Here is the 2:nd part:
Code:

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

_________________
Newbie


Last edited by SiggeSvahn on Sat Jan 11, 2020 7:05 am, edited 1 time in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: ColorPicker AdobePhotoShop style
PostPosted: Fri Jan 10, 2020 2:12 pm 
Offline
Addict
Addict

Joined: Thu Apr 18, 2019 8:17 am
Posts: 1007
Doesn't compile; too many errors.


Top
 Profile  
Reply with quote  
 Post subject: Re: ColorPicker AdobePhotoShop style
PostPosted: Fri Jan 10, 2020 3:18 pm 
Offline
Addict
Addict
User avatar

Joined: Sat Feb 19, 2011 10:06 am
Posts: 866
Location: Denmark
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:

_________________
“Tell me and I forget. Teach me and I remember. Involve me and I learn.”
— Benjamin Franklin
Current configurations: Windows 10, Intel 6800K, GeForce Gtx 1060, 32 gb ram.


Top
 Profile  
Reply with quote  
 Post subject: Re: ColorPicker AdobePhotoShop style
PostPosted: Fri Jan 10, 2020 6:01 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4705
Location: Lyon - France
Thanks to DK_PETER that works :D
Nice stuff SiggeSvahn, thanks for sharing 8)

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
 Post subject: Re: ColorPicker AdobePhotoShop style
PostPosted: Sat Jan 11, 2020 1:53 am 
Offline
Addict
Addict

Joined: Thu Apr 18, 2019 8:17 am
Posts: 1007
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.


Top
 Profile  
Reply with quote  
 Post subject: Re: ColorPicker AdobePhotoShop style
PostPosted: Sat Jan 11, 2020 7:08 am 
Offline
User
User

Joined: Wed Oct 06, 2010 9:37 pm
Posts: 34
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


Top
 Profile  
Reply with quote  
 Post subject: Re: ColorPicker AdobePhotoShop style
PostPosted: Sat Jan 11, 2020 5:31 pm 
Offline
Addict
Addict
User avatar

Joined: Tue Mar 02, 2004 1:20 pm
Posts: 1147
Location: Amphibios 9
a screenshot would be nice. Because I have no idea how a ColorPicker in "AdobePhotoShop style" could look like.

_________________
Can't decide if i need a hug, an XXL coffee, 6 shots of vodka or 2 weeks of sleep.


Top
 Profile  
Reply with quote  
 Post subject: Re: ColorPicker AdobePhotoShop style
PostPosted: Sat Jan 11, 2020 8:09 pm 
Offline
User
User

Joined: Wed Oct 06, 2010 9:37 pm
Posts: 34
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


Top
 Profile  
Reply with quote  
 Post subject: Re: ColorPicker AdobePhotoShop style
PostPosted: Sun Jan 12, 2020 3:31 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4705
Location: Lyon - France
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:
[img]Http://erdsjb.free.fr/purestorage/images/anim/animaux/BulldogAnglaisMotoMer.gif[/img]

Image

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
 Post subject: Re: ColorPicker AdobePhotoShop style
PostPosted: Mon Jan 13, 2020 7:29 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Mon Apr 16, 2007 3:57 am
Posts: 461
Location: Germany, NRW
@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)


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 15 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 3 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye