unit woColorListBox;
{
        Webocton - ColorListBox

        Von TListBox abgeleitete Komponente welche die in der
        Items-Eigenschaft im Hex-Format (#FFF, #FFFFFF) abgelegten Farben
        neben dem Farbwert graphisch anzeigt.
        Die Komponente ist somit ideal geeignet für eine anschauliche Darstellung
        einer beliebigen Anzahl von hexadezimal-definierten Farben.

        Version vom: 08.05.2004

        Copyright 2004-2008 by Benedikt Loepp
        Webocton

        benedikt@webocton.de
        www.webocton.de

        ---

        Benötigt wird Borland Delphi+Visual Component Library
}

interface

uses
    Windows,
    SysUtils,
    Classes,
    Controls,
    StdCtrls,
    Graphics;

type
    TwoColorListBox = class(TListBox)
    private
        function ColorToHex(const Color: TColor): string;
        function HexToColor(const Color: string): TColor;
        function GetColor(Index: Integer): TColor;
    protected
        procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    public
        property Colors[Index: Integer]: TColor read GetColor;
        constructor Create(AOwner: TComponent); override;
    published
    end;

procedure Register;

implementation

procedure Register;
begin
    RegisterComponents('Webocton - Components', [TwoColorListBox]);
end;

constructor TwoColorListBox.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);
    inherited Style := lbOwnerDrawFixed;
end;

function TwoColorListBox.HexToColor(const Color: string): TColor;
var
    r: string;
    g: string;
    b: string;
begin
    if (Length(Color) = 7) then
    begin
        r := Copy(Color, 2, 2);
        g := Copy(Color, 4, 2);
        b := Copy(Color, 6, 2);
    end
    else if (Length(Color) = 4) then
    begin
        r := Color[2] + Color[2];
        g := Color[3] + Color[3];
        b := Color[4] + Color[4];
    end;

    Result := clBlack;

    try
        Result := StringToColor('$00' + b + g + r);
    except
    end;
end;

function TwoColorListBox.ColorToHex(const Color: TColor): string;
var
    old: Integer;
    rgb: string;
    r: string;
    g: string;
    b: string;
begin
    old := ColorToRGB(Color);

    rgb := IntToHex(old, 6);

    r := rgb;
    g := rgb;
    b := rgb;

    Delete(r, 1, 4);
    Delete(g, 1, 2);
    Delete(g, 3, 2);
    Delete(b, 3, 4);

    rgb := r + g + b;

    Result := '#' + RGB;
end;

function TwoColorListBox.GetColor(Index: Integer): TColor;
begin
    Result := HexToColor(Items[Index]);
end;

procedure TwoColorListBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);

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

var
    LRect: TRect;
    LBackground: TColor;
begin
    with Canvas do
    begin
        FillRect(Rect);
        LBackground := Brush.Color;

        LRect := Rect;
        LRect.Right := LRect.Bottom - LRect.Top + LRect.Left + 20;
        InflateRect(LRect, -1, -1);
        Brush.Color := HexToColor(Items[Index]);

        FillRect(LRect);
        Brush.Color := ColorToBorderColor(ColorToRGB(Brush.Color));
        FrameRect(LRect);

        Brush.Color := LBackground;
        Rect.Left := LRect.Right + 5;

        TextRect(Rect, Rect.Left, Rect.Top + (Rect.Bottom - Rect.Top - TextHeight(Items[Index])) div 2, Items[Index]);
    end;
end;

end.