sourceeditunit.pas

这是一个有关文本编辑器的源程序,支持彩色语法,你可以任意修改,修改后发给我一份

{*******************************************************}
{                                                       }
{       TSourceEdit Component v2.12                     }
{                                                       }
{       Based on TMemoComponent                         }
{                                                       }
{       Copyright (c) 2000-2002 Sebastian Reichelt      }
{                                                       }
{*******************************************************}
(*
  add: CurrentCol, CurrentRow
  add: FindText, ReplaceText, GotoLine
  add: TCustomstyle.CaseSensitive
  Modified: TCustomstyle.FindItem(S: string)  process CaseSensitive string;
*)
unit SourceEditUnit;

interface

uses
	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
	StdCtrls, Consts, ObjList, MemoComponentUnit, RtfExport;

const
	SymbolChars: set of Char = ['<', '{', '[', '(', ')', ']', '}', '>', ';', ':', ',', '.', '=', '+', '-', '*', '/', '\', '|', '"', '''', '!', '?', '&', '%', '#', '@', '^', '~'];
	MaxBeginEndTextLength = 20;
	MaxOnFlySectionLength = 128;
	SSourceEditError = 'TSourceEdit internal error';

type
	ESourceEdit = class(Exception);

	TSyntaxColoring = class;
	TWordLists = class;
	TWordList = class;
	TCustomStyles = class;
	TCustomStyle = class;

	TSyntaxRange = class;

	TIgnoreChar = string [1];
	TParenthesisStyle = (psOpening, psClosing);

	TDebuggableRange = record
		RStart,
		REnd: Integer;
		Text,
		ClassName: string;
	end;
	TDebuggableRanges = array of TDebuggableRange;

        //SearchOption for FindText and ReplaceText
        TSearchOption = set of (soCaseSensitive, soSearchSelText, soSearchAllText,
                         soFromCursor, soWholeRange, soUp, soDown);

        //SearchRange, CurPos-->record next time's finding position
        TSearchRange = record
         BegPos, EndPos, CurPos: Integer;
        end;

	TSourceEdit = class(TMemoComponent)
	private
		FAutoIndent: Boolean;
		FSyntaxColoring: TSyntaxColoring;
		FFirstSyntaxRange: TSyntaxRange;
		FLastSyntaxRange: TSyntaxRange;
		FAutoIndentIncrease: Boolean;
		FAutoIndentIncreaseStart: Char;
		FAutoIndentIncreaseEnd: Char;
		FSplitOnFly: Boolean;
                //Add New
                FSearchOption: TSearchOption;
                FSearch: TSearchRange;
                //-------
		procedure CMFontChanged(var Message: TMessage); message cm_FontChanged;
		procedure WMKeyDown(var Message: TWMKeyDown); message wm_KeyDown;
		procedure SetSyntaxColoring(const Value: TSyntaxColoring);
		procedure SetSplitOnFly(const Value: Boolean);
                //Add New
                function GetCurrentCol: Integer;
                function GetCurrentRow: Integer;
                procedure SetSearchOption(const Value: TSearchOption);
                //--------
	protected
		SyntaxStartRange,
		LastPRange: TSyntaxRange;
		LastCRange: TCustomRange;
		procedure KeyPress(var Key: Char); override;
		procedure TextChangeNotification(StartPos, OldLength, NewLength: Integer); override;
		procedure TextChangeNotificationAfter; override;
		procedure ReColor; virtual;
		procedure ReColorRange(Range: TCustomRange); virtual;
		procedure FreeAllSyntaxRanges; virtual;
		function ReplaceSyntaxRanges(NewRange: TSyntaxRange; var StartRange: TSyntaxRange): Boolean; virtual;
		function CreateSplitRanges(Range: TCustomRange): TFormattedRangeArray; override;
		procedure OverwriteRange(Sender: TObject);
		function FindSyntaxHole: TSyntaxRange; virtual;
		function FindSyntaxOverlap: TSyntaxRange; virtual;
		function MakeDebuggableRanges: TDebuggableRanges; virtual;
	public
		constructor Create(AOwner: TComponent); override;
		destructor Destroy; override;
		function SyntaxRangeAtPos(RangePos: Integer): TSyntaxRange; virtual;
		function SyntaxRangeAtPosWithHint(RangePos: Integer; Hint: TSyntaxRange): TSyntaxRange; virtual;
                //Add
                function FindText(ATxt: string): Boolean;
                function ReplaceText(FindTxt, ReplaceTxt: string; ReplaceAll: Boolean): Boolean;
                procedure GotoLine(LineNo: Integer);
                procedure ExportToRtf(FileName: string; NeedColor: Boolean=True);
                //--------
		property FirstSyntaxRange: TSyntaxRange read FFirstSyntaxRange write FFirstSyntaxRange;
		property LastSyntaxRange: TSyntaxRange read FLastSyntaxRange write FLastSyntaxRange;
                //Add
                property SearchOption: TSearchOption read FSearchOption write SetSearchOption;
                property CurrentCol: Integer read GetCurrentCol;
                property CurrentRow: Integer read GetCurrentRow;
                //-----------
	published
		property SyntaxColoring: TSyntaxColoring read FSyntaxColoring write SetSyntaxColoring;
		property AutoIndent: Boolean read FAutoIndent write FAutoIndent;
		property AutoIndentIncrease: Boolean read FAutoIndentIncrease write FAutoIndentIncrease;
		property AutoIndentIncreaseStart: Char read FAutoIndentIncreaseStart write FAutoIndentIncreaseStart;
		property AutoIndentIncreaseEnd: Char read FAutoIndentIncreaseEnd write FAutoIndentIncreaseEnd;
		property SplitOnFly: Boolean read FSplitOnFly write SetSplitOnFly;
	end;

	TSyntaxRangeClass = class of TSyntaxRange;

	TSyntaxRange = class(TCustomFormattedRange)
	private
		FParenthesisLevel: Integer;
		FNextRange: TSyntaxRange;
		FPrevRange: TSyntaxRange;
	protected
		procedure SetNewParenthesisLevel; virtual;
		function GetNextParenthesisLevel: Integer; virtual;
		function GetColor: TColor; override;
		function ReplaceSyntaxRanges(var StartRange: TSyntaxRange): Boolean; virtual;
	public
		destructor Destroy; override;
		class function EqualEndings(Range1, Range2: TSyntaxRange): Boolean;
		function EqualEndingsWith(Range: TSyntaxRange): Boolean; virtual;
		class function InsertRangeBefore(Range: TSyntaxRange; RangeClass: TSyntaxRangeClass; Editor: TSourceEdit): TSyntaxRange;
		function InsertBefore(RangeClass: TSyntaxRangeClass): TSyntaxRange;
		function InsertAfter(RangeClass: TSyntaxRangeClass): TSyntaxRange;
		class function NewRangeInsertedBefore(Range: TSyntaxRange; Editor: TSourceEdit): TSyntaxRange;
		class function NewRangeInsertedAfter(Range: TSyntaxRange; Editor: TSourceEdit): TSyntaxRange;
		procedure UpdateParenthesisLevel; virtual;
		property NextParenthesisLevel: Integer read GetNextParenthesisLevel;
		property PrevRange: TSyntaxRange read FPrevRange write FPrevRange;
		property NextRange: TSyntaxRange read FNextRange write FNextRange;
	published
		property ParenthesisLevel: Integer read FParenthesisLevel write FParenthesisLevel;
	end;

	TNormalTextRange = class(TSyntaxRange)
	protected
		function GetFont: TFont; override;
	public
		function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
	end;

	TCustomStyleRange = class(TSyntaxRange)
	private
		FStyle: TCustomStyle;
	protected
		function GetFont: TFont; override;
	public
		function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
	published
		property Style: TCustomStyle read FStyle write FStyle;
	end;

	TCustomTextRange = class(TSyntaxRange)
	protected
		function GetFont: TFont; override;
	public
		function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
	end;

	TWordListRange = class(TSyntaxRange)
	private
		FWordList: TWordList;
	protected
		function GetFont: TFont; override;
	public
		function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
	published
		property WordList: TWordList read FWordList write FWordList;
	end;

	TSymbolRange = class(TSyntaxRange)
	private
		FSymbol: string;
	protected
		function GetFont: TFont; override;
	public
		function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
	published
		property Symbol: string read FSymbol write FSymbol;
	end;

	TNumberRange = class(TSyntaxRange)
	private
		FNumber: string;
	protected
		function GetFont: TFont; override;
	public
		function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
	published
		property Number: string read FNumber write FNumber;
	end;

	TParenthesisRange = class(TSyntaxRange)
	private
		FStyle: TParenthesisStyle;
	protected
		procedure SetNewParenthesisLevel; override;
		function GetNextParenthesisLevel: Integer; override;
		function GetFont: TFont; override;
	public
		function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
		procedure UpdateParenthesisLevel; override;
	published
		property Style: TParenthesisStyle read FStyle write FStyle;
	end;

	TSyntaxColoring = class(TOwnedPersistent)
	private
		FNumberColor: TColor;
		FSymbolColor: TColor;
		FCustomStyles: TCustomStyles;
		FWordLists: TWordLists;
		FEnabled: Boolean;
		FUpdateDebth: Integer;
		FParenthesisColors: TStringList;
		FSymbolCustomStyle: Boolean;
		FNumberCustomStyle: Boolean;
		FNumberStyle: TFontStyles;
		FSymbolStyle: TFontStyles;
		FParenthesisCustomStyle: Boolean;
		FParenthesisStyle: TFontStyles;
		procedure SetCustomStyles(const Value: TCustomStyles);
		procedure SetNumberColor(const Value: TColor);
		procedure SetSymbolColor(const Value: TColor);
		procedure SetWordLists(const Value: TWordLists);
		procedure SetEnabled(const Value: Boolean);
		procedure SetParenthesisColors(const Value: TStringList);
		procedure SetNumberCustomStyle(const Value: Boolean);
		procedure SetNumberStyle(const Value: TFontStyles);
		procedure SetSymbolCustomStyle(const Value: Boolean);
		procedure SetSymbolStyle(const Value: TFontStyles);
		procedure SetParenthesisCustomStyle(const Value: Boolean);
		procedure SetParenthesisStyle(const Value: TFontStyles);
	protected
		SymbolFont,
		NumberFont,
		ParenthesisFont: TFont;
		procedure ChangeNotification(Sender: TObject);
	public
		constructor Create(AOwner: TPersistent); override;
		destructor Destroy; override;
		procedure ColoringChange; virtual;
		procedure Assign(Source: TPersistent); override;
		function GetParenthesisColor(Index: Integer): TColor;
		procedure BeginUpdate; virtual;
		procedure EndUpdate; virtual;
	published
		property Enabled: Boolean read FEnabled write SetEnabled;
		property SymbolColor: TColor read FSymbolColor write SetSymbolColor;
		property SymbolStyle: TFontStyles read FSymbolStyle write SetSymbolStyle;
		property SymbolCustomStyle: Boolean read FSymbolCustomStyle write SetSymbolCustomStyle;
		property NumberColor: TColor read FNumberColor write SetNumberColor;
		property NumberStyle: TFontStyles read FNumberStyle write SetNumberStyle;
		property NumberCustomStyle: Boolean read FNumberCustomStyle write SetNumberCustomStyle;
		property WordLists: TWordLists read FWordLists write SetWordLists;
		property CustomStyles: TCustomStyles read FCustomStyles write SetCustomStyles;
		property ParenthesisColors: TStringList read FParenthesisColors write SetParenthesisColors;
		property ParenthesisStyle: TFontStyles read FParenthesisStyle write SetParenthesisStyle;
		property ParenthesisCustomStyle: Boolean read FParenthesisCustomStyle write SetParenthesisCustomStyle;
	end;

	TWordLists = class(TCollection)
	private
		FColoring: TSyntaxColoring;
		function GetItem(Index: Integer): TWordList;
		procedure SetItem(Index: Integer; Value: TWordList);
	protected
		function GetOwner: TPersistent; override;
		procedure Update(Item: TCollectionItem); override;
	public
		constructor Create(AColoring: TSyntaxColoring);
		function Add: TWordList;
		function FindList(const S: string): TWordList;
		property Items[Index: Integer]: TWordList read GetItem write SetItem; default;
	end;

	TWordList = class(TCollectionItem)
	private
		FCustomStyle: Boolean;
		FCustomColor: Boolean;
		FColor: TColor;
		FStyle: TFontStyles;
		FWords: TStringList;
		FDisplayName: string;
		FCaseSensitive: Boolean;
		procedure SetColor(const Value: TColor);
		procedure SetCustomColor(const Value: Boolean);
		procedure SetCustomStyle(const Value: Boolean);
		procedure SetStyle(const Value: TFontStyles);
		procedure SetWords(const Value: TStringList);
		procedure SetCaseSensitive(const Value: Boolean);
	protected
		Font: TFont;
		function GetDisplayName: string; override;
		procedure SetDisplayName(const Value: string); override;
		procedure ListChange; virtual;
		procedure ChangeNotification(Sender: TObject);
	public
		constructor Create(Collection: TCollection); override;
		destructor Destroy; override;
		procedure Assign(Source: TPersistent); override;
		function WordInList(S: string): Boolean;
	published
		property Caption: string read FDisplayName write SetDisplayName;
		property CustomColor: Boolean read FCustomColor write SetCustomColor;
		property Color: TColor read FColor write SetColor;
		property CustomStyle: Boolean read FCustomStyle write SetCustomStyle;
		property Style: TFontStyles read FStyle write SetStyle;
		property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive;
		property Words: TStringList read FWords write SetWords;
	end;

	TCustomStyles = class(TCollection)
	private
		FColoring: TSyntaxColoring;
		function GetItem(Index: Integer): TCustomStyle;
		procedure SetItem(Index: Integer; Value: TCustomStyle);
	protected
		function GetOwner: TPersistent; override;
		procedure Update(Item: TCollectionItem); override;
	public
		constructor Create(AColoring: TSyntaxColoring);
		function Add: TCustomStyle;
		function FindStyle(const S: string): TCustomStyle;
		property Items[Index: Integer]: TCustomStyle read GetItem write SetItem; default;
	end;

	TCustomStyle = class(TCollectionItem)
	private
                FCaseSensitive: Boolean;       //Add new
		FCustomStyle: Boolean;
		FCustomColor: Boolean;
		FEndText: string;
		FBeginText: string;
		FColor: TColor;
		FStyle: TFontStyles;
		FIgnoreChar: TIgnoreChar;
		FDisplayName: string;
		FSwitchable: Boolean;
		FLineStartOnly: Boolean;
		procedure SetBeginText(Value: string);
		procedure SetColor(const Value: TColor);
		procedure SetCustomColor(const Value: Boolean);
		procedure SetCustomStyle(const Value: Boolean);
		procedure SetEndText(Value: string);
		procedure SetIgnoreChar(const Value: TIgnoreChar);
		procedure SetStyle(const Value: TFontStyles);
		procedure SetSwitchable(const Value: Boolean);
		procedure SetLineStartOnly(const Value: Boolean);
	protected
		Font: TFont;
		function GetDisplayName: string; override;
		procedure SetDisplayName(const Value: string); override;
		procedure StyleChange; virtual;
	public
		constructor Create(Collection: TCollection); override;
		destructor Destroy; override;
		procedure Assign(Source: TPersistent); override;
	published
		property Caption: string read FDisplayName write SetDisplayName;
		property CustomColor: Boolean read FCustomColor write SetCustomColor;
		property Color: TColor read FColor write SetColor;
		property CustomStyle: Boolean read FCustomStyle write SetCustomStyle;
		property Style: TFontStyles read FStyle write SetStyle;
		property BeginText: string read FBeginText write SetBeginText;
		property EndText: string read FEndText write SetEndText;
		property IgnoreChar: TIgnoreChar read FIgnoreChar write SetIgnoreChar;
		property Switchable: Boolean read FSwitchable write SetSwitchable;
		property LineStartOnly: Boolean read FLineStartOnly write SetLineStartOnly;
                property CaseSensitive: Boolean read FCaseSensitive write FCaseSensitive;
	end;

	TSyntaxColoringCopy = class(TComponent)
	private
		FNumberColor: TColor;
		FSymbolColor: TColor;
		FCustomStyles: TCustomStyles;
		FWordLists: TWordLists;
		FEnabled: Boolean;
		FParenthesisColors: TStringList;
		FSymbolCustomStyle: Boolean;
		FNumberCustomStyle: Boolean;
		FNumberStyle: TFontStyles;
		FSymbolStyle: TFontStyles;
		FParenthesisCustomStyle: Boolean;
		FParenthesisStyle: TFontStyles;
		procedure SetCustomStyles(const Value: TCustomStyles);
		procedure SetParenthesisColors(const Value: TStringList);
		procedure SetWordLists(const Value: TWordLists);
	protected
	public
		procedure Assign(Source: TPersistent); override;
	published
		constructor Create(AOwner: TComponent); override;
		destructor Destroy; override;
		property Enabled: Boolean read FEnabled write FEnabled;
		property SymbolColor: TColor read FSymbolColor write FSymbolColor;
		property SymbolStyle: TFontStyles read FSymbolStyle write FSymbolStyle;
		property SymbolCustomStyle: Boolean read FSymbolCustomStyle write FSymbolCustomStyle;
		property NumberColor: TColor read FNumberColor write FNumberColor;
		property NumberStyle: TFontStyles read FNumberStyle write FNumberStyle;
		property NumberCustomStyle: Boolean read FNumberCustomStyle write FNumberCustomStyle;
		property WordLists: TWordLists read FWordLists write SetWordLists;
		property CustomStyles: TCustomStyles read FCustomStyles write SetCustomStyles;
		property ParenthesisColors: TStringList read FParenthesisColors write SetParenthesisColors;
		property ParenthesisStyle: TFontStyles read FParenthesisStyle write FParenthesisStyle;
		property ParenthesisCustomStyle: Boolean read FParenthesisCustomStyle write FParenthesisCustomStyle;
	end;