Code: Select all
#include once "windows.bi"
Declare Function CopyToClipboard(Byref x As String) As Integer
Function HSLtoRGB(hh As Integer,ss As Integer,ll As Integer) As Integer
Dim As Double v,fract, vsf, mid1, mid2,m,sv
Dim As Double h,s,l,r,g,b
Dim As Integer sextant
h = hh / 255
s = ss / 255
l = ll / 255
v = iif((l <= 0.5),(l * (1.0 + s)),(l + s - l * s))
If v <= 0 Then
r = g = b = 0.0
Else
m = l + l - v
sv = (v - m ) / v
h *= 6.0
sextant = Int(h)
fract = h - sextant
vsf = v * sv * fract
mid1 = m + vsf
mid2 = v - vsf
Select Case As Const sextant
Case 0
r = v
g = mid1
b = m
Case 1
r = mid2
g = v
b = m
Case 2
r = m
g = v
b = mid1
Case 3
r = m
g = mid2
b = v
Case 4
r = mid1
g = m
b = v
Case 5
r = v
g = m
b = mid2
End Select
End If
Return rgb(r * 255,g * 255,b * 255)
End Function
screenres 256,264,24,2
screenset 1,0
setmouse 127,127
Dim As Integer mx,my,mb,click,col,r,g,b,x,y
Do
Cls
getmouse mx,my,,mb
If mb = 0 Then click = 0
For y = 0 To 255
For x = 0 To 255
Pset (x,y),HSLtoRGB(x,255-y,iif(my >= 0 And my <= 255,my,127))
Next
Next
col = Point(mx,my)
r = ((col Shr 16) And &hff)
g = ((col Shr 8) And &hff)
b = (col And &hff)
Draw String (0,256),Str(mx) & " #" & Hex(r) & Hex(g) & Hex(b),HSLtoRGB(mx,127,127)
screencopy 1,0
If mb > 0 And click = 0 Then
click = 1
CopytoClipBoard(Hex(r) & Hex(g) & Hex(b))
While mb > 0
getmouse mx,my,,mb
If Len(Inkey) Then Exit Do
Wend
click = 0
While mb = 0
getmouse mx,my,,mb
If Len(Inkey) Then Exit Do
Wend
click = 1
End If
Sleep 10
Loop Until Len(Inkey)
System
Function CopyToClipboard(Byref x As String) As Integer
Function = false
Dim As HANDLE hText = NULL
Dim As Ubyte Ptr clipmem = NULL
Dim As Integer n = Len(x)
If n > 0 Then
hText = GlobalAlloc(GMEM_MOVEABLE Or GMEM_DDESHARE, n + 1)
Sleep 15
If (hText) Then
clipmem = GlobalLock(hText)
If clipmem Then
CopyMemory(clipmem, Strptr(x), n)
Else
hText = NULL
End If
If GlobalUnlock(hText) Then
hText = NULL
End If
End If
If (hText) Then
If OpenClipboard(NULL) Then
Sleep 15
If EmptyClipboard() Then
Sleep 15
If SetClipboardData(CF_TEXT, hText) Then
Sleep 15
Function = True
End If
End If
CloseClipboard()
End If
End If
End If
End Function