synhighlightermulti.pas

一个mwEdit控件原码,比mwCuuEdit0.92a功能先进.

            //fMarkers.Add( TMarker.Create( cScheme, iParser.MatchPos[0] + iEaten,
            //  iParser.MatchLen[0], True, iExpr ) );
            //GBN 31/01/2002 - End
            Delete( iLine, 1, iParser.MatchPos[0] -1 + iParser.MatchLen[0] );
            Inc( iEaten, iParser.MatchPos[0] -1 + iParser.MatchLen[0] );
            break;
          end;
        end; {for}
        if cScheme >= Schemes.Count then
          break;
      end; {else}

  finally
    iParser.Free;
  end;

  fLineNumber := LineNumber;
  fLine := NewValue;
  fMarker := nil;
  fRun := 1;
  fTokenPos := 0;
  fNextMarker := 0;
  Next;
end;

procedure TSynMultiSyn.SetSchemes(const Value: TSchemes);
begin
  fSchemes.Assign(Value);
end;

procedure TSynMultiSyn.UnhookHighlighter(aHL: TSynCustomHighlighter);
begin
  aHL.UnhookAttrChangeEvent( DefHighlightChange );
{$IFDEF SYN_COMPILER_5_UP}
  aHL.RemoveFreeNotification( Self );
{$ENDIF}
end;

function TSynMultiSyn.GetSampleSource: string;
begin
  Result := fSampleSource;
end;

procedure TSynMultiSyn.SetSampleSource(Value: string);
begin
  fSampleSource := Value;
end;

{$IFNDEF SYN_CLX}
function TSynMultiSyn.LoadFromRegistry(RootKey: HKEY;
  Key: string): boolean;
var
  r: TBetterRegistry;
  i: integer;
begin
  if DefaultHighlighter <> nil then
    Result := DefaultHighlighter.LoadFromRegistry( RootKey, Key + '\DefaultHighlighter' )
  else
    Result := False;
  r := TBetterRegistry.Create;
  try
    r.RootKey := RootKey;
    for i := 0 to Schemes.Count-1 do
      if (Schemes[i].SchemeName <> '') and
        r.OpenKeyReadOnly(Key + '\' + Schemes[i].SchemeName) then
      begin
        Result := Schemes[i].MarkerAttri.LoadFromRegistry(r) and Result;
        r.CloseKey;
        Result := (Schemes[i].Highlighter <> nil) and
          Schemes[i].Highlighter.LoadFromRegistry( RootKey,
          Key + '\' + Schemes[i].SchemeName ) and Result;
      end
      else
        Result := False;
  finally
    r.Free;
  end;
end;

function TSynMultiSyn.SaveToRegistry(RootKey: HKEY; Key: string): boolean;
var
  r: TBetterRegistry;
  i: integer;
begin
  if DefaultHighlighter <> nil then
    Result := DefaultHighlighter.SaveToRegistry( RootKey, Key + '\DefaultHighlighter' )
  else
    Result := False;
  r := TBetterRegistry.Create;
  try
    r.RootKey := RootKey;
    for i := 0 to Schemes.Count-1 do
      if (Schemes[i].SchemeName <> '') and
        r.OpenKey(Key + '\' + Schemes[i].SchemeName, True) then
      begin
        Result := Schemes[i].MarkerAttri.SaveToRegistry(r) and Result;
        r.CloseKey;
        Result := (Schemes[i].Highlighter <> nil) and
          Schemes[i].Highlighter.SaveToRegistry( RootKey,
          Key + '\' + Schemes[i].SchemeName ) and Result;
      end
      else
        Result := False;
  finally
    r.Free;
  end;
end;
{$ENDIF}

function TSynMultiSyn.GetRange: Pointer;
begin
  Result := nil;
  fRangeProc( roGet, cardinal(Result) );
end;

procedure TSynMultiSyn.SetRange(Value: Pointer);
begin
  fRangeProc( roSet, cardinal(Value) );
end;

procedure TSynMultiSyn.NewRangeProc(Operation: TRangeOperation; var Range: cardinal);
const
  SchemeIndexSize = 3;
  MaxSchemeCount = (1 shl SchemeIndexSize) -1;
  SchemeRangeSize = 4;
  MaxSchemeRange = (1 shl SchemeRangeSize) -1;
begin
  if Operation = roGet then
  begin
    if DefaultHighlighter <> nil then
      Range := cardinal( DefaultHighlighter.GetRange )
    else
      Range := 0;
    if CurrScheme >= 0 then
    begin
      Assert( cardinal( Schemes[CurrScheme].Highlighter.GetRange ) <= MaxSchemeRange );
      Range := Range shl SchemeRangeSize;
      Range := Range or cardinal( Schemes[CurrScheme].Highlighter.GetRange );
    end;
    Assert( CurrScheme <= MaxSchemeCount );
    Range := Range shl SchemeIndexSize;
    Range := Range or cardinal(CurrScheme + 1);
  end
  else begin
    CurrScheme := integer(Range and MaxSchemeCount) -1;
    Range := Range shr SchemeIndexSize;
    if CurrScheme >= 0 then
    begin
      Schemes[CurrScheme].Highlighter.SetRange( pointer(Range and MaxSchemeRange) );
      Range := Range shr SchemeRangeSize;
    end;
    if DefaultHighlighter <> nil then
    begin
      fTmpRange := pointer(Range);
      DefaultHighlighter.SetRange( fTmpRange );
    end;
  end;
end;

function TSynMultiSyn.UpdateRangeProcs: boolean;
// determines the appropriate RangeProcs and returns whether they were changed
var
  i: integer;
  OldProc: TRangeProc;
begin
  OldProc := fRangeProc;
  if Assigned( OnCustomRange ) then
    fRangeProc := UserRangeProc
  else begin
    fRangeProc := NewRangeProc;
    for i := 0 to Schemes.Count -1 do
      if Schemes[i].Highlighter is TSynMultiSyn then
      begin
        fRangeProc := OldRangeProc;
        break;
      end;
  end;
  Result := TMethod(OldProc).Code <> TMethod(fRangeProc).Code;
  if Result then
    DefHighlightChange( Self );
end;

procedure TSynMultiSyn.UserRangeProc(Operation: TRangeOperation; var Range: cardinal);
begin
  OnCustomRange( Self, Operation, pointer(Range) );
  if (Operation = roSet) and (DefaultHighlighter <> nil) then
    fTmpRange := DefaultHighlighter.GetRange;
end;

procedure TSynMultiSyn.SetOnCustomRange(const Value: TCustomRangeEvent);
begin
  if ( TMethod(OnCustomRange).Code <> TMethod(Value).Code ) or
    ( TMethod(OnCustomRange).Data <> TMethod(Value).Data ) then
  begin
    fOnCustomRange := Value;
    UpdateRangeProcs;
  end;
end;

procedure TSynMultiSyn.Loaded;
begin
  inherited;
  DefHighlightChange( Self );
end;

{ TSchemes }

constructor TSchemes.Create(aOwner: TSynMultiSyn);
begin
  inherited Create(TScheme);
  fOwner := aOwner;
end;

function TSchemes.GetItems(Index: integer): TScheme;
begin
  Result := inherited Items[Index] as TScheme;
end;

{$IFDEF SYN_COMPILER_3_UP}
function TSchemes.GetOwner: TPersistent;
begin
  Result := fOwner;
end;
{$ENDIF}

procedure TSchemes.SetItems(Index: integer; const Value: TScheme);
begin
  inherited Items[Index] := Value;
end;

{$IFDEF SYN_COMPILER_3_UP}
procedure TSchemes.Update(Item: TCollectionItem);
begin
  if Item <> nil then
    fOwner.DefHighlightChange( Item )
  else // pass the MultiSyn as the Sender so Editors reparse their text
    fOwner.DefHighlightChange( fOwner );
end;
{$ENDIF}

{ TScheme }

function TScheme.ConvertExpression(const Value: String): String;
begin
  if not CaseSensitive then
    Result := AnsiUpperCase(Value)
  else
    Result := Value;
end;

constructor TScheme.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  fCaseSensitive := True;
  fMarkerAttri := TSynHighlighterAttributes.Create(SYNS_AttrMarker);
  fMarkerAttri.OnChange := MarkerAttriChanged;
  MarkerAttri.Background := clYellow;
  MarkerAttri.Style := [fsBold];
  MarkerAttri.InternalSaveDefaultValues;
end;

destructor TScheme.Destroy;
begin
  { unhook notification handlers }
  Highlighter := nil;
  inherited Destroy;
  fMarkerAttri.Free;
end;

{$IFDEF SYN_COMPILER_3_UP}
function TScheme.GetDisplayName: String;
begin
  if SchemeName <> '' then
    Result := SchemeName
  else
    Result := inherited GetDisplayName;
end;
{$ENDIF SYN_COMPILER_3_UP}

procedure TScheme.MarkerAttriChanged(Sender: TObject);
begin
  Changed( False );
end;

procedure TScheme.SetCaseSensitive(const Value: Boolean);
begin
  if fCaseSensitive <> Value then
  begin
    fCaseSensitive := Value;
    Changed( True );
  end;
end;

{$IFDEF SYN_COMPILER_3_UP}
procedure TScheme.SetDisplayName(const Value: String);
begin
  SchemeName := Value;
end;
{$ENDIF SYN_COMPILER_3_UP}

procedure TScheme.SetEndExpr(const Value: string);
var OldValue: String; //GBN 31/01/2002 - From Flavio
begin
  if fEndExpr <> Value then
  begin
    if Value <> '' then
      CheckExpression( Value );
    OldValue := fEndExpr; //GBN 31/01/2002 - From Flavio
    fEndExpr := Value;
    //GBN 31/01/2002 - From Flavio
    if ConvertExpression( OldValue ) <> ConvertExpression( Value ) then
      Changed( True );
  end;
end;

procedure TScheme.SetHighlighter(const Value: TSynCustomHighLighter);
var
  iOwner: TSynMultiSyn;
  iAlreadyRepainted: boolean;
begin
  if Highlighter <> Value then
  begin
    iOwner := TSchemes(Collection).fOwner;
    if (Highlighter <> nil) and (Highlighter <> iOwner) then
      iOwner.UnhookHighlighter( Highlighter );
    fHighlighter := Value;
    if (Highlighter <> nil) and (Highlighter <> iOwner) then
      iOwner.HookHighlighter( Highlighter );
    if Highlighter is TSynMultiSyn then
      iAlreadyRepainted := iOwner.UpdateRangeProcs
    else
      iAlreadyRepainted := False;
    if not iAlreadyRepainted then
      Changed( True );
  end;
end;

procedure TScheme.SetMarkerAttri(const Value: TSynHighlighterAttributes);
begin
  fMarkerAttri.Assign(Value);
end;

procedure TScheme.SetStartExpr(const Value: string);
var OldValue: String; //GBN 31/01/2002 - From Flavio
begin
  if fStartExpr <> Value then
  begin
    if Value <> '' then
      CheckExpression( Value );
    OldValue   := fStartExpr; //GBN 31/01/2002 - From Flavio
    fStartExpr := Value;
    //GBN 31/01/2002 - From Flavio
    if ConvertExpression( Value ) <> ConvertExpression( OldValue ) then
      Changed( True );
  end;
end;

end.