yPix: a desktop vfp colorPicker

Published on by Yousfi Benameur


This color manager yPix is a  VFP9 program , do the follow things and retrieves:
- the absolute positions X and Y at any screen point
- the VFP color (RGB color) as an integer
- the Hexadecimal color
- the HTML color
- the CMYK(Cyan,magenta,yellow,key black) color
- The HSV color
-It have two  hotkeys programmed for
 1.CTRL+F6....Show and Copy the current properties of the point to ypix.txt
 2. CTRL+F7...Fires a colorPicker built with APIs (expanded).Choose a color+return to apture the pixel point .the traditional getcolor() in this case dont used because focus.
- The capture of any window (not very efficient because timer) .
The form is movable by the mouse.
Any point on the desktop can be captured (pointthe cursor+press ctrl+f6). 

this code is extracted from a foxite post i made on 2008.can download complet project from :
http://www.foxite.com/downloads/default.aspx?id=193&keyword=ypix&category=
warning: the clipboard seems to be disturbed by ypix (to fix) !!! 
 
     *Time stamp  11/23/08 06:24:02 PM


Click on code to select [then copy] -click outside to deselect


_Screen.WindowState=1

Clea All
If _vfp.StartMode=0
    On Shutdown Quit
Endi

Publi m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Set Defa To (yrep)
Publi yform
yform=Newobject("ypix")
yform.Show
Read Events

Define Class ypix As Form
	BorderStyle = 2
	Top = 4
	Left = 809
	Height = 105
	Width = 158
	ShowWindow = 2
	ShowTips = .T.
	Caption = "yPix"
	MousePointer = 15
	Icon = Home(1)+"GRAPHICS\ICONS\ARROWS\ARW03UP.ICO"
	AlwaysOnTop = .T.
	BackColor = Rgb(255,255,255)
	posx = 0
	posy = 0
	pixelcolor = .F.
	rgbcolor = 0
	hexcolor = .F.
	htmlcolor = .F.
	cmykcolor = .F.
	hsvcolor = .F.
	yclip = .F.
	ydest = .F.
	Name = "ypix"

	Add Object ypub As Label With ;
		BackStyle = 0, ;
		Caption = "", ;
		Height = 106, ;
		Left = 0, ;
		MousePointer = 15, ;
		Top = 0, ;
		Visible = .F., ;
		Width = 157, ;
		ForeColor = Rgb(0,0,255), ;
		Name = "yPub"

	Add Object lblcolor As Label With ;
		AutoSize = .T., ;
		BackStyle = 0, ;
		Caption = "COLOR", ;
		Height = 17, ;
		Left = 1, ;
		Top = 16, ;
		Width = 45, ;
		Name = "lblColor"

	Add Object lblrgbcolor As Label With ;
		AutoSize = .T., ;
		BackStyle = 0, ;
		Caption = "RgbColor", ;
		Height = 17, ;
		Left = 1, ;
		Top = 32, ;
		Width = 55, ;
		Name = "lblRGBColor"

	Add Object lblhexcolor As Label With ;
		AutoSize = .T., ;
		BackStyle = 0, ;
		Caption = "HExColor", ;
		Height = 17, ;
		Left = 1, ;
		Top = 48, ;
		Width = 54, ;
		Name = "lblHexColor"

	Add Object timer1 As Timer With ;
		Top = 34, ;
		Left = 120, ;
		Height = 23, ;
		Width = 23, ;
		Interval = 100, ;
		Name = "Timer1"

	Add Object colorshower As Shape With ;
		Top = 23, ;
		Left = 110, ;
		Height = 36, ;
		Width = 43, ;
		BorderStyle = 0, ;
		Name = "colorShower"

	Add Object lblclose As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		BackStyle = 0, ;
		BorderStyle = 0, ;
		fontbold=.T.,;
		forecolor=255,;
		Caption = " X ", ;
		Height = 17, ;
		Left = 134, ;
		MousePointer = 15, ;
		Top = 3, ;
		Width = 16, ;
		Name = "lblClose"

	Add Object lblpixelat As Label With ;
		AutoSize = .T., ;
		BackStyle = 0, ;
		Caption = "lblPixelAT", ;
		Height = 17, ;
		Left = 1, ;
		Top = 0, ;
		Width = 55, ;
		Name = "lblPixelAT"

	Add Object lblhtmlcolor As Label With ;
		AutoSize = .T., ;
		BackStyle = 0, ;
		Caption = "HtmlColor", ;
		Height = 17, ;
		Left = 1, ;
		Top = 63, ;
		Width = 58, ;
		Name = "lblHtmlColor"

	Add Object lblcmykcolor As Label With ;
		AutoSize = .T., ;
		BackStyle = 0, ;
		Caption = "lblCMYKColor", ;
		Height = 17, ;
		Left = 1, ;
		Top = 78, ;
		Width = 78, ;
		Name = "lblCMYKColor"

	Add Object lblhsvcolor As Label With ;
		AutoSize = .T., ;
		BackStyle = 0, ;
		Caption = "lblHSVColor", ;
		Height = 17, ;
		Left = 1, ;
		Top = 92, ;
		Width = 69, ;
		Name = "lblHSVColor"


	Add Object ypix As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		BackStyle = 0, ;
		BorderStyle = 1, ;
		Caption = " P", ;
		Height = 17, ;
		Left = 128, ;
		MousePointer = 15, ;
		Top = 85, ;
		Width = 13, ;
		ForeColor = Rgb(0,0,255), ;
		ToolTipText = "Open pix.txt", ;
		Name = "ypix"

	Add Object lblmin As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		BackStyle = 0, ;
		BorderStyle = 0, ;
		Caption = " -", ;
		fontbold=.T.,;
		forecolor=255,;
		Height = 17, ;
		Left = 123, ;
		MousePointer = 15, ;
		Top = 3, ;
		Width = 9, ;
		Name = "lblMin"

	Add Object lblcap As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		BackStyle = 0, ;
		BorderStyle = 1, ;
		Caption = " C", ;
		Height = 17, ;
		Left = 143, ;
		MousePointer = 15, ;
		Top = 85, ;
		Width = 13, ;
		ForeColor = Rgb(0,0,255), ;
		ToolTipText = "Capture a window", ;
		Name = "lblCap"

	Procedure color2rgb
	Lparameters tnColor
	Local lnRed,lnGreen,lnBlue
	lnRed	= Bitrshift(Bitand(tnColor, 0x0000FF),0)
	lnGreen	= Bitrshift(Bitand(tnColor, 0x00FF00),8)
	lnBlue	= Bitrshift(Bitand(tnColor, 0xFF0000),16)
	Return Trans(lnRed)+","+Trans(lnGreen)+","+Trans(lnBlue)
	Endproc

	Procedure ymodule
	Lparameters x, Y, z
	* Returns the module of a 3D vector
	xModule = Sqrt(x * x + Y * Y + z * z)
	Return xModule
	Endproc

	Procedure yarg
	Lparameters xx, yy
	*Returns the argument (in radians) of a point in the (x,y) plan
	Do Case
	Case   xx = 0 And yy = 0
		Argo = 0
	Case   xx = 0 And yy >= 0
		Argo = Pi() / 2
	Case   xx<0  And yy=0
		Argo = Pi()
	Case  xx = 0 And yy < 0
		Argo = -Pi() / 2
	Case  xx > 0
		Argo = Atan(yy/xx)

	Otherwise

		If   xx < 0 And yy >= 0
			Argo = Pi() - Atan(-yy/xx)
		Endi
		If  xx < 0 And yy < 0
			Argo = -Pi() + Atan(-yy/-xx)
		Endi
	Endcase
	Return Argo
	Endproc

	Procedure ycolorpicker
	*Inspired from News2News (thanks)- identical with getcolor():the first fires on desktop ,the second fires on the form.i choosed the first one.
	#Define CC_RGBINIT 1
	#Define CC_FULLOPEN 2
	#Define CC_PREVENTFULLOPEN 4
	#Define CC_SHOWHELP 8
	#Define CC_SOLIDCOLOR 128
	#Define CC_ANYCOLOR 256
	#Define CC_WIDE 32


	#Define COLORREF_ARRAY_SIZE  64

	Local hWindow, lcBuffer, lnInitColor, lnFlags,;
		lnCustColors, lcCustColors, ii
	hWindow =0      &&GetActiveWindow()

	* the color initially selected when the dialog box is created
	lnInitColor = Rgb(128,0,0)

	* allocating memory block for 16 COLORREF values (DWORD)
	* for the custom color boxes in the dialog box
	* and filling this memory with zeroes

	#Define GMEM_FIXED 0
	lnCustColors = GlobalAlloc(GMEM_FIXED, COLORREF_ARRAY_SIZE)
	= ZeroMemory(lnCustColors, COLORREF_ARRAY_SIZE)

	* initialization flags
	lnFlags = CC_FULLOPEN + CC_RGBINIT

	* compiling the CHOOSECOLOR structure
	lcBuffer = This.num2dword(CHOOSECOLOR_SIZE) +;
		this. num2dword(hWindow) +;
		this. num2dword(0) +;
		this.num2dword(lnInitColor) +;
		this. num2dword(lnCustColors) +;
		this. num2dword(lnFlags) +;
		this. num2dword(0) +;
		this. num2dword(0) +;
		this. num2dword(0)

	If ChooseColor(@lcBuffer) <> 0
		This.timer1.Enabled=.F.
		* the OK button of the dialog box has been selected
		cr=Chr(13)+Chr(10)
		With Thisform
			ystring= "Color selected:"+ Trans(This.buf2dword(Substr(lcBuffer, 13,4)))+cr+;
				"Pixel AT: ["+Trans(.posx)+","+Trans(.posy)+"]"+cr+;
				"PxColor= "+Trans(.pixelcolor)+cr+;
				"RGB= "+Trans(.rgbcolor)+cr+;
				"Hex= "+(.hexcolor)+cr  +;
				"Html= "+(.htmlcolor)+cr+;
				"CMYK= "+(.cmykcolor)+cr+;
				(.hsvcolor)+cr+cr
		Endwith
		Set Safe Off
		=Strtofile(ystring,m.yrep+"ypix.txt")
		Set Safe On
		_Cliptext=ystring
		This.timer1.Enabled=.T.
		Messagebox(ystring+"The Result is copied to ypix.txt.",0+32,"YcolorPicker")
	Endif

	* free the memory block if you do not use it for the
	* following calls to this function
	= GlobalFree(lnCustColors)
	Endproc

	Procedure num2dword
	Lparameters lnValue
	#Define m0 0x100
	#Define m1 0x10000
	#Define m2 0x1000000
	Local b0, b1, b2, b3
	b3 = Int(lnValue/m2)
	b2 = Int((lnValue - b3*m2)/m1)
	b1 = Int((lnValue - b3*m2 - b2*m1)/m0)
	b0 = Mod(lnValue, m0)
	Return Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)
	Endproc

	Procedure buf2dword
	Lparameters  lcBuffer
	#Define MAX_DWORD 0xffffffff
	#Define MAX_LONG 0x7FFFFFFF
	Local lnResult
	lnResult = Asc(Substr(lcBuffer, 1,1)) + ;
		Asc(Substr(lcBuffer, 2,1)) * 256 +;
		Asc(Substr(lcBuffer, 3,1)) * 65536 +;
		Asc(Substr(lcBuffer, 4,1)) * 16777216
	Return Iif(lnResult>MAX_LONG, lnResult-MAX_DWORD, lnResult)

	Endproc

	Procedure ybind
	Lparameters HWnd As Integer,;
		Msg As Integer, ;
		wParam As Integer, ;
		lParam As Integer

	Do Case
	Case  wParam=1000   &&CTRL+F6   capture pixel
		cr=Chr(13)+Chr(10)
		With Thisform
			ystring="Pixel AT: ["+Trans(.posx)+","+Trans(.posy)+"]"+cr+;
				"PxColor= "+Trans(.pixelcolor)+cr+;
				"RGB= "+Trans(.rgbcolor)+cr+;
				"Hex= "+(.hexcolor)+cr  +;
				"Html= "+(.htmlcolor)+cr+;
				"CMYK= "+(.cmykcolor)+cr+;
				(.hsvcolor)+cr+cr
		Endwith
		*_cliptext=ystring    &&problem with clipboard and timer....???
		Set Safe Off
		=Strtofile(ystring,m.yrep+"ypix.txt")
		Set Safe On
		Messagebox(ystring+;
			"The Result is copied to ypix.txt.",0+32,"YcolorPicker")

	Case  wParam=1001    &&CTRL+F7    -------ColorPicker
		Thisform.ycolorpicker()
	Endcase
	Endproc

	Procedure ybuild
	Local m.afile
	m.afile=Addbs(Sys(2023))+"ycapt.prg"
	Set Textmerge On To  (afile) Noshow
	
	TEXT
		yform=createObject("asup")
		yform.show(1)
		*Yousfi benameur
		*-- Time Stamp:   11/23/08 09:59:11 PM
		*
		DEFINE CLASS asup AS form
			Top = 9
			Left = 252
			Height = 140
			Width = 138
			DoCreate = .T.
			Caption = ""
			Name = "Form1"

			ADD OBJECT image1 AS image WITH ;
				Stretch = 2, ;
				Height = 140, ;
				Left = 0, ;
				Top = 0, ;
				Width = 140, ;
				Name = "Image1"

		PROCEDURE Init

				this.borderstyle=0
				this.maxbutton=.f.
				this.minbutton=.f.
				this.image1.picture="
	ENDTEXT
		\\<<lcdest>>"
	TEXT
			ENDPROC

			PROCEDURE Destroy
			dele file (addbs(sys(2023))+"ycap*.jpg"
			ENDPROC
		ENDDEFINE

	ENDTEXT
	Set Textmerge To

	Do (afile)

	Endproc

	Procedure MouseDown
	Lparameters nButton, nShift, nXCoord, nYCoord
	Declare Integer GetFocus In WIN32API
	lnHandle =thisform.hwnd    && GetFocus()
	param1 = 274
	param2 = 0xF012
	Declare Integer ReleaseCapture In WIN32API
	Declare Integer SendMessage In WIN32API Integer, Integer, Integer, Integer
	bb=ReleaseCapture()
	bb=SendMessage(lnHandle, param1, param2,0)
	Endproc

	Procedure Load
	Declare Integer RegisterHotKey In user32;
		integer HWnd,;
		integer Id,;
		integer fsModifiers,;
		integer vk

	Declare Integer UnregisterHotKey In user32;
		INTEGER HWnd,;
		INTEGER Id
	Declare Sleep In Win32API Integer
	Declare short GetCursorPos In win32api String @ lpPoint
	Declare Integer GetWindowDC In Win32API Integer HWnd
	Declare Integer GetPixel In win32API  Integer hdc, Integer nXPos, Integer nYPos


	Declare Integer ChooseColor In comdlg32 String @lpcc
	Declare Integer GetActiveWindow In user32
	Declare Integer GlobalFree In kernel32 Integer Hmem
	Declare RtlZeroMemory In kernel32 As ZeroMemory;
		INTEGER Dest, Integer numBytes

	Declare Integer GlobalAlloc In kernel32;
		INTEGER wFlags, Integer dwBytes

	Declare RtlMoveMemory In kernel32 As Heap2Str;
		STRING @, Integer, Integer
	Endproc

	Procedure Destroy
	Debugout 'UNregistre'
	UnregisterHotKey(This.HWnd, 1000)  &&ctrl+f6
	UnregisterHotKey(This.HWnd, 1001)  &&ctrl+f7
    clea dlls
	Clea Events   &&&&&&&&&&&&&&&&&&&&&&&&&
	Endproc

	Procedure Init
	Publi lcdest
	This.TitleBar=0
	*this.borderstyle=0
	If  Fontmetric(1, 'MS Sans Serif', 8, '') # 13 Or ;
			fontmetric(4, 'MS Sans Serif', 8, '') # 2 Or ;
			fontmetric(6, 'MS Sans Serif', 8, '') # 5 Or ;
			fontmetric(7, 'MS Sans Serif', 8, '') # 11
		This.SetAll('fontname', 'Tahoma')
	Else
		This.SetAll('fontname','MS Sans Serif')
	Endif
	This.SetAll('fontsize',7)
	
	#Define MOD_ALT     0x001     && Alt key
	#Define MOD_CTRL    0x002     && Ctrl key
	#Define MOD_SHIFT   0x004     && Shift key
	#Define MOD_WIN     0x008     && Windows key
	#Define vk_F6 0x75    &&Virtual key F6
	#Define vk_F7 0x76    &&Virtual key F7
	#Define	WM_HOTKEY 		0x312

	yresult1 = RegisterHotKey(Thisform.HWnd,1000,MOD_CTRL,vk_F6)    && CTRL+F6
	If yresult1#0
	Else
		Messagebox("the hotkey CTRL+F6  is not registrered-Fail !"+Transform(yresult1))
		*	return .F.  &&if cancel
	Endif

	yresult2 = RegisterHotKey(Thisform.HWnd,1001,MOD_CTRL,vk_F7)    && CTRL+F7
	If yresult2#0
	Else
		Messagebox("the hotkey CTRL+F7  is not registrered-Fail !"+Transform(yresult2))
		*	return .F. &&if cancel
	Endif

	Bindevent(Thisform.HWnd, WM_HOTKEY, Thisform, "yBind")
	cr=Chr(13)
	xpub=cr+"Hotkeys for yPix"+cr+;
		" -CTR+F6 Copy to clipboard"+cr+;
		" -CTR+F7 colorPicker"+cr+;
        " -P open ypix.txt"+cr+;
		"-C=Capture any window to clipboard"+cr+;
		"-Clic for summary help."

	This.ypub.Caption=xpub
	This.ypub.Visible=.F.
	Endproc

	Procedure ypub.MouseDown
	Lparameters nButton, nShift, nXCoord, nYCoord
	Declare Integer GetFocus In WIN32API
	lnHandle = GetFocus()
	param1 = 274
	param2 = 0xF012
	Declare Integer ReleaseCapture In WIN32API
	Declare Integer SendMessage In WIN32API Integer, Integer, Integer, Integer
	bb=ReleaseCapture()
	bb=SendMessage(lnHandle, param1, param2,0)
	Endproc

	Procedure ypub.Click
	Local m.myvar
	TEXT to myVar noshow
		This color manager yPix is a 100% VFP9 program , do the follow things and retrieve:
	 - the positions X and Y at any screen point (including windows,taskbar...)
	 - the VFP color (RGB color) as an integer
	 - the Hexadecimal color
	 - the HTML color
	 - the CMYK(Cyan,magenta,yellow,key black) color
	 - The HSV color
	 -It have two  hotkey programmed for
	   1.CTRL+F6....Show and Copy the current properties of the point to ypix.txt
	   2. CTRL+F7...Fires a colorPicker (expanded).Choose a color+return to copy .
	 - The capture of any window (not very efficient because timer) .
	 The form is movable by the mouse -Any feedBack is welcome.My source is free for any futur developpment.
	 -Warning : The clipboard is disturbed by the timer & APIs.
	 *Author :Yousfi Benameur EL Bayadh ALGERIA
	 *Time stamp  11/23/08 06:24:02 PM
	ENDTEXT
	Try
		Local lcBell
		lcBell = Set("Bell")
		Set Bell To (Addbs(Getenv('windir')))+"MEDIA\notify.WAV"
		?? Chr(7)
		Set Bell To (lcBell)
	Catch
	Endtry
	Messagebox(myvar,0+32+4096,"Summary help- About" )
	Endproc

	Procedure timer1.Timer
	With Thisform
		If .posx>.Left And .posx<=.Left+.Width And .posy>=.Top And .posy<=.Top+.Height
			For i=1 To .ControlCount
				If Lower(.Controls(i).Class)#"timer" And Lower(.Controls(i).Name)#"lblclose" ;
						and Lower(.Controls(i).Name)#"lblmin"   ;
						and Lower(.Controls(i).Name)#"ypix"  And Lower(.Controls(i).Name)#"lblcap"
					.Controls(i).Visible=.F.
				Endi
			Endfor
			.ypub.Visible=.T.
		Else
			For i=1 To .ControlCount
				If Lower(.Controls(i).Class)#"timer"
					.Controls(i).Visible=.T.
				Endi
			Endfor
			.ypub.Visible=.F.
		Endi
	
		lpPoint = Space(8)
		If GetCursorPos(@lpPoint)#0
			.posx = Asc(Substr(lpPoint,1))*256^0+;
				asc(Substr(lpPoint,2))*256^1+;
				asc(Substr(lpPoint,3))*256^2+;
				asc(Substr(lpPoint,4))*256^3
			.posy = Asc(Substr(lpPoint,5))*256^0+;
				asc(Substr(lpPoint,6))*256^1+;
				asc(Substr(lpPoint,7))*256^2+;
				asc(Substr(lpPoint,8))*256^3
			Thisform.lblpixelat.Caption="Pixel AT: ["+Trans(.posx)+","+Trans(.posy)+"]"
			.pixelcolor = GetPixel(GetWindowDC(0), .posx, .posy)
			Thisform.lblcolor.Caption="PxColor= "+Trans(.pixelcolor)
			.rgbcolor = .color2rgb(.pixelcolor)
			Thisform.lblrgbcolor.Caption="RGB= "+Trans(.rgbcolor)
			.hexcolor = Stuff(Transform(.pixelcolor,'@0'),3,2,'')
			Thisform.lblhexcolor.Caption="Hex= "+Trans(.hexcolor)
		
			lcColor=Right(Transform(.pixelcolor,"@0"),6)
			.htmlcolor="#" + Substr(lcColor,5,2) + Substr(lcColor,3,2) + Left(lcColor,2)
			Thisform.lblhtmlcolor.Caption="Html= "+ .htmlcolor
		
			&&CMKY color
			tnColor=.pixelcolor
			R	= Bitrshift(Bitand(tnColor, 0x0000FF),0)
			G	= Bitrshift(Bitand(tnColor, 0x00FF00),8)
			B	= Bitrshift(Bitand(tnColor, 0xFF0000),16)
			xcolorRGB= Trans(R)+","+Trans(G)+","+Trans(B)
			Ct = (1-(R/255 ))
			Mt = (1-(G/255 ))
			Yt = (1-(B/255 ))
			Kt=Min(Ct,Mt,Yt)
			C=Min(1,Max(0,Ct-Kt))
			M=Min(1,Max(0,Mt-Kt))
			Y=Min(1,Max(0,Yt-Kt))
			K=Min(1,Max(0,Kt))
			.cmykcolor="("+Trans(Round(100*C,0))+" , "+Trans(Round(100*M,0))+" , "+Trans(Round(100*Y,0))+" , "+Trans(Ceiling(100*K))+" )"
			Thisform.lblcmykcolor.Caption="CMYK= "+ .cmykcolor

			*RGB TO HSV
		
			tnColor=.pixelcolor
			_Cliptext=Trans(tnColor)
			R	= Bitrshift(Bitand(tnColor, 0x0000FF),0)
			G	= Bitrshift(Bitand(tnColor, 0x00FF00),8)
			B	= Bitrshift(Bitand(tnColor, 0xFF0000),16)
			xcolorRGB= Trans(R)+","+Trans(G)+","+Trans(B)
			Red =100*( R / 255 )
			Green = 100*( G / 255 )
			Blue = 100*( B / 255 )
			Temp = (Red + Green + Blue) / 3
			xx = (Green - Red) / Sqrt(2)
			yy = (Blue + Blue - Red - Green) / Sqrt(6)
			aa=Thisform.yarg(  xx,yy)
			Hue = aa * 180 / Pi() + 150
			aa=Thisform.ymodule(Red - Temp, Green-Temp,Blue-Temp)
			Saturation =Thisform.yarg(Temp,aa*100/Atan(Sqrt(6)) )
			value_ = Temp / 2.55
			If Saturation = 0 Or value_ = 0
				Hue = 0
			Endi
			If Hue < 0
				Hue = Hue + 360
			Endi
			If Hue >= 360
				Hue = Hue - 360
			Endi
			del_Max = Max(Red,Green,Blue) - Min(Red,Green,Blue)
			value_ = Max(Red,Green,Blue)
			If  del_Max = 0                      &&This is a gray, no chroma...
				S = 0
			Else
				S = del_Max /Max(Red,Green,Blue)
			Endi
	
			H=Ceiling(Hue)
			S=Ceiling(100*S)
			V=Ceiling(value_)

			.hsvcolor="HSV= ("+Trans(H)+","+Trans(S)+","+Trans(V)+")"
			Thisform.lblhsvcolor.Caption=.hsvcolor
		
			.colorshower.BackColor = .pixelcolor
			.Refresh()
		Endif
	Endwith

	Endproc

	Procedure lblclose.Click
	Clea
	Thisform.Release
	Endproc


	Procedure ypix.Click
	Local m.oo
	m.oo=m.yrep+"ypix.txt"
	Run/N "notepad" &oo
	Endproc


	Procedure lblmin.Click
	Thisform.WindowState=1
	Endproc

	Procedure lblcap.Click
	Messagebox("To snapshot any active window,validate ok+clic on this window---capture in 2 seconds   !",0+64+4096,"")
	Thisform.Visible=.F.
	Thisform.timer1.Enabled=.F.
	t0=Seconds()
	Do While Seconds()-t0<=2
	Enddo

	&&capture window
	Declare Integer keybd_event In Win32API ;
		INTEGER, Integer, Integer, Integer
	VK_SNAPSHOT = 44    && from the winuser.h
	VK_LMENU = 164
	KEYEVENTF_KEYUP = 2
	KEYEVENTF_EXTENDEDKEY = 1

	*The following commands copy the active application window to the
	*clipboard (the equivalent of ALT+PrintScrn):
	DoEvents
	keybd_event( VK_LMENU,    0, KEYEVENTF_EXTENDEDKEY, 0 )  && key down
	keybd_event( VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0 )
	keybd_event( VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0 )
	keybd_event( VK_LMENU,    0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0 )
	DoEvents

	Inkey(0.5)
	oshell=Createobject("wscript.shell")
	Run/n3 mspaint
	Inkey(3)
	oshell.sendkeys("^{v}")
	Inkey(1)
	Thisform.Visible=.T.
	Thisform.timer1.Enabled=.T.
	Endproc

Enddefine
*
*-- EndDefine: ypix


yPix: a desktop vfp colorPicker
yPix: a desktop vfp colorPicker
yPix: a desktop vfp colorPicker
 
*Important:*the code above is tested on visual foxpro 9 sp2-under windows 10 pro

To be informed of the latest articles, subscribe:
Comment on this post