psvsql.pas

PIC 单片机 PAS SOURCE CODE SAMPLES

  fLineNumber := LineNumber;
  Next;
end;{ SetLine }

procedure TpsvSQLRTF.AndSymbolProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvSQLRTF.BackslashProc;
begin
  fTokenID := tkSymbol;                {reference}
  inc(Run);
end;

procedure TpsvSQLRTF.CRProc;
begin
  fTokenID := tkSymbol;
  Case FLine[Run + 1] of
    #10: inc(Run, 2);
  else inc(Run);
  end;
end;

procedure TpsvSQLRTF.ColonProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvSQLRTF.CommaProc;
begin
  inc(Run);
  fTokenID := tkSymbol;                {comma}
end;

procedure TpsvSQLRTF.CommentProc;
begin
  fTokenID := tkComment;
  repeat
    case FLine[Run] of
      #0, #10, #13: break;
    end;
    inc(Run);
  until FLine[Run] = #0;
end;

procedure TpsvSQLRTF.EqualProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvSQLRTF.GreaterProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvSQLRTF.IdentProc;
begin
  {regular identifier}
  fTokenID := IdentKind((fLine + Run));
  inc(Run, fStringLen);
  while Identifiers[fLine[Run]] do inc(Run);
end;

procedure TpsvSQLRTF.LFProc;
begin
  fTokenID := tkSymbol;
  inc(Run);
end;

procedure TpsvSQLRTF.LowerProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvSQLRTF.MinusProc;
begin
  case FLine[Run + 1] of
    '-' :
      begin
        inc(Run, 2);
        fTokenID := tkComment;
        while FLine[Run] <> #0 do
          begin
            case FLine[Run] of
              #10, #13 : break;
            end;
            inc(Run);
          end;
      end;
    else
      begin
        inc(Run);
        fTokenID := tkSymbol;
      end;
  end;
end;

procedure TpsvSQLRTF.NullProc;
begin
  fTokenID := tkNull;
end;

procedure TpsvSQLRTF.NumberProc;
begin
{begin}                                                                         //mh 2000-01-07
  inc(Run);
  if not (fLine[Run] in ['0'..'9']) then begin
    fTokenID := tkSymbol;
    exit;
  end;
{end}                                                                           //mh 2000-01-07
  fTokenID := tkNumber;
  while FLine[Run] in
      ['0'..'9', '-', '_', '.', 'A'..'F', 'a'..'f', 'x', 'X'] do
  begin
    case FLine[Run] of
      '.':
        if FLine[Run + 1] = '.' then break;
      '-':                             {check for e notation}
        if not ((FLine[Run + 1] = 'e') or (FLine[Run + 1] = 'E')) then break;
    end;
    inc(Run);
  end;
end;

procedure TpsvSQLRTF.OrSymbolProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvSQLRTF.PlusProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvSQLRTF.QuestionProc;
begin
  fTokenID := tkSymbol;                {conditional op}
  inc(Run);
end;

procedure TpsvSQLRTF.RoundCloseProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvSQLRTF.RoundOpenProc;
begin
  inc(Run);
  FTokenID := tkSymbol;
end;

procedure TpsvSQLRTF.SemiColonProc;
begin
  inc(Run);
  fTokenID := tkSymbol;                {semicolon}
end;

procedure TpsvSQLRTF.SlashProc;
begin
  case FLine[Run + 1] of
    '/':                               {c++ style comments}
      begin
        inc(Run, 2);
        fTokenID := tkComment;
        while FLine[Run] <> #0 do
        begin
          case FLine[Run] of
            #10, #13: break;
          end;
          inc(Run);
        end;
      end;
    '*':                               {c style comments}
      begin
        fTokenID := tkComment;
        fRange := rsAnsiC;
        inc(Run);
        while fLine[Run] <> #0 do
          case fLine[Run] of
            '*':
              if fLine[Run + 1] = '/' then
              begin
                inc(Run, 2);
                fRange := rsUnKnown;
                break;
              end else inc(Run);
            #10: break;
            #13: break;
          else inc(Run);
          end;
      end;
  else                                 {division}
    begin
      inc(Run);
      fTokenID := tkSymbol;
    end;
  end;
end;

procedure TpsvSQLRTF.SpaceProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
  while FLine[Run] in [#1..#9, #11, #12, #14..#32] do inc(Run);
end;

procedure TpsvSQLRTF.SquareCloseProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvSQLRTF.SquareOpenProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvSQLRTF.StarProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvSQLRTF.StringInterpProc;
begin
  fTokenID := tkString;
  if (FLine[Run + 1] = #34) and (FLine[Run + 2] = #34) then inc(Run, 2);
  repeat
    case FLine[Run] of
      #0, #10, #13: break;
      #92:
        { backslash quote not the ending one }
        if FLine[Run + 1] = #34 then inc(Run);
    end;
    inc(Run);
  until FLine[Run] = #34;
  if FLine[Run] <> #0 then inc(Run);
end;

procedure TpsvSQLRTF.StringLiteralProc;
begin
  fTokenID := tkString;
  repeat
    case FLine[Run] of
      #0, #10, #13: break;
    end;
    inc(Run);
  until FLine[Run] = #39;
  if FLine[Run] <> #0 then inc(Run);
end;

procedure TpsvSQLRTF.XOrSymbolProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvSQLRTF.UnknownProc;
begin
  inc(Run);
end;

procedure TpsvSQLRTF.AnsiCProc;
begin
  fTokenID := tkComment;
  case FLine[Run] of
    #0:
      begin
        NullProc;
        exit;
      end;
    #10:
      begin
        LFProc;
        exit;
      end;
    #13:
      begin
        CRProc;
        exit;
      end;
  end;

  while FLine[Run] <> #0 do
    case FLine[Run] of
      '*':
        if fLine[Run + 1] = '/' then
        begin
          inc(Run, 2);
          fRange := rsUnKnown;
          break;
        end
        else inc(Run);
      #10: break;
      #13: break;
    else inc(Run);
    end;
end;

procedure TpsvSQLRTF.Next;
begin
  fTokenPos := Run;
  Case fRange of
    rsAnsiC: AnsiCProc;
    else
      fRange := rsUnknown;
      fProcTable[fLine[Run]];
  end;
end;

{begin}                                                                         //mh 2000-01-17
function TpsvSQLRTF.GetEol: Boolean;
begin
  Result := fTokenId = tkNull;
end;

function TpsvSQLRTF.GetRange: Pointer;
begin
 Result := Pointer(fRange);
end;

function TpsvSQLRTF.GetToken: String;
var
  Len: LongInt;
begin
  Len := Run - fTokenPos;
  SetString(Result, (FLine + fTokenPos), Len);
end;

function TpsvSQLRTF.GetTokenID: TtkTokenKind;
begin
  Result := fTokenId;
end;

function TpsvSQLRTF.GetTokenAttribute: integer;
begin
  case fTokenID of
    tkComment: Result := 1;
    tkIdentifier: Result := 2;
    tkKey: Result := 3;
    tkNumber: Result := 4;
    tkSymbol: Result := 5;
    tkString: Result := 6;
    tkUnknown: Result := 7;
    else Result := 8;
  end;
end;

function TpsvSQLRTF.GetTokenKind: integer;
begin
  Result := Ord(fTokenId);
end;

function TpsvSQLRTF.GetTokenPos: Integer;
begin
 Result := fTokenPos;
end;

procedure TpsvSQLRTF.ReSetRange;
begin
  fRange:= rsUnknown;
end;

procedure TpsvSQLRTF.SetRange(Value: Pointer);
begin
  fRange := TRangeState(Value);
end;

procedure TpsvSQLRTF.PrepareToken(var AToken : string);
var St : string;
begin
  St := AToken;
  St := StringReplace(St,'\','\\',[rfReplaceAll]);
  St := StringReplace(St,'{','\{',[rfReplaceAll]);
  St := StringReplace(St,'}','\}',[rfReplaceAll]);
  AToken := St;
end;

function TpsvSQLRTF.PrepareOutput(Attr: integer; AToken : string): string;
begin
  case Attr of 
    1 : Result  := '\cf1 \i '+ AToken +'\i0 ';
    3 : Result  := '\cf3 \b '+ AToken + '\b0 ';
  else
   Result := Format('\cf%d %s',[Attr,AToken]);
  end;
end;

procedure TpsvSQLRTF.SetupDefaultColors;
begin
  CreateColorTable([clNavy, clBlack, clBlack, clBlack, clBlack, clBlue, clBlack]);
end;

initialization
  MakeIdentTable;
end.