FAQ VCL
Множества и перечисления

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как получить символьное представление элемента перечисления?

uses
  {...,} TypInfo;

type
  TTestEnum = (Val1, Val2, Val3, Val4);

procedure _GetEnumName(Val: TTestEnum);
begin
  ShowMessage(GetEnumName(TypeInfo(TTestEnum), Integer(Val)));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  _GetEnumName(Val3);
end;


Как проверить принадлежит ли элемент перечисления множеству?

type
  TSet = (s1, s2, s3, s4, s5);
  TSets = set of TSet;

implementation

procedure TForm1.Button1Click(Sender: TObject);
var
  set1: TSets;
begin
  set1 := [s1, s2, s3];
  if s1 in set1 then
    ShowMessage('Принадлежит')
  else
    ShowMessage('Не принадлежит');
end;


Как перебрать все элементы перечисления?

type
  TSet = (s1, s2, s3, s4, s5);

uses
  {...,} TypInfo;

implementation

procedure TForm1.Button1Click(Sender: TObject);
var
  i: TSet;
begin
  for i := Low(TSet) to High(TSet) do
    ShowMessage(GetEnumName(TypeInfo(TSet), Integer(i)));
end;


Как перебрать все элементы множества?

// Способ первый
type
  TSet = (s1, s2, s3, s4, s5);
  TSets = set of TSet;

uses
  {...,} TypInfo;

implementation

procedure TForm1.Button1Click(Sender: TObject);
var
  s: TSets;
  i: TSet;
begin
  s := [s1, s2];

  for i := Low(TSet) to High(TSet) do
    if TSet(i) in s then
      ShowMessage(GetEnumName(TypeInfo(TSet), Integer(i)));
end;

// Способ второй
type
  TSet = (s1, s2, s3, s4, s5);
  TSets = set of TSet;

uses
  {...,} TypInfo;

implementation

procedure TForm1.Button1Click(Sender: TObject);
var
  s: TSets;
  i: TSet;
begin
  s := [s1, s2];

  for i in s do
    ShowMessage(GetEnumName(TypeInfo(TSet), Integer(i)));
end;

// Способ третий
uses
  TypInfo;

function GetOrdValue(Info: PTypeInfo; const SetParam): Integer;
begin
  Result := 0;

  case GetTypeData(Info)^.OrdType of
    otSByte, otUByte:
      Result := Byte(SetParam);
    otSWord, otUWord:
      Result := Word(SetParam);
    otSLong, otULong:
      Result := Integer(SetParam);
  end;
end;

procedure SetOrdValue(Info: PTypeInfo; var SetParam; Value: Integer);
begin
  case GetTypeData(Info)^.OrdType of
    otSByte, otUByte:
      Byte(SetParam) := Value;
    otSWord, otUWord:
      Word(SetParam) := Value;
    otSLong, otULong:
      Integer(SetParam) := Value;
  end;
end;

function SetToString(Info: PTypeInfo; const SetParam; Brackets: Boolean): string;
var
  i: Integer;
  s: TIntegerSet;
  TypeInfo: PTypeInfo;
begin
  Result := '';

  Integer(s) := GetOrdValue(Info, SetParam);
  TypeInfo := GetTypeData(Info)^.CompType^;
  for i := 0 to SizeOf(Integer) * 8 - 1 do
    if i in s then
    begin
      if Result <> '' then
        Result := Result + ', ';
      Result := Result + GetEnumName(TypeInfo, i);
    end;
  if Brackets then
    Result := '[' + Result + ']';
end;

procedure StringToSet(Info: PTypeInfo; var SetParam; const Value: string);
var
  P: PChar;
  EnumInfo: PTypeInfo;
  EnumName: string;
  EnumValue, SetValue: Longint;

  function NextWord(var P: PChar): string;
  var
    i: Integer;
  begin
    i := 0;
    while not (P[i] in [',', ' ', #0, ']']) do
      Inc(i);
    SetString(Result, P, i);
    while P[i] in [',', ' ', ']'] do
      Inc(i);
    Inc(P, i);
  end;

begin
  SetOrdValue(Info, SetParam, 0);
  if Value = '' then
    Exit;

  SetValue := 0;
  P := PChar(Value);

  while P^ in ['[', ' '] do
    Inc(P);

  EnumInfo := GetTypeData(Info)^.CompType^;
  EnumName := NextWord(P);

  while EnumName <> '' do
  begin
    EnumValue := GetEnumValue(EnumInfo, EnumName);
    if EnumValue < 0 then
    begin
      SetOrdValue(Info, SetParam, 0);
      Exit;
    end;
    Include(TIntegerSet(SetValue), EnumValue);
    EnumName := NextWord(P);
  end;
  SetOrdValue(Info, SetParam, SetValue);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  s: string;
  FSASet: TFileSystemAttributes;
begin
  FSASet := [fsCaseSensitive, fsNetwork];
  s := SetToString(TypeInfo(TFileSystemAttributes), FSASet, True);
  ShowMessage(s);
end;


Как проверить равны ли 2 множества между собой?

// способ первый
type
  TSet = (s1, s2, s3, s4, s5);
  TSets = set of TSet;

implementation

procedure TForm1.Button1Click(Sender: TObject);
var
  set1, set2: TSets;
begin
  set1 := [s1, s2];
  set2 := [s2, s1, s3];
  if set1 = set2 then
    ShowMessage('Равны')
  else
    ShowMessage('Не равны');
end;

// способ второй
type
  TSet = (s1, s2, s3, s4, s5);
  TSets = set of TSet;

implementation

procedure TForm1.Button1Click(Sender: TObject);
var
  set1, set2: TSets;
begin
  set1 := [s1, s2];
  set2 := [s2, s1, s3];
  if set1 <> set2 then
    ShowMessage('Не равны')
  else
    ShowMessage('Равны');
end;


Как объединить элементы двух множеств?

type
  TSet = (s1, s2, s3, s4, s5);
  TSets = set of TSet;

implementation

procedure TForm1.Button1Click(Sender: TObject);
var
  set1, set2, res: TSets;
begin
  set1 := [s1, s2, s3];
  set2 := [s3, s4, s5];
  res := set1 + set2;
end;


Как из первого множества исключить элементы второго множества?

type
  TSet = (s1, s2, s3, s4, s5);
  TSets = set of TSet;

implementation

procedure TForm1.Button1Click(Sender: TObject);
var
  set1, set2, res: TSets;
begin
  set1 := [s1, s2];
  set2 := [s2, s3];
  res := set1 - set2;
end;


Как проверить, пересекаются ли 2 множества?

type
  TSet = (s1, s2, s3, s4, s5);
  TSets = set of TSet;

implementation

procedure TForm1.Button1Click(Sender: TObject);
var
  set1, set2: TSets;
begin
  set1 := [s1, s2];
  set2 := [s5, s3];
  if set1 * set2 <> [] then
    ShowMessage('Пересекаются')
  else
    ShowMessage('Не пересекаются');
end;


Как проверить принадлежат ли все элементы первого множества второму множеству?

type
  TSet = (s1, s2, s3, s4, s5);
  TSets = set of TSet;

implementation

procedure TForm1.Button1Click(Sender: TObject);
var
  set1, set2: TSets;
begin
  set1 := [s1, s2];
  set2 := [s2, s1, s3];
  if set1 <= set2 then
    ShowMessage('Все элементы первого множества входят во второе множество')
  else
    ShowMessage('Не все элементы первого множества входят во второе множество');
end;


Как проверить принадлежат ли все элементы второго множества первому множеству?

type
  TSet = (s1, s2, s3, s4, s5);
  TSets = set of TSet;

implementation

procedure TForm1.Button1Click(Sender: TObject);
var
  set1, set2: TSets;
begin
  set1 := [s1, s2, s3];
  set2 := [s2, s1];
  if set1 >= set2 then
    ShowMessage('Все элементы первого множества входят во второе множество')
  else
    ShowMessage('Не все элементы первого множества входят во второе множество');
end;

При использовании материала - ссылка на сайт обязательна