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

Вниз

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

 
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;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.45 MB
Время: 0.036 c
1-1081190376
KommandorDi
2004-04-05 22:39
2004.04.25
Перерисовка компонента TPaintBox


7-1077790648
Brut
2004-02-26 13:17
2004.04.25
Как открыть "сетевые подключения"


6-1077907167
ALeX.B.
2004-02-27 21:39
2004.04.25
Помогите! Нужен рабочий FTPServer!


1-1081489079
Riant
2004-04-09 09:37
2004.04.25
Excel в Delphi


3-1080194760
ГАГН
2004-03-25 09:06
2004.04.25
DBComboBox





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