Title: A Color Editor Component
Question: Add a PropertyPage for choose a Tokens and relative color
Answer:
This component derived from TCustomRichEdit, is a simple editor with two add property called Token and TokenColor. The final project is to have an editor similar a Unit Delphi editor. This is the version 1.0 of that project.
This is the class definition:
----------------------------------------------------------------------
unit ColorEditor;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, ExtCtrls;
type
TColorEditor = class(TCustomRichEdit)
private
FTokenList: TStringList;
FTokenColor: TColor;
procedure SetTokenList(Value: TStringList);
procedure SetTokenColor(Value: TColor);
procedure UpdateEditor;
protected
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property DefAttributes;
property Modified;
property SelAttributes;
property SelLength;
property SelStart;
property SelText;
procedure ClearToken;
procedure AddToken(Token: string);
function GetLineNumber: Integer;
published
property Align;
property Anchors;
property BorderStyle;
property Color;
property Constraints;
property Ctl3D;
property Enabled;
property Font;
property HideScrollBars;
property HideSelection;
property Lines;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ScrollBars;
property TabOrder;
property TabStop;
property Token: TStringList read FTokenList write SetTokenList;
property TokenColor: TColor read FTokenColor write SetTokenColor default clNavy;
property Visible;
property WantReturns;
property WantTabs;
property WordWrap;
property OnChange;
property OnClick;
property OnDblClick;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnSelectionChange;
end;
procedure Register;
implementation
constructor TColorEditor.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Alignment := taLeftJustify;
PlainText := True;
MaxLength := 0;
FTokenList := TStringList.Create;
FTokenColor := clNavy;
end;
procedure TColorEditor.SetTokenList(Value: TStringList);
begin
FTokenList.Assign(Value);
end;
procedure TColorEditor.SetTokenColor(Value: TColor);
begin
if Value FTokenColor then
begin
FTokenColor := Value;
Update;
end;
end;
procedure TColorEditor.KeyDown(var Key: Word; Shift: TShiftState);
begin
if (Key = 13) Or (Key = 38) Or (Key = 40) Then
UpdateEditor;
if Assigned(OnkeyDown) then
OnkeyDown(Self, Key, Shift);
end;
procedure TColorEditor.ClearToken;
begin
FTokenList.Clear;
end;
procedure TColorEditor.AddToken(Token: string);
begin
if Token '' then
FTokenList.Add(Token);
end;
function TColorEditor.GetLineNumber: Integer;
begin
Result := Perform(EM_LINEFROMCHAR,SelStart,0) +1;
end;
procedure TColorEditor.UpdateEditor;
var
iTokenCount, iToken: Integer;
iStart, iEnd: Integer;
fToken: Integer;
cLine: Integer;
Token: string;
begin
iTokenCount := FTokenList.Count -1;
if iTokenCount Exit;
cLine := SelStart;
Perform(WM_SETREDRAW,0,0);
for iToken := 0 to iTokenCount do
begin
iStart := 0;
iEnd := Length(Text);
Token := FTokenList.Strings[iToken];
fToken := FindText(Token,iStart,iEnd,[stWholeWord]);
while (fToken -1) do
begin
SelStart := fToken;
SelLength := Length(Token);
SelAttributes.Color := FTokenColor;
iStart := fToken + Length(Token);
iEnd := Length(Text) - iStart;
fToken := FindText(Token,iStart,iEnd,[stWholeWord]);
end;
end;
SelStart := cLine;
Perform(WM_SETREDRAW,1,0);
Refresh;
end;
destructor TColorEditor.Destroy;
begin
FTokenList.Free;
inherited Destroy;
end;
procedure Register;
begin
RegisterComponents('Custom', [TColorEditor]);
end;
end.