jvhleditor.pas

数据表对拷程序。 做这个程序的本意是

            lgComment2:
              begin //  /*
                P := StrScan(F + i, '/');
                if P = nil then
                  Break
                else
                begin
                  if P[-1] = '*' then
                    FLong := lgNone;
                  i := P - F + 1;
                end;
              end;
            lgString:
              begin
                P := StrScan(F + i + 1, '"');
                if P <> nil then
                begin
                  i1 := P - F;
                  if P[1] <> '"' then
                    i := i1
                  else
                    { ?? }
                end
                else
                begin
                  if FHighlighter in [hlCBuilder, hlJava, hlNQC] then
                  begin
                    if (LastNoSpaceChar(S) <> '\') or (not HasStringOpenEnd(Lines, iLine)) then
                      FLong := lgNone;
                  end;
                  i := L1 + 1;
                end;
              end;
            lgPreproc:
              begin
                if LastNoSpaceChar(S) <> '\' then
                  FLong := lgNone;
              end;
          end;
        hlPython, hlPerl:
          case FLong of
            lgNone: //  not in comment
              case S[i] of
                '#':
                  i := L1;
                '"':
                  begin
                    P := StrScan(F + i, '"');
                    if P = nil then
                    begin
                      FLong := lgString;
                      Break;
                    end
                    else
                      i := P - F + 1;
                  end;
              end;
            lgString: // python and perl long string
              begin
                P := StrScan(F + i - 1, '"');
                if P <> nil then
                begin
                  FLong := lgNone;
                  i := P - F + 1;
                end
                else
                  i := L1 + 1;
              end;
          end;
        hlHtml:
          case FLong of
            lgNone: //  not in comment
              case S[i] of
                '<':
                  begin
                    P := StrScan(F + i, '>');
                    if P = nil then
                    begin
                      FLong := lgTag;
                      Break;
                    end
                    else
                      i := P - F + 1;
                  end;
              end;
            lgTag: // html tag
              begin
                P := StrScan(F + i - 1, '>');
                if P <> nil then
                begin
                  FLong := lgNone;
                  i := P - F + 1;
                end
                else
                  i := L1 + 1;
              end;
          end;
        hlCocoR:
          case FLong of
            lgNone: //  not in comment
              case S[i] of
                '(':
                  if {S[i + 1]} F[i] = '*' then
                  begin
                    FLong := lgComment2;
                    P := StrScan(F + i + 2, ')');
                    if P = nil then
                      Break
                    else
                    begin
                      if P[-1] = '*' then
                        FLong := lgNone;
                      i := P - F + 1;
                    end;
                  end;
                '"':
                  begin
                    P := StrScan(F + i + 1, '"');
                    if P <> nil then
                    begin
                      i1 := P - F;
                      if P[1] <> '"' then
                        i := i1
                      else
                        { ?? }
                    end
                    else
                      i := L1 + 1;
                  end;
                '''':
                  begin
                    P := StrScan(F + i + 1, '''');
                    if P <> nil then
                    begin
                      i1 := P - F;
                      if P[1] <> '''' then
                        i := i1
                      else
                        { ?? }
                    end
                    else
                      i := L1 + 1;
                  end;
                '/':
                  if {S[i + 1]} F[i] = '*' then
                  begin
                    FLong := lgComment2;
                    P := StrScan(F + i + 2, '/');
                    if P = nil then
                      Break
                    else
                    begin
                      if P[-1] = '*' then
                        FLong := lgNone;
                      i := P - F + 1;
                    end;
                  end;
              end;
            lgComment2:
              begin //  (*
                P := StrScan(F + i, ')');
                if P = nil then
                  Break
                else
                begin
                  if P[-1] = '*' then
                    FLong := lgNone;
                  i := P - F + 1;
                end;
              end;
          end;
      end;
      Inc(i);
    end;

    if (FHighLighter = hlCocoR) and
      (StrLIComp(PChar(S), 'productions', Length('productions')) = 0) then
    begin
      ProductionsLine := iLine;
    end;


    Inc(iLine);
    if FLongDesc[iLine] <> FLong then
    begin
      FLongDesc[iLine] := FLong;
      Result := True; // Invalidate
    end;
  end;
 // undefine following lines
  if MaxScanLine < MaxLine then
    FillChar(FLongDesc[MaxScanLine + 1], SizeOf(FLongDesc[0]) * (MaxLine - MaxScanLine), lgUndefined);
end;

function TJvHLEditor.FindLongEnd: Integer;
var
  P, F: PChar;
  i: integer;
begin
  P := PChar(FLine);
  Result := Length(FLine);
  case FHighLighter of
    hlPascal:
      case FLong of
        lgComment1:
          begin
            P := StrScan(P, '}');
            if P <> nil then
              Result := P - PChar(FLine);
          end;
        lgComment2:
          begin
            F := P;
            while True do
            begin
              F := StrScan(F, '*');
              if F = nil then
                Exit;
              if F[1] = ')' then
                Break;
              Inc(F);
            end;
            P := F + 1;
            Result := P - PChar(FLine);
          end;
      end;
    hlCBuilder, hlSql, hlJava, hlPhp, hlNQC:
      begin
        case FLong of
          lgComment2:
            begin
              F := P;
              while True do
              begin
                F := StrScan(F, '*');
                if F = nil then
                  Exit;
                if F[1] = '/' then
                  Break;
                Inc(F);
              end;
              P := F + 1;
              Result := P - PChar(FLine);
            end;
          lgString:
            begin
              F := P;
              repeat
                P := StrScan(P, '"');
                if P <> nil then
                begin
                  if (P = F) or (P[-1] <> '\') then
                  begin
                    Result := P - F;
                    Break;
                  end
                  else
                  begin
                   // count the backslashes
                    i := 1;
                    while (P - 1 - i > F) and (P[-1 - i] = '\') do Inc(i);
                    if i and $01 = 0 then {faster than: if i mod 2 = 0 then}
                    begin
                      Result := P - F;
                      Break;
                    end;
                  end;
                  Inc(P);
                end;
              until P = nil;
            end;
          end;  // case
      end;
    hlPython, hlPerl:
      case FLong of
        lgString:
          begin
            P := StrScan(P, '"');
            if P <> nil then
              Result := P - PChar(FLine);
          end;
      end;
    hlHtml:
      case FLong of
        lgTag:
          begin
            P := StrScan(P, '>');
            if P <> nil then
              Result := P - PChar(FLine);
          end;
      end;
  end;
end;

procedure TJvHLEditor.TextModified(ACaretX, ACaretY: Integer; Action: TModifiedAction;
  const Text: string);
var
  S: string;
{  LP, i: Integer;
  P: PChar;
  OldProductionsLine: Integer; }
begin
  if not FLongTokens then
    Exit;
  case FHighLighter of
    hlPascal:
      S := '{}*()/'#13;
    hlCBuilder, hlJava, hlSql, hlPhp, hlNQC:
      S := '*/'#13'\';
    hlVB:
      S := '''' + #13;
    hlPython, hlPerl:
      S := '#"'#13;
    hlHtml:
      S := '<>'#13;
    hlCocoR:
      S := '*()/'#13;
  else
    S := #13; { unknown highlighter ? }
  end;
  if (Action in [maAll, maReplace]) or HasAnyChar(S, Text) then
  begin
    if Action = maAll then
      ACaretY := -1;  // rescan all lines

    if RescanLong(ACaretY) then
      Invalidate;
  end;
 {
  if (FHighLighter = hlCocoR) and (HasAnyChar('productions'#13, Text)) then
  begin
    LP := Length('productions');
    OldProductionsLine := ProductionsLine;
    ProductionsLine := High(Integer);
    for i := 0 to Lines.Count - 1 do
    begin
      P := PChar(Lines[i]);
      if (StrLIComp(P, 'productions', LP) = 0) and
         ((Length(P) = LP) or (P[LP] = ' ')) then
      begin
        ProductionsLine := i;
        Break;
      end;
    end;
    if ProductionsLine <> OldProductionsLine then
      Invalidate;
  end; }
end;

function TJvHLEditor.GetReservedWord(const Token: string;
  var Reserved: Boolean): Boolean;
begin
  Result := Assigned(FOnReservedWord);
  if Result then
  begin
    Reserved := False;
    FOnReservedWord(Self, Token, Reserved);
  end
end;

function TJvHLEditor.UserReservedWords: Boolean;
begin
  Result := Assigned(FOnReservedWord);
end;

procedure TJvHLEditor.Assign(Source: TPersistent);
begin
  if Source is TJvHLEditor then
  begin
    Colors.Assign((Source as TJvHLEditor).Colors);
    SelForeColor := (Source as TJvHLEditor).SelForeColor;
    SelBackColor := (Source as TJvHLEditor).SelBackColor;
    Color := (Source as TJvHLEditor).Color;
    RightMarginColor := (Source as TJvHLEditor).RightMarginColor;
    Invalidate;
  end
  else
    inherited Assign(Source);
end;


type
  TDelphiColor = record
    ForeColor, BackColor: TColor;
    Style: TFontStyles;
  end;

const
  DelphiColor_Comment: TDelphiColor = (ForeColor: clNavy; BackColor: clWindow; Style: [fsItalic]);
  DelphiColor_Number: TDelphiColor = (ForeColor: clNavy; BackColor: clWindow; Style: []);
  DelphiColor_Strings: TDelphiColor = (ForeColor: clBlue; BackColor: clWindow; Style: []);
  DelphiColor_Symbol: TDelphiColor = (ForeColor: clBlack; BackColor: clWindow; Style: []);
  DelphiColor_Reserved: TDelphiColor = (ForeColor: clBlack; BackColor: clWindow; Style: [fsBold]);
  DelphiColor_Identifier: TDelphiColor = (ForeColor: clBlack; BackColor: clWindow; Style: []);
  DelphiColor_PlainText: TDelphiColor = (ForeColor: clWindowText; BackColor: clWindow; Style: []);

function TJvHLEditor.GetDelphiColors: Boolean;
  function CompareColor(Symbol: TJvSymbolColor; const DelphiColor: TDelphiColor): Boolean;
  begin
    Result := (Symbol.ForeColor = DelphiColor.ForeColor) and
              (Symbol.BackColor = DelphiColor.BackColor) and
              (Symbol.Style = DelphiColor.Style);
  end;
begin
  Result := False;
  if not CompareColor(FColors.Comment, DelphiColor_Comment) then Exit;
  if not CompareColor(FColors.Number, DelphiColor_Number) then Exit;
  if not CompareColor(FColors.Strings, DelphiColor_Strings) then Exit;
  if not CompareColor(FColors.Symbol, DelphiColor_Symbol) then Exit;
  if not CompareColor(FColors.Reserved, DelphiColor_Reserved) then Exit;
  if not CompareColor(FColors.Identifier, DelphiColor_Identifier) then Exit;
  if not CompareColor(FColors.PlainText, DelphiColor_PlainText) then Exit;
  Result := True;
end;

procedure TJvHLEditor.SetDelphiColors(Value: Boolean);
  procedure SetColor(Symbol: TJvSymbolColor; const DelphiColor: TDelphiColor);
  begin
    with DelphiColor do
      Symbol.SetColor(ForeColor, BackColor, Style);
  end;
begin
  if Value then
  begin
    SetColor(FColors.FComment, DelphiColor_Comment);
    SetColor(FColors.FNumber, DelphiColor_Number);
    SetColor(FColors.Strings, DelphiColor_Strings);
    SetColor(FColors.Symbol, DelphiColor_Symbol);
    SetColor(FColors.Reserved, DelphiColor_Reserved);
    SetColor(FColors.Identifier, DelphiColor_Identifier);
    SetColor(FColors.PlainText, DelphiColor_PlainText);
  end;
end;

end.