unit1.pas

Delphi6编程大师_多媒体

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  MPlayer, ExtCtrls, StdCtrls, ComCtrls, Buttons;

type
  TForm1 = class(TForm)
    mdPlayer: TMediaPlayer;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    UpDown1: TUpDown;
    TrackBar: TTrackBar;
    SpeedButton1: TSpeedButton;
    Button1: TButton;
    OpenDlg: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SpeedButton1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure mdPlayerClick(Sender: TObject; Button: TMPBtnType;
      var DoDefault: Boolean);
    procedure TrackBarChange(Sender: TObject);
  private
    procedure UpdataTrackBar;
    procedure InitShow;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Fetchf : Boolean;
  path : string;
  Count : integer;
implementation

{$R *.DFM}


Procedure TForm1.UpdataTrackBar;
begin
  TrackBar.min := MdPlayer.StartPos;
  TrackBar.max := MdPlayer.Length;
  TrackBar.Position := MdPlayer.Position;
  Label2.Caption := '当前位置： '
    +Inttostr(MdPlayer.Position);
end;

procedure TForm1.InitShow;
begin
  with Mdplayer do begin
    Form1.Caption := FileName ;
    Path := ExtractFilePath(FileName)+'bmp';
  Count := 0;
  if FileName <> '' then begin
  Open;
  TrackBar.Enabled := True;
    UpdataTrackBar;
  TrackBar.SetFocus ;
  Frames := 1;
    label1.Caption :='文件名: ' +
  FileName + #13#10 +' 总长度: '+ Inttostr(Length);
        label1.Caption :=Label1.Caption +
  #13#10 +' 起始位置: '+ Inttostr(StartPos)
  end else begin
    Label1.Caption :='';
  Label2.Caption :='';
  end;
  end;
  end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  MdPlayer.FileName :='';
  TrackBar.Enabled := False;
  InitShow;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  mdPlayer.Close;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  if SpeedButton1.Down then begin
        Fetchf := True;
  mdPlayer.Frames := updown1.Position
  end
  else Fetchf := False;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  MdPlayer.Close ;
  TrackBar.Enabled := False;
  label1.Caption := '';
  label2.Caption := '';
  if OpenDlg.Execute then begin
  mdPlayer.FileName := OpenDlg.FileName;
  InitShow;
end;
end;

procedure TForm1.mdPlayerClick(Sender: TObject; Button: TMPBtnType;
  var DoDefault: Boolean);
var
  MyBmp : TBitmap;
  MyCanvas : Tcanvas;
  dc : Hdc;
  rect : TRect;
  name,tmp : String;
begin
  UpdataTrackBar;
  if ((Button = btBack) or (Button = btStep))
    and Fetchf then
  try
  myBmp := TBitMap.Create ;
  MyCanvas := TCanvas.Create ;
  rect := mdPlayer.DisplayRect ;
  Dc := GetDc(Panel1.Handle);
  myCanvas.Handle := dc;

  myBmp.Width := rect.Right - rect.Left ;
  myBmp.Height := rect.Bottom - rect.Top ;
  myBmp.Canvas.CopyRect(rect,myCanvas,Rect);
  count :=count+1;

  if count< 10 then name := '000' + Inttostr(count)
  else if count < 100 then name := '00'
    + Inttostr(count)
  else if count< 1000 then name := '0'
    + Inttostr(count);
  name := Path + name + '.bmp';
  myBmp.SaveToFile(name);
  finally
    ReleaseDC(0 ,dc);
    myBmp.Free;
    myCanvas.Free;
  end;
end;

procedure TForm1.TrackBarChange(Sender: TObject);
begin
  MdPlayer.Position := TrackBar.Position ;
  Label2.Caption := '当前位置： '
  +Inttostr(MdPlayer.Position);
end;

end.