⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mediaunit1.pas

📁 program nghe nhac with goodskin
💻 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 + -