suicolorbox.pas

新颖按钮控件

////////////////////////////////////////////////////////////////////////////////
//
//
//  FileName    :   SUIColorBox.pas
//  Creator     :   Shen Min
//  Date        :   2002-11-14
//  Comment     :
//
//  Copyright (c) 2002-2003 Sunisoft
//  http://www.sunisoft.com
//  Email: [e-mail]
//
////////////////////////////////////////////////////////////////////////////////

unit SUIColorBox;

interface

{$I SUIPack.inc}

uses Windows, Messages, SysUtils, Classes, Controls, StdCtrls, Graphics,
     Dialogs, Consts,
     SUIComboBox;

type
    TColorBoxStyles = (
        cbStandardColors, // first sixteen RGBI colors
        cbExtendedColors, // four additional reserved colors
        cbSystemColors // system managed/defined colors
    );

    TColorBoxStyle = set of TColorBoxStyles;

    TsuiColorBox = class(TsuiComboBox)
    private
        m_Style : TColorBoxStyle;
        m_NeedToPopulate : Boolean;
        m_ListSelected : Boolean;
        m_SelectedColor : TColor;

        function GetColor(Index: Integer): TColor;
        function GetColorName(Index: Integer): string;
        function GetSelected: TColor;
        procedure SetSelected(const AColor: TColor);
        procedure ColorCallBack(const AName: string);

    protected
        procedure CloseUp; {$IFDEF SUIPACK_D6UP} override; {$ENDIF}
        procedure CreateWnd; override;
        procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
        procedure KeyDown(var Key: Word; Shift: TShiftState); override;
        procedure PopulateList;
        procedure Select; {$IFDEF SUIPACK_D6UP} override; {$ENDIF}
        procedure SetStyle(AStyle: TColorBoxStyle); reintroduce;

    public
        constructor Create(AOwner: TComponent); override;

        property Colors[Index: Integer]: TColor read GetColor;
        property ColorNames[Index: Integer]: string read GetColorName;

    published
        property Style: TColorBoxStyle read m_Style write SetStyle
            default [cbStandardColors, cbExtendedColors, cbSystemColors];
        property Selected: TColor read GetSelected write SetSelected default clBlack;

    end;

implementation

uses SUIPublic;

const
    NoColorSelected = clBlack;
{$IFDEF SUIPACK_D5}
    StandardColorsCount = 16;
    ExtendedColorsCount = 4;
{$ENDIF}


procedure TsuiColorBox.CloseUp;
begin
    inherited;
    m_ListSelected := True;
end;

procedure TsuiColorBox.ColorCallBack(const AName: String);
begin
    Items.Add(AName);
end;

constructor TsuiColorBox.Create(AOwner: TComponent);
begin
    inherited;
    inherited Style := csOwnerDrawFixed;

    m_Style := [cbStandardColors, cbExtendedColors, cbSystemColors];
    m_SelectedColor := clBlack;
    PopulateList;
end;

procedure TsuiColorBox.CreateWnd;
begin
    inherited;
    if m_NeedToPopulate then
        PopulateList;
end;

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

    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 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;
        InflateRect(LRect, -1, -1);
        Brush.Color := StringToColor(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;

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

function TsuiColorBox.GetColorName(Index: Integer): string;
begin
    Result := Items[Index];
end;

function TsuiColorBox.GetSelected: TColor;
begin
    if HandleAllocated then
        if ItemIndex <> -1 then
            Result := Colors[ItemIndex]
        else
            Result := NoColorSelected
    else
        Result := m_SelectedColor;
end;

procedure TsuiColorBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
    m_ListSelected := False;

    inherited;
end;

procedure TsuiColorBox.PopulateList;
    procedure DeleteRange(const AMin, AMax: Integer);
    var
        I: Integer;
    begin
        for I := AMax downto AMin do
            Items.Delete(I);
    end;

var
    LSelectedColor : TColor;
begin
    if HandleAllocated then
    begin
        Items.BeginUpdate;
        try
            LSelectedColor := m_SelectedColor;
            Items.Clear;
            GetColorValues(ColorCallBack);
            if not (cbSystemColors in Style) then
                DeleteRange(StandardColorsCount + ExtendedColorsCount, Items.Count - 1);
            if not (cbExtendedColors in Style) then
                DeleteRange(StandardColorsCount, StandardColorsCount + ExtendedColorsCount - 1);
            if not (cbStandardColors in Style) then
                DeleteRange(0, StandardColorsCount - 1);
            Selected := LSelectedColor;
        finally
            Items.EndUpdate;
            m_NeedToPopulate := False;
        end;
    end
    else
        m_NeedToPopulate := True;
end;

procedure TsuiColorBox.Select;
begin
    if m_ListSelected then
        m_ListSelected := False;

    inherited;
end;

procedure TsuiColorBox.SetSelected(const AColor: TColor);
begin
    if HandleAllocated then
        ItemIndex := Items.IndexOf(ColorToString(AColor));

    m_SelectedColor := AColor;
end;

procedure TsuiColorBox.SetStyle(AStyle: TColorBoxStyle);
begin
    if AStyle <> Style then
    begin
        m_Style := AStyle;
        Enabled := ([cbStandardColors, cbExtendedColors, cbSystemColors] * m_Style) <> [];
        PopulateList;
        if (Items.Count > 0) and (ItemIndex = -1) then
            ItemIndex := 0;
  end;
end;

end.