procedure PAS_SetProgression(Eventer:TPurifyEvent);
   function PAS_NoComments(RE:TStrings):real;

.. in ..

procedure PAS_SetProgressionVisualBasic(Eventer:TPurifyEvent);
   function PAS_NoCommentsVisualBasic(RE:TStrings):real;

// Here everything in the area of ​​the bracket with a star is deleted
          if L2='(*' then
            begin
              r:=L1;
              Comment:=true;
              Key:=true;
              Continue;
            end;

          if Key then
            L2:=Copy(s,x-1,2);
          if (Comment) and (L2='*)') then
            begin
              Comment:=false;
              Key:=false;
              r:=L1;
              Continue;
            end;

// Here everything after the specified string is deleted, in this case //
          if L2='//' then
            begin
              CmtLine:=true;
              r:=L1;
              Continue;
            end;

   PAS_SetProgressionVisualBasic(Progression);
   PerCent := PAS_NoCommentsVisualBasic(RichEdit1.Lines);

  // symbols...
  CodeC1: array[0..20] of String = ('#','$','(',')','*',',',
          '.','/',':',';','[',']','{','}','<','>',
          '-','=','+','''','@');

  // These entries are highlighted by the style..
  // If there is a change, the loop must be adjusted
  CodeC2: array[0..44] of String = ('and','as','begin',
          'case','char','class','const','downto',
          'else','end','except','finally','for',
          'forward','function','if','implementation','interface',
          'is','nil','or','private','procedure','public','raise',
          'repeat','string','to','try','type','unit','uses','var',
          'while','external','stdcall','do','until','array','of',
          'in','shr','shl','cos','div');

// Highlight all functions defined as arrays.
  // When adding or removing words,
  // the number of loops must be adjusted.
  for i := 0 to 44 do
  begin
    with RichE do
    begin
      RichE.Lines.BeginUpdate;
      StartPos := 0;
      ToEnd := Length(Text) - StartPos;
      FoundAt := FindText(CodeC2[i], StartPos, ToEnd, [stWholeWord]);
      while (FoundAt <> -1) do
      begin
        SelStart := FoundAt;
        SelLength := Length(CodeC2[i]);
        SelAttributes.Color := C3;
        SelAttributes.Style := [fsBold];
        StartPos := FoundAt + Length(CodeC2[i]);
        FoundAt := FindText(CodeC2[i], StartPos, ToEnd, [stWholeWord]);
      end;
      RichE.Lines.EndUpdate;
    end;
  end;

// Styles
  case Form1.ComboBox1.ItemIndex of
  0 : style := 'Twilight';
  1 : style := 'Default';
  2 : style := 'Ocean';
  3 : style := 'Classic';
  4 : style := 'Oldskool';
  end;

  if Style = 'Twilight' then
  begin
    // Colors for the basic setting
  BackC := clWhite;   // Background Color
  FontC := clBlack;   // Font Color
  C1 := clBlack;      // Integer Color
  C2 := clBlack;      // Comments Color
  C3 := clBlack;      // function Color
  strC := clBlue;     // parameter Color
  strC1 := clGreen;   // brace Color
  Gray := clGray;     // Comment Color
  end

// Coloring all comments that are behind a "//" up to the line break
  Startpos := 0;
  with RichE do
  begin
    RichE.Lines.BeginUpdate;
    FoundAt := FindText('//', StartPos, Length(Text), []);
    while FoundAt <> -1 do
    begin
      SelStart := FoundAt;
      Startpos := FoundAt+1;
      FoundAt := FindText(#13#10, StartPos, Length(Text), []);
      if FoundAt <> -1 then
      begin
        SelLength := (FoundAt - selstart)+1;
        SelAttributes.Style := [];
        SelAttributes.Color := clGray;
        StartPos := FoundAt+1;
        FoundAt := FindText('//', StartPos, Length(Text), []);
      end;
    end;
    RichE.Lines.EndUpdate;
  end;

  // Color all characters inside the curly bracket
  Startpos := 0;
  with RichE do
  begin
    RichE.Lines.BeginUpdate;
    FoundAt := FindText('{', StartPos, Length(Text), []);
    while FoundAt <> -1 do
    begin
      SelStart := FoundAt;
      Startpos := FoundAt+1;
      FoundAt := FindText('}', StartPos, Length(Text), []);
      if FoundAt <> -1 then
      begin
        SelLength := (FoundAt - selstart)+1;
        SelAttributes.Style := [];
        SelAttributes.Color := strC1;
        StartPos := FoundAt+1;
        FoundAt := FindText('{', StartPos, Length(Text), []);
      end;
    end;
    RichE.Lines.EndUpdate;
  end;

  // Coloring all strings within the commercial
  Startpos := 0;
  with RichE do
  begin
    RichE.Lines.BeginUpdate;
    FoundAt := FindText('''', StartPos, Length(Text), []);
    while FoundAt <> -1 do
    begin
      SelStart := FoundAt;
      Startpos := FoundAt+1;
      FoundAt := FindText('''', StartPos, Length(Text), []);
      if FoundAt <> -1 then
      begin
        SelLength := (FoundAt - selstart)+1;
        SelAttributes.Style := [];
        SelAttributes.Color := strC1;
        StartPos := FoundAt+1;
        FoundAt := FindText('''', StartPos, Length(Text), []);
      end;
    end;
    RichE.Lines.EndUpdate;
  end;

  // Color all strings within the brackets and star
  Startpos := 0;
  with RichE do
  begin
    RichE.Lines.BeginUpdate;
    FoundAt := FindText('(*', StartPos, Length(Text), []);
    while FoundAt <> -1 do
    begin
      SelStart := FoundAt;
      Startpos := FoundAt+1;
      FoundAt := FindText('*)', StartPos, Length(Text), []);
      if FoundAt <> -1 then
      begin
        SelLength := (FoundAt - selstart)+1;
        SelAttributes.Style := [];
        SelAttributes.Color := clGray;
        StartPos := FoundAt+1;
        FoundAt := FindText('(*', StartPos, Length(Text), []);
      end;
    end;
    RichE.Lines.EndUpdate;
  end;

  // Color all strings within the corner brackets
  Startpos := 0;
  with RichE do
  begin
    RichE.Lines.BeginUpdate;
    FoundAt := FindText('[', StartPos, Length(Text), []);
    while FoundAt <> -1 do
    begin
      SelStart := FoundAt;
      Startpos := FoundAt+1;
      FoundAt := FindText(']', StartPos, Length(Text), []);
      if FoundAt <> -1 then
      begin
        SelLength := (FoundAt - selstart)+1;
        SelAttributes.Style := [];
        SelAttributes.Color := strC;
        StartPos := FoundAt+1;
        FoundAt := FindText('[', StartPos, Length(Text), []);
      end;
    end;
    RichE.Lines.EndUpdate;
  end;