cbhpsyn.pas

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

    Result := tkRplComment;
    while (run<=Length(fLine)) do
      case FLine[Run] of
        #10, #13:
          begin
            inc(Run);
            break;
          end;
      else inc(Run);
      end;
  end else
    Result:= IdentProc;
end;

function TcbHPSyn.IdentProc: TtkTokenKind;
var
  i: integer;
  s: string;
begin
  i:= Run;
  EndOfToken;
  s:= Copy(fLine, i, run-i);
  if fRange = rsAsm then
    if FAsmKeyWords.Find(s)<>nil then
      if (s='!RPL') or (s='ENDCODE') then
      Begin
        fRange := rsRpl;
        result:= tkAsmKey;
      end else
        result:= tkAsmKey
    else
      if fLine[i]<>'*' then
        result:= tkAsm
      else
        result:= tkAsmKey
  else
    if FRplKeyWords.Find(s)<>nil then
      if (s='CODEM') or (s='ASSEMBLEM') then
      Begin
        fRange := rsAsm;
        result:= tkAsmKey;
      end else
        if (s='CODE') or (s='ASSEMBLE') then
        Begin
          fRange := rssAsm1;
          result:= tksAsmKey;
        end else
          result:= tkRplKey
    else
      result:= tkRpl;
end;

function TcbHPSyn.GetTokenFromRange: TtkTokenKind;
begin
  case frange of
    rsAsm                 : result:= tkAsm;
    rssAsm1               : result:= tksAsmKey;
    rssAsm2               : result:= tksAsm;
    rssAsm3               : result:= tksAsmComment;
    rsRpl                 : result:= tkRpl;
    rsComRpl              : result:= tkRplComment;
    rsComAsm1, rsComAsm2  : result:= tkAsmComment;
    else result:= TkAsm;
  end;
end;

Function TcbHPSyn.NullProc: TtkTokenKind;
begin
  Result := GetTokenFromRange;
  fEol := True;
end;

Function TcbHPSyn.SpaceProc: TtkTokenKind;
begin
  inc(Run);
  while (Run<=Length(FLine)) and (FLine[Run] in [#1..#32]) do inc(Run);
  result:= GetTokenFromRange;
end;

Function TcbHPSyn.Next1: TtkTokenKind;
begin
  fTokenPos := Run;
  if Run>Length(fLine) then      result:= NullProc
  else if fRange = rsComRpl then result:= RplComProc
  else if fRange = rsComAsm1 then result:= AsmComProc(')')
  else if fRange = rsComAsm2 then result:= AsmComProc('/')
  else if frange = rssasm1   then result:= SasmProc1
  else if frange = rssasm2   then result:= sasmproc2
  else if frange = rssasm3   then result:= sasmproc3
  else if fLine[Run] in [#1..#32] then result:= SpaceProc
  else if fLine[Run] = '(' then  result:= ParOpenProc
  else if fLine[Run] = '%' then  result:= PersentProc
  else if fLine[Run] = '/' then  result:= SlashProc
  else if (run=1) and (fRange = rsRpl) and (fLine[1]='*') then result:= StarProc
  else result:= IdentProc;
end;

procedure TcbHPSyn.Next2(tkk: TtkTokenKind);
begin
  fTockenKind:= tkk;
end;

procedure TcbHPSyn.Next;
begin
  Next2(Next1);
end;

function TcbHPSyn.GetEol: Boolean;
begin
  Result:= fEol;
end;

function TcbHPSyn.GetToken: String;
var
  Len: LongInt;
  a: PChar;
begin
  a:= @(fLine[fTokenPos]);
  Len := Run - fTokenPos;
  SetString(Result, a, Len);
end;

function TcbHPSyn.GetTokenPos: Integer;
begin
 Result := fTokenPos-1;
end;

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

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

procedure TcbHPSyn.ReSetRange;
begin
  fRange := BaseRange;
end;

function TcbHPSyn.GetAttrib(Index: integer): TmwHighLightAttributes;
begin
  Result:= Attribs[TtkTokenKind(Index)];
end;

procedure TcbHPSyn.SetAttrib(Index: integer; Value: TmwHighLightAttributes);
begin
  Attribs[TtkTokenKind(Index)].Assign(Value);
end;

procedure TcbHPSyn.EndOfToken;
begin
  while (Run<=Length(fLine)) and (FLine[Run]>' ') do
    Inc(Run);
end;

function TcbHPSyn.LoadFromRegistry(RootKey: HKEY; Key: string): boolean;
var
  r: TBetterRegistry;
begin
  r:= TBetterRegistry.Create;
  try
    r.RootKey := RootKey;
    if r.OpenKeyReadOnly(Key) then begin
      if r.ValueExists('AsmKeyWordList')
        then AsmKeywords.Text:= r.ReadString({'HPSyntax',} 'AsmKeyWordList'{, AsmKeywords.Text});
      if r.ValueExists('RplKeyWordList')
        then RplKeywords.Text:= r.ReadString({'HPSyntax',} 'RplKeyWordList'{, RplKeywords.Text});
      Result := inherited LoadFromRegistry(RootKey, Key);
    end
    else Result := false;
  finally r.Free; end;
end;

function TcbHPSyn.SaveToRegistry(RootKey: HKEY; Key: string): boolean;
var
  r: TBetterRegistry;
begin
  r:= TBetterRegistry.Create;
  try
    r.RootKey := RootKey;
    if r.OpenKey(Key,true) then begin
      Result := true;
      r.WriteString({'HPSyntax',} 'AsmKeyWordList', AsmKeywords.Text);
      r.WriteString({'HPSyntax',} 'RplKeyWordList', RplKeywords.Text);
      Result := inherited SaveToRegistry(RootKey, Key);
    end
    else Result := false;
  finally r.Free; end;
end;

procedure TcbHPSyn.Assign(Source: TPersistent);
var
  i: TtkTokenKind;
begin
  if Source is TcbHPSyn then
  Begin
    for i:= Low(Attribs) to High(Attribs) do
    Begin
      Attribs[i].Background    := TcbHPSyn(source).Attribs[i].Background;
      Attribs[i].Foreground    := TcbHPSyn(source).Attribs[i].Foreground;
      Attribs[i].Style := TcbHPSyn(source).Attribs[i].Style;
    end;
    AsmKeyWords.Text:= TcbHPSyn(source).AsmKeyWords.Text;
    RplKeyWords.Text:= TcbHPSyn(source).RplKeyWords.Text;
  end else
    inherited Assign(Source);
end;

function TcbHPSyn.GetAttribCount: integer;
begin
  Result := Ord(High(Attribs))-Ord(Low(Attribs))+1;
end;

function TcbHPSyn.GetAttribute(idx: integer): TmwHighLightAttributes;
begin // sorted by name
  if (idx <= Ord(High(TtkTokenKind))) then Result := Attribs[TtkTokenKind(idx)]
                                      else Result := nil;
end;

function TcbHPSyn.GetLanguageName: string;
begin
  Result := 'HP48';
end;

procedure TcbHPSyn.SetHighLightChange;
var
  i: TtkTokenKind;
begin
  for i:= Low(Attribs) to High(Attribs) do
    Attribs[i].OnChange := DefHighLightChange;
end;

function TcbHPSyn.SasmProc1: TtkTokenKind;
var
  i: integer;
  s: string;
begin
  Result := tksAsmKey;
  if run>Length(fLine) then
    exit;
  if FLine[Run]='*' then
  begin
    frange:= rssasm3;
    result:= tksAsmComment;
    exit;
  end;
  if FLine[Run]>=' ' then
  Begin
    i:= run;
    while (run<=Length(fLine)) and (FLine[run]>' ') do inc(run);
    s:= Copy(fLine, i, run-i);
    if (s='RPL') or (s='ENDCODE') then
    Begin
      frange:= rsRpl;
      exit;
    end;
  end;
  while (run<=Length(fLine)) and (FLine[run]<=' ') and (FLine[run]<>#10) do inc(run);
  if run<=Length(fLine) then
    frange:= rssasm2
  else
    frange:= rssasm1;
end;

function TcbHPSyn.SasmProc2: TtkTokenKind;
var
  i: integer;
  s: string;
begin
  Result := tksAsm;
  while (run<=Length(fLine)) and (FLine[run]<=' ') and (fline[run]<>#10) do inc(run);
  if run>30 then
  Begin
    frange:= rssasm3;
    exit;
  end;
  i:= run;
  while (run<=Length(fLine)) and (FLine[run]>' ') do inc(run);
  s:= Copy(fLine, i, run-i);
  if (s='ENDCODE') or (s='RPL') then
  Begin
    frange:= rsRpl;
    result:= tksAsmKey;
  end else begin
    if FSAsmNoField.Find(s)=nil then
    Begin
      while (run<=Length(fLine)) and (FLine[run]<=' ') and (FLine[run]<>#10) do inc(run);
      while (run<=Length(fLine)) and (FLine[run]>' ') do inc(run);
      while (run<=Length(fLine)) and (FLine[run]<=' ') and (FLine[run]<>#10) do inc(run);
    end;
    if run<=Length(fLine) then
      frange:= rssasm3
    else
      frange:= rssasm1;
  end;
end;

function TcbHPSyn.SasmProc3: TtkTokenKind;
begin
  Result := tksAsmComment;
  while (run<=Length(fLine)) and (FLine[run]<>#10) do inc(run);
  if run<=Length(fLine) then inc(run);
  frange:= rssasm1;
end;

function TcbHPSyn.GetTokenAttribute: TmwHighLightAttributes;
begin
  Result := GetAttrib(Ord(fTockenKind));
end;

function TcbHPSyn.GetTokenKind: integer;
begin
  Result := Ord(fTockenKind);
end;

end.