synuniformatultraedit.pas

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

{
@abstract(Provides UltraEdit highlighting schemes import and export)
@authors(Vitalik [[e-mail]])
@created(2005)
@lastmod(2006-06-30)
}

{$IFNDEF QSynUniFormatUltraEdit}
unit SynUniFormatUltraEdit;
{$ENDIF}

interface

uses
{$IFDEF SYN_CLX}
  QClasses,
  QGraphics,
  QSynUniFormat,
  QSynUniClasses,
  QSynUniRules,
  SynUniHighlighter,
{$ELSE}
  Classes,
  Graphics,
  SynUniFormat,
  SynUniClasses,
  SynUniRules,
  SynUniHighlighter,
{$ENDIF}
  SysUtils;

type
  TSynUniFormatUltraEdit = class(TSynUniFormat)
  public
    class function Import(SynUniSyn: TSynUniSyn; FileList: TStringList): boolean;
    class function ImportFromStream(AObject: TObject; Stream: TStream): boolean; override;
    class function ImportFromFile(AObject: TObject; FileName: string): boolean; override;
  end;

implementation

(*
function Test(FileName: string): boolean;
var
  i, cur: integer;
  buf: string;
  isLoading: boolean;
begin
  Form1.Memo1.Clear;
  if not Assigned(UltraEditFile) then
    if FileName <> '' then begin
      UltraEditFile := TStringList.Create;
      UltraEditFile.LoadFromFile(FileName);
      UltraEditFileName := FileName;
      UltraEditFilePos := 0;
      Form1.Memo1.Lines.Add('File was loaded...');
    end
    else begin
      Form1.Memo1.Lines.Add('File was not assigned and not loaded...');
      Result := False;
      Exit;
    end
  else begin
    if (FileName = UltraEditFileName) and (UltraEditFilePos >= UltraEditFile.Count-1) or (FileName = '') then begin
      if Assigned(UltraEditFile) then begin
        UltraEditFile.Free;
        UltraEditFile := nil;
      end;
      UltraEditFileName := '';
      UltraEditFilePos := 0;
      Form1.Memo1.Lines.Add('Variables are deleted...');
      Form1.Memo1.Lines.Add('Exit: 1.');
      Result := False;
      Exit;
    end;
    if FileName <> UltraEditFileName then begin
      UltraEditFile.LoadFromFile(FileName);
      UltraEditFileName := FileName;
      UltraEditFilePos := 0;
      Form1.Memo1.Lines.Add('New File was loaded!');
    end;
  end;

  isLoading := False;
  for i := UltraEditFilePos to UltraEditFile.Count-1 do begin
    buf := UltraEditFile.Strings[i];
    UltraEditFilePos := i;
    if buf = '' then continue;
    if copy(buf, 1, 2) = '/L' then begin
      if not isLoading then
        isLoading := True
      else begin // isLoading = True?
        Result := True;
        Exit;
        {TrySaveFile(); ResetSynUniSyn;}
      end;
      if (buf[4] = '"') or (buf[5] = '"') then begin
        cur := pos('"', copy(buf, pos('"',buf)+1, length(buf)-pos('"',buf))) + pos('"', buf);
        Form1.Memo1.Lines.Add(' Name: ' + copy(buf, pos('"',buf)+1, cur-pos('"',buf)-1));
      end;
    end else begin
      if not isLoading then isLoading := True;
      if copy(buf, 1, 13) = '/Delimiters =' then
        Form1.Memo1.Lines.Add(' Delimiters: ' + copy(buf, pos('=',buf)+1, length(buf)-pos('=',buf)+1))
      else
      if copy(buf, 1, 2) = '/C' then begin
        if buf[4] = '"' then begin
          cur := pos('"', copy(buf, 5, length(buf)-4)) + 4;
          Form1.Memo1.Lines.Add(' C' + buf[3] + ' "' + copy(buf, 5, cur-5) + '"');
        end
        else
          Form1.Memo1.Lines.Add(' C' + buf[3] + ' "<' + 'noname' + '>"');
      end else
    end;
  end;
  Form1.Memo1.Lines.Add('');
  Form1.Memo1.Lines.Add('File has finished...');
  Result := True;
end;
*)

//------------------------------------------------------------------------------
{* * * * * * * * * * * * TSynUniFormatUltraEdit * * * * * * * * * * * * * * * *}
//------------------------------------------------------------------------------
class function TSynUniFormatUltraEdit.Import(SynUniSyn: TSynUniSyn; FileList: TStringList): boolean;
var
  i, j, qn1, qn2, bn1, bn2, cur, Nc: integer;
  qc1, qc2: char;
  word, buf: string;
  Cnames: array [1..8] of string;
  Created: array [1..8] of integer;
  isLoading: boolean;
  keyword: TSynKeyList;
const
  colors: array [1..8] of TColor =
            (clBlue, clRed, $0080FF, clGreen, clMaroon, clBlue, clBlue, clBlue);
  badsymb: array [0..8] of char = ('\', '/', ':', '*', '?', '"', '<', '>', '|');
  LINE_COMMENT  = 1;
  BLOCK_COMMENT = 2;
  STRING_CHARS  = 3;
  LINE_COMM_NUM = 4;
  SINGLE_WORD   = 5;
  WHOLE_STRING  = 6;
  ESCAPE_CHAR   = 7;

  function GetAttribute(Key: string; Style: integer): boolean;
  var pos_start, space1_pos, space2_pos, len: integer;
  begin
    Result := False;
    if pos(key, buf) = 0 then Exit;
    pos_start := pos(key, buf) + length(key);
    if (Style = LINE_COMMENT) or (Style = BLOCK_COMMENT) or (Style = STRING_CHARS) then begin
      if Style =  LINE_COMMENT then len :=  5 else
      if Style = BLOCK_COMMENT then len := 19 else
      if Style =  STRING_CHARS then len := 2  else len := 5;
      word := copy(buf, pos_start, len);
      space1_pos := pos(' ', word);
      if space1_pos > 0 then
        if space1_pos = 1 then begin
          space2_pos := pos(' ', copy(word, 2, len-1));
          if space2_pos > 0 then
            word := copy(word, 1, space2_pos);
        end else
          word := copy(word, 1, space1_pos-1)
    end
    else if Style = LINE_COMM_NUM then begin
      len := StrToInt(buf[pos_start]);
      word := copy(buf, pos_start+1, len);
      space1_pos := pos(' ', word);
      if space1_pos > 0 then
    end
    else if Style = WHOLE_STRING then
      word := copy(buf, pos_start, length(buf) - pos_start + 1)
    else if Style = ESCAPE_CHAR then
      word := buf[pos_start]
    else if Style = SINGLE_WORD then ;

    if word <> '' then Result := True;
  end;

  function GetToken2: string;
  begin
    cur := pos(' ', buf);
    if cur > 0 then begin
      Result := copy(buf, 1, cur-1);
      buf := copy(buf, cur+1, length(buf)-cur);
    end else begin
      Result := buf;   buf := '';
    end;
  end;

  procedure RefreshScheme(ARange: TSynRange);
  var
    i: integer;
  begin
    with ARange, SynUniSyn do begin
      for i := 0 to RangeCount - 1 do
      begin
        with Ranges[i] do
          ActiveScheme.AddStyle(Name, Attributes.Foreground, Attributes.Background, Attributes.Style);
        RefreshScheme(Ranges[i]);
      end;
      for i := 0 to KeyListCount - 1 do
        with KeyLists[i] do
          ActiveScheme.AddStyle(Name, Attributes.Foreground, Attributes.Background, Attributes.Style);
      for i := 0 to ARange.SetCount - 1 do
        with Sets[i] do
          ActiveScheme.AddStyle(Name, Attributes.Foreground, Attributes.Background, Attributes.Style);
    end;
  end;

var
  FilePos: integer;
  FileName: string;
begin
  //Result := False;
  with SynUniSyn do begin
    FilePos := 0;
    if not Assigned(FileList) then