{
===============================================================================
  Copyright (©) 2001. Rodax Software.
===============================================================================
  Los contenidos de este fichero son propiedad de Rodax Software titular del
  copyright. Este fichero sólo podrá ser copiado, distribuido y utilizado,
  en su totalidad o en parte, con el permiso escrito de Rodax Software, o de
  acuerdo con los términos y condiciones establecidas en el acuerdo/contrato
  bajo el que se suministra.
  -----------------------------------------------------------------------------
  Web:  www.rodax-software.com
===============================================================================
  Fecha primera versión: 01-10-2001
  Versión actual: 1.0.0
  Fecha versión actual: 01-10-2001
===============================================================================
  Modificaciones:

    Fecha         Comentarios
    ---------------------------------------------------------------------------
===============================================================================
}

unit Colores;

{$C PRELOAD}
{$I ..\COMPILE.INC}

interface

uses Classes, Controls, Graphics, Forms;

const
  clWindowColor = TColor($00616161);





  rdxDarkBlue = TColor($885522);
  rdxBlue = TColor($CF9030);
  rdxLightBlue = TColor($DCCBAD);
  rdxDarkRed = $001F1A62;
  rdxRed = $00564EBA;
  rdxLightRed = $00BCBBEE;
  rdxDarkGreen = $00385937;
  rdxGreen = $005E8152;
  rdxLightGreen = $0093CAB1;
  rdxDarkYellow = $00237285;
  rdxYellow = $0047B3CD;
  rdxLightYellow = $00AEE1E6;
  rdxDarkPink = $006D1555;
  rdxPink = $00B5539F;
  rdxLightPink = $00DDB7DD;
  rdxDarkBrown = $0008305E; //$00257589;
  rdxBrown = $00057CF5; //$00555E66;
  rdxLightBrown = $009FCEFF; //$00829AA2;
  rdxHueso = $00F9FEFF;
  rdxSepiaClaro = $00EFF7F7;
  rdxSepia = $00D9E5E9;
  rdxSepiaOscuro = $008396A0;
  rdxSepiaAmarillo = $00C2F0FF;
  rdxGris = $005C5C5C;
  rdxGrisMedio = $003F3F3F;
  rdxGrisOscuro = $00373737;

//function RdxIdentToColor(const Ident: string; var Color: Longint): Boolean;
function RdxColorToString(Color: TColor): string;
function RdxStringToColor(S: string): TColor;
procedure RdxGetColorValues(Proc: TGetStrProc);
procedure Register;

implementation

uses
  Windows, SysUtils
  {$IFDEF RDX_D6}, DesignIntf, VCLEditors{$ELSE}, DsgnIntf{$ENDIF};

type
  TColorEntry = record
    Value: TColor;
    Name: PChar;
  end;

const
  ColorCount = 26;
  Colors: array[0..ColorCount - 1] of TColorEntry = (
    (Value: rdxDarkBlue;    Name : 'rdxDarkBlue'),
    (Value: rdxBlue;        Name : 'rdxBlue'),
    (Value: rdxLightBlue;   Name : 'rdxLightBlue'),
    (Value: rdxDarkRed;     Name : 'rdxDarkRed'),
    (Value: rdxRed;         Name : 'rdxRed'),
    (Value: rdxLightRed;    Name : 'rdxLightRed'),
    (Value: rdxDarkGreen;   Name : 'rdxDarkGreen'),
    (Value: rdxGreen;       Name : 'rdxGreen'),
    (Value: rdxLightGreen;  Name : 'rdxLightGreen'),
    (Value: rdxDarkYellow;  Name : 'rdxDarkYellow'),
    (Value: rdxYellow;      Name : 'rdxYellow'),
    (Value: rdxLightYellow; Name : 'rdxLightYellow'),
    (Value: rdxDarkPink;    Name : 'rdxDarkPink'),
    (Value: rdxPink;        Name : 'rdxPink'),
    (Value: rdxLightPink;   Name : 'rdxLightPink'),
    (Value: rdxDarkBrown;   Name : 'rdxDarkBrown'),
    (Value: rdxBrown;       Name : 'rdxBrown'),
    (Value: rdxLightBrown;  Name : 'rdxLightBrown'),
    (Value: rdxHueso;       Name: 'rdxHueso'),
    (Value: rdxSepiaClaro;  Name: 'rdxSepiaClaro'),
    (Value: rdxSepia;       Name: 'rdxSepia'),
    (Value: rdxSepiaOscuro; Name: 'rdxSepiaOscuro'),
    (Value: rdxSepiaAmarillo; Name: 'rdxSepiaAmarillo'),
    (Value: rdxGris;        Name: 'rdxGris'),
    (Value: rdxGrisMedio;   Name: 'rdxGrisMedio'),
    (Value: rdxGrisOscuro;  Name: 'rdxGrisOscuro')
    );


function RdxColorToString(Color: TColor): string;
var
  I: Integer;
begin
  if not ColorToIdent(Color, Result) then begin
    for I := Low(Colors) to High(Colors) do
      if Colors[I].Value = Color then
      begin
        Result := StrPas(Colors[I].Name);
        Exit;
      end;
    FmtStr(Result, '$%.8x', [Color]);
  end;
end;

{function RdxIdentToColor(const Ident: string; var Color: Longint): Boolean;
var
  I: Integer;
  Text: array[0..63] of Char;
begin
  StrPLCopy(Text, Ident, SizeOf(Text) - 1);
  for I := Low(Colors) to High(Colors) do
    if StrIComp(Colors[I].Name, Text) = 0 then begin
      Color := Colors[I].Value;
      Result := True;
      Exit;
    end;
  Result := IdentToColor(Ident, Color);
end;}

function RdxStringToColor(S: string): TColor;
var
  I: Integer;
  Text: array[0..63] of Char;
begin
  StrPLCopy(Text, S, SizeOf(Text) - 1);
  for I := Low(Colors) to High(Colors) do
    if StrIComp(Colors[I].Name, Text) = 0 then
    begin
      Result := Colors[I].Value;
      Exit;
    end;
  Result := StringToColor(S);

{  if not RdxIdentToColor(S, Longint(Result)) then
    Result := StringToColor(S);}
end;

procedure RdxGetColorValues(Proc: TGetStrProc);
var
  I: Integer;
begin
  GetColorValues(Proc);
  for I := Low(Colors) to High(Colors) do Proc(StrPas(Colors[I].Name));
end;


type
  TRdxColorProperty = class(TColorProperty)
  public
    function GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
{$IFDEF RDX_D5}
    procedure ListDrawValue(const Value: string; ACanvas: TCanvas;
      const ARect: TRect; ASelected: Boolean);{$IFNDEF RDX_D6} override;{$ENDIF}
{$ENDIF}
  end;

function TRdxColorProperty.GetValue: string;
var
  Color: TColor;
begin
  Color := TColor(GetOrdValue);
  Result := RdxColorToString(Color);
end;

procedure TRdxColorProperty.GetValues(Proc: TGetStrProc);
begin
  RdxGetColorValues(Proc);
end;

procedure TRdxColorProperty.SetValue(const Value: string);
begin
  SetOrdValue(RdxStringToColor(Value));
end;

{$IFDEF RDX_D5}
procedure TRdxColorProperty.ListDrawValue(const Value: string; ACanvas: TCanvas;
  const ARect: TRect; ASelected: Boolean);

  function ColorToBorderColor(AColor: TColor): TColor;
  type
    TColorQuad = record
      Red, Green, Blue, Alpha: Byte;
    end;
  begin
    if (TColorQuad(AColor).Red > 192) or (TColorQuad(AColor).Green > 192) or
       (TColorQuad(AColor).Blue > 192) then
      Result := clBlack
    else if ASelected then
      Result := clWhite
    else
      Result := AColor;
  end;

var
  vRight: Integer;
  vOldPenColor, vOldBrushColor: TColor;
begin
  vRight := (ARect.Bottom - ARect.Top) + ARect.Left;
  with ACanvas do
  try
    vOldPenColor := Pen.Color;
    vOldBrushColor := Brush.Color;
    Pen.Color := Brush.Color;
    Rectangle(ARect.Left, ARect.Top, vRight, ARect.Bottom);
    Brush.Color := RdxStringToColor(Value);
    Pen.Color := ColorToBorderColor(ColorToRGB(Brush.Color));
    Rectangle(ARect.Left + 1, ARect.Top + 1, vRight - 1, ARect.Bottom - 1);
    Brush.Color := vOldBrushColor;
    Pen.Color := vOldPenColor;
  finally
    ACanvas.TextRect(Rect(vRight, ARect.Top, ARect.Right, ARect.Bottom), 
      vRight + 1, ARect.Top + 1, Value);
  end;
end;
{$ENDIF}

procedure Register;
begin
  RegisterPropertyEditor(TypeInfo(TColor), TPersistent, '', TRdxColorProperty);
end;

end.

