Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2009.10.25;
Скачать: CL | DM;

Вниз

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

 
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


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

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


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


 
Anatoly Podgoretsky ©   (2009-08-26 20:22) [21]

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

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


 
Сергей М. ©   (2009-08-26 20:25) [22]

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

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


 
Сергей М. ©   (2009-08-26 20:27) [23]


> Anatoly Podgoretsky ©   (26.08.09 20:22) [21]


Мне лень нагнуться.


 
Сергей М. ©   (2009-08-26 20:57) [24]

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



Страницы: 1 вся ветка

Текущий архив: 2009.10.25;
Скачать: CL | DM;

Наверх




Память: 0.54 MB
Время: 0.021 c
15-1250850838
Медвежонок Пятачок
2009-08-21 14:33
2009.10.25
перечень нехорошего


15-1250899237
Tirael
2009-08-22 04:00
2009.10.25
как называется игрушка


15-1251430920
Slym
2009-08-28 07:42
2009.10.25
RDP через HTTP прокси


2-1251724890
Rendal
2009-08-31 17:21
2009.10.25
Создание объявлений для большого числа компонентов.


2-1251965130
ford
2009-09-03 12:05
2009.10.25
TWebBrowser список ссылок ячейки таблицы