Author: Mike Heydon
BMP's to AVI file for TAnimate
Answer:
TAnimate is a rather nice component. However if you don't want to use the built in
AVI files and want to create your own AVI files from BMP files, then you may have a
problem as there is no tool in Delphi to do this.
While browsing the web for information on AVI file formats I came upon a site
www.shrinkwrapvb.com/avihelp/avihelp.htm that is maintained by Ray Mercer. In this
tutorial he explains how to manipulate,read and write AVI files. I was particularly
interested in "Step 5" in which he shows a utility that takes a list of BMP files
that creates an AVI file which can be used by the TAnimate component. The only
problem was that the examples are in Visual Basic, thus a conversion to Delphi was
required.
I have posted this procedure
CreateAVI(const FileName : string; BMPFileList : TStrings; FramesPerSec : integer =
10);
To keep the text of the example simple and readable I have left out most to the
error checking (try except etc.). You can also play with the AVISaveOptions dialog
box, but I can only seem to get it to work with "Full Frames Uncompressed" with BMP
files. Can anyone shed some light on this ?
Errors you should check for are ..
All files are valid BMP files and are of the same size.
All Blockreads are valid with no read errors.
Ray has a downloadable EXE that works quite nicely, however I am about to write my
own utility that incorporates the following ...
Multiline file selection.
Listbox line reordering (drag/drop).
Sort File list
Layout Save and Load .
AVI Preview.
(I have beta version 1.0.0.0 ready, if anyone wants a copy of exe or source code,
drop me a mail at mheydon@pgbison.co.za)
For further info on AVI files I recommend you vist Ray's site at
http://www.shrinkwrapvb.com/avihelp/avihelp.htm it really is a well written
tutorial (even if it is in Visual Basic)
1 const
2 // AVISaveOptions Dialog box flags
3
4 ICMF_CHOOSE_KEYFRAME = 1; // show KeyFrame Every box
5 ICMF_CHOOSE_DATARATE = 2; // show DataRate box
6 ICMF_CHOOSE_PREVIEW = 4; // allow expanded preview dialog
7 ICMF_CHOOSE_ALLCOMPRESSORS = 8; // don't only show those that
8 // can handle the input format
9 // or input data
10 AVIIF_KEYFRAME = 10;
11
12 type
13
14 AVI_COMPRESS_OPTIONS = packed record
15 fccType: DWORD; // stream type, for consistency
16 fccHandler: DWORD; // compressor
17 dwKeyFrameEvery: DWORD; // keyframe rate
18 dwQuality: DWORD; // compress quality 0-10,000
19 dwBytesPerSecond: DWORD; // bytes per second
20 dwFlags: DWORD; // flags... see below
21 lpFormat: DWORD; // save format
22 cbFormat: DWORD;
23 lpParms: DWORD; // compressor options
24 cbParms: DWORD;
25 dwInterleaveEvery: DWORD; // for non-video streams only
26 end;
27
28 AVI_STREAM_INFO = packed record
29 fccType: DWORD;
30 fccHandler: DWORD;
31 dwFlags: DWORD;
32 dwCaps: DWORD;
33 wPriority: word;
34 wLanguage: word;
35 dwScale: DWORD;
36 dwRate: DWORD;
37 dwStart: DWORD;
38 dwLength: DWORD;
39 dwInitialFrames: DWORD;
40 dwSuggestedBufferSize: DWORD;
41 dwQuality: DWORD;
42 dwSampleSize: DWORD;
43 rcFrame: TRect;
44 dwEditCount: DWORD;
45 dwFormatChangeCount: DWORD;
46 szName: array[0..63] of char;
47 end;
48
49 BITMAPINFOHEADER = packed record
50 biSize: DWORD;
51 biWidth: DWORD;
52 biHeight: DWORD;
53 biPlanes: word;
54 biBitCount: word;
55 biCompression: DWORD;
56 biSizeImage: DWORD;
57 biXPelsPerMeter: DWORD;
58 biYPelsPerMeter: DWORD;
59 biClrUsed: DWORD;
60 biClrImportant: DWORD;
61 end;
62
63 BITMAPFILEHEADER = packed record
64 bfType: word; //"magic cookie" - must be "BM"
65 bfSize: integer;
66 bfReserved1: word;
67 bfReserved2: word;
68 bfOffBits: integer;
69 end;
70
71 // DLL External declarations
72
73 function AVISaveOptions(Hwnd: DWORD; uiFlags: DWORD; nStreams: DWORD;
74 pPavi: Pointer; plpOptions: Pointer): boolean;
75 stdcall; external 'avifil32.dll';
76
77 function AVIFileCreateStream(pFile: DWORD; pPavi: Pointer; pSi: Pointer): integer;
78 stdcall; external 'avifil32.dll';
79
80 function AVIFileOpen(pPfile: Pointer; szFile: PChar; uMode: DWORD;
81 clSid: DWORD): integer;
82 stdcall; external 'avifil32.dll';
83
84 function AVIMakeCompressedStream(psCompressed: Pointer; psSource: DWORD;
85 lpOptions: Pointer; pclsidHandler: DWORD): integer;
86 stdcall; external 'avifil32.dll';
87
88 function AVIStreamSetFormat(pAvi: DWORD; lPos: DWORD; lpGormat: Pointer;
89 cbFormat: DWORD): integer;
90 stdcall; external 'avifil32.dll';
91
92 function AVIStreamWrite(pAvi: DWORD; lStart: DWORD; lSamples: DWORD;
93 lBuffer: Pointer; cBuffer: DWORD; dwFlags: DWORD;
94 plSampWritten: DWORD; plBytesWritten: DWORD): integer;
95 stdcall; external 'avifil32.dll';
96
97 function AVISaveOptionsFree(nStreams: DWORD; ppOptions: Pointer): integer;
98 stdcall; external 'avifil32.dll';
99
100 function AVIFileRelease(pFile: DWORD): integer; stdcall; external 'avifil32.dll';
101
102 procedure AVIFileInit; stdcall; external 'avifil32.dll';
103
104 procedure AVIFileExit; stdcall; external 'avifil32.dll';
105
106 function AVIStreamRelease(pAvi: DWORD): integer; stdcall; external 'avifil32.dll';
107
108 function mmioStringToFOURCCA(sz: PChar; uFlags: DWORD): integer;
109 stdcall; external 'winmm.dll';
110
111 // ============================================================================
112 // Main Function to Create AVI file from BMP file listing
113 // ============================================================================
114
115 procedure CreateAVI(const FileName: string; IList: TStrings;
116 FramesPerSec: integer = 10);
117 var
118 Opts: AVI_COMPRESS_OPTIONS;
119 pOpts: Pointer;
120 pFile, ps, psCompressed: DWORD;
121 strhdr: AVI_STREAM_INFO;
122 i: integer;
123 BFile: file;
124 m_Bih: BITMAPINFOHEADER;
125 m_Bfh: BITMAPFILEHEADER;
126 m_MemBits: packed array of byte;
127 m_MemBitMapInfo: packed array of byte;
128 begin
129 DeleteFile(FileName);
130 Fillchar(Opts, SizeOf(Opts), 0);
131 FillChar(strhdr, SizeOf(strhdr), 0);
132 Opts.fccHandler := 541215044; // Full frames Uncompressed
133 AVIFileInit;
134 pfile := 0;
135 pOpts := @Opts;
136
137 if AVIFileOpen(@pFile, PChar(FileName), OF_WRITE or OF_CREATE, 0) = 0 then
138 begin
139 // Determine Bitmap Properties from file item[0] in list
140 AssignFile(BFile, IList[0]);
141 Reset(BFile, 1);
142 BlockRead(BFile, m_Bfh, SizeOf(m_Bfh));
143 BlockRead(BFile, m_Bih, SizeOf(m_Bih));
144 SetLength(m_MemBitMapInfo, m_bfh.bfOffBits - 14);
145 SetLength(m_MemBits, m_Bih.biSizeImage);
146 Seek(BFile, SizeOf(m_Bfh));
147 BlockRead(BFile, m_MemBitMapInfo[0], length(m_MemBitMapInfo));
148 CloseFile(BFile);
149
150 strhdr.fccType := mmioStringToFOURCCA('vids', 0); // stream type video
151 strhdr.fccHandler := 0; // def AVI handler
152 strhdr.dwScale := 1;
153 strhdr.dwRate := FramesPerSec; // fps 1 to 30
154 strhdr.dwSuggestedBufferSize := m_Bih.biSizeImage; // size of 1 frame
155 SetRect(strhdr.rcFrame, 0, 0, m_Bih.biWidth, m_Bih.biHeight);
156
157 if AVIFileCreateStream(pFile, @ps, @strhdr) = 0 then
158 begin
159 // if you want user selection options then call following line
160 // (but seems to only like "Full frames Uncompressed option)
161
162 // AVISaveOptions(Application.Handle,
163 // ICMF_CHOOSE_KEYFRAME or ICMF_CHOOSE_DATARATE,
164 // 1,@ps,@pOpts);
165 // AVISaveOptionsFree(1,@pOpts);
166
167 if AVIMakeCompressedStream(@psCompressed, ps, @opts, 0) = 0 then
168 begin
169 if AVIStreamSetFormat(psCompressed, 0, @m_memBitmapInfo[0],
170 length(m_MemBitMapInfo)) = 0 then
171 begin
172
173 for i := 0 to IList.Count - 1 do
174 begin
175 AssignFile(BFile, IList[i]);
176 Reset(BFile, 1);
177 Seek(BFile, m_bfh.bfOffBits);
178 BlockRead(BFile, m_MemBits[0], m_Bih.biSizeImage);
179 Seek(BFile, SizeOf(m_Bfh));
180 BlockRead(BFile, m_MemBitMapInfo[0], length(m_MemBitMapInfo));
181 CloseFile(BFile);
182 if AVIStreamWrite(psCompressed, i, 1, @m_MemBits[0],
183 m_Bih.biSizeImage, AVIIF_KEYFRAME, 0, 0) <> 0 then
184 begin
185 ShowMessage('Error during Write AVI File');
186 break;
187 end;
188 end;
189 end;
190 end;
191 end;
192
193 AVIStreamRelease(ps);
194 AVIStreamRelease(psCompressed);
195 AVIFileRelease(pFile);
196 end;
197
198 AVIFileExit;
199 m_MemBitMapInfo := nil;
200 m_memBits := nil;
201 end;
|
