Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 5

Project ANIMCTRL

Project Structure


ANIMCTRL.DPR

program AnimCtrl;

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

{$R *.RES}

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

ANIMF.PAS

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.

ANIMF.DFM

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