Delphi / C ++ Builder的标签编辑器组件 [英] Tag editor component for Delphi/C++Builder

问题描述

我需要一个用于Delphi或C ++ Builder的VCL标签编辑器组件，类似于可用于JavaScript的VCL标签编辑器组件：例如这一个，或这一个或StackOverflow自己的标签编辑器。

有没有这样的可用或做我需要从头开始吗？

我需要的一些特定的东西是：

• 如果编辑器的宽度允许的更多标签存在，编辑器应允许滚动或变成多行。如果是多行的，应该有一个选项来定义一些最大高度，但是防止它变得太高。


• 选择是否在按空格或逗号键时创建标签的选项


• 当编辑器中没有关注时，提示文本（例如添加新标签）


• 理想情况下，您应该能够在标签之间移动使用键盘箭头突出显示它们，因此您可以使用键盘删除任何标签

解决方案

当然你想自己做这个！编写GUI控件是有趣和有益的！

您可以执行类似于

  unit TagEditor; 
 
接口
 
使用
 Windows，消息，SysUtils，类，控件，StdCtrls，窗体，图形，
类型，菜单; 
 
 type 
 TClickInfo = cardinal; 
 GetTagIndex = word; 
 
 const TAG_LOW = 0; 
 const TAG_HIGH = MAXWORD  -  2; 
 const EDITOR = MAXWORD  -  1; 
 const NOWHERE = MAXWORD; 
 
 const PART_BODY = $ 00000000; 
 const PART_REMOVE_BUTTON = $ 00010000; 
 
函数GetTagPart（ClickInfo：TClickInfo）：cardinal; 
 
 type 
 TTagClickEvent = procedure（Sender：TObject; TagIndex：integer; 
 const TagCaption：string）of object; 
 TRemoveConfirmEvent = procedure（Sender：TObject; TagIndex：integer; 
 const TagCaption：string; var CanRemove：boolean）of object; 
 TTagEditor = class（TCustomControl）
 private 
 {私有声明} 
 FTags：TStringList; 
 FEdit：TEdit; 
 FBgColor：TColor; 
 FBorderColor：TColor; 
 FTagBgColor：TColor; 
 FTagBorderColor：TColor; 
 FSpacing：integer; 
 FTextColor：TColor; 
 FLefts，FRights，FWidths，
 FTops，FBottoms：整数数组; 
 FCloseBtnLefts，FCloseBtnTops：整数数组; 
 FCloseBtnWidth：integer; 
 FSpaceAccepts：boolean; 
 FCommaAccepts：boolean; 
 FSemicolonAccepts：boolean; 
 FTrimInput：boolean; 
 FNoLeadingSpaceInput：boolean; 
 FTagClickEvent：TTagClickEvent; 
 FAllowDuplicates：boolean; 
 FPopupMenu：TPopupMenu; 
 FMultiLine：boolean; 
 FTagHeight：integer; 
 FEditPos：TPoint; 
 FActualTagHeight：integer; 
 FShrunk：boolean; 
 FEditorColor：TColor; 
 FTagAdded：TNotifyEvent; 
 FTagRemoved：TNotifyEvent; 
 FOnChange：TNotifyEvent; 
 FOnRemoveConfirm：TRemoveConfirmEvent; 
 FMouseDownClickInfo：TClickInfo; 
 FCaretVisible：boolean; 
 FDragging：boolean; 
 FAutoHeight：boolean; 
 FNumRows：整数; 
 procedure SetBorderColor（const Value：TColor）; 
程序SetTagBgColor（const值：TColor）; 
程序SetTagBorderColor（const值：TColor）; 
过程SetSpacing（const Value：integer）; 
程序TagChange（发件人：TObject）; 
程序SetTags（const值：TStringList）; 
程序SetTextColor（const值：TColor）; 
程序ShowEditor; 
程序HideEditor; 
 procedure EditKeyPress（Sender：TObject; var Key：Char）; 
 procedure mnuDeleteItemClick（Sender：TObject）; 
 procedure SetMultiLine（const Value：boolean）; 
 procedure SetTagHeight（const Value：integer）; 
 procedure EditExit（Sender：TObject）; 
函数接受：boolean; 
程序SetBgColor（const值：TColor）; 
函数GetClickInfoAt（X，Y：integer）：TClickInfo; 
函数GetSeparatorIndexAt（X，Y：integer）：integer; 
程序CreateCaret; 
程序DestroyCaret; 
函数IsFirstOnRow（TagIndex：integer）：boolean;一致; 
函数IsLastOnRow（TagIndex：integer）：boolean; 
程序SetAutoHeight（const Value：boolean）; 
 protected 
 {受保护的声明} 
 procedure Paint;覆盖
 procedure MouseDown（Button：TMouseButton; Shift：TShiftState; X：Integer; 
 Y：Integer）;覆盖
 procedure MouseMove（Shift：TShiftState; X：Integer; Y：Integer）;覆盖
 
程序KeyPress（var Key：Char）;覆盖
程序WndProc（var Message：TMessage）;覆盖
程序KeyDown（var Key：Word; Shift：TShiftState）;覆盖
 procedure MouseUp（Button：TMouseButton; Shift：TShiftState; X：Integer; 
 Y：Integer）;覆盖
 public 
 {公开声明} 
构造函数创建（AOwner：TComponent）;覆盖
析构函数覆盖
发布
 {发布声明} 
属性TabOrder; 
属性TabStop; 
属性颜色; 
属性锚点; 
 property Align; 
属性标签; 
属性游标; 
属性BgColor：TColor读FBgColor写SetBgColor; 
属性BorderColor：TColor读FBorderColor写SetBorderColor; 
属性TagBgColor：TColor读取FTagBgColor写SetTagBgColor; 
属性TagBorderColor：TColor读取FTagBorderColor 
写入SetTagBorderColor; 
属性间距：整数读取FSpacing写SetSpacing; 
属性标签：TStringList读取FTags写SetTags; 
属性TextColor：TColor读取FTextColor写入SetTextColor; 
属性SpaceAccepts：boolean读取FSpaceAccepts写入FSpaceAccepts 
 default true; 
属性CommaAccepts：boolean读取FCommaAccepts写入FCommaAccepts 
 default true; 
属性SemicolonAccepts：boolean读取FSemicolonAccepts 
写入FSemicolonAccepts default true; 
属性TrimInput：boolean读取FTrimInput写入FTrimInput default true; 
属性NoLeadingSpaceInput：boolean read FNoLeadingSpaceInput 
 write FNoLeadingSpaceInput default true; 
属性AllowDuplicates：boolean read FAllowDuplicates write FAllowDuplicates 
 default false; 
属性MultiLine：boolean读取FMultiLine写SetMultiLine默认为false; 
属性TagHeight：整数读取FTagHeight写入SetTagHeight默认32; 
属性EditorColor：TColor读取FEditorColor写FEditorColor 
默认clWindow; 
属性AutoHeight：boolean读取FAutoHeight写入SetAutoHeight; 
属性OnTagClick：TTagClickEvent读取FTagClickEvent写入FTagClickEvent; 
属性OnTagAdded：TNotifyEvent读取FTagAdded写入FTagAdded; 
属性OnTagRemoved：TNotifyEvent读取FTagRemoved写入FTagRemoved; 
属性OnChange：TNotifyEvent读取FOnChange写入FOnChange; 
属性OnRemoveConfirm：TRemoveConfirmEvent read FOnRemoveConfirm 
 write FOnRemoveConfirm; 
结束
 
程序注册; 
 
实现
 
使用Math，Clipbrd; 
 
程序注册; 
 begin 
 RegisterComponents（'Rejbrand 2009'，[TTagEditor]）; 
结束
 
函数IsKeyDown（const VK：integer）：boolean; 
 begin 
 IsKeyDown：= GetKeyState（VK）和$ 8000< 0; 
结束
 
函数GetTagPart（ClickInfo：TClickInfo）：cardinal; 
 begin 
 result：= ClickInfo和$ FFFF0000; 
结束
 
 {TTagEditor} 
 
构造函数TTagEditor.Create（AOwner：TComponent）; 
 var 
 mnuItem：TMenuItem; 
开始
继承; 
 FEdit：= TEdit.Create（Self）; 
 FEdit.Parent：= Self; 
 FEdit.BorderStyle：= bsNone; 
 FEdit.Visible：= false; 
 FEdit.OnKeyPress：= EditKeyPress; 
 FEdit.OnExit：= EditExit; 
 
 FTags：= TStringList.Create; 
 FTags.OnChange：= TagChange; 
 
 FBgColor：= clWindow; 
 FBorderColor：= clWindowFrame; 
 FTagBgColor：= clSkyBlue; 
 FTagBorderColor：= clNavy; 
 FSpacing：= 8; 
 FTextColor：= clWhite; 
 FSpaceAccepts：= true; 
 FCommaAccepts：= true; 
 FSemicolonAccepts：= true; 
 FTrimInput：= true; 
 FNoLeadingSpaceInput：= true; 
 FAllowDuplicates：= false; 
 FMultiLine：= false; 
 FTagHeight：= 32; 
 FShrunk：= false; 
 FEditorColor：= clWindow; 
 FCaretVisible：= false; 
 FDragging：= false; 
 
 FPopupMenu：= TPopupMenu.Create（Self）; 
 mnuItem：= TMenuItem.Create（PopupMenu）; 
 mnuItem.Caption：='Delete'; 
 mnuItem.OnClick：= mnuDeleteItemClick; 
 mnuItem.Hint：='删除所选标签'。 
 FPopupMenu.Items.Add（mnuItem）; 
 
 TabStop：= true; 
结束
 
程序TTagEditor.EditExit（发件人：TObject）; 
 begin 
如果FEdit.Text<> ''然后
接受
 else 
 HideEditor; 
结束
 
程序TTagEditor.mnuDeleteItemClick（Sender：TObject）; 
 begin 
如果发件人是TMenuItem然后
开始
 FTags.Delete（TMenuItem（发件人）.Tag）; 
如果分配（FTagRemoved）然后
 FTagRemoved（Self）; 
结束
结束
 
程序TTagEditor.TagChange（发件人：TObject）; 
 begin 
无效; 
如果分配（FOnChange）然后
 FOnChange（Self）; 
结束
 
程序TTagEditor.WndProc（var Message：TMessage）; 
开始
继承; 
 case Message.Msg 
 WM_SETFOCUS：
无效; 
 WM_KILLFOCUS：
 begin 
如果FCaretVisible然后DestroyCaret; 
 FDragging：= false; 
无效; 
结束
 WM_COPY：
 Clipboard.AsText：= FTags.DelimitedText; 
 WM_CLEAR：
 FTags.Clear; 
 WM_CUT：
 begin 
 Clipboard.AsText：= FTags.DelimitedText; 
 FTags.Clear; 
结束
 WM_PASTE：
 begin 
如果Clipboard.HasFormat（CF_TEXT）然后
如果FTags.Count = 0然后
 FTags.DelimitedText：= Clipboard.AsText 
 else 
 FTags.DelimitedText：= FTags.DelimitedText +'，'+ Clipboard.AsText; 
结束
结束
结束
 
函数TTagEditor.Accept：boolean; 
 begin 
 Assert（FEdit.Visible）; 
 result：= false; 
如果FTrimInput然后
 FEdit.Text：= Trim（FEdit.Text）; 
 if（FEdit.Text =''）或
（不是AllowDuplicates）和（FTags.IndexOf（FEdit.Text）-1））然后
 begin $ b $哔哔声
退出; 
结束
 FTags.Add（FEdit.Text）; 
 result：= true; 
 HideEditor; 
如果分配（FTagAdded）然后
 FTagAdded（自）; 
无效; 
结束
 
程序TTagEditor.EditKeyPress（发件人：TObject; var Key：Char）; 
 begin 
 
 if（Key = chr（VK_SPACE））和（FEdit.Text =''）和FNoLeadingSpaceInput然后
 begin 
 Key：=＃0; 
退出; 
结束
 
 if（（Key = chr（VK_SPACE））和FSpaceAccepts）或
（（Key ='，'）和FCommaAccepts）或
（（Key =';'）和FSemicolonAccepts）然后
 Key：= chr（VK_RETURN）; 
 
案例（Key）为
 VK_RETURN：
 begin 
接受; 
 ShowEditor; 
密钥：=＃0; 
结束
 VK_BACK：
 begin 
 if（FEdit.Text =''）和（FTags.Count> 0）然后
 begin 
 FTags.Delete（FTags.Count -  1）; 
如果分配（FTagRemoved）然后
 FTagRemoved（发件人）; 
结束
结束
 VK_ESCAPE：
 begin 
 HideEditor; 
 Self.SetFocus; 
密钥：=＃0; 
结束
结束
 
 end; 
 
析构函数TTagEditor.Destroy; 
 begin 
 FPopupMenu.Free; 
 FTags.Free; 
 FEdit.Free; 
继承; 
结束
 
程序TTagEditor.HideEditor; 
 begin 
 FEdit.Text：=''; 
 FEdit.Hide; 
 // SetFocus; 
结束
 
 
程序TTagEditor.KeyDown（var Key：Word; Shift：TShiftState）; 
开始
继承; 
 case 
的关键字VK_END：
 ShowEditor; 
 VK_DELETE：
执行（WM_CLEAR，0，0）; 
 VK_INSERT：
执行（WM_PASTE，0，0）; 
结束
结束
 
程序TTagEditor.KeyPress（var Key：Char）; 
开始
继承; 
 
 case 
 ^ C：
 begin 
执行（WM_COPY，0，0）; 
密钥：=＃0; 
退出; 
结束
 ^ X：
 begin 
执行（WM_CUT，0，0）; 
密钥：=＃0; 
退出; 
结束
 ^ V：
 begin 
执行（WM_PASTE，0，0）; 
密钥：=＃0; 
退出; 
结束
结束
 
 ShowEditor; 
 FEdit.Perform（WM_CHAR，ord（Key），0）; 
结束
 
函数TTagEditor.GetClickInfoAt（X，Y：整数）：TClickInfo; 
 var 
 i：integer; 
 begin 
 result：= NOWHERE; 
 if（X> = FEditPos.X）和（Y> = FEditPos.Y）然后
 Exit（EDITOR）; 
 
 for i：= 0 to FTags.Count  -  1 do 
 if InRange（X，FLefts [i]，FRights [i]）和InRange（Y，FTops [i] [i]）然后
 begin 
 result：= i; 
如果InRange（X，FCloseBtnLefts [i]，FCloseBtnLefts [i] + FCloseBtnWidth）和
 InRange（Y，FCloseBtnTops [i]，FCloseBtnTops [i] + FActualTagHeight）和
不是FShrunk 
 result：= result或PART_REMOVE_BUTTON; 
 break; 
结束
结束
 
函数TTagEditor.IsFirstOnRow（TagIndex：integer）：boolean; 
 begin 
 result：=（TagIndex = 0）或（FTops [TagIndex]> FTops [TagIndex-1]）; 
结束
 
函数TTagEditor.IsLastOnRow（TagIndex：integer）：boolean; 
 begin 
 result：=（TagIndex = FTags.Count  -  1）或（FTops [TagIndex]< FTops [TagIndex + 1]）; 
结束
 
函数TTagEditor.GetSeparatorIndexAt（X，Y：integer）：integer; 
 var 
 i：整数; 
 begin 
 result：= FTags.Count; 
 Y：= Max（Y，FSpacing + 1）; 
 for i：= FTags.Count  -  1 downto 0 do 
 begin 
如果Y < FTPS [i]然后继续; 
 if（IsLastOnRow（i）和（X> = FRights [i]））或
（（X< FRights [i]）和（IsFirstOnRow（i）或（FRights [i-1 ]< X）））然后
 begin 
 result：= i; 
 if（IsLastOnRow（i）和（X> = FRights [i]））then inc（result）; 
退出; 
结束
结束
结束
 
程序TTagEditor.MouseDown（Button：TMouseButton; Shift：TShiftState; X，
 Y：Integer）; 
 begin 
 FMouseDownClickInfo：= GetClickInfoAt（X，Y）; 
如果GetTagIndex（FMouseDownClickInfo）<>编辑然后
 SetFocus; 
结束
 
程序TTagEditor.CreateCaret; 
 begin 
如果不是FCaretVisible然后
 FCaretVisible：= Windows.CreateCaret（Handle，0，0，FActualTagHeight）; 
结束
 
程序TTagEditor.DestroyCaret; 
开始
如果不是FCaretVisible然后退出; 
 Windows.DestroyCaret; 
 FCaretVisible：= false; 
结束
 
程序TTagEditor.MouseMove（Shift：TShiftState; X，Y：Integer）; 
 var 
 SepIndex：integer; 
开始
继承; 
 
如果IsKeyDown（VK_LBUTTON）和
 InRange（GetTagIndex（FMouseDownClickInfo），TAG_LOW，TAG_HIGH）然后
 begin 
 FDragging：= true; 
 Screen.Cursor：= crDrag; 
 SepIndex：= GetSeparatorIndexAt（X，Y）; 
 TForm（Parent）.Caption：= IntToStr（SepIndex）; 
 CreateCaret; 
如果SepIndex = FTags.Count然后
 SetCaretPos（FLefts [SepIndex  -  1] + FWidths [SepIndex  -  1] + FSpacing div 2，
 FTops [SepIndex  -  1]）$ ​​b $ b else 
 SetCaretPos（FLefts [SepIndex]  -  FSpacing div 2，FTops [SepIndex]）; 
 ShowCaret（Handle）; 
退出; 
结束
 
案例GetTagIndex（GetClickInfoAt（X，Y））
 NOWHERE：Cursor：= crArrow; 
编辑器：Cursor：= crIBeam; 
 TAG_LOW..TAG_HIGH：Cursor：= crHandPoint; 
结束
 
 end; 
 
程序TTagEditor.MouseUp（Button：TMouseButton; Shift：TShiftState; X，
 Y：Integer）; 
 var 
 pnt：TPoint; 
 CanRemove：boolean; 
 ClickInfo：TClickInfo; 
 i：word; 
 p：cardinal; 
 SepIndex：integer; 
开始
继承; 
 
如果FDragging然后
开始
 DestroyCaret; 
 FDragging：= false; 
 Screen.Cursor：= crDefault; 
 SepIndex：= GetSeparatorIndexAt（X，Y）; 
如果不是InRange（SepIndex，GetTagIndex（FMouseDownClickInfo），
 GetTagIndex（FMouseDownClickInfo）+ 1）然后
 FTags.Move（GetTagIndex（FMouseDownClickInfo），SepIndex  -  
 IfThen（SepIndex> ; GetTagIndex（FMouseDownClickInfo），1，0））; 
退出; 
结束
 
 ClickInfo：= GetClickInfoAt（X，Y）; 
 
如果ClickInfo<> FMouseDownClickInfo然后退出; 
 
 i：= GetTagIndex（ClickInfo）; 
 p：= GetTagPart（ClickInfo）; 
 
 case i of 
编辑：
 ShowEditor; 
 NOWHERE：; 
 else 
 case按钮
 mbLeft：
 begin 
案例p 
 PART_BODY：
如果分配（FTagClickEvent）然后
 FTagClickEvent（Self，i，FTags [i]）; 
 PART_REMOVE_BUTTON：
 begin 
如果分配（FOnRemoveConfirm）然后
 begin 
 CanRemove：= false; 
 FOnRemoveConfirm（Self，i，FTags [i]，CanRemove）; 
如果不是CanRemove然后退出; 
结束
 FTags.Delete（i）; 
如果分配（FTagRemoved）然后
 FTagRemoved（Self）; 
结束
结束
结束
 mbRight：
 begin 
 FPopupMenu.Items [0] .Tag：= i; 
 pnt：= ClientToScreen（Point（X，Y））; 
 FPopupMenu.Items [0] .Caption：='删除标签''+ FTags [i] +''; 
 FPopupMenu.Popup（pnt.X，pnt.Y）; 
结束
结束
结束
 
 end; 
 
程序TTagEditor.Paint; 
 var 
 i：integer; 
 w：integer; 
 x，y：integer; 
 R：TRect; 
 MeanWidth：integer; 
 S：string; 
 DesiredHeight：integer; 
开始
继承; 
 Canvas.Brush.Color：= FBgColor; 
 Canvas.Pen.Color：= FBorderColor; 
 Canvas.Rectangle（ClientRect）; 
 Canvas.Font.Assign（Self.Font）; 
 SetLength（FLefts，FTags.Count）; 
 SetLength（FRights，FTags.Count）; 
 SetLength（FTops，FTags.Count）; 
 SetLength（FBottoms，FTags.Count）; 
 SetLength（FWidths，FTags.Count）; 
 SetLength（FCloseBtnLefts，FTags.Count）; 
 SetLength（FCloseBtnTops，FTags.Count）; 
 FCloseBtnWidth：= Canvas.TextWidth（'×'）; 
 FShrunk：= false; 
 
 //做指标
 FNumRows：= 1; 
如果FMultiLine然后
开始
 FActualTagHeight：= FTagHeight; 
 x：= FSpacing; 
 y：= FSpacing; 
 for i：= 0 to FTags.Count  -  1 do 
 begin 
 FWidths [i]：= Canvas.TextWidth（FTags [i] +'×'）+ 2 * FSpacing; 
 FLefts [i]：= x; 
 FRights [i]：= x +宽度[i]; 
 FTops [i]：= y; 
 FBottoms [i]：= y + FTagHeight; 
 
如果x +宽度[i] + FSpacing> ClientWidth然后
 {无需为编辑器腾出空间，因为它可以驻留在下一行！ 
 begin 
 x：= FSpacing; 
 inc（y，FTagHeight + FSpacing）; 
 inc（FNumRows）; 
 FLefts [i]：= x; 
 FRights [i]：= x +宽度[i]; 
 FTops [i]：= y; 
 FBottoms [i]：= y + FTagHeight; 
结束
 
 FCloseBtnLefts [i]：= x +宽度[i]  -  FCloseBtnWidth  -  FSpacing; 
 FCloseBtnTops [i]：= y; 
 
 inc（x，FWidths [i] + FSpacing）; 
结束
 end 
 else //即不是FMultiLine 
 begin 
 FActualTagHeight：= ClientHeight  -  2 * FSpacing; 
 x：= FSpacing; 
 y：= FSpacing; 
 for i：= 0 to FTags.Count  -  1 do 
 begin 
 FWidths [i]：= Canvas.TextWidth（FTags [i] +'×'）+ 2 * FSpacing; 
 FLefts [i]：= x; 
 FRights [i]：= x +宽度[i]; 
 FTops [i]：= y; 
 FBottoms [i]：= y + FActualTagHeight; 
 inc（x，FWidths [i] + FSpacing）; 
 FCloseBtnLefts [i]：= FRights [i]  -  FCloseBtnWidth  -  FSpacing; 
 FCloseBtnTops [i]：= y; 
结束
 FShrunk：= x + 64 {FEdit}> ClientWidth; 
如果FShrunk然后
开始
 
 //足够删除关闭按钮？ 
 x：= FSpacing; 
 y：= FSpacing; 
 for i：= 0 to FTags.Count  -  1 do 
 begin 
 FWidths [i]：= Canvas.TextWidth（FTags [i]）+ 2 * FSpacing; 
 FLefts [i]：= x; 
 FRights [i]：= x +宽度[i]; 
 FTops [i]：= y; 
 FBottoms [i]：= y + FActualTagHeight; 
 inc（x，FWidths [i] + FSpacing）; 
 FCloseBtnLefts [i]：= FRights [i]  -  FCloseBtnWidth  -  FSpacing; 
 FCloseBtnTops [i]：= y; 
结束
 
如果x + 64 {FEdit}> ClientWidth然后//显然没有
开始
 MeanWidth：=（ClientWidth  -  2 * FSpacing  -  64 {FEdit}）div FTags.Count  -  FSpacing; 
 x：= FSpacing; 
 for i：= 0 to FTags.Count  -  1 do 
 begin 
 FWidths [i]：= Min（FWidths [i]，MeanWidth）; 
 FLefts [i]：= x; 
 FRights [i]：= x +宽度[i]; 
 inc（x，FWidths [i] + FSpacing）; 
结束
结束
结束
结束
 
 FEditPos：= Point（FSpacing，FSpacing +（FActualTagHeight  -  FEdit.Height）div 2）; 
如果FTags.Count> 0然后
 FEditPos：= Point（FRights [FTags.Count  -  1] + FSpacing，
 FTops [FTags.Count  -  1] +（FActualTagHeight  -  FEdit.Height）div 2）; 
如果FMultiLine和（FEditPos.X + 64> ClientWidth）和（FTags.Count> 0）然后
开始
 FEditPos：=点（FSpacing，
 FTops [FTags .Count  -  1] + FTagHeight + FSpacing + 
（FActualTagHeight  -  FEdit.Height）div 2）; 
 inc（FNumRows）; 
结束
 
 DesiredHeight：= FSpacing + FNumRows *（FTagHeight + FSpacing）; 
如果FMultiLine和FAutoHeight和（ClientHeight&DesireHeight）然后
开始
 ClientHeight：= DesiredHeight; 
无效; 
退出; 
结束
 
 //绘制
 for i：= 0 to FTags.Count  -  1 do 
 begin 
 x：= FLefts [i]; 
 y：= FTops [i]; 
 w：= FWidths [i]; 
 R：= Rect（x，y，x + w，y + FActualTagHeight）; 
 Canvas.Brush.Color：= FTagBgColor; 
 Canvas.Pen.Color：= FTagBorderColor; 
 Canvas.Rectangle（R）; 
 Canvas.Font.Color：= FTextColor; 
 Canvas.Brush.Style：= bsClear; 
 R.Left：= R.Left + FSpacing; 
 S = = FTags [i]; 
如果不是FShrunk然后
 S：= S +'×'; 
 DrawText（Canvas.Handle，PChar（S），-1，R，DT_SINGLELINE或DT_VCENTER或
 DT_LEFT或DT_END_ELLIPSIS或DT_NOPREFIX）; 
 Canvas.Brush.Style：= bsSolid; 
结束
 
如果FEdit.Visible然后
 begin 
 FEdit.Left：= FEditPos.X; 
 FEdit.Top：= FEditPos.Y; 
 FEdit.Width：= ClientWidth  -  FEdit.Left  -  FSpacing; 
结束
如果聚焦然后
 begin 
 R：= Rect（2，2，ClientWidth  -  2，ClientHeight  -  2）; 
 SetBkColor（Canvas.Handle，clWhite）; 
 SetTextColor（clBlack）; 
 Canvas.DrawFocusRect（R）; 
结束
结束
 
程序TTagEditor.SetAutoHeight（const Value：boolean）; 
 begin 
如果FAutoHeight<>值然后
开始
 FAutoHeight：= Value; 
无效; 
结束
结束
 
程序TTagEditor.SetBgColor（const值：TColor）; 
 begin 
如果FBgColor<>值然后
 begin 
 FBgColor：= Value; 
无效; 
结束
结束
 
程序TTagEditor.SetBorderColor（const值：TColor）; 
 begin 
如果FBorderColor<>值然后
 begin 
 FBorderColor：= Value; 
无效; 
结束
结束
 
程序TTagEditor.SetMultiLine（const Value：boolean）; 
 begin 
如果FMultiLine<>值然后
 begin 
 FMultiLine：= Value; 
无效; 
结束
结束
 
程序TTagEditor.SetTagBgColor（const值：TColor）; 
 begin 
如果FTagBgColor<>值然后
 begin 
 FTagBgColor = = Value; 
无效; 
结束
结束
 
程序TTagEditor.SetTagBorderColor（const值：TColor）; 
 begin 
如果FTagBorderColor<>值然后
 begin 
 FTagBorderColor：= Value; 
无效; 
结束
结束
 
程序TTagEditor.SetTagHeight（const值：整数）; 
 begin 
如果FTagHeight<>值然后
 begin 
 FTagHeight：= Value; 
无效; 
结束
结束
 
程序TTagEditor.SetTags（const值：TStringList）; 
 begin 
 FTags.Assign（Value）; 
无效; 
结束
 
程序TTagEditor.SetTextColor（const值：TColor）; 
 begin 
如果FTextColor<>值然后
 begin 
 FTextColor：= Value; 
无效; 
结束
结束
 
程序TTagEditor.ShowEditor; 
 begin 
 FEdit.Left：= FEditPos.X; 
 FEdit.Top：= FEditPos.Y; 
 FEdit.Width：= ClientWidth  -  FEdit.Left  -  FSpacing; 
 FEdit.Color：= FEditorColor; 
 FEdit.Text：=''; 
 FEdit.Show; 
 FEdit.SetFocus; 
结束
 
程序TTagEditor.SetSpacing（const Value：integer）; 
 begin 
如果FSpacing<>值然后
 begin 
 FSpacing：= Value; 
无效; 
结束
结束
 
初始化
 Screen.Cursors [crHandPoint]：= LoadCursor（0，IDC_HAND）; //获取正常的手指光标
 
结束。 
  

其中

Screenshot http://privat.rejbrand.se/tageditor.png

< a href =http://privat.rejbrand.se/tageditor.mp4>示例视频

演示（编译EXE）

如果今天晚些时候有更多的时间，我将在此做更多的工作控制，例如鼠标悬停上的按钮突出显示，标记点击事件，按钮最大宽度等。

更新：添加了很多功能。 / p>

更新：添加多行功能。

更新： / strong>更多功能。

更新：添加了剪贴板界面，修复了一些问题等。

更新：添加拖放重新排序并修复了一些小问题。顺便说一句，这是我将在这里发布的最后一个版本。稍后的版本（如果有的话）将发布在 http://specials.rejbrand.se/dev/controls/。

更新：添加 AutoHeight 属性，使编辑框垂直居中，并更改了拖动光标。 （是的，我无法抗拒再做一个更新。）

I need a VCL tag editor component for Delphi or C++Builder, similar to what's available for JavaScript: e.g. this one, or this one or StackOverflow's own tags editor.

Is there something like this available or do I need to make it from scratch?

Some specific things that I need are:

• Editor should allow either scrolling or become multi-line if more tags are present than the editor's width allows. If multi-line, there should be an option to define some maximum height however, preventing it from becoming too tall
• Option to select whether tags are created when pressing space or comma key
• Prompt text in the editor, when it is not focused (for example "Add new tag")
• Ideally, you should be able to move between tags (highlighting them) using the keyboard arrows, so you can delete any tag using the keyboard only

解决方案

Of course you want to do this yourself! Writing GUI controls is fun and rewarding!

You could do something like

unit TagEditor;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, StdCtrls, Forms, Graphics,
  Types, Menus;

type
  TClickInfo = cardinal;
  GetTagIndex = word;

const TAG_LOW = 0;
const TAG_HIGH = MAXWORD - 2;
const EDITOR = MAXWORD - 1;
const NOWHERE = MAXWORD;

const PART_BODY = $00000000;
const PART_REMOVE_BUTTON = $00010000;

function GetTagPart(ClickInfo: TClickInfo): cardinal;

type
  TTagClickEvent = procedure(Sender: TObject; TagIndex: integer;
    const TagCaption: string) of object;
  TRemoveConfirmEvent = procedure(Sender: TObject; TagIndex: integer;
    const TagCaption: string; var CanRemove: boolean) of object;
  TTagEditor = class(TCustomControl)
  private
    { Private declarations }
    FTags: TStringList;
    FEdit: TEdit;
    FBgColor: TColor;
    FBorderColor: TColor;
    FTagBgColor: TColor;
    FTagBorderColor: TColor;
    FSpacing: integer;
    FTextColor: TColor;
    FLefts, FRights, FWidths,
    FTops, FBottoms: array of integer;
    FCloseBtnLefts, FCloseBtnTops: array of integer;
    FCloseBtnWidth: integer;
    FSpaceAccepts: boolean;
    FCommaAccepts: boolean;
    FSemicolonAccepts: boolean;
    FTrimInput: boolean;
    FNoLeadingSpaceInput: boolean;
    FTagClickEvent: TTagClickEvent;
    FAllowDuplicates: boolean;
    FPopupMenu: TPopupMenu;
    FMultiLine: boolean;
    FTagHeight: integer;
    FEditPos: TPoint;
    FActualTagHeight: integer;
    FShrunk: boolean;
    FEditorColor: TColor;
    FTagAdded: TNotifyEvent;
    FTagRemoved: TNotifyEvent;
    FOnChange: TNotifyEvent;
    FOnRemoveConfirm: TRemoveConfirmEvent;
    FMouseDownClickInfo: TClickInfo;
    FCaretVisible: boolean;
    FDragging: boolean;
    FAutoHeight: boolean;
    FNumRows: integer;
    procedure SetBorderColor(const Value: TColor);
    procedure SetTagBgColor(const Value: TColor);
    procedure SetTagBorderColor(const Value: TColor);
    procedure SetSpacing(const Value: integer);
    procedure TagChange(Sender: TObject);
    procedure SetTags(const Value: TStringList);
    procedure SetTextColor(const Value: TColor);
    procedure ShowEditor;
    procedure HideEditor;
    procedure EditKeyPress(Sender: TObject; var Key: Char);
    procedure mnuDeleteItemClick(Sender: TObject);
    procedure SetMultiLine(const Value: boolean);
    procedure SetTagHeight(const Value: integer);
    procedure EditExit(Sender: TObject);
    function Accept: boolean;
    procedure SetBgColor(const Value: TColor);
    function GetClickInfoAt(X, Y: integer): TClickInfo;
    function GetSeparatorIndexAt(X, Y: integer): integer;
    procedure CreateCaret;
    procedure DestroyCaret;
    function IsFirstOnRow(TagIndex: integer): boolean; inline;
    function IsLastOnRow(TagIndex: integer): boolean;
    procedure SetAutoHeight(const Value: boolean);
  protected
    { Protected declarations }
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;

    procedure KeyPress(var Key: Char); override;
    procedure WndProc(var Message: TMessage); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property TabOrder;
    property TabStop;
    property Color;
    property Anchors;
    property Align;
    property Tag;
    property Cursor;
    property BgColor: TColor read FBgColor write SetBgColor;
    property BorderColor: TColor read FBorderColor write SetBorderColor;
    property TagBgColor: TColor read FTagBgColor write SetTagBgColor;
    property TagBorderColor: TColor read FTagBorderColor
      write SetTagBorderColor;
    property Spacing: integer read FSpacing write SetSpacing;
    property Tags: TStringList read FTags write SetTags;
    property TextColor: TColor read FTextColor write SetTextColor;
    property SpaceAccepts: boolean read FSpaceAccepts write FSpaceAccepts
      default true;
    property CommaAccepts: boolean read FCommaAccepts write FCommaAccepts
      default true;
    property SemicolonAccepts: boolean read FSemicolonAccepts
      write FSemicolonAccepts default true;
    property TrimInput: boolean read FTrimInput write FTrimInput default true;
    property NoLeadingSpaceInput: boolean read FNoLeadingSpaceInput
      write FNoLeadingSpaceInput default true;
    property AllowDuplicates: boolean read FAllowDuplicates write FAllowDuplicates
      default false;
    property MultiLine: boolean read FMultiLine write SetMultiLine default false;
    property TagHeight: integer read FTagHeight write SetTagHeight default 32;
    property EditorColor: TColor read FEditorColor write FEditorColor
      default clWindow;
    property AutoHeight: boolean read FAutoHeight write SetAutoHeight;
    property OnTagClick: TTagClickEvent read FTagClickEvent write FTagClickEvent;
    property OnTagAdded: TNotifyEvent read FTagAdded write FTagAdded;
    property OnTagRemoved: TNotifyEvent read FTagRemoved write FTagRemoved;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnRemoveConfirm: TRemoveConfirmEvent read FOnRemoveConfirm
      write FOnRemoveConfirm;
  end;

procedure Register;

implementation

uses Math, Clipbrd;

procedure Register;
begin
  RegisterComponents('Rejbrand 2009', [TTagEditor]);
end;

function IsKeyDown(const VK: integer): boolean;
begin
  IsKeyDown := GetKeyState(VK) and $8000 <> 0;
end;

function GetTagPart(ClickInfo: TClickInfo): cardinal;
begin
  result := ClickInfo and $FFFF0000;
end;

{ TTagEditor }

constructor TTagEditor.Create(AOwner: TComponent);
var
  mnuItem: TMenuItem;
begin
  inherited;
  FEdit := TEdit.Create(Self);
  FEdit.Parent := Self;
  FEdit.BorderStyle := bsNone;
  FEdit.Visible := false;
  FEdit.OnKeyPress := EditKeyPress;
  FEdit.OnExit := EditExit;

  FTags := TStringList.Create;
  FTags.OnChange := TagChange;

  FBgColor := clWindow;
  FBorderColor := clWindowFrame;
  FTagBgColor := clSkyBlue;
  FTagBorderColor := clNavy;
  FSpacing := 8;
  FTextColor := clWhite;
  FSpaceAccepts := true;
  FCommaAccepts := true;
  FSemicolonAccepts := true;
  FTrimInput := true;
  FNoLeadingSpaceInput := true;
  FAllowDuplicates := false;
  FMultiLine := false;
  FTagHeight := 32;
  FShrunk := false;
  FEditorColor := clWindow;
  FCaretVisible := false;
  FDragging := false;

  FPopupMenu := TPopupMenu.Create(Self);
  mnuItem := TMenuItem.Create(PopupMenu);
  mnuItem.Caption := 'Delete';
  mnuItem.OnClick := mnuDeleteItemClick;
  mnuItem.Hint := 'Deletes the selected tag.';
  FPopupMenu.Items.Add(mnuItem);

  TabStop := true;
end;

procedure TTagEditor.EditExit(Sender: TObject);
begin
  if FEdit.Text <> '' then
    Accept
  else
    HideEditor;
end;

procedure TTagEditor.mnuDeleteItemClick(Sender: TObject);
begin
  if Sender is TMenuItem then
  begin
    FTags.Delete(TMenuItem(Sender).Tag);
    if Assigned(FTagRemoved) then
      FTagRemoved(Self);
  end;
end;

procedure TTagEditor.TagChange(Sender: TObject);
begin
  Invalidate;
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TTagEditor.WndProc(var Message: TMessage);
begin
  inherited;
  case Message.Msg of
    WM_SETFOCUS:
      Invalidate;
    WM_KILLFOCUS:
      begin
        if FCaretVisible then DestroyCaret;
        FDragging := false;
        Invalidate;
      end;
    WM_COPY:
      Clipboard.AsText := FTags.DelimitedText;
    WM_CLEAR:
      FTags.Clear;
    WM_CUT:
      begin
        Clipboard.AsText := FTags.DelimitedText;
        FTags.Clear;
      end;
    WM_PASTE:
      begin
        if Clipboard.HasFormat(CF_TEXT) then
          if FTags.Count = 0 then
            FTags.DelimitedText := Clipboard.AsText
          else
            FTags.DelimitedText := FTags.DelimitedText + ',' + Clipboard.AsText;
      end;
  end;
end;

function TTagEditor.Accept: boolean;
begin
  Assert(FEdit.Visible);
  result := false;
  if FTrimInput then
    FEdit.Text := Trim(FEdit.Text);
  if (FEdit.Text = '') or
    ((not AllowDuplicates) and (FTags.IndexOf(FEdit.Text) <> -1))  then
  begin
    beep;
    Exit;
  end;
  FTags.Add(FEdit.Text);
  result := true;
  HideEditor;
  if Assigned(FTagAdded) then
    FTagAdded(Self);
  Invalidate;
end;

procedure TTagEditor.EditKeyPress(Sender: TObject; var Key: Char);
begin

  if (Key = chr(VK_SPACE)) and (FEdit.Text = '') and FNoLeadingSpaceInput then
  begin
    Key := #0;
    Exit;
  end;

  if ((Key = chr(VK_SPACE)) and FSpaceAccepts) or
    ((Key = ',') and FCommaAccepts) or
    ((Key = ';') and FSemicolonAccepts) then
    Key := chr(VK_RETURN);

  case ord(Key) of
    VK_RETURN:
      begin
        Accept;
        ShowEditor;
        Key := #0;
      end;
    VK_BACK:
      begin
        if (FEdit.Text = '') and (FTags.Count > 0) then
        begin
          FTags.Delete(FTags.Count - 1);
          if Assigned(FTagRemoved) then
            FTagRemoved(Sender);
        end;
      end;
    VK_ESCAPE:
      begin
        HideEditor;
        Self.SetFocus;
        Key := #0;
      end;
  end;

end;

destructor TTagEditor.Destroy;
begin
  FPopupMenu.Free;
  FTags.Free;
  FEdit.Free;
  inherited;
end;

procedure TTagEditor.HideEditor;
begin
  FEdit.Text := '';
  FEdit.Hide;
//  SetFocus;
end;


procedure TTagEditor.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited;
  case Key of
    VK_END:
      ShowEditor;
    VK_DELETE:
      Perform(WM_CLEAR, 0, 0);
    VK_INSERT:
      Perform(WM_PASTE, 0, 0);
  end;
end;

procedure TTagEditor.KeyPress(var Key: Char);
begin
  inherited;

  case Key of
    ^C:
      begin
        Perform(WM_COPY, 0, 0);
        Key := #0;
        Exit;
      end;
    ^X:
      begin
        Perform(WM_CUT, 0, 0);
        Key := #0;
        Exit;
      end;
    ^V:
      begin
        Perform(WM_PASTE, 0, 0);
        Key := #0;
        Exit;
      end;
  end;

  ShowEditor;
  FEdit.Perform(WM_CHAR, ord(Key), 0);
end;

function TTagEditor.GetClickInfoAt(X, Y: integer): TClickInfo;
var
  i: integer;
begin
  result := NOWHERE;
  if (X >= FEditPos.X) and (Y >= FEditPos.Y) then
    Exit(EDITOR);

  for i := 0 to FTags.Count - 1 do
    if InRange(X, FLefts[i], FRights[i]) and InRange(Y, FTops[i], FBottoms[i]) then
    begin
      result := i;
      if InRange(X, FCloseBtnLefts[i], FCloseBtnLefts[i] + FCloseBtnWidth) and
        InRange(Y, FCloseBtnTops[i], FCloseBtnTops[i] + FActualTagHeight) and
        not FShrunk then
        result := result or PART_REMOVE_BUTTON;
      break;
    end;
end;

function TTagEditor.IsFirstOnRow(TagIndex: integer): boolean;
begin
  result := (TagIndex = 0) or (FTops[TagIndex] > FTops[TagIndex-1]);
end;

function TTagEditor.IsLastOnRow(TagIndex: integer): boolean;
begin
  result := (TagIndex = FTags.Count - 1) or (FTops[TagIndex] < FTops[TagIndex+1]);
end;

function TTagEditor.GetSeparatorIndexAt(X, Y: integer): integer;
var
  i: Integer;
begin
  result := FTags.Count;
  Y := Max(Y, FSpacing + 1);
  for i := FTags.Count - 1 downto 0 do
  begin
    if Y < FTops[i] then Continue;
    if (IsLastOnRow(i) and (X >= FRights[i])) or
      ((X < FRights[i]) and (IsFirstOnRow(i) or (FRights[i-1] < X))) then
    begin
      result := i;
      if (IsLastOnRow(i) and (X >= FRights[i])) then inc(result);
      Exit;
    end;
  end;
end;

procedure TTagEditor.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  FMouseDownClickInfo := GetClickInfoAt(X, Y);
  if GetTagIndex(FMouseDownClickInfo) <> EDITOR then
    SetFocus;
end;

procedure TTagEditor.CreateCaret;
begin
  if not FCaretVisible then
    FCaretVisible := Windows.CreateCaret(Handle, 0, 0, FActualTagHeight);
end;

procedure TTagEditor.DestroyCaret;
begin
  if not FCaretVisible then Exit;
  Windows.DestroyCaret;
  FCaretVisible := false;
end;

procedure TTagEditor.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  SepIndex: integer;
begin
  inherited;

  if IsKeyDown(VK_LBUTTON) and
    InRange(GetTagIndex(FMouseDownClickInfo), TAG_LOW, TAG_HIGH) then
  begin
    FDragging := true;
    Screen.Cursor := crDrag;
    SepIndex := GetSeparatorIndexAt(X, Y);
    TForm(Parent).Caption := IntToStr(SepIndex);
    CreateCaret;
    if SepIndex = FTags.Count then
      SetCaretPos(FLefts[SepIndex - 1] + FWidths[SepIndex - 1] + FSpacing div 2,
        FTops[SepIndex - 1])
    else
      SetCaretPos(FLefts[SepIndex] - FSpacing div 2, FTops[SepIndex]);
    ShowCaret(Handle);
    Exit;
  end;

  case GetTagIndex(GetClickInfoAt(X,Y)) of
    NOWHERE: Cursor := crArrow;
    EDITOR: Cursor := crIBeam;
    TAG_LOW..TAG_HIGH: Cursor := crHandPoint;
  end;

end;

procedure TTagEditor.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var
  pnt: TPoint;
  CanRemove: boolean;
  ClickInfo: TClickInfo;
  i: word;
  p: cardinal;
  SepIndex: integer;
begin
  inherited;

  if FDragging then
  begin
    DestroyCaret;
    FDragging := false;
    Screen.Cursor := crDefault;
    SepIndex := GetSeparatorIndexAt(X, Y);
    if not InRange(SepIndex, GetTagIndex(FMouseDownClickInfo),
      GetTagIndex(FMouseDownClickInfo) + 1) then
      FTags.Move(GetTagIndex(FMouseDownClickInfo), SepIndex -
        IfThen(SepIndex > GetTagIndex(FMouseDownClickInfo), 1, 0));
    Exit;
  end;

  ClickInfo := GetClickInfoAt(X, Y);

  if ClickInfo <> FMouseDownClickInfo then Exit;

  i := GetTagIndex(ClickInfo);
  p := GetTagPart(ClickInfo);

  case i of
    EDITOR:
      ShowEditor;
    NOWHERE: ;
  else
    case Button of
      mbLeft:
        begin
          case p of
            PART_BODY:
              if Assigned(FTagClickEvent) then
                FTagClickEvent(Self, i, FTags[i]);
            PART_REMOVE_BUTTON:
              begin
                if Assigned(FOnRemoveConfirm) then
                begin
                  CanRemove := false;
                  FOnRemoveConfirm(Self, i, FTags[i], CanRemove);
                  if not CanRemove then Exit;
                end;
                FTags.Delete(i);
                if Assigned(FTagRemoved) then
                  FTagRemoved(Self);
              end;
          end;
        end;
      mbRight:
        begin
          FPopupMenu.Items[0].Tag := i;
          pnt := ClientToScreen(Point(X,Y));
          FPopupMenu.Items[0].Caption := 'Delete tag "' + FTags[i] + '"';
          FPopupMenu.Popup(pnt.X, pnt.Y);
        end;
    end;
  end;

end;

procedure TTagEditor.Paint;
var
  i: integer;
  w: integer;
  x, y: integer;
  R: TRect;
  MeanWidth: integer;
  S: string;
  DesiredHeight: integer;
begin
  inherited;
  Canvas.Brush.Color := FBgColor;
  Canvas.Pen.Color := FBorderColor;
  Canvas.Rectangle(ClientRect);
  Canvas.Font.Assign(Self.Font);
  SetLength(FLefts, FTags.Count);
  SetLength(FRights, FTags.Count);
  SetLength(FTops, FTags.Count);
  SetLength(FBottoms, FTags.Count);
  SetLength(FWidths, FTags.Count);
  SetLength(FCloseBtnLefts, FTags.Count);
  SetLength(FCloseBtnTops, FTags.Count);
  FCloseBtnWidth := Canvas.TextWidth('×');
  FShrunk := false;

  // Do metrics
  FNumRows := 1;
  if FMultiLine then
  begin
    FActualTagHeight := FTagHeight;
    x := FSpacing;
    y := FSpacing;
    for i := 0 to FTags.Count - 1 do
    begin
      FWidths[i] := Canvas.TextWidth(FTags[i] + ' ×') + 2*FSpacing;
      FLefts[i] := x;
      FRights[i] := x + FWidths[i];
      FTops[i] := y;
      FBottoms[i] := y + FTagHeight;

      if x + FWidths[i] + FSpacing > ClientWidth then
   { no need to make room for the editor, since it can reside on the next row! }
      begin
        x := FSpacing;
        inc(y, FTagHeight + FSpacing);
        inc(FNumRows);
        FLefts[i] := x;
        FRights[i] := x + FWidths[i];
        FTops[i] := y;
        FBottoms[i] := y + FTagHeight;
      end;

      FCloseBtnLefts[i] := x + FWidths[i] - FCloseBtnWidth - FSpacing;
      FCloseBtnTops[i] := y;

      inc(x, FWidths[i] + FSpacing);
    end;
  end
  else // i.e., not FMultiLine
  begin
    FActualTagHeight := ClientHeight - 2*FSpacing;
    x := FSpacing;
    y := FSpacing;
    for i := 0 to FTags.Count - 1 do
    begin
      FWidths[i] := Canvas.TextWidth(FTags[i] + ' ×') + 2*FSpacing;
      FLefts[i] := x;
      FRights[i] := x + FWidths[i];
      FTops[i] := y;
      FBottoms[i] := y + FActualTagHeight;
      inc(x, FWidths[i] + FSpacing);
      FCloseBtnLefts[i] := FRights[i] - FCloseBtnWidth - FSpacing;
      FCloseBtnTops[i] := y;
    end;
    FShrunk := x + 64 {FEdit} > ClientWidth;
    if FShrunk then
    begin

      // Enough to remove close buttons?
      x := FSpacing;
      y := FSpacing;
      for i := 0 to FTags.Count - 1 do
      begin
        FWidths[i] := Canvas.TextWidth(FTags[i]) + 2*FSpacing;
        FLefts[i] := x;
        FRights[i] := x + FWidths[i];
        FTops[i] := y;
        FBottoms[i] := y + FActualTagHeight;
        inc(x, FWidths[i] + FSpacing);
        FCloseBtnLefts[i] := FRights[i] - FCloseBtnWidth - FSpacing;
        FCloseBtnTops[i] := y;
      end;

      if x + 64 {FEdit} > ClientWidth then // apparently no
      begin
        MeanWidth := (ClientWidth - 2*FSpacing - 64 {FEdit}) div FTags.Count - FSpacing;
        x := FSpacing;
        for i := 0 to FTags.Count - 1 do
        begin
          FWidths[i] := Min(FWidths[i], MeanWidth);
          FLefts[i] := x;
          FRights[i] := x  + FWidths[i];
          inc(x, FWidths[i] + FSpacing);
        end;
      end;
    end;
  end;

  FEditPos := Point(FSpacing, FSpacing + (FActualTagHeight - FEdit.Height) div 2);
  if FTags.Count > 0 then
    FEditPos := Point(FRights[FTags.Count - 1] + FSpacing,
      FTops[FTags.Count - 1] + (FActualTagHeight - FEdit.Height) div 2);
  if FMultiLine and (FEditPos.X + 64 > ClientWidth) and (FTags.Count > 0) then
  begin
    FEditPos := Point(FSpacing,
      FTops[FTags.Count - 1] + FTagHeight + FSpacing +
      (FActualTagHeight - FEdit.Height) div 2);
    inc(FNumRows);
  end;

  DesiredHeight := FSpacing + FNumRows*(FTagHeight+FSpacing);
  if FMultiLine and FAutoHeight and (ClientHeight <> DesiredHeight) then
  begin
    ClientHeight := DesiredHeight;
    Invalidate;
    Exit;
  end;

  // Draw
  for i := 0 to FTags.Count - 1 do
  begin
    x := FLefts[i];
    y := FTops[i];
    w := FWidths[i];
    R := Rect(x, y, x + w, y + FActualTagHeight);
    Canvas.Brush.Color := FTagBgColor;
    Canvas.Pen.Color := FTagBorderColor;
    Canvas.Rectangle(R);
    Canvas.Font.Color := FTextColor;
    Canvas.Brush.Style := bsClear;
    R.Left := R.Left + FSpacing;
    S := FTags[i];
    if not FShrunk then
      S := S + ' ×';
    DrawText(Canvas.Handle, PChar(S), -1, R, DT_SINGLELINE or DT_VCENTER or
      DT_LEFT or DT_END_ELLIPSIS or DT_NOPREFIX);
    Canvas.Brush.Style := bsSolid;
  end;

  if FEdit.Visible then
  begin
    FEdit.Left := FEditPos.X;
    FEdit.Top := FEditPos.Y;
    FEdit.Width := ClientWidth - FEdit.Left - FSpacing;
  end;
  if Focused then
  begin
    R := Rect(2, 2, ClientWidth - 2, ClientHeight - 2);
    SetBkColor(Canvas.Handle, clWhite);
    SetTextColor(clBlack);
    Canvas.DrawFocusRect(R);
  end;
end;

procedure TTagEditor.SetAutoHeight(const Value: boolean);
begin
  if FAutoHeight <> Value then
  begin
    FAutoHeight := Value;
    Invalidate;
  end;
end;

procedure TTagEditor.SetBgColor(const Value: TColor);
begin
  if FBgColor <> Value then
  begin
    FBgColor := Value;
    Invalidate;
  end;
end;

procedure TTagEditor.SetBorderColor(const Value: TColor);
begin
  if FBorderColor <> Value then
  begin
    FBorderColor := Value;
    Invalidate;
  end;
end;

procedure TTagEditor.SetMultiLine(const Value: boolean);
begin
  if FMultiLine <> Value then
  begin
    FMultiLine := Value;
    Invalidate;
  end;
end;

procedure TTagEditor.SetTagBgColor(const Value: TColor);
begin
  if FTagBgColor <> Value then
  begin
    FTagBgColor := Value;
    Invalidate;
  end;
end;

procedure TTagEditor.SetTagBorderColor(const Value: TColor);
begin
  if FTagBorderColor <> Value then
  begin
    FTagBorderColor := Value;
    Invalidate;
  end;
end;

procedure TTagEditor.SetTagHeight(const Value: integer);
begin
  if FTagHeight <> Value then
  begin
    FTagHeight := Value;
    Invalidate;
  end;
end;

procedure TTagEditor.SetTags(const Value: TStringList);
begin
  FTags.Assign(Value);
  Invalidate;
end;

procedure TTagEditor.SetTextColor(const Value: TColor);
begin
  if FTextColor <> Value then
  begin
    FTextColor := Value;
    Invalidate;
  end;
end;

procedure TTagEditor.ShowEditor;
begin
  FEdit.Left := FEditPos.X;
  FEdit.Top := FEditPos.Y;
  FEdit.Width := ClientWidth - FEdit.Left - FSpacing;
  FEdit.Color := FEditorColor;
  FEdit.Text := '';
  FEdit.Show;
  FEdit.SetFocus;
end;

procedure TTagEditor.SetSpacing(const Value: integer);
begin
  if FSpacing <> Value then
  begin
    FSpacing := Value;
    Invalidate;
  end;
end;

initialization
  Screen.Cursors[crHandPoint] := LoadCursor(0, IDC_HAND); // Get the normal hand cursor

end.

which yields

Screenshot http://privat.rejbrand.se/tageditor.png

Sample video

Demo (Compiled EXE)

If I get more time later on today I will do some more work on this control, e.g., button highlighting on mouse hover, tag click event, button max width etc.

Update: Added a lot of features.

Update: Added multi-line feature.

Update: More features.

Update: Added clipboard interface, fixed some issues, etc.

Update: Added drag-and-drop reordering and fixed some minor issues. By the way, this is the last version I'll post here. Later versions (if there will be any) will be posted at http://specials.rejbrand.se/dev/controls/.

Update: Added AutoHeight property, made edit box vertically centred, and changed the drag cursor. (Yeah, I couldn't resist making yet another update.)

这篇关于Delphi / C ++ Builder的标签编辑器组件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！