B
bluesky888
Unregistered / Unconfirmed
GUEST, unregistred user!
const MAX_BUF_SIZE = 40960;
// maximum buffer size (< 65534)(multiple of 1024)
const MAX_BUF_NUMBER = 20;
// maximum number of buffers to use
PFMP_OPEN_STRUCT = ^TFMP_OPEN_STRUCT;
TFMP_OPEN_STRUCT = record
lpFileName: LPTSTR;
dwCallBack: DWORD;
Reserved: array[0..7] of Byte;
end;
PBuffer = ^Byte;
PBuf = ^TBuf;
TBuffer = array[0..MAX_BUF_NUMBER-1] of PBuffer;
TBuf = record
hFile: THandle;
dwSize: DWORD;
wIndex: WORD;
Buffer: TBuffer;
//PBuffer;
// char *Buffer[MAX_BUF_NUMBER];
BufferIndex: array[0..MAX_BUF_NUMBER-1] of DWord;
// DWORD BufferIndex[MAX_BUF_NUMBER];
end;
function FMPCallbackProc(bMsg: BYTE;
hMPEGStream: BYTE;
dwValue: DWORD): WORD;stdcall;
var
i: integer;
Buf: PBuf;
NumberOfBytes: DWORD;
begin
Buf := PBuf(FMPGet(hMPEGStream, FMPI_STM_USER));
case bMsg of
// first message received - make all your allocations here
FMPM_BUF_CREATE:
begin
//DWORD dwIndex;
Buf := PBuf(GlobalAllocPtr(GMEM_FIXED, sizeof(TBuf)));
if not Assigned(Buf) then
begin
MessageBox(0,"Error while allocating TBuf","FMPBuf1::FMPCallbackProc()",MB_ICONASTERISK or MB_OK );
Result := FMPE_DOS;
exit;
end;
ZeroMemory(Buf, sizeof(TBuf));
// Value is the parameter passed when opening the file( ie. filename )
Buf^.hFile := CreateFile((PFMP_OPEN_STRUCT(dwValue))^.lpFileName,
GENERIC_READ, FILE_SHARE_READ,
nil,
OPEN_EXISTING,
0,
0);
// if we cannot open the file, return an error
// NOTE: the FMPM_BUF_CLOSE is not called when an error occurs
// during the creation
if (Buf^.hFile = INVALID_HANDLE_VALUE) then
begin
MessageBox( 0,"Error While Opening File","FMPBuf1::FMPCallbackProc()",MB_ICONASTERISK or MB_OK );
GlobalFreePtr(Buf);
Result := FMPE_DOS;
exit;
end;
for i := 0 to MAX_BUF_NUMBER - 1do
Buf^.Buffer := PBuffer(GlobalAllocPtr(GMEM_FIXED, MAX_BUF_SIZE + 2));
Buf^.wIndex := 0;
Buf^.dwSize := 0;
// store the structure address in the USER field
FMPSet(hMPEGStream, FMPI_STM_USER, DWORD(Buf));
// trigger at 3/4 of the buffer to fill the next buffer
FMPSet(hMPEGStream, FMPI_BUF_POS, DWORD(trunc(MAX_BUF_SIZE * 0.75)));
end;
{End for case 'FMPM_BUF_CREATE'}
// message received when closing the stream - delete buffers
FMPM_BUF_CLOSE:
begin
// close the file
CloseHandle(Buf^.hFile);
// free all application buffers
for i := 0 to MAX_BUF_NUMBER - 1do
GlobalFreePtr(Buf^.Buffer);
GlobalFreePtr(Buf);
end;
{End for case 'FMPM_BUF_CLOSE'}
// message received when a seek is required - seek to the position
// in Value (specified in bytes)
FMPM_BUF_SEEK:
SetFilePointer(Buf^.hFile, integer(dwValue), nil, FILE_begin
);
// message received when a buffer has reached its signal position -
// prepare here the next buffer
FMPM_BUF_POS:
begin
NumberOfBytes := DWORD(@(Buf^.dwSize));
ReadFile(Buf^.hFile, Buf^.Buffer[Buf^.wIndex], MAX_BUF_SIZE, NumberOfBytes, nil);
// message received when a buffer has been completely read - switch to
end;
// the next prepared buffer
FMPM_BUF_EMPTY:
begin
FMPSet(hMPEGStream, FMPI_BUF_SIZE, Buf^.dwSize);
FMPSet(hMPEGStream, FMPI_BUF_ADDRESS, DWORD(Buf^.Buffer[Buf^.wIndex]));
//FMPSet( ghMPEGStream, FMPI_BUF_HANDLE, (DWORD)Buf->BufferIndex[Buf->wIndex] );
Inc(Buf^.wIndex);
Buf^.wIndex := Buf^.wIndex mod MAX_BUF_NUMBER;
end;
{End for case 'FMPM_BUF_EMPTY'}
FMPM_ERROR:
end;
{End for case statement}
Result := 0;
end;
下面为调用:
procedure TForm1.Button2Click(Sender: TObject);
var
FMPOpenStruct: TFMP_OPEN_STRUCT;
filename: string;
begin
// stop and close any currently opened MPEG stream
if ghMPEGStream <> 0 then
begin
FMPStop(ghMPEGStream);
FMPClose(ghMPEGStream);
ghMPEGStream := 0;
end;
// open selected MPEG stream
ZeroMemory(@FMPOpenStruct, sizeof(FMPOpenStruct));
FMPOpenStruct.lpFileName := Pchar(filename);
FMPOpenStruct.dwCallBack := DWORD(@FMPCallbackProc);
ghMPEGStream := BYTE(FMPOpen(FMPF_BUFFERS, DWORD(@FMPOpenStruct)));
if ghMPEGStream = 0 then
begin
MessageBox( 0, "File open error", "FMPBuf1 ERROR",
MB_ICONASTERISK or MB_OK );
end;
// set video keying mode
FMPSet(ghMPEGStream, FMPI_VID_KEY_MODE, FMPF_KEY_VGA);
// set video keying color
FMPSet(ghMPEGStream, FMPI_VID_KEY_COL, 0);
end;
// maximum buffer size (< 65534)(multiple of 1024)
const MAX_BUF_NUMBER = 20;
// maximum number of buffers to use
PFMP_OPEN_STRUCT = ^TFMP_OPEN_STRUCT;
TFMP_OPEN_STRUCT = record
lpFileName: LPTSTR;
dwCallBack: DWORD;
Reserved: array[0..7] of Byte;
end;
PBuffer = ^Byte;
PBuf = ^TBuf;
TBuffer = array[0..MAX_BUF_NUMBER-1] of PBuffer;
TBuf = record
hFile: THandle;
dwSize: DWORD;
wIndex: WORD;
Buffer: TBuffer;
//PBuffer;
// char *Buffer[MAX_BUF_NUMBER];
BufferIndex: array[0..MAX_BUF_NUMBER-1] of DWord;
// DWORD BufferIndex[MAX_BUF_NUMBER];
end;
function FMPCallbackProc(bMsg: BYTE;
hMPEGStream: BYTE;
dwValue: DWORD): WORD;stdcall;
var
i: integer;
Buf: PBuf;
NumberOfBytes: DWORD;
begin
Buf := PBuf(FMPGet(hMPEGStream, FMPI_STM_USER));
case bMsg of
// first message received - make all your allocations here
FMPM_BUF_CREATE:
begin
//DWORD dwIndex;
Buf := PBuf(GlobalAllocPtr(GMEM_FIXED, sizeof(TBuf)));
if not Assigned(Buf) then
begin
MessageBox(0,"Error while allocating TBuf","FMPBuf1::FMPCallbackProc()",MB_ICONASTERISK or MB_OK );
Result := FMPE_DOS;
exit;
end;
ZeroMemory(Buf, sizeof(TBuf));
// Value is the parameter passed when opening the file( ie. filename )
Buf^.hFile := CreateFile((PFMP_OPEN_STRUCT(dwValue))^.lpFileName,
GENERIC_READ, FILE_SHARE_READ,
nil,
OPEN_EXISTING,
0,
0);
// if we cannot open the file, return an error
// NOTE: the FMPM_BUF_CLOSE is not called when an error occurs
// during the creation
if (Buf^.hFile = INVALID_HANDLE_VALUE) then
begin
MessageBox( 0,"Error While Opening File","FMPBuf1::FMPCallbackProc()",MB_ICONASTERISK or MB_OK );
GlobalFreePtr(Buf);
Result := FMPE_DOS;
exit;
end;
for i := 0 to MAX_BUF_NUMBER - 1do
Buf^.Buffer := PBuffer(GlobalAllocPtr(GMEM_FIXED, MAX_BUF_SIZE + 2));
Buf^.wIndex := 0;
Buf^.dwSize := 0;
// store the structure address in the USER field
FMPSet(hMPEGStream, FMPI_STM_USER, DWORD(Buf));
// trigger at 3/4 of the buffer to fill the next buffer
FMPSet(hMPEGStream, FMPI_BUF_POS, DWORD(trunc(MAX_BUF_SIZE * 0.75)));
end;
{End for case 'FMPM_BUF_CREATE'}
// message received when closing the stream - delete buffers
FMPM_BUF_CLOSE:
begin
// close the file
CloseHandle(Buf^.hFile);
// free all application buffers
for i := 0 to MAX_BUF_NUMBER - 1do
GlobalFreePtr(Buf^.Buffer);
GlobalFreePtr(Buf);
end;
{End for case 'FMPM_BUF_CLOSE'}
// message received when a seek is required - seek to the position
// in Value (specified in bytes)
FMPM_BUF_SEEK:
SetFilePointer(Buf^.hFile, integer(dwValue), nil, FILE_begin
);
// message received when a buffer has reached its signal position -
// prepare here the next buffer
FMPM_BUF_POS:
begin
NumberOfBytes := DWORD(@(Buf^.dwSize));
ReadFile(Buf^.hFile, Buf^.Buffer[Buf^.wIndex], MAX_BUF_SIZE, NumberOfBytes, nil);
// message received when a buffer has been completely read - switch to
end;
// the next prepared buffer
FMPM_BUF_EMPTY:
begin
FMPSet(hMPEGStream, FMPI_BUF_SIZE, Buf^.dwSize);
FMPSet(hMPEGStream, FMPI_BUF_ADDRESS, DWORD(Buf^.Buffer[Buf^.wIndex]));
//FMPSet( ghMPEGStream, FMPI_BUF_HANDLE, (DWORD)Buf->BufferIndex[Buf->wIndex] );
Inc(Buf^.wIndex);
Buf^.wIndex := Buf^.wIndex mod MAX_BUF_NUMBER;
end;
{End for case 'FMPM_BUF_EMPTY'}
FMPM_ERROR:
end;
{End for case statement}
Result := 0;
end;
下面为调用:
procedure TForm1.Button2Click(Sender: TObject);
var
FMPOpenStruct: TFMP_OPEN_STRUCT;
filename: string;
begin
// stop and close any currently opened MPEG stream
if ghMPEGStream <> 0 then
begin
FMPStop(ghMPEGStream);
FMPClose(ghMPEGStream);
ghMPEGStream := 0;
end;
// open selected MPEG stream
ZeroMemory(@FMPOpenStruct, sizeof(FMPOpenStruct));
FMPOpenStruct.lpFileName := Pchar(filename);
FMPOpenStruct.dwCallBack := DWORD(@FMPCallbackProc);
ghMPEGStream := BYTE(FMPOpen(FMPF_BUFFERS, DWORD(@FMPOpenStruct)));
if ghMPEGStream = 0 then
begin
MessageBox( 0, "File open error", "FMPBuf1 ERROR",
MB_ICONASTERISK or MB_OK );
end;
// set video keying mode
FMPSet(ghMPEGStream, FMPI_VID_KEY_MODE, FMPF_KEY_VGA);
// set video keying color
FMPSet(ghMPEGStream, FMPI_VID_KEY_COL, 0);
end;