Home: Code Repository: Mastering Delphi 5

Project ANIMCTRL

Project Structure

ANIMCTRL.DPR
ANIMF.PAS
ANIMF.DFM

program AnimCtrl;

uses
  Forms,
  AnimF in 'AnimF.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

unit AnimF;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, ExtCtrls, Spin;

type
  TForm1 = class(TForm)
    Animate1: TAnimate;
    Panel1: TPanel;
    ListBox1: TListBox;
    OpenDialog1: TOpenDialog;
    BtnStart: TButton;
    BtnStop: TButton;
    BtnOnce: TButton;
    BtnTrice: TButton;
    BtnFragment: TButton;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    Label1: TLabel;
    Label2: TLabel;
    BtnGoto: TButton;
    SpinEdit3: TSpinEdit;
    BtnReverse: TButton;
    Bevel1: TBevel;
    Bevel2: TBevel;
    LblFrames: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure BtnStartClick(Sender: TObject);
    procedure BtnStopClick(Sender: TObject);
    procedure BtnOnceClick(Sender: TObject);
    procedure BtnTriceClick(Sender: TObject);
    procedure BtnFragmentClick(Sender: TObject);
    procedure BtnGotoClick(Sender: TObject);
    procedure BtnReverseClick(Sender: TObject);
    procedure Animate1Open(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  ListBox1.ItemIndex := 1;
  LblFrames.Caption := 'Frames ' +
    IntToStr (Animate1.FrameCount);
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
  Animate1.CommonAVI := TCommonAVI (ListBox1.ItemIndex);
  if (ListBox1.ItemIndex = 0) and
      OpenDialog1.Execute then
    Animate1.FileName := OpenDialog1.FileName
end;

procedure TForm1.BtnStartClick(Sender: TObject);
begin
  Animate1.Active := True;
end;

procedure TForm1.BtnStopClick(Sender: TObject);
begin
  Animate1.Stop;
end;

procedure TForm1.BtnOnceClick(Sender: TObject);
begin
  Animate1.Play (0, Animate1.FrameCount, 1);
end;

procedure TForm1.BtnTriceClick(Sender: TObject);
begin
  Animate1.Play (0, Animate1.FrameCount, 3);
end;

procedure TForm1.BtnFragmentClick(Sender: TObject);
begin
  Animate1.Play (SpinEdit1.Value,
    SpinEdit2.Value, -1);
end;

procedure TForm1.BtnGotoClick(Sender: TObject);
begin
  Animate1.Seek (SpinEdit3.Value);
end;

procedure TForm1.BtnReverseClick(Sender: TObject);
var
  Init: TDateTime;
  I: Integer;
begin
  for I := Animate1.FrameCount downto 1 do
  begin
    Animate1.Seek (I);
    // wait 50 milliseconds
    Init := Now;
    while Now < Init + EncodeTime (0, 0, 0, 50) do
      Application.ProcessMessages;
  end;
end;

procedure TForm1.Animate1Open(Sender: TObject);
begin
  LblFrames.Caption := 'Frames ' +
    IntToStr (Animate1.FrameCount);
end;

end.

object Form1: TForm1
  Left = 128
  Top = 152
  Width = 459
  Height = 359
  Caption = 'AnimCtrl Demo'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Animate1: TAnimate
    Left = 129
    Top = 101
    Width = 322
    Height = 231
    Align = alClient
    Active = False
    AutoSize = False
    CommonAVI = aviFindFolder
    StopFrame = 29
    OnOpen = Animate1Open
  end
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 451
    Height = 101
    Align = alTop
    TabOrder = 1
    object Bevel2: TBevel
      Left = 320
      Top = 8
      Width = 121
      Height = 87
    end
    object Bevel1: TBevel
      Left = 184
      Top = 8
      Width = 129
      Height = 88
    end
    object Label1: TLabel
      Left = 201
      Top = 50
      Width = 26
      Height = 13
      Caption = 'From:'
    end
    object Label2: TLabel
      Left = 213
      Top = 73
      Width = 16
      Height = 13
      Caption = 'To:'
    end
    object LblFrames: TLabel
      Left = 97
      Top = 79
      Width = 37
      Height = 13
      Caption = 'Frames:'
    end
    object BtnStart: TButton
      Left = 8
      Top = 8
      Width = 75
      Height = 25
      Caption = '&Start'
      TabOrder = 0
      OnClick = BtnStartClick
    end
    object BtnStop: TButton
      Left = 96
      Top = 8
      Width = 75
      Height = 25
      Caption = 'St&op'
      TabOrder = 1
      OnClick = BtnStopClick
    end
    object BtnOnce: TButton
      Left = 8
      Top = 40
      Width = 75
      Height = 25
      Caption = '&Play Once'
      TabOrder = 2
      OnClick = BtnOnceClick
    end
    object BtnTrice: TButton
      Left = 96
      Top = 40
      Width = 75
      Height = 25
      Caption = '&Three Times'
      TabOrder = 3
      OnClick = BtnTriceClick
    end
    object BtnFragment: TButton
      Left = 208
      Top = 14
      Width = 75
      Height = 25
      Caption = '&Fragment'
      TabOrder = 4
      OnClick = BtnFragmentClick
    end
    object SpinEdit1: TSpinEdit
      Left = 232
      Top = 45
      Width = 65
      Height = 22
      MaxValue = 0
      MinValue = 0
      TabOrder = 5
      Value = 3
    end
    object SpinEdit2: TSpinEdit
      Left = 232
      Top = 69
      Width = 65
      Height = 22
      MaxValue = 0
      MinValue = 0
      TabOrder = 6
      Value = 6
    end
    object BtnGoto: TButton
      Left = 344
      Top = 16
      Width = 75
      Height = 25
      Caption = '&Goto Frame'
      TabOrder = 7
      OnClick = BtnGotoClick
    end
    object SpinEdit3: TSpinEdit
      Left = 344
      Top = 56
      Width = 73
      Height = 22
      MaxValue = 0
      MinValue = 0
      TabOrder = 8
      Value = 0
    end
    object BtnReverse: TButton
      Left = 8
      Top = 72
      Width = 75
      Height = 25
      Caption = '&Reverse'
      TabOrder = 9
      OnClick = BtnReverseClick
    end
  end
  object ListBox1: TListBox
    Left = 0
    Top = 101
    Width = 129
    Height = 231
    Align = alLeft
    ItemHeight = 13
    Items.Strings = (
      '[Use an AVI file]'
      'Find Folder'
      'Find File'
      'Find Computer'
      'Copy Files'
      'Copy File'
      'Recycle File'
      'Empty Recycle'
      'Delete File')
    TabOrder = 2
    OnClick = ListBox1Click
  end
  object OpenDialog1: TOpenDialog
    DefaultExt = 'avi'
    Filter = 'AVI file (*.avi)|*.avi'
    Options = [ofPathMustExist, ofFileMustExist]
    Left = 144
    Top = 112
  end
end