aboutsummaryrefslogtreecommitdiff
path: root/Source/fsaviunit.pas
blob: edda0035b7df48aa3a45ca80c75dc992465929af (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
unit fsaviunit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  fsformunit,
  fsaviwriter, ExtCtrls, StdCtrls, Buttons;

type
  TFsAvi = class(TFsForm)
    sd1: TSaveDialog;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    a: TAviWriter;
  public
    { Public declarations }
    procedure Parse(const S: String); override;
  end;

var
  FsAvi: TFsAvi;

implementation

uses
  fsframeunit, strz, mainunit;

{$R *.DFM}

{ Tavi }

procedure TFsAvi.Parse(const S: String);
var
  s1: String;
  f: TFsFrame;
begin
  if S='' then Exit;

  s1 := UpperCase(ExtractWord(1, S, [' ']));

  if s1='WRITE' then begin
    a.FileName := Copy(S, Length(s1)+2, 255);
    if a.Filename='' then
      if sd1.Execute then begin
        a.Filename := sd1.Filename;
        if UpperCase(ExtractFileExt(a.Filename))<>'.AVI' then
          a.Filename := a.Filename+'.avi';
      end else
        Exit;
    a.Finish;
    Exit;
  end else
  if s1='FPS' then begin
    a.fps := MyStrToInt(Copy(S, Length(s1)+2, 255));
    Exit;
  end;

  if not a.Prepared then
    a.Prepare;

  f := FindFrame(S);
  if f=nil then Exit;

  a.Width := f.d1.SurfaceWidth;
  a.Height := f.d1.SurfaceHeight;

  f.dDib.DIB.Assign(f.d1.Surface);
  a.AddFrame(f.dDib.DIB);
  main.SendReturnValues(PdName+'pos='+IntToStr(a.FramePos));
end;

procedure TFsAvi.FormCreate(Sender: TObject);
begin
  a := TAviWriter.Create(Self);
end;

procedure TFsAvi.FormDestroy(Sender: TObject);
begin
  a.Free;
end;

procedure TFsAvi.BitBtn1Click(Sender: TObject);
begin
  a.Write;
end;

procedure TFsAvi.Button1Click(Sender: TObject);
begin
  a.Prepare;
end;

procedure TFsAvi.Button2Click(Sender: TObject);
begin
  a.Finish;
end;

end.