// Mit dem folgenden Code kann man AVIs mittels Mediaplayer in verschiedenen
// Größen
(also auch im Vollbildmodus) auf einem eigenen Hintergrundfenster
// abspielen. Dieses Spielfenster kann verschiedenen Eignern
(TWinControl)
// zugewiesen werden. Für das folgende Beispiel setzt man einen TMediaPlayer,
// ein TPanel und drei TButton auf eine Form. Wählt man als Größe "
Stretch", wird
// das Video auf Eignergröße gedehnt sowie x und y mißachtet. Ansonsten wird
// das Seitenverhältnis beachtet und das Video bei x und y
(immer auf den Eigner
// bezogen) abgebildet, es sei denn, eine dieser beiden Variablen hat den Wert
// MAXINT, dann wird das Video entsprechend auf Eignermitte gezogen. Mit
// "
Anpassen" wird der Abspielhintergrund der Videogröße angepasst, sonst nimmt
// dieses Hintergrundfenster den ganzen Eigner ein. Ist das Video zu Ende, wird
// sein Abspielfenster geschlossen, es sei denn, man hat "
Loop" auf "True"
// gesetzt, um eine Endlosschleife zu spielen. Das Abspielen kann jederzeit mit
//
ESC beendet werden. Softwareseitig kann man dazu auch die Prozedur "schliessen"
// aufrufen. Mit dem Faktor "
Korrektur" kann das Bild gestreckt oder gestaucht
// werden
(manche Videos werden in doppelter Breite abgespielt). Korrekturwerte
// zwischen 0 und 1 machen das Bild schmaler, Werte über 1 breiter.
// Die Prozeduren "
FormClose" und "FormKeyPress" werden gleichermaßen vom
// Programmfenster und vom Videofenster benutzt.
// Siehe auch:
Videos mit MCISendString abspielen

// Getestet mit D4 unter WinME

unit av; 
 
interface 
 
uses 
  Windows, 
  SysUtils, 
  Classes, 
  Controls, 
  Forms, 
  MPlayer, 
  StdCtrls, 
  ExtCtrls; 
 
type // bestimmt die Video-Größe 
  BildForm = (Normal, Einpassen, Stretch, Doppelt, Dreifach, Halb, Drittel); 
 
  TForm1 = class(TForm) 
    MediaPlayer1: TMediaPlayer; 
    Button1: TButton; 
    Button2: TButton; 
    Button3: TButton; 
    Panel1: TPanel; 
    // ----- im Objektinspektor erzeugen ----- 
    procedure Button1Click(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
    procedure Button3Click(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    procedure FormClose(Sender: TObject; var Action: TCloseAction); 
    procedure FormDestroy(Sender: TObject); 
    procedure FormKeyPress(Sender: TObject; var Key: Char); 
    procedure MediaPlayer1Notify(Sender: TObject); 
    // ----------------------------------------- 
  private 
    { Private-Deklarationen } 
  public 
    procedure PlayVideo(Video: string; Groesse: BildForm; Anpassen: boolean; 
      x, y: integer; Eigner: TWinControl; Korrektur: Single; Loop: Boolean); 
    function BerechneRect(r: TRect; Groesse: BildForm; Anpassen: boolean; 
      x, y: integer; Eigner: TWinControl; Korrektur: Single): TRect; 
    procedure beenden; 
    procedure schliessen; 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
var 
  VideoForm: TForm; 
 
const 
  sperre: boolean = false; 
  weiter: boolean = false; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  keypreview := true; 
  VideoForm := TForm.create(self); 
  VideoForm.OnKeypress := FormKeyPress; 
  VideoForm.OnClose := FormClose; 
  VideoForm.borderstyle := bsnone; 
  VideoForm.color := 0; 
  VideoForm.cursor := crNone; // bei Bedarf 
  VideoForm.doublebuffered := true; 
  mediaplayer1.visible := false; 
  mediaplayer1.autoRewind := true; 
  mediaplayer1.display := VideoForm; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  VideoForm.free; 
end; 
 
procedure TForm1.beenden; 
begin 
  try 
    MediaPlayer1.stop; 
    Mediaplayer1.close; 
  except 
  end; 
end; 
 
function TForm1.BerechneRect(r: TRect; Groesse: BildForm; Anpassen: boolean; 
  x, y: integer; Eigner: TWinControl; Korrektur: Single): TRect; 
var 
  faktor: Single; 
  breit, hoch, links, oben: integer; 
begin 
  if Eigner <> nil then begin 
    breit := Eigner.clientwidth; 
    hoch := Eigner.clientheight; 
  end else begin 
    breit := screen.width; 
    hoch := screen.height; 
  end; 
  if korrektur > 0 then 
    r.right := round(r.right * korrektur); 
  case groesse of 
    doppelt: begin 
        r.right := r.right * 2; 
        r.bottom := r.bottom * 2; 
      end; 
    dreifach: begin 
        r.right := r.right * 3; 
        r.bottom := r.bottom * 3; 
      end; 
    halb: begin 
        r.right := r.right div 2; 
        r.bottom := r.bottom div 2; 
      end; 
    drittel: begin 
        r.right := r.right div 3; 
        r.bottom := r.bottom div 3; 
      end; 
    Einpassen: begin 
        faktor := r.right / r.bottom; 
        if faktor < breit / hoch 
          then begin 
          r.bottom := hoch; 
          r.right := Trunc(hoch * faktor); 
        end else begin 
          r.right := breit; 
          r.bottom := Trunc(breit / faktor); 
        end; 
      end; 
  end; 
  if anpassen then begin 
    if (abs(x) = maxint) then links := (breit - r.right) div 2 
    else links := x; 
    if (abs(y) = maxint) then oben := (hoch - r.bottom) div 2 
    else oben := y; 
    VideoForm.SetBounds(links, oben, r.right, r.bottom); 
    x := 0; 
    y := 0; 
  end; 
  if (abs(x) = maxint) then links := (VideoForm.width - r.right) div 2 
  else links := x; 
  if (abs(y) = maxint) then oben := (VideoForm.height - r.bottom) div 2 
  else oben := y; 
  result := rect(links, oben, r.right, r.bottom) 
end; 
 
procedure TForm1.PlayVideo(Video: string; Groesse: BildForm; Anpassen: 
  boolean; x, y: integer; Eigner: TWinControl; Korrektur: Single;
  Loop: Boolean); 
begin 
  if fileexists(Video) then begin 
    sperre := true; 
    VideoForm.visible := false; 
    beenden; 
    VideoForm.parent := Eigner; 
    weiter := loop; 
    if Eigner <> nil then 
      SetWindowPos(VideoForm.handle, HWND_TOP, 0, 0, Eigner.clientwidth, 
        Eigner.clientheight, SWP_SHOWWINDOW or SWP_NOACTIVATE) 
    else 
      SetWindowPos(VideoForm.handle, HWND_TOPMOST, 0, 0, screen.width, 
        screen.height, SWP_SHOWWINDOW); 
    VideoForm.show; 
    with mediaplayer1 do begin 
      filename := Video; 
      open; 
      if Groesse = Stretch then 
        displayrect := display.clientrect 
      else 
        displayrect := berechnerect(displayrect, groesse, anpassen, x, y, 
          Eigner, Korrektur); 
      VideoForm.refresh; 
      play; 
    end; 
    application.processmessages; 
    sperre := false; 
  end; 
end; 
 
procedure TForm1.MediaPlayer1Notify(Sender: TObject); 
begin 
  try 
    if not sperre then 
      if weiter then MediaPlayer1.play 
      else VideoForm.close; 
  except 
  end; 
end; 
 
procedure TForm1.schliessen; 
begin 
  weiter := false; 
  beenden; 
end; 
 
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char); 
begin 
  if key = #27 then schliessen; 
end; 
 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); 
begin 
  schliessen; 
end; 
 

// Video als Schleife und Vollbild abspielen 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  playvideo('d:\mzs\images\neu-4.avi', einpassen, false, maxint, maxint, nil, 
    1, true); 
end; 
 
// Video auf Form1 25 Pixel vom linken Rand und in mittlerer Höhe 
// in halber Größe abspielen 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  playvideo('d:\mzs\images\neu-4.avi', halb, true, 25, maxint, self, 
    0, false); 
end; 
 
// Video horizontal vermittelt auf Panel1 mit 
// Korrektur (um die Hälfte schmaler) abspielen 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  playvideo('d:\mzs\images\neu-4.avi', normal, false, maxint, 0, Panel1, 
    0.5, false); 
end; 

 
end.



Zugriffe seit 6.9.2001 auf Delphi-Ecke