SHARE
TWEET

seberm

seberm Mar 30th, 2009 18 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. //////////////////////////////////////////////////////
  2. //**************************************************//
  3. //****************Copyright(c)2007******************//
  4. //**********Borland Developer Studio 2006***********//
  5. //******************Otto �abart*********************//
  6. //*******************FreeWare***********************//
  7. //**************************************************//
  8. //////////////////////////////////////////////////////
  9.  
  10. unit saplayer_system;
  11.  
  12. interface
  13.  
  14. uses
  15.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  16.   Dialogs, StdCtrls, ExtCtrls, MPlayer, ComCtrls, Gauges, ShellAPI, IniFiles,
  17.   Menus, MMSystem, Buttons;
  18.   //...Ru�n� p�idat: ShellAPI, IniFiles, MPlayer
  19.  
  20. type
  21.   TForm1 = class(TForm)
  22.     OpenDialog1: TOpenDialog;
  23.     Timer1: TTimer;
  24.     CheckBox1: TCheckBox;
  25.     TrayIcon1: TTrayIcon;
  26.     PopupMenu1: TPopupMenu;
  27.     Zobrazitpehrva1: TMenuItem;
  28.     Exit1: TMenuItem;
  29.     StaticText1: TStaticText;
  30.     Timer2: TTimer;
  31.     ScrollBar1: TScrollBar;
  32.     ProgressBar1: TProgressBar;
  33.     Label2: TLabel;
  34.     Label3: TLabel;
  35.     BitBtn2: TBitBtn;
  36.     BitBtn3: TBitBtn;
  37.     BitBtn4: TBitBtn;
  38.     BitBtn5: TBitBtn;
  39.     Button1: TButton;
  40.     PopupMenu2: TPopupMenu;
  41.     Pehrt1: TMenuItem;
  42.     Pozastavit1: TMenuItem;
  43.     Zastavit1: TMenuItem;
  44.     Otevt1: TMenuItem;
  45.     N1: TMenuItem;
  46.     Panel1: TPanel;
  47.     Timer3: TTimer;
  48.     Label1: TLabel;
  49.     Bevel1: TBevel;
  50.     procedure Timer3Timer(Sender: TObject);
  51.     procedure N1Click(Sender: TObject);
  52.     procedure Otevt1Click(Sender: TObject);
  53.     procedure Zastavit1Click(Sender: TObject);
  54.     procedure Pozastavit1Click(Sender: TObject);
  55.     procedure Pehrt1Click(Sender: TObject);
  56.     procedure Button1Click(Sender: TObject);
  57.     procedure BitBtn5Click(Sender: TObject);
  58.     procedure BitBtn4Click(Sender: TObject);
  59.     procedure BitBtn2Click(Sender: TObject);
  60.     procedure BitBtn3Click(Sender: TObject);
  61.     procedure Label2Click(Sender: TObject);
  62.     procedure ProgressBar1MouseMove(Sender: TObject; Shift: TShiftState; X,
  63.       Y: Integer);
  64.     procedure ProgressBar1MouseDown(Sender: TObject; Button: TMouseButton;
  65.       Shift: TShiftState; X, Y: Integer);
  66.     procedure ScrollBar1Change(Sender: TObject);
  67.     procedure Timer2Timer(Sender: TObject);
  68.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  69.     procedure FormCreate(Sender: TObject);
  70.     procedure Exit1Click(Sender: TObject);
  71.     procedure Zobrazitpehrva1Click(Sender: TObject);
  72.     procedure TrayIcon1Click(Sender: TObject);
  73.     procedure Timer1Timer(Sender: TObject);
  74.     function SetWaveVolume(volume: DWord): Dword;
  75.     function SetMidiVolume(volume: DWord): Dword;
  76.     procedure WMSysCommand(var Msg: TWMSysCommand);
  77.     message WM_SYSCOMMAND;
  78.    
  79.   private
  80.     { Private declarations }
  81.   public
  82.     { Public declarations }
  83.   end;
  84.  
  85. var
  86.   Form1: TForm1;
  87.   times: String;
  88.   MediaPlayer1: TMediaPlayer;
  89.  
  90. implementation
  91.   uses about_system;
  92.  
  93. {$R *.dfm}
  94.  
  95. procedure TForm1.FormCreate(Sender: TObject);
  96. var
  97.   Ini: TIniFile;
  98. begin
  99.   MediaPlayer1:= TMediaPlayer.Create(Form1); //...Vytvo�� komponentu TMediaPlayer
  100.   MediaPlayer1.Parent:= Form1; //...Bude um�st�n� na komponent� Form1
  101.   MediaPlayer1.Visible:= False; //...A nebude vid�t
  102.  
  103.   if ParamCount = 1 then  //...Jestli p�ehr�va� najde parametr, vlo�� ho jako FileName p�ehr�va�i a za�ne p�ehr�vat
  104.     begin
  105.       MediaPlayer1.FileName:= (ParamStr(1));
  106.       MediaPlayer1.Open;
  107.       BitBtn3.Click;
  108.       Label1.Caption:= ExtractFileName((ParamStr(1)));
  109.  
  110.       if Length(ExtractFileName((ParamStr(1)))) > 38 then
  111.         begin
  112.           Label1.Left:= Panel1.Width;
  113.           Timer3.Enabled:= True;
  114.         end else
  115.         begin
  116.           Label1.Left:= 0;
  117.           Timer3.Enabled:= False;
  118.         end;
  119.     end;
  120.  
  121.   Ini:= TIniFile.Create(ChangeFileExt(Application.ExeName,'_options.INI')); //...Pokud u� byl vytvo�en .INI soub., p�e�te z n�j hodnoty a na�te je do p�ehr�va�e
  122.   try
  123.     Form1.Top:= Ini.ReadInteger('Form1', 'Top', 76); //...P�e�te hodnoty Form1
  124.     Form1.Left:= Ini.ReadInteger('Form1', 'Left', 395);
  125.     CheckBox1.Checked:= Ini.ReadBool('CheckBox1', 'Checked', True); //...A taky hodnotu CheckBoxu1
  126.     ScrollBar1.Position:= Ini.ReadInteger('ScrollBar1', 'Position', 255) //...A ScrollBaru1
  127.   finally
  128.     Ini.Free; //...Uvoln� .INI soub. z pam�ti
  129.   end;
  130. end;
  131.  
  132. procedure TForm1.BitBtn2Click(Sender: TObject);
  133. begin
  134.   MediaPlayer1.Pause; //...Pauzne p�ehr�va�
  135.   BitBtn3.Enabled:= True;  //...Aktivuje tla��tko play
  136.   Label3.Caption:= 'Pozastaveno'; //...D� v�d�t �e je zapauzov�no
  137.   PopupMenu2.Items[0].Enabled:= True;
  138.  
  139.   if Label3.Font.Color = clRed then //...Label3 ozna�� barvou, aby to u�ivatel l�pe poznal
  140.     begin
  141.       Label3.Font.Color:= clNavy;
  142.       Label3.Caption:= 'P�ehr�v�n�';
  143.     end else
  144.       Label3.Font.Color:= clRed;
  145. end;
  146.  
  147. procedure TForm1.BitBtn3Click(Sender: TObject);
  148. begin
  149.   MediaPlayer1.Play; //...P�ehr�va� za�ne p�ehr�vat
  150.   BitBtn2.Enabled:= True; //...Deaktivuje tla��tko stop
  151.   BitBtn4.Enabled:= True; //...A tak� tla��tko pause
  152.   PopupMenu2.Items[0].Enabled:= False;
  153.   PopupMenu2.Items[1].Enabled:= True;
  154.   PopupMenu2.Items[2].Enabled:= True;
  155.   Timer1.Enabled:= True; //...Zapne timer (for ProgressBar1)
  156.   Timer2.Enabled:= True; //...Zapne timer (ukazov�n� stavu p�sni�ky v minut�ch)
  157.   ProgressBar1.Min:= 0; //...Nastav� minim�ln� hodnotu ProgressBaru na 0
  158.   ProgressBar1.Max:= MediaPlayer1.Length; //...Maxim�ln� hodnota ProgressBaru = D�lce p�ehr�van� souboru v MediaPlayeru
  159.   ProgressBar1.Position:= MediaPlayer1.Position;  //...Pozice ProgressBaru = pozici MediaPlayeru
  160.   Label3.Caption:= 'P�ehr�v�n�';
  161.  
  162.   if Label3.Font.Color = clRed then //...Jestli je barva Label3 �erven�, zm�n� ji na �ernou
  163.     Label3.Font.Color:= clBlack;
  164. end;
  165.  
  166. procedure TForm1.BitBtn4Click(Sender: TObject);
  167. begin
  168.   Application.ProcessMessages;
  169.   MediaPlayer1.Stop; //...Zastav� p�ehr�va�
  170.   MediaPlayer1.Position:= 0; //...Nastav� pozici p�ehr�va�e na 0
  171.   MediaPlayer1.Close; //...Zav�e p�ehr�va�
  172.   BitBtn2.Enabled:= False; //...Deaktivace tla��tek: BitBtn2
  173.   BitBtn3.Enabled:= False; //...BitBtn3
  174.   BitBtn4.Enabled:= False; //...BitBtn4
  175.   PopupMenu2.Items[0].Enabled:= False;
  176.   PopupMenu2.Items[1].Enabled:= False;
  177.   PopupMenu2.Items[2].Enabled:= False;
  178.   Timer1.Enabled:= False; //...Zastav� timer
  179.   Timer2.Enabled:= False; //...Zastav� druh� timer
  180.   StaticText1.Caption:= '00:00'; //...Vynuluje se StaticText1
  181.   ProgressBar1.Position:= 0; //...Pozice ProgressBaru se nastav� na 0
  182.   Label1.Caption:= '��dn� soubor nen� na�ten';
  183.   Label3.Caption:= 'Zastaveno'; //...D� u�ivateli v�d�t �e je p�ehr�va� zastaven
  184.  
  185.   if Label3.Font.Color = clRed then //...Jestli je barva Label3 �erven�, zm�n� ji na �ernou
  186.     Label3.Font.Color:= clBlack;
  187.  
  188.   if Length(ExtractFileName(OpenDialog1.Filename)) > 38 then
  189.     begin
  190.       Label1.Left:= Panel1.Width;
  191.       Timer3.Enabled:= True;
  192.     end else
  193.     begin
  194.       Label1.Left:= 0;
  195.       Timer3.Enabled:= False;
  196.   end;
  197. end;
  198.  
  199. procedure TForm1.BitBtn5Click(Sender: TObject);
  200. begin
  201.   if OpenDialog1.Execute then //...Otev�e Dialog
  202.     begin
  203.       Application.ProcessMessages;
  204.       MediaPlayer1.FileName:= OpenDialog1.FileName;
  205.       if not FileExists(OpenDialog1.FileName) then
  206.         begin
  207.           ShowMessage('MP3 file '+#13#10+ OpenDialog1.FileName +#13#10+'does not exist!');
  208.           Exit;
  209.         end;
  210.       MediaPlayer1.Open;  //...Otev�e p�ehr�va�
  211.       BitBtn3.Click; //...Aktivuje proceduru tla��tka BitBtn3, a t�m p�dem za�ne p�ehr�vat
  212.       Label1.Caption:= ExtractFileName(MediaPlayer1.FileName); //...Do label1 nap��e n�zev p�sni�ky
  213.     end;
  214.  
  215.   if Length(ExtractFileName(OpenDialog1.Filename)) > 38 then
  216.     begin
  217.       Label1.Left:= Panel1.Width;
  218.       Timer3.Enabled:= True;
  219.     end else
  220.     begin
  221.       Label1.Left:= 0;
  222.       Timer3.Enabled:= False;
  223.     end;
  224. end;
  225.  
  226. procedure TForm1.Button1Click(Sender: TObject);
  227. begin
  228.   if Form2.Visible = False then //...Pokud je Form2 neviditeln�, nastav� mu viditelnost na True
  229.     Form2.Visible:= True
  230.   else
  231.     Form2.Visible:= False; //...Jestli vid�t je, shov� ho
  232. end;
  233.  
  234. procedure TForm1.Exit1Click(Sender: TObject);
  235. begin
  236.   Application.Terminate; //...Aplikace se ukon��
  237. end;
  238.  
  239. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  240. var
  241.   Ini: TIniFile;
  242. begin
  243.   MediaPlayer1.Free; //...Uvoln� p�ehr�va� z pam�ti
  244.  
  245.   Ini:= TIniFile.Create(ChangeFileExt(Application.ExeName,'_options.INI'));  //...Vytvo�� .INI soub. (nebo p�ep��e star�)
  246.   try
  247.     Ini.WriteInteger('Form1', 'Top', Form1.Top); //...Zap��e hodnoty komponent
  248.     Ini.WriteInteger('Form1', 'Left', Form1.Left);
  249.     Ini.WriteBool('CheckBox1', 'Checked', CheckBox1.Checked);
  250.     Ini.WriteInteger('ScrollBar1', 'Position', ScrollBar1.Position);
  251.   finally
  252.     Ini.Free; //...Uvoln� .INI soub. z pam�ti
  253.   end;
  254. end;
  255.  
  256. procedure TForm1.Label2Click(Sender: TObject);
  257. var
  258.   MyWin: array[0..255] of Char;
  259. const
  260.   Size: Integer = MAX_PATH;
  261. begin
  262.         GetWindowsDirectory(MyWin, Size);  //...Cesta do C:\WINDOWS\system32
  263.   ShellExecute(Form1.Handle, 'open', 'sndvol32.exe', nil, MyWin, SW_SHOWNORMAL); //...Otev�e v adres��i C:\WINDOWS\system32 soubor s n�zvem sndvol32.exe (Nastaven� zvuku ve Win)
  264. end;
  265.  
  266. procedure TForm1.N1Click(Sender: TObject);
  267. begin
  268.   Button1.Click;
  269. end;
  270.  
  271. procedure TForm1.Otevt1Click(Sender: TObject);
  272. begin
  273.   BitBtn5.Click;
  274. end;
  275.  
  276. procedure TForm1.Pehrt1Click(Sender: TObject);
  277. begin
  278.   BitBtn3.Click;
  279. end;
  280.  
  281. procedure TForm1.Pozastavit1Click(Sender: TObject);
  282. begin
  283.   BitBtn2.Click;
  284. end;
  285.  
  286. procedure TForm1.ProgressBar1MouseDown(Sender: TObject; Button: TMouseButton;
  287.   Shift: TShiftState; X, Y: Integer);
  288. var
  289.   f: String;
  290. begin
  291. try
  292.  if Button = mbLeft then //...Odchycen� stisknut� lev�ho tla��tka
  293.   begin
  294.     f:= FloatToStr(Int(((MediaPlayer1.Length / (Form1.Width - ProgressBar1.Left - 15) * x)))); //...Vyhodnot�me pozici ProgressBaru
  295.     ProgressBar1.Position:= StrToInt(f); //...Nastav� ProgressBar na pozici kliku
  296.     MediaPlayer1.Position:= StrToInt(f); //...Nastav� P�ehr�va� na vyhodnocenou pozici kliknut�
  297.     MediaPlayer1.Play;
  298.     Label3.Font.Color:= clNavy;
  299.     Label3.Caption:= 'P�ehr�v�n�';
  300.   end;
  301. except
  302.   Exit;
  303. end;
  304. end;
  305.  
  306. procedure TForm1.ProgressBar1MouseMove(Sender: TObject; Shift: TShiftState; X,
  307.   Y: Integer);
  308. var
  309.   r: Real;
  310. begin
  311.   r:= Int(ProgressBar1.Position / ProgressBar1.Max * 100); //...Vyhodnot�me pozici aktu�ln�ho p�ehr�v�n� a p�evedeme na procenta
  312.   ProgressBar1.Hint:= 'Step: ' + FloatToStr(r) + '%'; //...A procenta zobraz�me v popisce
  313. end;
  314.  
  315. procedure TForm1.ScrollBar1Change(Sender: TObject);
  316. var
  317.   f: Real;
  318. begin
  319.   SetWaveVolume(ScrollBar1.Position); //...Nastaven� hlasitosti
  320.   SetMidiVolume(ScrollBar1.Position);
  321.   f:= Int(ScrollBar1.Position / ScrollBar1.Max * 100);
  322.   Label2.Caption:= 'Hlasitost: ' + FloatToStr(f) + '%'; //...Nap��eme hlasitost do Label, aby o n� byl u�ivatel informov�n
  323. end;
  324.  
  325. procedure TForm1.Timer1Timer(Sender: TObject);
  326. begin
  327.   ProgressBar1.Position:= MediaPlayer1.Position; //...Ka�d�ch 0,1s aktualizuje ProgressBar
  328.  
  329.   if MediaPlayer1.Position = MediaPlayer1.Length then
  330.     begin
  331.       if CheckBox1.Checked = true then //...Pokud je zatrhnuto "opakovat"
  332.         begin
  333.           BitBtn3.Click; //...Za�ne se opakovat procedura tla��tka play a t�m tedy i p�ehr�v�n�
  334.         end else
  335.         begin
  336.           MediaPlayer1.Stop; //...Jinak stopne p�ehr�va�
  337.           BitBtn3.Enabled:= True; //...Deaktivuje tla��tka...
  338.           BitBtn2.Enabled:= False;
  339.           BitBtn4.Enabled:= False;
  340.         end;
  341.     end;
  342. end;
  343.  
  344. procedure TForm1.Timer2Timer(Sender: TObject);
  345. var
  346.   x, t: Integer;
  347.   min, sec: Integer;
  348.   s1, s2, result: String;
  349. begin
  350.  
  351. if times = '' then  //...Ukazuje ve statictext na kolik�t� minut� u� hraje p�sni�ka
  352.   begin
  353.     t:= MediaPlayer1.Position; //...Vyhodnocen� pozice p�ehr�va�e a p�eveden� na minuty a sekundy
  354.     sec:= t div 1000;
  355.     min:= sec div 60;
  356.     sec:= (sec - min * 60);
  357.  
  358.     if min > 9 then
  359.       s1:= IntToStr(min)
  360.     else
  361.       s1:= '0' + IntToStr(min);
  362.  
  363.     if sec > 9 then
  364.       s2 := IntToStr(sec)
  365.     else
  366.       s2:= '0' + IntToStr(sec);
  367.       result:= s1 + ':' + s2;
  368.       StaticText1.Caption:= result; //...Zobraz� v�sledek
  369.     end
  370.     else
  371.     begin
  372.       try
  373.         t:= MediaPlayer1.Length - MediaPlayer1.Position;
  374.         sec:= t div 1000;
  375.         min:= sec div 60;
  376.         sec:= (sec - min * 60);
  377.         if min > 9 then
  378.           s1:= IntToStr(min)
  379.         else
  380.           s1:= '0' + IntToStr(min);
  381.           if sec >9 then
  382.             s2:= IntToStr(sec)
  383.           else
  384.             s2:= '0' + IntToStr(sec);
  385.             result:= s1 + ':' + s2;
  386.             StaticText1.Caption:= result;
  387.       except
  388.     end;
  389.   end;
  390. end;
  391.  
  392. procedure TForm1.Timer3Timer(Sender: TObject);
  393. begin
  394.   Label1.Left:= Label1.Left - 1; //...O kolik pixel� se label posune
  395.  
  396.   if Label1.Left < -Label1.Width  then
  397.     Label1.left:= Panel1.Width;
  398. end;
  399.  
  400. procedure TForm1.TrayIcon1Click(Sender: TObject);
  401. begin
  402.   Form1.Show; //...Zobraz&#65533; Form1
  403.   TrayIcon1.Visible:= False; //...Nastav&#65533; ikonce neviditelnost
  404. end;
  405.  
  406. procedure TForm1.Zastavit1Click(Sender: TObject);
  407. begin
  408.   BitBtn4.Click;
  409. end;
  410.  
  411. procedure TForm1.Zobrazitpehrva1Click(Sender: TObject);
  412. begin
  413.   Form1.Show;
  414. end;
  415. ///////////////////////////////////////////////////////////////////////////////////////////////////////////////
  416. function TForm1.SetWaveVolume(volume: DWord): Dword; //...Funkce pro nastaven&#65533; Wawe hlasitosti              //
  417. var                                                                                                        //
  418.   vol: Integer;                                                                                           //
  419.   MyWaveOutCaps: TWaveOutCaps;                                                                           //
  420. begin                                                                                                   //
  421.   vol:=(volume)*65537*257;                                                                             //
  422.     if WaveOutGetDevCaps(WAVE_MAPPER,@MyWaveOutCaps,sizeof(MyWaveOutCaps))=MMSYSERR_NOERROR then      //
  423.       begin                                                                                          //
  424.         WaveOutSetVolume(WAVE_MAPPER, MakeLong(vol, vol));                                          //
  425.       end;                                                                                         //
  426. end;                                                                                              //
  427. ///////////////////////////////////////////////////////////////////////////////////////////////////
  428.  
  429. ///////////////////////////////////////////////////////////////////////////////////////////////////////////////
  430. function TForm1.SetMidiVolume(volume: DWord): Dword; //...Funkce pro nastaven&#65533; Midi hlasitosti              //
  431. var                                                                                                        //
  432.   vol: Integer;                                                                                           //
  433.   MyMidiOutCaps: TMidiOutCaps;                                                                           //
  434. begin                                                                                                   //
  435.   vol:= (volume)*65537*257;                                                                            //
  436.     if MidiOutGetDevCaps(MIDI_MAPPER,@MyMidiOutCaps,sizeof(MyMidiOutCaps))=MMSYSERR_NOERROR then      //
  437.       begin                                                                                          //
  438.         MidiOutSetVolume(Midi_MAPPER, MakeLong(vol, vol));                                          //
  439.       end;                                                                                         //
  440. end;                                                                                              //
  441. ///////////////////////////////////////////////////////////////////////////////////////////////////
  442.  
  443. procedure TForm1.WMSysCommand; //...Procedura pro odchycen&#65533; minimalizov&#65533;n&#65533; okna
  444. begin
  445.   if (Msg.CmdType = SC_MINIMIZE) then //...Jestli u&#65533;ivatel kliknul na tla&#65533;&#65533;tko M&#65533;nimalizovat
  446.     begin
  447.       Form1.Hide; //...Formul&#65533;&#65533; se schov&#65533;
  448.       TrayIcon1.Visible:= True; //...Zobraz&#65533; se v tray ikonka
  449.       Form2.Visible:= False; //...A pokud byl zobrazen Form2 zapne neviditelnost Formu2
  450.     end
  451.   else
  452.     inherited;
  453.   end;
  454.  
  455. end.
RAW Paste Data
Challenge yourself this year...
Learn something new in 2017
Top