converting web colors to RGB

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')

Schreibe einen Kommentar