mwdmlsyn.pas

来自「本人买的<<VC++项目开发实例>>源代码配套光盘.」· PAS 代码 · 共 1,866 行 · 第 1/4 页

function TmwDmlSyn.Func184: TtkTokenKind;
begin
  if KeyComp('Lov_secondary') and IsQuali then Result := tkQualifier else
    if KeyComp('Cross_reference') then Result := tkKey else
      Result := tkIdentifier;
end;

function TmwDmlSyn.Func185: TtkTokenKind;
begin
  if KeyComp('Start_stream') then Result := tkKey else Result := tkIdentifier;
end;

function TmwDmlSyn.Func187: TtkTokenKind;
begin
  if KeyComp('Output_block') then Result := tkBlock else Result := tkIdentifier;
end;

function TmwDmlSyn.Func188: TtkTokenKind;
begin
  if KeyComp('Output_mask') and IsQuali then Result := tkQualifier else
    if KeyComp('Procedure_form') then Result := tkForm else
      Result := tkIdentifier;
end;

function TmwDmlSyn.Func203: TtkTokenKind;
begin
  if KeyComp('Noexit_forward') and IsQuali then Result := tkQualifier else
    Result := tkIdentifier;
end;

function TmwDmlSyn.Func206: TtkTokenKind;
begin
  if KeyComp('Lov_reduced_to') and IsQuali then Result := tkQualifier else
    Result := tkIdentifier;
end;

function TmwDmlSyn.Func216: TtkTokenKind;
begin
  if KeyComp('Receive_arguments') then Result := tkKey else
    Result := tkIdentifier;
end;

function TmwDmlSyn.Func219: TtkTokenKind;
begin
  if KeyComp('Lov_sorted_by') and IsQuali then Result := tkQualifier else
    Result := tkIdentifier;
end;

function TmwDmlSyn.Func221: TtkTokenKind;
begin
  if KeyComp('End_disable_trigger') then Result := tkKey else
    Result := tkIdentifier;
end;

function TmwDmlSyn.Func232: TtkTokenKind;
begin
  if KeyComp('Lov_auto_select') and IsQuali then Result := tkQualifier else
    Result := tkIdentifier;
end;

function TmwDmlSyn.Func234: TtkTokenKind;
begin
  if KeyComp('Binary_to_poly') then Result := tkFunction else
    if KeyComp('Poly_to_binary') then Result := tkFunction else
      Result := tkIdentifier;
end;

function TmwDmlSyn.Func235: TtkTokenKind;
begin
  if KeyComp('Begin_disable_trigger') then Result := tkKey else
    Result := tkIdentifier;
end;

function TmwDmlSyn.Func243: TtkTokenKind;
begin
  if KeyComp('Start_transaction') then Result := tkKey else
    if KeyComp('Absolute_position') and IsQuali then Result := tkQualifier else
      Result := tkIdentifier;
end;

function TmwDmlSyn.Func244: TtkTokenKind;
begin
  if KeyComp('Column_heading_row') and IsQuali then Result := tkQualifier else
    Result := tkIdentifier;
end;

function TmwDmlSyn.Func255: TtkTokenKind;
begin
  if KeyComp('Input_row_height') and IsQuali then Result := tkQualifier else
    Result := tkIdentifier;
end;

function TmwDmlSyn.Func313: TtkTokenKind;
begin
  if KeyComp('End_signal_to_status') then Result := tkKey else
    Result := tkIdentifier;
end;

function TmwDmlSyn.Func327: TtkTokenKind;
begin
  if KeyComp('Begin_signal_to_status') then Result := tkKey else
    Result := tkIdentifier;
end;

function TmwDmlSyn.AltFunc: TtkTokenKind;
begin
  Result := tkIdentifier;
end;

function TmwDmlSyn.IdentKind(MayBe: PChar): TtkTokenKind;
var
  HashKey: Integer;
begin
  fToIdent := MayBe;
  HashKey := KeyHash(MayBe);
  if HashKey < 328 then Result := fIdentFuncTable[HashKey] else
    Result := tkIdentifier;
end;

procedure TmwDmlSyn.MakeMethodTables;
var
  I: Char;
begin
  for I := #0 to #255 do
    case I of
      #0: fProcTable[I] := NullProc;
      #10: fProcTable[I] := LFProc;
      #13: fProcTable[I] := CRProc;
      #1..#9, #11, #12, #14..#32:
        fProcTable[I] := SpaceProc;
      '#': fProcTable[I] := AsciiCharProc;
      '"': fProcTable[I] := StringProc;
      '0'..'9': fProcTable[I] := NumberProc;
      'A'..'Z', 'a'..'z', '_':
        fProcTable[I] := IdentProc;
      '{': fProcTable[I] := SymbolProc;
      '}': fProcTable[I] := SymbolProc;
      '!': fProcTable[I] := RemProc;
      '.': fProcTable[I] := PointProc;
      '<': fProcTable[I] := LowerProc;
      '>': fProcTable[I] := GreaterProc;
      '@': fProcTable[I] := AddressOpProc;
      #39, '&', '('..'-', '/', ':', ';', '=', '?', '['..'^', '`', '~':
        fProcTable[I] := SymbolProc;
    else fProcTable[I] := UnknownProc;
    end;
end;

constructor TmwDmlSyn.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  fFormAttri:= TmwHighLightAttributes.Create(MWS_AttrForm);
  fFormAttri.Style:= [fsBold];
  fFormAttri.Foreground:= clBlue;
  AddAttribute(fFormAttri);
  fBlockAttri:= TmwHighLightAttributes.Create(MWS_AttrBlock);
  fBlockAttri.Style:= [fsBold];
  fBlockAttri.Foreground:= clGreen;
  AddAttribute(fBlockAttri);
  fKeyAttri := TmwHighLightAttributes.Create(MWS_AttrKey);
  fKeyAttri.Style:= [fsBold];
  AddAttribute(fKeyAttri);
  fCommentAttri := TmwHighLightAttributes.Create(MWS_AttrComment);
  fCommentAttri.Style:= [fsBold];
  fCommentAttri.Foreground:= clRed;
  AddAttribute(fCommentAttri);
  fQualiAttri:= TmwHighLightAttributes.Create(MWS_AttrQualifier);
  fQualiAttri.Style:= [fsItalic];
  fQualiAttri.Foreground:= clGreen;
  AddAttribute(fQualiAttri);
  fFunctionAttri:= TmwHighLightAttributes.Create(MWS_AttrFunction);
  fFunctionAttri.Style:= [fsItalic];
  fFunctionAttri.Foreground:= clBlack;
  AddAttribute(fFunctionAttri);
  fVariableAttri:= TmwHighLightAttributes.Create(MWS_AttrVariable);
  fVariableAttri.Style:= [fsBold, fsItalic];
  fVariableAttri.Foreground:= clBlack;
  AddAttribute(fVariableAttri);
  fSpecialAttri:= TmwHighLightAttributes.Create(MWS_AttrSpecialVariable);
  fSpecialAttri.Style:= [fsItalic];
  fSpecialAttri.Foreground:= clBlack;
  AddAttribute(fSpecialAttri);
  fIdentifierAttri := TmwHighLightAttributes.Create(MWS_AttrIdentifier);
  AddAttribute(fIdentifierAttri);
  fNumberAttri := TmwHighLightAttributes.Create(MWS_AttrNumber);
  AddAttribute(fNumberAttri);
  fSpaceAttri := TmwHighLightAttributes.Create(MWS_AttrSpace);
  AddAttribute(fSpaceAttri);
  fStringAttri := TmwHighLightAttributes.Create(MWS_AttrString);
  AddAttribute(fStringAttri);
  fSymbolAttri := TmwHighLightAttributes.Create(MWS_AttrSymbol);
  AddAttribute(fSymbolAttri);
  SetAttributesOnChange(DefHighlightChange);

  InitIdent;
  MakeMethodTables;
  fRange := rsUnknown;

  fDefaultFilter := MWS_FilterGembase;
end;

procedure TmwDmlSyn.SetLine(NewValue: String; LineNumber:Integer);
begin
  fLine := PChar(NewValue);
  Run := 0;
  fLineNumber := LineNumber;
  Next;
end;

procedure TmwDmlSyn.AddressOpProc;
begin
  fTokenID := tkSymbol;
  Inc(Run);
  if fLine[Run] = '@' then Inc(Run);
end;

procedure TmwDmlSyn.AsciiCharProc;
begin
  // variables...
  fTokenID := tkVariable;
  repeat
    inc(Run);
  until not (FLine[Run] in ['_', '0'..'9', 'a'..'z', 'A'..'Z']);
end;

procedure TmwDmlSyn.SymbolProc;
begin
  inc(Run);
  fTokenId := tkSymbol;
end;

procedure TmwDmlSyn.CRProc;
begin
  fTokenID := tkSpace;
  inc(Run);
  if FLine[Run] = #10 then inc(Run);
end;

procedure TmwDmlSyn.GreaterProc;
begin
  fTokenID := tkSymbol;
  Inc(Run);
  if FLine[Run] = '=' then Inc(Run);
end;

procedure TmwDmlSyn.IdentProc;
begin
  fTokenID := IdentKind((fLine + Run));
  inc(Run, fStringLen);
  while Identifiers[fLine[Run]] do inc(Run);
end;

procedure TmwDmlSyn.LFProc;
begin
  fTokenID := tkSpace;
  inc(Run);
end;

procedure TmwDmlSyn.LowerProc;
begin
  fTokenID := tkSymbol;
  inc(Run);
  if (fLine[Run]= '=') or (fLine[Run]= '>') then Inc(Run);
end;

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

procedure TmwDmlSyn.NumberProc;
begin
  inc(Run);
  fTokenID := tkNumber;
  while FLine[Run] in ['0'..'9', '.'] do
  begin
    case FLine[Run] of
      '.':
        if FLine[Run + 1] = '.' then break;
    end;
    inc(Run);
  end;
end;

procedure TmwDmlSyn.PointProc;
begin
  fTokenID := tkSymbol;
  inc(Run);
  if (fLine[Run]='.') or (fLine[Run]=')') then inc(Run);
end;

procedure TmwDmlSyn.RemProc;
var
  p: PChar;
begin
  p := PChar(@fLine[Run - 1]);
  while p >= fLine do begin
    if not (p^ in [#9, #32]) then begin
      inc(Run);
      fTokenID := tkSymbol;
      exit;
    end;
    Dec(p);
  end;
  // it is a comment...
  fTokenID := tkComment;
  p := PChar(@fLine[Run]);
  repeat
    Inc(p);
  until p^ in [#0, #10, #13];
  Run := p - fLine;
end;

procedure TmwDmlSyn.SpaceProc;
var p: PChar;
begin
  fTokenID := tkSpace;
  p := PChar(@fLine[Run]);
  repeat
    Inc(p);
  until (p^ > #32) or (p^ in [#0, #10, #13]);
  Run := p - fLine;
end;

procedure TmwDmlSyn.StringProc;
begin
  fTokenID := tkString;
  if (FLine[Run + 1] = '"') and (FLine[Run + 2] = '"') then inc(Run, 2);
  repeat
    inc(Run);
  until (FLine[Run] in ['"', #0, #10, #13]);

  if FLine[Run] <> #0 then inc(Run);
end;

procedure TmwDmlSyn.UnknownProc;
begin
  inc(Run);
  fTokenID := tkUnknown;
end;

procedure TmwDmlSyn.Next;
begin
  fTokenPos := Run;
  fProcTable[fLine[Run]];
end;

function TmwDmlSyn.GetEol: Boolean;
begin
  Result := fTokenID = tkNull;
end;

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

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

function TmwDmlSyn.GetTokenAttribute: TmwHighLightAttributes;
begin
  case GetTokenID of
    tkForm: Result := fFormAttri;
    tkBlock: Result := fBlockAttri;
    tkKey: Result := fKeyAttri;
    tkComment: Result := fCommentAttri;
    tkQualifier: Result := fQualiAttri;
    tkFunction: Result := fFunctionAttri;
    tkIdentifier: Result := fIdentifierAttri;
    tkNumber: Result := fNumberAttri;
    tkSpecial: Result := fSpecialAttri;
    tkSpace: Result := fSpaceAttri;
    tkString: Result := fStringAttri;
    tkVariable: Result := fVariableAttri;
    tkSymbol: Result := fSymbolAttri;
    tkUnknown: Result := fSymbolAttri;
    else Result := nil;
  end;
end;

function TmwDmlSyn.GetTokenKind: integer;
begin
  Result := Ord(GetTokenID);
end;

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

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

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

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

function TmwDmlSyn.GetLanguageName: string;
begin
  Result := MWS_LangGembase;
end;

function TmwDmlSyn.GetIdentChars: TIdentChars;
begin
  Result := ['_', '0'..'9', 'a'..'z', 'A'..'Z'];
end;

function TmwDmlSyn.GetCapability: THighlighterCapability;
begin
  Result := inherited GetCapability + [hcUserSettings];
end;

procedure TmwDmlSyn.SetLineForExport(NewValue: String);
begin
  fLine := PChar(NewValue);
  Run := 0;
  ExportNext;
end;

procedure TmwDmlSyn.ExportNext;
begin
  fTokenPos := Run;
  fProcTable[fLine[Run]];

  if Assigned(Exporter) then
    with TmwCustomExport(Exporter) do begin
      Case GetTokenID of
        tkBlock: FormatToken(GetToken, fBlockAttri, False, False);
        tkComment: FormatToken(GetToken, fCommentAttri, True, False);
        tkForm: FormatToken(GetToken, fFormAttri, False,False);
        tkKey: FormatToken(GetToken, fKeyAttri, False,False);
        tkQualifier: FormatToken(GetToken, fQualiAttri, False,False);
        tkFunction: FormatToken(GetToken, fFunctionAttri, False,False);
        tkVariable: FormatToken(GetToken, fVariableAttri, False,False);
        tkString: FormatToken(GetToken, fStringAttri, True,False);
        tkIdentifier: FormatToken(GetToken, fIdentifierAttri, False,False);
        tkNumber: FormatToken(GetToken, fNumberAttri, False,False);
        tkSpecial: FormatToken(GetToken, fSpecialAttri, False,False);
        tkSpace: FormatToken(GetToken, fSpaceAttri, False,True);
        tkSymbol: FormatToken(GetToken, fSymbolAttri, False,False);
      end;
    end; //with
end;

initialization
  MakeIdentTable;
end.