Как выйти из программы

← →
Kusma (2009-08-26 16:42) [0]

Здравствуйте програмисты делал программу смены одного изображения на другое используя функцию AlphaBltnd и столкнулся с проблемой во время выполнения программы не работает клавиатура, чтобы выйти из программы. Как выйти из програмы?

← →
Dennis I. Komarov © (2009-08-26 16:48) [1]

> не работает клавиатура

мышкой :)

← →
Kusma (2009-08-26 16:48) [2]

упс. Забыл кинуть код:
unit Unit1; { Генерируем и показываем форму } procedure TForm1.Button1Click(Sender: TObject); var f : tSearchRec; patch : string; BegN, EndN : string; st : string; i : byte; k : boolean; begin { Создаем новую форму } NewForm := TNewForm.CreateNew(Application); { Устанавливаем ее свойства } with NewForm do begin BorderStyle := bsNone; FormStyle := fsStayOnTop; Left := 0; Top := 0; Width := Screen.Width; Height := Screen.Height; AlphaBlend:=true; AlphaBlendValue:=0; color:=0; Show; end; // with NewForm do k:=false; patch:=""; while true do Begin if FindFirst(patch+"*.jpg", faHidden+faSysFile, F)=0 then Begin st1:=F.Name; BegN:=st1; // Загружаем картинку на нижюю форму form1.FormPaint(sender); While FindNext(f)=0 do begin if k=false then begin // Загружаем картинку на верхнюю не видимую форму st2:=F.Name; Newform.NewFormPaint(sender); // Показываем верхнюю (картинку) форму for i:=1 to 255 do newform.AlphaBlendValue:=i; delay(2000); // Надо найти еще один файл, значит // прокручиваем цыкл через Continue // переменная k используется для того чтобы // цыкл продолжался з прерванного места. k:=true; continue; End; if k=true then begin // Пока верхняя картинка видна загружаем нижнюю st1:=F.Name; form1.FormPaint(sender); // Убираем верхнюю картинку, открывая нижнюю for i:=255 downto 1 do newform.AlphaBlendValue:=i; delay(2000); // Надо найти еще один файл, значит // прокручиваем цыкл через Continue // переменная k используется для того чтобы // цыкл продолжался з прерванного места. k:=false; continue; end; end; End; EndN:=st2; End; // while true do FindClose(F); end; procedure TNewForm.NewFormKeyPress(Sender: TObject; var Key: Char); begin if key=#27 then NewForm.Close; end; procedure TNewForm.NewFormPaint(Sender: TObject); var jp : Tjpegimage; LeftJpeg, TopJpeg : Integer; // Размер изображения Source : Trect; // Размер рамки на которую ставим изображение DestRect : Trect; // Рамка для вывода изображения R : Trect; begin NewForm.Canvas.Rectangle(0, 0, screen.Width, screen.Height); jp := TJpegImage.Create(); jp.LoadFromFile(st2); // Картинка > экрана if (jp.Width > Screen.Width) or (jp.Height > Screen.Height) then Begin Source:=rect(0, 0, jp.Width, jp.Height); DestRect:=rect(0, 0, screen.Width, screen.Height); r:=FitRectInRect(Source, DestRect, true); NewForm.Canvas.StretchDraw(r, jp); End else // Картинка < экрана if (jp.Width < Screen.Width) or (jp.Height < Screen.Height) then Begin LeftJPEG := (Screen.Width - jp.Width) div 2; TopJPEG := (Screen.Height - jp.Height) div 2; NewForm.Canvas.Draw(LeftJpeg, TopJpeg, jp); End; jp.Free; end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin NewForm.Free; end; Procedure Full_Screen; begin with Form1 do begin BorderStyle := bsNone; FormStyle := fsStayOnTop; Left := 0; Top := 0; Height := Screen.Height; Width := Screen.Width; color := 0; alphablend := true; end; end; procedure TForm1.FormCreate(Sender: TObject); begin Full_Screen; end; procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char); begin if key=#27 then begin newform.Free; Form1.Close; end; end; procedure TForm1.FormPaint(Sender: TObject); var jp : Tjpegimage; LeftJpeg, TopJpeg : Integer; // Размер изображения Source : Trect; // Размер рамки на которую ставим изображение DestRect : Trect; // Рамка для вывода изображения R : Trect; begin Form1.Canvas.Rectangle(0, 0, screen.Width, screen.Height); jp := TJpegImage.Create(); jp.LoadFromFile(st1); // Картинка > экрана if (jp.Width > Screen.Width) or (jp.Height > Screen.Height) then Begin Source:=rect(0, 0, jp.Width, jp.Height); DestRect:=rect(0, 0, screen.Width, screen.Height); r:=FitRectInRect(Source, DestRect, true); form1.Canvas.StretchDraw(r, jp); End else // Картинка < экрана if (jp.Width < Screen.Width) or (jp.Height < Screen.Height) then Begin LeftJPEG := (Screen.Width - jp.Width) div 2; TopJPEG := (Screen.Height - jp.Height) div 2; form1.Canvas.Draw(LeftJpeg, TopJpeg, jp); End; jp.Free; end; procedure TForm1.FormActivate(Sender: TObject); begin Button1Click(Sender); end; end.

а вот ссылка на весь архив: http://kusmich0024.narod.ru/SetBlend.rar

← →
Kusma (2009-08-26 16:51) [3]

Dennis I. Komarov © (26.08.09 16:48) [1]

> не работает клавиатура

мышкой :)

:)

← →
clickmaker © (2009-08-26 16:56) [4]

а что, выход из цикла вообще не предусмотрен?
Application.ProcessMessage в цикл и какой-то флажок, его останавливающий

← →
Anatoly Podgoretsky © (2009-08-26 17:03) [5]

> Dennis I. Komarov (26.08.2009 16:48:01) [1]

Не предусмотрена

← →
Dennis I. Komarov © (2009-08-26 17:05) [6]

> Anatoly Podgoretsky © (26.08.09 17:03) [5]
>

Ну такая программа тоже...

← →
Anatoly Podgoretsky © (2009-08-26 17:08) [7]

> Dennis I. Komarov (26.08.2009 17:05:06) [6]

Но против лома нет приема, всегда можно выдернуть шнур из розетки.

← →
Dennis I. Komarov © (2009-08-26 17:13) [8]

> Anatoly Podgoretsky © (26.08.09 17:08) [7]
>

Он тоже не всегда предусмотрен...

← →
Kusma (2009-08-26 17:18) [9]

> а что, выход из цикла вообще не предусмотрен?
> Application.ProcessMessage в цикл и какой-то флажок, его останавливающий

Пробовал. Не выходит.

← →
clickmaker © (2009-08-26 17:20) [10]

> Пробовал. Не выходит

да ладно.

while not Terminated do
Begin
...
Application.ProcessMessages;
end;

procedure TNewForm.NewFormKeyPress(Sender: TObject; var Key: Char);
begin
if key=#27 then Terminated := true;
end;

← →
clickmaker © (2009-08-26 17:24) [11]

а вообще, цикл какой-то странный.
Почему, чтобы "Надо найти еще один файл", опять вызывается FindFirst? а не FindNext? при этом patch не меняется. Кстати, правильно Path

← →
Kusma (2009-08-26 17:41) [12]

> while not Terminated do
> Begin
> ...
> Application.ProcessMessages;
> end;

> procedure TNewForm.NewFormKeyPress(Sender: TObject; var Key: Char);
> begin
> if key=#27 then Terminated := true;
> end;

За ответ спасиба. Но на строке if key=#27 then Terminated := true; компилятор останавливается [Error] Unit1.pas(281): Cannot assign to a read-only property

> а вообще, цикл какой-то странный.
> Почему, чтобы "Надо найти еще один файл", опять вызывается FindFirst? а не FindNext? при этом patch не меняется.

Ты на код посмотри внимательней.

← →
Сергей М. © (2009-08-26 19:04) [13]

> програмисты делал программу

Как- то даже не прилично)
Чуть ли не
Мы, божьей милостью Программист, делали программу..

← →
Сергей М. © (2009-08-26 19:26) [14]

> на строке if key=#27 then Terminated := true; компилятор
> останавливается

А ты ему пучок морковки повесь перед носом.

У тебя слово "property" не вызвало никаких сомнений ?)

← →
clickmaker © (2009-08-26 19:30) [15]

> Ты на код посмотри внимательней.

да, проглядел.
там в чем фишка-то? прокрутили все файлы в папке и опять пошли по новой?
в любом случае, при бесконечном цикле без проверки какого-то флажка из программы не выйдешь.
Ибо она на 100% занята циклом, а очередь сообщений не проверяет

← →
Kusma (2009-08-26 19:48) [16]

> на строке if key=#27 then Terminated := true; компилятор
> останавливается

> А ты ему пучок морковки повесь перед носом.

> У тебя слово "property" не вызвало никаких сомнений ?)

Чесно говоря нет.

← →
Сергей М. © (2009-08-26 19:53) [17]

Те. набор незнакомых тебе букоф ?

Ну хорошо. а как вообще ты реагируешь на "остановки компилятора", когда нет морковки и не у кого спросить о причинах остановки ?

← →
Kusma (2009-08-26 20:03) [18]

> Те. набор незнакомых тебе букоф ?

> Ну хорошо. а как вообще ты реагируешь на "остановки компилятора", когда нет морковки и не у кого спросить о причинах остановки ?

Ты сам не знаешь ответа на мой вопрос. Еслы бы это было не так то ты бы уже давно ответил.

← →
Kusma (2009-08-26 20:11) [19]

> да, проглядел.
> там в чем фишка-то? прокрутили все файлы в папке и опять пошли по новой?
> в любом случае, при бесконечном цикле без проверки какого-то флажка из программы не выйдешь.
> Ибо она на 100% занята циклом, а очередь сообщений не проверяет

Абсолютно с вами согласен, вот пример похожей программы, только зделаной по принцыпу смешивания цветов: http://kusmich0024.narod.ru/Pictopic.rar

<
> Еслы бы это было не так то ты бы уже давно ответил.

Щас.
Разрешите бегом ?

> Kusma (26.08.2009 20:03:18) [18]

А поцеловать?

http://delphimaster.net/view/4-1251175537/
Вы с Мамедовым случаем не знакомы ?

То ведь тоже заявил а-ля "ты мне не дал код, значит ты не знаешь, значит ты говновод, а я Д"Артьаньян"

i := 0;
if FindFirst(..) = 0 then
repeat
Inc(i); // i-я итерация
.. // здесь твори с i-м файлом все что захочешь
Application.ProcessMessages; // мышь и клава тоже хотят !
until (not Findnext(..) <> 0) or (NeedBreak = True) or Application.Terminated

Как выйти из программы Найти похожие ветки