unit CLLBox; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TColorSelectionItem = ( csSystem, csSystemJ, csCustom, csDefault, csExtended); TColorSelection = set of TColorSelectionItem; TColorLookupListBox = class(TCustomListBox) private fSelection: TColorSelection; fShowName: Boolean; fMaxCustomCount, fCustomCount: Byte; fDefaultColor: TColor; fExtendedColors: TStrings; fOnLoadExtended: TNotifyEvent; procedure LoadExtendedColor; // Property Access Methods function GetSelectColor: TColor; procedure SetSelectColor( cl: TColor); procedure SetDefaultColor( cl: TColor); procedure SetExtendedColors( value: TStrings); procedure SetMaxCustomCount( cnt: Byte); procedure SetSelection( sel: TColorSelection); protected procedure CreateWnd; override; procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP; procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override; public constructor Create( AOwner: TComponent); override; destructor Destroy; override; property SelectColor: TColor read GetSelectColor write SetSelectColor; property CustomCount: Byte read fCustomCount; procedure AddCustomColor( name: string; cl: TColor); function GetCustomColor( idx: Byte): TColor; function GetCustomName( idx: Byte): string; procedure InitColorList; published property DefaultColor: TColor read fDefaultColor write SetDefaultColor default clNone; property ExtendedColors: TStrings read fExtendedColors write SetExtendedColors; property MaxCustomCount: Byte read fMaxCustomCount write SetMaxCustomCount default 3; property ShowName: Boolean read fShowName write fShowName default true; property OnLoadExtendedColors: TNotifyEvent read fOnLoadExtended write fOnLoadExtended; property Selection: TColorSelection read fSelection write SetSelection default [csSystemJ]; property Align; property Anchors; property BiDiMode; property BorderStyle; property Color; property Columns; property Constraints; property Ctl3D; property DragCursor; property DragKind; property DragMode; property Enabled; property ExtendedSelect; property Font; property ImeMode; property ImeName; property IntegralHeight; property ItemHeight; property Items; property MultiSelect; property ParentBiDiMode; property ParentColor; property ParentCtl3D; property ParentFont; property ParentShowHint; property PopupMenu; property ShowHint; property Sorted; //隠蔽 property Style; property TabOrder; property TabStop; property TabWidth; property Visible; property OnClick; property OnContextPopup; property OnDblClick; property OnDragDrop; property OnDragOver; property OnDrawItem; property OnEndDock; property OnEndDrag; property OnEnter; property OnExit; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMeasureItem; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnStartDock; property OnStartDrag; end; procedure Register; implementation procedure Register; begin RegisterComponents('Samples', [TColorLookupListBox]); end; { TColorLookupListBox } (*--▽---------------------------▼-- Itemの値を'赤色=$0000FF'というような形式にすると 『■赤色』のような描画をするListBoxです --▲---------------------------△--*) constructor TColorLookupListBox.Create( AOwner: TComponent); begin inherited Create( AOwner); Style:= lbOwnerDrawFixed; fExtendedColors:= TStringList.Create; fSelection:= [csSystemJ]; fMaxCustomCount:= 3; fDefaultColor:= clNone; fShowName:= true; end; destructor TColorLookupListBox.Destroy; begin fExtendedColors.Free; inherited; end; procedure TColorLookupListBox.InitColorList; var i: Integer; const NSys: array[0..15] of string = ( 'Black', 'Maroon', 'Green', 'Olive', 'Navy', 'Purple', 'Teal', 'Gray', 'Silver', 'Red', 'Lime', 'Yellow', 'Blue', 'Fuchsia', 'Aqua', 'White'); NSysJ: array[0..15] of string = ( '黒', '茶色', '緑', 'オリーブ', '紺', '紫', '青緑', '灰色', '銀色', '赤', '黄緑', '黄', '青', '赤紫', '水色', '白'); CSys: array[0..15] of TColor = ( clBlack, clMaroon, clGreen, clOlive, clNavy, clPurple, clTeal, clGray, clSilver, clRed, clLime, clYellow, clBlue, clFuchsia, clAqua, clWhite); begin if not (csDesigning in ComponentState) then with Items do begin BeginUpdate; Clear; if csDefault in fSelection then AddObject( '標準', TObject(fDefaultColor)); if csSystem in fSelection then for i:= 0 to 15 do AddObject( NSys[i], TObject(CSys[i])); if csSystemJ in fSelection then for i:= 0 to 15 do AddObject( NSysJ[i], TObject(CSys[i])); if csExtended in fSelection then LoadExtendedColor; if csCustom in fSelection then AddObject( 'その他...', TObject(clNone)); EndUpdate; end; end; procedure TColorLookupListBox.LoadExtendedColor; var i: Integer; name: string; color: TColor; begin if Assigned( fOnLoadExtended) then fOnLoadExtended( Self); with TStringList(fExtendedColors) do for i:= 0 to Count-1 do begin name:= Names[i]; if name<>'' then begin color:= StrToIntDef( Values[name], clNone); Self.Items.AddObject( name, TObject(color)); end; end; end; function TColorLookupListBox.GetSelectColor: TColor; begin if ItemIndex<>-1 then Result:= TColor(Items.Objects[ItemIndex]) else Result:= clNone; end; procedure TColorLookupListBox.SetSelectColor( cl: TColor); var i: Integer; begin if cl=clNone then ItemIndex:=-1 else begin for i:= 0 to Items.Count-1 do if cl=TColor(Items.Objects[i]) then begin ItemIndex:= i; Exit; end; if csCustom in fSelection then begin AddCustomColor( '', cl); for i:= 0 to Items.Count-1 do if cl=TColor(Items.Objects[i]) then begin ItemIndex:= i; Exit; end; end else ItemIndex:= -1; end; end; procedure TColorLookupListBox.SetDefaultColor( cl: TColor); begin fDefaultColor:= cl; InitColorList; end; procedure TColorLookupListBox.SetExtendedColors( value: TStrings); begin fExtendedColors.Assign( value); InitColorList; end; procedure TColorLookupListBox.SetSelection( sel: TColorSelection); begin fSelection:= sel; InitColorList; end; procedure TColorLookupListBox.SetMaxCustomCount( cnt: Byte); begin fMaxCustomCount:= cnt; InitColorList; end; procedure TColorLookupListBox.CreateWnd; begin inherited; InitColorList; end; {------------------------------- //OwnerDraw処理 機能: 『■赤色』という描画を行います 備考: 履歴: 2000/12/07 -------------------------------} procedure TColorLookupListBox.DrawItem( Index: Integer; Rect: TRect; State: TOwnerDrawState); {------------------------------- //TColorを'#RRBBGG'形式に変換 -------------------------------} function ColorToHtmlHex(Color: TColor): String; begin Result := '#'+ IntToHex(GetRValue(ColorToRGB(Color)),2) + IntToHex(GetGValue(ColorToRGB(Color)),2) + IntToHex(GetBValue(ColorToRGB(Color)),2); end; begin with Canvas do if fShowName then begin FillRect( Rect); if TColor(Items.Objects[Index]) = TColor(-1) then Brush.Color := clBlack else Brush.Color:= TColor(Items.Objects[Index]); Pen.Color:= clBlack; Rectangle( Rect.Left+2, Rect.Top+2, Rect.Left+26, Rect.Bottom-2); Brush.Style:= bsClear; if Items[Index][1]='$' then TextOut( Rect.Left+30, Rect.Top+1, ColorToHtmlHex(StringToColor(Items[Index])) ) else TextOut( Rect.Left+30, Rect.Top+1, Items[Index]); end else begin if TColor(Items.Objects[Index]) = TColor(-1) then Brush.Color := clBlack else Brush.Color:= TColor(Items.Objects[Index]); FillRect( Rect); end; end; procedure TColorLookupListBox.WMLButtonUp(var Message: TWMLButtonUp); var dialog: TColorDialog; begin inherited; if (csCustom in fSelection) and (ItemIndex=Items.Count-1) then begin dialog:= TColorDialog.Create( Self); try if dialog.Execute then AddCustomColor( '', dialog.Color); ItemIndex:= Items.Count-2; finally dialog.Free; end; end; end; procedure TColorLookupListBox.AddCustomColor( name: string; cl: TColor); begin if fMaxCustomCount=fCustomCount then begin Items.Delete( Items.Count-fMaxCustomCount-1); Dec( fCustomCount); end; if name='' then name:= Format( '$%.6X', [cl]); Items.InsertObject( Items.Count-1, name, TObject(cl)); Inc( fCustomCount); end; function TColorLookupListBox.GetCustomColor( idx: Byte): TColor; begin Result:= clNone; if (csCustom in fSelection) and (idx