Mega Code Archive
Directx kullanarak film-ses denetimi - 2
<![CDATA[
Begin
Case dsEventCode of
EC_COMPLETE : Begin
StopButton.Click;
plState := stStopped;
End;
End;
// Free the event from memory
dsMediaEventEx.FreeEventParams(dsEventCode,dsEventParam1,dsEventParam2);
End;
End;
end;
procedure TMainForm.SetWindowPos(pLeft,pTop,pWidth,pHeight : Integer);
begin
If (Assigned(dsVideoWindow)) and (plState <> stClosed) then
Begin
dsVideoWindow.SetWindowPosition(pLeft,pTop,pWidth,pHeight);
End;
end;
procedure TMainForm.ResetWindowPos;
begin
SetWindowPos(0,0,VideoPanel.Width,VideoPanel.Height);
end;
procedure TMainForm.SetCurrentPosition(mPos : Int64);
begin
If Assigned(dsMediaSeeking) then
Begin
dsMediaSeeking.SetPositions(mPos,AM_SEEKING_AbsolutePositioning,mPos,AM_SEEKING_NoPositioning);
MediaPosition := mPos;
End;
end;
function TMainForm.GetCurrentPosition : Int64;
var
CurPos : Int64;
StopPos : Int64; // Not really used by this program
begin
// Default result in case of failure
Result := -1;
If Assigned(dsMediaSeeking) then
Begin
If dsMediaSeeking.GetPositions(CurPos,StopPos) = S_OK then
Begin
Result := CurPos;
End;
End;
end;
procedure TMainForm.QuitButtonClick(Sender: TObject);
begin
Close;
end;
procedure TMainForm.OpenButtonClick(Sender: TObject);
var
FileName : String;
UnicodeFileName : Array[0..(MAX_PATH*2)-1] of Char;
begin
If OpenDialog.Execute = True then
Begin
Filename := OpenDialog.FileName;
If FileExists(FileName) = True then
Begin
// First clean the old movie interface
DestroyMovieInterface;
// In case we can't seek this file
MediaPosition := 0;
// Now create a new movie interface
If CreateMovieInterface = True then
Begin
// Get filename in UNICODE
MultiByteToWideChar(CP_ACP,0,PChar(FileName),-1,@UnicodeFileName,MAX_PATH);
// Render the file filters
If dsGraphBuilder.RenderFile(@UnicodeFileName,nil) = S_OK then
Begin
SetVolume(VolumeBar.Position);
plState := stOpen;
If Assigned(dsMediaSeeking) then
Begin
dsMediaSeeking.GetDuration(MediaLength);
End;
// Set our form as the owner
dsVideoWindow.put_Owner(MainForm.Handle);
// Set the video window messages (mouse/keyboard) to be routed to our form
dsVideoWindow.put_MessageDrain(MainForm.Handle);
// Set the video window to be a child window of our form.
dsVideoWindow.put_WindowStyle(WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN);
// Set the inital window position
ResetWindowPos;
// Seek the video to the start and pause.
StopButton.Click;
End
else
Begin
ShowMessage('Unable to render the file');
DestroyMovieInterface;
End;
End
Else ShowMessage('Unable to create DirectShow Interface');
End;
End;
end;
procedure TMainForm.StopButtonClick(Sender: TObject);
begin
If (plState <> stClosed) and (plState <> stStopped) then
Begin
If Assigned(dsMediaControl) then
Begin
// Stop Playback
dsMediaControl.Stop;
// Seek to First Frame
SetCurrentPosition(0);
// Pause Playback (brings up first image)
dsMediaControl.Pause;
plState := stStopped;
PlayButton.Caption := 'Play';
UpdateTimeLine;
End;
End;
end;
procedure TMainForm.PlayButtonClick(Sender: TObject);
begin
If Assigned(dsMediaControl) and (plState <> stClosed) then
Begin
// Pause if playing, Play if Stopped or Paused.
If (plState = stPaused) or (plState = stStopped) then
Begin
dsMediaControl.Run;
plState := stPlaying;
PlayButton.Caption := 'Pause';
End
else
Begin
dsMediaControl.Pause;
plState := stPaused;
PlayButton.Caption := 'Play';
End;
End;
end;
procedure TMainForm.FormResize(Sender: TObject);
begin
ResetWindowPos;
end;
procedure TMainForm.FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
begin
If (NewHeight < 359) then NewHeight := 359;
If (NewWidth < 408) then NewWidth := 408;
end;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
DestroyMovieInterface;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
// Smoother form draws
MainForm.DoubleBuffered := True;
// Create the bitmap used for the timeline
TimeLineImage.Picture.Bitmap.Width := TimeLineImage.Width;
TimeLineImage.Picture.Bitmap.Height := TimeLineImage.Height;
TimeLineImage.Picture.Bitmap.PixelFormat := pf24bit;
UpdateTimeLine;
end;
procedure TMainForm.UpdateTimeLine;
begin
// Clear the TimeLine;
TimeLineImage.Picture.Bitmap.Canvas.Brush.Color := clWhite;
TimeLineImage.Picture.Bitmap.Canvas.FillRect(Rect(0,0,TimeLineImage.Width,TimeLineImage.Height));
// Fill in the current position
TimeLineImage.Picture.Bitmap.Canvas.Brush.Color := clBlue;
TimeLineImage.Picture.Bitmap.Canvas.FillRect(Rect(0,0,Trunc(MediaPosition/(MediaLength / 100)),TimeLineImage.Height));
end;
procedure TMainForm.SetVolume(vLevel : Integer);
begin
If Assigned(dsBasicAudio) then dsBasicAudio.Put_Volume(VolumeTable[vLevel]);
end;
procedure TMainForm.SeekTimerTimer(Sender: TObject);
begin
If plState <> stClosed then
Begin
MediaPosition := GetCurrentPosition;
UpdateTimeLine;
End;
end;
procedure TMainForm.TimeLineImageMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
// Relay the even to the mouse move since they do the same thing
TimeLineImageMouseMove(Sender,Shift,X,Y);
end;
procedure TMainForm.TimeLineImageMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
// Set to the clicked position, only if left mouse button is clicked
If Shift = [ssLeft] = True then
Begin
SetCurrentPosition(Trunc((MediaLength/100)*X));
UpdateTimeLine;
End;
end;
procedure TMainForm.VolumeBarChange(Sender: TObject);
begin
If plState <> stClosed then SetVolume(VolumeBar.Position);
end;
procedure TMainForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
PlayButton.Click;
end;
end.
]]>