sourceeditunit.pas

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

begin
 if ReplaceAll then
 begin
  While FindText(FindTxt) do
  begin
   Selection.Text := ReplaceTxt;
   FSearch.EndPos := FSearch.EndPos + Length(ReplaceTxt) - Length(FindTxt);
   FSearch.CurPos := FSearch.CurPos + Length(ReplaceTxt) - Length(FindTxt);
  end;
 end
 else
 begin
  if SelLength = 0 then
  begin
   if FindText(FindTxt) then
   begin
    Selection.Text := ReplaceTxt;
    FSearch.EndPos := FSearch.EndPos + Length(ReplaceTxt) - Length(FindTxt);
    FSearch.CurPos := FSearch.CurPos + Length(ReplaceTxt) - Length(FindTxt);
   end;
  end
  else        //If use F3 to findnext, then replace current text
  begin
    Selection.Text := ReplaceTxt;
    FSearch.EndPos := FSearch.EndPos + Length(ReplaceTxt) - Length(FindTxt);
    FSearch.CurPos := FSearch.CurPos + Length(ReplaceTxt) - Length(FindTxt);
  end;
 end;
end;

procedure TSourceEdit.GotoLine(LineNo: Integer);
var
 Len, CurLine: Integer;
 P0, P1: PChar;
begin
 if LineNo < 1 then LineNo := 1;
 if LineNo > Lines.Count then LineNo := Lines.Count;
 P0 := PChar(Text);
 P1 := P0;
 Len := Length(Text);
 CurLine := 1;
 While (P1 - P0 + 1<= Len) do
 begin
  if CurLine = LineNo then Break;
  While P1^ <> #13 do Inc(P1);
  Inc(P1);
  Inc(CurLine);
 end;
 SelStart := P1 - P0;
 SelLength := 0;
 ScrollCaret;
 P0 := NIL;
 P1 := NIL;
end;

function TSourceEdit.GetCurrentCol: Integer;
begin
 Result := Selection.StartRowCol.Col;
end;

function TSourceEdit.GetCurrentRow: Integer;
begin
 Result := Selection.StartRowCol.Row;
end;

procedure TSourceEdit.FreeAllSyntaxRanges;
begin
	while Assigned (LastSyntaxRange) do
		LastSyntaxRange.Free;
end;

procedure TSourceEdit.KeyPress(var Key: Char);
var
	InsS: string;
	Rs,
	BeginLn,
	FirstChr: Integer;
begin
	if (Key = #13) and AutoIndent then begin
		with Selection do
			if AutoIndentIncrease and (RStart - 1 > 0) and (RStart - 1 <= TextLength) and (Self.Text [RStart - 1] = AutoIndentIncreaseStart) and (RStart - 2 > 0) and (not (Self.Text [RStart - 2] in [#9, #10, #13])) then begin
				BeginLn := CellToCharIdx (TextCell (StartRowCol.Row, 1));
				FirstChr := FirstNonWhiteSpace (Copy (Self.Text, BeginLn, RStart - BeginLn));
				InsS := #13#10 + Copy (Self.Text, BeginLn, FirstChr - 1) + #9;
				RS := RStart;
				Text := InsS + #13#10 + Copy (Self.Text, BeginLn, FirstChr - 1) + AutoIndentIncreaseEnd;
				NoSelAtPos (RS + Length (InsS));
				ScrollInView (4);
			end else begin
				BeginLn := CellToCharIdx (TextCell (StartRowCol.Row, 1));
				FirstChr := FirstNonWhiteSpace (Copy (Self.Text, BeginLn, RStart - BeginLn));
				Text := #13#10 + Copy (Self.Text, BeginLn, FirstChr - 1);
				ScrollInView (4);
			end;
		Key := #0;
	end;
	if (Key = AutoIndentIncreaseStart) and AutoIndentIncrease then begin
		BeginLn := CellToCharIdx (TextCell (Selection.StartRowCol.Row, 1));
		FirstChr := FirstNonWhiteSpace (Copy (Text, BeginLn, Selection.RStart - BeginLn));
		if (BeginLn + FirstChr - 1 > TextLength) or (Text [BeginLn + FirstChr - 1] = #13) then begin
			InsS := Key + #13#10 + Copy (Self.Text, BeginLn, FirstChr - 1) + #9;
			with Selection do begin
				RS := RStart;
				Text := InsS + #13#10 + Copy (Self.Text, BeginLn, FirstChr - 1) + AutoIndentIncreaseEnd;
				NoSelAtPos (RS + Length (InsS));
				ScrollInView (4);
			end;
			Key := #0;
		end;
	end;
	inherited;
end;

function TSourceEdit.MakeDebuggableRanges: TDebuggableRanges;
var
	Range: TSyntaxRange;
begin
	Range := FirstSyntaxRange;
	while Assigned (Range) do begin
		SetLength (Result, Length (Result) + 1);
		with Result [High (Result)] do begin
			RStart := Range.RStart;
			REnd := Range.REnd;
			Text := Range.Text;
			ClassName := Range.ClassName;
		end;
		Range := Range.NextRange;
	end;
end;

procedure TSourceEdit.OverwriteRange(Sender: TObject);
begin
	Sender.Free;
end;

procedure TSourceEdit.ReColor;
begin
	if TextLength > 0 then begin
		Selection.HideCaret;
		FreeAllSyntaxRanges;
		ReColorRange (WholeText);
		while Assigned (LastPRange) do begin
			LastPRange.SetNewParenthesisLevel;
			LastPRange := LastPRange.NextRange;
		end;
		VisibleRange.DrawRange;
		Selection.UpdateCaretPos;
		Selection.ShowCaret;
	end;
end;

procedure TSourceEdit.ReColorRange(Range: TCustomRange);
var
	LastRange: TSyntaxRange;
	KeepRunning,
	EndingsEqual: Boolean;
	SectionStart,
	SectionLength,
	WordStart,
	CurPos: Integer;
	CustomStyle,
	NewCustomStyle: TCustomStyle;
	CurChar: Char;
	SectionType: TSectionType;
procedure ProcessSection;
var
	I,
	J,
	LastStart: Integer;
	CurWord: string;
	IsNum: Boolean;
	WordStyle: TWordList;
begin
	if SectionLength > 0 then begin
		case SectionType of
			stSymbol:
				with TSymbolRange (TSymbolRange.NewRangeInsertedBefore (LastRange, Self)) do begin
					RStart := SectionStart;
					RLength := SectionLength;
					Symbol := Text;
					EndingsEqual := ReplaceSyntaxRanges (LastRange);
				end;
			stParenthesis:
				with TParenthesisRange (TParenthesisRange.NewRangeInsertedBefore (LastRange, Self)) do begin
					RStart := SectionStart;
					RLength := SectionLength;
					if Self.Text [SectionStart] in [')', '}', ']'] then
						Style := psClosing
					else
						Style := psOpening;
					EndingsEqual := ReplaceSyntaxRanges (LastRange);
				end;
			stCustomStyle:
				with TCustomStyleRange (TCustomStyleRange.NewRangeInsertedBefore (LastRange, Self)) do begin
					RStart := SectionStart;
					RLength := SectionLength;
					Style := CustomStyle;
					EndingsEqual := ReplaceSyntaxRanges (LastRange);
				end;
			stText: begin
				if SplitOnFly then
					with TCustomTextRange (TCustomTextRange.NewRangeInsertedBefore (LastRange, Self)) do begin
						RStart := SectionStart;
						RLength := SectionLength;
						EndingsEqual := ReplaceSyntaxRanges (LastRange);
					end
				else begin
					CurWord := '';
					LastStart := SectionStart;
					for I := SectionStart to SectionStart + SectionLength do begin
						if (I < SectionStart + SectionLength) and CharIsWordable (Text [I]) then
							Insert (Text [I], CurWord, Length (CurWord) + 1)
						else begin
							if Length (CurWord) > 0 then begin
								IsNum := CharIsExtNumber (CurWord [1]);
								if (not IsNum) and (CurWord [1] = '$') and (Length (CurWord) > 1) then begin
									IsNum := True;
									for J := 2 to Length (CurWord) do
										if not CharIsHexNumber (CurWord [J]) then begin
											IsNum := False;
											Break;
										end;
								end;
								if IsNum then begin
									if I - Length (CurWord) > LastStart then
										with TNormalTextRange (TNormalTextRange.NewRangeInsertedBefore (LastRange, Self)) do begin
											RStart := LastStart;
											REnd := I - Length (CurWord) - 1;
											if RLength > 0 then
												EndingsEqual := ReplaceSyntaxRanges (LastRange)
											else
												Free;
										end;
									with TNumberRange (TNumberRange.NewRangeInsertedBefore (LastRange, Self)) do begin
										RStart := I - Length (CurWord);
										REnd := I - 1;
										Number := Text;
										EndingsEqual := ReplaceSyntaxRanges (LastRange);
										LastStart := I;
									end;
								end else begin
									WordStyle := SyntaxColoring.WordLists.FindList (CurWord);
									if Assigned (WordStyle) then begin
										if I - Length (CurWord) > LastStart then
											with TNormalTextRange (TNormalTextRange.NewRangeInsertedBefore (LastRange, Self)) do begin
												RStart := LastStart;
												REnd := I - Length (CurWord) - 1;
												if RLength > 0 then
													EndingsEqual := ReplaceSyntaxRanges (LastRange)
												else
													Free;
											end;
										with TWordListRange (TWordListRange.NewRangeInsertedBefore (LastRange, Self)) do begin
											RStart := I - Length (CurWord);
											REnd := I - 1;
											WordList := WordStyle;
											EndingsEqual := ReplaceSyntaxRanges (LastRange);
											LastStart := I;
										end;
									end;
								end;
								CurWord := '';
							end;
							if (I >= SectionStart + SectionLength) and (I > LastStart) then
								with TNormalTextRange (TNormalTextRange.NewRangeInsertedBefore (LastRange, Self)) do begin
									RStart := LastStart;
									REnd := I - 1;
									LastStart := I;
									if RLength > 0 then
										EndingsEqual := ReplaceSyntaxRanges (LastRange)
									else
										Free;
								end;
						end;
					end;
				end;
			end;
		end;
	end;
end;
procedure SetSectionType(NewType: TSectionType);
begin
	if SplitOnFly and (NewType = stSymbol) and (SectionLength <= MaxOnFlySectionLength) then
		NewType := stText;
	if (NewType <> SectionType) or (NewType = stParenthesis) or (NewType = stCustomStyle) then begin
		if SplitOnFly and (NewType = stSymbol) then
			NewType := stText;
		ProcessSection;
		SectionStart := CurPos;
		SectionLength := 0;
		WordStart := CurPos;
		SectionType := NewType;
	end;
end;
var
	I,
	L: Integer;
	B: Boolean;
begin
	if SyntaxColoring.FUpdateDebth = 0 then begin
		if SyntaxColoring.Enabled and (TextLength > 0) then begin
			Inc (SyntaxColoring.FUpdateDebth);
			LastRange := SyntaxRangeAtPos (Range.RStart - 1);
			if Assigned (LastRange) then begin
				if Assigned (LastRange.PrevRange) and (LastRange.PrevRange is TCustomStyleRange) and Assigned ((LastRange.PrevRange as TCustomStyleRange).Style) and (LastRange.PrevRange as TCustomStyleRange).Style.Switchable then
					LastRange := LastRange.PrevRange;
				if Range.RStart > LastRange.RStart then
					Range.RStart := LastRange.RStart;
			end else
				Range.RStart := 1;
			CurPos := Range.RStart;
			SectionStart := CurPos;
			SectionLength := 0;
			WordStart := CurPos;
			SectionType := stText;
			CustomStyle := nil;
			EndingsEqual := False;
			KeepRunning := False;
			while (CurPos <= TextLength) and ((CurPos <= Range.REnd + 2) or (not EndingsEqual) or KeepRunning) do begin
				EndingsEqual := False;
				CurChar := Text [CurPos];
				NewCustomStyle := SyntaxColoring.CustomStyles.FindStyle (Copy (Text, CurPos, MaxBeginEndTextLength));
				if Assigned (NewCustomStyle) and NewCustomStyle.LineStartOnly and (CurPos - 1 > 0) and (not (Text [CurPos - 1] in [#10, #13])) then
					NewCustomStyle := nil;
				if Assigned (NewCustomStyle) and ((SectionType = stCustomStyle) and Assigned (CustomStyle) and (((NewCustomStyle = CustomStyle) and CustomStyle.Switchable) or (NewCustomStyle.EndText <> CustomStyle.EndText))) then
					NewCustomStyle := nil;
				KeepRunning := (SectionType = stCustomStyle) and Assigned (CustomStyle) and CustomStyle.Switchable and (not Assigned (NewCustomStyle));
				if KeepRunning and (Copy (Text, CurPos, Length (CustomStyle.EndText)) = CustomStyle.EndText) then begin
					KeepRunning := False;
					I := CurPos - 1;
					while (I >= 1) and ((Text [I] = CustomStyle.IgnoreChar) or ((CustomStyle.IgnoreChar = '\') and (Copy (Text, I - 2, 3) = '??/'))) do begin
						KeepRunning := not KeepRunning;
						if Text [I] = CustomStyle.IgnoreChar then
							Dec (I)
						else
							Dec (I, 3);
					end;
				end;
				if not KeepRunning then begin
					if Assigned (NewCustomStyle) then begin
						SetSectionType (stCustomStyle);
						CustomStyle := NewCustomStyle;
						if CustomStyle.Switchable then begin
							KeepRunning := True;
							Inc (SectionLength);
							Inc (CurPos);
						end else begin
							repeat
								L := Pos (CustomStyle.EndText, Copy (Text, CurPos + Length (CustomStyle.BeginText), TextLength));
								Inc (CurPos, L + Length (CustomStyle.BeginText) + Length (CustomStyle.EndText) - 2);
								B := (L < 1) or (CurPos <= Length (CustomStyle.EndText)) or (CurPos <= Length (CustomStyle.EndText));
								if not B then begin
									B := True;
									I := CurPos - Length (CustomStyle.EndText);
									while (I >= 1) and ((Text [I] = CustomStyle.IgnoreChar) or ((CustomStyle.IgnoreChar = '\') and (Copy (Text, I - 2, 3) = '??/'))) do begin
										B := not B;
										if Text [I] = CustomStyle.IgnoreChar then
											Dec (I)
										else
											Dec (I, 3);
									end;
								end;
							until B;
							if CustomStyle.EndText = #13 then
								Inc (CurPos);
							if (L < 1) or (CurPos <= Length (CustomStyle.EndText)) or (CurPos > TextLength) then
								CurPos := TextLength;
							Inc (CurPos);
							SectionLength := CurPos - SectionStart;
							SetSectionType (stText);
						end;
						Continue;
					end else if (SectionType = stCustomStyle) and Assigned (CustomStyle) and CustomStyle.Switchable then begin
						if CustomStyle.EndText = #13 then
							L := 2
						else
							L := Length (CustomStyle.EndText);
						Inc (SectionLength, L);
						Inc (CurPos, L);
						SetSectionType (stText);
						Continue;
					end;
					if CharIsParenthesis (CurChar) then
						SetSectionType (stParenthesis)
					else if CurChar = '.' then begin
						if ((SectionType = stText) and CharIsNumber (Text [WordStart])) or ((CurPos + 1 <= TextLength) and CharIsNumber (Text [CurPos + 1])) then
							SetSectionType (stText)
						else
							SetSectionType (stSymbol);
					end else if CurChar in ['+', '-'] then begin
						if not ((CurPos - 2 >= 1) and CharIsExtNumber (Text [CurPos - 2]) and (CurPos - 1 >= 1) and (Text [CurPos - 1] in ['e', 'E', 'p', 'P'])) then
							SetSectionType (stSymbol);
					end else if CharIsSymbol (CurChar) then
						SetSectionType (stSymbol)
					else begin
						SetSectionType (stText);
						if not CharIsIdentifier (CurChar) then
							WordStart := CurPos;
					end;
				end;
				Inc (SectionLength);
				Inc (CurPos);
			end;
			Range.REnd := CurPos - 1;
			if CurPos > TextLength then
				ProcessSection;
			LastPRange := SyntaxRangeAtPosWithHint (Range.RStart, LastRange);
			Dec (SyntaxColoring.FUpdateDebth);
		end else
			FreeAllSyntaxRanges;
	end;
	{$IFDEF SyntaxDebug}
		if FindSyntaxHole <> nil then
			raise ESourceEdit.Create (SSourceEditError);
	{$ENDIF}
end;

function TSourceEdit.ReplaceSyntaxRanges(NewRange: TSyntaxRange;
	var StartRange: TSyntaxRange): Boolean;
var
	PrevRange: TSyntaxRange;
begin
	Result := False;
	if not Assigned (StartRange) then
		StartRange := LastSyntaxRange;
	while Assigned (StartRange) and ((StartRange.RStart > NewRange.RStart) or (StartRange = NewRange)) do
		StartRange := StartRange.PrevRange;
	if not Assigned (StartRange) then
		StartRange := FirstSyntaxRange;
	while Assigned (StartRange) and ((StartRange.RStart < NewRange.RStart) or (StartRange = NewRange)) do