Форум: "Система";
Текущий архив: 2002.02.25;
Скачать: [xml.tar.bz2];
Внизпомогите чем можете Найти похожие ветки
← →
Прикольщик (2001-11-15 22:53) [0]вот в чем проблема делаю плеер а он только МР3 форматы понимает
а другие форматы понимать не хочет.
вот весь листинг:
unit MainF;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, FileCtrl, StdCtrls, ExtCtrls, ComCtrls, Buttons, MPlayer, Gauges,
RXSlider, Menus,mmsystem,ShellAPI,OpenGL,MAPI;
type
TTMPMainForm = class(TForm)
Panfile: TPanel;
Pandir: TPanel;
Pandrive: TPanel;
Panfilter: TPanel;
FileBox: TFileListBox;
DriveBox: TDriveComboBox;
FilterBox: TFilterComboBox;
StatusBar1: TStatusBar;
Panel1: TPanel;
OpenDlg: TOpenDialog;
HistoryList: TListBox;
Panel2: TPanel;
CheckBox1: TCheckBox;
MPTimer: TTimer;
Panel3: TPanel;
Label1: TLabel;
Slider: TRxSlider;
Playbut: TSpeedButton;
PauseBut: TSpeedButton;
StopBut: TSpeedButton;
Nextbut: TSpeedButton;
PreviousBut: TSpeedButton;
StepBut: TSpeedButton;
BackBut: TSpeedButton;
SpeedButton1: TSpeedButton;
MPlayer: TMediaPlayer;
DirBox: TDirectoryListBox;
PopMenu: TPopupMenu;
LoadPlayList1: TMenuItem;
SavePlayList1: TMenuItem;
PlayLisiDlg: TOpenDialog;
SaveListDlg: TSaveDialog;
CreatePlayList1: TMenuItem;
N1: TMenuItem;
N2: TMenuItem;
ArrangeAll1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FileBoxDblClick(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure HistoryListDblClick(Sender: TObject);
procedure MPTimerTimer(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure SliderMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure SliderMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Label1Click(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure MPlayerClick(Sender: TObject; Button: TMPBtnType;
var DoDefault: Boolean);
procedure LoadPlayList1Click(Sender: TObject);
procedure SavePlayList1Click(Sender: TObject);
procedure CreatePlayList1Click(Sender: TObject);
private
{ Private declarations }
PlayName:String;
PathName:String;
trMove : Boolean; //флаг - мы передвигаем TrackBar или нет
fPS : Boolean;
Direction : Integer;
procedure NextSong(Num: Integer);
public
{ Public declarations }
end;
var
TMPMainForm: TTMPMainForm;
implementation
{$R *.dfm}
procedure TTMPMainForm.HistoryListDblClick(Sender: TObject);
begin
try
if MPlayer.Mode = mpPlaying then
MPlayer.Stop;
if MPlayer.Mode = mpOpen then
MPlayer.Eject;
MPlayer.FileName :=HistoryList.Items[HistoryList.ItemIndex];
MPlayer.Open;
Slider.MaxValue := MPlayer.Length;
MPlayer.Play;
fPS := True;
except
on E: Exception do begin
MPlayer.Close;
ShowMessage(E.Message);
end;
end;
end;
procedure TTMPMainForm.FormCreate(Sender: TObject);
begin
trMove := False;
fPS := False;
MPlayer.Open;
MPlayer.TimeFormat := tfMilliseconds;
Direction := 0;
end;
procedure TTMPMainForm.FileBoxDblClick(Sender: TObject);
begin
with MPlayer do
begin
PathName:=FileBox.FileName;
FileName:=PathName;
Open;
Play;
end;
end;
procedure TTMPMainForm.CheckBox1Click(Sender: TObject);
var
Start_From : Longint;
begin
with MPlayer do begin
if FileName="" then Exit;
Start_From:=Position;
Close;
HistoryList.Items.SaveToFile("TMPlayer.tmp");
HistoryList.Clear;
if CheckBox1.Checked then
Display:=HistoryList
else
Display:=NIL;
HistoryList.Items.LoadFromFile("TMPlayer.tmp");
Open;
Position:=Start_From;
Play;
end;
end;
procedure TTMPMainForm.MPTimerTimer(Sender: TObject);
var
M, S, T: Integer;
sAdd : String;
begin
M := 0;
if (not trMove) and (MPlayer.Mode = mpPlaying) then begin
Slider.Value :=MPlayer.Position; //Если мы не двигаем TrackBar вручную и проигрыватель играет передвинуть TrackBar
case Direction of
0 : begin
T := MPlayer.Position div 1000;
sAdd := "";
end;
1 : begin
T := (MPlayer.Length - MPlayer.Position) div 1000;
sAdd := "-";
end;
end;
if T > 59 then begin
M := T div 60;
S := T - (M * 60);
end else
S := T;
Label1.Caption := sAdd +"Min: "+IntToStr(M)+" Sec: "+IntToStr(S);
end;
if (fPS) and (MPlayer.Mode = mpStopped) then
NextSong(1);
end;
procedure TTMPMainForm.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
if MPlayer.Mode = mpOpen then begin
MPlayer.Eject;
MPlayer.Close;
end;
end;
procedure TTMPMainForm.SliderMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
trMove := True;
end;
← →
Прикольщик (2001-11-15 22:54) [1]
procedure TTMPMainForm.SliderMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
MPlayer.Position := Slider.Value;
MPlayer.Play;
trMove := False;
end;
procedure TTMPMainForm.NextSong(Num: Integer);
begin
if (HistoryList.Items.Count > 1) and
(((Num > 0) and (HistoryList.ItemIndex < HistoryList.Items.Count - Num)) or
((Num < 0) and (HistoryList.ItemIndex > -1 - Num))) then begin
HistoryList.ItemIndex := HistoryList.ItemIndex + Num;
HistoryListDblClick(Self);
end;
end;
procedure TTMPMainForm.Label1Click(Sender: TObject);
begin
if Direction = 0 then
Direction := 1
else
Direction := 0;
end;
procedure TTMPMainForm.FormResize(Sender: TObject);
begin
if Width < 255 then
Width := 255;
if Height < 150 then
Height := 150;
end;
procedure TTMPMainForm.MPlayerClick(Sender: TObject; Button: TMPBtnType;
var DoDefault: Boolean);
begin
DoDefault:=false;
if (Button=btEject) and (OpenDlg.Execute) then
begin
HistoryList.Items:=OpenDlg.Files;
DirBox.Directory:=ExtractFilePath(OpenDlg.FileName);
DirBox.Update;
end
else
if Button=btPlay then begin
if HistoryList.ItemIndex > -1 then
HistoryListDblClick(self)
else
if MPlayer.FileName<>"" then
begin
try MPlayer.Open;
Slider.MaxValue:=MPlayer.Length;
fPS:=true;
MPlayer.Play;
except
on E: Exception do begin
MPlayer.Close;
ShowMessage(E.Message);
end;
end;
end;
end else if (Button = btPause) and (MPlayer.Mode <> mpPaused) then
MPlayer.Pause
else if (Button = btPause) and (MPlayer.Mode = mpPaused) then
MPlayer.Resume
else if Button = btStop then begin
fPS := False;
MPlayer.Stop;
Slider.Value := MPlayer.Start;
Label1.Caption := "0 : 0";
end else if Button = btNext then
NextSong(1)
else if Button = btPrev then
NextSong(-1);
end;
procedure TTMPMainForm.LoadPlayList1Click(Sender: TObject);
begin
if PlayLisiDlg.Execute then
begin
PlayName:=PlayLisiDlg.FileName;
HistoryList.Items.LoadFromFile(PlayName);
end;
end;
procedure TTMPMainForm.SavePlayList1Click(Sender: TObject);
begin
if SaveListDlg.Execute then
begin
HistoryList.Items.SaveToFile(SaveListDlg.FileName);
end;
end;
procedure TTMPMainForm.CreatePlayList1Click(Sender: TObject);
begin
if SaveListDlg.Execute then
begin
HistoryList.Items.SaveToFile(SaveListDlg.FileName);
end
else
begin
Application.MessageBox("PlayList empty, for the beginning load the list of tunes !","Stop !",MB_ICONSTOP);
end;
end;
end.
← →
Exception (2001-11-19 08:20) [2]Круто !!!
Вы думаете, кому-то будет не лень копаться во всем ЭТОМ ?
Надо задавать вопросы более конкретно. И еще: на интересный вопрос и отвечать интересно !!!
Страницы: 1 вся ветка
Форум: "Система";
Текущий архив: 2002.02.25;
Скачать: [xml.tar.bz2];
Память: 0.46 MB
Время: 0.004 c