MediaPanelyzer

Media-Panelyzer-Tutorial von Daniel Schwamm (21.01.2009 - 02.02.2009)

Inhalt

1. Medienvielfalt und die Antwort

Die nächsten zwei Wochen habe ich Urlaub. Gute Gelegenheit, ein neues Tutorial an den Start zu bringen.

1.1. MediaPanelyzer als Collage-Generator

Diesmal soll demonstriert werden, wie man kleine Fenster ("Panels") mit Bilder oder Filme ("Media") füllen kann. Anschliessend lassen sich diese "Media-Panels" auf verschiedene Arten auf dem Bildschirm arrangieren.

1.2. Bilder und Movies frei arrangierbar

Dies erlaubt das Betrachten mehrerer Bilder und/oder Movies auf einmal. Man kann "Foto-Tapeten" bilden, etwa mit den Schnappschüssen vom letzten Ägypten-Urlaub. Diese lassen sich nachträglich jederzeit ummodelieren. Und Movies müssen nicht länger hintereinander, sondern können auch parallel zueinander angesehen werden.

MediaPanelyzer ist genau das richtige für mediengeile Freaks, die gar nicht genug Infos auf einmal bekommen können. Also für solche Typen wie mich :-)

Delphi-Tutorials - MediaPanelyzer - Screenshot of a running MediaPanelyzer
Demo-Screenshot vom MediaPanelyzer: Alle Medien im Griff und auf einem Blick.

2. Programmierung von MediaPanelyzer

2.1. Zwei Units genügen

MediaPanelyzer wurde mit Delphi 7 programmiert. Es werden keine Fremdkomponenten verwendet. Die Registry wird nicht geändert. Das Projekt kommt mit nur zwei Units aus.

Delphi-Tutorials - MediaPanelyzer - Two Delphi-Form-Units for the MediaPanelyzer
Zwei Form-Units für MediaPanelyzer: Unit 'mainu.pas' mit dem Formular 'TMainF' (oben) und Unit 'coldimu.pas' mit dem Formular 'TColDimF' (unten).

2.2. Unit "mainu.pas"

2.2.1. "TMovP" - die "TPanel"-Klasse für Movies

Gehen wir direkt in den Source der Unit "mainu.pas". Hier finden wir die Deklaration der Klasse "TMovP", die von "TPanel" abgeleitet wird. Sie kapselt die Funktionalität für "Movie-Media-Panels". Jede Instanz von "TMovP" kann eine eigene Film-Datei anzeigen und verwalten.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
//Movie-Panel-Class
  TMovP=class(tpanel)
  public
    video:TMediaPlayer;  //media player
    DisplayP:tpanel;     //display-panel for video
    ctrlp:tpanel;        //control-panel with buttons+scrollbar
    startb:tbutton;      //start-button
    haltb:tbutton;       //stop-button
    sb:tscrollbar;       //scrollbar for seek in video
    sb_t:ttimer;         //timer to update scrollbar
    hint_len:string;     //hint: length of video
    hint_frames:string;  //hint: number of frames of video

    constructor Create(AOwner:TComponent);override;
    destructor Destroy;override;
    procedure resize;override;
    procedure startbClick(Sender: TObject);
    procedure haltbClick(Sender: TObject);
    procedure sb_tTimer(Sender: TObject);
    procedure sbScroll(
      Sender:TObject;
      ScrollCode:TScrollCode;
      var ScrollPos:Integer
    );
    procedure Volume_set(Volume:Integer);
    function Volume_get:Integer;
    function open(fn:string):bool;
  end;
2.2.1.1. Aufbau

Das Movie-Panel "TMovP" ist folgendermassen aufgebaut:

Delphi-Tutorials - MediaPanelyzer - Construction of the TPanel-Objekt TMovP
Aufbau vom 'TPanel'-Objekt 'TMovP': Ein 'Movie-Panels' setzt sich aus mehreren Komponenten zusammen: Ein Display-Panel für die Anzeige, Buttons zum Starten und Anhalten von Filmen, die ScrollBar für die Positionsanzeige ...
2.2.1.2. Konstruktor & Destruktor

Erzeugt werden die "Einzelteile" von "TMovP" zur Laufzeit im Konstruktor. Neben diversen Panels und Buttons wird ein Timer "sb_t" für die ScrollBar eingerichtet. Nicht ganz unwichtig ist natürlich auch die Instanz der "TMediaPlayer"-Komponente "video". Über den Destruktor werden die einzelnen Komponenten umgekehrt später wieder zerstört und aus dem Speicher entfernt.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082
00083
00084
00085
00086
00087
constructor TMovP.Create(AOwner:TComponent);
const
  _bdim=18;
begin
  inherited;

  //little border needed for shape
  left:=2;
  top:=2;
  BevelInner:=bvnone;
  BevelOuter:=bvnone;

  //create movie-control-panel as child of movp
  ctrlp:=tpanel.create(self);
  ctrlp.BevelInner:=bvnone;
  ctrlp.BevelOuter:=bvnone;
  ctrlp.Align:=albottom;
  ctrlp.height:=_bdim+2;
  ctrlp.ParentBackground:=false;
  ctrlp.Color:=clsilver;
  ctrlp.Parent:=self;

  //movie-start-button on ctrlp
  startb:=tbutton.Create(self);
  startb.left:=1;
  startb.top:=1;
  startb.width:=_bdim;
  startb.Height:=_bdim;
  startb.caption:='S';
  startb.hint:='Start';
  startb.onclick:=startbclick;
  startb.parent:=ctrlp;

  //movie-halt-button on ctrlp
  haltb:=tbutton.Create(self);
  haltb.left:=1+_bdim+1;
  haltb.top:=1;
  haltb.width:=_bdim;
  haltb.Height:=_bdim;
  haltb.caption:='H';
  haltb.hint:='Halt';
  haltb.onclick:=haltbclick;
  haltb.enabled:=false; //movie is not running after create
  haltb.parent:=ctrlp;

  //movie-scrollbar on ctrlp
  sb:=tscrollbar.Create(self);
  sb.left:=1+_bdim+1+_bdim+1;
  sb.top:=2;
  sb.height:=_bdim-4;
  sb.OnScroll:=sbscroll;
  sb.parent:=ctrlp;

  //the scrollbar-timer
  sb_t:=ttimer.Create(self);
  sb_t.Interval:=100;
  sb_t.enabled:=false;
  sb_t.ontimer:=sb_ttimer;

  //movie-display-panel as child of movp
  DisplayP:=tpanel.Create(self);
  DisplayP.BevelInner:=bvnone;
  DisplayP.BevelOuter:=bvnone;
  DisplayP.align:=alclient;
  DisplayP.ParentBackground:=false;
  DisplayP.Color:=clblack;
  DisplayP.parent:=self;

  //create TMediaPlayer
  video:=TMediaPlayer.create(self);
  video.Shareable:=true;
  video.Visible:=false;
  video.Parent:=self;
end;

destructor TMovP.Destroy;
begin
  haltbclick(nil);
  video.free;
  startb.Free;
  haltb.Free;
  sb.Free;
  sb_t.free;
  ctrlp.free;
  DisplayP.free;
  inherited;
end;

Ändert sich die Grösse des "TMovP"-Objekts, müssen Video-Display und ScrollBar-Breite entsprechend angepasst werden. Dies geschieht durch Überschreiben des "OnResize"-Ereignisses von "TPanel":

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
//movp is resizing
procedure TMovP.resize;
var
  rec:trect;
begin
  inherited;

  //adapt size of movie-display-panel
  rec.top:=0;
  rec.left:=0;
  rec.right:=DisplayP.width;
  rec.bottom:=DisplayP.height;
  video.displayrect:=rec;

  //adapt size of scrollbar
  sb.width:=ctrlp.width-(haltb.left+haltb.width)-5;
end;
2.2.1.3. ScrollBar und Movie-Synchronisation

Der ScrollBar-Timer "sb_t" wird aktiviert, sowie ein Movie abgespielt wird. Alle 100 ms wird daraufhin die aktuelle Frame-Position des Films abgefragt ("video.position") und die ScrollBar dazu synchronisiert. Ist das Ende des Films schliesslich erreicht, wird automatisch zurückgespult und von vorne begonnen.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
procedure TMovP.sb_tTimer(Sender: TObject);
begin
  //avoid positioning while scrolling
  if sb_t.tag<>0 then exit;

  try
    sb.Position:=video.position;
    //video reach end?
    if sb.position>=sb.max-1 then begin
      //start playing again
      video.rewind;
      sb.Position:=0;
      startbClick(sender);
    end;
  except
  end;
end;
2.2.1.4. Positionierung im Movie

Die Positionierung in der ScrollBar kann jederzeit vom Benutzer per Maus geändert werden. Im Film wird demgemäss vor- oder zurückgespult. Sowie der Mausbutton wieder losgelassen wird, läuft der Film weiter. Realisiert wird das über das "OnScroll"-Ereignis von "sb", welches "sbScroll" aufruft:

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
//scrolling of scrollbar
procedure TMovP.sbScroll(
  Sender:TObject;
  ScrollCode:TScrollCode;
  var ScrollPos:Integer
);
var
  i:integer;
begin
  //mark scrolling for sb_t
  sb_t.tag:=1;

  //seek video and scrollbar to scroll-position
  i:=scrollpos;
  if i<0 then i:=0;
  if i>=video.length then i:=video.length-1;
  sb.Position:=i;
  video.position:=i;

  //scrolling ready?
  if scrollcode=scEndScroll then begin
    //mark end of scrolling
    sb_t.tag:=0;

    //run movie if it is not stopped
    if sb_t.enabled then begin
      //avoid strange exception if video reach end
      if i<sb.Max then startbclick(sender);
    end;
  end;
end;

Unter Windows Vista kam es bei mir erstaunlicherweise zu Fehlermeldungen der "TMediaPlayer"-Komponente, wenn der Benutzer bis ganz nach rechts scrollte und der Film dann weiterlief ("Ungültige Gleitkomma-Operation"). Verhindern lässt sich das, indem die Position im Movie in diesem Fall stets um einen Frame nach vorne korrigiert wird ("video.length-1").

Über das "Tag"-Attribut von "sb" wird zudem signalisiert, ob gerade manuell gescrollt wird. Das vermeidet unschöne Überschneidungen mit den automatisierten Scroll-Aktionen des "OnTimer"-Ereignisses von "sb_t". Ist das Tag gesetzt, wird die zugehörige Funktion dort sofort wieder verlassen (siehe "sb_tTimer" weiter oben).

2.2.1.5. Movies starten & stoppen

Über die Buttons "startb" und "stopb" kann die eingebundene Film-Datei von "TMovP" gestartet oder angehalten werden. Die Knöpfe und der ScrollBar-Timer werden in passender Weise an- und abgeschaltet. Die zugehörigen Prozeduren sind:

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
//start-button: play movie
procedure TMovP.startbClick(Sender: TObject);
begin
  if video=nil then exit;
  try
    video.Play;
    sb_t.tag:=0;
    sb_t.enabled:=true;
    startb.Enabled:=false;
    haltb.Enabled:=true;
  except
  end;
end;

//halt-button: stop movie
procedure TMovP.haltbClick(Sender: TObject);
begin
  if video=nil then exit;
  sb_t.enabled:=false;
  startb.Enabled:=true;
  haltb.Enabled:=false;
  try
    video.stop;
  except
  end;
end;
2.2.1.6. Movie-Sound-Handling

Da Filme teilweise über Sound verfügen, kann dieser später per Menü-Aufruf deaktiviert bzw. wieder aktiviert werden. Dazu dienen die Funktionen "volume_get" und "volume_set". Die habe ich im Web gefunden. Sie fallen recht umfangreich aus, bieten aber einen besonderen Vorteil: Sie wirken sich nur auf das Movie des betreffenden "TMovP"-Objekts aus, nicht jedoch auf andere Filme, die möglicherweise zur selben Zeit abgespielt werden!

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
const
  //***********************************************************************
  //TMovP
  //***********************************************************************
  _mov_sound               = $0873;
  _mov_sound_volume        = $4002;
  _mov_sound_item          = $00800000;
  _mov_sound_value         = $01000000;
  _mov_sound_status_volume = $4019;

type
  //***********************************************************************
  //TMovP
  //***********************************************************************
  //record for movie-sound-parameters
  tmov_sound_params=record
    dwCallback:DWORD;
    dwItem:DWORD;
    dwValue:DWORD;
    dwOver:DWORD;
    lpstrAlgorithm:PChar;
    lpstrQuality:PChar;
  end;

[...]

implementation

//get sound volume, range 0-1000
function TMovP.Volume_get:Integer;
var
  p:MCI_STATUS_PARMS;
begin
  result:=0;if video=nil then exit;
  p.dwCallback:=0;
  p.dwItem:=_mov_sound_volume;
  mciSendCommand(
    video.DeviceID,
    MCI_STATUS,
    MCI_STATUS_ITEM,
    Cardinal(@p)
  );
  Result:=p.dwReturn;
end;

//Set Volume, range 0-1000
procedure TMovP.Volume_set(Volume:Integer);
var
  map:tmov_sound_params;
begin
  if video=nil then exit;
  map.dwCallback:=0;
  map.dwItem:=_mov_sound_volume;
  map.dwValue:=Volume;
  map.dwOver:=0;
  map.lpstrAlgorithm:=nil;
  map.lpstrQuality:=nil;
  mciSendCommand(
    video.DeviceID,
    _mov_sound,
    _mov_sound_value or _mov_sound_item,
    Cardinal(@map)
  );
end;
2.2.1.7. Movie öffnen

Die "open"-Funktion bindet eine bestimmte Movie-Datei an die "TMovP"-Instanz. Die "TMediaPlayer"-Komponente "video" wird dazu entsprechend initialisiert. Misslingt dies, wird eine Exception ausgeworfen. Ansonsten wird über die Aufrufe von "video.step" und "video.previous" dafür gesorgt, dass das erste Frame des Films auf dem "DisplayP"-Panel angezeigt wird. So kann der Benutzer später den Inhalt leichter abschätzen, auch wenn der Film (noch) nicht abgespielt wird. Anschliessend wird das ScrollBar-Maximum an die Video-Länge angepasst. Zuletzt werden noch einige Informationen über Länge und Anzahl der Film-Frames in den Hint-Strings gesichert.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
//open a movie-file
function TMovP.open(fn:string):bool;
begin
  result:=false;
  try
    video.FileName:=fn;
    video.Display:=DisplayP;
    video.Open;

    //show first movie-frame
    video.Step;
    video.Previous;

    //set movie-scrollbar parameters
    sb.position:=0;
    sb.Max:=video.length;

    //set hint-infos
    video.TimeFormat:=tfmilliseconds;
    hint_len:='Filmdauer: '+inttostr(round(video.Length/1000))+' Sekunden';
    video.TimeFormat:=tfframes;
    hint_frames:='Anzahl Frames: '+inttostr(video.Length);

    result:=true;
  except
    mainf.error('Keine gültige Movie-Datei: '+fn);
  end;
end;
Delphi-Tutorials - MediaPanelyzer - TMovP-Instance with opened movie-file
TMovP-Instanz mit geöffneter Filmdatei: Eine 'TMovP'-Instanz zeigt uns hier gerade Milla Jovovich in einem ihrer Filme. Die ScrollBar lässt erkennen, dass wir uns im vorderen Drittel des Filmes befinden.

2.2.2. "TMediaP" - die "TPanel"-Klasse für allgemeine Medien-Inhalte

Die nächste Deklaration in der Unit "mainu.pas" ist die Klasse "TMediaP". Sie ist ebenso wie wie "TMovP" von "TPanel" abgeleitet. Eine Instanz von "TMediaP" kann entweder ein Bild oder aber ein Movie beherbergen, wobei Letzteres als "TMovP" integriert wird (siehe vorherigen Abschnitt).

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
//***********************************************************************
//TMediaP: Media-Panel, contains image (img) or movie-panel (movp)
//***********************************************************************
TMediaP=class(tpanel)
public
  afn:string;      //filename of media

  //strings, necessary for design-sort
  ds_alpha:string;
  ds_size:string;
  ds_chrono:string;

  img:timage; //image-holder
  movp:TMovP; //movie-holder
  sh:tshape;  //active-border-shape

  //original dimension of media
  sz_org_width,
  sz_org_height:integer;

  //aspect ration: height/width
  sz_aspect:double;

  constructor Create(AOwner:TComponent);override;
  destructor Destroy;override;
  procedure resize;override;
  procedure event_MouseDown(
    Sender:TObject;
    Button:TMouseButton;
    Shift:TShiftState;
    X,Y:Integer
  );
  procedure event_MouseMove(
    Sender:TObject;
    Shift:TShiftState;
    X,Y:Integer
  );
  procedure sz_set(v:integer;heightok:bool);
  function open(fn:string):bool;
end;
2.2.2.1. Aufbau

Der Aufbau des "TMediaP"-Objekts sieht folgendermassen aus:

Delphi-Tutorials - MediaPanelyzer - Construction of the 'TMediaP'-Object
Aufbau eines 'TMediaP'-Objekts: Ein 'TMediaP'-Objekt setzte sich aus mehreren Bestandteilen zusammen. Integriert ist z.B. eine 'TImage'-Komponente von Delphi für die Wiedergabe von Bildern. Ausserdem gibt es die von uns entwickelte 'TMovP'-Komponente, über die eine mögliche Film-Datei verwaltet werden kann.
2.2.2.2. Konstruktor & Destruktor

Wird eine Instanz von "TMediaP" erzeugt, ist diese zunächst "leer", d.h., "img" und "movp" werden auf "nil" gesetzt. Die Position des Objekts wird zufällig bestimmt, befindet sich aber stets im oberen linken Drittel von "TMainF". Die Attribute Höhe und Breite erhalten dagegen einen Standard-Wert, der sich an eventuell bereits vorhandenen Instanzen von "TMediaP" orientiert ("mainf.object_height").

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
constructor TMediaP.Create(AOwner: TComponent);
begin
  inherited;

  parentbackground:=false;color:=clblack;
  bevelouter:=bvnone;

  //clear image- and movie-holder
  img:=nil;
  movp:=nil;

  //random position on mainf
  top:=random(screen.height div 3);
  left:=random(screen.width div 3);

  //set standard-dimension
  width:=mainf.object_height;
  height:=mainf.object_height;

  //create shape for selection
  sh:=tshape.create(self);
  sh.Parent:=self;
  sh.Brush.Style:=bsclear;
  sh.Pen.style:=pssolid;
  sh.Pen.color:=cllime;
  sh.Pen.Width:=2;
  sh.align:=alclient;
  sh.onmousedown:=event_mousedown;
  sh.onmousemove:=event_mousemove;
  sh.Visible:=false;

  onmousedown:=event_mousedown;

  //set new mediap as active object
  mainf.sh_off;
  mainf.amp:=self;

  showhint:=true;
  parent:=mainf;
end;

destructor TMediaP.Destroy;
begin
  if sh<>nil then sh.Free;
  if img<>nil then img.Free;
  if movp<>nil then movp.Free;
  inherited;
end;
2.2.2.3. Resizing

Beim "OnResize"-Ereignis von "TMediaP" muss das eventuell vorhandenes "TMovP"-Objekt ebenfalls modifiziert werden. Denn dieses wird stets einen Tick kleiner dimensioniert, damit genügend Platz für den Aktivierungsrahmen "sh" bleibt:

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
//resizing of media-panel
procedure TMediaP.resize;
begin
  inherited;

  //not a movie? Nothing to do
  if movp=nil then exit;

  //adapt size of mov_p a little smaller than mediap
  //(align=client not possible because of shape-border)
  movp.Height:=clientheight-4;
  movp.width:=clientwidth-4;
end;
2.2.2.4. Verschieben zur Laufzeit

Eine Besonderheit von "TMediaP" gegenüber einem gewöhnlichen "TPanel" ist, dass es vom Benutzer jederzeit per Maus verschoben und/oder seine Grösse variiert werden kann. Dies wird über die Ereignisse "OnMouseMove" und "OnMouseDown" implementiert:

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082
00083
00084
00085
00086
00087
00088
00089
00090
00091
00092
00093
00094
00095
00096
00097
00098
procedure TMediaP.event_MouseDown(
  Sender:TObject;
  Button:TMouseButton;
  Shift:TShiftState;
  X,Y:Integer
);
const
  _sz_left        = $f001;
  _sz_right       = $f002;
  _sz_top         = $f003;
  _sz_top_left    = $f004;
  _sz_top_right   = $f005;
  _sz_bottom      = $f006;
  _sz_bottom_left = $f007;
  _sz_bottom_right= $f008;
  _sz_move        = $f012;
var
  mp:TMediaP;
  cmd,mh,mw:integer;
  cu:tcursor;
begin
  mp:=self;

  //set mediap as active object
  cu:=mp.Cursor;
  mainf.sh_off;
  mainf.amp:=mp;
  mp.Cursor:=cu;
  mp.sh.Visible:=true;

  //right-click? then exit
  if shift=[ssright]then exit;

  //check if mouse is over size-change-point
  mh:=mp.height div 2;
  mw:=mp.width div 2;

  //init resizing/positioning of mediap
  cmd:=_sz_move;
  if mp.cursor=crsizenwse then
    if y<mh then cmd:=_sz_top_left else cmd:=_sz_bottom_right
  else if mp.cursor=crsizens then
    if y<mh then cmd:=_sz_top else cmd:=_sz_bottom
  else if mp.cursor=crsizewe then
    if x<mw then cmd:=_sz_left else cmd:=_sz_right
  else if mp.cursor=crsizenesw then
    if y<mh then cmd:=_sz_top_right else cmd:=_sz_bottom_left;
  sendmessage(mp.Handle,wm_syscommand,cmd,0);
end;

procedure TMediaP.event_MouseMove(
  Sender:TObject;
  Shift:TShiftState;
  X,Y:Integer
);
var
  mh,mw,ww,hh:integer;
  mp:TMediaP;
begin
  //right-click? then exit
  if shift=[ssright]then exit;

  //am i the active object? if not, then exit
  mp:=self;if mainf.amp<>mp then exit;

  //check if mouse is over size-change-point
  mh:=mp.height div 2;
  mw:=mp.width div 2;
  ww:=mp.width div 10+1;
  hh:=mp.Height div 10+1;

  if (x<ww)and(y<hh) then
    mp.Cursor:=crSizeNWSE
  else if (x>mw-ww)and(x<mw+ww)and(y<hh) then
    mp.cursor:=crsizens
  else if (x>mp.width-ww)and(y<Hh) then
    mp.cursor:=crsizenesw
  else if (x>mp.width-ww)and(y>mh-hh)and(y<mh+hh) then
    mp.cursor:=crsizewe
  else if (x>mp.width-ww)and(y>mp.Height-hh) then
    mp.cursor:=crsizenwse
  else if (x>mw-ww)and(x<mw+ww)and(y>mp.height-hh) then
    mp.cursor:=crsizens
  else if (x<ww)and(y>mp.Height-hh) then
    mp.Cursor:=crSizeNeSw
  else if (x<ww)and(y>mh-hh)and(y<mh+hh) then
    mp.cursor:=crsizewe
  else
    mp.cursor:=crsizeall;

  //set calculated cursor to child-controls
  mp.sh.Cursor:=mp.cursor;
  if mp.movp<>nil then mp.movp.DisplayP.Cursor:=mp.cursor;
  if mp.img<>nil then mp.img.Cursor:=mp.cursor;

  //refresh (new) aspect ratio
  sz_aspect:=clientheight/clientwidth;
end;

In der Prozedur "event_MouseMove" wird zunächst geprüft, ob das "TMediaP" aktiv ist, sprich, zuvor vom Benutzer angeklickt wurde. Ist dies der Fall, wird anhand der Mausposition ein passender Cursor definiert: Befindet sich die Maus etwa mittig auf der unteren Kante, wechselt der Cursor zu einem "Hoch-Runter"-Pfeil, mittig links zum "Links-Rechts"-Pfeil, weiter über dem Panel zum "Drag-Kreuz"-Cursor usw.

In der Prozedur "event_MouseDown" bewirkt dann diese Cursor-Auswahl weiter, welche Aktion vorgenommen wird, ob also das Panel als Ganzes verschoben wird oder sich die Lage bestimmter Eck- oder Kantenpunkte und damit die Grösse des Panels ändert.

2.2.2.5. Grössenänderung zur Laufzeit

Die Ausmasse von "TMediaP" können alternativ auch per Funktionsaufruf geändert werden. Die Prozedur "sz_set" bekommt dafür einen Zahlenwert "v" übergeben, der entweder die neue Höhe oder die neue Breite vorgibt. Wir verwenden das Höhe-Breite-Verhältnis der Original-Dimensionen, um aus der Breite die Höhe berechnen zu können bzw. umgekehrt aus der Höhe die Breite. Zu beachten ist, dass im Falle eines integrierten "TMovP"-Objekts der Höhenwert von "TMediaP" auch die Höhe des Kontrollpanels "ctrlp" berücksichtigt.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
//modify size of media-panel in proportional way
procedure TMediaP.sz_set(v:integer;heightok:bool);
var
  ow,oh,cw,ch:integer;
begin
  mainf.collection_chgok:=true;
  if movp<>nil then begin
    //movie: height regards control-height
    ow:=sz_org_width;
    oh:=sz_org_height+movp.ctrlp.Height;
  end
  else begin
    ow:=sz_org_width;
    oh:=sz_org_height;
  end;

  //error dimension
  if (ow=0)or(oh=0) then exit;

  if heightok then begin
    //height is fix, calculate width
    ch:=v;
    cw:=round((ow*(ch))/oh);
  end
  else begin
    //width is fix, calculate height
    cw:=v;
    ch:=trunc((cw*oh)/ow);
  end;

  //set new height
  clientheight:=ch;
  clientwidth:=cw;
  sz_aspect:=ch/cw;
end;
2.2.2.6. Medien-Datei öffnen

Die letzte Funktion von "TMediaP", "open", füllt ein "TMediaP"-Objekt mit einem Bild oder einem Movie, je nachdem, was als Datei-Namen "fn" übergeben wird. Der Dateityp wird dazu über die "TMainF"-Funktionen "is_pic" bzw. "is_mov" anhand der File-Extension ermittelt (siehe weiter unten). Dateiname, Dateigrösse und Dateidatum werden in normierter Weise in "design_sort"-Strings gespeichert. Diese dienen später als Vergleichsgrösse für die "design_sort"-Operationen.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082
00083
00084
00085
00086
00087
00088
00089
00090
00091
00092
00093
00094
00095
00096
00097
00098
00099
00100
00101
00102
00103
00104
00105
00106
00107
00108
00109
00110
00111
00112
00113
00114
00115
00116
00117
00118
00119
00120
00121
00122
00123
00124
00125
00126
00127
00128
//open a media-file
function TMediaP.open(fn:string):bool;
var
  sr:WIN32_FIND_DATA;
  status:thandle;
  t:tfiletime;
  st:tsystemtime;
  dt:tdatetime;
begin
  result:=false;

  if not fileexists(fn) then begin
    mainf.error(
      'Datei'+_cr+_cr+
      '  '+fn+_cr+_cr+
      'existiert nicht (mehr)!'
    );
    exit;
  end;

  //is media a picture?
  if mainf.is_pic(fn) then begin
    try
      //create image as child of TMediaP
      img:=timage.create(self);
      img.align:=alclient;
      img.Stretch:=true;
      img.Proportional:=false;
      img.center:=false;
      img.onmousedown:=event_mousedown;
      img.Parent:=self;

      //read the picture
      img.Picture.loadfromfile(fn);

      //save original dimension
      sz_org_width:=img.Picture.Width;
      sz_org_height:=img.Picture.height;

    except
      //something goes wrong
      mainf.error('Keine gültige Bild-Datei: '+fn);
      exit;
    end;
  end
  //is media a movie?
  else if mainf.is_mov(fn) then begin
    movp:=TMovP.Create(self);
    movp.DisplayP.onmousedown:=event_mousedown;
    movp.DisplayP.onmousemove:=event_mousemove;
    movp.Visible:=false;
    movp.Parent:=self;

    //open the movie-file, check for success
    if not movp.open(fn) then exit;

    //save original dimension
    movp.Visible:=true;
    sz_org_width:=movp.video.displayrect.Right;
    sz_org_height:=movp.video.displayrect.bottom;

    hint:=movp.Hint;
  end
  else begin
    //unkonw media
    mainf.error('Ungültige Medien-Datei: '+fn);
    exit;
  end;

  //get infos from file for design_sort
  status:=findfirstfile(pchar(fn),sr);
  try
    if status=INVALID_HANDLE_VALUE then exit;

    //norm filename fopr alphabetic sort
    ds_alpha:=ansilowercase(extractfilename(fn));

    //fill size width zeros in front because of size order
    ds_size:=mainf.str_fill(
      inttostr(
        int64(
          int64(sr.nFileSizeHigh*MAXDWORD)+
          sr.nFileSizeLow
        )
      ),
      20
    );

    //file-age in american style because of sort order
    try
      filetimetolocalfiletime(sr.ftLastWriteTime,t);
      filetimetosystemtime(t,st);
      dt:=SystemTimeToDateTime(st);
    except
      dt:=0;
    end;
    ds_chrono:=formatdatetime('yyyymmdd hhnnss',dt);
  finally
    windows.findClose(status);
  end;

  //adapt size of display
  sz_set(mainf.object_height,true);
  sz_aspect:=clientheight/clientwidth;

  //media is okay
  afn:=fn;

  hint:=
    'Datei: '+fn+_cr+
    'Auflösung: '+inttostr(sz_org_width)+' x '+inttostr(sz_org_height)+' Pixel';
  if movp<>nil then begin
    hint:=
      hint+_cr+
      movp.hint_frames+_cr+
      movp.hint_len;
  end;
  hint:=
    hint+_cr+
    '----------------------------------'+_cr+
    'Alpha: '+ds_alpha+_cr+
    'Chrono: '+ds_chrono+_cr+
    'Grösse: '+ds_size+' Bytes';

  resize;
  sh.BringToFront;
  result:=true;
end;
Delphi-Tutorials - MediaPanelyzer - Demonstration of four TMediaP'-Objects
Vier gefüllte 'TMediaP'-Objekte: Wir sehen hier einmal Christina Applegate als Movie-'TMediaP'-Objekt und dreimal Catherine Bell als Image-'TMediaP'-Objekte in verschiedenen Grössen.

2.2.3. "TMainF" - die Mutter aller "TMediaP"-Objekte

2.2.3.1. Deklaration

Die letzte Klasse, die in "mainu.pas" deklariert wird, ist die von "TForm" abgeleitete "TMainF". Das ist unser Hauptfenster. Es beherbergt alle "TMediaP"-Objekte, die dynamisch erzeugt und zerstört werden können. Das Fenster ist randlos und maximiert, um den zur Verfügung stehenden Platz optimal ausnutzen zu können. Die Steuerung erfolgt per Popup-Menü bzw. den zugehörigen Tastaturkürzeln.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
//***********************************************************************
  //THauptF: contains a dynamic collection of TMediaP
  //***********************************************************************

  //design sort types
  tdesignsort=(_ds_alpha,_ds_chrono,_ds_size,_ds_random,_ds_opt);

  TMainF = class(TForm)
    pm: TPopupMenu;
    objects_openpicdlg: TOpenPictureDialog;
    design_sort_lb: TListBox;
    bordersplitter: TSplitter;
    borderp: TPanel;
    sh_t: TTimer;
    design_backgroundcolordlg: TColorDialog;
    collection_OpenDlg: TOpenDialog;
    collection_SaveDlg: TSaveDialog;
    collection_img_savepicdlg: TSavePictureDialog;
    startt: TTimer;

    //menu active object
    aobject1: TMenuItem;
    aobject_mov_start1: TMenuItem;
    aobject_mov_halt1: TMenuItem;
    aobject_mov_sound1: TMenuItem;
    aobject_separator1: TMenuItem;
    aobject_sz_aspect1: TMenuItem;
    aobject_sz_org1: TMenuItem;
    aobject_separator2: TMenuItem;
    aobject_close1: TMenuItem;

    //menu objects
    objects: TMenuItem;
    objects_open1: TMenuItem;
    objects_separator1: TMenuItem;

[...]

  public
    { Public-Deklarationen }
    homedir:string;          //homedir of application
    collection_afn:string;   //filename of active collection
    collection_chgok:bool;   //any changes on collection?
    amp:TMediaP;             //active mediap (or NIL)
    design_sort_down:bool;   //design sort direction
    object_height:integer;   //actual standard-height of objects

    //2-dimensional mediap-array for arrangements
    mp_a:array[0.._mp_max,0.._mp_max]of TMediaP;

    //service
    function is_pic(fn:string):bool;
    function is_mov(fn:string):bool;
    function str_fill(s:string;len:integer):string;
    procedure mp_a_clr;
    procedure sh_off;
    procedure info(s:string);
    procedure error(s:string);

    //object(s)
    function object_open(fn:string):bool;
    procedure object_close(mp:TMediaP);
    procedure objects_close;

    //design
    procedure design_sz(zoom:double);
    procedure design_arrange;
    procedure design_sort(ds:tdesignsort);

    //collection
    procedure collection_open(fn:string);
    procedure collection_save(fn:string);
    procedure collection_img_thumb(Src,Dst:TBitmap);
    function collection_chgok_chksave:bool;

    //history
    procedure history_go1click(sender:tobject);
  end;
Delphi-Tutorials - MediaPanelyzer - Popup-Menu of the 'TMainF'-Form
Popup-Menü der 'TMainF'-Form: Alle Operationen, die unser Programm anbietet, sind in nur einem Popup-Menü untergebracht. Platzsparend. Dadurch bliebt der komplette Platz frei für unsere 'TMediaP'-Panels frei zur Verfügung.

Die Menü-Struktur gibt auch die Reihenfolge vor, wie die Funktionen und Prozeduren von "TMainF" angeordnet wurden: Nach den allgemeinen Fenster- und Service-Funktionen folgen die Prozeduren für das aktivierte "TMediaP"-Objekt, dann die, die alle Objekte betreffen, anschliessend die Design-Funktionen usw.

2.2.3.2. Konstruktor

Direkt nach dem Programmstart wird automatisch "FormCreate" aufgerufen.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
procedure TMainF.FormCreate(Sender: TObject);
begin
  homedir:=extractfilepath(application.exename);
  parentbackground:=false;color:=clgray;
  windowstate:=wsmaximized;
  borderstyle:=bsnone;
  borderp.ParentBackground:=false;borderp.Color:=clsilver;

  objects_openpicdlg.Filter:=
    'Bilder (*.jpg;*.jpeg;*.bmp;*.ico;*.emf;*.wmf)|'+
    '*.jpg;*.jpeg;*.bmp;*.ico;*.emf;*.wmf|'+
    'Movies (*.avi;*.mpg;*.mpeg;*.m1v;*.wmv)|'+
    '*.avi;*.mpg;*.mpeg;*.m1v;*.wmv|'+
    'Alle Dateien (*.*)
|*.*';
  objects_openpicdlg.Options:=
    [ofHideReadOnly,ofAllowMultiSelect,ofFileMustExist,ofEnableSizing];

  //standard-dimension of TMediaP
  object_height:=_object_height;

  //cursor control short-cuts
  design_sz_plus1.shortcut:=shortcut(vk_down,[]);
  design_sz_minus1.shortcut:=shortcut(vk_up,[]);
  design_sz_plus_small1.shortcut:=shortcut(vk_right,[]);
  design_sz_minus_small1.shortcut:=shortcut(vk_left,[]);

  startt.enabled:=true;
end;

Es werden einige Einstellungen zum Erscheinungsbild der Applikation vorgenommen.

Danach werden die erlaubten Bild- und Film-Formate an den Öffnen-Dialog "objects_openpicdlg" übergeben. Die Liste kann hier jederzeit erweitert werden.

Des Weiteren bekommen einige Menü-Punkte noch Shortcuts zugewiesen, die die Cursor-Tasten verwenden. Diese lassen sich nämlich nicht direkt über den Objekt-Inspektor von Delphi eintragen.

Zuletzt wird der "TTimer" "startt" aktiviert und das Hauptfenster erscheint als zunächst leere Fläche.

2.2.3.3. Start per Timer

Kurz darauf "feuert" das "OnTimer"-Ereignis von "startt":

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
procedure TMainF.starttTimer(Sender: TObject);

  function dir_set(dir:string):string;
  begin
    if directoryexists(dir) then result:=dir
                            else result:=homedir;
  end;

var
  inif:tinifile;
begin
  startt.enabled:=false;

  if not _debugok then about1Click(Sender);

  inif:=tinifile.create(homedir+_inifn);
  try
    collection_afn:=inif.readstring('param','collection_afn','');
    objects_openpicdlg.InitialDir:=dir_set(
      inif.readstring('param','objects_opendlg_dir',homedir)
    );
    collection_opendlg.InitialDir:=dir_set(
      inif.readstring('param','collection_opendlg_dir',homedir)
    );
    collection_savedlg.InitialDir:=dir_set(
      inif.readstring('param','collection_savedlg_dir',homedir)
    );
    collection_img_savepicdlg.InitialDir:=dir_set(
      inif.readstring('param','collection_img_savepicdlg_dir',homedir)
    );
    Color:=inif.ReadInteger('param','color',clgray);
  finally
    inif.Free;
  end;

  //collection to load?
  if collection_afn<>'' then collection_open(collection_afn);

  sh_t.enabled:=true;
end;

Eine einfache "Willkommen"-Meldung wird zur Anzeige gebracht. Anschliessend werden verschiedene Programm-Parameter aus dem INI-File der Applikation gelesen. Und falls ein entsprechender Eintrag vorhanden ist, wird am Schluss noch die letzte Medien-Kollektion "collection_afn" eingeladen.

2.2.3.4. MediaPanelyzer beenden

Beendet werden kann MediaPanelyzer über den Menü-Punkt "Schliessen" bzw. die ESCAPE-Taste. Dies bewirkt den Aufruf von "FormCloseQuery". Hier wird geprüft, ob die aktuelle Kollektion gespeichert werden soll. Zuletzt wird in "FormDestroy" die INI-Datei der Applikation geschrieben und alle noch vorhandenen "TMediaP"-Objekte zerstört.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
procedure TMainF.close1Click(Sender: TObject);
begin
  close;
end;

procedure TMainF.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if not collection_chgok_chksave then canclose:=false;
end;

procedure TMainF.FormDestroy(Sender: TObject);
var
  inif:tinifile;
begin
  sh_t.enabled:=false;
  deletefile(homedir+_inifn);

  inif:=tinifile.create(homedir+_inifn);
  try
    inif.writestring('param','collection_afn',collection_afn);
    inif.writestring('param','objects_opendlg_dir',objects_openpicdlg.InitialDir);
    inif.writestring('param','collection_opendlg_dir',collection_opendlg.InitialDir);
    inif.writestring('param','collection_savedlg_dir',collection_savedlg.InitialDir);
    inif.writestring(
      'param',
      'collection_img_savepicdlg_dir',
      collection_img_savepicdlg.InitialDir
     );
    inif.writeinteger('param','color',color);
  finally
    inif.Free;
  end;

  //free memory
  objects_close;
end;
2.2.3.5. Maus-Ereignisse behandeln

Sehen wir uns nun die Maus-Ereignisse von "TMainF" an:

Wird auf die Form geklickt (statt auf ein "TMediaP"-Objekt), so werden im "OnClick"-Ereignis alle Objekte deaktiviert. Wird hingegen das Mausrad gedreht, ändert sich die Grösse aller vorhandenen "TMediaP"-Objekte. Ein Rechtsclick ruft das "OnPopUp"-Ereignis auf. Hier werden die Menü-Punkte aktiviert bzw. deaktiviert, je nach Programm-Status. Gibt es keine Movie-"TMediaP"-Objekte, werden zum Beispiel alle Video-Menü-Punkte abgeschaltet.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082
00083
00084
procedure TMainF.FormClick(Sender: TObject);
begin
  //disable active tmedaip
  sh_off;
end;

procedure TMainF.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  design_sz_plus_small1Click(Sender);
  handled:=true;
end;

procedure TMainF.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  design_sz_minus_small1Click(Sender);
  handled:=true;
end;

procedure TMainF.pmPopup(Sender: TObject);
var
  object_ok,mov_ok:bool;
  r:integer;
  mp:TMediaP;
begin
  //any movie-media-panels?
  object_ok:=false;
  mov_ok:=false;
  for r:=ComponentCount-1 downto 0 do begin
    if not(components[r] is TMediaP) then continue;
    mp:=TMediaP(components[r]);
    object_ok:=true;
    if mp.movp=nil then continue;
    mov_ok:=true;
    break;
  end;

  //active object
  if amp=nil then aobject1.enabled:=false
  else begin
    aobject1.enabled:=true;
    aobject_mov_start1.Enabled:=(amp.movp<>nil);
    aobject_mov_halt1.Enabled:=(amp.movp<>nil);
    aobject_mov_sound1.Enabled:=(amp.movp<>nil);

    if amp.movp<>nil then begin
      aobject_mov_start1.checked:=amp.movp.sb_t.enabled;
      aobject_mov_halt1.checked:=not aobject_mov_start1.checked;
      aobject_mov_sound1.checked:=(amp.movp.Volume_get>0);
    end;
  end;

  //objects
  objects_movs_start1.enabled:=mov_ok;
  objects_movs_halt1.enabled:=mov_ok;
  objects_movs_sound1.enabled:=mov_ok;

  objects_sz_aspect1.Enabled:=object_ok;
  objects_sz_aspect_width1.enabled:=(amp<>nil);
  objects_sz_aspect_height1.enabled:=(amp<>nil);
  objects_close1.enabled:=object_ok;

  //design
  design_sort_alpha1.Enabled:=object_ok;
  design_sort_chrono1.Enabled:=object_ok;
  design_sort_size1.Enabled:=object_ok;
  design_sort_random1.Enabled:=object_ok;
  design_sort_opt1.Enabled:=object_ok;

  design_sz_plus1.enabled:=object_ok;
  design_sz_plus_small1.enabled:=object_ok;
  design_sz_minus1.enabled:=object_ok;
  design_sz_minus_small1.enabled:=object_ok;

  //collection
  collection_save1.enabled:=object_ok and(collection_afn<>'');
  collection_saveunder1.enabled:=object_ok;
  collection_img_make1.enabled:=object_ok;
  collection_screenshot_make1.enabled:=object_ok;

  //history
  history1.Enabled:=(history1.count>0);
end;
2.2.3.6. Blinkende (aktivierte) Objekte

Der Timer "sh_t", der alle 500 ms "feuert", wird verwendet, um das aktive "TMediaP"-Objekt blinken zu lassen. Aktiv sein kann immer nur ein oder aber kein Objekt. Das aktive Objekt erhält einen eignen Menü-Punkt im Popup-Menü von "TMainF" (dazu später mehr). Über die Funktion "sh_off" lassen sich alle Objekte auf einmal deaktivieren.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
procedure TMainF.sh_tTimer(Sender: TObject);
begin
  if amp=nil then exit;
  sh_t.Tag:=(sh_t.Tag+1)mod 2;
  if sh_t.tag=0 then amp.sh.Visible:=false
                else amp.sh.visible:=true;
end;

//disable active object
procedure TMainF.sh_off;
var
  r:integer;
  mp:TMediaP;
begin
  releasecapture;
  amp:=nil;
  for r:=0 to ComponentCount-1 do begin
    if not(components[r] is TMediaP) then continue;
    mp:=TMediaP(components[r]);

    //set standard cursor for mediap and it's child-controls
    mp.Cursor:=crdefault;
    if mp.movp<>nil then mp.movp.DisplayP.cursor:=crdefault;
    if mp.img<>nil then mp.img.cursor:=crdefault;
    mp.sh.Visible:=false;
  end;
  amp:=nil;
end;
2.2.3.7. Medien-Check - Bild oder Film?

Die nächsten beiden Funktionen fanden bereits Erwähnung in der "Open"-Funktion von "TMediaP". Sie dienen dazu, anhand der File-Extension den Typ des Mediums zu erkennen, also ob es sich um einen Film, ein Bild oder etwas anderes handelt.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
function TMainF.is_pic(fn:string):bool;
begin
  fn:=lowercase(extractfileext(fn));
  result:=
    (fn='.jpg')or(fn='.jpeg')or(fn='.jpe')or
    (fn='.bmp')or(fn='.ico')or(fn='.emf')or(fn='.wmf');
end;

function TMainF.is_mov(fn:string):bool;
begin
  fn:=lowercase(extractfileext(fn));
  result:=
    (fn='.wav')or(fn='.mp3')or(fn='.flv')or(fn='.mp4')or
    (fn='.mpg')or(fn='.mpe')or(fn='.mpeg')or(fn='.avi')or(fn='.mov')or
    (fn='.wmv')or(fn='.m1v')or(fn='.wma')or(fn='.asx')or(fn='.asf');
end;
2.2.3.8. Aufräumarbeiten

Und die folgenden vier Funktionen dienen zum Löschen des zweidimensionalen "TMediaP"-Arrays "mp_a", zum Auffüllen von Strings, bis eine bestimmte Länge erreicht ist, und zur Anzeige von Hinweis- und Fehler-Meldungen.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
//clear mediap-array
procedure TMainF.mp_a_clr;
var
  x,y:integer;
begin
  for y:=0 to _mp_max do
    for x:=0 to _mp_max do
      mp_a[x,y]:=nil;
end;

//fill string with previous zeros
function TMainF.str_fill(s:string;len:integer):string;
begin
  while length(s)<len do s:='0'+s;
  result:=s;
end;

procedure TMainF.info(s:string);
begin
  application.MessageBox(pchar(s),'*** HINWEIS ***',mb_ok);
end;

procedure TMainF.error(s:string);
begin
  beep;
  application.MessageBox(pchar(s),'*** FEHLER ***',mb_ok);
end;

2.2.4. "TMainF": Funktionen für das aktive Objekt

2.2.4.1. Aktives Objekt grün umrahmt

Wird ein "TMediaP"-Objekt angeklickt, so wird es zum aktiven Objekt. Ein solches wird durch einen grünen Rahmen gekennzeichnet, der periodisch erscheint und wieder verschwindet. Aktive Objekte erhalten einen eigenen Menü-Punkt im Popup-Menü von "TMainF". Dessen Untermenü-Punkte betreffen ausschliesslich das aktive Objekt.

Delphi-Tutorials - MediaPanelyzer - Popup-Menu for the active 'TMediaP'-Object
Popup-Menü für das aktive TMediaP'-Panel: Aktuell ist das Movie-'TMediaP'-Objekt unten recht aktiv (zu erkennen am grünen Rahmen) und alle anderen Objekte inaktiv. Die Aktionen im angezeigten Popup-Menü beziehen sich also nur auf dieses eine Panel.
2.2.4.2. Menü-Punkte nur für Movies

Ist das aktive Objekt ein Movie-"TMediaP", dann sind die Untermenü-Punkte "Video starten", "Video halten" und "Video Sound" eingeschaltet, sonst abgeschaltet. Ihr Aufruf bewirkt im Wesentlichen nur das Durchreichen der entsprechenden Funktionen an die "TMovP"-Klasse.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
procedure TMainF.aobject_mov_start1Click(Sender: TObject);
begin
  if amp=nil then exit;
  if amp.movp=nil then exit;
  amp.movp.startbclick(sender);
end;

procedure TMainF.aobject_mov_halt1Click(Sender: TObject);
begin
  if amp=nil then exit;
  if amp.movp=nil then exit;
  amp.movp.haltbclick(sender);
end;

procedure TMainF.aobject_mov_sound1Click(Sender: TObject);
begin
  if amp=nil then exit;
  if amp.movp=nil then exit;
  if aobject_mov_sound1.checked then begin
    amp.movp.volume_set(0);
  end
  else begin
    amp.movp.volume_set(1000);
  end;
end;
2.2.4.3. Automatische Grössen-Adaption

Die nächsten beiden Untermenü-Punkte von "Aktives Objekt" ermöglichen es, die Grösse des gewählten "TMediaP"-Objektes automatisiert zu ändern. "Seitenverhältnis herstellen" lässt die Höhe des Objektes unverändert, passt aber dessen Breite so an, dass das Originalverhältnis von Höhe zu Breite wieder stimmt - falls dies durch eine Benutzer-Aktion zuvor aus dem "Gleichgewicht" gebracht worden sein sollte. "Originalgrösse herstellen" spricht wohl für sich selbst.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
procedure TMainF.aobject_sz_aspect1Click(Sender: TObject);
begin
  if amp=nil then exit;
  amp.sz_set(amp.clientheight,true);
end;

procedure TMainF.aobject_sz_org1Click(Sender: TObject);
begin
  if amp=nil then exit;
  amp.sz_set(amp.sz_org_height,true);
end;
2.2.4.4. End of Object

Über "Schliessen" kann das aktive Objekt wieder zerstört werden. Dabei wird geprüft, ob dessen Dateiname im Menü-Punkt Verlauf gespeichert ist. Falls nicht, wird dort ein entsprechender Untermenü-Punkt generiert. So kann ein einmal zerstörtes Objekt leicht wieder auf den Bildschirm zurückgeholt werden.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
procedure TMainF.object_close(mp:TMediaP);
var
  r:integer;
  found:bool;
  mi:tmenuitem;
begin
  //noch aktives element in verlauf
  //eintrag schon vorhanden?
  found:=false;
  for r:=0 to history1.Count-1 do begin
    if ansilowercase(history1.Items[r].hint)=ansilowercase(mp.afn) then begin
      found:=true;
      break;
    end;
  end;

  if not found then begin
    //nein, dann neu dazu
    mi:=tmenuitem.Create(pm);
    mi.caption:=mp.afn;
    mi.Hint:=mp.afn;
    mi.onclick:=history_go1click;
    history1.Add(mi);
  end;

  mp.free;
  sh_off;
  collection_chgok:=true;

  //any objects for a collection?
  found:=false;
  for r:=0 to ComponentCount-1 do begin
    if not(components[r] is TMediaP) then continue;
    found:=true;
    break;
  end;
  if not found then collection_afn:='';
end;

procedure TMainF.aobject_close1Click(Sender: TObject);
begin
  if amp=nil then exit;
  object_close(amp);
end;

2.2.5. "TMainF": Funktionen für alle Objekte

Operationen, die alle "TMediaP"-Objekte betreffen, werden über den Menü-Punkt "Objekte" abgedeckt. Je nachdem, ob ein aktives Objekt oder ein Movie-"TMediaP"-Objekt vorhanden ist, werden Untermenü-Punkte passend an- bzw. abgeschaltet (siehe "OnPopup"-Ereignis weiter oben).

Delphi-Tutorials - MediaPanelyzer - Popup-Menu for all 'TMediaP'-Objects
Popup-Menü für alle TMediaP'-Panels: Die Aktionen im angezeigten Popup-Menü beziehen sich auf alle Panel. Die Menüeinträge verhalten sich 'intelligent' und sind deaktiviert, wenn derzeit keine sinnvolle Aktion damit möglich sind. Hier etwa gibt keine Movie-Panels und auch keine aktiven Bilder-Panels.
2.2.5.1. Eine Medien-Datei (oder mehrere) hinzufügen

Der Untermenü-Punkt "Öffnen" erlaubt die Anlage eines neuen "TMediaP"-Objekts. Über den "Datei öffnen"-Dialog "objects_openpicdlg" lassen sich ein oder mehrere Dateien gleichzeitig - Bilder oder Filme - auswählen.

Die "object_open"-Funktion verhindert dabei das mehrmalige Öffnen gleicher Film-Dateien, denn dies wird von der "TMediaPlayer"-Komponente innerhalb einer Applikation nicht unterstützt (Bilder hingegen können durchaus mehrfach geöffnet werden). Ausserdem wird dafür gesorgt, dass die maximale Anzahl erlaubter Objekte "_mp_max" (=200) nicht überschritten wird.

Misslingt das Öffnen der Datei, wird das "TMediaP"-Objekt gleich wieder zerstört, damit kein "leerer Rahmen" zurückbleibt.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
function TMainF.object_open(fn:string):bool;
var
  r,object_c:integer;
  mp:TMediaP;
begin
  result:=false;

  //movies can open only one time
  if is_mov(fn) then begin
    for r:=0 to ComponentCount-1 do begin
      if not(components[r] is TMediaP) then continue;
      mp:=TMediaP(components[r]);
      if ansilowercase(fn)=ansilowercase(mp.afn) then exit;
    end;
  end;

  //count objects
  object_c:=0;
  for r:=0 to ComponentCount-1 do begin
    if not(components[r] is TMediaP) then continue;
    inc(object_c);
  end;

  //reach max number of objects?
  if object_c>=_mp_max-1 then begin
    error(
      'Maximale Anzahl von Objekten erreicht ('+inttostr(_mp_max)+').'+_cr+
      'Neues Objekt '+_cr+_cr+
      '  '+fn+_cr+_cr+
      'nicht generiert!'
    );
    exit;
  end;

  //create new media-object
  mp:=TMediaP.create(self);
  if not mp.open(fn) then begin
    //no media loaded
    mp.free;
    amp:=nil;
    exit;
  end;
  collection_chgok:=true;
  sh_t.Enabled:=true;
  result:=true;
end;

//shape timer: change shape border of active object
procedure TMainF.objects_open1Click(Sender: TObject);
var
  r:integer;
begin
  if not objects_openpicdlg.execute then exit;
  for r:=0 to objects_openpicdlg.Files.Count-1 do begin
    object_open(objects_openpicdlg.Files[r]);
  end;
  if objects_openpicdlg.Files.Count>0 then
    objects_openpicdlg.initialdir:=extractfilepath(objects_openpicdlg.Files[0]);
end;
2.2.5.2. Menü-Punkte nur für Movies

Es folgen die drei Untermenü-Punkte für Videos, über die alle "TMovP"-Instanzen, die in den "TMediaP"-Objekten eingebunden sind, auf einmal gestartet, angehalten und mit Sound versehen bzw. lautlos geschaltet werden können.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
function TMainF.object_open(fn:string):bool;
procedure TMainF.objects_movs_start1Click(Sender: TObject);
var
  r:integer;
  mp:TMediaP;
begin
  for r:=ComponentCount-1 downto 0 do begin
    if not(components[r] is TMediaP) then continue;
    mp:=TMediaP(components[r]);
    if mp.movp<>nil then mp.movp.startbclick(sender);
  end;
end;

procedure TMainF.objects_movs_halt1Click(Sender: TObject);
var
  r:integer;
  mp:TMediaP;
begin
  for r:=ComponentCount-1 downto 0 do begin
    if not(components[r] is TMediaP) then continue;
    mp:=TMediaP(components[r]);
    if mp.movp<>nil then mp.movp.haltbclick(sender);
  end;
end;

procedure TMainF.objects_movs_sound1Click(Sender: TObject);
var
  r:integer;
  mp:TMediaP;
begin
  objects_movs_sound1.Checked:=not objects_movs_sound1.checked;
  for r:=ComponentCount-1 downto 0 do begin
    if not(components[r] is TMediaP) then continue;
    mp:=TMediaP(components[r]);
    if mp.movp=nil then continue;
    if objects_movs_sound1.Checked then mp.movp.volume_set(1000)
                                   else mp.movp.volume_set(0);
  end;
end;
2.2.5.3. Automatisiertes Grössen-Adaption aller Objekte

Das Vorgehen ist in allen drei Fällen ähnlich: Es werden alle Komponenten von "TMainF" durchlaufen, es wird geprüft, ob es sich um "TMediaP"-Objekte handelt, dann ermittelt, ob die integrierte "TMovP"-Instanz initialisiert ist, und schliesslich - sofern dies zutrifft - direkt deren Funktionen aufgerufen.

Den Untermenü-Punkt "Seitenverhältnisse herstellen" kennen wir in ähnlicher Weise bereits für das aktive Objekt, kann hier jedoch auf alle "TMediaP"-Objekte gleichzeitig angewendet werden. Analog gilt dies für "Originalgrössen herstellen".

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
procedure TMainF.objects_sz_aspect1Click(Sender: TObject);
var
  r:integer;
  mp:TMediaP;
begin
  for r:=ComponentCount-1 downto 0 do begin
    if not(components[r] is TMediaP) then continue;
    mp:=TMediaP(components[r]);
    mp.sz_set(mp.clientheight,true);
  end;
end;

procedure TMainF.objects_sz_org1Click(Sender: TObject);
var
  r:integer;
  mp:TMediaP;
begin
  for r:=ComponentCount-1 downto 0 do begin
    if not(components[r] is TMediaP) then continue;
    mp:=TMediaP(components[r]);
    mp.sz_set(mp.sz_org_height,true);
  end;
end;
Delphi-Tutorials - MediaPanelyzer - Set aspect ration for all 'TMediaP'-Objects
Objekte | Seitenverhältnisse herstellen: Alle Verzerrungen in den Ausmassen der 'TMediaP'-Objekte (oben) lassen sich mit nur einem Klick rückgängig machen (unten).

Neu hingegen sind die Untermenü-Punkte "Übernehme Breite des aktiven Objekts" und "Übernehme Höhe des aktiven Objekts". Sie sind logischerweise nur eingeschaltet, wenn eines der "TMediaP"-Objekte zuvor aktiviert wurde.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
procedure TMainF.objects_sz_aspect_width1Click(Sender: TObject);
var
  r:integer;
  mp:TMediaP;
begin
  if amp=nil then exit;
  for r:=ComponentCount-1 downto 0 do begin
    if not(components[r] is TMediaP) then continue;
    mp:=TMediaP(components[r]);
    mp.sz_set(amp.width,false);
  end;
end;

procedure TMainF.objects_sz_aspect_height1Click(Sender: TObject);
var
  r:integer;
  mp:TMediaP;
begin
  if amp=nil then exit;
  for r:=ComponentCount-1 downto 0 do begin
    if not(components[r] is TMediaP) then continue;
    mp:=TMediaP(components[r]);
    mp.sz_set(amp.height,true);
  end;
end;

Wir verwenden hierbei die "sz_set"-Funktion von "TMediaP", die wir bereits weiter oben kennengelernt haben. Die Auswirkung demonstriert das folgende Bild:

Delphi-Tutorials - MediaPanelyzer - Takeover the dimension (width or height) from one to all 'TMediaP'-Objects
Objekte | Übernehme Breite bzw. Höhe des aktiven Objekts: Alle Objekte übernehmen die Breite (links) bzw. Höhe (rechts) des aktuellen aktiven Objekts (hier: Charlize Theron).
2.2.5.4. Den zur Verfügung stehenden Platz optimal ausfüllen

Mithilfe der Untermenü-Punkte "Anpassen nach rechts", "Anpassen nach unten" sowie "Anpassen nach rechts und unten" können die "TMediaP"-Objekte über die gesamte Breite, Höhe oder Fläche von "TMainF" gestreckt oder gestaucht werden. Das ist nützlich, um keine undekorativen leeren Flächen auf der "Foto-Tapete" zu behalten.

Anders als bei den meisten bisherigen Prozeduren müssen wir hier sogar einmal etwas rechnen. Daher sehen wir uns jetzt "Anpassen nach rechts" etwas näher an:

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
procedure TMainF.objetcs_adapt_right1Click(Sender: TObject);
var
  xc,y,x,w,sw:integer;
  mp:TMediaP;
  wd:double;
begin
  //define the width of one row TMediaPs
  sw:=screen.width-2;

  //if there is a right-border then take this as 'sw'
  if bordersplitter.Visible then sw:=bordersplitter.Left;

  //check every row of TMediaPs
  for y:=0 to _mp_max do begin

    //sum of widths in actual row
    xc:=0;
    w:=0;
    for x:=0 to _mp_max do begin
      if mp_a[x,y]=nil then continue;
      mp:=mp_a[x,y];
      w:=w+mp.Width;
      inc(xc);
    end;

    //at least one TMediaP found in row?
    if xc>0 then begin

      //calculate rest of screen to fill
      wd:=sw-w;

      //calculate delta to add to widths
      wd:=wd/xc;

      //increase the width of every TMediaP in row
      for x:=0 to _mp_max do begin
        if mp_a[x,y]=nil then continue;
        mp:=mp_a[x,y];

        //modify width and calculate new aspect ratio
        mp.Width:=trunc(mp.Width+wd);
        mp.sz_aspect:=mp.Height/mp.width;
      end;
    end;
  end;

  //show the mediap with modified widths
  design_arrange;
end;

Wir sichern zunächst in "sw", wie Breit die Kollektion insgesamt werden soll. Wurde eine rechte Randlinie aktiviert (siehe "Design"-Funktionen weiter unten), orientiert sich "sw" daran, ansonsten ist es mit der Breite von "TMainF" identisch.

Alle "TMediaP"-Objekte werden über ein zweidimensionales Array "mp_a" verwaltet. Abhängig von ihren "Top"- und "Left"-Attributen wurden die Objekte darin zuvor passend abgelegt (siehe "design_sort", "design_sort_opt1Click" und "design_arrange"). "TMediaP"-Objekte weiter oben belegen die oberen Zeilen, die weiter unten die unteren, und entsprechend Objekte links die vorderen Spalten, die weiter rechts die hinteren.

Delphi-Tutorials - MediaPanelyzer - Two dimensional array with the coordinates of all 'TMediaP'-Objects
Zweidimenionales Array mit den Koordinaten aller 'TMediaP'-Objekts
00001
00002
00003
00004
mp_a[0,0]='Winona',    mp_a[0,1]='Winona',    mp_a[0,2]='Winona',  ... mp_a[0,200]=nil
mp_a[1,0]='Christina', mp_a[0,1]='Christina', mp_a[0,2]='Shannen', ... mp_a[0,200]=nil
...
mp_a[200,0]=nil,       mp_a[0,1]=nil,         mp_a[0,2]=nil,       ... mp_a[0,200]=nil

Dieses Array ermöglicht es uns nun, jede "Zeile" der "TMediaP"-Objekten gesondert zu durchlaufen. Die Breite von jedem "Spalten"-Objekt darin wird in "w" aufsummiert.

Ziehen wir die so ermittelte Breite "w" der aktuellen Zeile von der zur Verfügung stehenden Gesamtbreite "sw" ab, erhalten wir einen Restwert. Geteilt durch die Anzahl "xc" der Objekte der aktuellen Zeile, ergibt sich ein Delta-Wert "wd".

Dieses Delta kann übrigens durchaus negativ sein, nämlich dann, wenn die Gesamtbreite kleiner als die aufsummierte Breite ist. Dieser Fall liegt z.B. vor, wenn die aktivierte Randlinie die rechts liegenden "TMediaP"-Objekte überdeckt.

Im nächsten Schritt wird jedes Objekt der aktuellen Zeile um das "wd"-Delta in der Breite modifiziert. Das "Left"-Attribut der Objekte müsste eigentlich ebenfalls korrigiert werden. Das können wir uns aber sparen, da dies durch die abschliessende "design_arrange"-Funktion ohnehin vorgenommen wird.

Delphi-Tutorials - MediaPanelyzer - Adaption of the panel sizes to the right border
Objekte | Anpassen nach rechts: Alle Objekte (oben) werden möglichst gleichmässig gestreckt, sodass sie die gesamte Breite des Fensters in Anspruch nehmen und es keinerlei Leerflächen mehr gibt (unten).

Die "Anpassung nach unten" erfolgt in relativ ähnlicher Weise, nur dass diesmal die Höhen der Objekte modifiziert werden. Und die "Anpassung nach rechts und unten" führt die vorherigen beiden Anpassungsfunktionen einfach hintereinander aus.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
procedure TMainF.objetcs_adapt_bottom1Click(Sender: TObject);
var
  t,h,yc,sh,y,x:integer;
  mp:TMediaP;
  hd:double;
begin
  //height to fill
  sh:=screen.height;

  //sum of heights
  yc:=0;
  h:=0;
  for y:=0 to _mp_max do begin
    if mp_a[0,y]=nil then continue;
    mp:=mp_a[0,y];
    h:=h+mp.height;
    inc(yc);
  end;

  //calculate rest of screen to fill
  hd:=sh-h;

  //calculate delta to add to heights
  hd:=hd/yc;

  //increase hight of every mediap
  for y:=0 to _mp_max do begin
    //calculate new top of actual row
    t:=trunc(hd*y);
    for x:=0 to _mp_max do begin
      if mp_a[x,y]=nil then continue;
      mp:=mp_a[x,y];
      mp.height:=trunc(mp.height+hd);
      mp.top:=mp.top+t;
      mp.sz_aspect:=mp.Height/mp.width;
    end;
  end;

  //show the mediaps with modified heights
  design_arrange;
end;

procedure TMainF.objetcs_adapt_right_bottom1Click(Sender: TObject);
begin
  objetcs_adapt_right1Click(Sender);
  objetcs_adapt_bottom1Click(Sender);
end;
2.2.5.5. End of all Objects

Bleibt nur noch die "Schliessen"-Funktion im "Objekte"-Menü. Hier wird nach einer Sicherheitsabfrage für jedes "TMediaP"-Objekte die integrierte "close"-Prozedur aufgerufen.

Anschliessend wird die Applikation mit "BringToFront" (wieder) in den Vordergrund gebracht. Schliesst man nämlich unter Windows Vista ein Movie-"TMediaP"-Objekt, verschwindet ab und zu das aktive Anwendungsfenster in den Hintergrund. Die Ursache für dieses seltsame Verhalten ist mir allerdings unbekannt.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
procedure TMainF.objects_close;
var
  r:integer;
begin
  //disbale active object
  sh_t.enabled:=false;
  sh_off;

  //close all TMediaP-objects
  for r:=ComponentCount-1 downto 0 do begin
    if not(components[r] is TMediaP) then continue;
    object_close(TMediaP(components[r]));
  end;

  //strange behaviour of vista: widthout bringtofront
  //the application move to background
  mainf.BringToFront;

  //clear collection, remark the change
  collection_afn:='';
  collection_chgok:=true;
end;

procedure TMainF.objects_close1Click(Sender: TObject);
begin
  if application.messagebox(
    'Wirklich alle Objekte schliessen?',
    '*** FRAGE ***',
    mb_yesno
  )=id_no then
    exit;
  objects_close;
end;

2.2.6. "TMainF": Die Design-Funktionen

MediaPanelyzer ermöglicht es uns über den Menü-Punkt "Design" verschiedene Operationen auf die "TMediaP"-Objekte anzuwenden, die deren Anordnung und Grösse betreffen. Ausserdem kann man die Anzeigefläche durch Vorgabe eines rechten Rands schmaler machen, sowie die Hintergrundfarbe von "TMainF" ändern.

Delphi-Tutorials - MediaPanelyzer - Popup-Menu with design functions of MediaPanelyzer
Popup-Menü mit Design-Funktionen: Über dieses Menü kann die Reihenfolge der Anordnung der Panels automatisch geändert werden. Im Beispiel wurden die Objekte gerade nach ihrer Grösse sortiert - weshalb die Movie-Panels oben links zu finden sind.
2.2.6.1. Reihenfolge der Medien-Daten

Zur Anordnung: "TMediaP"-Objekte können alphabetisch, chronologisch, nach Grösse sortiert, zufällig oder "optimiert" auf "TMainF" arrangiert werden. Betrachten wir zunächst die ersten vier Fälle.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082
00083
00084
00085
00086
00087
00088
00089
00090
00091
00092
00093
00094
00095
00096
00097
00098
00099
00100
00101
00102
00103
00104
00105
00106
00107
00108
00109
00110
00111
00112
00113
00114
00115
00116
00117
00118
00119
//arrange TMediaP-objects in special order
procedure TMainF.design_sort(ds:tdesignsort);
var
  mp:TMediaP;
  x,y,sw,rr,r,t,tg,l:integer;
  s:string;
begin
  collection_chgok:=true;
  mp_a_clr;

  //fill listbox with design_sort_strings
  design_sort_lb.clear;
  rr:=0;
  for r:=0 to ComponentCount-1 do begin
    if not(components[r] is TMediaP) then continue;
    mp:=TMediaP(components[r]);

    //get design_sort_string
    if      ds=_ds_alpha  then s:=mp.ds_alpha
    else if ds=_ds_chrono then s:=mp.ds_chrono
    else if ds=_ds_size   then s:=mp.ds_size
    else if ds=_ds_random then s:=str_fill(inttostr(random(1000)),10)
    else                       s:=''; //should never happen

    //design_sort_string + object_number in listbox
    design_sort_lb.Items.add(s+'<'+inttostr(rr));

    //save object_number
    mp.tag:=rr;
    rr:=rr+1;
  end;

  //maximal width
  sw:=screen.width;

  //can be left of border-panel
  if borderp.Visible then sw:=bordersplitter.Left;

  //arrange panels on mainf
  x:=0;
  y:=0;
  t:=0;
  l:=0;
  for rr:=0 to design_sort_lb.Items.count-1 do begin

    //sort-direction
    if design_sort_down then
      s:=design_sort_lb.items[design_sort_lb.Items.count-1-rr]
    else
      s:=design_sort_lb.items[rr];

    //filter object_number
    tg:=pos('<',s);
    tg:=strtoint(copy(s,tg+1,length(s)));

    //search object with thar object-number
    for r:=0 to ComponentCount-1 do begin
      if not(components[r] is TMediaP) then continue;
      mp:=TMediaP(components[r]);

      //object-number found?
      if mp.tag<>tg then continue;

      //reach right border?
      if (l+mp.width)>sw then begin
        //yep, start new row
        l:=0;
        t:=t+mp.height;

        //increase row-counter
        inc(y);

        //set first col-counter
        x:=0;
      end;

      //set new position
      mp.top:=t;
      mp.left:=l;
      mp_a[x,y]:=mp;

      //calculate next left-position
      l:=l+mp.width;

      //increase col-counter
      inc(x);
      break;
    end;
  end;

  //delete number-tags of all TMediaPs
  for r:=0 to ComponentCount-1 do begin
    if not(components[r] is TMediaP) then continue;
    TMediaP(components[r]).Tag:=0;
  end;

  //change sort direction next time
  design_sort_down:=not design_sort_down;
end;

procedure TMainF.design_sort_alpha1Click(Sender: TObject);
begin
  design_sort(_ds_alpha);
end;

procedure TMainF.design_sort_chrono1Click(Sender: TObject);
begin
  design_sort(_ds_chrono);
end;

procedure TMainF.design_sort_size1Click(Sender: TObject);
begin
  design_sort(_ds_size);
end;

procedure TMainF.design_sort_random1Click(Sender: TObject);
begin
  design_sort(_ds_random);
end;
2.2.6.2. Sortierkriterien

Beim Öffnen von "TMediaP"-Objekten werden stets auch diverse "Design-Sort-Strings" gefüllt, basierend auf Daten, die uns die zugrunde liegende Datei liefert (siehe "open"-Funktion im Abschnitt "TMediaP").

Je nach gewähltem Sortierkriterium wird jetzt zur Anordnung der "TMediaP"-Objekte auf "TMainF" ein solcher "Design-Sort-String" ausgewählt bzw. im "Zufalls-Fall" ein neuer generiert.

Wir durchlaufen also alle "TMediaP"-Objekte, holen uns den passenden Design-Sort-String "s" und füllen damit die ListBox "design_sort_lb", deren Sortierungseigenschaft aktiviert ist. Hinter "s" wird jeweils auch noch die Nummer des Objekts angehängt und in sein "Tag"-Attribut eingetragen, um es später wieder identifizieren zu können.

Beispiel: Aus
  • Objekt #1, ds_alpha="b.jpg", ds_size="000001000"
  • Objekt #2, ds_alpha="z.jpg", ds_size="000004000"
  • Objekt #3, ds_alpha="a.mpg", ds_size="000003000"
wird so bei alphabetischer Sortierung in der ListBox
  • a.mpg<3
  • b.jpg<1
  • z.jpg<2
und bei Sortierung nach Grösse
  • b.jpg<1
  • a.mpg<3
  • z.jpg<2
wobei "<" als Delimiter verwendet wird.

Anschliessend wird die sortierte ListBox durchlaufen. Je nachdem, ob auf- oder absteigend sortiert werden soll, wird dabei von vorne nach hinten bzw. von hinten nach vorne auf die Elemente der ListBox zugegriffen.

Haben wir einen ListBox-Eintrag in "s" übertragen, scannen wir die Objekt-Nummer heraus und suchen das passende "TMediaP"-Objekt dazu. Ist dieses gefunden, positionieren wir es so weit links-oben wie möglich, ohne dabei ein eventuell bereits platziertes "TMediaP"-Objekt zu überdecken.

Würde das neue "TMediaP"-Objekt dadurch allerdings die erlaubte Gesamtbreite überschreiten, nehmen wir zuerst einen "Zeilenumbruch" vor, indem der Top-Wert "t" um die Standard-Höhe des Panels vergrössert wird.

Daraus wird auch ersichtlich, dass das Ganze nur dann Sinn macht, wenn alle Objekte die gleiche Höhe haben! Ansonsten kommen eher unschöne Ergebnisse heraus.

2.2.6.3. Platz-optimiertes Arrangement

Das Gleiche gilt in ähnlicher Weise für den nächsten Fall: "Sortierung optimiert".

Optimiert heisst hier, die "TMediaP"-Objekte sollen automatisch so arrangiert werden, dass sie möglichst komplett eine rechteckige Fläche abdecken. Dabei soll die zur Verfügung stehende Breite zur Gänze genutzt werden, es sei denn, dadurch würde in der letzten Zeile zu viel Leerfläche entstehen. In diesem Fall wird das Rechteck schmaler gemacht, dafür aber besser ausgefüllt.

Das folgende Beispiel möge dies verdeutlichen:

Delphi-Tutorials - MediaPanelyzer - Space optimized sorting of all Media-Panels
Sortierung optimiert: Im oberen Bild sind die 'TMediaP'-Objekte nach Grösse sortiert. Die zur Verfügung stehende Breite wird voll ausgenutzt. Im unteren Bild wurde die Reihenfolge dagegen optimiert; die Breite wird nicht länger voll ausgenutzt, dafür gibt es aber keine Leerflächen mehr.

Um es gleich vorweg zu sagen: Optimiert heisst nicht optimal!

Das Verfahren, dass wir hier anwenden, enthält Zufallselemente und liefert daher unter Umständen für ein und dieselbe Kollektion verschieden "gute" Ergebnisse.

Eine in ihren Grenzen flexible Fläche mathematisch exakt mit "x" Rechtecken verschiedener Höhen aufzufüllen, dass klingt nach ... mh, einer Art Integral-Funktion, deren absolutes Minimum über erste und zweite Ableitung zu suchen ist. Wenn es dafür keinen analytischen Weg gibt, dann wäre vielleicht auch eine numerisch-iterative Herangehensweise denkbar. Kann aber auch sein, dass es sich dabei um eines der berüchtigten NP-vollständigen Probleme handelt, die keine eindeutige Lösung in endlicher Zeit erlauben.

Keine Ahnung. So weit reichen meine mathematischen Kenntnisse nicht.

Die folgende Prozedur "design_sort_opt1Click" macht ihren Job allerdings hinreichend gut, wie ich finde. Zudem ist sie ziemlich schnell. Und nicht zuletzt bringt das Zufallselement auch noch etwas Abwechslung hinein.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082
00083
00084
00085
00086
00087
00088
00089
00090
00091
00092
00093
00094
00095
00096
00097
00098
00099
00100
00101
00102
00103
00104
00105
00106
00107
00108
00109
00110
00111
00112
00113
00114
00115
00116
00117
00118
00119
00120
00121
00122
00123
00124
00125
00126
00127
00128
00129
00130
00131
00132
00133
00134
00135
00136
00137
00138
00139
00140
00141
00142
00143
00144
00145
00146
00147
00148
00149
00150
00151
00152
00153
00154
00155
00156
00157
00158
00159
00160
00161
00162
00163
00164
00165
00166
00167
00168
00169
00170
00171
00172
00173
00174
00175
00176
00177
00178
00179
00180
00181
procedure TMainF.design_sort_opt1Click(Sender: TObject);
const
  _outer_trys_max=50;
  _inner_trys_max=100;
type
  twidth_a=array[0.._mp_max*_mp_max]of integer;

  //search tmedia with width 'w'
  function getpanel(w:integer):TMediaP;
  var
    r,x,y:integer;
    mp:TMediaP;
    foundok:bool;
  begin
    result:=nil;
    for r:=0 to ComponentCount-1 do begin
      if not(components[r] is TMediaP) then continue;
      mp:=TMediaP(components[r]);

      //searched width found?
      if mp.width<>w then continue;

      //is TMediaP free?
      foundok:=false;
      for y:=0 to _mp_max do begin
        for x:=0 to _mp_max do begin
          if mp_a[x,y]=nil then continue;
          if mp_a[x,y]=mp then foundok:=true;
        end
      end;

      if not foundok then begin
        //yep, it is free
        result:=mp;
        break;
      end;
    end;
  end;

var
  swo,yc,dsw,
  h,t,l,
  outer_trys,inner_trys,
  x,y,errmin,wmax,w,rr,err,sw,r,wc:integer;
  w_a,wold_a,wnew_a:^twidth_a;
  mp:TMediaP;
begin
  //create width-arrays
  new(w_a);
  new(wold_a);
  new(wnew_a);

  try

    //get all widths in w_a
    wc:=0;
    for r:=0 to ComponentCount-1 do begin
      if not(components[r] is TMediaP) then continue;
      w_a[wc]:=TMediaP(components[r]).width;
      inc(wc);
    end;

    //set error to a big value
    errmin:=screen.width*100;

    //get max width
    sw:=screen.width;
    if bordersplitter.Visible then sw:=bordersplitter.Left;

    //calculate a modifier for max width
    swo:=sw;
    dsw:=(sw-100) div _outer_trys_max;if dsw<0 then dsw:=0;

    //outer loop: makes max width 'sw' smaller
    for outer_trys:=0 to _outer_trys_max do begin

      //inner loop: search optimum for given max width
      for inner_trys:=0 to _inner_trys_max do begin

        //save width_array
        for r:=0 to wc-1 do wold_a[r]:=w_a[r];

        //change width_array in random way
        for r:=0 to wc-1 do begin

          //find a free width
          repeat
            rr:=random(wc);
          until wold_a[rr]>0;

          //save founded width
          wnew_a[r]:=wold_a[rr];

          //mark width as ready
          wold_a[rr]:=-1;
        end;

        //get max width of rows
        wmax:=0;
        r:=0;
        repeat
          //fill row, stop if right border is reached
          w:=0;
          repeat
            w:=w+wnew_a[r];
            inc(r);
          until (r>wc-1)or(w+wnew_a[r]>sw);

          if w>wmax then wmax:=w;
        until r=wc;

        //calculate error_sum
        yc:=0;
        err:=0;
        r:=0;
        repeat
          //fill row, stop if right border is reached
          w:=0;
          repeat
            w:=w+wnew_a[r];
            inc(r);
          until (r>wc-1)or(w+wnew_a[r]>sw);
          inc(yc);
          err:=err+(wmax-w);
        until r=wc;

        //modify error-sum: more rows => bigger error
        err:=err+(swo-sw)*yc;

        //new minimum found?
        if err>=errmin then continue;

        //yep
        errmin:=err;

        //save positions in mp_a
        mp_a_clr;
        y:=0;
        r:=0;
        repeat
          //fülle zeile bis über rechten rand
          w:=0;
          x:=0;
          repeat
            w:=w+wnew_a[r];
            mp_a[x,y]:=getpanel(wnew_a[r]);
            inc(r);
            inc(x);
          until (r>wc-1)or(w+wnew_a[r]>sw);
          inc(y);
        until r=wc;
      end;

      //now reduce max width an try again
      sw:=sw-dsw;if sw<100 then sw:=00;
    end;

    //okay, a minum was found and saved in mp_a
    //arrange TMediaP-objects new
    h:=0;
    t:=0;
    for y:=0 to _mp_max do begin
      l:=0;
      for x:=0 to _mp_max do begin
        if mp_a[x,y]=nil then continue;
        mp:=mp_a[x,y];
        mp.Top:=t;
        mp.left:=l;
        if l=0 then h:=mp.height;
        l:=l+mp.width;
      end;
      t:=t+h;
    end;

  finally
    //free memory
    dispose(wnew_a);
    dispose(wold_a);
    dispose(w_a);
  end;
end;

Okay, die Prozedur ist nicht ganz trivial. Und schwer zu beschreiben. Der prinzipielle Ablauf soll uns daher als Erklärung genügen:

  1. Wir holen uns alle Breiten der "TMovP"-Objekte in ein Array "w_a".
  2. Dieses Array wird "gewürfelt", sprich, die Reihenfolge wir in zufälliger Weise geändert und in "wnew_a" gesichert.
  3. Die zur Verfügung stehende Breite ist "sw". "wnew_a" wird sequenziell durchlaufen, bis die aufsummierte Gesamtbreite der "TMediaP"-Objekte schliesslich "sw" erreicht. Dann beginnt eine neue Zeile. Die bisherige Breite wird in "wmax" gesichert, sofern sie grösser ist als das vorherige "wmax".
  4. Nun werden noch einmal alle "Zeilen" durchlaufen. Schmalere Zeilen als "wmax" bedeuten Leerfläche, die Differenz wird daher jeweils auf die Fehlersumme "err" aufaddiert.
  5. Da unser Ziel ist, die zur Verfügung stehende Breite möglichst komplett auszunutzen, sind wenige Zeilen besser als viele. Aus diesem Grund berechnen wir nun für eine hohe Zeilenanzahl eine stärkere Vergrösserung der Fehlersumme (quasi ein "Strafterm").
  6. Nun prüfen wir, ob sich die Fehlersumme gegenüber einem Vorlauf verkleinert hat. Ist das der Fall, merken wir uns die neue Fehlersumme in "errmin" und die sich daraus ergebenden Positionen der "TMediaP"-Objekte im >"mp_a"-Array.
  7. Der Vorgang wird "_inner_trys"-mal wiederholt.
  8. Die "_inner_try"-Schleife wird zusätzlich "_outer-trys"-mal wiederholt. Hierbei wird jedoch die zur Verfügung stehende Breite "sw" bei jedem Durchgang sukzessive verkleinert. Dadurch tragen wir dem Fakt Rechnung, dass z.B. ein dreizeiliges Rechteck "kompakter" und damit optimierter sein kann, als ein "zerfranstes" zweizeiliges Rechteck, auch wenn dies die komplette Breite besser ausfüllt.

Das Zustandekommen der Fehlersummen sei hier noch einmal an einem schematischen Beispiel verdeutlicht:

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
// FEHLERSUMMEN verschiedener 'TMediaP'-Arrangements auf 'TMainF'

// Der Einfachheit halber wurde hier auf
// den 'Zeilen-Straf-Term' verzichtet

// Die '----' geben die gewünschte Gesamtbreite vor

// 'aaa', 'bb' usw. repräsentieren 'TMediaP'-Objekte
// verschiedener Breite, aber gleicher Höhe

// Die Zahlen geben die Anzahl Pixel an, die fehlen,
// um die gewünschte Breite für die Zeile zu erreichen.

// Durchgang #1
--------------------
aaa bb ccc eeee ffff
ddddddd ffff      40
--------------------
==> Fehlersumme 40

// Durchgang #2
--------------------
aaa bb ccc ddddddd 5
eeee ffff ffff    25
--------------------
==> Fehlersumme 30

// Durchgang #3, nachdem die zur Verfügung
// stehende Gesamtbreite verkleinert wurde
--------------
aaa bb ccc  11
ddddddd eeee 2
ffff ffff   15
---------------
==> Fehlersumme 28
2.2.6.4. Kollektives Zooming

Wenden wir uns nun den Untermenü-Punkten "Grösse plus", "Grösse plus fein", "Grösse minus" und "Grösse minus fein" zu. Hierüber können alle "TMediaP"-Objekte gleichzeitig um einen bestimmten Faktor vergrössert bzw. verkleinert werden. Die Seitenverhältnisse bleiben dabei erhalten (auch eventuell nicht-proportional modifizierte).

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
//increase/decrease size of TMediaP
procedure TMainF.design_sz(zoom:double);
var
  mp:TMediaP;
  r:integer;
  ow,oh,d:double;
begin
  collection_chgok:=true;
  for r:=0 to ComponentCount-1 do begin
    if not(components[r] is TMediaP) then continue;

    mp:=TMediaP(components[r]);

    //get aspect ratio (height/width) of TMediaP
    d:=mp.sz_aspect;

    //zoom the height
    //increase height if zoom>1
    //decrease height if zoom<1
    oh:=mp.height*zoom;

    //use aspect ratio to calulate new width
    ow:=oh/d;

    //setze new dimension
    mp.Height:=trunc(oh);
    mp.width:=trunc(ow);

    //save new height as standard_height
    object_height:=trunc(oh);
  end;

  //arrange TMediaP-objects on screen
  design_arrange;
end;

procedure TMainF.design_sz_plus1Click(Sender: TObject);
begin
  design_sz(1.1);
end;

procedure TMainF.design_sz_plus_small1Click(Sender: TObject);
begin
  design_sz(1.01);
end;

procedure TMainF.design_sz_minus1Click(Sender: TObject);
begin
  design_sz(0.9);
end;

procedure TMainF.design_sz_minus_small1Click(Sender: TObject);
begin
  design_sz(0.99);
end;

Wir durchlaufen wie üblich alle "TMediaP"-Objekte und sichern diesmal das Seitenverhältnis zwischen Höhe und Breite in "d". Dann strecken bzw. stauchen wir die Höhe des Objekts mit dem Faktor "zoom", der an die Prozedur übergeben wird. Über das Seitenverhältnis "d" lässt sich danach auch die neue Breite berechnen.

Ausserdem werden die Objekte abschliessend über "design_arrange" neu auf dem Bildschirm positioniert, sodass sie sich nicht überdecken oder Leerstellen entstehen. Die Reihenfolge wird dabei jedoch nicht geändert (siehe auch "Anpassen nach rechts").

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
procedure TMainF.design_arrange;
type
  tmedia_a=array[0.._mp_max*_mp_max]of TMediaP;
var
  hold,sw,r,pc,x,y,l,t:integer;
  mp_tmp_a:^tmedia_a;
  mp:TMediaP;
begin
  //create temporary 1-dim mediap-array
  new(mp_tmp_a);
  try

    //fill temporary array as sequence
    pc:=0;
    for y:=0 to _mp_max do begin
      for x:=0 to _mp_max do begin
        if mp_a[x,y]=nil then continue;
        mp:=mp_a[x,y];
        mp_tmp_a[pc]:=mp;
        inc(pc);
      end;
    end;

    //clear 2-dim mediap-array
    mp_a_clr;

    //max width to arrange
    sw:=screen.width;
    if bordersplitter.Visible then sw:=bordersplitter.Left;

    //replace movep-objects
    x:=0;
    y:=0;
    hold:=0;
    t:=0;
    l:=0;
    for r:=0 to pc-1 do begin
      mp:=mp_tmp_a[r];

      //reach right border?
      if l+mp.width>sw then begin

       //yep, start new row
       x:=0;
       l:=0;
       t:=t+hold;
       inc(y);
      end;

      //set new position
      mp.Top:=t;
      mp.left:=l;
      mp_a[x,y]:=mp;
      inc(x);

      //calculate new coordinates
      l:=l+mp.width;
      hold:=mp.height;
    end;

  finally
    //memory free
    dispose(mp_tmp_a);
  end;
end;
2.2.6.5. Rechte Randlinie

Die beiden letzten Design-Untermenü-Punkte sind wenig anspruchsvoll. Über "Randlinie" kann der rechte Rand nach aussen hin begrenzt werden. Und über "Hintergrund-Farbe" lässt sich - welche Überraschung - die Hintergrund-Farbe von "TMainF" ändern.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
procedure TMainF.design_borderline1Click(Sender: TObject);
begin
  design_borderline1.Checked:=not design_borderline1.checked;
  borderp.visible:=design_borderline1.Checked;
  bordersplitter.visible:=design_borderline1.Checked;
end;

procedure TMainF.design_backgroundcolor1Click(Sender: TObject);
begin
  design_backgroundcolordlg.Color:=color;
  if not design_backgroundcolordlg.Execute then exit;
  color:=design_backgroundcolordlg.Color;
end;
Delphi-Tutorials - MediaPanelyzer - Border line and background color for panel collages
Randlinie und Hintergrundfarbe für Panel-Collagen: Beispiele für eine sukzessive Verkleinerung der zur Verfügung stehenden Fläche für die Panels durch Änderung der rechten Randlinie. Ausserdem wurde jeweils die Hintergrundfarbe verändert.

2.2.7. "TMainF": Die Kollektion-Funktionen

Unter dem Menü-Punkt "Kollektion" finden sich Funktionen, über die sich "TMediaP"-Sammlungen (Kollektionen) öffnen und speichern lassen. Darüber hinaus kann man sich eine Collage generieren lassen oder einen Screenshot von "TMainF" vornehmen.

Delphi-Tutorials - MediaPanelyzer - Popup-menu width collage functions for the media panels
Popup-Menü mit Kollektionsfunktionen: Funktionen zur Verwaltung fertiger Collagen wie Speichern, Öffnen, Screenshots usw.
2.2.7.1. Kollektion öffnen

MediaPanelyzer-Kollektionen werden in Form von INI-Dateien mit der Datei-Extension ".mpc" abgespeichert.

Der Untermenü-Punkt "Öffnen" lädt eine Kollektionen-Datei ein:

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
procedure TMainF.collection_open(fn:string);
var
  inif:tinifile;
  rr:integer;
  mp_a_x,mp_a_y:integer;
begin
  screen.Cursor:=crhourglass;
  objects_movs_halt1Click(Self);

  if not fileexists(fn) then begin
    error(
      'MediaPanelyzer-Kollektion'+_cr+_cr+
      '  '+fn+_cr+_cr+
      'existiert nicht (mehr)!'
    );
    exit;
  end;

  collection_afn:=fn;
  collection_opendlg.initialdir:=extractfilepath(fn);
  collection_savedlg.initialdir:=extractfilepath(fn);

  inif:=tinifile.create(fn);
  try
    mp_a_clr;
    rr:=0;
    repeat
      fn:=inif.readString('mp'+inttostr(rr),'fn','');
      if fn<>'' then begin
        if object_open(fn) then begin
          amp.Top   :=inif.readinteger('mp'+inttostr(rr),'top',   amp.top   );
          amp.left  :=inif.readinteger('mp'+inttostr(rr),'left',  amp.left  );
          amp.height:=inif.readinteger('mp'+inttostr(rr),'height',amp.height);
          object_height:=amp.height;
          amp.width :=inif.readinteger('mp'+inttostr(rr),'width', amp.width );
          amp.sz_aspect:=amp.clientheight/amp.clientwidth;

          //array-pos
          mp_a_x:=inif.readinteger('mp'+inttostr(rr),'mp_a_x',-1);
          mp_a_y:=inif.readinteger('mp'+inttostr(rr),'mp_a_y',-1);
          if(mp_a_x<>-1)and(mp_a_y<>-1)then mp_a[mp_a_x,mp_a_y]:=amp;
        end;
      end;
      inc(rr);
    until fn='';
  finally
    inif.free;
    sh_off;
    collection_chgok:=false;
    screen.Cursor:=crdefault;
    if not _debugok then begin
      info('Kollektion'+_cr+_cr+'  '+collection_afn+_cr+_cr+'geladen');
    end;
  end;
end;

procedure TMainF.collection_open1Click(Sender: TObject);
begin
  if not collection_chgok_chksave then exit;
  if not collection_opendlg.execute then exit;
  collection_open(collection_opendlg.FileName);
end;

Nach der Überprüfung, ob eine bereits geöffnete Kollektion vor der Änderung nicht zuerst gespeichert werden soll ("collection_chgok_chksave"), kann über den Datei-Öffnen-Dialog "collection_opendlg" eine beliebige Kollektions-Datei selektiert werden.

Die Datei wird wie eine INI-Datei geöffnet. Danach werden in einer Schleife alle nötigen "TMediaP"-Objekte erzeugt. Die zugehörigen Medien-Dateien müssen dabei am gleichen Platz auf der Festplatte sein wie während der Speicherung. Die Kollektion beinhaltet nämlich nur die "TMediaP"-Positionen und -Dimensionen, nicht aber die Medien-Dateien an sich.

2.2.7.2. Kollektion speichern

Über die Unter-Menüpunkte "Speichern" und "Speichern unter ..." lässt sich eine Kollektion umgekehrt wieder auf Festplatte abspeichern:

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082
00083
00084
00085
00086
00087
00088
00089
00090
00091
00092
00093
00094
00095
00096
00097
00098
00099
00100
00101
00102
00103
00104
00105
00106
00107
00108
00109
00110
00111
00112
00113
00114
00115
00116
00117
00118
00119
function TMainF.collection_chgok_chksave:bool;
var
  objok:bool;
  rc,r:integer;
begin
  result:=true;
  if not collection_chgok then exit;

  //any objects?
  objok:=false;
  for r:=0 to ComponentCount-1 do begin
    if not(components[r] is TMediaP) then continue;
    objok:=true;
    break;
  end;
  if not objok then begin
    collection_chgok:=false;
    exit;
  end;

  rc:=application.MessageBox(
    pchar('Die (letzte) Kollektion wurde verändert. Jetzt speichern?'),
    '*** FRAGE ***',
    mb_yesnocancel
  );

  if rc=id_no then exit;
  if rc=id_cancel then begin
    result:=false;
    exit;
  end;
  collection_save1Click(nil);
end;

procedure TMainF.collection_save(fn:string);
var
  inif:tinifile;
  r,rr:integer;
  mp:TMediaP;
  x,y:integer;
  mp_a_x,mp_a_y:integer;
begin
  screen.Cursor:=crhourglass;
  deletefile(fn);
  inif:=tinifile.create(fn);
  try
    rr:=0;
    for r:=ComponentCount-1 downto 0 do begin
      if not(components[r] is TMediaP) then continue;
      mp:=TMediaP(components[r]);
      inif.WriteString('mp'+inttostr(rr),'fn',mp.afn);
      inif.Writeinteger('mp'+inttostr(rr),'top',mp.top);
      inif.Writeinteger('mp'+inttostr(rr),'left',mp.left);
      inif.Writeinteger('mp'+inttostr(rr),'height',mp.height);
      inif.Writeinteger('mp'+inttostr(rr),'width',mp.width);

      //p in pa-array?
      mp_a_x:=-1;mp_a_y:=-1;
      for y:=0 to _mp_max do begin
        for x:=0 to _mp_max do begin
          if mp_a[x,y]=nil then continue;
          if mp_a[x,y]<>mp then continue;
          mp_a_x:=x;
          mp_a_y:=y;
          break;
        end;
      end;

      //array-pos speichern (wenn nicht, dann x,y=-1
      inif.Writeinteger('mp'+inttostr(rr),'mp_a_x',mp_a_x);
      inif.Writeinteger('mp'+inttostr(rr),'mp_a_y',mp_a_y);

      rr:=rr+1;
    end;

    info(
      'Ok, MediaPanelyzer-Kollektion '+_cr+_cr+
      '  '+fn+_cr+_cr+
      'gespeichert!'
    );
    collection_afn:=fn;
    collection_opendlg.initialdir:=extractfilepath(fn);
    collection_savedlg.initialdir:=extractfilepath(fn);
    collection_chgok:=false;
  finally
    inif.free;
    screen.Cursor:=crdefault;
  end;
end;

procedure TMainF.collection_save1Click(Sender: TObject);
begin
  if collection_afn='' then
    collection_saveunder1click(sender)
  else
    collection_save(collection_afn);
end;

procedure TMainF.collection_saveunder1Click(Sender: TObject);
var
  fn:string;
begin
  if collection_afn<>'' then
    collection_savedlg.filename:=collection_afn
  else
    collection_savedlg.filename:='collection.mpc';
  if not collection_savedlg.Execute then exit;
  fn:=collection_savedlg.filename;

  if fileexists(fn) then begin
    if application.messagebox(
      pchar('Datei '+fn+' existiert bereits. Wirklich überschreiben?'),
      '*** FRAGE ***',
      mb_yesno
    )=id_no then exit;
  end;

  collection_save(fn);
end;
2.2.7.3. Kollektion zu Einzelbild (Wallpaper)

Kollektionen können über "Collage generieren" auch als Einzelbild im JPG-Format abgespeichert werden. Hier kommt die zweite Form von MediaPanelyzer ins Spiel, die "TColDimF". Über diese können die gewünschten Ausmasse des resultierenden Bildes angegeben werden.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082
00083
00084
00085
00086
00087
00088
00089
00090
00091
00092
00093
00094
00095
00096
00097
00098
00099
00100
00101
00102
00103
00104
00105
00106
00107
00108
00109
00110
00111
00112
00113
00114
procedure TMainF.collection_img_make1Click(Sender: TObject);
var
  l,w,h,t,x,y,maxx,maxy,r:integer;
  fac:double;
  mp:TMediaP;
  fn:string;
  jpg:tjpegimage;
  bmp_collection,
  bmp_media_org,
  bmp_media_thumb:tbitmap;
begin
  //check if there are movies
  for r:=ComponentCount-1 downto 0 do begin
    if not(components[r] is TMediaP) then continue;
    mp:=TMediaP(components[r]);
    if mp.movp=nil then continue;

    error(
      'Sorry, aber Datei '+_cr+_cr+
      '  '+mp.afn+_cr+_cr+
      'ist ein Movie.'+_cr+_cr+
      'Movies können nicht in die Collage integriert werden.'+_cr+
      'Verwenden Sie stattdessen Screenshot generieren.'
    );
    exit;
  end;

  bmp_collection:=tbitmap.Create;
  bmp_collection.PixelFormat:=pf24bit;
  bmp_media_org:=tbitmap.Create;
  bmp_media_org.PixelFormat:=pf24bit;
  bmp_media_thumb:=tbitmap.Create;
  bmp_media_thumb.PixelFormat:=pf24bit;
  try
    maxx:=0;
    maxy:=0;
    for r:=0 to ComponentCount-1 do begin
      if not(components[r] is TMediaP) then continue;
      mp:=TMediaP(components[r]);
      x:=mp.left+mp.width;
      if x>maxx then maxx:=x;
      y:=mp.top+mp.height;
      if y>maxy then maxy:=y;
    end;

    coldimf.factor:=maxx/maxy;
    coldimf.width_se.Value:=maxx;
    coldimf.height_se.Value:=maxy;
    coldimf.ShowModal;
    if not coldimf.rc then exit;

    fac:=coldimf.width_se.Value*100/maxx;

    maxx:=coldimf.width_se.Value;
    maxy:=coldimf.height_se.Value;

    try
      bmp_collection.Width:=maxx;
      bmp_collection.height:=maxy;

      bmp_collection.canvas.brush.color:=canvas.brush.color;
      bmp_collection.canvas.FillRect(rect(0,0,maxx,maxy));

      for r:=0 to ComponentCount-1 do begin
        if not(components[r] is TMediaP) then continue;
        mp:=TMediaP(components[r]);

        l:=round(mp.Left*fac/100);
        t:=round(mp.top*fac/100);
        w:=round(mp.width*fac/100);
        h:=round(mp.height*fac/100);

        bmp_media_org.assign(mp.img.picture.graphic);

        bmp_media_thumb.width:=w;
        bmp_media_thumb.height:=h;
        collection_img_thumb(bmp_media_org,bmp_media_thumb);
        bitblt(
          bmp_collection.Canvas.Handle,l,t,w,h,
          bmp_media_thumb.Canvas.handle,0,0,
          srccopy
        );
      end;

      collection_img_savepicdlg.filename:=formatdatetime('mmdd',now)+'.jpg';
      if not collection_img_savepicdlg.execute then exit;
      fn:=collection_img_savepicdlg.FileName;
      collection_img_savepicdlg.initialdir:=extractfilepath(fn);

      jpg:=tjpegimage.create;
      try
        jpg.Assign(bmp_collection);

        jpg.CompressionQuality:=90;
        if fileexists(fn) then begin
          if application.messagebox(
            pchar('Datei '+fn+' existiert bereits. Wirklich überschreiben?'),
            '*** FRAGE ***',
            mb_yesno
          )=id_no then exit;
        end;
        jpg.SaveToFile(fn);
        object_open(fn);
      finally
        jpg.Free;
      end;
    except
    end;
  finally
    bmp_media_thumb.free;
    bmp_media_org.free;
    bmp_collection.Free;
  end;
end;

Zuerst wird geprüft, ob eventuell Movie-"TMediaP"-Objekte in der Kollektion enthalten sind. Ist dies der Fall, kann die Collage nicht erstellt werden. Es ist mir nämlich nicht gelungen, an die Frame-Bilder der Filme zu kommen.

Danach werden alle "TMediaP"-Objekte, also alle Bilder, durchgegangen und in passender Weise "gethumbnailt" und "aneinander geklebt", so dass am Schluss ein einziges grosses Bild, die Collage, entsteht.

2.2.7.4. Kollektionen grösser als der Sichtbereich

Im Gegensatz zur Screenshot-Funktion (siehe weiter unten) müssen übrigens bei der Collage-Generierung die "TMediaP"-Objekte nicht unbedingt vollständig auf dem Bildschirm angeordnet sein. Es werden auch diejenigen erfasst, die sich unterhalb des sichtbaren Bereiches befinden.

Delphi-Tutorials - MediaPanelyzer - Creating a collage out of the media panels
Collage generieren: Eine Kollektion von 'TMediaP'-Objekten (oben) wird zu einem einzigen grossen Bild umgearbeitet (hier 794 x 726 Pixel gross, Ergebnis kleines Bild unten).
2.2.7.5. Thumbnailing

Die Prozedur zum Thumbnailen der Bilder, "collection_img_thumb", habe ich bereits in einem anderem Tutorial, PicOfPics verwendet - damals nannte ich sie "op_optthumb".

Wie man dort ausserdem nachlesen kann, ist die Prozedur nicht von mir. Und ich weiss auch nach wie vor nicht, wie sie funktioniert. Daher wird hier jetzt einfach nur noch der Source nachgeliefert:

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082
00083
00084
00085
00086
00087
00088
00089
00090
00091
00092
00093
00094
00095
00096
00097
00098
00099
00100
00101
00102
00103
00104
00105
00106
00107
00108
00109
00110
00111
00112
00113
00114
00115
00116
00117
00118
00119
00120
00121
00122
00123
00124
00125
00126
00127
00128
00129
00130
00131
00132
00133
00134
00135
00136
00137
00138
00139
00140
00141
00142
00143
00144
00145
00146
00147
00148
00149
00150
00151
00152
00153
00154
00155
00156
00157
00158
00159
00160
00161
00162
00163
00164
00165
00166
00167
00168
00169
00170
00171
00172
00173
00174
00175
00176
00177
00178
00179
00180
00181
00182
00183
00184
00185
00186
00187
00188
00189
00190
00191
00192
00193
00194
00195
00196
00197
00198
00199
00200
00201
00202
00203
00204
00205
00206
00207
00208
00209
00210
00211
00212
00213
00214
00215
00216
00217
00218
00219
00220
00221
00222
00223
00224
00225
00226
00227
00228
00229
00230
00231
00232
00233
00234
00235
00236
00237
00238
00239
00240
00241
00242
00243
00244
00245
00246
00247
00248
00249
00250
00251
00252
00253
00254
00255
00256
00257
00258
00259
00260
00261
00262
00263
00264
00265
00266
00267
00268
00269
00270
00271
00272
00273
00274
00275
00276
00277
00278
00279
00280
00281
00282
00283
00284
00285
00286
00287
00288
00289
00290
00291
00292
00293
00294
00295
00296
00297
00298
00299
00300
00301
00302
00303
00304
00305
00306
00307
00308
00309
00310
00311
00312
00313
00314
00315
00316
00317
00318
00319
00320
00321
00322
00323
00324
00325
00326
00327
00328
00329
00330
{$R-}
{------------------------------------------------------------------
Baue optimierten collection_img_thumb.

ACHTUNG: Funktioniert nur, wenn bei Compiler-Optionen
         die Bereichsprüfung deaktiviert ist!
-------------------------------------------------------------------}

procedure TMainF.collection_img_thumb(Src,Dst:TBitmap);
type
  // Contributor for a pixel
  TContributor=record
    pixel:integer;            // Source pixel
    weight:single;            // Pixel weight
  end;

  TContributorList=array[0..0] of TContributor;
  PContributorList=^TContributorList;

  // List of source pixels contributing to a destination pixel
  TCList=record
    n:integer;
    p:PContributorList;
  end;

  TCListList=array[0..0] of TCList;
  PCListList=^TCListList;

  TRGB=packed record
    r,g,b:single;
  end;

  // Physical bitmap pixel
  TColorRGB=packed record
    r,g,b:BYTE;
  end;
  PColorRGB=^TColorRGB;

  // Physical bitmap scanline (row)
  TRGBList=packed array[0..0] of TColorRGB;
  PRGBList=^TRGBList;

var
  xscale,yscale:single;            // Zoom scale factors
  i,j,k:integer;            // Loop variables
  center:single;            // Filter calculation variables
  width,fscale,weight:single;            // Filter calculation variables
  left,right:integer;            // Filter calculation variables
  n,cc,ccmod:integer;            // Pixel number
  Work:TBitmap;
  contrib:PCListList;
  rgb:TRGB;
  color:TColorRGB;
  SourceLine,
  DestLine:PRGBList;
  SourcePixel,
  DestPixel:PColorRGB;
  Delta,
  DestDelta:integer;
  SrcWidth,
  SrcHeight,
  DstWidth,
  DstHeight:integer;
  fwidth:single;

  function Color2RGB(Color: TColor): TColorRGB;
  begin
    Result.r:=Color AND $000000FF;
    Result.g:=(Color AND $0000FF00) SHR 8;
    Result.b:=(Color AND $00FF0000) SHR 16;
  end;

  function RGB2Color(Color: TColorRGB): TColor;
  begin
    Result:=Color.r OR (Color.g SHL 8) OR (Color.b SHL 16);
  end;

  function Lanczos3Filter(Value:Single):Single;

    function SinC(Value:Single):Single;
    begin
      if Value<>0.0 then begin
        Value:=Value*Pi;
        Result:=sin(Value)/Value;
      end
      else begin
        Result:=1.0;
      end;
    end;

  begin
    if Value<0.0 then Value:=-Value;
    if Value<3.0 then Result:=SinC(Value)*SinC(Value/3.0)
                 else Result:=0.0;
  end;

begin
  fwidth:=3.0;
  DstWidth:=Dst.Width;
  DstHeight:=Dst.Height;
  SrcWidth:=Src.Width;
  SrcHeight:=Src.Height;
  if (SrcWidth<1)or(SrcHeight<1) then
    raise Exception.Create('Source bitmap too small');

  // Create intermediate image to hold horizontal zoom
  Work:=TBitmap.Create;
  try
    Work.Height:=SrcHeight;
    Work.Width:=DstWidth;
    if SrcWidth=1 then xscale:=DstWidth/SrcWidth
                  else xscale:=(DstWidth-1)/(SrcWidth-1);
    if SrcHeight=1 then yscale:=DstHeight/SrcHeight
                   else yscale:=(DstHeight-1)/(SrcHeight-1);
    Src.PixelFormat:=pf24bit;
    Dst.PixelFormat:=Src.PixelFormat;
    Work.PixelFormat:=Src.PixelFormat;

    // --------------------------------------------
    // Pre-calculate filter contributions for a row
    // -----------------------------------------------
    GetMem(contrib,DstWidth*sizeof(TCList));

    // Horizontal sub-sampling
    // Scales from bigger to smaller width
    if xscale<1.0 then begin
      width:=fwidth/xscale;
      fscale:=1.0/xscale;

      for i:=0 to DstWidth-1 do begin

        contrib^[i].n:=0;
        GetMem(contrib^[i].p,trunc(width*2.0+1)*sizeof(TContributor));
        center:=i/xscale;
        // Original code:
        // left := ceil(center - width);
        // right := floor(center + width);
        left:=floor(center-width);
        right:=ceil(center+width);
        for j:=left to right do begin
          weight:=Lanczos3Filter((center-j)/fscale)/fscale;
          if weight=0.0 then continue;
          if      j<0         then n := -j
          else if j>=SrcWidth then n := SrcWidth - j + SrcWidth - 1
          else                     n := j;
          k:=contrib^[i].n;
          contrib^[i].n:=contrib^[i].n+1;

          //fliegt bei k=1 ab (0 geht noch) bei aktiver bereichsprüfung
          //so gehts auch nicht: contrib[i].p[k].pixel:=n;

          contrib^[i].p^[k].pixel:=n;
          contrib^[i].p^[k].weight:=weight;
        end;
      end;
    end
    else begin
      // Horizontal super-sampling
      // Scales from smaller to bigger width
      for i:=0 to DstWidth-1 do begin

        contrib^[i].n:=0;
        GetMem(contrib^[i].p,trunc(fwidth*2.0+1)*sizeof(TContributor));
        center:=i/xscale;
        // Original code:
        // left := ceil(center - fwidth);
        // right := floor(center + fwidth);
        left:=floor(center-fwidth);
        right:=ceil(center+fwidth);
        for j:=left to right do begin
          weight:=Lanczos3Filter(center-j);
          if weight=0.0 then continue;
          if      j<0         then n:=-j
          else if j>=SrcWidth then n:=SrcWidth-j+SrcWidth-1
                              else n:=j;
          k:=contrib^[i].n;
          contrib^[i].n:=contrib^[i].n+1;
          contrib^[i].p^[k].pixel:=n;
          contrib^[i].p^[k].weight:=weight;
        end;
      end;
    end;

    // ----------------------------------------------------
    // Apply filter to sample horizontally from Src to Work
    // ----------------------------------------------------

    for k:=0 to SrcHeight-1 do begin

      SourceLine:=Src.ScanLine[k];
      DestPixel:=Work.ScanLine[k];
      for i:=0 to DstWidth-1 do begin
        rgb.r:=0.0;
        rgb.g:=0.0;
        rgb.b:=0.0;
        for j:=0 to contrib^[i].n-1 do begin
          color:=SourceLine^[contrib^[i].p^[j].pixel];
          weight:=contrib^[i].p^[j].weight;
          if weight=0.0 then continue;
          rgb.r:=rgb.r+color.r*weight;
          rgb.g:=rgb.g+color.g*weight;
          rgb.b:=rgb.b+color.b*weight;
        end;
        if      rgb.r>255 then color.r:=255
        else if rgb.r<0.0 then color.r:=0
        else                   color.r:=round(rgb.r);
        if      rgb.g>255 then color.g:=255
        else if rgb.g<0.0 then color.g:=0
        else                   color.g:=round(rgb.g);
        if      rgb.B>255 then color.b:=255
        else if rgb.b<0.0 then color.b:=0
        else                   color.b:=round(rgb.b);
        // Set new pixel value
        DestPixel^:=color;
        // Move on to next column
        inc(DestPixel);
      end;
    end;

    // Free the memory allocated for horizontal filter weights
    for i:=0 to DstWidth-1 do FreeMem(contrib^[i].p);
    FreeMem(contrib);

    // -----------------------------------------------
    // Pre-calculate filter contributions for a column
    // -----------------------------------------------
    GetMem(contrib,DstHeight*sizeof(TCList));
    // Vertical sub-sampling
    // Scales from bigger to smaller height
    if yscale<1.0 then begin
      width:=fwidth/yscale;
      fscale:=1.0/yscale;

      for i:=0 to DstHeight-1 do begin

        contrib^[i].n:=0;
        GetMem(contrib^[i].p,trunc(width*2.0+1)*sizeof(TContributor));
        center:=i/yscale;
        // Original code:
        // left := ceil(center - width);
        // right := floor(center + width);
        left:=floor(center-width);
        right:=ceil(center+width);
        for j:=left to right do begin
          weight:=Lanczos3Filter((center-j)/fscale)/fscale;
          if (weight = 0.0) then continue;
          if (j < 0) then n := -j
          else if (j >= SrcHeight) then n := SrcHeight - j + SrcHeight - 1
          else n := j;
          k := contrib^[i].n;
          contrib^[i].n := contrib^[i].n + 1;
          contrib^[i].p^[k].pixel := n;
          contrib^[i].p^[k].weight := weight;
        end;
      end
    end
    else begin
      // Vertical super-sampling
      // Scales from smaller to bigger height
      for i := 0 to DstHeight-1 do begin

        contrib^[i].n := 0;
        GetMem(contrib^[i].p, trunc(fwidth * 2.0 + 1) * sizeof(TContributor));
        center := i / yscale;
        // Original code:
        // left := ceil(center - fwidth);
        // right := floor(center + fwidth);
        left := floor(center - fwidth);
        right := ceil(center + fwidth);
        for j := left to right do begin
          weight := Lanczos3Filter(center - j);
          if (weight = 0.0) then continue;
          if (j < 0) then n := -j
          else if (j >= SrcHeight) then n := SrcHeight - j + SrcHeight - 1
          else n := j;
          k := contrib^[i].n;
          contrib^[i].n := contrib^[i].n + 1;
          contrib^[i].p^[k].pixel := n;
          contrib^[i].p^[k].weight := weight;
        end;
      end;
    end;

    // --------------------------------------------------
    // Apply filter to sample vertically from Work to Dst
    // --------------------------------------------------
    SourceLine := Work.ScanLine[0];
    Delta := integer(Work.ScanLine[1]) - integer(SourceLine);
    DestLine := Dst.ScanLine[0];
    DestDelta := integer(Dst.ScanLine[1]) - integer(DestLine);
    for k := 0 to DstWidth-1 do begin

      DestPixel := pointer(DestLine);
      for i := 0 to DstHeight-1 do begin
        rgb.r := 0;
        rgb.g := 0;
        rgb.b := 0;
        // weight := 0.0;
        for j := 0 to contrib^[i].n-1 do begin
          color := PColorRGB(integer(SourceLine)+contrib^[i].p^[j].pixel*Delta)^;
          weight := contrib^[i].p^[j].weight;
          if (weight = 0.0) then continue;
          rgb.r := rgb.r + color.r * weight;
          rgb.g := rgb.g + color.g * weight;
          rgb.b := rgb.b + color.b * weight;
        end;
        if (rgb.r > 255.0) then color.r := 255
        else if (rgb.r < 0.0) then color.r := 0
        else color.r := round(rgb.r);
        if (rgb.g > 255.0) then color.g := 255
        else if (rgb.g < 0.0) then color.g := 0
        else color.g := round(rgb.g);
        if (rgb.b > 255.0) then color.b := 255
        else if (rgb.b < 0.0) then color.b := 0
        else color.b := round(rgb.b);
        DestPixel^ := color;
        inc(integer(DestPixel), DestDelta);
      end;
      Inc(SourceLine,1);
      Inc(DestLine,1);
    end;

    // Free the memory allocated for vertical filter weights
    for i := 0 to DstHeight-1 do FreeMem(contrib^[i].p);
    FreeMem(contrib);

  finally
    Work.Free;
  end;
end;
{$R+}
2.2.7.6. Screenshots des Sichtbereichs

Alternativ zur Collage kann eine Kollektion auch über den Untermenü-Punkt "Screenshot generieren" zu einem Bild zusammengefasst werden.

Nachteil dieser Methode ist, dass alle "TMediaP"-Objekte vollständig in "TMainF" zu sehen sein müssen. Objekte, die sich ausserhalb des sichtbaren Bereiches befinden, werden ignoriert. Auch kann der Screenshot natürlich nicht grösser sein als die aktuelle Auflösung des Bildschirms.

Vorteilhaft ist hingegen, dass man nun auch die Bildinformation von Movie-"TMediaP"-Objekten in das Ergebnisbild einfliessen lassen kann.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
procedure TMainF.collection_screenshot_make1Click(Sender: TObject);
var
  bmp:tbitmap;
  jpg:tjpegimage;
  fn:string;
  DeskTopDC:HDc;
  DeskTopCanvas:TCanvas;
  r,max_w,max_h:integer;
  mp:TMediaP;
begin
  screen.Cursor:=crhourglass;

  //deactive active object
  sh_off;

  //deactivate hints, get max width and height
  max_w:=0;
  max_h:=0;
  for r:=0 to ComponentCount-1 do begin
    if components[r] is TMediaP then begin
      mp:=TMediaP(components[r]);
      mp.ShowHint:=false;
      if mp.Left+mp.width>max_w then max_w:=mp.Left+mp.width;
      if mp.top+mp.height>max_h then max_h:=mp.top+mp.height;
    end;
  end;
  if max_w>screen.Width then max_w:=screen.width;
  if max_h>screen.height then max_h:=screen.height;

  //make screenshot into bmp
  bmp:=tbitmap.Create;
  jpg:=tjpegimage.create;
  try
    DeskTopDC:=GetDC(Handle);
    DeskTopCanvas:=TCanvas.Create;
    try
      DeskTopCanvas.Handle:=DeskTopDC;
      bmp.width:=max_w;
      bmp.height:=max_h;
      bmp.Canvas.CopyRect(
        rect(0,0,max_w,max_h),
        DeskTopCanvas,
        rect(0,0,max_w,max_h)
      );
      ReleaseDC(GetDeskTopWindow,DeskTopDC);
    finally
      DeskTopCanvas.Free;
    end;

    //konvert to jpg
    jpg.Assign(bmp);
    screen.Cursor:=crdefault;

    //save jpg
    fn:=formatdatetime('yymmdd',now)+'.jpg';
    collection_img_savepicdlg.filename:=fn;
    if not collection_img_savepicdlg.execute then exit;
    fn:=collection_img_savepicdlg.filename;
    collection_img_savepicdlg.initialdir:=extractfilepath(fn);
    jpg.CompressionQuality:=90;
    if fileexists(fn) then
      if application.messagebox(
        pchar(
          'Datei '+fn+' existiert bereits.'+_cr+_cr+
          'Wirklich überschreiben?'
        ),
        '*** FRAGE ***',
        mb_yesno
      )=id_no then exit;
    jpg.SaveToFile(fn);

    //show jpg as new object
    object_open(fn);
  finally
    jpg.Free;
    bmp.free;
  end;
end;

Zuerst bestimmen wir die Ausmasse unseres Ergebnisbildes. Ausgehend von der linken oberen Ecke muss es genau so breit sein, wie das am weitesten rechts liegende Pixel eines "TMemdiaP"-Objektes ("max_w"), und genau so hoch, wie das am tiefsten liegende Pixel ("max_h").

Anschliessend holen wir uns das Handle vom Desktop. Da alle Applikationen bei Windows "Kinder" vom Desktop sind, und unsere Anwendung im Vordergrund liegt, erhalten wir über "DeskTopCanvas.Handle:=DeskTopDC" Zugriff auf den Canvas mit all seinen Bildinformationen. Diesen kopieren wir in die temporäre Bitmap "bmp". Nun die Bitmap noch in ein "JPG"-Image "jpg" konvertiert und abgespeichert, fertig ist unser Screenshot.

Die "TForm" von Delphi bietet übrigens eine Funktion an, über die man die aktuelle Form direkt in eine Bitmap kopieren kann ("GetFormImage"). Das funktioniert mit den Bilder-"TMediaP"-Objekten auch einwandfrei, nicht jedoch mit den Movie-"TmediaP"-Objekten - warum auch immer.

2.2.8. "TMainF": Und die Restliche Menü-Funktionen

Die restlichen Menü-Punkte von MediaPanelyzer "Verlauf", "Über MediaPanelyzer" und "Beenden" sind wenig anspruchsvoll und seien hiermit schnell abgehakt:

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
procedure TMainF.history_go1click(sender:tobject);
var
  mi:tmenuitem;
begin
  mi:=tmenuitem(sender);
  object_open(mi.Hint);
end;

procedure TMainF.about1Click(Sender: TObject);
begin
  application.MessageBox(_about,'*** MEDIAPANELYZER ***',mb_ok);
end;

procedure TMainF.close1Click(Sender: TObject);
begin
  close;
end;

2.3. Unit "coldimu.pas" und Form "TColDimF"

Kommen wir nun zur zweiten "TForm" von MediaPanelyzer. Wie wir weiter oben gesehen haben, dient die "TColDimF" dazu, die Grössen-Parameter für ein Collage-Bild zu holen.

2.3.1. Eingabe der Collage-Dimension

Sowie das das Fenster erscheint, wird automatisch das SpinEdit "width_se" für die Breite aktiviert. Änderungen des Breite-Wertes resultieren automatisch in Änderungen des Höhen-Wertes (und umgekehrt), wobei der zuvor gesetzte "factor" zur Berechnung herangezogen wird.

Drückt man den "Ok"-Button bzw. die RETURN-Taste, wird die globale boolesche Variable "rc" auf "true" gesetzt. Drückt man dagegen den "Abbruch"-Button bzw. die ESCAPE-Taste, wird "rc" auf "false" gesetzt. In beiden Fällen schliesst sich die Form anschliessend wieder.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
procedure Tcoldimf.FormShow(Sender: TObject);
begin
  rc:=false;
  activecontrol:=width_se;
end;

procedure Tcoldimf.width_seChange(Sender: TObject);
begin
  if activecontrol<>width_se then exit;
  try
    height_se.Value:=round(width_se.Value/factor);
  except
  end;
end;

procedure Tcoldimf.height_seChange(Sender: TObject);
begin
  if activecontrol<>height_se then exit;
  try
    width_se.Value:=round(height_se.Value*factor);
  except
  end;
end;

procedure Tcoldimf.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if      key=vk_return then okbclick(sender)
  else if key=vk_escape then breakbclick(sender);
end;

procedure Tcoldimf.okbClick(Sender: TObject);
begin
  rc:=true;
  close;
end;

procedure Tcoldimf.breakbClick(Sender: TObject);
begin
  close;
end;

2.3.2. DirectShow-Blockade für Screenshots

Da der Source für "TColDimF" bisher ungleich weniger umfangreich ausfällt als für "TMainF", wurde hier der ausserdem der Algorithmus für die "DirectShow-Blockade" untergebracht.

2.3.2.1. DirectShow verbirgt Informationen

DirectShow ist im Prinzip eine feine Sache: Diese Windows-Grafik-API erlaubt den direkten Zugriff auf die Grafikkarte, was flüssigere Bilder ermöglicht. Die Delphi-Komponente "TMediaPlayer", die wir intern in "TMovP" einsetzen, macht davon automatisch Gebrauch. Allerdings in zwangsläufiger Weise, d.h., DirectShow lässt sich hierfür nicht so ohne weiteres abschalten.

Das hat aber einen grossen Nachteil: Die Bildinformationen der Movies in "TMovP"-Objekten sind quasi vom Betriebssystem abgekapselt. Man sieht sie zwar, kommt programmtechnisch aber nicht mehr an sie dran. zumindest nicht, ohne sich durch einen schwer verdaulichen Wust von DirectShow-API-Befehlen zu kämpfen.

Das merkt man z.B., wenn man versucht, über die "Druck"-Taste einen Screenshot von einem in "TMediaPlayer" abgespielten Movie zu machen: Man erhält nur einen schwarzen Rahmen zurück. Den gleichen Effekt erlebt man übrigens ebenso bei (allen) anderen Movie-Playern. Und nicht zuletzt auch leider bei der Screenshot-Funktion, die im MediaPanelyzer eingebaut ist.

2.3.2.2. DirectShow deaktivieren ...

Unter Windows XP konnte das Problem noch leicht umgangen werden. Im "System32"-Ordner gibt es das Tool "dxdiag.exe". Darüber lässt sich DirectShow systemweit dauerhaft deaktivieren. Danach sind dann Screenshots von Movies wieder problemlos möglich.

2.3.2.3. ... klappt nicht immer

Das Tool existiert auch bei Windows Vista. Zu meiner Überraschung lässt sich hier aber DirectShow nicht mehr deaktivieren; die entsprechenden Knöpfe sind - zumindest bei meiner Grafikkarte - abgeschaltet. Und das es bald neue Grafikkarten-Treiber gibt, die DirectShow explizit zu umgehen erlauben, erscheint wenig wahrscheinlich.

2.3.2.4. Die Lösung: DirectShow anderweitig beschäftigen

Glücklicherweise kann sich DirectShow aber offenbar immer nur auf eine Grafikausgabe auf einmal konzentrieren. Spielt man nämlich mehrere Movies gleichzeitig ab, sind Screenshots bei aktivem DirectShow durchaus möglich, ausser bei dem Film, der als erstes gestartet wurde.

2.3.2.5. Generierung eines Dummy-Movies

Um also ordentliche Screenshots mit MediaPanelyzer machen zu können, muss nur dafür gesorgt werden, dass DirectShow von einem "Dummy"-Movie in Beschlag genommen wird. Und dieses sollte möglichst unmittelbar nach Programmstart gestartet werden.

Wir setzen den Plan im "OnCreate"-Ereignis von "ColDimF" um.

Innerhalb des "const"-Teils legen wir zuerst ein Byte-Array "_dummymv" an, welches die Daten für ein Mini-"Dummy"-M1V enthält.

Bei der Formerzeugung wird dann zunächst geprüft, ob das "Dummy"-Movie bereits im Arbeitsordner existiert. Falls nicht, schreiben wir das Byte-Array als M1V-Movie-Datei auf die Festplatte. Anschliessend öffnen wir es mit der unsichtbaren "TMediaPlayer"-Komponente von "TColDimF", "video", - und schon ist DirectShow lahmgelegt.

Nicht unbedingt die eleganteste Methode, aber sie funktioniert.

2.3.2.6. Umweg über Festplatte

Leider war übrigens der etwas umständliche Umweg über die Festplatte nötig, denn es ist mir nicht gelungen, die Byte-Array-Daten als Memory-Stream direkt an "video" zu verfüttern, wie das etwa bei WAVE-Sounds funktioniert.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
const
  //dummy movie for activex-holder
  _dummymvlen=3226;
  _dummymvfn='dummy.m1v';

  _dummymv:array[0.._dummymvlen] of byte=(
      0,  0,  1,179,  4,  0, 64, 21,  0,250, 32,165, 16, 17, 17, 18, 18, 18, 19, 19,
     19, 19, 20, 20, 20, 20, 20, 21, 21, 21, 21, 21, 21, 22, 22, 22, 22, 22, 22, 22,
     23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 25, 24, 24, 24, 25, 26, 26, 26, 26,
[...]
      0,  0,  0,  0,  0,  1,183
  );

[...]

implementation

procedure Tcoldimf.FormCreate(Sender: TObject);
var
  f:file;
  rc:integer;
begin
  mainp.ParentBackground:=false;mainp.color:=clsilver;

  //exists dummy-movie?
  if not fileexists(mainf.homedir+_dummymvfn)then begin
    //no: create it
    assignfile(f,mainf.homedir+_dummymvfn);
    rewrite(f,1);
    BlockWrite(f,_dummymv,_dummymvlen+1,rc);
    closefile(f);
  end;

  video.FileName:=mainf.homedir+_dummymvfn;
  try
    video.Open;
    video.Stop;
  except
  end;
end;

2.4. "TMediaPlayer" weniger wählerisch machen

So, geschafft, der Programm-Source von MediaPanelyzer ist durch. Es folgen nun noch ein paar Hinweise, die die Nutzbarkeit des Programms vielleicht etwas erweitern können.

Die Möglichkeit, Filme über die "TMediaPlayer"-Komponente von Delphi in eigene Programme einbinden zu können, ist ja eine tolle Sache. Leider ist die Komponente von Haus aus ziemlich wählerisch und spielt deutlich weniger Formate ab als etwa der Windows MediaPlayer.

2.4.1. Registry-Eingriffe

Es hat mich einigen Schweiss gekostet, bis ich endlich herausfand, was zu tun ist, um der "TMediaPlayer"-Komponente auch andere Movie-Formate schmackhaft zu machen. Wie so oft bei Windows führt der Weg über die Registry. Bastelt man hier ein wenig herum, kann man im Prinzip alle Formate, die der Windows MediaPlayer abspielt, auch für den "TMediaPlayer" zugänglich machen.

2.4.1.1. AVIs für den Delphi-Player

Will man etwa "AVI"-Dateien abspielen, können folgende Eintragungen vorgenommen werden:

00001
00002
(1) HKEY_LOCAL_MACHINE\Software\Microsoft\Windows NT\CurrentVersion\MCI32
(2) (Neue) Zeichenfolge 'AVIVideo' von 'mciavi32.dll' nach 'mciqtz32.dll' ändern.
2.4.1.2. FLVs und MOVs für den Delphi-Player

Um an "FLV"- und "MOV"-Movies heranzukommen, hat sich diese Vorgehensweise als erfolgreich erwiesen:

00001
00002
00003
(1) HKEY_LOCAL_MACHINE\Software\Microsoft\Windows NT\CurrentVersion\MCIECTENSIONS
(2) (Neue) Zeichenfolge 'MOV' auf 'MPEGVideo' setzen
(2) (Neue) Zeichenfolge 'FLV' auf 'MPEGVideo' setzen

2.4.2. K-Lite Codec Pack-Optionen

Falls jemand das "K-Lite Codec Pack" verwendet, wird er feststellen, das die "TMovP"-Komponente des MediaPanelyzer-Tools zwar "AVI"-Filme abspielt, die ScrollBar aber keine Positionsänderung mehr durchführt. Um diese wieder zu aktivieren, habe ich folgenden Methode angewendet:

00001
00002
00003
00004
(1) Im 'Tool'-Menü des K-Lite Codec Packs' das Programm 'Codec Tweak Tool' starten.
(2) Direct Show Filter Management (K-Lite Codec Pack)
(3) Disable the following filters
(4) Haken bei 'AVI Splitter (Gabest)' rein

Obige Änderungen an der Registry sind natürlich mit Vorsicht zu geniessen.

Der Trick ist ja offenbar, dem System vorzugaukeln, eine Datei mit "FLV"-, "MOV"- oder "AVI"-Extension sei in Wirklichkeit ein "MPG"-Movie. Dadurch erst wird die Datei von der "TMediaPlayer"-Komponente akzeptiert. Wird sie dann geöffnet, erkennt Windows aber automatisch das echte Format und verwendet die passenden Codecs.

Ich habe bisher jedenfalls keinerlei Nachteile aufgrund dieser "Umbiege-Geschichte" feststellen können.

3. Kleines Fazit

MediaPanelyzer ist kein sonderlich anspruchsvolles Programm. Um so erstaunlicher, dass mir kein anderes derartiges Tool bekannt ist.

Zumindest im Freundeskreis hat es sich als recht beliebt erwiesen, erlaubt es doch beispielsweise, auf relativ einfache und schnelle Weise, sich Collagen aus Fotos der letzten Party zu generieren, und diese dann als Poster an die Wand zu hängen oder per Mail an die Kumpels zu schicken.

Ab und zu fliegt das Programm ab, etwa wenn zu viele Movies auf einmal abgespielt werden (bei mir liegt die Grenze so bei 5-8 Filmen gleichzeitig). Auch die "Wartung" des zweidimensionalen "TMediaP"-Arrays ist nicht durchgängig gelungen. Zudem ist unschön, dass dieses nicht dynamisch erweiterbar ist, sondern derzeit auf 200 Einträge fixiert.

So etwas verdirbt mir jedenfalls nicht den Spass an meinem Proggy. Ist halt nichts 100%iges. But who cares?

4. Download von MediaPanelyzer

MediaPanelyzer wurde in Delphi 7 programmiert, sollte aber auch mit anderen Versionen funktionieren. Im ZIP-File enthalten ist der komplette Sourcecode sowie die ausführbare EXE für alle die, die kein Delphi ihr eigen nennen.

MediaPanelyzer.zip (350 kB)

Have Fun!