Додатки Тексти програмного коду основних процедур програми

II JI E E P

unit Unit1;

interface

uses //підключені бібліотеки

Tlhelp32, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, FileCtrl, StdCtrls, MPlayer, MMSystem, ComCtrls, Buttons, ExtCtrls,

Menus, ShellAPI;

Type

TForm1 = class(TForm)

ListBox1: TListBox;

MediaPlayer1: TMediaPlayer;

OpenDialog1: TOpenDialog;

ProgressBar1: TProgressBar;

Play: TBitBtn;

Stop: TBitBtn;

Timer1: TTimer;

Pause: TBitBtn;

TrackBar1: TTrackBar;

Label1: TLabel;

CheckBox1: TCheckBox;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

Label6: TLabel;

BitBtn1: TBitBtn;

BitBtn2: TBitBtn;

BitBtn3: TBitBtn;

Label7: TLabel;

Label8: TLabel;

MainMenu1: TMainMenu;

N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

N5: TMenuItem;

N6: TMenuItem;

N7: TMenuItem;

N8: TMenuItem;

N9: TMenuItem;

N10: TMenuItem;

N11: TMenuItem;

N12: TMenuItem;

BitBtn4: TBitBtn;

BitBtn5: TBitBtn;

ColorDialog1: TColorDialog;

PopupMenu1: TPopupMenu;

N13: TMenuItem;

N14: TMenuItem;

N15: TMenuItem;

PopupMenu2: TPopupMenu;

N16: TMenuItem;

N17: TMenuItem;

Label9: TLabel;

Label10: TLabel;

Label11: TLabel;

Label12: TLabel;

Button2: TButton;

Timer2: TTimer;

Timer3: TTimer;

BitBtn6: TBitBtn;

Button1: TButton;

BitBtn7: TBitBtn;

onoff1: TMenuItem;

N18: TMenuItem;

Label13: TLabel;

Edit1: TEdit;

CheckBox2: TCheckBox;

procedure BitBtn4Click(Sender: TObject);

procedure ListBox1DblClick(Sender: TObject);

procedure PlayClick(Sender: TObject);

procedure StopClick(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure PauseClick(Sender: TObject);

procedure TrackBar1Change(Sender: TObject);

procedure ProgressBar1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure MediaPlayer1Notify(Sender: TObject);

procedure BitBtn5Click(Sender: TObject);

procedure Bitbtn1Click(Sender: TObject);

procedure BitBtn2Click(Sender: TObject);

procedure BitBtn3Click(Sender: TObject);

procedure N4Click(Sender: TObject);

procedure N12Click(Sender: TObject);

procedure N13Click(Sender: TObject);

procedure N17Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Timer2Timer(Sender: TObject);

procedure Timer3Timer(Sender: TObject);

procedure BitBtn6Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure BitBtn7Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

const

MCI_SETAUDIO = $0873;

MCI_DGV_SETAUDIO_VOLUME = $4002;

MCI_DGV_SETAUDIO_ITEM = $00800000;

MCI_DGV_SETAUDIO_VALUE = $01000000;

MCI_DGV_STATUS_VOLUME = $4019;

type

MCI_DGV_SETAUDIO_PARMS = record

dwCallback: DWORD;

dwItem: DWORD;

dwValue: DWORD;

dwOver: DWORD;

lpstrAlgorithm: PChar;

lpstrQuality: PChar;

end;

type

MCI_STATUS_PARMS = record

dwCallback: DWORD;

dwReturn: DWORD;

dwItem: DWORD;

dwTrack: DWORD;

end;

var //описуємо змінні

Form1: TForm1;

i: integer=0;

n: integer=0;

r: integer=0;

implementation

uses Unit2;

{$R *.dfm}

procedure SetMPVolume(MP: TMediaPlayer; Volume: Integer);

{ Volume: 0 - 1000 }

var

p: MCI_DGV_SETAUDIO_PARMS;

begin

{ Volume: 0 - 1000 }

p.dwCallback := 0;

p.dwItem := MCI_DGV_SETAUDIO_VOLUME;

p.dwValue := Volume;

p.dwOver := 0;

p.lpstrAlgorithm := nil;

p.lpstrQuality := nil;

mciSendCommand(MP.DeviceID, MCI_SETAUDIO,

MCI_DGV_SETAUDIO_VALUE or MCI_DGV_SETAUDIO_ITEM, Cardinal(@p));

end;

function GetMPVolume(MP: TMediaPlayer): Integer;

var

p: MCI_STATUS_PARMS;

begin

p.dwCallback := 0;

p.dwItem := MCI_DGV_STATUS_VOLUME;

mciSendCommand(MP.DeviceID, MCI_STATUS, MCI_STATUS_ITEM, Cardinal(@p));

Result := p.dwReturn;

{ Volume: 0 - 1000 }

end;

procedure TForm1.BitBtn4Click(Sender: TObject); //додавання файлів в плейлист

begin

OpenDialog1.Options:=[ofAllowMultiSelect]; //дозволяємо мультиселект

if opendialog1.Execute then //щоб не викликати помилку при натисканні відміни

begin

ListBox1.Clear;

listbox1.Items.AddStrings(opendialog1.Files);

//автоматично виділяємо перший файл в списку

ListBox1.Selected[0]:=true;

//автоматично відтворюємо виділений

if CheckBox1.Checked then PlayClick(self);

end;

bitbtn4.ShowHint:=true;

end;

procedure TForm1.ListBox1DblClick(Sender: TObject); //відтворення по подвійному кліку

begin

Mediaplayer1.FileName:=listbox1.items.Strings[listbox1.itemindex];//додаємо рядки

mediaplayer1.Open; //відкриваємо

progressbar1.Max:=mediaplayer1.Length;//прирівнюємо максимальну довжину прогресбару до поточної довжини треку

Timer1.Enabled:=true; //запускаємо таймер для відліку часу

//встановлюємо початкову гучність

SetMPVolume(MediaPlayer1, 1000-TrackBar1.Position*50);

mediaplayer1.Play;//відтворюємо

edit1.text :=(extractfilename(mediaplayer1.filename));

end;

procedure TForm1.PlayClick(Sender: TObject); //програмування кнопки «Грати»

begin

if ListBox1.Count>0 then

begin

mediaplayer1.FileName:=listbox1.Items.Strings[listbox1.itemindex];

mediaplayer1.Open;

progressbar1.Max:=mediaplayer1.Length;

Timer1.Enabled:=true;

//встановлюємо початкову гучність

SetMPVolume(MediaPlayer1, 1000-TrackBar1.Position*50);

mediaplayer1.Play;

edit1.text :=(extractfilename(mediaplayer1.filename));

end

else ShowMessage('Плейлист порожній!');

play.ShowHint:=true;

end;

procedure TForm1.StopClick(Sender: TObject); //програмування кнопки «СТОП»

begin

if (ListBox1.Count>0) then

begin

mediaplayer1.Stop;

Progressbar1.Max:=progressbar1.Min;

end;

stop.ShowHint:=true;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

Var

Len,Pos,MinLeft,SecLeft,Min,Sec,minn,secc: Integer;

begin

if ProgressBar1.Max<>0 then

begin

ProgressBar1.Position := Mediaplayer1.Position; //прирівнюємо початкову позицію прогресбару до поточної позиції треку

Len:=Mediaplayer1.TrackLength[ListBox1.ItemIndex];

//вираховуємо час

Pos := Mediaplayer1.Position;

MinLeft := ((Len - Pos) div 1000) div 60;//залишилось хв

SecLeft := ((Len - Pos) div 1000) mod 60;//залишилось сек

Min := (Pos div 1000) div 60;

Sec := (Pos div 1000) mod 60;

minn:= ((len) div 1000) div 60;

secc:= ((len) div 1000) mod 60;

label9.caption:='0'+inttostr(minn);

if secc<10 then

label10.caption:='0'+inttostr(secc) else

label10.caption:=inttostr(secc); //всього

//залишилось

if SecLeft < 10 then

label3.Caption := '0' + IntToStr(SecLeft)

else

label3.Caption := IntToStr(SecLeft);

if MinLeft < 10 then

label2.Caption := '0' + IntToStr(MinLeft)+':'

else

label2.Caption := IntToStr(MinLeft)+':';

//пройшло

if Sec < 10 then

label5.Caption := '0' + IntToStr(Sec)

else

label5.Caption := IntToStr(Sec);

if Min < 10 then

label4.Caption := '0' + IntToStr(Min)+':'

else

label4.Caption := IntToStr(Min)+':';

end;

end;

procedure TForm1.PauseClick(Sender: TObject); //натискання паузи

begin

if listbox1.ItemIndex<0 then//якщо плейлист порожній

showmessage('плейлист порожній!')

else

begin

if i=1 then

begin

mediaplayer1.pause;

i:=0;

end

else

begin

mediaplayer1.play;

i:=1;

end;

edit1.text :=(extractfilename(mediaplayer1.filename)); //записуємо в edit1 назву поточного файла

pause.ShowHint:=true;

end;

end;

//змінюємо гучність

procedure TForm1.TrackBar1Change(Sender: TObject);

begin

SetMPVolume(MediaPlayer1, 1000-TrackBar1.Position*50);

Label1.Caption:=IntToStr(100-TrackBar1.Position*5)+'%';

end;

//навігація по треку

procedure TForm1.ProgressBar1MouseDown(Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

var

pos:integer;

begin

pos:=round((100 / ProgressBar1.Width)*x); //позиція кліка

MediaPlayer1.Position:=(MediaPlayer1.Length div 100)*pos;

MediaPlayer1.Play;

edit1.text :=(extractfilename(mediaplayer1.filename));

end;

//перехід на наступний трек

procedure TForm1.MediaPlayer1Notify(Sender: TObject);

begin

with MediaPlayer1 do

if NotifyValue = nvSuccessful then //якщо кінець пісні

begin

if checkbox2.checked then begin

playclick(self)

end

else

begin

Notify := True;

with ListBox1 do

if ItemIndex<Items.Count-1 then//якщо не остання пісня

begin

Selected[ItemIndex+1]:=true;//виділяємо наступний трек

Notify:=False;

PlayClick(self);

end

else

selected[0]:=true;

Notify:=False;

playclick(self);

end;

end;

end;

procedure TForm1.BitBtn5Click(Sender: TObject); //відкрити теку з файлами

var

chosenDir:string;

fs: tSearchRec;

begin

if SelectDirectory('виберіть каталог','', chosenDir)

then

begin

ListBox1.Clear;

if (FindFirst(chosenDir+'\*.mp3', faAnyFile, fs)=0) or

(FindFirst(chosenDir+'\*.wma', faAnyFile, fs)=0) or

(FindFirst(chosenDir+'\*.wav', faAnyFile, fs)=0) or

(FindFirst(chosenDir+'\*.aac', faAnyFile, fs)=0)

then

repeat

ListBox1.Items.Add(chosenDir+'\'+fs.Name);

FindNext(fs);

ListBox1.Items.Add(chosenDir+'\'+fs.Name);

until FindNext(fs)<>0;

if ListBox1.Items.Count<>0 then

begin

//автоматично виділяємо перший файл в списку

ListBox1.Selected[0]:=true;

//автоматично відтворюємо виділений

if (CheckBox1.Checked) then PlayClick(self);

end;

edit1.text :=(extractfilename(mediaplayer1.filename)); // записуємо в edit1 назву поточного файла

end;

bitbtn5.ShowHint:=true;

end;

procedure TForm1.Bitbtn1Click(Sender: TObject); // перехід до попереднього файлу

begin

if ListBox1.Count>0 then

begin

if listbox1.itemindex>0 then

begin

mediaplayer1.Stop;

mediaplayer1.FileName:=listbox1.Items.Strings[listbox1.itemindex-1];

mediaplayer1.Open;

progressbar1.Max:=mediaplayer1.Length;

Timer1.Enabled:=true;

//встановлюємо початкову гучність

SetMPVolume(MediaPlayer1, 1000-TrackBar1.Position*50);

mediaplayer1.Play;

ListBox1.Selected[ListBox1.ItemIndex-1]:=true;//виділяємо попередній трек

edit1.text :=(extractfilename(mediaplayer1.filename)); //записуємо в edit1 назву поточного файла

end

end;

bitbtn1.ShowHint:=true;

end;

procedure TForm1.BitBtn2Click(Sender: TObject); //перехід до наступного файлу

begin

if ListBox1.Count>0 then

begin

if listbox1.itemindex<ListBox1.Count-1 then

begin

mediaplayer1.Stop;

mediaplayer1.FileName:=listbox1.Items.Strings[listbox1.itemindex+1];

mediaplayer1.Open;

progressbar1.Max:=mediaplayer1.Length;

Timer1.Enabled:=true;

//встановлюємо початкову гучність

SetMPVolume(MediaPlayer1, 1000-TrackBar1.Position*50);

mediaplayer1.Play;

ListBox1.Selected[ListBox1.ItemIndex+1]:=true; //виділяємо наступний трек

edit1.text :=(extractfilename(mediaplayer1.filename));

end

end ;

bitbtn2.ShowHint:=true;

end;

procedure TForm1.BitBtn3Click(Sender: TObject); //встановлюємо гучність

begin

trackbar1.Visible:=true;

label1.Visible:=true;

timer2.Enabled:=true;

bitbtn3.ShowHint:=true;

end;

procedure TForm1.N4Click(Sender: TObject); //вихід

begin

Form1.close;

end;

procedure TForm1.N12Click(Sender: TObject); //про програму

begin

Form2.visible:=true;

end;

procedure TForm1.N13Click(Sender: TObject); //зміна кольору форми

begin

if not Colordialog1.Execute then exit else Form1.Color:=colordialog1.Color;

end;

procedure TForm1.N17Click(Sender: TObject); //зміна кольору плейлисту

begin

if not colordialog1.execute then exit else listbox1.color:=colordialog1.Color;

end;

procedure TForm1.Button2Click(Sender: TObject); //виводити системний час

begin

Label12.Caption := TimeToStr(Time);

timer3.enabled:=true;

end;

procedure TForm1.Timer2Timer(Sender: TObject); //приховати зміну гучності

begin

trackbar1.Visible:=false;

label1.Visible:=false;

timer2.Enabled:=false;

end;

procedure TForm1.Timer3Timer(Sender: TObject); //оновлювати системний час

begin

button2click(self);

end;

function KillTask(ExeFileName: string): integer; //функція закриття процесу

const

PROCESS_TERMINATE=$0001;

var

ContinueLoop: BOOL;

FSnapshotHandle: THandle;

FProcessEntry32: TProcessEntry32;

begin

result := 0;

FSnapshotHandle := CreateToolhelp32Snapshot

(TH32CS_SNAPPROCESS, 0);

FProcessEntry32.dwSize := Sizeof(FProcessEntry32);

ContinueLoop := Process32First(FSnapshotHandle,

FProcessEntry32);

while integer(ContinueLoop) <> 0 do

begin

if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =

UpperCase(ExeFileName))

or (UpperCase(FProcessEntry32.szExeFile) =

UpperCase(ExeFileName))) then

Result := Integer(TerminateProcess(OpenProcess(

PROCESS_TERMINATE, BOOL(0),

FProcessEntry32.th32ProcessID), 0));

ContinueLoop := Process32Next(FSnapshotHandle,

FProcessEntry32);

end;

CloseHandle(FSnapshotHandle);

end;

procedure TForm1.Button1Click(Sender: TObject);//закриття процесу

begin

KillTask('TIMER.exe');

end;

procedure TForm1.BitBtn6Click(Sender: TObject);//показати/приховати таймер

begin

if r=1 then

begin

KillTask('TIMER.exe');

r:=0;

end

else

begin

ShellExecute(0, 'open', 'C:\Program files\II JI E E P\TIMER\TIMER.exe', '', '', SW_SHOWNORMAL);

r:=1;

end;

bitbtn6.ShowHint:=true;

end;

procedure TForm1.BitBtn7Click(Sender: TObject);//увімкнути/вимкнути плейлист

begin

if n=1 then

begin

listbox1.visible:=false;

label6.caption:='плейлист вимкнено';

n:=0;

end

else

begin

listbox1.visible:=true;

label6.caption:='плейлист увімкнено';

n:=1;

end;

bitbtn7.ShowHint:=true;

end;

end.

ТАЙМЕР

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ExtCtrls, StdCtrls, math;

type

TForm1 = class(TForm)

Button1: TButton;

ComboBox1: TComboBox;

Timer1: TTimer;

Button2: TButton;

ComboBox2: TComboBox;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Button3: TButton;

procedure Button1Click(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

function MyExitWindows(RebootParam: Longword): Boolean; //функція вимкнення Windows

var

TTokenHd: THandle;

TTokenPvg: TTokenPrivileges;

cbtpPrevious: DWORD;

rTTokenPvg: TTokenPrivileges;

pcbtpPreviousRequired: DWORD;

tpResult: Boolean;

const

SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';

begin

if Win32Platform = VER_PLATFORM_WIN32_NT then

begin

tpResult := OpenProcessToken(GetCurrentProcess(),

TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,

TTokenHd);

if tpResult then

begin

tpResult := LookupPrivilegeValue(nil,

SE_SHUTDOWN_NAME,

TTokenPvg.Privileges[0].Luid);

TTokenPvg.PrivilegeCount := 1;

TTokenPvg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;

cbtpPrevious := SizeOf(rTTokenPvg);

pcbtpPreviousRequired := 0;

if tpResult then

Windows.AdjustTokenPrivileges(TTokenHd,

False,

TTokenPvg,

cbtpPrevious,

rTTokenPvg,

pcbtpPreviousRequired);

end;

end;

Result := ExitWindowsEx(RebootParam, 0);

end;

procedure TForm1.Button2Click(Sender: TObject);//при натисканні кнопки запустити таймер

begin

MyExitWindows(EWX_POWEROFF or EWX_FORCE);

end;

procedure TForm1.Button1Click(Sender: TObject);

var

time: integer;

time2: integer;

begin

time:=combobox1.ItemIndex;//присвоєння змінних

time2:=combobox2.ItemIndex;

timer1.Interval:=((((time) * 1000)*60)+(((time2)*1000)*60)*60);//обчислення таймера

if timer1.Interval=0 then begin

showmessage ('виберіть час виключення!');

time:=1;

end

else

if timer1.Interval>0 then

begin

timer1.Enabled:=true;

Form1.Visible:=false;

end;

end;

procedure TForm1.Timer1Timer(Sender: TObject);//по таймеру вимкнеться комп’ютер

begin

timer1.Enabled:=false;

button2click(self);

end;

procedure TForm1.Button3Click(Sender: TObject);//закрити програму

begin

close;

end;

end.