Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example:
#Compiler PBWin 10
#Compile Exe
#Dim All
#Debug Error On
#Debug Display On
%Unicode = 1
#Include "Win32API.inc"
%CellSize = 70
%IDC_Graphic = 500
Type ColorList
c As Long 'color
cr As Single 'contrast ratio
End Type
Global hDlg As Dword, C() As Long, CRList() As ColorList
Global iSelected, jSelected, cSelected As Long
Function PBMain() As Long
Dialog New Pixels, 0, "Colors",,,18*%CellSize,9*%CellSize, %WS_OverlappedWindow To hDlg
Control Add Graphic, hDlg, %IDC_Graphic,"",0,0,18*%CellSize,9*%CellSize, %SS_Notify
Graphic Attach hDlg, %IDC_Graphic, ReDraw
Graphic Clear
DrawColors
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Select Case Cb.Msg
Case %WM_Command
Select Case Cb.Ctl
Case %IDC_Graphic
RespondToClick 'sets iSelected, jSelected, cSelected
DrawColors
HighLightSelectedCell
GetCRForAllCells
Array Sort CRList(), Call SortByCR()
DrawTop27ContrastingColors 'draws top nine CR values, in order
End Select
Case %WM_ContextMenu : Dialog End hDlg
Case %WM_Help
Local temp$, i As Long
For i = 1 To 13*9
temp$ += Str$(CRList(i).cr)
Next i
? Temp$
End Select
End Function
Sub RespondToClick
Local pt As Point, i,j,R,G,B As Long, rc As Rect
iSelected = 0 : jSelected = 0
GetCursorPos pt : ScreenToClient hDlg, pt
For i = 1 To 13
For j = 1 To 9
rc.nLeft = (i-1)*%CellSize
rc.nTop = (j-1)*%CellSize
rc.nRight = rc.nLeft + %CellSize
rc.nBottom = rc.nTop + %CellSize
If PtInRect(rc,pt) Then
R = GetRValue(C(i,j))
G = GetGValue(C(i,j))
B = GetBValue(C(i,j))
Dialog Set Text hDlg, "Colors Cell:" + Str$(i) + Str$(j) + " RGB:" + Str$(R) + Str$(G) + Str$(B)
Clipboard Reset
Clipboard Set Text Str$(R) + Str$(G) + Str$(B)
iSelected = i : jSelected = j : cSelected = C(i,j)
Exit Sub
End If
Next j
Next i
End Sub
Sub DrawColors
Local i,j,iCount,x,y,R,G,B As Long
ReDim C(13,9)
Graphic Clear
For j = 1 To 9
For i = 1 To 13
Incr iCount : R = Val(Read$(iCount))
Incr iCount : G = Val(Read$(iCount))
Incr iCount : B = Val(Read$(iCount))
C(i,j) = RGB(R,G,B)
Next i
Next j
Graphic Width 3
For i = 1 To 13
For j = 1 To 9
x = (i-1)*%CellSize
y = (j-1)*%CellSize
Graphic Set Pos(x,y)
Graphic Box (x,y)-(x+%CellSize,y+%CellSize),, %Black, C(i,j)
Graphic Box (x,y)-(x+%CellSize,y+%CellSize),, %Black, -2
Next j
Next i
'Row1
Data 51,0,0
Data 51,25,0
Data 51,51,0
Data 25,51,0
Data 0,51,0
Data 0,51,25
Data 0,51,51
Data 0,25,51
Data 0,0,51
Data 25,0,51
Data 51,0,51
Data 51,0,25
Data 0,0,0
'Row2
Data 102,0,0
Data 102,51,0
Data 102,102,0
Data 51,102,0
Data 0,102,0
Data 0,102,51
Data 0,102,102
Data 0,51,102
Data 0,0,102
Data 51,0,102
Data 102,0,102
Data 102,0,51
Data 32,32,32
'Row3
Data 153,0,0
Data 153,76,0
Data 153,153,0
Data 76,153,0
Data 0,153,0
Data 0,153,76
Data 0,153,153
Data 0,76,153
Data 0,0,153
Data 76,0,153
Data 153,0,153
Data 153,0,76
Data 64,64,64
'Row4
Data 204,0,0
Data 204,102,0
Data 204,204,0
Data 102,204,0
Data 0,204,0
Data 0,204,102
Data 0,204,204
Data 0,102,204
Data 0,0,204
Data 102,0,204
Data 204,0,204
Data 204,0,102
Data 96,96,96
'Row5
Data 255,0,0
Data 255,128,0
Data 255,255,0
Data 128,255,0
Data 0,255,0
Data 0,255,128
Data 0,255,255
Data 0,128,253
Data 0,0,255
Data 127,0,255
Data 255,0,255
Data 255,0,127
Data 128,128,128
'Row6
Data 255,51,51
Data 255,153,51
Data 255,255,51
Data 153,255,51
Data 51,255,51
Data 51,255,153
Data 51,255,255
Data 51,153,255
Data 51,51,255
Data 153,51,255
Data 255,51,255
Data 255,51,153
Data 160,160,160
'Row7
Data 255,102,102
Data 255,178,102
Data 255,255,102
Data 178,255,102
Data 102,255,102
Data 102,255,178
Data 102,255,255
Data 102,178,255
Data 102,102,255
Data 178,102,255
Data 255,102,255
Data 255,102,178
Data 192,192,192
'Row8
Data 255,153,153
Data 255,204,153
Data 255,255,153
Data 204,255,153
Data 153,255,153
Data 153,255,204
Data 153,255,255
Data 153,204,255
Data 153,153,255
Data 204,153,255
Data 255,153,255
Data 255,153,204
Data 224,224,224
'Row9
Data 255,204,204
Data 255,229,204
Data 255,255,204
Data 229,255,204
Data 204,255,204
Data 204,255,229
Data 204,255,255
Data 204,229,255
Data 204,204,255
Data 229,204,255
Data 255,204,255
Data 255,204,229
Data 255,255,255
End Sub
Function ContrastRatio(Color1 As Long, Color2 As Long) As Single
Local Result, L1, L2 As Single, R,G,B As Long
R = GetRValue(Color1)
G = GetGValue(Color1)
B = GetBValue(Color1)
If R/255 <= 0.3928 Then R = R/255/12.92 Else R = ((R/255+0.055)/1.055)^2.4
If G/255 <= 0.3928 Then G = G/255/12.92 Else G = ((G/255+0.055)/1.055)^2.4
If B/255 <= 0.3928 Then B = B/255/12.92 Else B = ((B/255+0.055)/1.055)^2.4
L1 = 0.2126 * R + 0.7152 * G + 0.0722 * B
R = GetRValue(Color2)
G = GetGValue(Color2)
B = GetBValue(Color2)
If R/255 <= 0.3928 Then R = R/255/12.92 Else R = ((R/255+0.055)/1.055)^2.4
If G/255 <= 0.3928 Then G = G/255/12.92 Else G = ((G/255+0.055)/1.055)^2.4
If B/255 <= 0.3928 Then B = G/255/12.92 Else B = ((B/255+0.055)/1.055)^2.4
L2 = 0.2126 * R + 0.7152 * G + 0.0722 * B
Result = (L1 + 0.05) / (L2 + 0.05)
If Result < 1 Then Result = 1 / Result
Function = Result
End Function
Sub HighlightSelectedCell
Local x,y As Long
Graphic Width 11
x = (iSelected-1)*%CellSize
y = (jSelected-1)*%CellSize
Graphic Set Pos(x,y)
Graphic Box (x,y)-(x+%CellSize,y+%CellSize),, %Black, -2
End Sub
Sub GetCRForAllCells
Local i,j,iCount As Long
ReDim CRList(13*9)
For i = 1 To 13
For j = 1 To 9
Incr iCount
CRList(iCount).c = C(i,j) 'color
CRList(iCount).cr = ContrastRatio( C(i,j), cSelected ) 'contrast ratio
Next j
Next i
End Sub
Function SortByCR(A As ColorList, B As ColorList) As Long
' -1 if 1st should precede 2nd : +1 if 2nd should precede 2nd
' this routine sorts on the .cr (single) element of the UDT
Function = IIf(A.cr > B.cr, -1, +1) 'descending numeric
End Function
Sub DrawTop27ContrastingColors
Local i,j,x,y,iCount As Long
'display the top 27 CR colors (3 rows of 9) from the sorted CRList()
Graphic Width 3
For i = 1 To 3
For j = 1 To 9
x = (13+i) * %CellSize 'draw in columns 14, 15, 16
y = (j-1) * %CellSize 'draw in rows 1-9
Incr iCount
Graphic Set Pos(x,y)
Graphic Box (x,y)-(x+%CellSize,y+%CellSize),, %Black, CRList(iCount).c
Next j
Next i
Graphic ReDraw
End Sub
http://www.garybeene.com/sw/gbsnippets.htm