Текущий архив: 2004.04.25;
Скачать: CL | DM;

Вниз

Добавление событий компаненту   Найти похожие ветки 

← →
Kalista   (2004-04-11 17:43) [0]

Вот код компанента.
Необходимо дабавить OnMouseDown.

Unit Mpl;

interface

uses
 Windows, Messages, SysUtils, Classes, Controls, ExtCtrls, Forms, MPlayer;

type RECT = record
X,Y,X1,Y1:Integer;
End;

type
 TMpl = class(TWinControl)
 private
   RView:RECT;
   View:THandle;
   FNotify:TNotifyEvent;
   FVolume:Integer;
   Function GetLength:Integer;
   Constructor Create(AOwner: TComponent); override;
   Destructor Destroy; override;
   procedure MMNotify(var Message: TMessage); message WM_USER + 201;
   Function GetVolume:Integer;
   Procedure SetVolume(Volume:Integer);
 protected
   { Protected declarations }
 public
   Length:Integer;
   Procedure Open(S:String);
   Procedure Play;
   Procedure Stop;
   Procedure ReSet;
   Procedure Seek(Pos:Integer);
   Function Position:Integer;
 published
   property OnNotify:TNotifyEvent read FNotify write FNotify;
   property Volume:Integer Read GetVolume Write SetVolume;
 end;

procedure Register;

function _MyMCIWndPut(Whom:HWND; Rect:LongInt):LongInt; cdecl; external "pmstrone.dll";
function _MyMCIWndCreate(hwndParent:HWND;hInstance:HWND;
   dwStyle:DWORD; szFile:LPSTR):HWND; cdecl; external "pmstrone.dll";
function _MyMCIWndClose(Whom:HWND):LongInt; cdecl; external "pmstrone.dll";
function _MyMCIWndPutDest(Whom:HWND; Rect:LongInt):LongInt; cdecl; external "pmstrone.dll";
function _MyMCIWndOpen(Whom:HWND; fname:LPSTR; Flags:LongInt):LongInt; cdecl; external "pmstrone.dll";
function _MyMCIWndPlay(Whom:HWND):LongInt; cdecl; external "pmstrone.dll";
function _MyMCIWndStop(Whom:HWND):LongInt; cdecl; external "pmstrone.dll";
function _MyMCIWndSeek(Whom:HWND; Pos:LongInt):LongInt; cdecl; external "pmstrone.dll";
function _MyMCIWndGetLength(Whom:HWND):LongInt; cdecl; external "pmstrone.dll";
function _MyMCIWndGetPosition(Whom:HWND):LongInt; cdecl; external "pmstrone.dll";
function _MyMCIWndPutSource(Whom:HWND; Rect:LongInt):LongInt; cdecl; external "pmstrone.dll";
function _MyMCIWndGetVolume(Whom:HWND):LongInt; cdecl; external "pmstrone.dll";
function _MyMCIWndGetSource(Whom:HWND; Rect:LongInt):LongInt; cdecl; external "pmstrone.dll";
function _MyMCIWndSetVolume(Whom:HWND; Vol:LongInt):LongInt; cdecl; external "pmstrone.dll";

implementation

procedure TMpl.MMNotify(var Message: TMessage);
Begin
   If(Assigned(FNotify)) Then FNotify(Self);
End;

Constructor TMpl.Create(AOwner: TComponent);
Begin
   inherited Create(AOwner);
   View:=_MyMCIWndCreate(Handle,0,$1F0E,"");
   RView.X:=0;
   RView.Y:=0;
   RView.X1:=Width;
   RView.Y1:=Height;
   Volume:=50;
   _MyMCIWndPutSource(View, LongInt(@RView));
   _MyMCIWndPutDest(View, LongInt(@RView));
End;

Destructor TMpl.Destroy;
Begin
   _MyMCIWndClose(View);
   inherited Destroy;
End;

Procedure TMpl.Open(S:String);
Var I:LongInt;
Begin
RView.X:=0;
RView.X1:=Width;
RView.Y:=0;
RView.Y1:=Height;

_MyMCIWndOpen(View, PChar(S), $00);
_MyMCIWndPutDest(View, LongInt(@RView));
_MyMCIWndPutSource(View, LongInt(@RView));

I:=LongInt(@RView);

//_MyMCIWndPut(View, LongInt(@RView));

Length:=GetLength;
End;

Procedure TMpl.Play;
Begin
   _MyMCIWndPlay(View);
End;

Procedure TMpl.Stop;
Begin
   _MyMCIWndStop(View);
End;

Procedure TMpl.ReSet;
Begin
   _MyMCIWndSeek(View, 0);
End;

Function TMpl.GetLength:Integer;
Begin
GetLength:=_MyMCIWndGetLength(View);
End;

Function TMpl.Position:Integer;
Begin
Position:=Round(400.0*_MyMCIWndGetPosition(View)/Length);
End;

Procedure TMpl.Seek(Pos:Integer);
Var I:Integer;
Begin
   I:=Round(1.0*Pos/400*Length);
   _MyMCIWndSeek(View, I);
End;

Procedure TMpl.SetVolume(Volume:Integer);
Var A:LongInt;
Begin
A:=Round((1.0*Volume/100)*1000);
_MyMCIWndSetVolume(View,A);

End;

Function TMpl.GetVolume:Integer;
Var A:Longint;
Begin
A:=_MyMCIWndGetVolume(View);
A:=A div 10;
GetVolume:=A;
End;

procedure Register;
begin
 RegisterComponents("Player", [TMpl]);
end;

end.

---

← →
Jack128 ©   (2004-04-11 17:51) [1]

TMpl = class(TWinControl)
...
published
...
 property OnMouseDown;
end;

---

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

Текущий архив: 2004.04.25;
Скачать: CL | DM;

Наверх

Память: 0.47 MB
Время: 0.023 c