Запустить форму несколько раз

@hsimpson · Регистрация: 21.05.2012

Студворк — интернет-сервис помощи студентам

Моё почтение, уважаемые!
Подскажите, можно ли единовременно запустить одну форму несколько раз (с разными значениями)?
Например, у меня есть сообщение для пользователя, которое индицируется на предназначенной для этого форме.
А как быть, если таких сообщений несколько?
Причём, их нужно показать одновременно.
Причём, заранее неизвестно, сколько точно их будет.

Спасибо.

@D1973 · 29.12.2017, 13:29

Сообщение от BagrAlex

хочет запускаться процедура pingtest

А с какого перепугу она должно работать? Сделайте ее методом класса формы Fshow, раз уж Вы в этой процедуре вовсю обращаетесь к компонентам этой формы

@BagrAlex · 29.12.2017, 17:21

Сообщение от D1973

Сделайте ее методом класса формы Fshow

Сделал так

Delphi
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
unit Unit2;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, IdBaseComponent,
  IdComponent, IdRawBase, IdRawClient, IdIcmpClient, JvExControls, JvLabel,
  OverbyteIcsWndControl, OverbyteIcsPing, Vcl.Imaging.jpeg, Vcl.ExtCtrls,
  JvExExtCtrls, ShellApi, unit1;
 
type
  TFshow = class(TForm)
    lb_pingip1: TLabel;
    btn_pingtest: TButton;
    lb_pinggw1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    lb_name: TLabel;
    lb_gw1: TLabel;
    lb_adr: TLabel;
    lb_ip1: TLabel;
    Ping1: TPing;
    im_cmdip1: TImage;
    im_cmdgw1: TImage;
    btn_openbrws: TButton;
    Label1: TLabel;
    Label4: TLabel;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure im_cmdip1Click(Sender: TObject);
    procedure im_cmdgw1Click(Sender: TObject);
    procedure btn_openbrwsClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btn_pingtestClick(Sender: TObject);
    procedure pingtest;
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Fshow: TFshow;
 
implementation
 
{$R *.dfm}
 
procedure TFshow.pingtest;
begin
  with Fshow do begin
    btn_openbrws.Enabled:=false;
    lb_pinggw1.Font.Color:=clBlue;
    lb_pingip1.Font.Color:=clBlue;
    lb_pinggw1.Caption:='Проверка...подождите...';
    lb_pingip1.Caption:=lb_pinggw1.Caption;
    Application.ProcessMessages;
    ping1.Address:=lb_ip1.Caption;
    ping1.Ping;
    if ping1.ErrorCode=0 then
      begin
        lb_pingip1.Caption:='OK';
        lb_pingip1.Font.Color:=ClGreen;
         btn_openbrws.Enabled:=true;
      end
    else
      begin
        lb_pingip1.Caption:='NOK';
        lb_pingip1.Font.Color:=ClRed;
      end;
    Application.ProcessMessages;
    ping1.Address:=lb_gw1.Caption;
    ping1.Ping;
    if ping1.ErrorCode=0 then
      begin
        lb_pinggw1.Caption:='OK';
        lb_pinggw1.Font.Color:=ClGreen;
      end
    else
      begin
        lb_pinggw1.Caption:='NOK';
        lb_pinggw1.Font.Color:=ClRed;
      end;
   end;
end;
 
procedure TFshow.btn_openbrwsClick(Sender: TObject);
begin
    ShellExecute(0, 'open', PChar('http://'+lb_ip1.Caption+':666/sysconf'), nil, nil, SW_SHOW);
end;
 
procedure TFshow.btn_pingtestClick(Sender: TObject);
begin
   pingtest;
end;
 
procedure TFshow.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    lb_pinggw1.Caption:='неизвестно';
    lb_pinggw1.Font.Color:=clWindowText;
    lb_pingip1.Caption:=lb_pinggw1.Caption;
    lb_pingip1.Font.Color:=lb_pinggw1.Font.Color;
    btn_openbrws.Enabled:=false;
end;
 
procedure TFshow.FormCreate(Sender: TObject);
begin
    pingtest;
end;
 
procedure TFshow.FormShow(Sender: TObject);
begin
   Application.ProcessMessages;
   pingtest;
end;
 
procedure TFshow.im_cmdip1Click(Sender: TObject);
var
s:ansistring;
begin
    s:='ping.exe '+ lb_ip1.Caption+' -t';
   WinExec(pansichar(s), sw_show);
end;
 
procedure TFshow.im_cmdgw1Click(Sender: TObject);
var
s:ansistring;
begin
    s:='ping.exe '+ lb_gw1.Caption+' -t';
    WinExec(Pansichar(s), sw_show);
end;
 
end.

Ошибка та же самая: при попытке вызвать TFshow.pingtest - access violation at 0x006adca3: read of address 0x000003e0

Сообщение от qwertehok

до твоей процедуры дело доходит

Да, ошибка именно при вызове процедуры

@hsimpson · 29.12.2017, 19:55 **[ТС]**

Уважаемые, всех с Новым годом!
Всем - всего хорошего и побольше.

@qwertehok · 29.12.2017, 21:02

BagrAlex, ошибка памяти - значит ты вызываешь то чего нет

где ты создаешь Fshow: TFshow;?

hsimpson, и вам того же
как ваш проект?

@BagrAlex · 29.12.2017, 21:17

Сообщение от qwertehok

где ты создаешь Fshow: TFshow;?

44 строка юнита, описывающего класс формы.

4 и 9 строка в процедуре вызова формы в другом юните

@hsimpson · 29.12.2017, 21:24 **[ТС]**

Ноябрь и декабрь - в полиграфии сезон, так что программирование пока побоку. В январе, возможно снова засяду.

@qwertehok · 29.12.2017, 23:18

Сообщение от BagrAlex

44 строка юнита, описывающего класс формы.
4 и 9 строка в процедуре вызова формы в другом юните

не вижу

@BagrAlex · 29.12.2017, 23:28

44я строка тут:

Delphi
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
unit Unit2;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, IdBaseComponent,
  IdComponent, IdRawBase, IdRawClient, IdIcmpClient, JvExControls, JvLabel,
  OverbyteIcsWndControl, OverbyteIcsPing, Vcl.Imaging.jpeg, Vcl.ExtCtrls,
  JvExExtCtrls, ShellApi, unit1;
 
type
  TFshow = class(TForm)
    lb_pingip1: TLabel;
    btn_pingtest: TButton;
    lb_pinggw1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    lb_name: TLabel;
    lb_gw1: TLabel;
    lb_adr: TLabel;
    lb_ip1: TLabel;
    Ping1: TPing;
    im_cmdip1: TImage;
    im_cmdgw1: TImage;
    btn_openbrws: TButton;
    Label1: TLabel;
    Label4: TLabel;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure im_cmdip1Click(Sender: TObject);
    procedure im_cmdgw1Click(Sender: TObject);
    procedure btn_openbrwsClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btn_pingtestClick(Sender: TObject);
    procedure pingtest;
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Fshow: TFshow;
 
implementation
 
{$R *.dfm}
 
procedure TFshow.pingtest;
begin
  with Fshow do begin
    btn_openbrws.Enabled:=false;
    lb_pinggw1.Font.Color:=clBlue;
    lb_pingip1.Font.Color:=clBlue;
    lb_pinggw1.Caption:='Проверка...подождите...';
    lb_pingip1.Caption:=lb_pinggw1.Caption;
    Application.ProcessMessages;
    ping1.Address:=lb_ip1.Caption;
    ping1.Ping;
    if ping1.ErrorCode=0 then
      begin
        lb_pingip1.Caption:='OK';
        lb_pingip1.Font.Color:=ClGreen;
         btn_openbrws.Enabled:=true;
      end
    else
      begin
        lb_pingip1.Caption:='NOK';
        lb_pingip1.Font.Color:=ClRed;
      end;
    Application.ProcessMessages;
    ping1.Address:=lb_gw1.Caption;
    ping1.Ping;
    if ping1.ErrorCode=0 then
      begin
        lb_pinggw1.Caption:='OK';
        lb_pinggw1.Font.Color:=ClGreen;
      end
    else
      begin
        lb_pinggw1.Caption:='NOK';
        lb_pinggw1.Font.Color:=ClRed;
      end;
   end;
end;
 
procedure TFshow.btn_openbrwsClick(Sender: TObject);
begin
    ShellExecute(0, 'open', PChar('http://'+lb_ip1.Caption+':666/sysconf'), nil, nil, SW_SHOW);
end;
 
procedure TFshow.btn_pingtestClick(Sender: TObject);
begin
   Fshow.pingtest;
end;
 
procedure TFshow.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    lb_pinggw1.Caption:='неизвестно';
    lb_pinggw1.Font.Color:=clWindowText;
    lb_pingip1.Caption:=lb_pinggw1.Caption;
    lb_pingip1.Font.Color:=lb_pinggw1.Font.Color;
    btn_openbrws.Enabled:=false;
end;
 
procedure TFshow.FormCreate(Sender: TObject);
begin
    Fshow.pingtest;
end;
 
procedure TFshow.FormShow(Sender: TObject);
begin
   Application.ProcessMessages;
   pingtest;
end;
 
procedure TFshow.im_cmdip1Click(Sender: TObject);
var
s:ansistring;
begin
    s:='ping.exe '+ lb_ip1.Caption+' -t';
   WinExec(pansichar(s), sw_show);
end;
 
procedure TFshow.im_cmdgw1Click(Sender: TObject);
var
s:ansistring;
begin
    s:='ping.exe '+ lb_gw1.Caption+' -t';
    WinExec(Pansichar(s), sw_show);
end;
 
end.

4я и 8я тут:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
procedure TFmain.jvsgDblClick(Sender: TObject);
var
j:integer;
frm:TFshow;
begin
      if (CurRow<>0) and (Length(forshow)>0) then
      begin
          frm:=TFShow.Create(Self);
          j:=StrToInt(jvsg.Cells[0,CurRow]);
          frm.Caption:='Объект '+pod[j].depart+' №'+pod[j].code;
          frm.lb_name.Caption:=pod[j].name;
          frm.lb_adr.Caption:='Адрес: '+pod[j].adress;;
          frm.lb_ip1.Caption:=pod[j].externalip1;
          frm.lb_gw1.Caption:=pod[j].gw1;
          frm.lb_name.Width:=430;
          frm.lb_adr.Top:=frm.lb_name.Top+frm.lb_name.Height+3;
          frm.lb_adr.Width:=430;
          frm.show;
      end;
end;

@qwertehok · 30.12.2017, 01:03

это ты переменную объявляешь
но сам объект то не создан

@BagrAlex · 30.12.2017, 15:51

А что ж у меня тогда открывается....((
Форма TFShow появляется сколько угодно раз, данные в компонентах в каждой форме верные, только процедура (которая теперь метод) не работает.

@qwertehok · 30.12.2017, 16:58

Сообщение от BagrAlex

TFShow

это не форма

Сообщение от BagrAlex

frm:TFshow;
...
begin
...
frm:=TFShow.Create(Self);
...
frm.show;

frm - это форма
ты ее создал и показал

Сообщение от BagrAlex

только процедура (которая теперь метод) не работает.

на какой строке ошибка?

@Massaraksh7 · 30.12.2017, 17:23

Возможно, она создается в dpr

Новые блоги и статьи Все статьи Все блоги /
Был там один разговор по поводу свободы в материальном мире. kumehtar 19.08.2026 Суть: рассматривается живое существо, оказавшееся внутри довольно странной системы (этого мира) и пытающееся обустроить в ней свой кусок пространства. Жизнь действительно предъявляет каждому. . .	Когда логика программы не спасает от человеческих ошибок Maks 18.08.2026 В последнее время всё чаще и чаще сталкиваюсь с таким явлением, как абсолютная невнимательность (или глупость) пользователей. Проявляется это чаще всего на работе в коллективе. Допустим, человек с. . .	Лето уходит kumehtar 17.08.2026	Мысли в слух kumehtar 17.08.2026 Забавно, насколько сейчас стала доступна информация. Например о магии, духовном развитии, медитациях, и других подобных направлениях, ранее зачастую тайных, передаваемых от учителя к ученику. Хотя. . .
Перемещение строк из ТЧ в другой документ с учетом текущего пробега Maks 17.08.2026 Реализация из решения ниже выполнена на примере нетипового документа "Автозапчасти", с ТЧ "Шины". За основу взят алгоритм отсюда: https:/ / www. cyberforum. ru/ blogs/ 359708/ 10838. html Задача: . . .	Саморегулирующийся социальный контракт для сервера cross-section. Hrethgir 14.08.2026 С кодом конечно таких глубоких размышлений пока не было, впрочем я уже привык к алгоритмизации. Суть предмета записи: снова в диалоге с нейросетью (я взял пока себе ник для учётки админа - Rector). . . .	Часы электронные Uhbif79 12.08.2026 Выкладываю программу часов. Программа позволяет: 1. Использовать системное время и дату, 2. Есть возможность вводить время и дату вручную. 3. Реализованы 2 будильника: начало и конец рабочего дня. . . .	Часы с будильником на основе класса QLCDNumber Uhbif79 12.08.2026 Всем добрый день, выкладываю программу часов с будильником на основе класса QLCDNumber. Здесь я пробовал самостоятельно создавал классы, впервые столкнулся с видимостью переменной одного класса из. . .

@hsimpson 1 / 1 / 3 Регистрация: 21.05.2012 Сообщений: 246

	Запустить форму несколько раз 26.07.2016, 00:43. Показов 5797. Ответов 51 Метки нет (Все метки) Моё почтение, уважаемые! Подскажите, можно ли единовременно запустить одну форму несколько раз (с разными значениями)? Например, у меня есть сообщение для пользователя, которое индицируется на предназначенной для этого форме. А как быть, если таких сообщений несколько? Причём, их нужно показать одновременно. Причём, заранее неизвестно, сколько точно их будет. Спасибо. 0

@hsimpson 1 / 1 / 3 Регистрация: 21.05.2012 Сообщений: 246
	29.12.2017, 19:55 [ТС]
	Уважаемые, всех с Новым годом! Всем - всего хорошего и побольше. 0

@qwertehok 6001 / 4576 / 1096 Регистрация: 29.08.2013 Сообщений: 28,264 Записей в блоге: 3
	29.12.2017, 21:02
	BagrAlex, ошибка памяти - значит ты вызываешь то чего нет где ты создаешь Fshow: TFshow;? hsimpson, и вам того же как ваш проект? 0

@hsimpson 1 / 1 / 3 Регистрация: 21.05.2012 Сообщений: 246
	29.12.2017, 21:24 [ТС]
	Ноябрь и декабрь - в полиграфии сезон, так что программирование пока побоку. В январе, возможно снова засяду. 0

@qwertehok 6001 / 4576 / 1096 Регистрация: 29.08.2013 Сообщений: 28,264 Записей в блоге: 3
	30.12.2017, 01:03
	это ты переменную объявляешь но сам объект то не создан 0

@BagrAlex 0 / 0 / 0 Регистрация: 15.04.2015 Сообщений: 35
	30.12.2017, 15:51
	А что ж у меня тогда открывается....(( Форма TFShow появляется сколько угодно раз, данные в компонентах в каждой форме верные, только процедура (которая теперь метод) не работает. 0

@Massaraksh7 Айлурофил 518 / 451 / 112 Регистрация: 27.05.2017 Сообщений: 2,749 Записей в блоге: 7
	30.12.2017, 17:23
	Возможно, она создается в dpr 0