| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Как выйти из программы [D7, XP]

Страницы:   < 1 2 >

Kusma ©   (2009-08-26 16:42:00) 

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

---

clickmaker   (2009-08-26 16:56:00) [21]

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

---

Kusma   (2009-08-26 16:51:00) [22]

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

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

мышкой :)

:)

---

Dennis I. Komarov   (2009-08-26 16:48:00) [23]

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

мышкой :)

---

Kusma   (2009-08-26 16:48:00) [24]

упс. Забыл кинуть код:
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

---

Страницы:   < 1 2 >

Наверх