sourceeditunit.pas

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

	TSectionType = (stText, stSymbol, stParenthesis, stCustomStyle);

function CharIsWordable(Ch: Char): Boolean;
function CharIsIdentifier(Ch: Char): Boolean;
function CharIsExtNumber(Ch: Char): Boolean;
function CharIsNumber(Ch: Char): Boolean;
function CharIsSymbol(Ch: Char): Boolean;
function CharIsParenthesis(Ch: Char): Boolean;

procedure Register;

implementation

uses	UtilsDos;

function CharIsWordable(Ch: Char): Boolean;
begin
	Result := CharIsIdentifier (Ch) or (Ch in ['#', '.', '+', '-']);
end;

function CharIsIdentifier(Ch: Char): Boolean;
begin
	Result := Ch in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$'];
end;

function CharIsExtNumber(Ch: Char): Boolean;
begin
	Result := CharIsNumber (Ch) or (Ch in ['#', '.']);
end;

function CharIsNumber(Ch: Char): Boolean;
begin
	Result := Ch in ['0'..'9'];
end;

function CharIsHexNumber(Ch: Char): Boolean;
begin
	Result := Ch in ['A'..'F', 'a'..'f', '0'..'9'];
end;

function CharIsSymbol(Ch: Char): Boolean;
begin
	Result := Ch in SymbolChars;
end;

function CharIsParenthesis(Ch: Char): Boolean;
begin
	Result := Ch in ['(', ')'];
end;

procedure Register;
begin
	RegisterComponents ('Edit Controls', [TSourceEdit]);
end;

{ TSourceEdit }

procedure TSourceEdit.CMFontChanged(var Message: TMessage);
begin
	inherited;
	if Assigned (SyntaxColoring) then
		SyntaxColoring.ColoringChange;
end;

constructor TSourceEdit.Create(AOwner: TComponent);
begin
	inherited;
	FSyntaxColoring := TSyntaxColoring.Create (Self);
	FAutoIndent := True;
	FAutoIndentIncrease := False;
	FAutoIndentIncreaseStart := '{';
	FAutoIndentIncreaseEnd := '}';
	FSplitOnFly := False;
end;

function TSourceEdit.CreateSplitRanges(Range: TCustomRange): TFormattedRangeArray;
var
	RS,
	RE,
	TotalEnd: Integer;
	ExitHere: Boolean;
procedure AddRange(R: TCustomFormattedRange; AlwaysCopy: Boolean);
procedure UpdateRS;
begin
	RS := RE + 1;
	if RS < Range.RStart then
		RS := Range.RStart;
	if RS < R.RStart then
		RS := R.RStart;
end;
procedure SetRE(NewValue: Integer);
begin
	if NewValue < RE then
		NewValue := RE;
	RE := NewValue;
	if RE > Range.REnd then
		RE := Range.REnd;
	if RE > R.REnd then
		RE := R.REnd;
end;
begin
	UpdateRS;
	if (not Selection.Hidden) and (Selection.RLength > 0) then begin
		SetRE (Selection.RStart - 1);
		if RE >= RS then begin
			SetLength (Result, Length (Result) + 1);
			if AlwaysCopy or (RS <> R.RStart) or (RE <> R.REnd) then begin
				Result [High (Result)] := TFormattedRange.Create (nil);
				with Result [High (Result)] do begin
					FreeWhenDone := True;
					Editor := Self;
					RStart := RS;
					REnd := RE;
					Font := R.Font;
					Color := Self.Color;
				end;
			end else
				Result [High (Result)] := R;
		end;
		UpdateRS;
		SetRE (Selection.REnd);
		if RE >= RS then begin
			SetLength (Result, Length (Result) + 1);
			Result [High (Result)] := TFormattedRange.Create (nil);
			with Result [High (Result)] do begin
				FreeWhenDone := True;
				Editor := Self;
				RStart := RS;
				REnd := RE;
				Font := R.Font;
				Font.Color := clHighlightText;
				Color := clHighlight;
			end;
		end;
		UpdateRS;
	end;
	SetRE (R.REnd);
	if RE >= RS then begin
		SetLength (Result, Length (Result) + 1);
		if AlwaysCopy or (RS <> R.RStart) or (RE <> R.REnd) then begin
			Result [High (Result)] := TFormattedRange.Create (nil);
			with Result [High (Result)] do begin
				FreeWhenDone := True;
				Editor := Self;
				RStart := RS;
				REnd := RE;
				Font := R.Font;
				Color := Self.Color;
			end;
		end else
			Result [High (Result)] := R;
	end;
	if R.REnd >= TotalEnd then
		ExitHere := True;
end;
var
	I,
	J,
	LastStart: Integer;
	CurWord: string;
	IsNum: Boolean;
	WordStyle: TWordList;
	R: TCustomFormattedRange;
begin
	if SyntaxColoring.Enabled then begin
		ExitHere := False;
		TotalEnd := Range.REnd;
		SyntaxStartRange := SyntaxRangeAtPosWithHint (Range.RStart, SyntaxStartRange);
		RE := Range.RStart - 1;
		while Assigned (SyntaxStartRange) and (SyntaxStartRange.RStart <= Range.REnd) do begin
			if SyntaxStartRange is TCustomTextRange then begin
				CurWord := '';
				LastStart := SyntaxStartRange.RStart;
				for I := SyntaxStartRange.RStart to SyntaxStartRange.REnd + 1 do begin
					if (I <= SyntaxStartRange.REnd) and CharIsWordable (Text [I]) and ((not CharIsSymbol (Text [I]) or ((Text [I] = '.') and ((Length (Text) > 0) and CharIsExtNumber (Text [1]))))) 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 begin
									R := TNormalTextRange.Create (nil);
									with R do try
										Editor := Self;
										RStart := LastStart;
										REnd := I - Length (CurWord) - 1;
										if RLength > 0 then
											AddRange (R, True);
									finally
										Free;
									end;
								end;
								R := TNumberRange.Create (nil);
								with R as TNumberRange do try
									Editor := Self;
									RStart := I - Length (CurWord);
									REnd := I - 1;
									Number := Text;
									if RLength > 0 then
										AddRange (R, True);
									LastStart := I;
								finally
									Free;
								end;
							end else begin
								WordStyle := SyntaxColoring.WordLists.FindList (CurWord);
								if Assigned (WordStyle) then begin
									if I - Length (CurWord) > LastStart then begin
										R := TNormalTextRange.Create (nil);
										with R do try
											Editor := Self;
											RStart := LastStart;
											REnd := I - Length (CurWord) - 1;
											if RLength > 0 then
												AddRange (R, True);
										finally
											Free;
										end;
									end;
									R := TWordListRange.Create (nil);
									with R as TWordListRange do try
										Editor := Self;
										RStart := I - Length (CurWord);
										REnd := I - 1;
										WordList := WordStyle;
										if RLength > 0 then
											AddRange (R, True);
										LastStart := I;
									finally
										Free;
									end;
								end;
							end;
							CurWord := '';
						end;
						if (I <= SyntaxStartRange.REnd) and CharIsSymbol (Text [I]) then begin
							if I > LastStart then begin
								R := TNormalTextRange.Create (nil);
								with R do try
									Editor := Self;
									RStart := LastStart;
									REnd := I - 1;
									if RLength > 0 then
										AddRange (R, True);
								finally
									Free;
								end;
							end;
							R := TSymbolRange.Create (nil);
							with R as TSymbolRange do try
								Editor := Self;
								RStart := I;
								LastStart := I;
								while (LastStart <= SyntaxStartRange.REnd) and CharIsSymbol (Self.Text [LastStart]) do
									Inc (LastStart);
								REnd := LastStart - 1;
								Symbol := Text;
								if RLength > 0 then
									AddRange (R, True);
							finally
								Free;
							end;
						end;
						if (I > SyntaxStartRange.REnd) and (I > LastStart) then begin
							R := TNormalTextRange.Create (nil);
							with R do try
								Editor := Self;
								RStart := LastStart;
								REnd := I - 1;
								LastStart := I;
								if RLength > 0 then
									AddRange (R, True);
							finally
								Free;
							end;
						end;
					end;
					if ExitHere then
						Break;
				end;
			end else
				AddRange (SyntaxStartRange, False);
			SyntaxStartRange := SyntaxStartRange.NextRange;
		end;
	end else
		Result := inherited CreateSplitRanges (Range);
	{$IFDEF SyntaxDebug}
		for I := Low (Result) + 1 to High (Result) do
			if Result[I-1].REnd + 1 <> Result[I].RStart then
				raise ESourceEdit.Create (SSourceEditError);
	{$ENDIF}
end;

destructor TSourceEdit.Destroy;
begin
	if Assigned (FSyntaxColoring) then begin
		FSyntaxColoring.FUpdateDebth := 100;
		FSyntaxColoring.Free;
	end;
	inherited;
end;

function TSourceEdit.FindSyntaxHole: TSyntaxRange;
begin
	Result := FirstSyntaxRange;
	if Assigned (Result) and (Result.RStart = 1) then begin
		if LastSyntaxRange.REnd <> TextLength then
			Result := LastSyntaxRange
		else
			while Assigned (Result) and ((not Assigned (Result.NextRange)) or (Result.REnd + 1 = Result.NextRange.RStart)) do
				Result := Result.NextRange;
	end;
end;

function TSourceEdit.FindSyntaxOverlap: TSyntaxRange;
begin
	Result := FirstSyntaxRange;
	while Assigned (Result) and ((not Assigned (Result.NextRange)) or (Result.REnd < Result.NextRange.RStart)) do
		Result := Result.NextRange;
end;

function CmpStr(T1, T2: String; CaseSensitive: Boolean): Boolean;
begin
 if CaseSensitive then
  Result := AnsiCompareStr(T1, T2) = 0
 else
  Result := AnsiCompareText(T1, T2) = 0;
end;

function TSourceEdit.FindText(ATxt: string): Boolean;
var
 Find: Boolean;
 K : Integer;
 Txt: string;
 P0, P1, P2: PChar;
 T1: string;
begin
 if FSearch.BegPos > Length(Text) then Exit;
 if FSearch.EndPos > Length(Text) then Exit;
 If Not(soCaseSensitive in SearchOption) then
  ATxt := LowerCase(ATxt);
 Find := False;
 P0 := PChar(Self.Text);    //Text's Address
 //Up Search
 if soUp in SearchOption then
 begin
  P1 := P0 + FSearch.BegPos;
  P2 := P0 + FSearch.EndPos - FSearch.CurPos;
  While (P2 - P1 >=0) do
  begin
   While True do
   begin
    K := Ord(ATxt[Length(ATxt)]) - Ord(P2^);
    if ((K=0) or (K=32)) then Break;
    Dec(P2);
    if (P2 - P1 <= 0) then Break;
   end;
   //----------
   if ((K=0) or (K=32)) then
    if ((P2 - P1 + 1)>= Length(ATxt)) then
     begin
      T1 := Copy(Text, P2 - P0 - Length(ATxt) + 2, Length(ATxt));
      if CmpStr(T1, ATxt, soCaseSensitive in SearchOption) then
      begin
       SelStart := P2 - P0 - Length(ATxt) + 1;
       SelLength := Length(ATxt);
       FSearch.CurPos := Length(P2)  + Length(ATxt) -1;
       Find := True;
       Break;
      end;
     end;
   //----------
   if Not Find then Dec(P2);
  end;
 end;
 //-------------------------------------------------
 //Down Search
 if soDown in SearchOption then
 begin
  P1 := P0 + FSearch.BegPos + FSearch.CurPos;  //the beginning position for search
  P2 := P0 + FSearch.EndPos;        //the End Position for Search
  While (P2 - P1 >= 0) do
  begin
   //if FSearch.BegPos + FSearch.CurPos >= FSearch.EndPos then Break;
    While(True) do
    begin
     K := Ord(ATxt[1]) - Ord(P1^);
     if ((K=0) or (K=32)) then Break;
     Inc(P1);
     if P1 - P2 >=0 then Break;
    end;
    //-------------
    if ((K = 0) or (K = 32)) then
     if ((P2 - P1 + 1)>= Length(ATxt)) then
      begin
       T1 := Copy(Self.Text, P1 - P0 + 1, Length(ATxt));
       if CmpStr(T1, ATxt, soCaseSensitive in SearchOption) then
       begin
        SelStart := P1 - P0;
        SelLength := Length(ATxt);
        FSearch.CurPos := P1 - P0 - FSearch.BegPos + Length(ATxt)-1;
        Find := True;
        Break;
       end;
      end;
    //----------
    if Not Find then Inc(P1);
  end;
 end;
 Result := Find;
 if Not Find then
  FSearch.CurPos := 0 //Set this Value, It can repeatly Find
 else
  Self.ScrollCaret;
 P0 := NIL;
 P1 := NIL;
 P2 := NIL;
end;

function TSourceEdit.ReplaceText(FindTxt, ReplaceTxt: string;
  ReplaceAll: Boolean): Boolean;