Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
BMP's to AVI file for TAnimate Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
23-Oct-02
Category
Multimedia
Language
Delphi 5.x
Views
189
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			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;


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC