получить список переменных

Комментарии

• DimaBr

  November 2012 отредактировано 09:08

  Я добавил собственный парсер
  unit frxDesign;

  procedure TfrxDesignerForm.OnCodeCompletion(const Name: String; List: TStrings);
  var
    obj: TPersistent;
    xd: TfsXMLDocument;
    i, j: Integer;
    sl, members: TStringList;
    s: String;
    clName: String;
    clVar: TfsClassVariable;
    clMethod: TfsCustomHelper;
    cl: TClass;
    l: TList;
  
    function AFind(SubStr,S:string; AChars: TSysCharSet): integer;
    var X,dx: integer;
    begin
      Result := -1;
      dx := 0;
      while (Length(S) > 0) and (Result < 0) do begin
        X := Pos(SubStr,S);
        if X > 0 then
          if (S[X-1] in AChars) and (S[X+Length(SubStr)] in AChars)
            then Result := X + dx
            else begin
              Delete(S,1,X);
              inc(dx,X);
            end
        else S := '';
      end;
    end;
  
    function GetClassFromCode: string;
    var P: TPoint;
        T, M: string;
        I, X,Y, X1,X2: integer;
    begin // собираем переменые по тексту
      Result := '';
      P := CodeWindow.GetPos;
      for i := 0 to P.Y do
        T := T + UpperCase(Trim(CodeWindow.Lines[i])) + ';';
      M := T;
  // вырезаем всё лишнее
      while Length(T) > 0 do begin
        X := AFind('PROCEDURE',T,[' ',';']);
        Y := AFind('FUNCTION',T,[' ',';']);
        if (Y<X) and (Y>-1) then X := Y;
        if X > 0 then begin
          I := 1;
          while I > 0 do begin
            X1 := AFind('BEGIN',T,[' ',';']);
            X2 := AFind('END',T,[' ',';']);
            if (X1 > X2) or (X1=-1) then begin
              Delete(T,X, MaxInt);
              I := 0;
            end
            else Delete(T,X, X2-X+3);
          end;
        end
        else Break;
      end;
  
      I := Length(M)-6;
      while I > 0 do begin
        dec(I);
        if (copy(M,I,10) = 'PROCEDURE ') or (copy(M,I,9) = 'FUNCTION ') then
          if M[I-1] in [' ',';'] then begin
            Delete(M,1,I-1);
            X := AFind('VAR',M,[' ',';']);
            if X > 0 then Delete(M,1,X-1);
            I := -1;
            X := AFind('BEGIN',M,[' ',';']);
            if X > 0 then Delete(M,X,Length(M)-X);
          end;
      end;
      T := M + ';' + T;
      M := UpperCase(members[0]);
  
      X := AFind(M,T,[',',' ',':',';']);
      if X > 0 then begin
        Delete(T,1,X-1);
        X := Pos(':',T);
        if (X > 0) and (Pos(';',T)>0)
          then Result := Trim(copy(T,X+1,Pos(';',T)-X-1));
      end;
    end;
  
  begin
    members := TStringList.Create;
  

  и дальше по коду добавлено обращение к функции

    if obj <> nil then
      clName := obj.ClassName
  {добавлено}
      else clName := GetClassFromCode;
  

  
  frxSynMemo
  добавлен параметр LastKey: word

  procedure TfrxSyntaxMemo.DoCodeCompletion(LastKey: word);
  
  
    function GetCompletionString: String;
    var
      i: Integer;
      s: String;
      fl1, fl2: Boolean;
      fl3, fl4: Integer;
    begin
      Result := '';
      s := LineAt(FPos.Y-1);
  //  который добавляется с строке S
      s := Trim(Copy(s, 1, FPos.X))+ Char(LastKey);
  

  
  frxSynMemo
  добавлена обработка нажатия точки после длинного CASE и обработки Ctrl

  procedure TfrxSyntaxMemo.KeyDown(var Key: Word; Shift: TShiftState);
  {..............}
    else
      MyKey := False;
    end;
  
    if (Key in [VK_DECIMAL,190,191]) and (Shift = []) and Assigned(FOnCodeCompletion) then begin
      Lan := GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, nil));
      if (Key = VK_DECIMAL)or
         ((Lan = 67699721) and (Key = 190)) or
         ((Lan = 68748313) and (Key = 191)) then begin
        DoCodeCompletion(VK_DECIMAL);
        MyKey := True;
      end;
    end;
  
    if Shift = [ssCtrl] then
  

  // добавлен параметр и ниже в этой же процедуре

  {......}
  else if Key = 32 then // Ctrl+Space code completion
      begin
        if Assigned(FOnCodeCompletion) then
          DoCodeCompletion(key);
        MyKey := True;
      end