Form içinde REGISTRY uygulaması

Form içinde farklı skinler oluşturma ve bu işi registry ile yapma uygulamasıdır.

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, OleCtrls, WMPLib_TLB;

type
TForm1 = class(TForm)
OpenDialog1: TOpenDialog;Label3: TLabel;Label9: TLabel;
Label10: TLabel;ListBox1: TListBox;Label1: TLabel;
Skin: TColorDialog; ListBox2: TListBox; ApplicationEvents1: TApplicationEvents;
Timer1: TTimer; Button1: TButton; Key: TEdit; ListDialog: TOpenDialog;
Timer3: TTimer; SaveList: TSaveDialog;LoadListDia: TOpenDialog;
Panel1: TPanel;Label11: TLabel;MainMenu1: TMainMenu;Files1: TMenuItem;
OpenFiles1: TMenuItem; N1: TMenuItem;LoadList1: TMenuItem;
AddtoYourList1: TMenuItem;SaveList1: TMenuItem; EdityourList1: TMenuItem;
View1: TMenuItem;Setskin1: TMenuItem;Help1: TMenuItem;
About1: TMenuItem;N2: TMenuItem;Content1: TMenuItem;
N3: TMenuItem;Close1: TMenuItem;MediaPlayer1: TMediaPlayer;
TrackBar1: TTrackBar; Auto: TCheckBox;MuteBtn: TCheckBox;
StatusBar1: TStatusBar;Gauge2: TGauge;Label2: TLabel;
TrackBar2: TTrackBar;WindowsMediaPlayer1: TWindowsMediaPlayer;
Button2: TButton;
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 TrackBar2Change(Sender: TObject);
procedure MuteBtnClick(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);
procedure OpenFiles1Click(Sender: TObject);
procedure LoadList1Click(Sender: TObject);
procedure AddtoYourList1Click(Sender: TObject);
procedure SaveList1Click(Sender: TObject);
procedure EdityourList1Click(Sender: TObject);
procedure Close1Click(Sender: TObject);
procedure Setskin1Click(Sender: TObject);
procedure About1Click(Sender: TObject);
procedure Content1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);

private
public
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 := 'MK MediaPlayer : ' + 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\Mkstyle',TRUE) then
Form1.Color := StringToColor(Reg.ReadString('Color'));
Key.Text := GetKey;
Reg.OpenKey('\Software\Sadimba Software',FALSE);
if Key.Text = Reg.ReadString('Key') then
begin Button1.Visible := FALSE; 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.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.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.ApplicationEvents1Exception(Sender: TObject;E: Exception);
begin
ShowMessage('Sorry! MK MediaPlayer 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;
//******************************************************************************
procedure TForm1.OpenFiles1Click(Sender: TObject);
begin if OpenDialog1.Execute then begin
FileName := OpenDialog1.FileName; if filename='*.mp4' then
Listbox1.Items.AddStrings(Opendialog1.Files); Filename:=WindowsMediaPlayer1.URL;end
else Label3.Caption := ExtractFileName(FileName); end;
//******************************************************************************
procedure TForm1.LoadList1Click(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.AddtoYourList1Click(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.SaveList1Click(Sender: TObject);
begin if SaveList.Execute then ListBox2.Items.SaveToFile(SaveList.FileName);end;

procedure TForm1.EdityourList1Click(Sender: TObject);
begin Edit := 'Yes';ShowMessage('Edit mode ON. CLick on item to delete.');end;

procedure TForm1.Close1Click(Sender: TObject);
begin application.Terminate;end;

procedure TForm1.Setskin1Click(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\Sadimba',FALSE); Reg.WriteString('Color',COL);
Reg.CloseKey; Reg.Free;end;

procedure TForm1.About1Click(Sender: TObject);
begin SplashScreen := TAboutBox.Create(Application);
With SplashScreen do begin
Timer2.Interval := $700; Splash; Timer2.Enabled := True; end;end;

procedure TForm1.Content1Click(Sender: TObject);
begin ShellExecute(Handle,'open',PChar('help.txt'),NIL,NIL,SW_SHOWNORMAL);end;

procedure TForm1.Button2Click(Sender: TObject);
var index,h,a: integer; str_dir, x:string;
begin index:=0;
WindowsMediaPlayer1.URL:=str_dir+ListBox1.Items.Strings[index] ;
x:=(FloatToStr(windowsMediaPlayer1.currentMedia.duration));
val(x,h,a); WindowsMediaPlayer1.controls.play;end;

end.
Kodlardan bazıları alıntıdır.