powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Подскажите вариант CASE ... OF с условиями
25 сообщений из 58, страница 2 из 3
Подскажите вариант CASE ... OF с условиями
    #39796721
Василий 2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
А для перебора строк юзал такое
Код: pascal
1.
2.
3.
4.
5.
6.
case IndexStr(str, ['foo', 'bar', '..']) of
  0: // foo
  1: // bar
  ...
  -1: // not found
end


Но это редкость, обычно такие наборы типизированы и тогда
Код: pascal
1.
2.
3.
4.
5.
6.
case TSomeEnum(IndexStr(str, SomeEnumValues)) of
  seFoo: // foo
  seBar: // bar
  ...
  else // not found
end
...
Рейтинг: 0 / 0
Подскажите вариант CASE ... OF с условиями
    #39796730
--= Eagle =--
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Делал для себя, надеюсь поможет:
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
function StringCase(Value: String; Cases: array of String; CaseSensitive: Boolean = False): Integer;
var
  I: Integer;
  Matches: Boolean;

begin
  Result := -1;
  if not CaseSensitive then
    Value := UpperCase(Value);
  for I := 0 to Length(Cases) - 1 do
  begin
    if CaseSensitive then
      Matches := Cases[I] = Value
    else
      Matches := UpperCase(Cases[I]) = Value;
    if Matches then
    begin
      Result := I;
      Exit;
    end;
  end;
end;


procedure Test();
begin
  case StringCase(ParamStr(0), ['/Help', '/Start', '/Wait']) of
    0: ActionHelp();
    1: ActionStart();
    2: ActionWait();
  end;
end;
...
Рейтинг: 0 / 0
Подскажите вариант CASE ... OF с условиями
    #39796732
Vizit0r
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
FoxpcЧё уж? Давайте пировать!

ну давайте.

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
  TGumpNumElement = (gne_noclose,
                     gne_nodispose,
                     gne_nomove,
                     gne_noresize,
                     gne_group,
                     gne_endgroup,
//тут еще три десятка вариантов
                     gne_echandleinput);

....

    case TGumpNumElement(GetEnumValue(TypeInfo(TGumpNumElement), 'gne_'
                                      +LowerCase(CommandName))) of
      gne_noclose   : fNoClose := true;
      gne_group     :   begin
                          //код
                          fGroups.Add(Group);
                        end;
//и так все элементы
  end; 



из рабочего кода, кстати. Каких только извращений там нет...
...
Рейтинг: 0 / 0
Подскажите вариант CASE ... OF с условиями
    #39796734
rgreat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Зачем так сложно-то?

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
  if FindCmdLineSwitch('Help') then begin
    Exit;
  end;
  if FindCmdLineSwitch('Start') then begin
    Exit;
  end;
  if FindCmdLineSwitch('Wait') then begin
    Exit;
  end;

И все.
Exit-ы - опциональны.
...
Рейтинг: 0 / 0
Подскажите вариант CASE ... OF с условиями
    #39796773
Фотография roschinspb
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Artem.1st...
Уважаемые гуру, как вы оформляете такой Delphi код?
1. Во всех непонятных случаях по оформлению кода см. исходники.
2. Автоформатировщик (Ctrl+D) по умолчанию обычно дает приемлемый результат. Единственное, надо поставить Line Breaks/Right margin = 120 (80 по умолчанию это ни в какие ворота не лезет)
3. По стандартам положено так
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
if xxx = yyy then
  Write('aaa')
else if (xxx < yyy) or (xxx = 12312) then
begin
  Write('bbb');
  Writeln('zzz');
end 
else if  (xxx >= yyy) and ((yyy = 3456) or (xxx = 777)) {длинное условие} and 
  (Messagebox(Question) = mrYes) then
begin
  Writeln('Ok');
  Exit;
end
else
  Writeln('Ok');
...
Рейтинг: 0 / 0
Подскажите вариант CASE ... OF с условиями
    #39796810
pvv.pas
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Artem.1st High.Programer ,
For..In использвоать боюсь, т.к. в детстве не приучили
:-)

zinpub, DimaBr ,
спасибо за идею. Проблема String для Case..OF решается, хотя для более сложных условий придется выстраивать многочисленные if then.
Похоже, не только в Delphi, я посмотрел в других языках C++, Java также "Switch" не помогает
:-(
Для сложной логики обработки входных данных придуманы конечные автоматы. Я обычно строю либо на бинарном сбалансированном дереве, либо на боре Ахо-Корасика, где ключ - состояние, данные - метод обработки. Для твоего случая, думаю и хеш-таблица вполне сойдёт, т.к. у тебя, насколько я понимаю, входные данные предполагают одно состояние
...
Рейтинг: 0 / 0
Подскажите вариант CASE ... OF с условиями
    #39796813
Фотография defecator
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Модератор форума
а я пользуюсь библиотекой GpCommandLineParser от Primoz Gabrijelcic
В ней можно разбирать командные строки любой сложности

вот так это выглядит в прикладом коде
ничего парсить не надо от слова совсем

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
type
    TCommandLine = class
    strict private
      { опции компиляции }
 	    FIndexCheck    : Boolean ;
      FOverflowCheck : Boolean ;
      FTypeCheck     : Boolean ;
		  FClearCheck    : Boolean ;
      FInputFile     : string  ;
      FPascalCompiler: Boolean ;
    public
      constructor Create ;

      [CLPName('i'), CLPLongName('Index check', 'Index check'),
       CLPDescription('Enable Index range check code generation')]
      property IndexCheck : Boolean read FIndexCheck write FIndexCheck ;

      [CLPName('o'), CLPLongName('Overflow check', 'Overflow check'),
       CLPDescription('Enable Overflow check code generation')]
      property OverflowCheck : Boolean read FOverflowCheck write FOverflowCheck ;

      [CLPName('t'), CLPLongName('Type check', 'Type check'),
       CLPDescription('Enable strong type check')]
      property TypeCheck : Boolean read FTypeCheck write FTypeCheck ;

      [CLPName('c'), CLPLongName('Clear check', 'Clear check'),
       CLPDescription('Enable clear checking')]
      property ClearCheck : Boolean read FClearCheck write FClearCheck ;

      [CLPName('p'), CLPLongName('Pascal syntax', 'Pascal syntax'),
       CLPDescription('Pascal syntax use')]
      property PascalCompiler : Boolean read FPascalCompiler write FPascalCompiler ;

      [CLPPosition(1), CLPDescription('Input file'), CLPLongName('input_file'), CLPRequired]
      property InputFile : string read FInputFile write FInputFile;
    end ;

constructor TCommandLine.Create ;
begin
     Inherited Create ;

     FIndexCheck    := False ;
     FOverflowCheck := False ;
     FTypeCheck     := False ;
     FClearCheck    := False ;
     FInputFile     := '' ;
end ;

var
   cl : TCommandLine;

begin
     cl := TCommandLine.Create;
     try
        try
            parsed := CommandLineParser.Parse(cl);

            if not parsed then
             begin
                  writeln(Format('%s, position = %d, name = %s',
                          [CommandLineParser.ErrorInfo.Text, CommandLineParser.ErrorInfo.Position,
                          CommandLineParser.ErrorInfo.SwitchName])
                         );

                  for S in CommandLineParser.Usage
                   do Writeln(s);

                  Exit;
             end;

            SourceFileName := cl.InputFile ;
            if not FileExists(SourceFileName) then
             begin
                  writeln('filename '+SourceFileName+' not found') ;
                  Exit;
             end ;

            if cl.PascalCompiler
             then Compiler := TPascalCompiler.Create(SourceFileName, 0)
             else Compiler := TOberonCompiler.Create(SourceFileName, 0) ;

            try
               try
                  Compiler.IsNoGUICompiler := True ;
                  { опции }
                  Compiler.IndexCheck    := cl.IndexCheck ;
                  Compiler.OverflowCheck := cl.OverflowCheck ;
                  Compiler.TypeCheck     := cl.TypeCheck ;
                  Compiler.ClearCheck    := cl.ClearCheck ;

...
Рейтинг: 0 / 0
Подскажите вариант CASE ... OF с условиями
    #39796815
Фотография defecator
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Модератор форума
а вот так выглядит вывод, если никаких параметров не указать
И мной не написано ни строчки кода
...
Рейтинг: 0 / 0
Подскажите вариант CASE ... OF с условиями
    #39796824
I partigiani resistono
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Artem.1stНа практике встречается длинная цепочка операторов: If () Then

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
if ( {условие-1} ) then begin {действия-1} end 
else
  if ( {условие-2} ) then begin {действия-2} end
  else
    if ({условие-3} ) then begin {действия-3} end
    else
      if ( {условие-4} ) then begin {действия-4} end 
      else
         // ...  и т.д. ОЧЕНЬ длинная конструкция 


Когда более 10 условий, то код становится трудно-читаемым.
К сожалению case () of здесь нельзя использовать, т.к. условия - вычисляемые.

Уважаемые гуру, как вы оформляете такой Delphi код?

Спасибо.

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
procedure MyExec(aCondList: array of boolean; aProcList: array of TProc);
begin
  if Length(aCondList) <> Length(aProcList) then
    raise Exception.Create('Parameters - arrays must be the same length.');
  for var i := 0 to High(aProcList) do
    if aCondList[i] then
    begin
      if Assigned(aProcList[i]) then
        aProcList[i]();
      Break;
    end;
end;



Пример:

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
procedure Proc1;
begin

end;
procedure Proc2;
begin

end;
procedure Proc3;
begin

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  MyExec(
  [1=1, 2<>2, 3*2=5],
  [Proc1, Proc2, Proc3]
  );
end;


Можно лямбды прикрутить, для стройности.
...
Рейтинг: 0 / 0
Подскажите вариант CASE ... OF с условиями
    #39796825
I partigiani resistono
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
I partigiani resistono,

ах да.

Код: pascal
1.
2.
type
  TProc = procedure;
...
Рейтинг: 0 / 0
Подскажите вариант CASE ... OF с условиями
    #39796833
Фотография Dmitry Arefiev
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
1) Абстрактно ... Отступ означает вложенность. Тут же все if-ы одного уровня подчиненности. Т.е. отступ не нужен.
2) ParamStr(0) - имя исполняемого модуля. Надо ParamStr(1).
3) Обычный
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
LParamStr := LowerCase(ParamStr(1));
if SameStr(LParamStr, 'bla 1') then
begin
  ...
end
else if SameStr(LParamStr, 'bla 2') then
begin
  ...
end
...
...
Рейтинг: 0 / 0
Подскажите вариант CASE ... OF с условиями
    #39796848
Vlad F
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
roschinspb1. Во всех непонятных случаях по оформлению кода см. исходники.
<...>
А когда-то, не поверите, в эбаут-окне прямо так и писали, - Используй силу исходники, Люк.
Да уж, - были благословенные времена.))
...
Рейтинг: 0 / 0
Подскажите вариант CASE ... OF с условиями
    #39796854
Foxpc
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
А мне всё же больше нравится так. Выглядит очень читабельно

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
    while True do
    begin
      Readln(Str);
      if not InteractiveCallBack(Str.ToLower, 3,
        '/help', procedure
        begin
          Writeln('Help');
        end,
        '/start', procedure
        begin
          Writeln('start');
        end,
        '/wait', procedure
        begin
          Writeln('Wait');
        end) then
      begin
        Writeln('Write : /help /start /wait');
      end;
    end;





Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
unit InteractiveCallBackUnit;

interface

type
  TEventInteractiveNotify = Reference to procedure();

var
  InteractiveCallBack: procedure(const Str1: string; Count: Integer; Name: string;
    E: TEventInteractiveNotify)Cdecl Varargs;

implementation

procedure InteractiveCallBackTmp(const Str1: string; Count: Integer; Name: string;
  E: TEventInteractiveNotify); cdecl; // varargs;
const
  SizeAlign = SizeOf(NativeUint) - 1;
var
  Va: PByte;
  Str2: string;
  Event: Pointer;

  procedure SetPointer(P: PByte; TypSize: Integer);
  begin
    Va := PByte(NativeUint(P + TypSize + SizeAlign) and not SizeAlign);
  end;

  function Read(TypSize: Integer): Pointer;
  begin
    Move(Va^, Result, TypSize);
    SetPointer(Va, TypSize);
  end;

begin
  SetPointer(@Count, SizeOf(NativeUint));
  while Count >= 1 do
  begin
    Str2 := string(Read(SizeOf(string)));
    Event := Read(SizeOf(Pointer));
    if Str1 = Str2 then
    begin
      TEventInteractiveNotify(Event)();
      Exit;
    end;
    Dec(Count);
  end;
end;

initialization

InteractiveCallBack := InteractiveCallBackTmp;

finalization

end.

...
Рейтинг: 0 / 0
Подскажите вариант CASE ... OF с условиями
    #39796856
Foxpc
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Мой пример это что - то вроде, полноценного switch
...
Рейтинг: 0 / 0
Подскажите вариант CASE ... OF с условиями
    #39796863
Фотография Dmitry Arefiev
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
FoxpcА мне всё же больше нравится так. Выглядит очень читабельно
Носки решают какую ногу будут одевать. Логика должна быть чуть более прямой ...
...
Рейтинг: 0 / 0
Подскажите вариант CASE ... OF с условиями
    #39796955
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
defecatorа вот так выглядит вывод
Спалился, однако, ты, Миш. Чуть менее, чем совсем
...
Рейтинг: 0 / 0
Подскажите вариант CASE ... OF с условиями
    #39797018
Фотография defecator
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Модератор форума
Докdefecatorа вот так выглядит вывод
Спалился, однако, ты, Миш. Чуть менее, чем совсем

в чём спалился ?
...
Рейтинг: 0 / 0
Подскажите вариант CASE ... OF с условиями
    #39797186
kealon(Ruslan)
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
roschinspb3. По стандартам положено так
эко вас поломало, уже и не там, а всё смотрите на эти глупости
...
Рейтинг: 0 / 0
Подскажите вариант CASE ... OF с условиями
    #39797239
Фотография Virtual Student
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
FoxpcЧё уж? Давайте пировать!

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
    InteractiveCallBack(ParamStr(0), 3,
    '/Help', procedure
      begin
        Writeln('Help');
      end,
    '/start', procedure
      begin
        Writeln('start');
      end,
    '/Wait', procedure
      begin
        Writeln('Wait');
      end);



Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
unit InteractiveCallBackUnit;

interface

type
  TEventInteractiveNotify = Reference to procedure();

  InteractiveCallBackTmp2 = procedure(const Str1: string; Count: Integer; Name: string;
    E: TEventInteractiveNotify)Cdecl Varargs;

  TvaArgs = record
  const
    SizeAlign = SizeOf(NativeUint) - 1;
  private
    FPtr: PByte;
  public
    constructor Create(LastArg: Pointer; Size: Integer);
    function Read<T>(): T;
  end;

var
  InteractiveCallBack: InteractiveCallBackTmp2;

implementation

constructor TvaArgs.Create(LastArg: Pointer; Size: Integer);
begin
  FPtr := PByte(NativeUint(PByte(LastArg) + Size + SizeAlign) and not SizeAlign);
end;

function TvaArgs.Read<T>(): T;
begin
  Move(FPtr^, Result, SizeOf(T));
  FPtr := PByte(NativeUint(PByte(FPtr) + SizeOf(T) + SizeAlign) and not SizeAlign);
end;

procedure InteractiveCallBackTmp(const Str1: string; Count: Integer; Name: string;
  E: TEventInteractiveNotify); cdecl; // varargs;
var
  Va: TvaArgs;
  Str2: string;
  Event: Pointer;
begin
  Va := TvaArgs.Create(@Count, SizeOf(Integer));
  while Count >= 1 do
  begin
    Str2 := Va.Read<string>;
    Event := Va.Read<Pointer>;
    if Str1 = Str2 then
    begin
      TEventInteractiveNotify(Event)();
      Exit;
    end;
    Dec(Count);
  end;
end;

initialization

InteractiveCallBack := InteractiveCallBackTmp;

finalization

end.


Месье знает толк в извращениях! :)

На мой взгляд самый простой способ с IndexStr().
...
Рейтинг: 0 / 0
Подскажите вариант CASE ... OF с условиями
    #39797304
Foxpc
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Virtual Student,

В смысле извращения ??? c\с++ извращенцы ???? Со своими Varargs наборами

Функция до ужаса простая. Я передаю всего лишь аргументы, передаю их количество. И потом считываю обычным offset

И обычным циклом уменьшаю offset,сверяя str1 = str2 == true вызвав коллбэк
...
Рейтинг: 0 / 0
Подскажите вариант CASE ... OF с условиями
    #39797412
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
defecatorв чём спалился ?

Михал Сергеич, говоришь? :)
...
Рейтинг: 0 / 0
Подскажите вариант CASE ... OF с условиями
    #39797423
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
defecatorвот так это выглядит в прикладом коде...
Начал пользоваться атрибутами... Так, гляди, и до дженериков недалеко
...
Рейтинг: 0 / 0
Подскажите вариант CASE ... OF с условиями
    #39797441
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Kazantsev AlexeyТак, гляди, и до дженериков недалеко

тише, спугнешь
...
Рейтинг: 0 / 0
Подскажите вариант CASE ... OF с условиями
    #39797479
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
High.ProgramerЯ не проверял, но помню, что это переменная цикла после индексного перебора For i:=0 to Count-1 do имеет неопределенное значения.Это в случае использования за циклом. А если делать Exit, то все нормально
Код: pascal
1.
2.
3.
4.
5.
6.
function TStrings.IndexOf(const S: string): Integer;
begin
  for Result := 0 to GetCount - 1 do
    if CompareStrings(Get(Result), S) = 0 then Exit;
  Result := -1;
end;
...
Рейтинг: 0 / 0
Подскажите вариант CASE ... OF с условиями
    #39797480
Foxpc
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
А меня разочаровало что дженерики нельзя использовать для обычных функций... Вот что мешало реализовать?
...
Рейтинг: 0 / 0
25 сообщений из 58, страница 2 из 3
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Подскажите вариант CASE ... OF с условиями
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]