• Курсы Академии Кодебай, стартующие в мае - июне, от команды The Codeby

    1. Цифровая криминалистика и реагирование на инциденты
    2. ОС Linux (DFIR) Старт: 16 мая
    3. Анализ фишинговых атак Старт: 16 мая Устройства для тестирования на проникновение Старт: 16 мая

    Скидки до 10%

    Полный список ближайших курсов ...

Form1.close из модальной формы...

  • Автор темы Shaman2008
  • Дата начала
S

Shaman2008

Здравствуйте уважаемые форумчане!
Такая ситуация. Есть две формы, главная и доступная...

Код главной формы:
Код:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, DB, ADODB, Grids, DBGrids, IniFiles, Math;

type
TForm1 = class(TForm)
DBGrid1: TDBGrid;
DBRead: TADODataSet;
DataSource1: TDataSource;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
ConfigFile: TIniFile;
PathZDB: string;

implementation

uses Unit2;

{$R *.dfm}


procedure TForm1.FormCreate(Sender: TObject);
begin
PathZDB := '';
Timer1.Enabled := False;
if Fileexists('db.ini') = False then begin
ConfigFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'db.ini')
end else begin
ConfigFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'db.ini');
PathZDB := ConfigFile.ReadString('DB', 'PathZDB', '');
end;

end;

procedure TForm1.FormActivate(Sender: TObject);
begin
if (PathZDB = '') OR (fileexists(PathZDB) = False) then begin
Form2 := TForm2.Create(self);
Form2.ShowModal
end
else begin
DBRead.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+PathZDB+';Persist Security Info=False';
DBRead.Active := True;
FormResize(self);
Timer1.Enabled := True
end;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
DBRead.Fields.FieldByName('ID').Visible := False;
DBRead.Fields.FieldByName('Done').Visible := False;
DBRead.Fields.FieldByName('Worker_Done').Visible := False;
DBRead.Fields.FieldByName('Done_Timer').Visible := False;
DBRead.Fields.FieldByName('Done_Dater').Visible := False;
DBGrid1.Columns[0].Title.Caption := 'Äàòà';
DBGrid1.Columns[0].Title.Font.Size := 15;
//DBGrid1.Columns[0].Width := Math.Floor(ClientWidth * 0.05);
DBGrid1.Columns[1].Title.Caption := 'Âðåìÿ';
DBGrid1.Columns[1].Title.Font.Size := 15;
//DBGrid1.Columns[1].Width := Math.Floor(ClientWidth * 0.05);
DBGrid1.Columns[2].Title.Caption := 'Îðãàíèçàöèÿ';
DBGrid1.Columns[2].Title.Font.Size := 15;
//DBGrid1.Columns[2].Width := Math.Floor(ClientWidth * 0.1);
DBGrid1.Columns[3].Title.Caption := 'Àäðåñ';
DBGrid1.Columns[3].Title.Font.Size := 15;
//DBGrid1.Columns[3].Width := Math.Floor(ClientWidth * 0.1);
DBGrid1.Columns[4].Title.Caption := 'Êàáèíåò';
DBGrid1.Columns[4].Title.Font.Size := 15;
//DBGrid1.Columns[4].Width := Math.Floor(ClientWidth * 0.1);
DBGrid1.Columns[5].Title.Caption := 'Çàÿâêà';
//DBGrid1.Columns[5].Width := DBGrid1.Width - (DBGrid1.Columns[0].Width + DBGrid1.Columns[1].Width + DBGrid1.Columns[2].Width + DBGrid1.Columns[3].Width + DBGrid1.Columns[4].Width + 21);
DBGrid1.Columns[5].Title.Font.Size := 15;
DBGrid1.Columns[0].Width := Math.Floor(ClientWidth * 0.08);
DBGrid1.Columns[1].Width := Math.Floor(ClientWidth * 0.065);
DBGrid1.Columns[2].Width := Math.Floor(ClientWidth * 0.2);
DBGrid1.Columns[3].Width := Math.Floor(ClientWidth * 0.12);
DBGrid1.Columns[4].Width := Math.Floor(ClientWidth * 0.11);
DBGrid1.Columns[5].Width := DBGrid1.Width - (DBGrid1.Columns[0].Width + DBGrid1.Columns[1].Width + DBGrid1.Columns[2].Width + DBGrid1.Columns[3].Width + DBGrid1.Columns[4].Width + 9);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
DataSource1.Enabled := False;
DBRead.Active := False;
DBRead.Active := True;
DataSource1.Enabled := True;
FormResize(self);
end;


procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
if (Date - StrToDate(TDBGrid(Sender).Fields[0].Value)) > 0 then begin
TDBGrid(Sender).Canvas.Brush.Color := clMaroon;
TDBGrid(Sender).Font.Color := clWhite;
end else if (Date - StrToDate(TDBGrid(Sender).Fields[0].Value)) = 0 then begin
if ((Time - StrToTime(TDBGrid(Sender).Fields[1].Value)) > 0) AND ((Time - StrToTime(TDBGrid(Sender).Fields[1].Value)) < 0.020) then begin
TDBGrid(Sender).Canvas.Brush.Color := clWhite;
TDBGrid(Sender).Font.Color := clBlack;
end else if ((Time - StrToTime(TDBGrid(Sender).Fields[1].Value)) > 0.020) AND ((Time - StrToTime(TDBGrid(Sender).Fields[1].Value)) < 0.060) then begin
TDBGrid(Sender).Canvas.Brush.Color := clYellow;
TDBGrid(Sender).Font.Color := clBlack;
end else begin
TDBGrid(Sender).Canvas.Brush.Color := clRed;
TDBGrid(Sender).Font.Color := clWhite;
end
end;
TDBGrid(Sender).DefaultDrawColumnCell(rect, DataCol, Column, State);

end;

end.

и код доступной:
Код:
unit Unit2;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm2 = class(TForm)
Label1: TLabel;
Zajavka_Path: TLabel;
Button1: TButton;
Button2: TButton;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form2: TForm2;

implementation

uses Unit1;

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
begin
OpenDialog1.Execute;
if length(OpenDialog1.FileName) <> 0 then begin
Zajavka_Path.Caption := OpenDialog1.FileName;
OpenDialog1.Free;
end else OpenDialog1.Free;
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
Form1.Close;
if length(Zajavka_Path.Caption) <> 0 then begin
if FileExists(Zajavka_Path.Caption) then ConfigFile.WriteString('DB', 'PathZDB', Zajavka_Path.Caption);
end;
ConfigFile.Free;
Form2.Close;
end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ShowMessage('Перезапустите приложение!');
Form1.Close;
end;



end.

Так вот. Не знаю по какой причине, перестала работать команда Form1.Close (событие TForm2.FormClose) ;
Приложение выполняется так, будто команды Form1.Close нету вообще!
И при этом, после закрытия модальной формы начинает выполнение процедура TForm1.FormResize(Sender: TObject), хотя никакого вызова нету, ну по крайней мере, в том случае, если файл конфига отсутствует....
Помогите, где ошибка?
 
S

Shaman2008

Form1.Close (событие TForm2.FormClose




Кто на ком сидел?

Form1.Close вызывается в TForm2.FormClose (то есть при закрытии модальной формы)....

Если я правельно понял, то Form2 на Form1 )))

Вообщем вторая форма создается и отображается через ShowModal при АКТИВАЦИИ первой формы, в случае если программа не смогла загрузить путь до БД из ини файла или если ини файла вообще не существует...

Раньше работало так, как написано, почему сейчас перестало, не пойму ><
 
S

Shaman2008

Ни у кого никаких соображений? (((
Form1.Destroy крит выдает...
 
S

Shaman2008

Вы имеете в виду "Step Over" "Step Into"?
То есть пройти по шагам???
Если да, то проходил, и если честно так и не понял, где происходит сбой! Но что странно, чувство такое будто Unit1 выполняется подряд, то есть процедуру за процедурой!
После компилирования, приложение оказывается закрывается, если запускать ехе-шник, но видно как окошко с ошибкой появляется и тут же закрывается приложение, то есть Form1.Close работает, но почему успевает сработать процедура TForm1.FormResize(Sender: TObject) ??? Я ведь даже нигде ее не вызываю к тому моменту? :rolleyes:
И еще, если просто сделать две формы и одну вызвать из другой через showmodal и прописать на закрытие второй формы Form1.Close то все работает как положено....

Добавлено: sax_ol Можно ваш ICQ если есть и если можно :)
 
S

Shaman2008

Сбой происходит здесь:
procedure TForm1.FormResize(Sender: TObject);
begin
DBRead.Fields.FieldByName('ID').Visible := False;... Он ругается на то, что не может найти столбец с названием ID.

Это и понятно, потому как в процедуре
procedure TForm1.FormActivate(Sender: TObject);
begin
if (PathZDB = '') OR (fileexists(PathZDB) = False) then begin
Form2 := TForm2.Create(self);
Form2.ShowModal
end

else begin
DBRead.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+PathZDB+';Persist Security Info=False';
DBRead.Active := True;
FormResize(self);
Timer1.Enabled := True

end;
end;

выпоняется первая часть, которая выделена фиолетовым цветом, так как условие if (PathZDB = '') OR (fileexists(PathZDB) = False) then begin выполняется...
и не выполняется вторая (выделена синим), то есть строка подключения к базе остается пустой...

Но по идее, выполнение приложения должно остановиться после первой части (фиолетовым выделено), так как после Form2.ShowModal ничего нет...
Но вопреки вызывается процедура TForm1.FormResize.... Почему, не пойму ><

Вот скрин ошибки, она мне понятна, не понятно почему процедура вызывается тогда, когда не должна! ><
err.jpg
 
S

Shaman2008

ТОЧНО!!!!!!!!!!!!!!!!!!!!!!! Блин...как же я сам не догадался....у меня ведь есть FormResize(SELF)... То есть можно просто проверку написать, если DBRead.ConnectionString <> '' then и изменять размеры и все остальное.... А если не секрет, как можно завершить приложение корректно, ни тогда, когда первая ворма была активирована, а на стадии OnCreate? Ведь если я правельно понял, что если не было "Create" то и "Close" нечего получается....

Если быть точнее, как реализовать корректно 1 вариант? Надо все проверить в OnCreate и вывести второе окно через ShowModal Не активируя первое, но как правельно завершить приложение из второго окна не активировав первое???
 
S

Shaman2008

Лучше Create не делать, тогда и Close не нужен. см. п. 1) из предыдущего.
нет, OnCreate работает после того как создалось окно, так что закрывать его нужно.

Значит главным окном нужно сделать второе, и просто его скрывать если все нормально, так чтоли?

Но в любом случае я исправил это:
Код:
procedure TForm123.FormResize(Sender: TObject);
begin
DBRead.Fields.FieldByName('ID').Visible := False;
....
DBGrid1.Columns[5].Width := DBGrid1.Width - (DBGrid1.Columns[0].Width + DBGrid1.Columns[1].Width + DBGrid1.Columns[2].Width + DBGrid1.Columns[3].Width + DBGrid1.Columns[4].Width + 9);
end;
end;

на это:
Код:
procedure TForm123.FormResize(Sender: TObject);
begin
if DBRead.ConnectionString <> '' then begin
DBRead.Fields.FieldByName('ID').Visible := False;
....
DBGrid1.Columns[5].Width := DBGrid1.Width - (DBGrid1.Columns[0].Width + DBGrid1.Columns[1].Width + DBGrid1.Columns[2].Width + DBGrid1.Columns[3].Width + DBGrid1.Columns[4].Width + 9);
end;
end;

Теперь никакой ошибки нет! :) Спасибо! :rolleyes:
 
S

Shaman2008

Классно! Я подозревал, что можно все это делать не в Unitах а в непосредственно перед запуском приложения... :rolleyes: Спасибо еще раз вам!!!!!!
А еще можно вопрос?? :) А почему у вас TForm2.Create(nil) а не TForm2.Create(self)? То есть как бы "ничто" вызывает событие TForm2.Create ?
 
S

Shaman2008

Спасибо, понял...правда, нету ведь самой формы еще...
 
Мы в соцсетях:

Обучение наступательной кибербезопасности в игровой форме. Начать игру!