请问一下如何在MediaPlayer控件用TrackBar实现播放进度的前进和后退???(39分)

  • 主题发起人 主题发起人 mike1031
  • 开始时间 开始时间
M

mike1031

Unregistered / Unconfirmed
GUEST, unregistred user!
谢谢拉!~~~~~~~~~~~~~~~~`只有这么多分拉!都给拉!~~~
 
procedure TForm1.Timer1Timer(Sender: TObject);
TrackBar1.Position:=MediaPlayer1.Position div 1000;
panel7.Caption:=IntTurnLen(MediaPlayer1.Position,1);

procedure TForm1.TrackBar1Change(Sender: TObject);
MediaPlayer1.Position:=TrackBar1.Position*1000;
MediaPlayer1.Play;

Play key pressed:
si1:=MediaPlayer1.Length;
si1:=si1 div 1000;
TrackBar1.Max:=si1;
TrackBar1.Min:=0;
si2:=60;
while si2<si1do
begin

TrackBar1.SetTick(si2);
si2:=si2+60;
end;

MediaPlayer1.Position:=0;
MediaPlayer1.Play;
 
楼上有没有测试,好像不行哟? ”TrackBar1Change“;

楼主:这里有TTrackBar修改组件,有MouseDown/MouseUp事件,看看能否帮上;
http://www.vclxx.org/DELPHIGB/AAAT1024.HTM#StatusBar
在MouseDown事件里停止计时器,MouseUp事件里开始计时器,和楼上的方法类似;
 
引入一个boolean;在进入 TForm1.Timer1Timer 时为真,出则置假;
在TForm1.TrackBar1Change里判断,如果是真则直接跳出.
 
请留地址我给一个文件里;
 
1、先安装下面的控件(下面是全部源码):
unit GHTrackBar;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls ,Commctrl, Consts;


type
TGHTrackBar = class(TWinControl)
private
// FOnScroll: TScrollEvent;
// ghboy+
FOnScroll:TNotifyEvent;
// ghboy+

FOrientation: TTrackBarOrientation;
FTickMarks: TTickMark;
FTickStyle: TTickStyle;
FLineSize: Integer;
FPageSize: Integer;
FThumbLength: Integer;
FSliderVisible: Boolean;
FMin: Integer;
FMax: Integer;
FFrequency: Integer;
FPosition: Integer;
FSelStart: Integer;
FSelEnd: Integer;
FOnChange: TNotifyEvent;
function GetThumbLength: Integer;
procedure SetOrientation(Value: TTrackBarOrientation);
procedure SetParams(APosition, AMin, AMax: Integer);
procedure SetPosition(Value: Integer);
procedure SetMin(Value: Integer);
procedure SetMax(Value: Integer);
procedure SetFrequency(Value: Integer);
procedure SetTickStyle(Value: TTickStyle);
procedure SetTickMarks(Value: TTickMark);
procedure SetLineSize(Value: Integer);
procedure SetPageSize(Value: Integer);
procedure SetThumbLength(Value: Integer);
procedure SetSliderVisible(Value: Boolean);
procedure SetSelStart(Value: Integer);
procedure SetSelEnd(Value: Integer);
procedure UpdateSelection;
procedure CNHScroll(var Message: TWMHScroll);
message CN_HSCROLL;
procedure CNVScroll(var Message: TWMVScroll);
message CN_VSCROLL;


// proceduredo
Scroll(var Message: TWMScroll);
//ghboy +
protected
procedure CreateParams(var Params: TCreateParams);
override;
procedure CreateWnd;
override;
procedure DestroyWnd;
override;
procedure Changed;
dynamic;

// procedure Scroll(ScrollCode: TScrollCode;
var ScrollPos: Integer);
dynamic;
public
constructor Create(AOwner: TComponent);
override;
procedure SetTick(Value: Integer);
published
property Align;
property Anchors;
property BorderWidth;
property Ctl3D;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Constraints;
property LineSize: Integer read FLineSize write SetLineSize default 1;
property Max: Integer read FMax write SetMax default 10;
property Min: Integer read FMin write SetMin default 0;
property Orientation: TTrackBarOrientation read FOrientation write SetOrientation;
property ParentCtl3D;
property ParentShowHint;
property PageSize: Integer read FPageSize write SetPageSize default 2;
property PopupMenu;
property Frequency: Integer read FFrequency write SetFrequency;
property Position: Integer read FPosition write SetPosition;
property SliderVisible: Boolean read FSliderVisible write SetSliderVisible default True;
property SelEnd: Integer read FSelEnd write SetSelend;

property SelStart: Integer read FSelStart write SetSelStart;
property ShowHint;
property TabOrder;
property TabStop default True;
property ThumbLength: Integer read GetThumbLength write SetThumbLength default 20;
property TickMarks: TTickMark read FTickMarks write SetTickMarks;
property TickStyle: TTickStyle read FTickStyle write SetTickStyle;
property Visible;
property OnContextPopup;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnStartDock;
property OnStartDrag;

// property OnScroll: TScrollEvent read FOnScroll write FOnScroll;
//ghboy+
property OnScroll: TNotifyEvent read FOnScroll write FOnScroll;
//ghboy+
end;


procedure Register;

implementation

procedure Register;
begin

RegisterComponents('LCDScreen', [TGHTrackBar]);
end;


{ TGHTrackBar }


{procedure TGHTrackBar.Scroll(ScrollCode: TScrollCode;
var ScrollPos: Integer);
begin

if Assigned(FOnScroll) then
FOnScroll(Self, ScrollCode, ScrollPos);
end;



procedure TGHTrackBar.DoScroll(var Message: TWMScroll);
var
ScrollPos: Integer;
NewPos: Longint;
ScrollInfo: TScrollInfo;
begin

showmessage('gh');
with Messagedo

begin

NewPos := FPosition;
case TScrollCode(ScrollCode) of
scLineUp:
Dec(NewPos, FSmallChange * FRTLFactor);
scLineDown:
Inc(NewPos, FSmallChange * FRTLFactor);
scPageUp:
Dec(NewPos, FLargeChange * FRTLFactor);
scPageDown:
Inc(NewPos, FLargeChange * FRTLFactor);
scPosition, scTrack:
with ScrollInfodo

begin

cbSize := SizeOf(ScrollInfo);
fMask := SIF_ALL;
GetScrollInfo(Handle, SB_CTL, ScrollInfo);
NewPos := nTrackPos;
if not NotRightToLeft then
NewPos := FMax - NewPos;
end;

scTop:
NewPos := FMin;
scBottom:
NewPos := FMax;
end;

with ScrollInfodo

begin

cbSize := SizeOf(ScrollInfo);
fMask := SIF_ALL;
GetScrollInfo(Handle, SB_CTL, ScrollInfo);
NewPos := nTrackPos;
end;


if NewPos < FMin then
NewPos := FMin;
if NewPos > FMax then
NewPos := FMax;
ScrollPos := NewPos;
Scroll(TScrollCode(ScrollCode), ScrollPos);
SetPosition(ScrollPos);
end;


end;

}

procedure TGHTrackBar.Changed;
begin

if Assigned(FOnChange) then
FOnChange(Self);
end;


procedure TGHTrackBar.CNHScroll(var Message: TWMHScroll);
begin

inherited;
FPosition := SendMessage(Handle, TBM_GETPOS, 0, 0);
// Changed;
if Assigned(FOnScroll) then
FOnScroll(Self);
Message.Result := 0;
end;


procedure TGHTrackBar.CNVScroll(var Message: TWMVScroll);
begin

inherited;
FPosition := SendMessage(Handle, TBM_GETPOS, 0, 0);
if Assigned(FOnScroll) then
FOnScroll(Self);
// Changed;
Message.Result := 0;
end;


constructor TGHTrackBar.Create(AOwner: TComponent);
begin

inherited Create(AOwner);
Width := 150;
Height := 45;
TabStop := True;
FMin := 0;
FMax := 10;
FLineSize := 1;
FPageSize := 2;
FFrequency := 1;
FThumbLength := 20;
FTickMarks := tmBottomRight;
FTickStyle := tsAuto;
FOrientation := trHorizontal;
ControlStyle := ControlStyle - [csDoubleClicks];
// ControlStyle := [csFramed, csDoubleClicks];

FSliderVisible := True;

end;


procedure TGHTrackBar.CreateParams(var Params: TCreateParams);
const
OrientationStyle: array[TTrackbarOrientation] of DWORD = (TBS_HORZ, TBS_VERT);
TickStyles: array[TTickStyle] of DWORD = (TBS_NOTICKS, TBS_AUTOTICKS, 0);
ATickMarks: array[TTickMark] of DWORD = (TBS_BOTTOM, TBS_TOP, TBS_BOTH);
begin

InitCommonControl(ICC_BAR_CLASSES);
inherited CreateParams(Params);
CreateSubClass(Params, TRACKBAR_CLASS);
// CreateSubClass(Params, 'SCROLLBAR');
with Paramsdo

begin

Style := Style or OrientationStyle[FOrientation] or
TickStyles[FTickStyle] or ATickMarks[FTickMarks] or TBS_FIXEDLENGTH or
TBS_ENABLESELRANGE;
WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW) or
CS_DBLCLKS;
if not FSliderVisible then
Style := Style or TBS_NOTHUMB;

end;

end;


procedure TGHTrackBar.CreateWnd;
begin

inherited CreateWnd;
if HandleAllocated then

begin

SendMessage(Handle, TBM_SETTHUMBLENGTH, FThumbLength, 0);
SendMessage(Handle, TBM_SETLINESIZE, 0, FLineSize);
SendMessage(Handle, TBM_SETPAGESIZE, 0, FPageSize);
SendMessage(Handle, TBM_SETRANGEMIN, 0, FMin);
SendMessage(Handle, TBM_SETRANGEMAX, 0, FMax);
UpdateSelection;
SendMessage(Handle, TBM_SETPOS, 1, FPosition);
SendMessage(Handle, TBM_SETTICFREQ, FFrequency, 1);
end;

end;


procedure TGHTrackBar.DestroyWnd;
begin

inherited DestroyWnd;
end;


function TGHTrackBar.GetThumbLength: Integer;
begin

if HandleAllocated then

Result := SendMessage(Handle, TBM_GETTHUMBLENGTH, 0, 0)
else

Result := FThumbLength;
end;


procedure TGHTrackBar.SetFrequency(Value: Integer);
begin

if Value <> FFrequency then

begin

FFrequency := Value;
if HandleAllocated then

SendMessage(Handle, TBM_SETTICFREQ, FFrequency, 1);
end;

end;


procedure TGHTrackBar.SetLineSize(Value: Integer);
begin

if Value <> FLineSize then

begin

FLineSize := Value;
if HandleAllocated then

SendMessage(Handle, TBM_SETLINESIZE, 0, FLineSize);
end;

end;


procedure TGHTrackBar.SetMax(Value: Integer);
begin

if Value >= FMin then

SetParams(FPosition, FMin, Value);
end;


procedure TGHTrackBar.SetMin(Value: Integer);
begin

if Value <= FMax then

SetParams(FPosition, Value, FMax);
end;


procedure TGHTrackBar.SetOrientation(Value: TTrackBarOrientation);
begin

if Value <> FOrientation then

begin

FOrientation := Value;
if ComponentState * [csLoading, csUpdating] = [] then

SetBounds(Left, Top, Height, Width);
RecreateWnd;
end;

end;


procedure TGHTrackBar.SetPageSize(Value: Integer);
begin

if Value <> FPageSize then

begin

FPageSize := Value;
if HandleAllocated then

SendMessage(Handle, TBM_SETPAGESIZE, 0, FPageSize);
end;

end;


procedure TGHTrackBar.SetParams(APosition, AMin, AMax: Integer);
begin

if AMax < AMin then

raise EInvalidOperation.CreateFmt(SPropertyOutOfRange, [Self.Classname]);
if APosition < AMin then
APosition := AMin;
if APosition > AMax then
APosition := AMax;
if (FMin <> AMin) then

begin

FMin := AMin;
if HandleAllocated then

SendMessage(Handle, TBM_SETRANGEMIN, 1, AMin);
end;

if (FMax <> AMax) then

begin

FMax := AMax;
if HandleAllocated then

SendMessage(Handle, TBM_SETRANGEMAX, 1, AMax);
end;

if FPosition <> APosition then

begin

FPosition := APosition;
if HandleAllocated then

SendMessage(Handle, TBM_SETPOS, 1, APosition);
Changed;
end;

end;


procedure TGHTrackBar.SetPosition(Value: Integer);
begin

SetParams(Value, FMin, FMax);
end;


procedure TGHTrackBar.SetSelEnd(Value: Integer);
begin

if Value <> FSelEnd then

begin

FSelEnd := Value;
UpdateSelection;
end;

end;


procedure TGHTrackBar.SetSelStart(Value: Integer);
begin

if Value <> FSelStart then

begin

FSelStart := Value;
UpdateSelection;
end;

end;


procedure TGHTrackBar.SetSliderVisible(Value: Boolean);
begin

if FSliderVisible <> Value then

begin

FSliderVisible := Value;
RecreateWnd;
end;

end;


procedure TGHTrackBar.SetThumbLength(Value: Integer);
begin

if Value <> FThumbLength then

begin

FThumbLength := Value;
if HandleAllocated then

SendMessage(Handle, TBM_SETTHUMBLENGTH, Value, 0);
end;

end;


procedure TGHTrackBar.SetTick(Value: Integer);
begin

if HandleAllocated then

SendMessage(Handle, TBM_SETTIC, 0, Value);
end;


procedure TGHTrackBar.SetTickMarks(Value: TTickMark);
begin

if Value <> FTickMarks then

begin

FTickMarks := Value;
RecreateWnd;
end;

end;


procedure TGHTrackBar.SetTickStyle(Value: TTickStyle);
begin

if Value <> FTickStyle then

begin

FTickStyle := Value;
RecreateWnd;
end;

end;


procedure TGHTrackBar.UpdateSelection;
begin

if HandleAllocated then

begin

if (FSelStart = 0) and (FSelEnd = 0) then

SendMessage(Handle, TBM_CLEARSEL, 1, 0)
else

SendMessage(Handle, TBM_SETSEL, Integer(True), MakeLong(FSelStart, FSelEnd));
end;

end;


end.


2、在看下面的例子
unit Avi_pas;

interface

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

type
TForm1 = class(TForm)
Panel1: TPanel;
Animate1: TAnimate;
Panel2: TPanel;
MediaPlayer1: TMediaPlayer;
Button1: TButton;
OpenDialog1: TOpenDialog;
GHTrackBar1: TGHTrackBar;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
procedure Panel1Resize(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure GHTrackBar1Scroll(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;


var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin

Timer1.Enabled:=false;

Mediaplayer1.Close ;
if Opendialog1.Execute then

begin

Mediaplayer1.FileName := Opendialog1.FileName ;
Mediaplayer1.Open ;
Mediaplayer1.Display := Animate1;
Mediaplayer1.DisplayRect := panel1.ClientRect ;
Timer1.Enabled:=true;
GHTrackBar1.Max:=Mediaplayer1.Length;
end;

end;


procedure TForm1.Panel1Resize(Sender: TObject);
begin

Mediaplayer1.DisplayRect := panel1.ClientRect ;
end;


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

Mediaplayer1.Close ;
end;


procedure TForm1.GHTrackBar1Scroll(Sender: TObject);
begin

Mediaplayer1.Position:=GHTrackBar1.Position;
Mediaplayer1.Play;
end;


procedure TForm1.Timer1Timer(Sender: TObject);
begin

GHTrackBar1.Position :=Mediaplayer1.Position ;
end;


end.



 
http://delphibbs.com/delphibbs/dispq.asp?lid=860997
 
楼上的你的连接打不开啊????????????
 
你在论坛里搜索一下,我以前也遇到这种问题,只要在控件里加两句MouseDown/MouseUp就可以了
 
后退
顶部