sourceeditunit.pas

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

		StartRange := StartRange.NextRange;
	if (not Assigned (StartRange)) and (LastSyntaxRange <> NewRange) then
		StartRange := LastSyntaxRange;
	while Assigned (StartRange) and (StartRange <> NewRange) and ((StartRange.RStart <= NewRange.REnd) or (StartRange.REnd <= NewRange.REnd)) do begin
		Result := StartRange.EqualEndingsWith (NewRange);
		PrevRange := StartRange;
		StartRange := StartRange.NextRange;
		PrevRange.Free;
	end;
	{$IFDEF SyntaxDebug}
		if FindSyntaxOverlap <> nil then
			raise ESourceEdit.Create (SSourceEditError);
	{$ENDIF}
end;

procedure TSourceEdit.SetSearchOption(const Value: TSearchOption);
begin
 FSearchOption := Value;
 if Value = [] then
  With FSearch do
  begin
   BegPos := 0;
   EndPos := 0;
   CurPos := 0;
  end;
 if soSearchSelText in FSearchOption then
 begin
  FSearch.BegPos := SelStart;
  FSearch.EndPos := FSearch.BegPos + SelLength-1;
 end;
 if soSearchAllText in FSearchOption then
 begin
  FSearch.BegPos := 0;
  FSearch.EndPos := TextLength-1;
 end;
 if soFromCursor in FSearchOption then
 begin
  if soUp in FSearchOption then
   FSearch.EndPos := SelStart
  else
   FSearch.BegPos := SelStart;
 end;
end;

procedure TSourceEdit.SetSplitOnFly(const Value: Boolean);
begin
	if FSplitOnFly <> Value then begin
		FSplitOnFly := Value;
		ReColor;
	end;
end;

procedure TSourceEdit.SetSyntaxColoring(const Value: TSyntaxColoring);
begin
	FSyntaxColoring.Assign (Value);
end;

function TSourceEdit.SyntaxRangeAtPos(RangePos: Integer): TSyntaxRange;
begin
	Result := FirstSyntaxRange;
	while Assigned (Result) and (Result.REnd < RangePos) do
		Result := Result.NextRange;
end;

function TSourceEdit.SyntaxRangeAtPosWithHint(RangePos: Integer;
	Hint: TSyntaxRange): TSyntaxRange;
begin
	if Assigned (Hint) then begin
		Result := Hint;
		while Assigned (Result) and (Result.REnd >= RangePos) do
			Result := Result.PrevRange;
		if not Assigned (Result) then
			Result := FirstSyntaxRange;
	end else
		Result := FirstSyntaxRange;
	while Assigned (Result) and (Result.REnd < RangePos) do
		Result := Result.NextRange;
end;

procedure TSourceEdit.TextChangeNotification(StartPos, OldLength,
	NewLength: Integer);
begin
	inherited;
	LastPRange := nil;
	LastCRange := TMCRange.Create (nil);
	with LastCRange do begin
		Editor := Self;
		RStart := StartPos;
		RLength := NewLength;
		ReColorRange (LastCRange);
	end;
end;

procedure TSourceEdit.TextChangeNotificationAfter;
begin
	inherited;
	if Assigned (LastCRange) then begin
		while Assigned (LastPRange) do begin
			if LastPRange.REnd <= LastCRange.REnd then
				LastPRange.SetNewParenthesisLevel
			else
				LastPRange.UpdateParenthesisLevel;
			LastPRange := LastPRange.NextRange;
		end;
		LastCRange.DrawRange;
		LastCRange.Free;
		LastCRange := nil;
	end;
end;

procedure TSourceEdit.WMKeyDown(var Message: TWMKeyDown);
var
	Shift: TShiftState;
begin
	if Message.CharCode = vk_Tab then begin
		Shift := KeyDataToShiftState (Message.KeyData);
		if ssShift in Shift then
			ChangeIndent (-1)
		else if (Selection.RLength > 0) and (Selection.EndRowCol.Row > Selection.StartRowCol.Row) then
			ChangeIndent (1)
		else
			inherited;
	end else
		inherited;
end;

procedure TSourceEdit.ExportToRtf(FileName: string; NeedColor: Boolean=True);
var
 W : TTxt2Rtf;
begin
 try
  W := TTxt2Rtf.Create;
  W.KeyWords.Assign(SyntaxColoring.WordLists.Items[0].Words);
  W.NeedColor := NeedColor;
  W.SaveTextToRtfFile(Text, FileName);
 finally
  W.Free;
 end;
end;

{ TSyntaxColoring }

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

procedure TSyntaxColoring.BeginUpdate;
begin
	Inc (FUpdateDebth);
end;

procedure TSyntaxColoring.ChangeNotification(Sender: TObject);
begin
	ColoringChange;
end;

procedure TSyntaxColoring.ColoringChange;
var
	I: Integer;
begin
	if FUpdateDebth = 0 then
		if Assigned (Owner) then
			if Owner is TSourceEdit then
				with Owner as TSourceEdit do begin
					with SymbolFont do begin
						Assign (Font);
						Color := SymbolColor;
						if SymbolCustomStyle then
							Style := SymbolStyle;
					end;
					with NumberFont do begin
						Assign (Font);
						Color := NumberColor;
						if NumberCustomStyle then
							Style := NumberStyle;
					end;
					with ParenthesisFont do begin
						Assign (Font);
						Color := GetParenthesisColor (0);
						if ParenthesisCustomStyle then
							Style := ParenthesisStyle;
					end;
					with WordLists do
						for I := 0 to Count - 1 do
							with Items[I].Font do begin
								Assign (Font);
								if Items[I].CustomColor then
									Color := Items[I].Color;
								if Items[I].CustomStyle then
									Style := Items[I].Style;
							end;
					with CustomStyles do
						for I := 0 to Count - 1 do
							with Items[I].Font do begin
								Assign (Font);
								if Items[I].CustomColor then
									Color := Items[I].Color;
								if Items[I].CustomStyle then
									Style := Items[I].Style;
							end;
					ReColor;
				end;
end;

constructor TSyntaxColoring.Create(AOwner: TPersistent);
begin
	inherited;
	SymbolFont := TFont.Create;
	NumberFont := TFont.Create;
	ParenthesisFont := TFont.Create;
	FWordLists := TWordLists.Create (Self);
	FCustomStyles := TCustomStyles.Create (Self);
	FParenthesisColors := TStringList.Create;
	FParenthesisColors.Duplicates := dupAccept;
	FParenthesisColors.Add ('$000000');
	FParenthesisColors.OnChange := ChangeNotification;
	FNumberColor := clGreen;
	FSymbolColor := clOlive;
	FEnabled := True;
end;

destructor TSyntaxColoring.Destroy;
begin
	FParenthesisColors.Free;
	FCustomStyles.Free;
	FWordLists.Free;
	NumberFont.Free;
	SymbolFont.Free;
	ParenthesisFont.Free;
	inherited;
end;

procedure TSyntaxColoring.EndUpdate;
begin
	Dec (FUpdateDebth);
	if FUpdateDebth = 0 then
		ColoringChange;
end;

function TSyntaxColoring.GetParenthesisColor(Index: Integer): TColor;
begin
	with ParenthesisColors do
		if (Count <= 0) or (Index < 0) then
			Result := clWindowText
		else
			try
				Result := StrToInt (Strings [Index mod Count]);
			except
				Result := clWindowText;
			end;
end;

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

procedure TSyntaxColoring.SetEnabled(const Value: Boolean);
begin
	if FEnabled <> Value then begin
		FEnabled := Value;
		ColoringChange;
	end;
end;

procedure TSyntaxColoring.SetNumberColor(const Value: TColor);
begin
	if FNumberColor <> Value then begin
		FNumberColor := Value;
		ColoringChange;
	end;
end;

procedure TSyntaxColoring.SetNumberCustomStyle(const Value: Boolean);
begin
	if FNumberCustomStyle <> Value then begin
		FNumberCustomStyle := Value;
		ColoringChange;
	end;
end;

procedure TSyntaxColoring.SetNumberStyle(const Value: TFontStyles);
begin
	if FNumberStyle <> Value then begin
		FNumberStyle := Value;
		ColoringChange;
	end;
end;

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

procedure TSyntaxColoring.SetParenthesisCustomStyle(const Value: Boolean);
begin
	if FParenthesisCustomStyle <> Value then begin
		FParenthesisCustomStyle := Value;
		ColoringChange;
	end;
end;

procedure TSyntaxColoring.SetParenthesisStyle(const Value: TFontStyles);
begin
	if FParenthesisStyle <> Value then begin
		FParenthesisStyle := Value;
		ColoringChange;
	end;
end;

procedure TSyntaxColoring.SetSymbolColor(const Value: TColor);
begin
	if FSymbolColor <> Value then begin
		FSymbolColor := Value;
		ColoringChange;
	end;
end;

procedure TSyntaxColoring.SetSymbolCustomStyle(const Value: Boolean);
begin
	if FSymbolCustomStyle <> Value then begin
		FSymbolCustomStyle := Value;
		ColoringChange;
	end;
end;

procedure TSyntaxColoring.SetSymbolStyle(const Value: TFontStyles);
begin
	if FSymbolStyle <> Value then begin
		FSymbolStyle := Value;
		ColoringChange;
	end;
end;

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

{ TWordLists }

function TWordLists.Add: TWordList;
begin
	Result := TWordList (inherited Add);
end;

constructor TWordLists.Create(AColoring: TSyntaxColoring);
begin
	inherited Create (TWordList);
	FColoring := AColoring;
end;

function TWordLists.FindList(const S: string): TWordList;
var
	I: Integer;
begin
	Result := nil;
	for I := 0 to Count - 1 do
		if Items[I].WordInList (S) then begin
			Result := Items [I];
			Break;
		end;
end;

function TWordLists.GetItem(Index: Integer): TWordList;
begin
	Result := TWordList (inherited GetItem (Index));
end;

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

procedure TWordLists.SetItem(Index: Integer; Value: TWordList);
begin
	inherited SetItem (Index, Value);
end;

procedure TWordLists.Update(Item: TCollectionItem);
begin
	if Assigned (Item) then
		TWordList(Item).ListChange
	else
		if Assigned (FColoring) then
			FColoring.ColoringChange;
end;

{ TWordList }

procedure TWordList.Assign(Source: TPersistent);
begin
	if Source is TWordList then begin
		Caption := TWordList(Source).Caption;
		FCustomColor := TWordList(Source).CustomColor;
		FColor := TWordList(Source).Color;