Tam Ekran Film keyfi

[mege]

Tam ekran film izlemek için küçük bir kod parçası..
formda 1 adet mediaplayer var ve nesne kendini form üzerine form boyutlarında bırakıyor.

Kod: Tümünü seç

procedure TForm1.FormCreate(Sender: TObject);
begin
 with form1 do
 begin
   Cursor:= crNone;
   Color:=clBlack;
   BorderStyle:=bsNone;
   WindowState:=wsMaximized;
   Show;
 end;

 with mediaplayer1 do
 begin
   Visible:= False;
   FileName:='sahil.mpg';
   Open;
   Display:=Form1;
   DisplayRect:=RECT(0,0,Form1.ClientWidth,form1.ClientHeight);
   play;
 end;
end;

procedure TForm1.FormClick(Sender: TObject);
begin
  Halt;
end;

[mege]

EK: deminki kod repeat yapmıyordu, yoğun istekler üzerine kodu azcık modifiye ettim. supoyler,sis farı,bide krom çamurluk falan taktım,, nediyorum ben ya
Notify ile çeşitli hataları sezmekde mümkünmüş.. ayrıca bunu mediaplayer ın ONNotifya eklemeyi unutmayın.

Kod: Tümünü seç

procedure TForm1.FormCreate(Sender: TObject);
begin
with form1 do
begin
  Cursor:= crNone;
  Color:=clBlack;
  BorderStyle:=bsNone;
  WindowState:=wsMaximized;
  Show;
end;

with mediaplayer1 do
begin
  Visible:= False;
  FileName:='jene.avi';
  Open;
  Display:=Form1;
  DisplayRect:=RECT(0,0,Form1.ClientWidth,form1.ClientHeight);
  play;
  Notify  := True;
end;
end;

procedure TForm1.FormClick(Sender: TObject);
begin
Halt;
end;

procedure TForm1.MediaPlayer1Notify(Sender: TObject);
begin
 with Sender as TMediaPlayer do
  begin
    if mode=mpstopped then Play;
    Notify := True;
  end;
end;