Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  | Правила  

Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Программирование и базы данных » Delphi - Немодальные окна в Delphi

Ответить
Настройки темы
Delphi - Немодальные окна в Delphi

Пользователь


Сообщения: 75
Благодарности: 0

Профиль | Отправить PM | Цитировать


Доброго времени суток, уважаемые форумчане. Вопрос по поводу создания не модальных окон в делфи. В приложение при закрытии которого происходит сбой. Т.е. программа вызывает из dll библиотеки немодальное окно там пользователь совершает манипуляции и выходит из него. И если мы закрываем наше приложение, то выскакивает сообщение винды о сбое и в диспетчере задач остается в памяти процесс приложения и идет загруз ЦП на 50-60 процентов Уже все перепробовал даже не знаю что может быть.

Исходный код exe файла:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, ShockwaveFlashObjects_TLB, ExtCtrls, StdCtrls, ShellApi,
AppEvnts, Menus, XPMan;

function ADDBASE(Handle: THandle; connect: string):LongInt;stdcall;
procedure FREEBASE(RefForm: LongInt);export;stdcall

type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
ShockwaveFlash1: TShockwaveFlash;
ComboBox1: TComboBox;
XPManifest1: TXPManifest;
Label1: TLabel;
ShockwaveFlash2: TShockwaveFlash;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure ShockwaveFlash1FSCommand(ASender: TObject; const command,
args: WideString);
function PoiskBD : TStringList;
procedure ComboBox1Enter(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure ShockwaveFlash2FSCommand(ASender: TObject; const command,
args: WideString);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
f : LongInt;
function ADDBASE; external 'source1\add\bibl\Project1.dll';
procedure FREEBASE;external 'source1\add\bibl\Project1.dll';

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var R1 : HRGN;
begin
R1:= CreateRoundRectRgn(0, 0, Width-1, Height-1,40, 40);

SetWindowRgn(Handle, R1, True);

form1.Color:=$00999966;
ShockwaveFlash1.Movie := ExtractFilePath(Application.ExeName) + '1.swf';
ShockwaveFlash2.Movie := ExtractFilePath(Application.ExeName) + 'source1\add\bibl\1.swf';

end;

procedure TForm1.ShockwaveFlash1FSCommand(ASender: TObject; const command,
args: WideString);
begin
if command = 'Click' then Form1.Close;
end;

function TForm1.PoiskBD: TStringList;
var
searchResult : TSearchRec;
Find: String;
Begin
Find:=ExtractFileDir(Application.ExeName)+'\base\*.xml';
Result:=TStringList.Create;
if FindFirst(Find, faAnyFile, searchResult) = 0 then
begin
repeat
Result.Add(searchResult.Name);
until FindNext(searchResult) <> 0;
FindClose(searchResult);
end;
end;

procedure TForm1.ComboBox1Enter(Sender: TObject);
begin
Form1.ComboBox1.Items:=Form1.PoiskBD;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
ShockwaveFlash1.CallFunction('<invoke name="myFunction" returntype="xml"><arguments><string>base\'+Form1.ComboBox1.Text+'</string></arguments></invoke>');
end;

procedure TForm1.ShockwaveFlash2FSCommand(ASender: TObject; const command,
args: WideString);
begin
if command='exit' then Form1.Close;
if command='add' then Begin
end;
if command='delete' then ShowMessage('Óäàëèòü');
if command='replace' then ShowMessage('Èçìåíèòü');
if command='new' then ShowMessage('Ñîçäàòü');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if f>0 then
FREEBASE(f);
f:=ADDBASE(Application.Handle, ExtractFilePath(Application.ExeName)+'base\'+Form1.ComboBox1.Text);
end;

end.


Исходный код окна в dll библиотеки

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, jpeg, ExtCtrls, OleCtrls, ShockwaveFlashObjects_TLB,xmldom, XMLIntf, msxmldom, XMLDoc,
AppEvnts;

type
TForm1 = class(TForm)
Image1: TImage;
Label1: TLabel;
Edit1: TEdit;
Label2: TLabel;
Edit2: TEdit;
Label3: TLabel;
Edit3: TEdit;
Button1: TButton;
Label4: TLabel;
Memo1: TMemo;
OpenDialog1: TOpenDialog;
ShockwaveFlash1: TShockwaveFlash;
ApplicationEvents1: TApplicationEvents;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure ADD;
procedure FormActivate(Sender: TObject);
procedure ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
procedure ShockwaveFlash1FSCommand(ASender: TObject; const command,
args: WideString);
private
{ Private declarations }
procedure WMNCHitTest(var Message: TWMNCHitTest);message WM_NCHITTEST;
public
{ Public declarations }
end;

var
Form1: TForm1;
Base : String;
function ADDBASE(Handle: THandle; connect: string):LongInt;export;stdcall;
procedure FREEBASE(RefForm : LongInt); export; stdcall;

implementation

{$R *.dfm}


function ADDBASE(Handle: THandle; connect : string): LongInt;
Begin
Application.Handle:=Handle;
Form1:=TForm1.Create(Application);

Result:=LongInt(Form1);

Base:=connect;
Form1.Show;

end;


procedure FREEBASE(RefForm: LongInt);
Begin
if RefForm>0 then TForm1(RefForm).Release;
end;


procedure TForm1.FormCreate(Sender: TObject);
var
R1: HRgn;
begin
R1:= CreateRoundRectRgn(0, 0, Width-1, Height-1,40, 40);

SetWindowRgn(Handle, R1, True);

end;

procedure TForm1.Add;
var Xml: IXMLDocument;
Summ : integer;
begin
xml:=TXMLDocument.Create(nil);
xml.LoadFromFile(Base);
xml.Active:=True;

Summ:=xml.DocumentElement.ChildNodes.Count+1;
with xml.ChildNodes['images'].AddChild('image') do
Begin
Attributes['id']:=IntToStr(Summ);

ChildValues ['title'] := Edit1.Text;

ChildValues['names']:=Edit2.Text;

ChildValues['img']:=Edit3.Text;

ChildValues['opis']:=Memo1.Text;
end;
xml.SaveToFile(Base);
xml.Active:=False;
Edit1.Text:='';
Edit2.Text:='';
Edit3.Text:='';
Memo1.Text:='';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if Form1.OpenDialog1.Execute=true then Edit3.Text:=Form1.OpenDialog1.FileName;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
Form1.ShockwaveFlash1.Movie:=ExtractFilePath(Application.ExeName)+'source1\add\bibl\1.swf';
end;

procedure TForm1.WMNCHitTest(var Message: TWMNCHitTest);
begin
inherited;
Message.Result := HTCAPTION;
end;

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
begin
if msg.message = WM_RBUTTONDOWN then
Handled := True;
end;

procedure TForm1.ShockwaveFlash1FSCommand(ASender: TObject; const command,
args: WideString);
begin
if command='add' then ADD;
if command='exit' then Form1.Close;
end;

end.

И код самой библиотеки:
library Project1;


uses
SysUtils,
Classes,
Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

exports
ADDBASE,
FREEBASE;


begin
end.

Помогите, в чем может быть проблема и как ее исправить.

Отправлено: 19:36, 21-07-2013

 

Пользователь


Сообщения: 75
Благодарности: 0

Профиль | Отправить PM | Цитировать


Изображения
Тип файла: jpg 1.jpg
(189.6 Kb, 13 просмотров)

Прикладываю скрин ошибки которую выдает делфи

Отправлено: 19:40, 21-07-2013 | #2



Для отключения данного рекламного блока вам необходимо зарегистрироваться или войти с учетной записью социальной сети.

Если же вы забыли свой пароль на форуме, то воспользуйтесь данной ссылкой для восстановления пароля.

pva pva вне форума

Аватара для pva

Ветеран


Сообщения: 1180
Благодарности: 279

Профиль | Отправить PM | Цитировать


Greshnick, Судя по коду, валится на месте вызова виртуальной функции (скорее всего она вызывается в цикле, а объект ты удалил, значит нет указателя на виртуальную таблицу)
Попробуй:
1. добавь проверку или блокировку на все циклы в программе. При выходе подай сигнал, если есть активные циклы.
2. посмотри стек, возможно найдёшь в нём, что за цикл у тебя выполняется
Полезно добавить (и пусть меня побьют) _глобальную_ булевую переменную, говорящую о завершении программы. Все циклы должны проверять, что она равна "не завершено".

Можно выяснить, что за функция:
1. запускаешь проект
2. открываешь disassembly, находишь адрес ip=0x22331e, ставишь на него брейк-поинт
3. запускаешь отладку, делаешь что угодно (только не закрываешь). Рано или поздно на нём встаешь
4. Открываешь стек вызовов, смотришь, как туда пришло
Скорее всего окажется какой-нибудь onPaint в флеше, но найдёшь к нему путь, разорвёшь внешний цикл, добавишь ему какой-нибудь stopFlash()
Это сообщение посчитали полезным следующие участники:

Отправлено: 09:54, 22-07-2013 | #3


Пользователь


Сообщения: 75
Благодарности: 0

Профиль | Отправить PM | Цитировать


Пытался сделать окно модальным, но...загвозка вот в чем я сделал кнопку во флеш портировал ее в делфи. Через нее вызываю dll. в коде видно. И дальше просто жесть когда вызвана dll идет загрузка проца 50-60 пока не закроешь окошко. Если вызываю это же окошко но со стандартной buttonки все норм. Такое ощущение, что первое окно становится не доступно, а анимация которая идет во флешке начинает кричать что мне нужен доступ и грузить проц. Ошибок при выходе нету.

Есть ли какое нить решение. "АткрИл я Америка!" узнал про GDIi+, но не умею пользоваться его функциями. Нашел в нете учебник ОСИПОВ графика в проектах делфи описание кричало что есть про GDI+ может по пробовать кнопочку так разработать. Уже очень хочется ВАУ эффекта в программе.

Отправлено: 11:01, 22-07-2013 | #4


Ветеран


Сообщения: 27449
Благодарности: 8087

Профиль | Отправить PM | Цитировать


Greshnick, поверьте — приложение должно 1) работать, 2) правильно и 3) эффективно. Оставьте «Wow!»-фефекты на долю MS, Apple и прочего «ширпотреба для избранных».

Отправлено: 11:18, 22-07-2013 | #5


Пользователь


Сообщения: 75
Благодарности: 0

Профиль | Отправить PM | Цитировать


Iska, Да я бы давно написал эту программу и не парился. Без этой фигни я бы ее за 3 дня написал и все. Но хочется что бы препод увидел еще красивое оформление...Да и научится хочется самому делать красивые программы в стеле "прочего «ширпотреба для избранных»". Ну интересно мне...

Отправлено: 11:36, 22-07-2013 | #6


Аватара для lxa85

Необычный


Contributor


Сообщения: 4463
Благодарности: 994

Профиль | Сайт | Отправить PM | Цитировать


Greshnick, можно вас попросить прикрепить проект в архиве?
Я в TurboDelphi посмотрю.
----
Цитата Greshnick:
Но хочется что бы препод увидел еще красивое оформление... »
Как препод. Лично мне пофигу красивое оформление. Программа должна работать и быть снабжена соотв. документацией. (Если препод женщина И(ИЛИ) "ведется" на wow-эффекты - это другой вопрос)
"Wow!" эффект - будет рассмотрен строго после того, как будет доказана работоспособность программы.
Поупражняйтесь в составлении документации. Там все тоже не с первого раза

-------
- Я не разрешаю тебе быть плохой! Потому что плохие люди совершают плохие поступки. А это нехорошо!
(Из наставлений 5 летней девочки своей младшей сестре)

Это сообщение посчитали полезным следующие участники:

Отправлено: 12:29, 22-07-2013 | #7


Пользователь


Сообщения: 75
Благодарности: 0

Профиль | Отправить PM | Цитировать


lxa85, Я закончил колледж на техника программиста. Щас в универе. И это я пишу преподу не программирования, а с военной кафедры ему нужен журнал для хранения инфы о студентах и выставление оценок. А он в компах ноль и его понятие хороший прогер это когда круто выглядит. Потому что я компы не умею ремонтировать. Как ему надо "Взлом паролей, настройка сетей, ремонт железок итд" Мои интересы чисто прикладное программирование и веб программирование. Железо меня не интересует. А на его взкгля коли ты прогер должен уметь все. И никак ему не пояснишь что я тоже могу сказать коли ты военный то должен и танк водить и с парашюта прыгать и крейсером управлять.

http://files.mail.ru/7E467CA5F0D349A5935DCCF8802F56CA ссылка на архив.

Отправлено: 12:38, 22-07-2013 | #8

pva pva вне форума

Аватара для pva

Ветеран


Сообщения: 1180
Благодарности: 279

Профиль | Отправить PM | Цитировать


Greshnick, как веб-программист, ты должен понимать, что крутой интерфейс может жить отдельно от бизнес-логики. Логика на сервере, интерфейс на клиенте (насколько я понял это как раз в твоих интересах).
Поэтому:
1. следуй совету lxa85, делай прогу за 3 дня.
2. как заработает, приделай веб-интерфейс
Ждём от тебя в среду пункт 1

Отправлено: 15:39, 22-07-2013 | #9


Аватара для lxa85

Необычный


Contributor


Сообщения: 4463
Благодарности: 994

Профиль | Сайт | Отправить PM | Цитировать


Изображения
Тип файла: png 22-07-2013 18-47-19.png
(25.3 Kb, 5 просмотров)
Тип файла: png 22-07-2013 18-52-58.png
(122.8 Kb, 5 просмотров)
Тип файла: png 22-07-2013 19-12-17.png
(29.7 Kb, 5 просмотров)

Greshnick, не волнуйся, мы и у военных, ежели чего, консультацию получить сумеем
По секрету скажу. Все всегда хотят всего и сразу. В любой области есть узкоспециализированные специалисты, о наличии которых ты даже не подозреваешь до тех пор, пока не столкнешься лично. Отнюдь не в укор, все сталкиваются с этим. Допустим военный человек не разбирается в ПК. Ему и не надо. Ему нужен ты, который разбирается. Да, во всем. А если не разбирается, то должен дать аргументированный ответ, где следует искать решение (Не "почему ты не...", а "где искать решение"). Да, ему справедливо интересен "Взлом паролей, настройка сетей, ремонт железок итд" И ты, как прикладной программист широкого профиля (банально не успел получить узкую специальность) должен, хотя бы приблизительно представлять все процессы формирования, передачи и обработки информации, включая вопросы безопасности. (Что кстати говоря к web программированию имеет прямое отношение).
Цитата Greshnick:
Железо меня не интересует. »
Как только вопрос коснется не "сборка на коленке", а высоконаргруженных, высокопроизводительных, высоконадежных решений, железо тебя ой как заинтересует
Цитата Greshnick:
И никак ему не пояснишь »
Значит не умеешь пояснять. Вот и всё. Все через это проходят, подожди, станешь старше, поймешь. Пока не понял, наступаешь на горло своей гордости и "роешь землю". Это нормально. В крайнем случае - наглядное пособие "как НЕ надо делать". Учись студент
----
К делу.
Здесь люди, через руки которых прошло не одно и не два внедрения программных продуктов в корпоративную среду. Т.ч. прислушивайся и делай правильные выводы.
Сейчас главная твоя ошибка - не правильно расставленные приоритеты.
У военных все строго параллельно и перпендикулярно. Все должно быть четко прописано в инструкции по эксплуатации.
Я сомневаюсь, что ты реально представляешься себе ПК, на которых будет выполняться твоя программа. Это очень старая, дважды и трижды списанная техника, которая, тем не менее, позволяет вести учет студентов.
Флеш и wow эффект работникам абсолютно до лампады. Он мешает, тормозит работу, и будь уверен, через неделю тебя проклянут до 3его колена. Цветом повестки в военком
Программа должна работать Надежно, Быстро и Просто.
Будь она хоть вся в wow эффектах, но теряющая данные,то ну... хмм.. ну о чем тут говорить?
----
Программа.
Хочется оторвать руки. Это дико. Не согласованность по глубине, цветовой гамме, градиентам. Огромные аляповатые кнопки (да, с "красивым" фокусом). "Выбрать" и "Выход" рядом никто не ставит. "Выберите базу" мы не с детьми общаемся, чтобы такие шрифты ставить. Основное окно пустое, как гладильная доска. Что в нем делать не ясно. Как осуществлять поиск и работу с базой данных студентов?
Добавить:
Это что за рюшки? В армии все должно быть функционально. Это не "развлекалка" для девочек, играющих в куклы.
Форма плывёт
----
Код.
По коду пока ничего сказать не могу. Не получается побороться с TShockwareFlash компонентами.
Подключение dll библиотек, само по себе - есть хорошо.
Комментариев нет.
----
Вывод.
Пока это очень глубокая альфа, для своего собственного удовольствия. Ничего общего с рабочими программами она пока не имеет.
Успехов!

-------
- Я не разрешаю тебе быть плохой! Потому что плохие люди совершают плохие поступки. А это нехорошо!
(Из наставлений 5 летней девочки своей младшей сестре)


Последний раз редактировалось lxa85, 22-07-2013 в 19:56. Причина: добавил картинок


Отправлено: 19:49, 22-07-2013 | #10



Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Программирование и базы данных » Delphi - Немодальные окна в Delphi

Участник сейчас на форуме Участник сейчас на форуме Участник вне форума Участник вне форума Автор темы Автор темы Шапка темы Сообщение прикреплено

Похожие темы
Название темы Автор Информация о форуме Ответов Последнее сообщение
Дождаться окна и скопировать весь текст со всех элементов окна vxor AutoIt 2 14-11-2011 00:41
Delphi - Delphi | UpperCase на Delphi 7 Cognolio Программирование и базы данных 3 26-01-2006 15:42
Delphi - Delphi | создание окна и его элементов средствами WinAPI Savant Программирование и базы данных 14 18-01-2005 14:15
Delphi - DELPHI Surround Программирование и базы данных 8 22-06-2004 09:42
Delphi - Delphi. Высота заголовка окна, изменение. Prisoner Программирование и базы данных 3 19-10-2003 03:52




 
Переход