-
Notifications
You must be signed in to change notification settings - Fork 0
/
unit_avi.pas
337 lines (290 loc) · 11.4 KB
/
unit_avi.pas
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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
unit unit_avi;{writes uncompressed video to an avi file (AVI=Audio Video Interleave format). This unit writes RGB 24 bit format for colour and monochrome images. Pixels information is are taken from Timage (screen)}
{Copyright (C) 2022 by Han Kleijn, www.hnsky.org
email: han.k.. at...hnsky.org
This Source Code Form is subject to the terms of the Mozilla Public
License, v. 2.0. If a copy of the MPL was not distributed with this
file, You can obtain one at https://mozilla.org/MPL/2.0/. }
interface
uses
Classes, SysUtils,dialogs,graphics,
LCLType, // For RGBtriple
IntfGraphics, // TLazIntfImage type
fpImage, // TFPColor type;
lclintf,
math;
function write_avi_head(filen, frame_rate: string; nrframes, w,h: integer): boolean;{open/create file and writes head. Result is false if failure}
function write_avi_frame(x,y,w,h: integer): boolean; {reads pixels from Timage and writes YUV frames in 444p style, colour or mono. Call this procedure for each image. Result is false if failure}
procedure close_the_avi(nrframes: integer);
implementation
uses astap_main;
var
theFile : tfilestream;
zero_dword : dword=0; // used for up the 3 extra zeros behind each image line depending on the with of the line
extra : integer; // number of extra zero's behind each line
const
nrcolors=3; // should be fixed at colour. Mono is not standarised in AVI
type
header = record
riff : dword; //'RIFF' fileSize fileType (data)
riffsize : dword; // fileSize is a 4-byte value giving the size of the data in the file. (filesize -8)
// The value of fileSize includes the size of the fileType FOURCC plus the size of the data that follows.
avi : dword; // fileType is a FOURCC that identifies the specific file type
list : dword; // A list has the following form: 'LIST' listSize listType listData
lsize : dword; // listsize
hdrL : dword; //
fcc : dword; // avih
cb: dword; // Specifies the size of the structure, not including the initial 8 bytes.
{===================}
dwMicroSecPerFrame: dword; // frame display rate (or 0)
dwMaxBytesPerSec : dword; // max. transfer rate
dwPaddingGranularity : dword; // pad to multiples of this size
dwFlags : dword; // Flags
dwTotalFrames : dword; // Number frames in file
dwInitialFrames : dword;
dwStreams : dword; // Number of streams in the file
dwSuggestedBufferSize : dword;
dwWidth : dword;
dwHeight : dword;
dwReserved1 : dword;
dwReserved2 : dword;
dwReserved3 : dword;
dwReserved4 : dword;
end;
var
head : header=
(riff :$46464952; // 'RIFF'
riffsize :0;
avi :$20495641; // AVI
list :$5453494C; // LIST
lsize:$000000C0; //
hdrL :$6C726468; // hdrL
fcc :$68697661; // avih
cb :$00000038; // 14*4=56 Specifies the size of the structure, not including the initial 8 bytes.
{===================}
dwMicroSecPerFrame: $000F4240; // 1 sec, MicroSecPerFrame, frame display rate (or 0)
dwMaxBytesPerSec : $0; // max. transfer rate
dwPaddingGranularity :$0; // pad to multiples of this size
dwFlags : $00000010; // flags
dwTotalFrames : $0; // # frames in file
dwInitialFrames : $0;
dwStreams : 1; // Number of streams in the file
dwSuggestedBufferSize : $0;
dwWidth : 16;
dwHeight : 8;
dwReserved1 : 0;
dwReserved2 : 0;
dwReserved3 : 0;
dwReserved4 : 0);
type
streamheader = record // AVIStreamHeader;
list : dword; // A list has the following form: 'LIST' listSize listType listData
size: dword;
strl : dword; // length chunk
{===================}
strh : dword; // stream header
hsize: dword; // length 56
fccType: dword;// vids
fccHandler : dword; // codec to be used.
dwFlags : dword;
wPriority : word;
wLanguage : word;
dwInitialFrames: dword;
dwScale: dword;
dwRate: dword; //* dwRate / dwScale == samples/second */
dwStart: dword;
dwLength: dword; //* In units above... */
dwSuggestedBufferSize: dword;
dwQuality: dword;
dwSampleSize: dword;
rcframew1: word;
rcframeh1: word;
rcframew2: word;
rcframeh2: word;
strf : dword; // stream format
Ssize: dword;
fsize: dword; // length 40
width: dword;
height: dword;
planes: word; // number of planes , 1
bitcount: word; // number of bits per pixel
compression: dword;
sizeimage : dword; // uncompressed size in bytes.
pixels_per_meterH: dword;// 0
pixels_per_meterV: dword;// 0
nr_colours_used: dword; // 0 is maximum
nr_important_colours: dword;// 0 is all
end;
var
streamhead : streamheader=
( list :$5453494C; // 'LIST'
size :$74;
strl :$6C727473; // 'strl'
strh :$68727473; // 'strh'
hsize:$00000038; // 56
fcctype:$73646976; // 'vids'
fccHandler: $0 ; // codex
dwFlags : 0;
wPriority : 0;
wLanguage : 0;
dwInitialFrames: 0;
dwScale: 1;
dwRate: 1; //* dwRate / dwScale == samples/second */
dwStart: 0;
dwLength: 0; //* In units above... */ size of stream in units as defined in dwRate and dwScale {here number of frames}
dwSuggestedBufferSize: 0; // to be set later
dwQuality: 0;
dwSampleSize: 0;
rcframew1: 0; // rect, specified in four words
rcframeh1: 0;
rcframew2: 200; // width
rcframeh2: 100; // height
strf : $66727473; //stream format
ssize: 40;
fsize: 40; // length 40
width: 200;
height:100;
planes: 1; // number of planes , 1
bitcount: 24; // number of bits per pixel
compression:0;
sizeimage : 200*100+200;// uncompressed in bytes plus extra zeros defind by extra.
pixels_per_meterH: $0EC4;// 0
pixels_per_meterV: $0EC4;// 0
nr_colours_used: 0; // 0 is maximum
nr_important_colours: 0; // 0 is all
);
type
moviheader = record // AVIStreamHeader;
list : dword; // A list has the following form: 'LIST' listSize listType listData
size: dword;
movi: dword;
end;
var
movihead: moviheader=
( list :$5453494C; //'LIST'
size :$0; // width x length x bitperpixel
movi: $69766F6D);
type
framestart =record
db : dword;
x : dword;
end;
var
frame_start:framestart=
(db : $62643030;//'00db'
x : $0); // blocksize, to be set later
type
indexstart =record
idx1 : dword;
size: dword; // length of index, nrrecords*$10
end;
var
index_start:indexstart=
(idx1 : $31786469;//'idx1'
size : $0); // length of index, nrrecords*$10, to be set later
type
index =record
db : dword;
x : dword;
position : dword;
size : dword;
end;
var
indx: index=
(db :$62643030;//'00db'
x :$10;
position :$0;
size :$0);
function write_avi_head(filen, frame_rate: string; nrframes, w,h: integer): boolean;{open/create file and writes head. Result is false if failure}
begin
result:=false; // assume failure
head.dwwidth:= w;
head.dwheight:= h;
extra:=(w*nrcolors mod 4);// Each written image line should be a multiple of 4 bytes. Add extra $0 bytes to achieve that. w*nrcolors is 15 => add one zero, 16 => add two zeros, 17 => add three zeros, 18 => add none. Found by reverse engineering.
if extra<>0 then extra:=4-extra;
head.dwTotalFrames:=nrframes;
head.dwMicroSecPerFrame:=round(1000000/max(strtofloat(frame_rate),0.00001));
streamhead.bitcount:=8*nrcolors;
streamhead.width:=w;
streamhead.height:=h;
streamhead.rcframew2:=w;
streamhead.rcframeh2:=h;
streamhead.sizeimage:=w * h * (streamhead.bitcount div 8)+h*extra {zeros behind each line}; {in bytes}
streamhead.dwLength:=head.dwTotalFrames;
streamhead.dwSuggestedBufferSize:= streamhead.sizeimage;
head.dwSuggestedBufferSize:= streamhead.sizeimage;
movihead.size:= 4 {length dword movi}+(streamhead.sizeimage+sizeof(frame_start))*head.dwTotalFrames;
head.riffsize:=sizeof(head)-8+sizeof(streamhead)+sizeof(movihead)+ ( sizeof(frame_start)+ streamhead.sizeimage+ sizeof(indx))*head.dwTotalFrames+sizeof(indexstart) ;
frame_start.x:= streamhead.sizeimage;
try
TheFile:=tfilestream.Create(filen, fmcreate );
except
TheFile.free;
exit;
end;
thefile.writebuffer(head,sizeof(head));
thefile.writebuffer(streamhead,sizeof(streamhead));
thefile.writebuffer(movihead,sizeof(movihead));
result:=true;
end;
function write_avi_frame(x,y,w,h: integer): boolean; {reads pixels from Timage and writes AVI frame. Call this procedure for each image. Result is false if failure}
var
xx,yy : integer;
r,g,b : byte;
row : array of byte;
xLine : PByteArray;
begin
result:=true;
try
thefile.writebuffer(frame_start,sizeof(frame_start)); {write 00db header}
setlength(row, nrcolors*w {width});
for yy := y+h-1 downto y {height} do
begin // scan each timage line
xLine:=mainwindow.image1.Picture.Bitmap.ScanLine[yy];
for xx := x to x+w-1 {width} do
begin
{$ifdef mswindows}
B:=xLine^[xx*3]; {3*8=24 bit}
G:=xLine^[xx*3+1]; {fast pixel write routine }
R:=xLine^[xx*3+2];
{$endif}
{$ifdef darwin} {MacOS}
R:=xLine^[xx*4+1]; {4*8=32 bit}
G:=xLine^[xx*4+2]; {fast pixel write routine }
B:=xLine^[xx*4+3];
{$endif}
{$ifdef linux}
B:=xLine^[xx*4]; {4*8=32 bit}
G:=xLine^[xx*4+1]; {fast pixel write routine }
R:=xLine^[xx*4+2];
{$endif}
row[nrcolors *(xx-x)] :=B;
row[nrcolors *(xx-x)+1]:=G;
row[nrcolors *(xx-x)+2]:=R;
// row[(xx-x)] :=trunc((R+G+B)/3); // Mono seams not a valid option with .avi
end;
thefile.writebuffer(row[0],length(row));
thefile.writebuffer(zero_dword,extra); // Add extra zeros 0,1,2,3 depending on width to make it a mulitiply of 4 bytes. Found by reverse engineering.
end;
except
result:=false;
row:=nil;
exit;
end;
row:=nil;
end;
procedure close_the_avi(nrframes: integer);
var
i: integer;
begin
index_start.size:=nrframes*$10;// index length in bytes
thefile.writebuffer(index_start,sizeof(index_start));
indx.position:=$4;
indx.size:=streamhead.sizeimage;
for i:=1 to nrframes do
begin
thefile.writebuffer(indx,sizeof(indx));
indx.position:=indx.position+sizeof(frame_start)+streamhead.sizeimage;
end;
thefile.free;
end;
end.