Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Шаблоны проектирования в Delphi / 25 сообщений из 36, страница 1 из 2
25.06.2019, 02:13
    #39830104
svnvlad
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Шаблоны проектирования в Delphi
Интересует шаблон State. Не пойму, как применить его в случае работы с Delphi, если все классы в Delphi - это визуальные компоненты (формы). О каком наследовании может идти речь?
На форме имеется ряд кнопок состояний судна.
Обработка состояний идет по классике перебором статусов внутри процедуры.
Код: 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.
procedure TfmPlanArrivalVessels.btnStatusFlClick(Sender: TObject);
var
  new_fs_id: integer;
  allowed_old_status_id: integer; // разрешенный статус для изменения. Если текущий статус не является таким, то менять запрещено
  allowed_old_status_id2: integer;
  allowed_old_status_id3: integer;
begin
.......................
  if Sender = btnStatusFlInWay then
    begin
      allowed_old_status_id := 0;
      allowed_old_status_id2 := 0;
      allowed_old_status_id3 := 0;
      new_fs_id := StatusIdInWay;
    end
  else
  if Sender = btnStatusFlArrived then
    begin
      allowed_old_status_id := StatusIdInWay;
      allowed_old_status_id2 := StatusIdInWay;
      allowed_old_status_id3 := StatusIdInWay;
      new_fs_id := StatusIdArrived;
    end
  else
  if Sender = btnStatusFlAnchorage then
    begin
      allowed_old_status_id := StatusIdArrived;
      allowed_old_status_id2 := StatusIdArrived;
      allowed_old_status_id3 := StatusIdArrived;
      new_fs_id := StatusIdAnchorage;
    end
  else
  if Sender = btnStatusFlPutToTheDock then
    begin
      allowed_old_status_id := StatusIdAnchorage;
      allowed_old_status_id2 := StatusIdAnchorage;
      allowed_old_status_id3 := StatusIdAnchorage;
      new_fs_id := StatusIdPutToTheDock;
    end
  else
  if Sender = btnStatusFlSafeIdle then
    begin
      allowed_old_status_id := StatusIdPutToTheDock;
      allowed_old_status_id2 := StatusIdPutToTheDock;
      allowed_old_status_id3 := StatusIdPutToTheDock;
      new_fs_id := StatusIdSafeIdle;
    end
  else
  if Sender = btnStatusFlHandlingWait then
    begin
      allowed_old_status_id := StatusIdPutToTheDock;
      allowed_old_status_id2 := StatusIdSafeIdle;
      allowed_old_status_id3 := StatusIdSafeIdle;
      new_fs_id := StatusIdHandlingWait;
    end
  else
  if Sender = btnStatusFlLeave then
    begin
      allowed_old_status_id := StatusIdLeavePrev;
      allowed_old_status_id2 := StatusIdSafeIdle;
      allowed_old_status_id3 := StatusIdAnchorage2;
      new_fs_id := StatusIdLeave;
    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.
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.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
procedure TfmPlanArrivalVessels.SetStatusButtons;
begin
  // Если нет записи, то все запрещено
  if plan_vessel_id = 0 then
    begin
      // check state и надписи
      btnStatusFlInWay.Checked := false;
      btnStatusFlArrived.Checked := false;
      btnStatusFlAnchorage.Checked := false;
      btnStatusFlPutToTheDock.Checked := false;
      btnStatusFlSafeIdle.Checked := false;
      btnStatusFlHandlingWait.Checked := false;
      btnStatusBeforeLeave.Checked := false;
      btnStatusBeforeLeave.Caption := '';
      btnStatusFlAnchorage2.Checked := false;
      btnStatusFlLeave.Checked := false;

      // enabled state
      btnStatusFlInWay.Enabled := false;
      btnStatusFlArrived.Enabled := false;
      btnStatusFlAnchorage.Enabled := false;
      btnStatusFlPutToTheDock.Enabled := false;
      btnStatusFlSafeIdle.Enabled := false;
      btnStatusFlHandlingWait.Enabled := false;
      btnStatusFlAnchorage2.Enabled := false;
      btnStatusFlLeave.Enabled := false;

      btnCancelStatusInWay.Enabled := false;
      btnCancelStatusArrived.Enabled := false;
      btnCancelStatusAnchorage.Enabled := false;
      btnCancelStatusPutToTheDock.Enabled := false;
      btnCancelStatusSafeIdle.Enabled := false;
      btnCancelStatusHandlingWait.Enabled := false;
      btnCancelStatusAnchorage2.Enabled := false;
      btnCancelStatusLeave.Enabled := false;

      exit;
    end;
  if (sequence_number = 0) or (sequence_number < StatusSequenceInWay) then // Нет статуса
    begin
      // check state и надписи
      btnStatusFlInWay.Checked := false;
      btnStatusFlArrived.Checked := false;
      btnStatusFlAnchorage.Checked := false;
      btnStatusFlPutToTheDock.Checked := false;
      btnStatusFlSafeIdle.Checked := false;
      btnStatusFlHandlingWait.Checked := false;
      btnStatusBeforeLeave.Checked := false;
      btnStatusBeforeLeave.Caption := '';
      btnStatusFlAnchorage2.Checked := false;
      btnStatusFlLeave.Checked := false;

      // enabled state
      btnStatusFlInWay.Enabled := Conf.IsAdmin or Conf.Permissions.IsPermission('PlanArrivalVessels', prmUpdate);
      btnStatusFlArrived.Enabled := false;
      btnStatusFlAnchorage.Enabled := false;
      btnStatusFlPutToTheDock.Enabled := false;
      btnStatusFlSafeIdle.Enabled := false;
      btnStatusFlHandlingWait.Enabled := false;
      btnStatusFlAnchorage2.Enabled := false;
      btnStatusFlLeave.Enabled := false;

   .............................
..................................
      btnStatusFlLeave.Enabled := false;

      // кнопки отмены
      btnCancelStatusInWay.Enabled := Conf.IsAdmin or Conf.Permissions.IsPermission('PlanArrivalVessels', prmUpdate);
      btnCancelStatusArrived.Enabled := false;
      btnCancelStatusAnchorage.Enabled := false;
      btnCancelStatusPutToTheDock.Enabled := false;
      btnCancelStatusSafeIdle.Enabled := false;
      btnCancelStatusHandlingWait.Enabled := false;
      btnCancelStatusAnchorage2.Enabled := false;
      btnCancelStatusLeave.Enabled := false;
    end
  else
  if sequence_number = StatusSequenceArrived then // Прибыло
    begin
      // check state и надписи
      btnStatusFlInWay.Checked := false;
      btnStatusFlArrived.Checked := true;
      btnStatusFlAnchorage.Checked := false;
      btnStatusFlPutToTheDock.Checked := false;
      btnStatusFlSafeIdle.Checked := false;
      btnStatusFlHandlingWait.Checked := false;
      btnStatusBeforeLeave.Checked := false;
      btnStatusBeforeLeave.Caption := '';
      btnStatusFlAnchorage2.Checked := false;
      btnStatusFlLeave.Checked := false;

      // enabled state
      btnStatusFlInWay.Enabled := false;
      btnStatusFlArrived.Enabled := false;
      btnStatusFlAnchorage.Enabled := Conf.IsAdmin or Conf.Permissions.IsPermission('PlanArrivalVessels', prmUpdate);
      btnStatusFlPutToTheDock.Enabled := false;
      btnStatusFlSafeIdle.Enabled := false;
      btnStatusFlHandlingWait.Enabled := false;
      btnStatusFlAnchorage2.Enabled := false;
      btnStatusFlLeave.Enabled := false;

      // кнопки отмены
      btnCancelStatusInWay.Enabled := false;
      btnCancelStatusArrived.Enabled := Conf.IsAdmin or Conf.Permissions.IsPermission('PlanArrivalVessels', prmUpdate);
      btnCancelStatusAnchorage.Enabled := false;
      btnCancelStatusPutToTheDock.Enabled := false;
      btnCancelStatusSafeIdle.Enabled := false;
      btnCancelStatusHandlingWait.Enabled := false;
      btnCancelStatusAnchorage2.Enabled := false;
      btnCancelStatusLeave.Enabled := false;
    end
  else
  if sequence_number = StatusSequenceAnchorage then // На рейде
    begin
      // check state и надписи
      btnStatusFlInWay.Checked := false;
      btnStatusFlArrived.Checked := false;
      btnStatusFlAnchorage.Checked := true;
      btnStatusFlPutToTheDock.Checked := false;
      btnStatusFlSafeIdle.Checked := false;
      btnStatusFlHandlingWait.Checked := false;
      btnStatusBeforeLeave.Checked := false;
      btnStatusBeforeLeave.Caption := '';
      btnStatusFlAnchorage2.Checked := false;
      btnStatusFlLeave.Checked := false;

      // enabled state
      btnStatusFlInWay.Enabled := false;
      btnStatusFlArrived.Enabled := false;
      btnStatusFlAnchorage.Enabled := false;
      btnStatusFlPutToTheDock.Enabled := Conf.IsAdmin or Conf.Permissions.IsPermission('PlanArrivalVessels', prmUpdate);
      btnStatusFlSafeIdle.Enabled := false;
      btnStatusFlHandlingWait.Enabled := false;
      btnStatusFlAnchorage2.Enabled := false;
      btnStatusFlLeave.Enabled := false;

      // кнопки отмены
      btnCancelStatusInWay.Enabled := false;
      btnCancelStatusArrived.Enabled := false;
      btnCancelStatusAnchorage.Enabled := Conf.IsAdmin or Conf.Permissions.IsPermission('PlanArrivalVessels', prmUpdate);
      btnCancelStatusPutToTheDock.Enabled := false;
      btnCancelStatusSafeIdle.Enabled := false;
      btnCancelStatusHandlingWait.Enabled := false;
      btnCancelStatusAnchorage2.Enabled := false;
      btnCancelStatusLeave.Enabled := false;
    end
  else
  if sequence_number = StatusSequencePutToTheDock then // Поставлено к причалу
    begin
      // check state и надписи
      btnStatusFlInWay.Checked := false;
      btnStatusFlArrived.Checked := false;
      btnStatusFlAnchorage.Checked := false;
      btnStatusFlPutToTheDock.Checked := true;
      btnStatusFlSafeIdle.Checked := false;
      btnStatusFlHandlingWait.Checked := false;
      btnStatusBeforeLeave.Checked := false;
      btnStatusBeforeLeave.Caption := '';
      btnStatusFlAnchorage2.Checked := false;
      btnStatusFlLeave.Checked := false;

      // enabled state
      btnStatusFlInWay.Enabled := false;
  ..............................
...............................



Как видите, все достаточно однообразно и муторно.
Приведите пример, как можно это в Delphi переписать на шаблон State и стоит ли?
...
Рейтинг: 0 / 0
25.06.2019, 02:22
    #39830105
svnvlad
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Шаблоны проектирования в Delphi
Может быть я не вижу гибкости работы с классами или чего-то не знаю, подтолкните в нужную сторону. Пока программировал тупо формами и методами внутри них. Одна форма - один класс.
...
Рейтинг: 0 / 0
25.06.2019, 02:49
    #39830108
Victor Cookin
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Шаблоны проектирования в Delphi
svnvlad,

Код: sql
1.
2.
TShipState = (ShStOntheWay, ShStArrived, ShStNearBy, ShStEmbarked, ShStSafeHarbour, ShStProcessing, ShStNearBy2, ShStDebarked, ShStHz);
  TShipStates= set of TShipState;



Поскольку есть 2 кнопки "На рейде", ввёл 2 состояния ShStNearBy и ShStNearBy2.
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
  TShip = class (TObject)
  public
    ID : integer;
    Name : string;
    State: TShipStates;
  end;

sh : TShip;



Так как состояния могут быть взаимоисключающими, надо бы создать кросстаблицу и проверять набор состояний на валидность.
Например, не может быть одновременно ShStArrived и ShStDebarked.

Добавление состояния :
Код: pascal
1.
sh.State := sh.State + [ShStProcessing];



Если же вообще состояние только одно, то нужен не set, а набор констант.
...
Рейтинг: 0 / 0
25.06.2019, 03:05
    #39830109
svnvlad
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Шаблоны проектирования в Delphi
Victor Cookinsvnvlad,

Код: sql
1.
2.
TShipState = (ShStOntheWay, ShStArrived, ShStNearBy, ShStEmbarked, ShStSafeHarbour, ShStProcessing, ShStNearBy2, ShStDebarked, ShStHz);
  TShipStates= set of TShipState;



Поскольку есть 2 кнопки "На рейде", ввёл 2 состояния ShStNearBy и ShStNearBy2.
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
  TShip = class (TObject)
  public
    ID : integer;
    Name : string;
    State: TShipStates;
  end;

sh : TShip;



Так как состояния могут быть взаимоисключающими, надо бы создать кросстаблицу и проверять набор состояний на валидность.
Например, не может быть одновременно ShStArrived и ShStDebarked.

Добавление состояния :
Код: pascal
1.
sh.State := sh.State + [ShStProcessing];



Если же вообще состояние только одно, то нужен не set, а набор констант.
Ну а шаблона State то здесь нет. Там каждое состояние - это отдельный класс со своим поведением.
...
Рейтинг: 0 / 0
25.06.2019, 03:07
    #39830110
svnvlad
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Шаблоны проектирования в Delphi
Victor Cookin,

конечно состояние только одно - это работа с конечным автоматом.
...
Рейтинг: 0 / 0
25.06.2019, 03:58
    #39830111
svnvlad
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Шаблоны проектирования в Delphi
Victor Cookin,
как-то так наверно...
Код: 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.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
type
  // *** context ***
  TShip = class (TObject)
  private
    State: TShipState;
  public
    constructor Create(Obj: TObject); // begin... State := TShipState.Create; ... end;
    procedure DoOnTheWay; // begin State.ShStOnTheWay(self); end;
    procedure DoArrived; // begin State.ShStArrived(self); end;
    procedure DoNearBy; // ....
    procedure DoEmbarked;
    procedure DoSafeHarbour;
    procedure DoProcessing;
    procedure DoNearBy2;
    procedure DoDebarked;
    procedure DoHz;
  end;

  // *** abstract state ***
  TShipState = class abstract
  public
    procedure ShStOnTheWay(AShip: TShip); virtual; abstract;
    procedure ShStArrived(AShip: TShip); virtual; abstract;
    procedure ShStNearBy(AShip: TShip); virtual; abstract;
    procedure ShStEmbarked(AShip: TShip); virtual; abstract;
    procedure ShStSafeHarbour(AShip: TShip); virtual; abstract;
    procedure ShStProcessing(AShip: TShip); virtual; abstract;
    procedure ShStNearBy2(AShip: TShip); virtual; abstract;
    procedure ShStDebarked(AShip: TShip); virtual; abstract;
    procedure ShStHz(AShip: TShip); virtual; abstract;
  end;

  // *** concrete states ***

  TOnTheWayState = class(TShipState)
  public
    procedure ShStOntheWay(AShip: TShip); override;
    procedure ShStArrived(AShip: TShip); override;
    procedure ShStNearBy(AShip: TShip); override;
    procedure ShStEmbarked(AShip: TShip); override;
    procedure ShStSafeHarbour(AShip: TShip); override;
    procedure ShStProcessing(AShip: TShip); override;
    procedure ShStNearBy2(AShip: TShip); override;
    procedure ShStDebarked(AShip: TShip); override;
    procedure ShStHz(AShip: TShip); override;
  end;

  TArrivedState = class(TShipState)
  public
    procedure ShStOntheWay(AShip: TShip); override;
    procedure ShStArrived(AShip: TShip); override;
    procedure ShStNearBy(AShip: TShip); override;
    procedure ShStEmbarked(AShip: TShip); override;
    procedure ShStSafeHarbour(AShip: TShip); override;
    procedure ShStProcessing(AShip: TShip); override;
    procedure ShStNearBy2(AShip: TShip); override;
    procedure ShStDebarked(AShip: TShip); override;
    procedure ShStHz(AShip: TShip); override;
  end;

  TNearByState = class(TShipState)
  public
    procedure ShStOntheWay(AShip: TShip); override;
    procedure ShStArrived(AShip: TShip); override;
    procedure ShStNearBy(AShip: TShip); override;
    procedure ShStEmbarked(AShip: TShip); override;
    procedure ShStSafeHarbour(AShip: TShip); override;
    procedure ShStProcessing(AShip: TShip); override;
    procedure ShStNearBy2(AShip: TShip); override;
    procedure ShStDebarked(AShip: TShip); override;
    procedure ShStHz(AShip: TShip); override;
  end;

  TEmbarkedState = class(TShipState)
  public
    procedure ShStOntheWay(AShip: TShip); override;
    procedure ShStArrived(AShip: TShip); override;
    procedure ShStNearBy(AShip: TShip); override;
    procedure ShStEmbarked(AShip: TShip); override;
    procedure ShStSafeHarbour(AShip: TShip); override;
    procedure ShStProcessing(AShip: TShip); override;
    procedure ShStNearBy2(AShip: TShip); override;
    procedure ShStDebarked(AShip: TShip); override;
    procedure ShStHz(AShip: TShip); override;
  end;

  TSafeHarbourState = class(TShipState)
  public
    procedure ShStOntheWay(AShip: TShip); override;
    procedure ShStArrived(AShip: TShip); override;
    procedure ShStNearBy(AShip: TShip); override;
    procedure ShStEmbarked(AShip: TShip); override;
    procedure ShStSafeHarbour(AShip: TShip); override;
    procedure ShStProcessing(AShip: TShip); override;
    procedure ShStNearBy2(AShip: TShip); override;
    procedure ShStDebarked(AShip: TShip); override;
    procedure ShStHz(AShip: TShip); override;
  end;

  TProcessingState = class(TShipState)
  public
    procedure ShStOntheWay(AShip: TShip); override;
    procedure ShStArrived(AShip: TShip); override;
    procedure ShStNearBy(AShip: TShip); override;
    procedure ShStEmbarked(AShip: TShip); override;
    procedure ShStSafeHarbour(AShip: TShip); override;
    procedure ShStProcessing(AShip: TShip); override;
    procedure ShStNearBy2(AShip: TShip); override;
    procedure ShStDebarked(AShip: TShip); override;
    procedure ShStHz(AShip: TShip); override;
  end;

  TNearBy2State = class(TShipState)
  public
    procedure ShStOntheWay(AShip: TShip); override;
    procedure ShStArrived(AShip: TShip); override;
    procedure ShStNearBy(AShip: TShip); override;
    procedure ShStEmbarked(AShip: TShip); override;
    procedure ShStSafeHarbour(AShip: TShip); override;
    procedure ShStProcessing(AShip: TShip); override;
    procedure ShStNearBy2(AShip: TShip); override;
    procedure ShStDebarked(AShip: TShip); override;
    procedure ShStHz(AShip: TShip); override;
  end;

  TDebarkedState = class(TShipState)
  public
    procedure ShStOntheWay(AShip: TShip); override;
    procedure ShStArrived(AShip: TShip); override;
    procedure ShStNearBy(AShip: TShip); override;
    procedure ShStEmbarked(AShip: TShip); override;
    procedure ShStSafeHarbour(AShip: TShip); override;
    procedure ShStProcessing(AShip: TShip); override;
    procedure ShStNearBy2(AShip: TShip); override;
    procedure ShStDebarked(AShip: TShip); override;
    procedure ShStHz(AShip: TShip); override;
  end;

  THzState = class(TShipState)
  public
    procedure ShStOntheWay(AShip: TShip); override;
    procedure ShStArrived(AShip: TShip); override;
    procedure ShStNearBy(AShip: TShip); override;
    procedure ShStEmbarked(AShip: TShip); override;
    procedure ShStSafeHarbour(AShip: TShip); override;
    procedure ShStProcessing(AShip: TShip); override;
    procedure ShStNearBy2(AShip: TShip); override;
    procedure ShStDebarked(AShip: TShip); override;
    procedure ShStHz(AShip: TShip); override;
  end;


sh : TShip;
...
Рейтинг: 0 / 0
25.06.2019, 07:28
    #39830123
pvv.pas
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Шаблоны проектирования в Delphi
svnvladVictor Cookin,
как-то так наверно...
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
type
  // *** context ***
  TShip = class (TObject)
  private
    State: TShipState;
  public
    constructor Create(Obj: TObject); // begin... State := TShipState.Create; ... end;
    procedure DoOnTheWay; // begin State.ShStOnTheWay(self); end;
    procedure DoArrived; // begin State.ShStArrived(self); end;
    procedure DoNearBy; // ....
    procedure DoEmbarked;
    procedure DoSafeHarbour;
    procedure DoProcessing;
    procedure DoNearBy2;
    procedure DoDebarked;
    procedure DoHz;
  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.
type
  ...
  TStateHandler = procedure(Ship: TShip) of object;
  
  TAutomation = class
  private
    Handlers: array[TShipState] of TStateHandler;  
    procedure HandleShStOntheWay(Ship: TShip);
    procedure HandleShStArrived(Ship: TShip);
    ...
  public
    constructor Create;
    procedure HandleState(Ship: TShip);  
  end;
  ...

implementation
  ...

constructor TAutomation.Create;
begin
  // заполняем обработчиками для каждого состояния
  Handlers[ShStOntheWay] := HandleShStOntheWay;
  Handlers[ShStArrived] := HandleShStArrived;
  ...
end;

procedure TAutomation.HandleState(Ship: TShip);
begin
  Handlers[Ship.State](Ship);
end;


Может я что то упустил из сути твоей задачи, и тебе это не подходит, но я обычно реализую таким образом если состояния можно описать set-ами и объект находится всегда в одном из них (а не set of). Если же тебе нужно обрабатывать набор состояний как одно целое (т.е. реагировать на цепочку событий), то здесь как я обычно строю автомат на алгоритме Ахо-Корасика. Пока, думаю, трудозатраты/цена вопроса не соответствуют необходимости в этом.
...
Рейтинг: 0 / 0
25.06.2019, 20:34
    #39830505
L_argo
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Шаблоны проектирования в Delphi
Просто адовый говнокод. Потому что хардкод. Малейшее изменение и приходится пересобирать проект.
Заюзайте чтоле Tag. Там можно сделать 32 битовых статуса. Сделать процедуру RTTI-перебора кнопок и проверки этих статусов.
Также следует заюзать некую легковесную БД. Даже ин-мемори. И управлять кнопами произвольно гибко и настраиваемо.
...
Рейтинг: 0 / 0
28.06.2019, 04:44
    #39831440
svnvlad
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Шаблоны проектирования в Delphi
pvv.pas,
как вариант, достаточно интересно. Я так понял, что это урезанный вариант классического шаблона Состояние.
Суть поста была как раз разобраться с шаблоном State, чем получить рекомендации по конкретной задаче (хотя за это тоже спасибо, может быть шаблон и не нужен).
В описании шаблона обычно указывают преимущества:
- Избавляет от множества больших условных операторов машины состояний.
- Концентрирует в одном месте код, связанный с определённым состоянием.
- Упрощает код контекста.
https://refactoring.guru/ru/design-patterns/state

Я пытаюсь смоделировать шаблон для своей задачи. Пока путаюсь, вот тот код, что я привел, содержит ошибки, в частности, создание экземпляра абстрактного класса, что делать нельзя. Однако как правильно, я еще не разобрался. Где и как создавать экземпляры всех унаследованных классов, конкретизирующих поведение каждого состояния. И, судя по всему, экземпляры нужно создавать в виде Singleton, обращаясь к ним не по Create, а по GetInstanсe, чтобы по ошибке не создать дубликаты состояний.
Потом, по приведенному мной коду, переписанному на шаблон State, вовсе не прослеживается, что "для ввода нового состояния достаточно создать соответствующий класс, и не надо переписывать множество условных операторов и пересобирать весь проект" - как видно, для ввода нового состояния придется создать соответствующие процедуры В КАЖДОМ подклассе. Различие лишь в том, что из одного места эта перепись переходит в десятки разных мест. Так в чем преимущество шаблона?
...
Рейтинг: 0 / 0
28.06.2019, 09:13
    #39831463
pvv.pas
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Шаблоны проектирования в Delphi
svnvlad... Так в чем преимущество шаблона?
Так ведь ты сам ответил на свой вопрос:
svnvlad...
В описании шаблона обычно указывают преимущества:
- Избавляет от множества больших условных операторов машины состояний.
- Концентрирует в одном месте код, связанный с определённым состоянием.
- Упрощает код контекста.
...

Проще говоря - наводит порядок как в голове так и в коде, и, соответственно, упрощает дальнейшее сопровождение. И ещё раз повторюсь: главное не перемудрить и не выгореть на этапе изучения, а то понапишут столько про элементарщину...
...
Рейтинг: 0 / 0
28.06.2019, 09:52
    #39831477
kealon(Ruslan)
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Шаблоны проектирования в Delphi
svnvlad,

состояния в VCL для гуи уже реализовано в виде TAction

для присвоения состояния контролу достаточно присвоить ему нужный Action, это и есть "переход"
...
Рейтинг: 0 / 0
28.06.2019, 10:40
    #39831510
svnvlad
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Шаблоны проектирования в Delphi
kealon(Ruslan)svnvlad,

состояния в VCL для гуи уже реализовано в виде TAction

для присвоения состояния контролу достаточно присвоить ему нужный Action, это и есть "переход"
Тут не о состоянии контролов говорится, а о состоянии системы в целом. Здесь как бы две задачи - сориентировать состояния системы между собой и попутно прорисовать контролы, соответственно состоянию системы.
...
Рейтинг: 0 / 0
28.06.2019, 10:42
    #39831512
svnvlad
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Шаблоны проектирования в Delphi
kealon(Ruslan)svnvlad,

состояния в VCL для гуи уже реализовано в виде TAction

для присвоения состояния контролу достаточно присвоить ему нужный Action, это и есть "переход"
Я думал над этим. В дельфи ничего не мешает уже существовать чему-либо типа TAction, как классу состояния системы.
...
Рейтинг: 0 / 0
28.06.2019, 10:44
    #39831514
svnvlad
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Шаблоны проектирования в Delphi
kealon(Ruslan)svnvlad,

состояния в VCL для гуи уже реализовано в виде TAction

для присвоения состояния контролу достаточно присвоить ему нужный Action, это и есть "переход"
А что тогда играет роль абстрактного класса State?
...
Рейтинг: 0 / 0
28.06.2019, 10:48
    #39831517
Мимопроходящий
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Шаблоны проектирования в Delphi
вот нахрена смешивать модель с GUI-ём в одну кучу?!
какие нахрен батоны? какие нахрен акции?
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
28.06.2019, 10:48
    #39831518
svnvlad
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Шаблоны проектирования в Delphi
kealon(Ruslan),

если создать несколько TAction с разными именами, соответственно количеству состояний, и в каждом TAction создать несколько методов, соответствующих переходам, с одинаковыми именами, и осуществлять подмену класса Action, получится ли? Будет ли вызываться одна и та же процедура по имени, с подменой поведения?
...
Рейтинг: 0 / 0
28.06.2019, 10:50
    #39831521
svnvlad
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Шаблоны проектирования в Delphi
Мимопроходящийвот нахрена смешивать модель с GUI-ём в одну кучу?!
какие нахрен батоны? какие нахрен акции?

это вы про какое именно сообщение?
...
Рейтинг: 0 / 0
28.06.2019, 11:01
    #39831526
svnvlad
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Шаблоны проектирования в Delphi
kealon(Ruslan),
не получится. TAction - сквозной элемент GUI, нельзя в разных акциях создать процедуры с одинаковыми именами - они все вываливаются в общий класс формы.
...
Рейтинг: 0 / 0
28.06.2019, 11:26
    #39831541
kealon(Ruslan)
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Шаблоны проектирования в Delphi
svnvladkealon(Ruslan),
не получится. TAction - сквозной элемент GUI, нельзя в разных акциях создать процедуры с одинаковыми именами - они все вываливаются в общий класс формы.и не надо
TAction это и есть состояние какого-то объекта и одновременно и метод. Контрол же у вас не может вызвать два метода на выбор? ну и зачем козе баян?

общее состояние - это комбинация состояний группы контролов, соответственно каждый контрол и вызывает метод из Aсtion (это и есть "процедура с именем", которую вы ищете). В ней вы выполнете нужное действие и прописываете новое состояние системы (задаёте контролам новые состояния, указав им новый Action)
...
Рейтинг: 0 / 0
28.06.2019, 11:28
    #39831542
Dimonka
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Шаблоны проектирования в Delphi
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
  TShipState = class abstract
  public
    procedure ShStOnTheWay(AShip: TShip); virtual; abstract;
    procedure ShStArrived(AShip: TShip); virtual; abstract;
    procedure ShStNearBy(AShip: TShip); virtual; abstract;
    procedure ShStEmbarked(AShip: TShip); virtual; abstract;
    procedure ShStSafeHarbour(AShip: TShip); virtual; abstract;
    procedure ShStProcessing(AShip: TShip); virtual; abstract;
    procedure ShStNearBy2(AShip: TShip); virtual; abstract;
    procedure ShStDebarked(AShip: TShip); virtual; abstract;
    procedure ShStHz(AShip: TShip); virtual; abstract;
  end;


Все вышеуказанные "действия" тоже можно заменить шаблонными методами. Например посмотреть в сторону паттерна "стратегия".
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
  TShipAction = class abstract
     procedure DoAction(AShip: TShip); abstract;
     property ActionType: TShipActionType;
  end;

  TShipState = class abstract
  public
    function GetActionByType(ActionType: TShipActionType): TShipAction;
    property ShipActions[Index: integer]: TShipAction;
    property ShipActionCount: integer;
  end;


Таким образом для каждого состояния можно компоновать различные уникальные и не уникальные наборы действий. Ну и соответственно иметь возможность расширять список возможных действий.
...
Рейтинг: 0 / 0
28.06.2019, 11:30
    #39831543
svnvlad
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Шаблоны проектирования в Delphi
kealon(Ruslan)svnvladkealon(Ruslan),
не получится. TAction - сквозной элемент GUI, нельзя в разных акциях создать процедуры с одинаковыми именами - они все вываливаются в общий класс формы.и не надо
TAction это и есть состояние какого-то объекта и одновременно и метод. Контрол же у вас не может вызвать два метода на выбор? ну и зачем козе баян?

общее состояние - это комбинация состояний группы контролов, соответственно каждый контрол и вызывает метод из Aсtion (это и есть "процедура с именем", которую вы ищете). В ней вы выполнете нужное действие и прописываете новое состояние системы (задаёте контролам новые состояния, указав им новый Action)
В новом TAction-е будут имена процедур другие. Вы предлагаете каждой кнопке назначать новое имя процедуры?
...
Рейтинг: 0 / 0
28.06.2019, 11:33
    #39831551
svnvlad
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Шаблоны проектирования в Delphi
перепутал TAction и TActionManager.
...
Рейтинг: 0 / 0
28.06.2019, 11:40
    #39831554
svnvlad
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Шаблоны проектирования в Delphi
Dimonka
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
  TShipState = class abstract
  public
    procedure ShStOnTheWay(AShip: TShip); virtual; abstract;
    procedure ShStArrived(AShip: TShip); virtual; abstract;
    procedure ShStNearBy(AShip: TShip); virtual; abstract;
    procedure ShStEmbarked(AShip: TShip); virtual; abstract;
    procedure ShStSafeHarbour(AShip: TShip); virtual; abstract;
    procedure ShStProcessing(AShip: TShip); virtual; abstract;
    procedure ShStNearBy2(AShip: TShip); virtual; abstract;
    procedure ShStDebarked(AShip: TShip); virtual; abstract;
    procedure ShStHz(AShip: TShip); virtual; abstract;
  end;


Все вышеуказанные "действия" тоже можно заменить шаблонными методами. Например посмотреть в сторону паттерна "стратегия".
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
  TShipAction = class abstract
     procedure DoAction(AShip: TShip); abstract;
     property ActionType: TShipActionType;
  end;

  TShipState = class abstract
  public
    function GetActionByType(ActionType: TShipActionType): TShipAction;
    property ShipActions[Index: integer]: TShipAction;
    property ShipActionCount: integer;
  end;


Таким образом для каждого состояния можно компоновать различные уникальные и не уникальные наборы действий. Ну и соответственно иметь возможность расширять список возможных действий.
Паттерн стратегия внутри паттерна State? Насколько я понял, их различие в том, что в State есть ссылка на контекст, а в стратегии нет. Например изнутри процедур конкретного класса состояния есть доступ к самой форме и ее элементам, а в стратегии нет (чтоб к тем же контролам обратиться например).
...
Рейтинг: 0 / 0
28.06.2019, 11:43
    #39831557
kealon(Ruslan)
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Шаблоны проектирования в Delphi
svnvladВ новом TAction-е будут имена процедур другие. Вы предлагаете каждой кнопке назначать новое имя процедуры?когда вы присваиваете контролу другой Action у него меняется Caption, Enabled, Checked(если есть) и само собой метод OnClick или аналоги

т.е. всем отображением и действиями управляет уже новый присвоенный Action
...
Рейтинг: 0 / 0
28.06.2019, 11:51
    #39831561
svnvlad
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Шаблоны проектирования в Delphi
kealon(Ruslan)svnvladВ новом TAction-е будут имена процедур другие. Вы предлагаете каждой кнопке назначать новое имя процедуры?когда вы присваиваете контролу другой Action у него меняется Caption, Enabled, Checked(если есть) и само собой метод OnClick или аналоги

т.е. всем отображением и действиями управляет уже новый присвоенный Action
Ну там 10-20 контролов (кнопок). И кроме кнопок (видимых элементов), есть еще поля и таблицы в базе данных, которым присваиваются значения и выполняются некие процедуры.
Вы предлагаете шаблон State сделать наизнанку. Там подменяется класс, внутри которого ряд процедур, на другой класс с таким же набором процедур. А вы предлагаете оставить класс, а менять имена процедур для каджой кнопки. Зачем, если есть уже отработанный шаблон?
...
Рейтинг: 0 / 0
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Шаблоны проектирования в Delphi / 25 сообщений из 36, страница 1 из 2
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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