Новости
Видео
Microsoft
Windows 10
Железо
Программы
Форум

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

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

< Предыдущая 1 2
Ответить
Настройки темы
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 | Цитировать

Изображения
Тип файла: png окно.png
(114.9 Kb, 12 просмотров)

lxa85, программа пока еще не завершена. Поиск еще будет реализован. Равно как удаление и редактирование. На счет оформления наверное реально надо, как то переделать вид. На счет компов, это в его личное пользование. На его рабочем ноуте который не слабее моего. А на счет пустого окна прикладываю скрин как это выглядит когда база подключена. Спасибо за советы. Учту. И можно еще один вопрос. Есть ли какие нибудь хорошие книги про написание компонентов в среде делфи на GDI+. Потому что я так понял все эти вау эффекты грамотнее делать через GDI+ а, не через флеш иначе память жрет как удав. Даже в рабочем состоянии.

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



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

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


Ветеран


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

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

Greshnick, Вам рано думать о каких-либо Wow-эффектах, если Вы «плаваете» пока даже в простейших принципах построения пользовательских интерфейсов.
Это сообщение посчитали полезным следующие участники:

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

pva pva вне форума

Аватара для pva

Ветеран


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

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

Greshnick, девочка на фотографии красивая, но не спасает ужасный интерфейс.
1. Цвет отвратительный (смотри рекомендации по сочетаниям цветов)
2. Текст нечитаемый (смотри рекомендации по выбору шрифтов)
3. Интерфейс не отражает процесс (ежедневно поиск ученика, выставление оценки, еженедельно распечатка ведомости)
Попробой сам имитировать опрос 30 учеников (сгенерируй случайный список) - через 10 минут заболят глаза и руки

ИМХО:
1. забудь временно про интерфейс, используй стандартные кнопки, стандартные формы
2. сконцентрируйся на функционале
Это сообщение посчитали полезным следующие участники:

Отправлено: 08:07, 23-07-2013 | #13


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


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

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

Изображения
Тип файла: png окно.png
(95.0 Kb, 13 просмотров)
Тип файла: png окно2.png
(66.8 Kb, 13 просмотров)

Iska, pva, lxa85 Вчера посидел и немного доработал интерфейс(прикрепляю 2 скрина), а также удаление, добавление и изменение записей. Лучше или нет выглядит внешка? Можете посоветовать учебники по построению интерфейса для начинающих? А также по GDI+ где идет описание создания компонентов?

Отправлено: 09:17, 23-07-2013 | #14


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


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

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

pva, Iska, lxa85 посмотрел про построение интерфейса. Вот уже действительно век живи Век учись. Получается и правда иногда грамотно подобранное оформление и цветовые схемы помогут скрыть некоторые недоработки в плане функционала например. Т.е. то что нету будет считаться лишним и не нужным и наоборот неудобное оформление отпугнет пользователя. Спасибо Большое. Будем разбираться.

Отправлено: 11:54, 23-07-2013 | #15

< Предыдущая 1 2


Компьютерный форум 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


« Предыдущая тема | Следующая тема »


 
Переход