sourceeditunit.pas

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

		FCustomStyle := TWordList(Source).CustomStyle;
		FStyle := TWordList(Source).Style;
		FCaseSensitive := TWordList(Source).CaseSensitive;
		FWords.Assign (TWordList(Source).Words);
		ListChange;
	end else
		inherited Assign (Source);
end;

procedure TWordList.ChangeNotification(Sender: TObject);
begin
	ListChange;
end;

constructor TWordList.Create(Collection: TCollection);
begin
	inherited;
	Font := TFont.Create;
	FWords := TStringList.Create;
	FWords.Sorted := True;
	FWords.Duplicates := dupAccept;
	FWords.OnChange := ChangeNotification;
	FColor := clBlue;
	FCustomColor := True;
	FCaseSensitive := True;
end;

destructor TWordList.Destroy;
begin
	FWords.Free;
	Font.Free;
	inherited;
end;

function TWordList.GetDisplayName: string;
begin
	if FDisplayName = '' then
		Result := inherited GetDisplayName
	else
		Result := FDisplayName;
end;

procedure TWordList.ListChange;
begin
	if Assigned (Collection) then
		with TWordLists (Collection) do
			if Assigned (FColoring) then
				FColoring.ColoringChange;
end;

procedure TWordList.SetCaseSensitive(const Value: Boolean);
begin
	if FCaseSensitive <> Value then begin
		FCaseSensitive := Value;
		ListChange;
	end;
end;

procedure TWordList.SetColor(const Value: TColor);
begin
	if FColor <> Value then begin
		FColor := Value;
		ListChange;
	end;
end;

procedure TWordList.SetCustomColor(const Value: Boolean);
begin
	if FCustomColor <> Value then begin
		FCustomColor := Value;
		ListChange;
	end;
end;

procedure TWordList.SetCustomStyle(const Value: Boolean);
begin
	if FCustomStyle <> Value then begin
		FCustomStyle := Value;
		ListChange;
	end;
end;

procedure TWordList.SetDisplayName(const Value: string);
begin
	if FDisplayName <> Value then begin
		FDisplayName := Value;
		inherited;
	end;
end;

procedure TWordList.SetStyle(const Value: TFontStyles);
begin
	if FStyle <> Value then begin
		FStyle := Value;
		ListChange;
	end;
end;

procedure TWordList.SetWords(const Value: TStringList);
begin
	FWords.Assign (Value);
	ListChange;
end;

function TWordList.WordInList(S: string): Boolean;
var
	I: Integer;
begin
	if CaseSensitive then
		Result := Words.Find (S, I) and (I >= 0) and (I < Words.Count) and (S = Words.Strings [I])
	else
		Result := Words.Find (S, I) or ((I >= 0) and (I < Words.Count) and (UpperCase (S) = UpperCase (Words.Strings [I])));
end;

{ TCustomStyles }

function TCustomStyles.Add: TCustomStyle;
begin
	Result := TCustomStyle (inherited Add);
end;

constructor TCustomStyles.Create(AColoring: TSyntaxColoring);
begin
	inherited Create (TCustomStyle);
	FColoring := AColoring;
end;

//Mofified
function TCustomStyles.FindStyle(const S: string): TCustomStyle;
var
 I, R: Integer;
 Tmp: string;
begin  
 Result := nil;
 R := 1;
 if S <> '' then
  for I := 0 to Count - 1 do
  begin
   Tmp := Copy(S, 1, Length(Items[I].BeginText));
   Case Items[I].CaseSensitive of
    True :  R := AnsiCompareStr(PChar(Items[I].BeginText), Tmp);
    False:  R := AnsiCompareText(Items[I].BeginText, Tmp);
   end;
   if R = 0 then
   begin
    Result := Items[I];
    Break;
   end;
  end;
end;

function TCustomStyles.GetItem(Index: Integer): TCustomStyle;
begin
	Result := TCustomStyle (inherited GetItem (Index));
end;

function TCustomStyles.GetOwner: TPersistent;
begin
	Result := FColoring;
end;

procedure TCustomStyles.SetItem(Index: Integer; Value: TCustomStyle);
begin
	inherited SetItem (Index, Value);
end;

procedure TCustomStyles.Update(Item: TCollectionItem);
begin
	if Assigned (FColoring) then
		FColoring.ColoringChange;
end;

{ TCustomStyle }

procedure TCustomStyle.Assign(Source: TPersistent);
begin
	if Source is TCustomStyle then begin
		Caption := TCustomStyle(Source).Caption;
		FCustomColor := TCustomStyle(Source).CustomColor;
		FColor := TCustomStyle(Source).Color;
		FCustomStyle := TCustomStyle(Source).CustomStyle;
		FStyle := TCustomStyle(Source).Style;
		FBeginText := TCustomStyle(Source).BeginText;
		FEndText := TCustomStyle(Source).EndText;
		FIgnoreChar := TCustomStyle(Source).IgnoreChar;
		FSwitchable := TCustomStyle(Source).Switchable;
		FLineStartOnly := TCustomStyle(Source).LineStartOnly;
		StyleChange;
	end else
		inherited Assign (Source);
end;

constructor TCustomStyle.Create(Collection: TCollection);
begin
	inherited;
	Font := TFont.Create;
	FColor := clMaroon;
	FCustomColor := True;
end;

destructor TCustomStyle.Destroy;
begin
	Font.Free;
	inherited;
end;

function TCustomStyle.GetDisplayName: string;
begin
	if FDisplayName = '' then
		Result := inherited GetDisplayName
	else
		Result := FDisplayName;
end;

procedure TCustomStyle.SetBeginText(Value: string);
begin
	if Value = '#13' then
		Value := #13;
	if FBeginText <> Value then begin
		FBeginText := Value;
		StyleChange;
	end;
end;

procedure TCustomStyle.SetColor(const Value: TColor);
begin
	if FColor <> Value then begin
		FColor := Value;
		StyleChange;
	end;
end;

procedure TCustomStyle.SetCustomColor(const Value: Boolean);
begin
	if FCustomColor <> Value then begin
		FCustomColor := Value;
		StyleChange;
	end;
end;

procedure TCustomStyle.SetCustomStyle(const Value: Boolean);
begin
	if FCustomStyle <> Value then begin
		FCustomStyle := Value;
		StyleChange;
	end;
end;

procedure TCustomStyle.SetDisplayName(const Value: string);
begin
	FDisplayName := Value;
end;

procedure TCustomStyle.SetEndText(Value: string);
begin
	if Value = '#13' then
		Value := #13;
	if FEndText <> Value then begin
		FEndText := Value;
		StyleChange;
	end;
end;

procedure TCustomStyle.SetIgnoreChar(const Value: TIgnoreChar);
begin
	if FIgnoreChar <> Value then begin
		FIgnoreChar := Value;
		StyleChange;
	end;
end;

procedure TCustomStyle.SetLineStartOnly(const Value: Boolean);
begin
	if FLineStartOnly <> Value then begin
		FLineStartOnly := Value;
		StyleChange;
	end;
end;

procedure TCustomStyle.SetStyle(const Value: TFontStyles);
begin
	if FStyle <> Value then begin
		FStyle := Value;
		StyleChange;
	end;
end;

procedure TCustomStyle.SetSwitchable(const Value: Boolean);
begin
	if FSwitchable <> Value then begin
		FSwitchable := Value;
		StyleChange;
	end;
end;

procedure TCustomStyle.StyleChange;
begin
	if Assigned (Collection) then
		with TCustomStyles (Collection) do
			if Assigned (FColoring) then
				FColoring.ColoringChange;
end;

{ TSyntaxColoringCopy }

procedure TSyntaxColoringCopy.Assign(Source: TPersistent);
begin
	if Source is TSyntaxColoring then begin
		FEnabled := TSyntaxColoring(Source).Enabled;
		FSymbolColor := TSyntaxColoring(Source).SymbolColor;
		FSymbolStyle := TSyntaxColoring(Source).SymbolStyle;
		FSymbolCustomStyle := TSyntaxColoring(Source).SymbolCustomStyle;
		FNumberColor := TSyntaxColoring(Source).NumberColor;
		FNumberStyle := TSyntaxColoring(Source).NumberStyle;
		FNumberCustomStyle := TSyntaxColoring(Source).NumberCustomStyle;
		FWordLists.Assign (TSyntaxColoring(Source).WordLists);
		FCustomStyles.Assign (TSyntaxColoring(Source).CustomStyles);
		FParenthesisColors.Assign (TSyntaxColoring(Source).ParenthesisColors);
		FParenthesisStyle := TSyntaxColoring(Source).ParenthesisStyle;
		FParenthesisCustomStyle := TSyntaxColoring(Source).ParenthesisCustomStyle;
	end else
		inherited Assign (Source);
end;

constructor TSyntaxColoringCopy.Create(AOwner: TComponent);
begin
	inherited;
	FWordLists := TWordLists.Create (nil);
	FCustomStyles := TCustomStyles.Create (nil);
	FParenthesisColors := TStringList.Create;
	FParenthesisColors.Duplicates := dupAccept;
	FParenthesisColors.Add ('$000000');
	FNumberColor := clGreen;
	FSymbolColor := clOlive;
	FEnabled := True;
end;

destructor TSyntaxColoringCopy.Destroy;
begin
	FParenthesisColors.Free;
	FCustomStyles.Free;
	FWordLists.Free;
	inherited;
end;

procedure TSyntaxColoringCopy.SetCustomStyles(const Value: TCustomStyles);
begin
	FCustomStyles.Assign (Value);
end;

procedure TSyntaxColoringCopy.SetParenthesisColors(
	const Value: TStringList);
begin
	FParenthesisColors.Assign (Value);
end;

procedure TSyntaxColoringCopy.SetWordLists(const Value: TWordLists);
begin
	FWordLists.Assign (Value);
end;

{ TSyntaxRange }

destructor TSyntaxRange.Destroy;
begin
	if Assigned (Collection) and (not (Collection as TMCRanges).FDestroying) then begin
		if Assigned (Editor) and ((Editor as TSourceEdit).SyntaxStartRange = Self) then
			(Editor as TSourceEdit).SyntaxStartRange := nil;
		if Assigned (PrevRange) then
			PrevRange.NextRange := NextRange
		else if Assigned (Editor) then
			(Editor as TSourceEdit).FirstSyntaxRange := NextRange;
		if Assigned (NextRange) then
			NextRange.PrevRange := PrevRange
		else if Assigned (Editor) then
			(Editor as TSourceEdit).LastSyntaxRange := PrevRange;
	end;
	inherited;
end;

class function TSyntaxRange.EqualEndings(Range1,
	Range2: TSyntaxRange): Boolean;
begin
	Result := Assigned (Range1) and Assigned (Range2) and Range1.EqualEndingsWith (Range2);
end;

function TSyntaxRange.EqualEndingsWith(Range: TSyntaxRange): Boolean;
begin
	Result := REnd = Range.REnd;
end;

function TSyntaxRange.GetColor: TColor;
begin
	if Assigned (Editor) then
		Result := Editor.Color
	else
		Result := clWindow;
end;

function TSyntaxRange.GetNextParenthesisLevel: Integer;
begin
	Result := ParenthesisLevel;
end;

function TSyntaxRange.InsertAfter(RangeClass: TSyntaxRangeClass):
	TSyntaxRange;
begin
	Result := InsertRangeBefore (NextRange, RangeClass, Editor as TSourceEdit);
end;

function TSyntaxRange.InsertBefore(RangeClass: TSyntaxRangeClass):
	TSyntaxRange;
begin
	Result := InsertRangeBefore (Self, RangeClass, Editor as TSourceEdit);
end;

class function TSyntaxRange.InsertRangeBefore(Range: TSyntaxRange;
	RangeClass: TSyntaxRangeClass; Editor: TSourceEdit): TSyntaxRange;
	// If Range is nil, new item is inserted at the end.
begin
	if Assigned (Editor) then begin
		Result := RangeClass.Create (Editor.TrackedRanges);
		Result.OnOverwrite := Editor.OverwriteRange;
		if Assigned (Range) then
			Result.PrevRange := Range.PrevRange
		else
			Result.PrevRange := Editor.LastSyntaxRange;
		Result.NextRange := Range;
		if Assigned (Range) then begin