📄 mediaunit1.pas
字号:
unit MediaUnit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
MPlayer, StdCtrls, ExtCtrls, ComCtrls,MMSystem,ShellAPI, Buttons, Gauges,
Spin,About,Menus, AppEvnts, Registry;
type
TForm1 = class(TForm)
MediaPlayer1: TMediaPlayer;
OpenDialog1: TOpenDialog;
Label3: TLabel;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
Gauge2: TGauge;
Bevel1: TBevel;
TrackBar1: TTrackBar;
ListBox1: TListBox;
Label1: TLabel;
SpeedButton4: TSpeedButton;
Label2: TLabel;
TrackBar2: TTrackBar;
Bevel2: TBevel;
LoadList: TSpeedButton;
OpenFiles: TSpeedButton;
SpeedButton8: TSpeedButton;
SpeedButton9: TSpeedButton;
SpeedButton1: TSpeedButton;
SpeedButton10: TSpeedButton;
MuteBtn: TCheckBox;
SkinBtn: TSpeedButton;
Skin: TColorDialog;
ListBox2: TListBox;
ApplicationEvents1: TApplicationEvents;
SpeedButton2: TSpeedButton;
Timer1: TTimer;
Button1: TButton;
Key: TEdit;
Auto: TCheckBox;
ListDialog: TOpenDialog;
Timer3: TTimer;
SaveList: TSaveDialog;
LoadListDia: TOpenDialog;
procedure MediaPlayer1Click(Sender: TObject; Button: TMPBtnType;
var DoDefault: Boolean);
procedure Timer1Timer(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure EditClick(Sender: TObject);
procedure SkinBtnClick(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure TrackBar2Change(Sender: TObject);
procedure SpeedButton5Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton10Click(Sender: TObject);
procedure MuteBtnClick(Sender: TObject);
procedure OpenFilesClick(Sender: TObject);
procedure ApplicationEvents1Exception(Sender: TObject; E: Exception);
procedure Delete1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure Label1StartDrag(Sender: TObject;
var DragObject: TDragObject);
procedure Timer3Timer(Sender: TObject);
procedure Move1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure Label1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
function GetKey: PCHAR; stdcall; external 'register.dll';
function GetCName: PCHAR; stdcall; external 'register.dll';
procedure PlayNow;
var
Form1:TForm1;
Device,P,K:Integer;
FileName,Edit, COL:String;
SplashScreen: TAboutBox;
Reg: TRegistry;
implementation
uses RegUnit;
{$R *.DFM}
procedure TForm1.MediaPlayer1Click(Sender: TObject; Button: TMPBtnType;
var DoDefault: Boolean);
begin
case Button of
btPlay :
begin
MediaPlayer1.FileName := FileName;
MediaPlayer1.Open;
TrackBar1.Enabled := True;
Label10.Caption := 'Playing';
Device := MediaPlayer1.Handle;
end;
btPause:
begin
Label10.Caption := 'Paused';
end;
btStop:
begin
Label10.Caption := 'Stopped';
end;
btStep:
begin
Label10.Caption := 'Step';
end;
btBack:
begin
Label10.Caption := 'Back';
end;
btRecord:
begin
Label10.Caption := 'Record';
end;
btEject:
begin
Label10.Caption := 'Eject';
end;
end;
Gauge2.MaxValue := MediaPlayer1.Length;
TrackBar1.Max := MediaPlayer1.Length;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
NoOfFIles: Integer;
begin
Gauge2.Progress := MediaPlayer1.Position;
Label3.Caption := 'MediaWalker : ' + ExtractFileName(FileName);
if (Auto.Checked = True) and (Gauge2.PercentDone = 100) then
begin
NoOfFiles := ListBox2.Items.Count;
if NoOfFIles <> 0 then
begin
K := Random(NoOfFIles);
PlayNow;
end;
end;
end;
procedure PlayNow;
begin
FileName := Form1.ListBox2.Items.Strings[K];
Form1.MediaPlayer1.FileName := ExtractFilePath(FileName);
Form1.MediaPlayer1Click(nil,btPlay,DDBsOnly);
Form1.MediaPlayer1.Play;
end;
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
if MediaPlayer1.Enabled = False then
TrackBar1.Enabled := False
else
begin
TrackBar1.Enabled := True;
with MediaPlayer1 do
begin
Position := TrackBar1.Position;
play;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Reg := TRegistry.Create;
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('\Software\MW',TRUE) then
Form1.Color := StringToColor(Reg.ReadString('Color'));
Key.Text := GetKey;
Reg.OpenKey('\Software\JaySoft',FALSE);
if Key.Text = Reg.ReadString('Key') then
begin
Button1.Visible := FALSE;
// Label3.Visible := TRUE;
end;
Reg.CloseKey;
Reg.Free;
SplashScreen := TAboutBox.Create(Application);
With SplashScreen do
begin
Splash;
Timer2.Enabled := True;
end;
Label1.Width := 345;
Edit := 'No';
end;
procedure TForm1.EditClick(Sender: TObject);
var
A,C : Integer;
begin
if LoadListDia.Execute then
begin
ListBox2.Clear;
ListBox1.Clear;
ListBox2.Items.LoadFromFile(LoadListDia.FileName);
C := ListBox2.Items.Count;
if C <> 0 then
begin
for A := 0 to (C - 1) do
ListBox1.Items.Add(ExtractFileName(ListBox2.Items.Strings[A]));
end;
end;
end;
procedure TForm1.SkinBtnClick(Sender: TObject);
begin
if Skin.Execute then
Form1.Color := Skin.Color;
if Form1.BorderStyle = bsSingle then
begin
Form1.BorderStyle := bsNone;
Form1.BorderStyle := bsSingle;
end
else
begin
Form1.BorderStyle := bsSingle;
Form1.BorderStyle := bsNone;
end;
COL := ColorToString(Form1.Color);
Reg := TRegistry.Create;
Reg.RootKey := HKEY_CURRENT_USER;
Reg.OpenKey('\Software\MW',FALSE);
Reg.WriteString('Color',COL);
Reg.CloseKey;
Reg.Free;
end;
procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
if SaveList.Execute then
ListBox2.Items.SaveToFile(SaveList.FileName);
end;
procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
FileName := OpenDialog1.FileName;
Label3.Caption := ExtractFileName(FileName);
end;
end;
procedure TForm1.ListBox1Click(Sender: TObject);
begin
K := ListBox1.ItemIndex;
if Edit = 'Yes' then
begin
ListBox1.Items.Delete(K);
ListBox2.Items.Delete(K);
Edit := 'No';
end
else
PlayNow;
end;
procedure TForm1.TrackBar2Change(Sender: TObject);
begin
if MuteBtn.Checked = True then
begin
MuteBtn.Checked := False;
MuteBtn.Font.Color := ClBlack;
end;
case TrackBar2.Position of
1:
begin
waveOutSetVolume(0,$00000000);
end;
2:
begin
waveOutSetVolume(0,$10001000);
end;
3:
begin
waveOutSetVolume(0,$20002000);
end;
4:
begin
waveOutSetVolume(0,$30003000);
end;
5:
begin
waveOutSetVolume(0,$40004000);
end;
6:
begin
waveOutSetVolume(0,$50005000);
end;
7:
begin
waveOutSetVolume(0,$60006000);
end;
8:
begin
waveOutSetVolume(0,$70007000);
end;
9:
begin
waveOutSetVolume(0,$80008000);
end;
10:
begin
waveOutSetVolume(0,$90009000);
end;
11:
begin
waveOutSetVolume(0,$A000A000);
end;
12:
begin
waveOutSetVolume(0,$B000B000);
end;
13:
begin
waveOutSetVolume(0,$C000C000);
end;
14:
begin
waveOutSetVolume(0,$D000D000);
end;
15:
begin
waveOutSetVolume(0,$E000E000);
end;
16:
begin
waveOutSetVolume(0,$F000F000);
end;
17:
begin
waveOutSetVolume(0,$FF00FF00);
end;
18:
begin
waveOutSetVolume(0,$FFF0FFF0);
end;
19:
begin
waveOutSetVolume(0,$FFFFFFFF);
end;
20:
begin
waveOutSetVolume(0,$FFFFFFFF);
end;
end;
end;
procedure TForm1.SpeedButton5Click(Sender: TObject);
begin
SplashScreen := TAboutBox.Create(Application);
With SplashScreen do
begin
Timer2.Interval := $700;
Splash;
Timer2.Enabled := True;
end;
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
Edit := 'Yes';
ShowMessage('Edit mode ON. CLick on item to delete.');
end;
procedure TForm1.SpeedButton10Click(Sender: TObject);
begin
ShellExecute(Handle,'open',PChar('help.txt'),NIL,NIL,SW_SHOWNORMAL);
end;
procedure TForm1.MuteBtnClick(Sender: TObject);
begin
if MuteBtn.Checked = True then
begin
WaveOutSetVolume(0,$00000000);
MuteBtn.Font.Color := Clred;
end
else
begin
TrackBar2.Position := TrackBar2.Position + 1;
TrackBar2.Position := TrackBar2.Position - 1;
MuteBtn.Font.Color := ClBlack;
end;
end;
procedure TForm1.OpenFilesClick(Sender: TObject);
var
A, C : Integer;
begin
ListBox1.Clear;
if ListDialog.Execute then
ListBox2.Items.AddStrings(ListDialog.Files);
C := ListBox2.Items.Count;
if C <> 0 then
begin
for A := 0 to (C - 1) do
ListBox1.Items.Add(ExtractFileName(ListBox2.Items.Strings[A]));
end;
end;
procedure TForm1.ApplicationEvents1Exception(Sender: TObject;
E: Exception);
begin
ShowMessage('Sorry! MediaWalker could not perform this operation.' + #13 + 'Error : ' + E.Message);
end;
procedure TForm1.Delete1Click(Sender: TObject);
begin
ListBox2.DeleteSelected;
end;
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
Application.Terminate;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
RF : TRegistrationForm;
begin
RF := TRegistrationForm.Create(Self);
RF.ShowModal;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
var
NoOfFIles: Integer;
begin
NoOfFiles := ListBox2.Items.Count;
if NoOfFIles <> 0 then
begin
if (Gauge2.PercentDone = 100) then
begin
K := Random(NoOfFIles);
PlayNow;
end;
end;
end;
procedure TForm1.Label1StartDrag(Sender: TObject;
var DragObject: TDragObject);
var G : TPoint;
begin
G := Mouse.CursorPos;
Form1.Left := G.X;
Form1.Top := G.Y;
end;
procedure TForm1.Timer3Timer(Sender: TObject);
var G : TPoint;
begin
G := Mouse.CursorPos;
Form1.Left := G.X - Form1.Width div 2;
Form1.Top := G.Y;
end;
procedure TForm1.Move1Click(Sender: TObject);
begin
if Timer3.Enabled = TRUE then
Timer3.Enabled := FALSE
else
Timer3.Enabled := TRUE;
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
exit;
end;
procedure TForm1.Label1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Timer3.Enabled = TRUE then
Timer3.Enabled := FALSE
else
Timer3.Enabled := TRUE;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -