Kendi media oynatıcım

Merhaba arkadaşlar bilgisayarımı karıştırırken 5-6 ay önce yazmış olduğum bir programı buldum.
Fazla algoritma kullandım aslında birazda karışık oldu.
aşağıda Type kısmında yazan isimleri google amcamızda aratırsanız size yardımcı olur hangi componenetleri kullandığım konusunda. Aslında fazla karışık. Butür kodları yazarken ara verirsem eğer kodlar birbirine karışıyor ondan bi çırpıda yazmak gerekiyor. İşinize yarar umarım. Bu kez kaynak kod dosyalarınıda ekledim..

link burada







unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, LPControl, SLControlCollection, VLCommonDisplay,
  VLDSVideoPreviewDock, LPComponent, MLDSPlayer, VLDSVideoPlayer, sButton,
  cxGraphics, cxControls, cxLookAndFeels, cxLookAndFeelPainters, cxContainer,
  cxEdit, dxSkinsCore, dxSkinBlack, dxSkinBlue, dxSkinCaramel, dxSkinCoffee,
  dxSkinDarkRoom, dxSkinDarkSide, dxSkinFoggy, dxSkinGlassOceans,
  dxSkiniMaginary, dxSkinLilian, dxSkinLiquidSky, dxSkinLondonLiquidSky,
  dxSkinMcSkin, dxSkinMoneyTwins, dxSkinOffice2007Black, dxSkinOffice2007Blue,
  dxSkinOffice2007Green, dxSkinOffice2007Pink, dxSkinOffice2007Silver,
  dxSkinOffice2010Black, dxSkinOffice2010Blue, dxSkinOffice2010Silver,
  dxSkinPumpkin, dxSkinSeven, dxSkinSharp, dxSkinSilver, dxSkinSpringTime,
  dxSkinStardust, dxSkinSummer2008, dxSkinsDefaultPainters, dxSkinValentine,
  dxSkinXmas2008Blue, cxTrackBar, ExtCtrls,shellapi, sTrackBar, sSkinManager,
  acProgressBar, sPanel, AdvProgr, sListBox, ALAudioOut, ALBasicAudioOut,
  ALDSAudioOut,MMSystem, ImgList, acAlphaImageList, AdvSmartMessageBox;

type
  TForm1 = class(TForm)
    VLDSVideoPlayer1: TVLDSVideoPlayer;
    VLDSVideoPreviewDock1: TVLDSVideoPreviewDock;
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    sSkinManager1: TsSkinManager;
    ListBox1: TsListBox;
    sPanel2: TsPanel;
    sButton3: TsButton;
    sButton2: TsButton;
    listegizle: TsButton;
    baslatdurdur: TsButton;
    sButton1: TsButton;
    Timer1: TTimer;
    ALDSAudioOut1: TALDSAudioOut;
    ALAudioOut1: TALAudioOut;
    sPanel1: TsPanel;
    Label3: TLabel;
    sTrackBar1: TsTrackBar;
    sAlphaImageList1: TsAlphaImageList;
    sButton4: TsButton;
    sButton5: TsButton;
    sPanel3: TsPanel;
    sButton6: TsButton;
    sTrackBar2: TsTrackBar;
    AdvSmartMessageBox1: TAdvSmartMessageBox;
    Memo1: TMemo;
    procedure VLDSVideoPlayer1Progress(Sender: TObject; StartSample, EndSample,
      CurrentSample: Int64);
    procedure FormCreate(Sender: TObject);
procedure WMDropFiles(VAR Msg: TWMDropFiles); message WM_DROPFILES;
    procedure Timer1Timer(Sender: TObject);
    procedure sTrackBar1Change(Sender: TObject);
    procedure cxTrackBar1PropertiesChange(Sender: TObject);
    procedure sButton2Click(Sender: TObject);
    procedure sButton3Click(Sender: TObject);
    procedure baslatdurdurClick(Sender: TObject);
    procedure listegizleClick(Sender: TObject);
    procedure sButton1Click(Sender: TObject);
    procedure VLDSVideoPreviewDock1MouseMove(Sender: TObject;
      Shift: TShiftState; X, Y: Integer);
    procedure VLDSVideoPreviewDock1DblClick(Sender: TObject);

    procedure prgbrMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure prgbrMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure sTrackBar2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure sTrackBar2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure sButton4Click(Sender: TObject);
    procedure sButton5Click(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure FormResize(Sender: TObject);
    procedure VLDSVideoPreviewDock1Resize(Sender: TObject);
    procedure UpdateApplication;
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure sButton6Click(Sender: TObject);
    procedure VLDSVideoPreviewDock1Click(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

  private
    { Private declarations }

       mouse:integer;
  public
    { Public declarations }

  end;

var
  Form1: TForm1;


implementation

uses Unit2;

{$R *.dfm}



function GetWaveVolume(var LVol: DWORD; var RVol: DWORD): Boolean;
var
WaveOutCaps: TWAVEOUTCAPS;
Volume: DWORD;
begin
Result := False;
if WaveOutGetDevCaps(WAVE_MAPPER,@WaveOutCaps,SizeOf(WaveOutCaps))=MMSYSERR_NOERROR then
  if WaveOutCaps.dwSupport and WAVECAPS_VOLUME=WAVECAPS_VOLUME then
   begin
    Result:=WaveOutGetVolume(WAVE_MAPPER, @Volume)=MMSYSERR_NOERROR;
    LVol:=LoWord(Volume);
    RVol:=HiWord(Volume);
   end;
end;

function SetWaveVolume(const AVolume: DWORD): Boolean;
var
WaveOutCaps: TWAVEOUTCAPS;
begin
Result:=False;
  if WaveOutGetDevCaps(WAVE_MAPPER, @WaveOutCaps, SizeOf(WaveOutCaps)) = MMSYSERR_NOERROR then
   if WaveOutCaps.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then
    Result:=WaveOutSetVolume(WAVE_MAPPER, AVolume)=MMSYSERR_NOERROR;
end;



procedure TForm1.cxTrackBar1PropertiesChange(Sender: TObject);
begin
    VLDSVideoPlayer1.Pause;

VLDSVideoPlayer1.Resume;
end;

procedure TForm1.FormCreate(Sender: TObject);

begin

  DragAcceptFiles(Handle, True);

   AdvSmartMessageBox1.Messages.Clear;
    AdvSmartMessageBox1.Messages.Add.Text:=memo1.lines.Text;
    AdvSmartMessageBox1.Messages.items[0].MaxDuration:=7000;
    AdvSmartMessageBox1.Messages.items[0].MaxDuration:=4000;
    AdvSmartMessageBox1.Messages.ShowAll;



end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if (key=#27) then
begin
VLDSVideoPlayer1.Pause;
form1.WindowState:=wsNormal;
       form1.WindowState:=wsnormal;
 ///    form1.BorderStyle:=bsSizeable;
    spanel2.Visible:=true;
    spanel2.Visible:=false;
      VLDSVideoPlayer1.Resume;
end;

end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin


if  (Key=VK_BACK) then
 begin
 if form1.WindowState=wsMaximized then
    begin

      VLDSVideoPlayer1.Pause;
    setZOrder(true);
     form1.WindowState:=wsnormal;
     form1.BorderStyle:=bsSizeable;
     spanel2.Visible:=true;
    spanel2.Visible:=false;

    VLDSVideoPlayer1.Resume;
    end
    else
    begin
    VLDSVideoPlayer1.Pause;

     setZOrder(true);
    form1.WindowState:=wsMaximized;
    spanel2.Visible:=true;
    spanel2.Visible:=false;
    VLDSVideoPlayer1.resume;

    end;
 end;



if(Key=VK_RIGHT) then
sbutton3.click;
if(Key=VK_LEFT) then
sbutton2.click;
if(Key=VK_Down) then
begin
sTrackBar1.Position:=sTrackBar1.Position-1;
 AdvSmartMessageBox1.Messages.Clear;
    AdvSmartMessageBox1.Messages.Add.Text:=('<B><FONT size="16"><SHAD>Ses:</SHAD></FONT></B>'+'<B><FONT size="16"><SHAD>'+inttostr(sTrackBar1.Position*10)+'</SHAD></FONT></B>');
    AdvSmartMessageBox1.Messages.ShowAll;



end;





if(Key=VK_RETURN) then
 if spanel2.Visible=true then
    spanel2.Visible:=false
    else
    spanel2.Visible:=true;

    if(Key=VK_UP) then
    begin
sTrackBar1.Position:=sTrackBar1.Position+1;
 AdvSmartMessageBox1.Messages.Clear;
    AdvSmartMessageBox1.Messages.Add.Text:=('<B><FONT size="16"><SHAD>Ses:</SHAD></FONT></B>'+'<B><FONT size="16"><SHAD>'+inttostr(sTrackBar1.Position*10)+'</SHAD></FONT></B>');
    AdvSmartMessageBox1.Messages.ShowAll;


    end;
if (key=vk_space) then
begin
if   VLDSVideoPlayer1.Paused=true then
begin
VLDSVideoPlayer1.Resume;
 AdvSmartMessageBox1.Messages.Clear;
    AdvSmartMessageBox1.Messages.Add.Text:=('<B><FONT size="16"><SHAD>Video Oynatılıyor</SHAD></FONT></B>');
    AdvSmartMessageBox1.Messages.ShowAll;
end
else
begin
VLDSVideoPlayer1.Pause;
 AdvSmartMessageBox1.Messages.Clear;
    AdvSmartMessageBox1.Messages.Add.Text:=('<B><FONT size="16"><SHAD>Video Durduruldu</SHAD></FONT></B>');
    AdvSmartMessageBox1.Messages.ShowAll;

end;
end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
///spanel2.visible:=true;
end;

procedure TForm1.FormResize(Sender: TObject);
var
i:integer;
begin
form1.Update;
form1.Refresh;
form1.Repaint;
form1.Show;
if WindowState=wsMaximized then
begin
setZOrder(true);
SetWindowPos(Form1.Handle, HWND_NOTOPMOST, 0, 0, Screen.Width, Screen.Height,
  SWP_SHOWWINDOW);
  spanel2.Visible:=true;
    spanel2.Visible:=false;
end

else
form1.BorderStyle:=bsSizeable


end;


procedure tform1.UpdateApplication;
// Updates (repaints where nesc) all windows of the app
  function UpdateWindow(hWnd: HWND; LParam: longint): bool; stdcall;
  begin
    Result := True;
    Windows.UpdateWindow(hWnd);
  end;
begin
  EnumWindows(@UpdateWindow, 0);
end;





procedure TForm1.baslatdurdurClick(Sender: TObject);
begin
if VLDSVideoPlayer1.Paused=true then
 begin
 ///baslatdurdur.Caption:='Durdur'  ;
 VLDSVideoPlayer1.Resume;
 baslatdurdur.ImageIndex:=5;
 AdvSmartMessageBox1.Messages.Clear;
    AdvSmartMessageBox1.Messages.Add.Text:=('<B><FONT size="16"><SHAD>Video Oynatılıyor</SHAD></FONT></B>');
    AdvSmartMessageBox1.Messages.ShowAll;
 spanel2.Visible:=false;

  end
  else
  begin
   ///  baslatdurdur.Caption:='Başlat'  ;
 VLDSVideoPlayer1.pause;
 baslatdurdur.ImageIndex:=4;
   AdvSmartMessageBox1.Messages.Clear;
    AdvSmartMessageBox1.Messages.Add.Text:=('<B><FONT size="16"><SHAD>Video Durduruldu</SHAD></FONT></B>');
    AdvSmartMessageBox1.Messages.ShowAll;
  end;


end;

procedure TForm1.listegizleClick(Sender: TObject);
begin
if form2.Visible=true then
begin
listegizle.Caption:='Listeyi Göster';
form2.visible:=false;
end
else
begin
listegizle.Caption:='Listeyi Gizle';
form2.visible:=true;
end;
end;

procedure TForm1.prgbrMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  var
  yer:double;
  begin



end;

procedure TForm1.prgbrMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   /// VLDSVideoPlayer1.CurrentTime:=x div  100000000;
end;

procedure TForm1.sButton1Click(Sender: TObject);
begin
//SetZOrder(TRUE);
// SetWindowPos(Form1.Handle, HWND_NOTOPMOST, 0, 0, Screen.Width, Screen.Height,
//  SWP_SHOWWINDOW);
  end;

procedure TForm1.sButton2Click(Sender: TObject);
var
anlik:Int64;
begin
 anlik:=VLDSVideoPlayer1.CurrentTime;
VLDSVideoPlayer1.CurrentTime:=(anlik-(100000000));
 AdvSmartMessageBox1.Messages.Clear;
    AdvSmartMessageBox1.Messages.Add.Text:=('<B><FONT size="16"><SHAD>10 Sn geri</SHAD></FONT></B>');
    AdvSmartMessageBox1.Messages.ShowAll;
end;

procedure TForm1.sButton3Click(Sender: TObject);
var
anlik:Int64;
begin
 anlik:=VLDSVideoPlayer1.CurrentTime;
VLDSVideoPlayer1.CurrentTime:=(anlik+(100000000));
 AdvSmartMessageBox1.Messages.Clear;
    AdvSmartMessageBox1.Messages.Add.Text:=('<B><FONT size="16"><SHAD>10 Sn ileri</SHAD></FONT></B>');
    AdvSmartMessageBox1.Messages.ShowAll;
end;

procedure TForm1.sButton4Click(Sender: TObject);
var
anlik:int64;
begin
 anlik:=VLDSVideoPlayer1.CurrentTime;
VLDSVideoPlayer1.CurrentTime:=(anlik-(50000000));
 AdvSmartMessageBox1.Messages.Clear;
    AdvSmartMessageBox1.Messages.Add.Text:=('<B><FONT size="16"><SHAD>5 Sn geri</SHAD></FONT></B>');
    AdvSmartMessageBox1.Messages.ShowAll;
end;

procedure TForm1.sButton5Click(Sender: TObject);
var
anlik:int64;
begin
 anlik:=VLDSVideoPlayer1.CurrentTime;
VLDSVideoPlayer1.CurrentTime:=(anlik+(50000000));
 AdvSmartMessageBox1.Messages.Clear;
    AdvSmartMessageBox1.Messages.Add.Text:=('<B><FONT size="16"><SHAD>5 Sn ileri</SHAD></FONT></B>');
    AdvSmartMessageBox1.Messages.ShowAll;
end;

procedure TForm1.sButton6Click(Sender: TObject);
begin
spanel2.Visible:=false;

end;

procedure TForm1.sTrackBar1Change(Sender: TObject);
var
Volume: Word;
begin
Volume:=strackbar1.Position*6535;
SetWaveVolume(MakeLong(Volume,Volume))
end;



procedure TForm1.sTrackBar2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
VLDSVideoPlayer1.Pause;


end;

procedure TForm1.sTrackBar2MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  var
  current:integer;
begin
     current:= strackbar2.Position;
VLDSVideoPlayer1.CurrentFrame:=current;
   VLDSVideoPlayer1.Resume;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if mouse=1 then
begin
  ///spanel1.Visible:=false;
  spanel2.Visible:=false;
   mouse:=0
end;
end;


procedure TForm1.VLDSVideoPlayer1Progress(Sender: TObject; StartSample,
  EndSample, CurrentSample: Int64);
  var
  dk:integer;
  saat:integer;
  begin
label1.Caption:=FloatToStr(CurrentSample);
label2.Caption:=floattostr(VLDSVideoPlayer1.DurationTime)     ;
dk:=(VLDSVideoPlayer1.CurrentTime div 10000000) div 60;
saat:=((VLDSVideoPlayer1.CurrentTime div 10000000) div 60)div 60;


label3.Caption:=inttostr(saat mod 12)+':'+inttostr(dk mod 60)+':'+inttostr((VLDSVideoPlayer1.CurrentTime div 10000000) mod 60);
//
// label4.Caption:=inttostr(VLDSVideoPlayer1.DurationTime);
// prgbr.Max:=VLDSVideoPlayer1.DurationTime div 100000000;
 sTrackBar2.Max:=VLDSVideoPlayer1.FramesCount ;//div 100000000;  ;

 strackbar2.Position :=VLDSVideoPlayer1.CurrentFrame ; ///div  100000000;
// prgbr.Position:=VLDSVideoPlayer1.CurrentTime div  100000000;

if VLDSVideoPlayer1.CurrentFrame+4>=VLDSVideoPlayer1.FramesCount then
begin
VLDSVideoPlayer1.Stop;
sPanel2.Visible:=true;
VLDSVideoPreviewDock1.Align:=alClient;

end;

end;


procedure TForm1.VLDSVideoPreviewDock1Click(Sender: TObject);
begin
/// spanel2.Visible:=true;
end;

procedure TForm1.VLDSVideoPreviewDock1DblClick(Sender: TObject);
begin
form1.WindowState:=wsMaximized;
end;

procedure TForm1.VLDSVideoPreviewDock1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
//
//if Y>VLDSVideoPreviewDock1.Height-40 then
//begin
//  ////spanel1.Visible:=true;
//  spanel2.Visible:=true;
//
//end
//else
//begin
//  ////spanel1.Visible:=false;
//  spanel2.Visible:=false;
//
//end;
end;



procedure TForm1.VLDSVideoPreviewDock1Resize(Sender: TObject);
begin
if WindowState=wsMaximized then
begin
form1.BorderStyle:=bsnone ;
end

else
form1.BorderStyle:=bsSizeable


end;

procedure TForm1.WMDropFiles(var Msg: TWMDropFiles);
var
  i, x, cnt : integer;
  buffer, F : string;
  sFullAppPath, sAppName : string;

begin
    buffer:='';
    f:='';
    i:=0;
    x:=0;
    cnt:=0;
    AdvSmartMessageBox1.Messages.Clear;
    AdvSmartMessageBox1.Messages.Add.Text:=('<B><FONT size="16"><SHAD>Video Yükleniyor</SHAD></FONT></B>');
    AdvSmartMessageBox1.Messages.ShowAll;

  //If you only want ListBox1 to accept the files
  //if they are being dropped directly on it...

    cnt := DragQueryFile(Msg.Drop, $FFFFFFFF, nil, MAX_PATH);
    SetLength(buffer, MAX_PATH *2);

    for i := 0 to cnt -1 do begin
      x := DragQueryFile(Msg.Drop, i, nil, MAX_PATH *2);
      if (x > 0) and (x < MAX_PATH *2) then begin
        DragQueryFile(Msg.Drop, i, @buffer[1], x +1);

        F := Copy(buffer, 1, x);
        // do something with F...
        VLDSVideoPlayer1.FileName:=F;


sFullAppPath  := f;
sAppName := ExtractFileName(sFullAppPath);




        form1.Caption:='Kendim Yaptım Oldu Video Player    ||||||  '+sAppName;
       AdvSmartMessageBox1.Messages.Clear;
    AdvSmartMessageBox1.Messages.Add.Text:=('<B><SHAD><FONT size="11">Navigasyon Tuşlarını Görüntülemek İçin ENTER tuşuna basınız</FONT></SHAD></B>');
    AdvSmartMessageBox1.Messages.ShowAll;
         spanel2.Visible:=false;
      end;
    end;


  DragFinish(Msg.Drop);
  Msg.Result := 0;

end;
end.


Yorumlar