Просмотр анимаций .avi

---

Проект состоит из одного модуля.

Краткое описание: что может программа

• Анимация .avi выбирается либо из папки, либо (системные) - из Shell32.dll
• После открытия анимации в строке статуса показывает число кадров
• Можно установить начальный и конечный кадр показа.
• Можно установить число повторов при показе.
• Там, где возможно - устанавливается прозрачность фона.

Текст модуля Unit1

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, Menus, Buttons;

type
  TForm1 = class(TForm)
    Animate1: TAnimate;
    OpenDialog1: TOpenDialog;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    FOpen: TMenuItem;
    OPt: TMenuItem;
    Count: TMenuItem;
    begin1: TMenuItem;
    end1: TMenuItem;
    Trans: TMenuItem;
    Quit: TMenuItem;
    Label1: TLabel;
    UpDown1: TUpDown;
    Edit1: TEdit;
    Button1: TButton;
    SB1: TStatusBar;
    sbPlay: TSpeedButton;
    sbStop: TSpeedButton;
    aviFindFile1: TMenuItem;
    aviFindFolder1: TMenuItem;
    aviFindComputer1: TMenuItem;
    aviCopyFiles1: TMenuItem;
    aviCopyFile1: TMenuItem;
    aviRecycleFile1: TMenuItem;
    aviEmptyRecycle1: TMenuItem;
    aviDeleteFile1: TMenuItem;
    sys1: TMenuItem;
    procedure QuitClick(Sender: TObject);
    procedure FOpenClick(Sender: TObject);
    procedure TransClick(Sender: TObject);
    procedure CountClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure begin1Click(Sender: TObject);
    procedure sbPlayClick(Sender: TObject);
    procedure sbStopClick(Sender: TObject);
    procedure OPtClick(Sender: TObject);
    procedure end1Click(Sender: TObject);
    procedure aviFindFile1Click(Sender: TObject);
    procedure aviFindFolder1Click(Sender: TObject);
    procedure aviFindComputer1Click(Sender: TObject);
    procedure aviCopyFiles1Click(Sender: TObject);
    procedure aviCopyFile1Click(Sender: TObject);
    procedure aviRecycleFile1Click(Sender: TObject);
    procedure aviEmptyRecycle1Click(Sender: TObject);
    procedure aviDeleteFile1Click(Sender: TObject);
  private
    { Private declarations }
    procedure Common1;
    procedure Common2;
    procedure Common3(tag: Integer);   
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ ************ СПРАВКА: ********************
  ********* 1. TAnimate ***********
property Center: Boolean;
property FileName: TFileName;
property FrameCount: Integer;
property Open: Boolean; - есть клип в памяти ?
property Repetitions: Integer; - число повторов
 , = 0 - бесконечно (чтобы остановить - Active:= false)
property StartFrame: SmallInt; - номер стартового кадра
property StopFrame: SmallInt;  - ясно
property Transparent: Boolean; - фон прозрачный ?
------- методы ------------
procedure Play(FromFrame, ToFrame: Word;
 Count: Integer - число повторов);
- эквивал: StartFrame:=  ; StopFrame:= ; Active:=true;
--------
procedure Reset; - очищ StartFrame, StopFrame и
показывает 1-й кадр
----
procedure Seek(Frame: SmallInt); - показ кадр номер Frame
procedure Stop;
----------- property CommonAVI: TCommonAVI; ---------

type TCommonAVI = (aviNone, aviFindFolder, aviFindFile,
 aviFindComputer, aviCopyFiles, aviCopyFile, aviRecycleFile,
 aviEmptyRecycle, aviDeleteFile);


========================
 ********** 2. MessageDlg ****************
function MessageDlg(const Msg: string; DlgType: TMsgDlgType;
 Buttons: TMsgDlgButtons; HelpCtx: Longint): Word;
type TMsgDlgType = (mtWarning, mtError, mtInformation,
     mtConfirmation, mtCustom);
TMsgDlgButtons = set of TMsgDlgBtn;
type TMsgDlgBtn = (mbYes, mbNo, mbOK, mbCancel, mbAbort,
     mbRetry, mbIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp);
type TModalResult = Low(Integer)..High(Integer); :
---
mrNone	None. Used as a default value before the user exits.
mrOk	The user exited with OK button.
mrCancel	The user exited with the CANCEL button. 
mrYes (6)	The user exited with the YES button.
mrNo(7)	The user exited with the NO button. или Escape!!!
mrAbort	The user exited with the ABORT button.
mrRetry	The user exited with the RETRY button.
mrIgnore	The user exited with the IGNORE button.
mrAll	The user exited with the ALL button.
mrNoToAll	The user exited with the NO TO ALL button.
mrYesToAll	The user exited with the YES TO ALL button.
(2) - закрыл окошко (mrAbort??)
==================
  Animate1.Active := true;

}

var variant: Integer;

procedure TForm1.QuitClick(Sender: TObject);
begin
 Application.Terminate; 
end;

procedure TForm1.Common3(tag: Integer);
begin
  Animate1.Active := false;
  Animate1.CommonAVI := TCommonAVI(tag);
    // загружаем тип системного AVI (см выше - перечисляемый тип
    // TCommonAVI, т е Byte(aviFindFile) = 2 и т д)
  Animate1.Reset;
  Opt.Enabled:= true;    // делаем пункт меню доступным
  sbPlay.Visible:= true;  //делаем кнопку видимой
  sbStop.Visible:= true;  //делаем кнопку видимой
  SB1.Font.Size:= 12;     // размер шрифта для строки статуса
  SB1.SimpleText:= '  Всего: '
    +IntToStr(Animate1.FrameCount)+' кадров.';
end;

procedure TForm1.FOpenClick(Sender: TObject);
begin
 If OpenDialog1.Execute then
   begin Animate1.Active := false;
     Animate1.FileName := OpenDialog1.FileName; // выбрали файл из папки
     Animate1.Reset;
     Opt.Enabled:= true;     // делаем пункт меню доступным
     sbPlay.Visible:= true;  //делаем кнопку видимой
     sbStop.Visible:= true;  //делаем кнопку видимой
     SB1.Font.Size:= 12;     // размер шрифта для строки статуса
     SB1.SimpleText:= '  Всего: '
     +IntToStr(Animate1.FrameCount)+' кадров.';
   end;
end;

procedure TForm1.TransClick(Sender: TObject);
var Rez: Integer;
begin
  Repeat
  Rez := MessageDlg('Фон прозрачный? (Yes | No=Esc )', mtConfirmation,
  [mbYes, mbNo],0);  // см выше - справку по MessageDlg
  if Rez = mrYes then Animate1.Transparent:= true else
  if Rez = mrNo then Animate1.Transparent:= false else
  showmessage('Скажи: Да или нет !');
  until (Rez = mrYes) or (Rez = mrNo);
  sbStopClick(Sender);  // Запуск обработчика щелчка по кнопке.
  sbPlay.Visible:= true;  //делаем кнопку видимой
  sbStop.Visible:= true;  //делаем кнопку видимой
end;

procedure TForm1.Common1;
const Vis = true;
begin
  Label1.AutoSize:= false;  // чтобы поместить многострочный текст
  Label1.WordWrap:= Vis;    // чтобы поместить многострочный текст, но
                            // это лишнее, потому что уже сделано
                            // в инспекторе объектов

  Label1.Visible:=Vis;      //делаем компонент видимым
  UpDown1.Visible := Vis;   //делаем компонент видимым
  Edit1.Visible:= Vis;      //делаем компонент видимым
  Button1.Visible:= Vis;    //делаем компонент видимым
end;

procedure TForm1.Common2;
const Vis = false;
begin
  Label1.Visible:=Vis;       //делаем компонент невидимым
  UpDown1.Visible := Vis;    //делаем компонент невидимым
  Edit1.Visible:= Vis;       //делаем компонент невидимым
  Button1.Visible:= Vis;     //делаем компонент невидимым
  sbPlay.Visible:= true;     //делаем компонент видимым
  sbStop.Visible:= true;     //делаем компонент видимым
end;

procedure TForm1.CountClick(Sender: TObject);
const Vis = true;
begin
  Common1;
  Label1.Width:= 220;
  Label1.Caption:=
  'Установите число повторов '+
  '(0) - бесконечно';
  variant:=1;
end;

procedure TForm1.Button1Click(Sender: TObject);
const Vis = false;
begin
  Common2;
  case variant of
  1: Animate1.Repetitions := StrToInt(Edit1.Text); // число повторов
  2: Animate1.StartFrame:=  StrToInt(Edit1.Text);  // номер начального кадра
  3: Animate1.StopFrame:=  StrToInt(Edit1.Text);
     // номер последнего кадра (при показе)
  end;
end;

procedure TForm1.begin1Click(Sender: TObject);
begin
  Common1;
  Label1.Width:= 185;
  Edit1.Text:= '1';   // в окошко Edit1 помещаем 1.
  Label1.Caption:=
  'Установите номер '+
  'начального кадра';
  variant:=2;
end;

procedure TForm1.sbPlayClick(Sender: TObject);
begin
  Animate1.Active:= true;  // включаем показ анимации
end;

procedure TForm1.sbStopClick(Sender: TObject);
begin
  Animate1.Active:= false;  // выключаем показ анимации
end;

procedure TForm1.OPtClick(Sender: TObject);
begin
  sbPlay.Visible:= false; //делаем кнопку невидимой
  sbStop.Visible:= false; //делаем кнопку невидимой
end;

procedure TForm1.end1Click(Sender: TObject);
begin
  Common1;
  Label1.Width:= 185;
  Edit1.Text:= '1';    // в окошко Edit1 помещаем 1.
  Label1.Caption:=
  'Установите номер '+
  'кадра остановки';
  variant:=3;
end;

procedure TForm1.aviFindFile1Click(Sender: TObject);
begin
  Common3(aviFindFile1.Tag); // Аргумент (т е aviFindFile1.Tag) равен 2
        // (см настройки в инспекторе объектов или файле Unit1.dfm)
end;

procedure TForm1.aviFindFolder1Click(Sender: TObject);
begin
  Common3(aviFindFolder1.Tag);
end;

procedure TForm1.aviFindComputer1Click(Sender: TObject);
begin
  Common3(aviFindComputer1.Tag);
end;

procedure TForm1.aviCopyFiles1Click(Sender: TObject);
begin
  Common3(aviCopyFiles1.Tag);
end;

procedure TForm1.aviCopyFile1Click(Sender: TObject);
begin
  Common3(aviCopyFile1.Tag);
end;

procedure TForm1.aviRecycleFile1Click(Sender: TObject);
begin
  Common3(aviRecycleFile1.Tag);
end;

procedure TForm1.aviEmptyRecycle1Click(Sender: TObject);
begin
  Common3(aviEmptyRecycle1.Tag);
end;

procedure TForm1.aviDeleteFile1Click(Sender: TObject);
begin
  Common3(aviDeleteFile1.Tag);
end;

end.

Некоторые особенности проекта:

• При выборе пунктов меню, в которых требуется ввод целого числа, на форме становятся видимыми: метка Label1 с надписью (каждый раз другой), окошко Edit1, в которое можно вписывать вводимое число, компонент UpDown1 - чтобы менять это число с помощью стрелок, кнопка Button1, при щелчке по которой число устанавливается (запоминается в соответствующей переменной) и все эти компоненты становятся невидимыми (так как уже не нужны).
• Полезные выписки из справочной системы см. в тексте модуля.
• Описание - как создавать главное меню - см в проекте 2

Скачать RAR-архив исходников (100 Кб)
Скачать RAR-архив исходников + .exe(300 Кб)