www.pudn.com > 縐嶺ok嗣馱夔畦溫ん40050_mv.rar > Unit1.pas

unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, Menus, StdCtrls, DSPack, ExtCtrls, ImgList, Buttons, ComCtrls, 
  ToolWin, DirectShow9,Jpeg; 
 
type 
  TMainForm = class(TForm) 
    MainMenu1: TMainMenu; 
    N1: TMenuItem; 
    N2: TMenuItem; 
    N3: TMenuItem; 
    N4: TMenuItem; 
    PlayFunc: TMenuItem; 
    PlayMNU: TMenuItem; 
    PauseMNU: TMenuItem; 
    StopMNU: TMenuItem; 
    N9: TMenuItem; 
    BackwardMNU: TMenuItem; 
    FowardMNU: TMenuItem; 
    N12: TMenuItem; 
    FSMNU: TMenuItem; 
    PopupMenu1: TPopupMenu; 
    N5: TMenuItem; 
    N6: TMenuItem; 
    TopPanel: TPanel; 
    SG: TSampleGrabber; 
    Panel2: TPanel; 
    PlayFuncTB: TToolBar; 
    ToolButton1: TToolButton; 
    ToolButton2: TToolButton; 
    ToolButton3: TToolButton; 
    ToolButton4: TToolButton; 
    ToolButton5: TToolButton; 
    ToolButton6: TToolButton; 
    ToolButton7: TToolButton; 
    ToolButton8: TToolButton; 
    ToolButton9: TToolButton; 
    DSTrackBar1: TDSTrackBar; 
    Panel3: TPanel; 
    VWEX: TDSVideoWindowEx2; 
    RadioGroup1: TRadioGroup; 
    GrabPanel: TPanel; 
    MADFilter: TFilter; 
    OpenDialog1: TOpenDialog; 
    ImageList1: TImageList; 
    FG: TFilterGraph; 
    procedure N4Click(Sender: TObject); 
    procedure N2Click(Sender: TObject); 
    procedure N5Click(Sender: TObject); 
    procedure VWEXMouseDown(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); 
    procedure ToolButton1Click(Sender: TObject); 
    procedure ToolButton2Click(Sender: TObject); 
    procedure ToolButton3Click(Sender: TObject); 
    procedure ToolButton5Click(Sender: TObject); 
    procedure ToolButton6Click(Sender: TObject); 
    procedure ToolButton8Click(Sender: TObject); 
    procedure PlayMNUClick(Sender: TObject); 
    procedure PauseMNUClick(Sender: TObject); 
    procedure StopMNUClick(Sender: TObject); 
    procedure BackwardMNUClick(Sender: TObject); 
    procedure FowardMNUClick(Sender: TObject); 
    procedure ToolButton9Click(Sender: TObject); 
    procedure N6Click(Sender: TObject); 
    procedure RadioGroup1Click(Sender: TObject); 
    procedure FSMNUClick(Sender: TObject); 
    procedure DSTrackBar1Timer(sender: TObject; CurrentPos, 
      StopPos: Cardinal); 
  private 
    { Private declarations } 
  public 
    { Public declarations } 
    SeekControl : IMediaControl; 
    Grabbing: boolean; 
  end; 
 
var 
  MainForm: TMainForm; 
 
implementation 
 
{$R *.dfm} 
 
procedure TMainForm.N4Click(Sender: TObject); 
begin 
   Close; 
end; 
 
procedure TMainForm.N2Click(Sender: TObject); 
begin 
   if OpenDialog1.Execute then begin 
      IF FG.State=gsPlaying then 
         FG.Stop; 
      FG.Active:=true; 
      FG.ClearGraph; 
      FG.RenderFile(Opendialog1.FileName); 
      FG.QueryInterface(IMediaControl,SeekControl); 
      FG.Play; 
      PlayFunc.Enabled:=true; 
      PlayFuncTB.Enabled:=true; 
      RadioGroup1.Enabled:=true; 
      RADIOGROUP1.ItemIndex:=1; 
      GrabPanel.Visible:=true; 
      Grabbing:=false; 
   end; 
end; 
 
 
 
 
 
procedure TMainForm.N5Click(Sender: TObject); 
begin 
   FSMNU.Click; 
end; 
 
procedure TMainForm.VWEXMouseDown(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
   if FG.State=gsPlaying then 
      PopupMenu1.Popup(mouse.CursorPos.X+3,mouse.CursorPos.Y+3); 
end; 
 
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); 
begin 
   IF FG.State=gsPlaying then 
      FG.Stop; 
   FG.ClearGraph; 
   FG.Active:=false; 
end; 
 
procedure TMainForm.ToolButton1Click(Sender: TObject); 
begin 
   PlayMNU.Click; 
end; 
 
procedure TMainForm.ToolButton2Click(Sender: TObject); 
begin 
   PauseMNU.Click; 
end; 
 
procedure TMainForm.ToolButton3Click(Sender: TObject); 
begin 
   StopMNU.Click; 
end; 
 
procedure TMainForm.ToolButton5Click(Sender: TObject); 
begin 
   BackwardMNU.Click; 
end; 
 
procedure TMainForm.ToolButton6Click(Sender: TObject); 
begin 
   FowardMNU.Click; 
end; 
 
procedure TMainForm.ToolButton8Click(Sender: TObject); 
begin 
   FSMNU.Click; 
end; 
 
procedure TMainForm.PlayMNUClick(Sender: TObject); 
begin 
   FG.Play; 
end; 
 
procedure TMainForm.PauseMNUClick(Sender: TObject); 
begin 
   FG.Pause; 
end; 
 
procedure TMainForm.StopMNUClick(Sender: TObject); 
begin 
   FG.Stop; 
end; 
 
procedure TMainForm.BackwardMNUClick(Sender: TObject); 
var ncpt,ocpt,tcpt : LONGLONG; 
    g_pMediaSeeking:IMediaSeeking; 
begin 
   if Succeeded(FG.QueryInterface(IID_IMediaSeeking, g_pMediaSeeking)) then  begin 
      g_pMediaSeeking.GetCurrentPosition(ncpt); 
      g_pMediaSeeking.GetStopPosition(ocpt); 
      ncpt:=ncpt-(ocpt div 30); 
      if ncpt<0 then ncpt:=0; 
      g_pMediaSeeking.SetPositions(ncpt, AM_SEEKING_AbsolutePositioning, ncpt , AM_SEEKING_NoPositioning); 
   end; 
end; 
 
procedure TMainForm.FowardMNUClick(Sender: TObject); 
var ncpt,ocpt,tcpt : LONGLONG; 
    g_pMediaSeeking:IMediaSeeking; 
begin 
   if Succeeded(FG.QueryInterface(IID_IMediaSeeking, g_pMediaSeeking)) then  begin 
      g_pMediaSeeking.GetCurrentPosition(ncpt); 
      g_pMediaSeeking.GetStopPosition(ocpt); 
      ncpt:=ncpt+(ocpt div 30); 
      g_pMediaSeeking.SetPositions(ncpt, AM_SEEKING_AbsolutePositioning, ocpt, AM_SEEKING_NoPositioning); 
   end; 
end; 
 
procedure TMainForm.ToolButton9Click(Sender: TObject); 
begin 
   if VWEX.DesktopPlayback then 
      VWEX.NormalPlayback 
   else begin 
      VWEX.StartDesktopPlayback; 
      showmessage('您的桌面已經變成放映布了!!!請縮小其他視窗看看吧~') 
   end; 
end; 
 
procedure TMainForm.N6Click(Sender: TObject); 
begin 
   showmessage('本程式是奇聲卡拉 O K 電腦伴唱專業研究開發，所有程式碼可自行修改，'+#13+ 
               '但請大方公開修改後的作品，讓更多人能有福氣共享我們的作品'+#13#13#13+ 
               '039917 2004/04/03'); 
end; 
 
procedure TMainForm.RadioGroup1Click(Sender: TObject); 
VAR GS2 : IMpegAudioDecoder; 
    SCNT : cardinal; 
begin 
     if succeeded(MADFilter.QueryInterface(IMpegAudioDecoder,GS2)) then begin 
        scnt:=radiogroup1.ItemIndex; 
        gs2.put_dualmode(scnt); 
     end; 
end; 
 
 
 
procedure TMainForm.FSMNUClick(Sender: TObject); 
begin 
   if (FG.state=gsPlaying) and  VWEX.FullScreen then 
      VWEX.NormalPlayback 
   else 
      VWEX.StartFullScreen; 
end; 
 
procedure TMainForm.DSTrackBar1Timer(sender: TObject; CurrentPos, 
  StopPos: Cardinal); 
var fn ,fnex,pathx: string; 
    BMP:TBitmap; 
    JPG:TJpegImage; 
begin 
//           這里是每隔0.5秒截一張圖，一秒鐘二張，頻率可以在DSTrackBar1.Timeinterval設定 
//            1000 代表1000微秒，就是1秒，500就是0.5秒........... 
 
 
 
end; 
 
 
 
end.