Есть ли какое-то изящное решение для инкрементирования переменной порядкового типа, когда по достижении крайнего из диапазона значений, принимается значение с противоположного края диапазона? К примеру, есть тип, включающий значения RED, YELLOW, BLUE. При инкрементировании значения BLUE надо что бы переменная принимала значение RED. При декрементировании, соответственно - наоборот.
Очень уж не хочется писать новую функцию под каждый новый тип. Дженерики не помогут - громоздкая конструкция получается.
Уважаемые авторы вопросов! Большая просьба сообщить о результатах решения проблемы на этой странице. Иначе, следящие за обсуждением, возможно имеющие аналогичные проблемы, не получают ясного представления об их решении. А авторы ответов не получают обратной связи. Что можно расценивать, как проявление неуважения к отвечающим от автора вопроса.
02-12-2018 08:39 | Комментарий к предыдущим ответам
To Geo:
>>> Оставаясь на D7, я теряю эти малозначимые для меня новшества
Для меня намного более важной проблемой является то, что TListView в режиме vsReport в D7 c пользовательской сортировкой временами становится пустым при работе на Windows 7 и старше. То есть данные есть, нажатия на кнопки из обрабатывают, но ничего не отображается. Тот же проект, собранные на Delphi 2006 работает. А поскольку у меня мал-помалу появляются среди пользователей люди с Windows 7 (старые компы с хрюшкой ломаются, приходится волей-неволей, но переходить на семёрку), то приходится с такой "фичей" считаться.
01-12-2018 00:24 | Комментарий к предыдущим ответам
Можно вообще-то воспользоваться директивой компилятора {$Z4} или {$MINENUMSIZE 4}, тогда размер перечислимого типа будет 4 байта. Но не суть. Снова про то что луше ;)
Простой пример
if A>B then Inc(MyColors) else Dec(MyColors);
или
if A>B then begin
if MyColor < High(MyColor) then Inc(MyColor) else MyColor:=Low(MyColor);
end
else begin
if MyColor > Low(MyColor) then Doc(MyColor) else MyColor:=High(MyColor);
end;
Код можно как угодно оформлять, может кому то не нравится привычное мне форматирование, но мне кажется, тут спорить даже не о чем какой вариант читается легче. В реале еще и строка кода, которая вместо функции будет копипастится, в результате легко получить ошибку из серии смотишь и в упор ее не видишь. Я предложил решение где вызов функции подлинее
if A>B then TOrd.Inc(MyColors) else TOrd.Dec(MyColors);
Это все равно гораздо читабелнее, ну а пример можно усложнять, хотя и этого самого простого примера на мой взгляд достаточно. Но я далее покакжу как сделать вариант просто с Inc(MyColors) и Dec(MyColors).
Снова лирическое отступление. В настоящий момент доступна абсолютно бесплатно Delphi 10.3. Я поставил сначала 10.2.3, а через пару дней 10.3. Это полнофункциональная версия равно Professional версии. Delphi7 и Delphi 10.3 прекрастно уживутся на одном копмютере. Можно же продолжать пользоваться семеркой. Но и посмотреть и пощупать, что дает последняя версия Delphi ведь тоже можно.
Итак, хочу предложить еще один вариант решения задачи. В Delphi уже доступно давно перерпределение операторов для записей. Как это нам может помочь? Очень просто. Можно легко перейти от исходного пречислимого типа с эквивалентному в виде записи, и переопределить для него операторы. Итак по порядку с примерами.У нас есть такой тип
TMyColors = (RED,YELLOW,BLUE);
Эквивалентный тип ему такой:
TRecMyColors=record
FValue:TMyColors
end;
Полностью эквивалентным он станет в случае, если мы определим операраторы для него, которые позволят проводить те же операции что и с перечислимым типом, и даже гораздо больше. Кончено если делать переопределение операторов для каждого типа, то это совсем не то что нам нужно. Но мы можем объявить дженерик рекорд и переопределить операции для дженерика. Вот так это примероно будет выглядеть.
TEnum<T> = record
private
class var ctx : TRttiContext;
FValue : T;
function getValue: T;
public
class operator Implicit (const a:string): TEnum<T>;
class operator Implicit (a:T ): TEnum<T>;
class operator Implicit (a:TEnum<T> ): T;
class operator Implicit (a:TEnum<T> ): string ;
class operator Inc (a: TEnum<T> ): TEnum<T>;
class operator Dec (a: TEnum<T> ): TEnum<T>;
property Value:T read getValue;
end;
implementation
{ TEnum<T> }
function TEnum<T>.getValue: T;
begin
Result:=FValue;
end;
class operator TEnum<T>.Implicit(a: TEnum<T>): string;
var ValueType:TRttiType;
ui8:uint8;
begin
ctx:=TRttiContext.Create;
ValueType:=ctx.GetType(TypeInfo(T));
if (ValueType.Handle^.Kind=tkEnumeration) then begin
Move(a.FValue,ui8,1);
Result:=GetEnumName(TypeInfo(T),ui8);
end;
end;
class operator TEnum<T>.Inc(a: TEnum<T>): TEnum<T>;
var rt : TRttiType;
Handle : PTypeInfo;
td : TTypeData;
Result_8 : uint8;
Result_16 : uint16;
Result_32 : uint32;
AddrEnumVar : Pointer;
ui8:uint8;
begin
ctx:=TRttiContext.Create;
rt:=ctx.GetType(TypeInfo(T));//результат может быть nil
Handle:=rt.Handle;
td:=rt.Handle^.TypeData^;
if not(rt.Handle^.Kind in [tkInteger, tkChar, tkEnumeration, tkWChar]) then raise Exception.Create( 'Not ordinal type');
case rt.TypeSize of
1: begin
Move(a.FValue,ui8,1);
Result_8:=(ui8+1);
if Result_8>td.MaxValue then Result_8:=td.MinValue;
Move(Result_8,Result.FValue,1);
end;
2: begin
end;
4:begin
end;
end;
end;class operator TEnum<T>.Dec(a: TEnum<T>): TEnum<T>;
begin
//тот же код что и для Inc, с соотвествующими заменами проверок и +1 на -1
end;
class operator TEnum<T>.Implicit(const a: string): TEnum<T>;
var ValueType:TRttiType;
i:int8;
begin
ctx:=TRttiContext.Create;
ValueType:=ctx.GetType(TypeInfo(T));//результат может быть nil
if (ValueType.Handle^.Kind=tkEnumeration) then begin
i:=GetEnumValue(TypeInfo(T),a);
if i<>-1 then Move(i,Result.FValue,1);
end;
end;
class operator TEnum<T>.Implicit(a: T): TEnum<T>;
var ValueType:TRttiType;
ui8:uint8;
begin
ctx:=TRttiContext.Create;
ValueType:=ctx.GetType(TypeInfo(T));
if (ValueType.Handle^.Kind=tkEnumeration) then begin
Move(a,Result.FValue,1);
end;
end;
class operator TEnum<T>.Implicit(a: TEnum<T>): T;
var ValueType:TRttiType;
ui8:uint8;
begin
ctx:=TRttiContext.Create;
ValueType:=ctx.GetType(TypeInfo(T));
if (ValueType.Handle^.Kind=tkEnumeration) then begin
Move(a.FValue, Result,1);
end;
end;
Так как кода получается многовато, то не делал большинства проверок на размер типов, например, все функции прописаны для однобайтных типов, также результатом запроса RTTI может быть nil, если тип не имеет RTTI, все эти проверки в "боевых" функциях кончено же надо делать. Немного о том какие операторы определены и зачем. Ну во-первых конечно же пара функций
class operator Implicit (a:T ): TEnum<T>;
class operator Implicit (a:TEnum<T> ): T;
Это позволяеят нам применять наш эквиваоентный тип вот так
type
TMyColors = (RED,GREEN,BLUE);
TMyNumbers = (I,II,III,IV,V,VI);
TColors = TEnum<TMyColors>;
TRomeNumbers = TEnum<TMyNumbers>;
var Clr:TColors;
RN :TRomeNumbers;
begin
Clr:=RED;// переменным эквивалентных типов присваиваются значения "исходных" пречислимых типов
RN:=III;
Соответсвенно пара функций
class operator Implicit (const a:string): TEnum<T>;
class operator Implicit (a:TEnum<T> ): string ;
позволяет преобразовывать в строку и обратно
var st:string;
begin
Clr:='BLUE';//Clr=BLUE
RN := IV;
st := RN; // st:='IV'
Ну и собственно процедуры Inc и Dec, теперь просто можно писать так
Inc(Clr);Inc(RN);
Можно определить все необходимые операторы и в результате в основной программе получть гораздо более читабельный и понятный код. Мною такой подход использовался для эмуляции битовых полей, которых все таки не хватает в Delphi, код модуля с типами, где переопределялись операции полился довольно внушительным конечно, но все это под капотом где то в модуле, в основном тексте программы зато ясность и простота.
27-11-2018 14:49 | Комментарий к предыдущим ответам
Когда я писал свои примеры, исходил из предположения, что переменные выровнены на адреса кратные четырем (у нас же 32-разрядный компилятор). С удивлением выяснил, что это не так, поэтому в процедуре
procedure IncEnum(var EnumValue; MaxValue : Integer);
var
IntVal : Integer absolute EnumValue;
begin
if IntVal < MaxValue then Inc(IntVal) else IntVal:=0;
end;
есть две дыры, могущие приводить к ошибкам: сравнение и обнуление.
Сразу добавлю, что я сторонник разумной универсальности, а не абсолютной. Поэтому если у автора стоит проблема инкремента перечислений, то не будем делать единую универсальную процедуру для инкремента всех упорядоченных типов. А так как перечисления всегда начинаются с нуля, значит отрицательные значения нам не нужны, и можно перейти от знаковых типов к беззнаковым. С учетом этого перепишем процедуру так:
procedure IncEnum(var EnumValue; MaxValue : LongWord);
var
IntVal : LongWord absolute EnumValue;
Mask : LongWord;
begin
if MaxValue <= $FF
then
Mask:=$FF
else if MaxValue <= $FFFF
then
Mask:=$FFFF
else if MaxValue <= $FFFFFF
then
Mask:=$FFFFFF
else
Mask:=$FFFFFFFF;
if (IntVal and Mask) < MaxValue then Inc(IntVal) else IntVal:=(IntVal and (not Mask));
end;
По максимальному значению определяем, сколько байт занимает наше перечисление и маскируем лишнее. Правда детальное тестирование показало, что на практике (в D7) все же имеется выравнивание переменных на четный адрес, так что переменная типа перечисление может занимать либо два, либо четыре байта, соответственно, код можно упростить. Ну да бог с ним. Снова повторюсь, что, по моему личному мнению, наиболее оптимальным будет вот такой вариант:
if MyColor < High(MyColor) then Inc(MyColor) else MyColor:=Low(MyColor);
так как он прост, компактен и легко читаем. И никаких процедур не надо.
Теперь по "лирическим отступлениям"
>>> я вообще директивой absolute не пользовался раньше и дальше не буду
Дело ваше, конечно же. Но.... Паскаль — язык со строгой типизацией данных. И если в прикладном программировании это благо, то в системном зачастую создает определенные трудности. И это ограничение приходится обходить. Навскидку назову четыре способа:
1. Приведение типов.
2. Переход к указателям.
3. Запись с вариантами.
4. Использование директивы absolute.
И именно использование четвертого варианта позволяет получить наиболее простой код. Естественно, применение этой директивы (как и любого другого низкоуровневого механизма) требует понимания и аккуратности.
>>> Вообще со времен семерки столько вкусного добавлено в язык, что я не понимаю как на ней можно до сих пор сидеть.
Во-первых, по работе я не программист и кодированием на Delphi не занимаюсь. Использую же Delphi в том случае, когда нужно соорудить для себя какую-нибудь утилитку (лень работать руками). Ну, или для развлечения (игрушку какую-нибудь написать). Из всего, что было добавлено после D7 мне очень не хватает только юникода в VCL (появился то ли в Delphi 2009, то ли в Delphi 2010). Остальное (на мой взгляд) либо сахар, либо способ для криворукого программиста несколько компенсировать криворукость. Про кросс-платформенность же я вообще лучше промолчу. Оставаясь на D7, я теряю эти малозначимые для меня новшества, но зато имею легкую IDE, быстрый компилятор и небольшой результирующий выполняемый файл.
Вполне допускаю, что если работать в команде над большим проектом, то лучше будет использовать последние версии Delphi.
21-11-2018 16:56 | Комментарий к предыдущим ответам
>>>Как учит нас жизнь, если начальство дает срочную задачу, не спеши ее делать: возможно, завтра ее изменят или вообще отменят.
Про начальство соглашусь, но нас то сюда всех не начальство пригнало :). Вопрос заданный автором для меня интересный, так что все в порядке :)
>>>я работаю с однобайтовой переменной через четырехбайтный Integer, проблем быть не должно
Сразу скажу, то что в процедуру закралась ошибка я понял проверив ее в приложении, а не просто глядя на текст, у меня не настолько глаз наметан чтобы такие вещи сходу обнаруживать, я вообще директивой absolute не пользовался раньше и дальше не буду.Еще раз посмотрим на процедуру
procedure IncEnum(var EnumValue; MaxValue : Integer);
var
IntVal : Integer absolute EnumValue;
begin
if IntVal < MaxValue then Inc(IntVal) else IntVal:=0;
end;
Вы работаете не с однобайтной переменной. Локальная переменная IntVal является четырехбайтной и работаете вы именно с ней, а именно производите операцию сравнения, инкремента и присваивания. Адрес этой переменной просто совпадает с той однобайтной переменной, инкремент которой нас интересует. Но сравниваются то все 4 байта а не один поэтому результат зависит еще и от 3-х других байтов. Поэтому передавать в процедуру надо еще и значение которое наша инкрементируемая переменная занимает в памяти. Просто перечислимый тип больше 2-х байт это конечно нонсенс, а вот 2 байта вполне возможно.Далее
class procedure TEnumHelper.EnumInc<T>(var EnumVar: T);
begin
if EnumVar < High(T) then Inc(EnumVar) else EnumVar:=Low(T);
end;
Такой код компилятор не пропустит. Дженерики это не шаблоны из С++ . Самое существенное отличие в том, что в коде дженерика вы можете использовать только те операции, которые применимы к любому типу.
По поводу синтаксиса вызова
TEnumHelper.EnumInc<TMyColors>(@Clr,Clr);
TEnumHelper.EnumInc<TSub100i>(@S100i,S100i);
Вот так наприсать можно, но не необходимо, более того дженерик специально был так сконструирован, чтобы можно было сделать процедуру полиморфной и не надо было в явном виде писать тип аргументов, иначе она просто не нужна. Я не заострял тут внимание, но вообще то что там два аргумента а не один это косяк. Действительно правильный жденерик должен был бы быть таким
class procedure TEnumHelper.EnumInc<T>(var EnumVar: T);
begin
//тут код , который в прошлом посте
end;
Но при таком описании вызов должен быть таким
TEnumHelper.EnumInc<TMyColors>(Clr);
Т.е. необходимо явно указать тип при вызове, что нас категорически не устраивает и сводит ценность такой дженерик функции к нулю. Эта давняя проблема обсуждалась давно https://stackoverflow.com/questions/5592713/delphi-generic-type-inference-of-reference-argument (я не разобрался как оформить ссылку :( ) . Так вот буквально вчера я проверил код в последней доступной мне версии Delphi 10.2.2 и вуаля! Оказывается старый баг уже пофикшен. Огорд городить с двумя параметрами необходимо чтобы, в первом параметре адрес передать, а втором информацию о типе. Но в последней версии можно переписать все так
unit Unit1;
interface
uses TypInfo,RTTI;
type
TOrdExt = class
private
class var ctx:TRttiContext;
public
class procedure EnumInc<T>(var EnumVar: T);
end;
implementation
{ TOrdExt }
class procedure TOrdExt.EnumInc<T>(var EnumVar: T);
var rt : TRttiType;
Handle : PTypeInfo;
td : TTypeData;
Result_8 : uint8;
Result_16 : uint16;
Result_32 : uint32;
AddrEnumVar : Pointer;
begin
ctx:=TRttiContext.Create;
rt:=ctx.GetType(TypeInfo(T));
Handle:=rt.Handle;
td:=rt.Handle^.TypeData^;
AddrEnumVar:= @EnumVar;
if not(rt.Handle^.Kind in [tkInteger, tkChar, tkEnumeration, tkWChar]) then raise Exception.Create( 'Not ordinal type');
case rt.TypeSize of
1: begin
Result_8:=(PByte(AddrEnumVar)^+1);
if Result_8>td.MaxValue then Result_8:=td.MinValue;
Move(Result_8,PByte(AddrEnumVar)^,1);
end;
2: begin
Result_16:=(PWord(AddrEnumVar)^+1);
if Result_16>td.MaxValue then Result_16:=td.MinValue;
Move(Result_16,PByte(AddrEnumVar)^,2);
end;
4:begin
Result_32:=(PInteger(AddrEnumVar)^+1);
if Result_32>td.MaxValue then Result_32:=td.MinValue;
Move(Result_32,PByte(AddrEnumVar)^,4);
end;
end;
end;
Вызов теперь такой
type
TMyColors = (RED,YELLOW,BLUE);
TSub100i = -50..49;
var
Clr : TMyColors;
S100i : TSub100i;
begin
Clr := BLUE;
TOrdExt.Inc(Clr);
S100i:=49;
TOrdExt.Inc(S100i);
end.
Переименовал класс содержащий дженерик, так как Helper может ввести в заблуждение и лучще использовать таки для хелперов :), ну и имя процедуры можно использовать покороче, так как она все же метод класса и путаницы с System.Inc не должно быть. Кстате небольшое лирическое отступление Delphi 10.2 теперь доступна в Community Edition которая равна Professional но можно получить ее бесплатно, просто надо зарегестрироваться и оформить запрос. Правда у меня пока не получилось установить ее ), инсталятор качает данные сам и почему то ему нужен Direct X и на этом месте у меня все обрывается, не получилось установить на 3-х разных компьютерах :( . Но думаю это победимо. Главное что Embarcadero дает полнофункциональную версию и не на 30 дней как раньше, а на год как минимум (лицензия на год), долгожданный шаг, наконец то! Так что можно поставить себе последнюю Dlphi и попоробовать тот код который я привел, он рабочий уверяю вас ). Вообще со времен семерки столько вкусного добавлено в язык, что я не понимаю как на ней можно до сих пор сидеть.
А теперь отвечу на вопрос про универсальность и про то как лучше. Давайте посмотрим. У нас есть такой вариант
if MyColor < High(MyColor) then Inc(MyColor) else MyColor:=Low(MyColor);
Можно написать процедуру инкремента и, например, пусть мы знаем, что размер не превысит байта, то в функцию не надо передавать размер тогда вызов такой:
IncEnum(MyColor,Ord(High(MyColor)));
Тут дело вкуса, но я бы все же предпочел прцедуру, единственно жесткое ограничение на размер типа меня бы сильно коробило, поэтому сделал бы еще вариант с передаваемым размером, тогда вызов такой
Длинновато уже конечно. Ну а теперь в погоне за универсальностью добавим корме максимального значения будем передавать еще и минимальное тогда вызов такой:
Ну да тут в пору замахать руками и сказать, что не надо нам никакой универсальности ) . Теперь посмотрим вариант с RTTI
OrdExt.Inc(MyColor);
Напомню тут нужда последняя версия Delphi. Работает для всех ординарных типов, универсальность их коробки, просто потому, что код подходит для всех ординарных типов.
Кстати есть еще одно решение задачи, вызовы там могут быть такие MyColor.Inc . Решение довольно спорное сразу скажу. Но возможно кому то будет интересно (может и мне будет, тогда точно сделаю :D)
20-11-2018 01:44 | Комментарий к предыдущим ответам
Как учит нас жизнь, если начальство дает срочную задачу, не спеши ее делать: возможно, завтра ее изменят или вообще отменят.
Грамотно выдержанная пауза позволила не тратить время на доказательство универсальности :-)
Продолжим по остальным пунктам.
Никто не собирался делать пистолет, из которого было бы невозможно прострелить себе ногу. Обычно ограничиваются тем, что мешают прострелить себе ногу случайно. А от дурака с админскими правами защиты не существует.
Излишняя универсальность так же плоха, как и узкая заточенность. По постановке задачи требовалась работа с перечислимыми типами (причем, без явного задания значения). Обобщить на все упорядоченные типы можно, конечно, но стоит ли?
А если не обобщать, то даже если я работаю с однобайтовой переменной через четырехбайтный Integer, проблем быть не должно. Перечислимый тип принимает значения 0..N. Предложенный мной код не выходит за пределы данного отрезка, то есть все изменения будут касаться только младшего байта (младших байт), и никак не изменят остальные три. Кстати, я пребывал в уверенности, что компилятор выравнивает переменные на 4-байтную границу.
Насчет подключения RTTI. Код растет в объеме, падает безопасность. Когда это важно для проекта в целом, то понятно. Но когда нужно всего лишь отдельные (не особо важные) действия упростить... Я сразу вспоминаю одного знакомого прикладного программиста: он к небольшой утилитке, анализирующей сообщения на форуме добавил джедаевскую библиотеку. Только потому, что у джедаев была готовая функция парсинга даты.
Про дженерики. Не изучал. Проверить тоже негде, так как максимальная из доступных мне версий Delphi — Семерка. Но после просмотра некоторых примеров в интернете возник вопрос: синтаксис использования правильный? Не требуется разве писать так:
? И если я прав насчет синтаксиса, то почему тогда не написать проще
unit Unit1;
interface
uses TypInfo,RTTI
type
TEnumHelper = class
public
class procedure EnumInc<T>(var EnumVar: T);
end;
implementation
{ TEnumHelper }
class procedure TEnumHelper.EnumInc<T>(var EnumVar: T);
begin
if EnumVar < High(T) then Inc(EnumVar) else EnumVar:=Low(T);
end;
И безо всяких RTTI
Ну и главный момент. Вариантов я все же предложил два. И чем плох второй вариант:
type
TMyColors = (RED,YELLOW,BLUE);
var
MyColor : TMyColors;
begin
if MyColor < High(MyColor) then Inc(MyColor) else MyColor:=Low(MyColor);
19-11-2018 03:23 | Комментарий к предыдущим ответам
В своем предыдущем ответе я поторопился написать, что предложенные решения не универсальны. Собственно предложение было одно от Geo, а Александр Малыгин предложил как лаконично можно описать "заворот", ну и плюс Python c Александром Малыгиным категорично написали мол нельзя в Delhi. Ну как же нельзя, если очень даже можно! И даже без RTTI. В предложении Geo закралась ошибка, которую не заметили, я тоже в уме прикинув решил, что тут RTTI надо, хотя можно и без него. Дело в чем. Напрямую приведенная функция не будет правильно работать, вернее так, она иногда может работать и правильно но в общем случае, конечно, нет. Локальная переменная IntVal имеет размер 4 байт, а накладывается на нее переменная размером 1 байт, так как в примере размер типа 1 байт, хотя в общем случае размер типа может быть и 2 и 4. Поэтому что там будет за значение у локальной переменной, когда размер EnumValue 1 или 2 зависит от случая. Я сходу решил, что просто узнаем в рантайме размер типа + хотел показать, что все ординарные типы по большому счету для компилятора одно и то же, и могут отличатся лишь MinValue и MaxValue. Можно написать что то типа такого чтобы исправить
procedure IncEnumU8(var EnumValue; MaxValue : Integer);
var
IntVal : uint8 absolute EnumValue;
begin
if IntVal < MaxValue then Inc(IntVal) else IntVal:=0;
end;
procedure IncEnumU16(var EnumValue; MaxValue : Integer);
var
IntVal : uint16 absolute EnumValue;
begin
if IntVal < MaxValue then Inc(IntVal) else IntVal:=0;
end;
procedure IncEnumU32(var EnumValue; MaxValue : Integer);
var
IntVal : uint32 absolute EnumValue;
begin
if IntVal < MaxValue then Inc(IntVal) else IntVal:=0;
end;
procedure IncEnum(var EnumValue; SizeType,MaxValue : Integer);
begin
case SizeType of
1:IncEnumU8(EnumValue,MaxValue);
2:IncEnumU16(EnumValue,MaxValue);
4:IncEnumU32(EnumValue,MaxValue);
end;
end;
В общем, не смотря на длинный вызов, на самом деле вполне универсальное решение и даже если поменяется тип то ничего в тексте программы менять даже не надо будет. А если добавить в параметры функций кроме MaxValue еще и MinValue, то можно использовать эти процедуры также и для диапазонных типов и тех же Char и Wchar . Если же применять RTTI, то можно написать дженерик такого вида
var
MyColor : TMyColors;
begin
IncEnum(@MyColor,MyColor);
В общем приведу все таки вариант с применением RTTI, так как все таки накатал вариант с RTTI для сравнения.
unit Unit1;
interface
uses TypInfo,RTTI
type
TEnumHelper = class
class var ctx:TRttiContext;
public
class procedure EnumInc<T>(AddrValue: pointer; Value: T);
end;
implementation
{ TEnumHelper }
class procedure TEnumHelper.EnumInc<T>(AddrValue: pointer; Value: T);
var rt : TRttiType;
Handle : PTypeInfo;
td : TTypeData;
Result_8 : uint8;
Result_8 : int8;
begin
ctx:=TRttiContext.Create;
rt:=ctx.GetType(TypeInfo(T));
Handle:=rt.Handle;
td:=rt.Handle^.TypeData^;
if not(rt.Handle^.Kind in [tkInteger, tkChar, tkEnumeration, tkWChar]) then raise Exception.Create( 'Not ordinal type');
Size:=td.MaxValue+1;
case rt.TypeSize of
1: begin
Result_8:=(PByte(AddrValue)^+1);
if Result_8>td.MaxValue then Result_8:=td.MinValue;
Move(Result_8,PByte(AddrValue)^,1);
end;
2: begin
Result_16:=(PWord(AddrValue)^+1);
if Result_16>td.MaxValue then Result_16:=td.MinValue;
Move(Result_16,PByte(AddrValue)^,2);
end;
4:begin
Result_32:=(PInteger(AddrValue)^+1);
if Result_32>td.MaxValue then Result_32:=td.MinValue;
Move(Result_32,PByte(AddrValue)^,4);
end;
end;
end;
end.
Пример вызова вот
type
TMyColors = (RED,YELLOW,BLUE);
TSub100i = -50..49;
var
MyColor : TMyColors;
Sub100i : TSub100i;
begin
Clr := BLUE;
TEnumHelper.EnumInc(@Clr,Clr);
S100i:=49;
TEnumHelper.EnumInc(@S100i,S100i);
end.
Результат будет верным можно проверить. В общем с применением RTTI список параметров покороче, плюс внутри функции делается проверка на соответствие типа, чего без RTTI точно никак. Ногу конечно, все еще можно отстрелить, передав в качестве первого параметра какой нибудь "левый" адрес, но тут параметры такие что предается просто адрес переменной и сама переменная, запутаться сложнее чем в варианте без RTTI c обилием скобок.
18-11-2018 23:59 | Комментарий к предыдущим ответам
Совершенно точно для перечислимых типов есть способ сделать циклическое "заворачивание" и если рассмотреть задачу шире то это можно сделать и для Subrange Types, Char и WChar. Да, в том случае когда программистом используется такая фенька как явно заданные значения перечисляемого типа то задачу решить нельзя. Но, но я например, не вижу причин не написать процедуру если она необходима и упрощает жизнь из за такого несущественного ограничения.
Приведенные решения конечно позволяют решить задачу. Но что делать если изначально имели такой тип:
type TMyColors = (RED,YELLOW,BLUE);
а потом поняв, что трех цветов мало решили добавить четвертый :)
type TMyColors = (RED,YELLOW,BLUE,GREEN);
По всему тексту править вызовы процедуры?
Задача достаточно элегантно может быть решена с использованием RTTI. Не вижу где тут стрельба из пушки по воробьям. Если реально в программе интенсивно используются это самое циклическое "заворачивание" да еще для разных типов то гораздо лучше иметь для этого соответствующую универсальную процедуру, в которую не надо подставлять размер перечислимого типа, особенно если в программе таких типов много.
Что мне позволяет утверждать, что задачу можно решить в общем виде? Посмотрите на структуру TTypeKind из модуля System.TypeIfo. Для всех типов в программе при включенном RTTI хранится информация о типе в виде этой структуры. Так как структура очень длинная, я приведу тот фрагмент который нам интересен:
case TTypeKind of
tkUnknown: ();
tkUString,
{$IFNDEF NEXTGEN}
tkWString,
{$ENDIF !NEXTGEN}
tkVariant: (AttrData: TAttrData);
{$IFNDEF NEXTGEN}
tkLString: (
CodePage: Word
{LStrAttrData: TAttrData});
{$ENDIF !NEXTGEN}
tkInteger,
{$IFNDEF NEXTGEN}
tkChar,
{$ENDIF !NEXTGEN}
tkEnumeration, tkSet, tkWChar: (
OrdType: TOrdType;
case TTypeKind of
tkInteger, tkChar, tkEnumeration, tkWChar: (
MinValue: Longint;
MaxValue: Longint;
case TTypeKind of
tkInteger, tkChar, tkWChar: ();
tkEnumeration: (
BaseType: PPTypeInfo;
NameList: TSymbolName;
{EnumUnitName: TSymbolName;
EnumAttrData: TAttrData}));
...
Мы можем видеть, что ординарных типов TOrdType, а именно tkInteger, tkChar, tkEnumeration, tkWChar хранится их MinValue и MaxValue. Собственно это и есть ключ к определению размера типа на этапе выполнения и модификации уже предложенных вариантов так, чтобы не надо было передавать в процедуру размер типа в явном виде.
Кстати что касается Enumerated Types with Explicitly Assigned Ordinality
type Size = (Small = 5, Medium = 10, Large = Small + Medium);
или
type TMyColors1 = (RED1=1,YELLOW1,BLUE1);
то это для компилятора как бы и не тип на самом деле, во всяком случае для таких типов не генерируется RTTI. Таким образом, так как внутри процедуры все равно необходимо делать проверку на соответствие типов, то можно для таких вот "типов" просто генерировать исключение.
18-11-2018 01:36 | Комментарий к предыдущим ответам
>>> от Geo вообще не ожидал, что он забудет про такую фичу языка
Geo не забыл про такую фичу языка, хитрый Geo в самом начале своего ответа написал:
"Если не использовать никаких выкрутасов, то объявление перечислимого типа..."
и дальше указал, какое именно объявление ;-) Перечисления с явно заданными значениями — это уже выкрутас, польза которого сомнительна, а геморрой вполне реален.
>>> можно также сделать второй параметр тоже нетипизированным
Насколько я помню, нетипизированный параметр можно передавать только по ссылке. И если для самой переменной, значение котрой нужно увеличить, это оправдано, то держать еще и переменную для хранения максимального значения перечислимого типа — это уже перебор.
>>> Чтобы получить периодичность функции сложения в общем случае, очень удобно использовать операцию mod взятие остатка от деления
Кратко и красиво. Просто во мне еще до сих пор сидят навыки программирования на асме процессора 8066/88. А там операции деления и умножения были очень дорогими по количеству тактов (разница с сравнением и инкрементом на порядок). Вот и осталась привычка их избегать :-)
Всем комментаторам (от Geo вообще не ожидал, что он забудет про такую фичу языка): увы, но есть такая фенька как явно заданные значения перечисляемого типа (перевод мой - я не встречал на русском общепринятого варианта, так что идите по ссылке, если непонятно, что я имел в виду). Так вот: для такого типа, который указан в примере по ссылочке работать не будет вообще ничего. Кстати, inc и dec для таких типов весьма даже странно работают (с точки зрения программиста, конечно, можно посмотреть в подводных камушках, но вроде там ничего подобного нет).
Вывод: НЕТ, для перечислимых типов никакого способа сделать циклическое "заворачивание" нет и быть не может. С точки зрения компилятора, значения перечислимого типа - это просто константы целого типа. Изначально в сишечке перечисления именно так и задавали - через #define кучи констант, потом появились static const int, ну и в конце пришли к тем же enum, которые имеют те же проблемы, что и константы, но и так сойдёт .
PS: в варианте Geo можно также сделать второй параметр тоже нетипизированным, тогда "лишний" Ord можно будет опускать. Безопасность кода будет... гм... как показано выше.
16-11-2018 15:23 | Комментарий к предыдущим ответам
Удовлетворительного ответа на вопрос автора я не дам, потому что в рамках Delphi его не существует. Возможны только компромиссы. Всё самое ценное уже написал Geo.
У меня есть замечание по методу "заворачивания" инкремента для целых чисел.
Чтобы получить периодичность функции сложения в общем случае, очень удобно использовать операцию mod взятие остатка от деления.
Если известен размер диапазона Size, то автоматическое заворачивание (без проверки условия) выглядит так:
Result := (Source + 1) mod Size;
Операция mod Size любой (неотрицательный) аргумент приведёт к диапазону 0..Size-1, и этим свойством очень удобно пользоваться для перевода линейной функции в периодическую.
Есть два интересных следствия:
1) какое бы значение инкремента мы не прибавили к исходному числу, результат останется в нужном диапазоне;
2) прибавление N*Size не изменит результат;
3) прибавление Size-1 реализует декремент.
Для отрицательных чисел результат будет в диапазоне -Size+1..0
Это не очень удобно для декремента. Но следствие №2 подсказывает, как спасти ситуацию:
Result := (Source - 1 + Size) mod Size;
Универсальная функция может выглядеть так:
function IncWrap(SrcValue,Size,IncValue : integer) : integer;
begin
result := (SrcValue + (IncValue mod Size) + Size) mod Size;
end;
В частности, я всегда использую mod при организации кольцевого буфера.
Если не использовать никаких выкрутасов, то объявление перечислимого типа
type
TMyColors = (RED,YELLOW,BLUE);
приводит у заданию для каждого элемента целочисленного значения, идущего по порядку, начиная с нуля: RED = 0, YELLOW = 1, BLUE = 2. Количество элементов в перечислении в run-time недоступно, а все варианты использования псевдофункций High и Low обрабатываются на этапе компиляции.
Отсюда вывод, написать подпрограмму, выполняющую инкремент переменной перечислимого типа можно, но нужно будет туда кроме самой переменной передавать еще и значение максимального элемента (для проверки и зацикливания).
Есть еще одна сложность при реализации такой универсальной подпрограммы на Delphi — строгая типизация языка, характерная для языков Pascal-Delphi. Обойти можно с переходом к указателям и адресам, но не хочется. Однако есть еще вариант передачи в подпрограмму по ссылке нетипизированного парметра. По-моему, это будет легче читать.
Отсюда вытекает и вариант реализации. Будем разрабатывать процедуру (чтобы не мучится с типом возвращаемого функцией значения). В процедуру будем передавать по ссылке переменную, значение которой нужно увеличить, а также целочисленное значение, соответствующее максимальному значению переменной соответствующего типа. Повозившись, сочинил нечто вот такое:
procedure IncEnum(var EnumValue; MaxValue : Integer);
var
IntVal : Integer absolute EnumValue;
begin
if IntVal < MaxValue then Inc(IntVal) else IntVal:=0;
end;
Вызов будет несколько корявым. Используем объявление типа в начале этого сообщения. Тогда:
var
MyColor : TMyColors;
begin
IncEnum(MyColor,Ord(High(TMyColors))); // вызываем так
IncEnum(MyColor,Ord(High(MyColor))); // или даже так
{ Но что-то мне подсказывает, что овчинка выделки не стоит,
ведь то же самое можно написать безо всякого гемора вот так }
if MyColor < High(MyColor) then Inc(MyColor) else MyColor:=Low(MyColor);
{ количество символов ненамного больше, чем в вызове процедуры :-) }
Можно еще рассмотреть варианты:
1. С подключением RTTI к проекту.
2. С использованием объектов для перечислимых типов.
Но это уже будет вообще стрельба из пушки по воробьям.
Если вы заметили орфографическую ошибку на этой странице, просто выделите ошибку мышью и нажмите Ctrl+Enter. Функция может не работать в некоторых версиях броузеров.
