コンボボックスのリスト部分の背景色を項目別に色分けするコンポです。
項目を選択すると、コンボボックス本体の背景色も変わります。

コンボボックスでリストから項目を選択するとき、同じような文字が並んでると
選択ミスをしても気が付きにくいですが、項目別に色分けして、選択した時に
その色の背景色になることで、間違えて選択をした場合でも、気が付きやすく
なります。入力ミスの軽減を目的に作りました。

プロパティの「ListColor1〜3」に指定した色で、リストが色分けされます。
初期値では、薄い青・黄・赤になっています。

                          JBC01362 アトリエ まっちゃん
                                 「うたた寝子」
                                   http://www.people.or.jp/~macchan/

-------------------------< ColorComboBox.pas >-------------------------
unit ColorComboBox;

interface

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

type
  TColorCombo = class(TComboBox)
  private
    { Private 宣言 }
    FColor: TColor;
    FListColors: array[0..2] of TColor;
    procedure SetColor(const Value: TColor);
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure SetListColors1(const Value: TColor);
    procedure SetListColors2(const Value: TColor);
    procedure SetListColors3(const Value: TColor);
  protected
    { Protected 宣言 }
    procedure Change; override;
    procedure DrawItem(Index: Integer; Rect: TRect;
      State: TOwnerDrawState); override;
  public
    { Public 宣言 }
    constructor Create(AOwner: TComponent); override;
    procedure CreateParams(var Params: TCreateParams); override;
  published
    { Published 宣言 }
    property Color: TColor read FColor write SetColor default clWindow;
    property ListColor1: TColor read FListColors[0] write SetListColors1
                                default $FFD0D0;
    property ListColor2: TColor read FListColors[1] write SetListColors2
                                default $D0FFFF;
    property ListColor3: TColor read FListColors[2] write SetListColors3
                                default $D0D0FF;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Additional', [TColorCombo]);
end;

{ TColorCombo }

procedure TColorCombo.Change;
var
  i: Integer;
begin
  inherited;
  i := Items.IndexOf(Text);
  if i < 0 then
    inherited Color := FColor
  else
    inherited Color := FListColors[i mod 3];
end;

procedure TColorCombo.CMFontChanged(var Message: TMessage);
begin
  inherited;
  if Style in [csDropDown, csSimple, csDropDownList] then
    ItemHeight := Abs(Font.Height);
end;

constructor TColorCombo.Create(AOwner: TComponent);
begin
  inherited;
  FColor := clWindow;
  inherited Color := FColor;
  FListColors[0]  := $FFD0D0;
  FListColors[1]  := $D0FFFF;
  FListColors[2]  := $D0D0FF;
end;

procedure TColorCombo.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.Style := Params.Style or CBS_OWNERDRAWFIXED;
end;

procedure TColorCombo.DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
const
  ArrowWidth  =  6;
  ArrowHeight = 12;
  Space       =  2;
begin
  TControlCanvas(Canvas).UpdateTextFlags;
  if Assigned(OnDrawItem) then
   begin
    OnDrawItem(Self, Index, Rect, State);
    Exit;
   end;
  Canvas.Font .Color := Font.Color;
  Canvas.Brush.Color := FListColors[Index mod 3];
  Canvas.FillRect(Rect);
  Canvas.TextOut(ArrowWidth + Space * 2 + 2, Rect.Top, Items[Index]);
  if odSelected in State then
   begin
    Canvas.DrawFocusRect(Rect);
    Canvas.Brush.Color := Font.Color;
    Rect.Left   := Rect.Left + Space;
    Rect.Right  := Rect.Left + ArrowWidth;
    Rect.Top    := Rect.Top  + (Rect.Bottom - Rect.Top - ArrowHeight) div 2;
    Rect.Bottom := Rect.Top  + ArrowHeight;
    Canvas.Polygon([Point(Rect.Left , Rect.Top),
                    Point(Rect.Right, (Rect.Top + Rect.Bottom) div 2),
                    Point(Rect.Left , Rect.Bottom),
                    Point(Rect.Left , Rect.Top)]);
   end;
end;

procedure TColorCombo.SetColor(const Value: TColor);
begin
  if FColor = Value then Exit;
  if FColor = inherited Color then
   begin
    FColor := Value;
    inherited Color := FColor;
   end
  else
    FColor := Value;
end;

procedure TColorCombo.SetListColors1(const Value: TColor);
begin
  if FListColors[0] = Value then Exit;
  FListColors[0] := Value;
  if Style = csSimple then
    Invalidate;
end;

procedure TColorCombo.SetListColors2(const Value: TColor);
begin
  if FListColors[1] = Value then Exit;
  FListColors[1] := Value;
  if Style = csSimple then
    Invalidate;
end;

procedure TColorCombo.SetListColors3(const Value: TColor);
begin
  if FListColors[2] = Value then Exit;
  FListColors[2] := Value;
  if Style = csSimple then
    Invalidate;
end;

end.
 


- FDELPHI  MES(16):玉石混淆みんなで作るSample蔵【見本蓄積】 01/08/05 -

Original document by Atelier Macchan 氏 ID:(JBC01362)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。