Color Selector + GetPixel

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
enform
Posts: 175
Joined: Apr 24, 2011 12:57
Location: France

Color Selector + GetPixel

Postby enform » Sep 26, 2017 17:00

Hello,
The original version was made by Vanya . It launches the Windows Color Requester and copies the Hex value into
the Clipboard . I added 'Get BGR(r,g,b)' for Window9.bi and also the Bkg color changes accordingly to the new value .

In FbEdit , the exe can be copied into Tools ; Then go to Menu/Options/Tools and select it with a name .

Edit 2018/11 : added GetPixel from the screen

greetings .

Code: Select all


#Include "window9.bi"

  ' Original by Vanya ;
  ' modif by enform 2017/09 :
  ' Added copy BGR ,selected color as bkg,
  ' uses StringGadget wich is editable before copy to clipboard
  ' modified WindowEvent to WaitEvent  no high cpu load
 
  ' Edit 2018/03   Added Getcolor from Clipboard ,sended to the ColorRequester ;
  '     conv BGR to Dec , Copy Dec
  ' ClipBoard can return color as Hexa , BGR or Decimal
 
  ' Edit 2018/11 Added GetPixel : copy a color from the Desktop and also initialize
  '     the color to send to the ColorRequester()

 /' tests : ( Highlight and Ctl+C , then click 'Another color' )
     BGR(1,2,250)
     BGR(250,2,1)
    &h0000ff
    &hff0000
    254
    16646144  254*65536
 '/


'#Define ld __LINE__
 
Dim As Long event,lSelColor,lGetColor,lColor,oldx,oldy,getpixelflag
Dim As Point pt
Dim As HWND hwnd
Dim As HDC hDC

hDC = GetDC(0)
 

Function Bgr2Dec(sBgr As String) As Long
   Dim As Long lVal
   Dim As String sVal
   Dim As Byte bComma1,bComma2,bPar1,bPar2
   
   bPar1 = InStr(sBgr,"(")+1
   bPar2 = InStrRev(sBgr,")")-1
 
    bComma1 = InStr(sBgr,",")
   sVal = Trim(Mid(sBgr,bPar1,bComma1-bPar1)) ' r
   '?  ld & " sVal = " & sVal
   lVal = ValLng(sVal)
      
   bComma2 = InStr(bComma1+1,sBgr,",")
   sVal = Trim(Mid(sBgr,bComma1+1,bComma2-bComma1-1)) ' g
   '?  ld & " sVal = " & sVal
   lVal += ValLng(sVal) *256
   
   sVal = Trim(Mid(sBgr,bComma2+1,bPar2-bComma2)) ' b
   '?  ld & " sVal = " & sVal
   lVal += ValLng(sVal) *65536
   Return lVal
End Function

Function SetBGR(Col As Long) As String
   Dim As UByte c1,c2,c3
   
   c3 = Col Shr 16 And 255    ' r
   c2 = Col Shr 8  And 255    ' g
   c1 = Col And 255           ' b
   '? ld,"BGR(" & c1 &  "," & c2 &  "," & c3 & ")"
   Return "BGR(" & c1 &  "," & c2 &  "," & c3 & ")"
End Function

' the ref is decimal
Function GetClipBoardCol() As Long
   
   Dim As String sgc,hsgc
   Dim As Long lGetCol
   
   sgc = GetClipBoardText() ': ? ld ,sgc
   
   If InStr(sgc,"&") Then  ' hexa
      hsgc = Str(sgc)  ' hexa to dec string
      lGetCol = ValLng(sgc)  ' dec
   ' ?  ld," lGetcolor = " & lGetcol
   ElseIf InStr(sgc,UCase("BGR")) Then  ' bgr
      lGetCol = Bgr2Dec(sgc)
   ' ?  ld," lGetcol = " & lGetcol
   ElseIf InStr(sgc,Any "0123456789") Then  ' decimal
      lGetCol = ValLng(sgc)
   ' ?  ld," lGetcol = " & lGetcol
   EndIf
   Return lGetCol
End Function
 

   hwnd = OpenWindow("Color Selector",600,10,260,205)
   StringGadget(1,5,10,120,20,,SS_CENTER,WS_EX_CLIENTEDGE )
   SetGadgetColor(1,&hFFAA55,&hFFFFFF,3)
   ButtonGadget(2,130,10,100,20,"Copy Hex")
   
   StringGadget(4,5,40,120,20,,SS_CENTER,WS_EX_CLIENTEDGE )
   SetGadgetColor(4,&hFFAA55,&hFFFFFF,3)
   ButtonGadget(5,130,40,100,20,"Copy BGR")
   
   StringGadget(6,5,70,120,20,,SS_CENTER,WS_EX_CLIENTEDGE )
   SetGadgetColor(6,&hFFAA55,&hFFFFFF,3)
   ButtonGadget(7,130,70,100,20,"Copy Dec")
   
   ButtonGadget(3,10,120,100,20,"Another Color")
   GadgetToolTip(3,"Sends color from ClipBoard to ColorRequester")
   
   ButtonGadget(8,130,120,100,20,"Get pixel")
   GadgetToolTip(8,"From all the screen")

   lGetColor = GetClipBoardCol()
   WindowColor(hwnd,lGetColor)             ' from ClipBoard
   ' ?  ld," lGetcolor = " & lGetcolor
   SetGadgetText(1,"&h" & Hex(lGetColor))
   SetGadgetText(4,SetBGR(lGetColor))
   SetGadgetText(6,"" & lGetColor)

   ' if value in ClipBoard >0 launch the ColorRequester with this value
   If lGetColor Then
      lSelColor = ColorRequester(lGetColor,,)
      SetGadgetText(1,"&h" & Hex(lSelColor))
      SetGadgetText(4,SetBGR(lSelColor))
      SetGadgetText(6,"" & lSelColor)
      WindowColor(hwnd,lSelColor) ' control of the selected color
   EndIf   
   
Do
   event = WaitEvent()

   ' click the "Get pixel" button and move the mouse over the screen
   If getpixelflag =1 Then ' button clicked
      pt.x = GlobalMouseX() : pt.y = GlobalMouseY()
      If pt.x <> oldx Or pt.y <> oldy Then
         lColor = GetPixel(hDC,pt.x,pt.y)
         ' get a copy of the value
         SetGadgetText(1,"&h" & Hex(lColor))
         SetGadgetText(4,SetBGR(lColor))
         SetGadgetText(6,"" & lColor)
         WindowColor(hwnd,lColor) ' the bkg color follows the color of the pixel
      '   ? "lColor",lColor
         oldx = pt.x
         oldy = pt.y
      EndIf
      ' get it from a pixel
      If GetAsyncKeyState(27) <0 Then ' Esc ; with a key the mouse pointer cannot move
      '   ? "27"
         SetClipBoardText(Str(lColor)) ' for the "Another Color" button
      '   ? "GetClipBoardText",GetClipBoardText()
         ' get a copy of the value
         SetGadgetText(1,"&h" & Hex(lColor))
         SetGadgetText(4,SetBGR(lColor))
         SetGadgetText(6,"" & lColor)
      '   ? "Getcolor",lcolor
         getpixelflag = 0
      EndIf
   EndIf
   
   If Event=EventClose Then
       ReleaseDC(0,hDC)
        Exit Do
   If Event=EventGadget Then
      If  EventNumber = 2 Then        ' Copy Hexa
         SetClipBoardText(GetGadgetText(1))
      ElseIf  EventNumber = 5 Then    ' Copy BGR
         SetClipBoardText(GetGadgetText(4))
      ElseIf  EventNumber = 7 Then    ' Copy Decimal
         SetClipBoardText(GetGadgetText(6))
      ElseIf EventNumber = 3 Then  ' Another Color
         lGetColor = GetClipBoardCol()
         WindowColor(hwnd,lGetColor)             ' from ClipBoard
         ' ?  ld," lGetcolor = " & lGetcolor
         SetGadgetText(1,"&h" & Hex(lGetColor))  ' from ClipBoard
         SetGadgetText(4,SetBGR(lGetColor))
         SetGadgetText(6,"" & lGetColor)
          lSelColor = ColorRequester(lGetColor,,hwnd)
         SetGadgetText(1,"&h" & Hex(lSelColor))
         SetGadgetText(4,SetBGR(lSelColor))
         SetGadgetText(6,"" & lSelColor)
         WindowColor(hwnd,lSelColor)
      ElseIf EventNumber = 8 Then  ' getpixel
         getpixelflag = 1
     EndIf
   EndIf
Loop



Last edited by enform on Nov 01, 2018 18:41, edited 1 time in total.
enform
Posts: 175
Joined: Apr 24, 2011 12:57
Location: France

Re: Color Selector + GetPixel

Postby enform » Nov 01, 2018 15:49

New version with GetPixel (all the screen).
Edit : added ReleaseDC(0,hDC)
dodicat
Posts: 5936
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Color Selector + GetPixel

Postby dodicat » Nov 21, 2018 14:15

Here is a little colour picker I used as a test for a compressor (last post).
Windows only.
https://www.freebasic.net/forum/viewtopic.php?f=7&t=27119
Just run the code to make the picker.

Return to “Tips and Tricks”

Who is online

Users browsing this forum: Baidu [Spider] and 15 guests