Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Система";
Текущий архив: 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
6-79407
Дима
2001-12-06 14:39
2002.02.25
Получение IP адресов и имён соответствующих компьютеров


1-79376
Batiskaf
2002-02-07 13:52
2002.02.25
Form Designer without Delphi


1-79328
IronHawk
2002-02-07 11:03
2002.02.25
Приветствую Мастеров ! Запамятовал, КАК В PageControl ПОМЕНЯТЬ МЕСТАМИ TabSheet-ы ???


7-79484
MJH
2001-11-13 16:49
2002.02.25
AverTV - TV + пульт ДУ


1-79399
Aleksey_K
2002-02-08 12:14
2002.02.25
Пароль





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский