Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2008.05.18;
Скачать: [xml.tar.bz2];

Вниз

Полоса пкрутки   Найти похожие ветки 

 
DRAF   (2008-02-17 10:05) [0]

Как сделать полосу пркрутки из scrollbar во время проигрывания видео MediaPlyer"ом (подобно в windows media player)


 
SSSS   (2008-04-20 01:07) [1]

Вот посмотри пример

unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   MediaPlayer1: TMediaPlayer;
   Button1: TButton;
   Button2: TButton;
   Button3: TButton;
   Button4: TButton;
   OpenDialog1: TOpenDialog;
   Timer1: TTimer;
   ScrollBar1: TScrollBar;
   Label1: TLabel;
   Label2: TLabel;
   ListView1: TListView;
   Button5: TButton;
   DriveComboBox1: TDriveComboBox;
   Label3: TLabel;
   Panel1: TPanel;
   Label4: TLabel;
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
   procedure Button3Click(Sender: TObject);
   procedure Button4Click(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure FormClose(Sender: TObject; var Action: TCloseAction);
   procedure Button6Click(Sender: TObject);
   procedure Timer1Timer(Sender: TObject);
   procedure ScrollBar1Scroll(Sender: TObject; ScrollCode: TScrollCode;
     var ScrollPos: Integer);
   procedure Button5Click(Sender: TObject);
   procedure ListView1Click(Sender: TObject);
   procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
   procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
   procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
     Y: Integer);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}
var
  Pusk : boolean;
  catalog : string;
  cl : boolean;

Procedure Play;
Begin
//   g:=Form1.MediaPlayer1.FileName;
End;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute=true then
  Begin
     MediaPlayer1.FileName:=OpenDialog1.FileName;
     MediaPlayer1.Open;
     pusk:=true;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  MediaPlayer1.Play;
  ScrollBar1.Max:=MediaPlayer1.Length;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  MediaPlayer1.Pause;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  MediaPlayer1.Stop;
  MediaPlayer1.Position:=0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Label1.Caption:="Длина трека:  ";
  Label2.Caption:="Время звучания:  ";
  OpenDialog1.Filter:="*.mp3";
  MediaPlayer1.Visible:=False;
  Pusk:=False;

  ListView1.Columns[0].Caption:="Name";
  ListView1.Columns[0].Width:=200;
  ListView1.ViewStyle:=vsReport;
  cl:=false;
end;

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

procedure TForm1.Button6Click(Sender: TObject);
begin
  MediaPlayer1.Save;
end;

function srd(im:integer):string;
var a,b,c:integer;
   s:string;
begin
  s:="";
  c:=im div 100;
  im:=im div 1000;
  // c:=c-im*10;
  b:=im div 60;
  if b<10 then s:=s+"0";
  s:=s+inttostr(b)+":";
  a:=im-b*60;
  if a<10 then s:=s+"0";
  s:=s+IntToStr(a);
  {+":"}
 // s:=s+IntToStr(c);
  srd:=s;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if pusk then
  Begin
     Label1.Caption:="Длина трека:  "+srd(MediaPlayer1.Length);
     Label2.Caption:="Время: "+srd(MediaPlayer1.Position);
     ScrollBar1.Position:=Mediaplayer1.Position;
  End;
end;

procedure TForm1.ScrollBar1Scroll(Sender: TObject; ScrollCode: TScrollCode;
 var ScrollPos: Integer);
begin
  MediaPlayer1.Position:=ScrollBar1.Position;
  MediaPlayer1.Play;
end;

Procedure actiw(patch : string);
var
  f      : tSearchRec;
  //patch  : String;
begin
  // patch:="";

  if FindFirst(patch+"*.mp3", faHidden+faSysFile, F)=0 then
  Begin
      Form1.ListView1.Items.Add.Caption:=f.Name;
      While FindNext(f)=0 do
      begin
         Form1.ListView1.Items.Add.Caption:=f.Name;
      end;
  End;
  FindClose(F);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  if opendialog1.Execute then
  begin
     Actiw(OpenDialog1.InitialDir);
     catalog:=OpenDialog1.InitialDir;
  end;
end;

procedure TForm1.ListView1Click(Sender: TObject);
var
  g : string;
begin
  if ListView1.SelCount>0 then
  begin
     g:=ListView1.Items.Item[ListView1.Selected.Index].Caption;
     Label3.Caption:="Трек: "+g;
     // ShowMessage(g);
     g:= catalog + g;
     MediaPlayer1.FileName:=g;
     MediaPlayer1.Open;
     ScrollBar1.Max:=MediaPlayer1.Length;
     MediaPlayer1.Play;
     pusk:=true;
  end;
end;

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
  cl :=true;
  label4.Caption:= IntToStr(X);
end;

procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
  cl:=false;
end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
begin
  if cl then
  begin
     label4.Caption:= IntToStr(X);
  end;
end;

end.


 
brother ©   (2008-04-21 07:45) [2]

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 if pusk then
 Begin
    Label1.Caption:="Длина трека:  "+srd(MediaPlayer1.Length);
    Label2.Caption:="Время: "+srd(MediaPlayer1.Position);
    ScrollBar1.Position:=Mediaplayer1.Position;
 End;
end;

и

 MediaPlayer1.Position:=ScrollBar1.Position;
 MediaPlayer1.Play;

смущают... не пробовал, но работает???



Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2008.05.18;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.46 MB
Время: 0.038 c
11-1189173120
MTsv DN
2007-09-07 17:52
2008.05.18
Вопрос по прозрачности, вероятно автору - homm у...


2-1208350222
Апостля
2008-04-16 16:50
2008.05.18
буфер. ричедит.


15-1206905643
Поп Гапон
2008-03-30 23:34
2008.05.18
Как вы думаете, IT-шникам сейчас как в материальном плане?


2-1208345263
Fasco
2008-04-16 15:27
2008.05.18
помогите ...............


15-1207461552
@!!ex
2008-04-06 09:59
2008.05.18
IDE для FPC с нормальным дебагером





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский