Home > Delphi > Superfast Netscape palette lookup formula

Superfast Netscape palette lookup formula

October 14, 2013 Leave a comment Go to comments

This is probably one of the fastest color lookup functions out there for converting 24/32 bit RGB values to an 8bit fixed palette (Netscape palette). I take for granted that you add stuff like your own exceptions and extract what you need from this code.

Netscape palette

Netscape palette

Here we go (note: the exportColorObj method should be removed, it requires a different class not yet published):

TSLPaletteCustom = Class(TPersistent)
Protected
  Function  GetByteSize:Integer;virtual;
  Procedure GetItemQuad(Index:Integer;Var Data);virtual;abstract;
  Function  GetCount:Integer;virtual;abstract;
  Function  GetItem(index:Integer):TColor;virtual;abstract;
  Procedure SetItem(Index:Integer;Value:TColor);virtual;abstract;
  Function  GetReadOnly:Boolean;virtual;abstract;
Protected
  procedure AssignTo(Dest: TPersistent);Override;
Public
  Property  ReadOnly:Boolean read GetReadOnly;
  Property  Items[index:Integer]:TColor
            read GetItem write SetItem;
  Property  Count:Integer read GetCount;
  Property  Size:Integer read GetByteSize;

  Procedure ExportQuadArray(Const Target);
  Procedure ExportRGB(Const index:Integer;var R,G,B:Byte);virtual;
  function  ExportColorObj(Const index:Byte):TSLPaletteColor;

  Function  Match(r,g,b:Byte):Integer;overload;dynamic;abstract;
  Function  Match(Value:TColor):Integer;overload;dynamic;
End;

TSLPaletteNetScape = Class(TSLPaletteCustom)
Private
  FQuads:     TRGBQuadArray;
Protected
  Function    GetReadOnly:Boolean;override;
  Procedure   GetItemQuad(Index:Integer;Var Data);override;
  Function    GetCount:Integer;override;
  Function    GetItem(index:Integer):TColor;override;
  Procedure   SetItem(Index:Integer;Value:TColor);override;
Public
  Procedure   ExportRGB(Const index:Integer;var R,G,B:Byte);override;
  Function    Match(r,g,b:Byte):Integer;override;
  Constructor Create;virtual;
End;

//###########################################################################
//  TSLPaletteNetScape
//###########################################################################

Constructor TSLPaletteNetscape.Create;
var
  FIndex: Integer;
  r,g,b:  Byte;
begin
  inherited;
  for r:=0 to 5 do
  for g:=0 to 5 do
  for b:=0 to 5 do
  Begin
    FIndex:=b + g*6 + r*36;
    FQuads[FIndex].rgbRed:=r * 51;
    FQuads[FIndex].rgbGreen:=g * 51;
    FQuads[FIndex].rgbBlue:=b * 51;
  end;
end;

Procedure TSLPaletteNetScape.ExportRGB(Const index:Integer;var R,G,B:Byte);
Begin
  if (index>=0) and (index<CNT_SLPALETTE_NETSCAPE_COUNT) then
  Begin
    r:=FQuads[index].rgbRed;
    g:=FQuads[index].rgbGreen;
    b:=FQuads[index].rgbBlue;
  end else
  Raise ESLPalette.CreateFmt
  (ERR_SLPALETTE_INVALIDCOLORINDEX,[0,GetCount-1,index]);
end;

Function TSLPaletteNetScape.Match(r,g,b:Byte):Integer;
Begin
  R := (R+25) div 51;
  G := (G+25) div 51;
  B := (B+25) div 51;
  result:=(B + 6 * G + 36 * R);
end;

Function TSLPaletteNetScape.GetReadOnly:Boolean;
Begin
  result:=True;
end;

Procedure TSLPaletteNetScape.GetItemQuad(Index:Integer;Var Data);
Begin
  If (Index>=0) and (index<CNT_SLPALETTE_NETSCAPE_COUNT) then
  TRGBQuad(Data):=FQuads[index] else
  Raise ESLPalette.CreateFmt
  (ERR_SLPALETTE_INVALIDCOLORINDEX,[0,215,index]);
end;

Function TSLPaletteNetScape.GetCount:Integer;
Begin
  result:=CNT_SLPALETTE_NETSCAPE_COUNT;
end;

Function TSLPaletteNetScape.GetItem(index:Integer):TColor;
var
  FTemp:  PRGBQuad;
Begin
  If (Index>=0) and (index<CNT_SLPALETTE_NETSCAPE_COUNT) then
  Begin
    FTemp:=@FQuads[index];
    Result := (FTemp^.rgbRed
    or (FTemp^.rgbGreen shl 8 )
    or (FTemp^.rgbBlue shl 16) );
  end else
  Raise ESLPalette.CreateFmt
  (ERR_SLPALETTE_INVALIDCOLORINDEX,[0,CNT_SLPALETTE_NETSCAPE_COUNT-1,index]);
end;

Procedure TSLPaletteNetScape.SetItem(Index:Integer;Value:TColor);
Begin
  Raise ESLPalette.Create(ERR_SLPALETTE_PALETTEREADONLY);
end;

//###########################################################################
//  TSLPaletteCustom
//###########################################################################

procedure TSLPaletteCustom.AssignTo(Dest: TPersistent);
var
  x:  Integer;
Begin
  If Dest<>NIL then
  Begin
    if (dest is TSLPaletteCustom) then
    Begin
      if not TSLPaletteCustom(dest).ReadOnly then
      Begin
        for x:=1 to GetCount do
        TSLPaletteCustom(dest).Items[x-1]:=Items[x-1];
      end else
      Raise ESLPalette.Create(ERR_SLPALETTE_ASSIGNToREADONLY);
    end else
    Inherited;
  end else
  Inherited;
end;

Function TSLPaletteCustom.GetByteSize:Integer;
Begin
  result:=SizeOf(TRGBQuad) * GetCount;
end;

Procedure TSLPaletteCustom.ExportRGB(Const index:Integer;var R,G,B:Byte);
var
  FTemp:  TColor;
Begin
  if (index>=0) and (index<GetCount) then
  Begin
    FTemp:=GetItem(index);
    R:=Byte(FTemp);
    G:=Byte(FTemp shr 8);
    B:=Byte(FTemp shr 16);
  end else
  Raise ESLPalette.CreateFmt
  (ERR_SLPALETTE_INVALIDCOLORINDEX,[0,GetCount-1,index]);
end;

function TSLPaletteCustom.ExportColorObj(const index:Byte):TSLPaletteColor;
Begin
  result:=TSLPaletteColor.Create;
  result.ColorRef:=Items[index];
end;

Procedure TSLPaletteCustom.ExportQuadArray(Const Target);
var
  x:      Integer;
  FCount: Integer;
  FData:  PRGBQuadArray;
Begin
  FData:=@Target;
  If FData<>NIl then
  Begin
    FCount:=GetCount;
    for x:=1 to FCount do
    GetItemQuad(x-1,FData^[x-1]);
  end;
end;

Function TSLPaletteCustom.Match(Value:TColor):Integer;
Begin
  (* If palette reference, convert to RGB color *)
  {$IFDEF SL_USE_WINDOWS}
  If (Value shr 24)=$FF then
  Value:=GetSysColor(Value and $000000FF);
  {$ENDIF}

  (* Look it up. It's up to the implementor of the class to at least
     be able to match colors by RGB *)
  result:=Match(Byte(value),Byte(value shr 8),Byte(value shr 16));
end;
Advertisements
  1. Jon Lennart Aasenden
    October 14, 2013 at 10:45 am

    Note: ExportColorObj() can be rem’ed out.

  1. No trackbacks yet.

Leave a Reply

Please log in using one of these methods to post your comment:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: