You are not logged in. Please login or register.
My Visual Database → Russian → Закрытие всех форм, кроме...
Всем привет. Есть вопрос, можно ли по нажатию одной кнопки закрыть все формы, кроме одной. Было-бы удобно для быстрого перехода например на стартовую страницу не закрывая все остальные открытые, а что бы они закрывались сами. И было бы хорошо реализовать данную функцию без перечесления всех имеющихся в базе форм (например frmOrder.Close; и т.д , их мягко говоря много))).....Что нибудь типа закрыть всё кроме.
Здравствуйте.
Скачайте пожалуйста последнюю бета версию 3.6
https://www.dropbox.com/s/4rfukqr2r1awq … b.zip?dl=0
Пример:
procedure frmNumber_Button3_OnClick (Sender: string; var Cancel: boolean);
begin
CloseForms(frmAbonent);
end;
procedure CloseForms(exceptForm: TForm);
var
i,c: integer;
begin
c := Screen.FormCount-1;
for i := c downto 0 do
begin
if (Screen.Forms[i] is TAForm) and
(Screen.Forms[i] <> exceptForm) and
(Screen.Forms[i].ClassName <>'TfrmMaindbCore') then Screen.Forms[i].Close;
end;
end;процедура CloseForms закроет все формы кроме той, которая указана в параметрах, также главная форма также не будет закрыта.
Здравствуйте.
Скачайте пожалуйста последнюю бета версию 3.6
https://www.dropbox.com/s/4rfukqr2r1awq … b.zip?dl=0Пример:
procedure frmNumber_Button3_OnClick (Sender: string; var Cancel: boolean); begin CloseForms(frmAbonent); end; procedure CloseForms(exceptForm: TForm); var i,c: integer; begin c := Screen.FormCount-1; for i := c downto 0 do begin if (Screen.Forms[i] is TAForm) and (Screen.Forms[i] <> exceptForm) and (Screen.Forms[i].ClassName <>'TfrmMaindbCore') then Screen.Forms[i].Close; end; end;процедура CloseForms закроет все формы кроме той, которая указана в параметрах, также главная форма также не будет закрыта.
Спасибо! Дмитрий, а по посту "Уникальное имя изображения" не подскажите?
Здравствуйте.
Скачайте пожалуйста последнюю бета версию 3.6
https://www.dropbox.com/s/4rfukqr2r1awq … b.zip?dl=0Пример:
procedure frmNumber_Button3_OnClick (Sender: string; var Cancel: boolean); begin CloseForms(frmAbonent); end; procedure CloseForms(exceptForm: TForm); var i,c: integer; begin c := Screen.FormCount-1; for i := c downto 0 do begin if (Screen.Forms[i] is TAForm) and (Screen.Forms[i] <> exceptForm) and (Screen.Forms[i].ClassName <>'TfrmMaindbCore') then Screen.Forms[i].Close; end; end;процедура CloseForms закроет все формы кроме той, которая указана в параметрах, также главная форма также не будет закрыта.
Работает!!! СПАСИБО!
Дмитрий ещё раз здравствуйте. Сделал эту процедуру в двух формах. Если не комментировать одну из них, то во второй подсвечивается красным
procedure CloseForms(exceptForm: TForm);
Что не так?
Дмитрий ещё раз здравствуйте. Сделал эту процедуру в двух формах. Если не комментировать одну из них, то во второй подсвечивается красным
procedure CloseForms(exceptForm: TForm);
Что не так?
Не совсем понял, приведите ваш скрипт полностью
kovalenko wrote:Дмитрий ещё раз здравствуйте. Сделал эту процедуру в двух формах. Если не комментировать одну из них, то во второй подсвечивается красным
procedure CloseForms(exceptForm: TForm);
Что не так?Не совсем понял, приведите ваш скрипт полностью
procedure frmApplication_Button1_OnAfterClick (Sender: string);
var
dbFileName, sFileName, sNewFileName: string;
begin
if frmApplication.DBImage1.dbImageIsChanged then
begin
sFileName := frmApplication.DBImage1.dbFileName;
sFileName := ExtractFileDir(Application.ExeName)+sFileName;
sNewFileName := ExtractFilePath(Application.ExeName) + frmApplication.DBImage1.dbCopyTo + '\'+ frmApplication.edCounter.Text + '_' + DateToStr(frmApplication.dtDate.Date) + ExtractFileExt(sFileName);
dbFileName := '"\'+frmApplication.DBImage1.dbCopyTo + '\'+ frmApplication.edCounter.Text + '_' + DateToStr(frmApplication.dtDate.Date) + ExtractFileExt(sFileName)+'"';
if FileExists(sNewFileName) then
begin
if IDYES = MessageBox('File exists.' + #13+ sNewFileName+#13+ 'Overwrite?', 'Warning', MB_YESNO+MB_ICONQUESTION) then
begin
DeleteFile(sNewFileName);
if RenameFile(sFileName, sNewFileName) then SQLExecute('UPDATE application SET PhotoIn1_filename = '+dbFileName + ' WHERE id='+IntToStr(frmApplication.Button1.dbGeneralTableId));
end;
end;
end;
{if frmApplication.DBImage2.dbImageIsChanged then
begin
sFileName := frmApplication.DBImage2.dbFileName;
sFileName := ExtractFileDir(Application.ExeName)+sFileName;
sNewFileName := ExtractFilePath(Application.ExeName) + frmApplication.DBImage2.dbCopyTo + '\'+ frmApplication.edCounter.Text + '_' + DateToStr(frmApplication.dtDate.Date) + ExtractFileExt(sFileName);
dbFileName := '"\'+frmApplication.DBImage2.dbCopyTo + '\'+ frmApplication.edCounter.Text + '_' + DateToStr(frmApplication.dtDate.Date) + ExtractFileExt(sFileName)+'"';
if FileExists(sNewFileName) then
begin
if IDYES = MessageBox('File exists.' + #13+ sNewFileName+#13+ 'Overwrite?', 'Warning', MB_YESNO+MB_ICONQUESTION) then
begin
DeleteFile(sNewFileName);
if RenameFile(sFileName, sNewFileName) then SQLExecute('UPDATE person SET photo2_filename = '+dbFileName + ' WHERE id='+IntToStr(frmApplication.Button1.dbGeneralTableId));
end;
end;
end;
if frmApplication.DBImage3.dbImageIsChanged then
begin
sFileName := frmApplication.DBImage3.dbFileName;
sFileName := ExtractFileDir(Application.ExeName)+sFileName;
sNewFileName := ExtractFilePath(Application.ExeName) + frmApplication.DBImage3.dbCopyTo + '\'+ frmApplication.edCounter.Text + '_' + DateToStr(frmApplication.dtDate.Date) + ExtractFileExt(sFileName);
dbFileName := '"\'+frmApplication.DBImage3.dbCopyTo + '\'+ frmApplication.edCounter.Text + '_' + DateToStr(frmApplication.dtDate.Date) + ExtractFileExt(sFileName)+'"';
if FileExists(sNewFileName) then
begin
if IDYES = MessageBox('File exists.' + #13+ sNewFileName+#13+ 'Overwrite?', 'Warning', MB_YESNO+MB_ICONQUESTION) then
begin
DeleteFile(sNewFileName);
if RenameFile(sFileName, sNewFileName) then SQLExecute('UPDATE person SET photo3_filename = '+dbFileName + ' WHERE id='+IntToStr(frmApplication.Button1.dbGeneralTableId));
end;
end;
end;}
end;
Упс..не то. Сейчас пришлю. Дмитрий, а вот по этому скрипту, что-то у меня не присваивается имя изображению. Пытался сделать для пробы на одно изображение, не хочет работать....
Здравствуйте.
Скачайте пожалуйста последнюю бета версию 3.6
https://www.dropbox.com/s/4rfukqr2r1awq … b.zip?dl=0Пример:
procedure frmNumber_Button3_OnClick (Sender: string; var Cancel: boolean); begin CloseForms(frmAbonent); end; procedure CloseForms(exceptForm: TForm); var i,c: integer; begin c := Screen.FormCount-1; for i := c downto 0 do begin if (Screen.Forms[i] is TAForm) and (Screen.Forms[i] <> exceptForm) and (Screen.Forms[i].ClassName <>'TfrmMaindbCore') then Screen.Forms[i].Close; end; end;процедура CloseForms закроет все формы кроме той, которая указана в параметрах, также главная форма также не будет закрыта.
Дмитрий, а разве
procedure frmNumber_Button3_OnClick (Sender: string; var Cancel: boolean);
begin
CloseForms(frmAbonent);
end;
Не закроет формы? Хотелось-бы понять смысл во второй части скрипта.
Дмитрий, а разве
procedure frmNumber_Button3_OnClick (Sender: string; var Cancel: boolean);
begin
CloseForms(frmAbonent);
end;Не закроет формы? Хотелось-бы понять смысл во второй части скрипта.
Вторая часть скрипта (procedure CloseForms(exceptForm: TForm);) это реализация данной процедуры (CloseForms), т.е. вы ее как бы вызываете.
Здравствуйте.
Скачайте пожалуйста последнюю бета версию 3.6
https://www.dropbox.com/s/4rfukqr2r1awq … b.zip?dl=0Пример:
procedure frmNumber_Button3_OnClick (Sender: string; var Cancel: boolean); begin CloseForms(frmAbonent); end; procedure CloseForms(exceptForm: TForm); var i,c: integer; begin c := Screen.FormCount-1; for i := c downto 0 do begin if (Screen.Forms[i] is TAForm) and (Screen.Forms[i] <> exceptForm) and (Screen.Forms[i].ClassName <>'TfrmMaindbCore') then Screen.Forms[i].Close; end; end;процедура CloseForms закроет все формы кроме той, которая указана в параметрах, также главная форма также не будет закрыта.
Дмитрий здравствуйте. Перестало работать закрытие окон, при попытке использовать данную функцию, выпадает окно с "stack overflow" и через некоторое время программа закрывается.
Пожалуйста приложите ваш проект, в котором данный скрипт не работает.
My Visual Database → Russian → Закрытие всех форм, кроме...
Powered by PunBB, supported by Informer Technologies, Inc.
Theme Hydrogen by Kushi