Jeff Slarve:
program
Map
RGBHex(Long pL),String
WEBHexToColor(String pWebColor),Long
end
c Long
Color Group,Over(c)
Red Byte
Green Byte
Blue Byte
Byte
end
RGB String(7)
Window WINDOW('RGB Sample'),AT(,,135,63),FONT('MS Sans Serif',8,,),|
CENTER,SYSTEM,GRAY,DOUBLE
STRING('Red'),AT(3,3),USE(?String4::)
SPIN(@n3),AT(28,3,29,10),USE(color.red),RANGE(0,255)
STRING('Green'),AT(3,16),USE(?String4:)
SPIN(@n3),AT(28,16,29,10),USE(color.green),RANGE(0,255)
STRING('Blue'),AT(3,28),USE(?String4)
SPIN(@n3),AT(28,28,29,10),USE(color.blue),RANGE(0,255)
BOX,AT(60,2,59,57),USE(?Box1),COLOR(COLOR:Black),FILL(COLOR:Black)
TEXT,AT(4,42,53,10),USE(RGB),SINGLE
BUTTON('...'),AT(121,2,12,12),USE(?ColorButton)
END
Code
Open(Window)
c = Color:Red
RGB = RGBHex(c)
?Box1{PROP:Fill}=c
Accept
Case Event()
of Event:OpenWindow
Select(?Color:Red) !Workaround for Display(?Text) Bug
of Event:NewSelection
Do DisplayColor
of Event:Accepted
Case Field()
of ?RGB
c = WebHexToColor(RGB)
?Box1{PROP:FILL} = c
Display
Do DisplayColor
of ?Color:Red orof ?Color:Green orof ?Color:Blue
Do DisplayColor
Select(?) !Workaround for Display(?Text) Bug
of ?ColorButton
If ColorDialog('Pick Color',c)
Do DisplayColor
end
end
end
end
DisplayColor Routine
?Box1{PROP:Fill}=c
RGB = RGBHex(c)
Display(?RGB)
RGBHex PROCEDURE (Long pL)
HexDig STRING('0123456789ABCDEF'), STATIC
HexMap GROUP, PRE(), OVER(pL)
b4 BYTE
b3 BYTE
b2 BYTE
b1 BYTE
END
HexVal STRING(8), AUTO
CODE
HexVal[1] = '#'
HexVal[6] = HexDig[BSHIFT(b2, -4)+1]
HexVal[7] = HexDig[BAND(b2, 0Fh)+1]
HexVal[4] = HexDig[BSHIFT(b3, -4)+1]
HexVal[5] = HexDig[BAND(b3, 0Fh)+1]
HexVal[2] = HexDig[BSHIFT(b4, -4)+1]
HexVal[3] = HexDig[BAND(b4, 0Fh)+1]
RETURN HexVal
WEBHexToColor Procedure(String pWebColor)
LOC:WebColor String(7)
Code
LOC:WebColor = pWebColor
LOC:WebColor = Clip(Left(LOC:WebColor[2:7])) & All('0',7)
Return Evaluate('0' & LOC:WebColor[5:6] &|
LOC:WebColor[3:4] &|
LOC:WebColor[1:2] & 'h')