Delphi / C ++ Builder的标签编辑器组件

本文介绍了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 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 示例视频 演示（编译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 tallOption to select whether tags are created when pressing space or comma keyPrompt 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 likeunit TagEditor;interfaceuses 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;implementationuses 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 cursorend.which yieldsScreenshot http://privat.rejbrand.se/tageditor.pngSample videoDemo (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的标签编辑器组件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！