synhighlighterhp48.pas

用delphi写的delphi源代码 用delphi写的delphi源代码 用delphi写的delphi源代码 用delphi写的delphi源代码

constructor TSpeedStringList.create;
var
  i: integer;
begin
  inherited Create;
  for i := Low(Datas) to high(datas) do begin
    SumOfUsed[i] := 0;
    DatasUsed[i] := 0;
    lengthDatas[i] := 0;
    datas[i] := nil;
  end;
end;

destructor TSpeedStringList.Destroy;
begin
  Clear;
  inherited destroy;
end;

function TSpeedStringList.Find(const name: string): TSpeedListObject;
var
  crc: integer;
  i: integer;
begin
  crc := StringCrc(name) mod High(Datas) + 1;
  for i := 0 to DatasUsed[crc] - 1 do
    if Datas[crc][i].name = name then begin
      result := Datas[crc][i];
      exit;
    end;
  result := nil;
end;

function TSpeedStringList.Get(Index: Integer): string;
var
  i: integer;
begin
  for i := low(SumOfUsed) + 1 to High(SumOfUsed) do
    if Index > SumOfUsed[i] then begin
      result := Datas[i - 1][Index - SumOfUsed[i - 1]].name;
      exit;
    end;
  result := '';
end;

function TSpeedStringList.GetCount: integer;
begin
  result := SumOfUsed[High(datas)] + DatasUsed[High(Datas)];
end;

function TSpeedStringList.GetInObject(Index: Integer): TObject;
var
  i: integer;
begin
  for i := low(SumOfUsed) + 1 to High(SumOfUsed) do
    if Index > SumOfUSed[i] then begin
      result := Datas[i - 1][Index - SumOfUsed[i - 1]].pointer;
      exit;
    end;
  result := nil;
end;

function TSpeedStringList.GetObject(Index: Integer): TSpeedListObject;
var
  i: integer;
begin
  for i := low(SumOfUsed) + 1 to High(SumOfUsed) do
    if Index > SumOfUSed[i] then begin
      result := Datas[i - 1][Index - SumOfUsed[i - 1]];
      exit;
    end;
  result := nil;
end;

function TSpeedStringList.GetStringList: TStrings;
var
  i, j: integer;
begin
  result := TStringList.Create;
  for i := Low(Datas) to High(Datas) do
    for j := 0 to DatasUsed[i] - 1 do
      result.add(datas[i][j].name);
end;

function TSpeedStringList.GetText: string;
begin
  with StringList do begin
    result := Text;
    free;
  end;
end;

procedure TSpeedStringList.NameChange(const Obj: TSpeedListObject; const NewName: string);
var
  crc: integer;
  i: integer;
  j: integer;
begin
  crc := StringCrc(obj.Name) mod High(Datas) + 1;
  for i := 0 to DatasUsed[crc] - 1 do
    if Datas[crc][i] = Obj then begin
      for j := i + 1 to DatasUsed[crc] - 1 do
        Datas[i - 1] := Datas[i];
      for j := crc + 1 to High(Datas) do
        dec(SumOfUsed[j]);
      if DatasUsed[crc] < lengthDatas[crc] div 2 then begin
        ReallocMem(Datas[crc], DatasUsed[crc] * SizeOf(Datas[crc][0]));
        lengthDatas[crc] := DatasUsed[crc];
      end;
      AddObj(Obj);
      exit;
    end;
end;

procedure TSpeedStringList.ObjectDeleted(const obj: TSpeedListObject);
var
  crc: integer;
  i: integer;
  j: integer;
begin
  crc := StringCrc(obj.Name) mod High(Datas) + 1;
  for i := 0 to DatasUsed[crc] - 1 do
    if Datas[crc][i] = Obj then begin
      for j := i + 1 to DatasUsed[crc] - 1 do
        Datas[i - 1] := Datas[i];
      for j := crc + 1 to High(Datas) do
        dec(SumOfUsed[j]);
      Obj.FSpeedList := nil;
      exit;
    end;
end;

procedure TSpeedStringList.SetInObject(Index: Integer;
  const Value: TObject);
var
  i: integer;
begin
  for i := low(SumOfUsed) + 1 to High(SumOfUsed) do
    if Index > SumOfUSed[i] then begin
      Datas[i - 1][Index - SumOfUsed[i - 1]].pointer := value;
      exit;
    end;
end;

procedure TSpeedStringList.SetStringList(const value: TStrings);
var
  i: integer;
begin
  clear;
  for i := 0 to Value.Count - 1 do
    AddObj(TSpeedListObject.Create(value[i]));
end;

procedure TSpeedStringList.SetText(const Value: string);
var
  s: TStrings;
begin
  s := TStringList.Create;
  try
    s.Text := Value;
    StringList := s;
  finally
    s.Free;
  end;
end;

{ TSynHP48Syn }

constructor TSynHP48Syn.Create(AOwner: TComponent);
var
  i: TtkTokenKind;
  j, k: integer;
begin
  for i := low(TtkTokenKind) to High(TtkTokenKind) do
    Attribs[i] := TSynHighlighterAttributes.Create(tkTokenName[i]);
  inherited Create(AOwner);
  SetHighlightChange;
  FAsmKeyWords := TSpeedStringList.Create;
  FAsmKeyWords.Text := DefaultAsmKeyWords;
  for j := low(OtherAsmKeyWords) to High(OtherAsmKeyWords) do begin
    FAsmKeyWords.AddObj(TSpeedListObject.Create(OtherAsmKeyWords[j]));
    for k := 1 to 8 do
      FAsmKeyWords.AddObj(TSpeedListObject.Create(OtherAsmKeyWords[j] + IntToStr(k)));
  end;
  FRplKeyWords := TSpeedStringList.Create;
  FRplKeyWords.Text := DefaultRplKeyWords;
  FSAsmNoField := TSpeedStringList.Create;
  FSAsmNoField.Text := SAsmNoField;
  BaseRange := rsRpl;
  fRange := rsRpl;
  fDefaultFilter := SYNS_FilterHP48;
end; { Create }

destructor TSynHP48Syn.Destroy;
var
  i: TtkTokenKind;
begin
  for i := low(TtkTokenKind) to High(TtkTokenKind) do
    Attribs[i].Free;
  FAsmKeyWords.Free;
  FRplKeyWords.Free;
  FSAsmNoField.free;
  inherited Destroy;
end; { Destroy }

procedure TSynHP48Syn.SetLine(NewValue: string; LineNumber: Integer);
begin
  fLine := PChar(NewValue);
  Run := 1;
  fEol := False;
  Next;
end; { SetLine }

function TSynHP48Syn.AsmComProc(c: char): TtkTokenKind;
begin
  Result := tkAsmComment;
  if (Run > Length(fLine)) then
    Result := NullProc
  else
    while Run <= Length(FLine) do
      if ((run = 1) or (fLine[run - 1] <= ' ')) and
        (fLine[Run] = '*') and
        ((run < Length(fLine)) and (fLine[run + 1] = c)) and
        ((run + 1 = Length(fLine)) or (fLine[run + 2] <= ' ')) then begin
        inc(run, 2);
        fRange := rsAsm;
        break;
      end
      else
        inc(Run);
end;

function TSynHP48Syn.RplComProc: TtkTokenKind;
begin
  Result := tkRplComment;
  if (Run > Length(fLine)) then
    Result := NullProc
  else
    while Run <= Length(FLine) do
      if fLine[Run] = ')' then begin
        inc(run);
        fRange := rsRpl;
        break;
      end
      else
        inc(Run);
end;

function TSynHP48Syn.SlashProc: TtkTokenKind;
begin
  if fRange = rsRpl then
    Result := IdentProc
  else if ((Run = 1) or (fLine[Run - 1] <= ' ')) and
    (fLine[Run] = '/') and
    (run < Length(fLine)) and
    (fLine[run + 1] = '*') and
    ((run + 1 = Length(fLine)) or (fLine[Run + 2] <= ' ')) then begin
    inc(Run, 2);
    Result := tkAsmComment;
    fRange := rsComAsm2;
  end
  else if (run < Length(fLine)) and (fLine[Run + 1] = '/') then begin
    inc(Run, 2);
    Result := tkAsmComment;
    while (run <= Length(fLine)) do
      if FLine[Run] in [#10, #13] then begin
        inc(Run);
        break;
      end
      else
        inc(Run);
  end
  else
    Result := IdentProc
end;

function TSynHP48Syn.ParOpenProc: TtkTokenKind;
begin
  if fRange = rsRpl then
    if ((Run = 1) and ((Length(fLine) = 1) or (fLine[Run + 1] <= ' '))) or
      ((fLine[Run - 1] <= ' ') and ((Length(fLine) = Run) or (fLine[Run + 1] <= ' '))) then begin
      inc(Run);
      Result := tkRplComment;
      fRange := rsComRpl;
    end
    else
      Result := IdentProc
  else if ((run = 1) or (fLine[run - 1] <= ' ')) and
    (fline[Run] = '(') and
    (run < Length(fLine)) and
    (fLine[run + 1] = '*') and
    ((run + 2 > Length(fLine)) or (fLine[run + 2] <= ' ')) then begin
    inc(Run, 2);
    Result := tkAsmComment;
    fRange := rsComAsm1;
  end
  else
    Result := IdentProc
end;

function TSynHP48Syn.PersentProc: TtkTokenKind;
begin
  if fRange = rsAsm then begin
    inc(Run);
    Result := tkAsmComment;
    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 TSynHP48Syn.StarProc: TtkTokenKind;
begin
  if fRange = rsRpl then begin
    inc(Run);
    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 TSynHP48Syn.IdentProc: TtkTokenKind;
var
  i: integer;