MediaPanelyzer
Media-Panelyzer-Tutorial von Daniel Schwamm (21.01.2009 - 02.02.2009)
Inhalt
Die nächsten zwei Wochen habe ich Urlaub. Gute Gelegenheit, ein neues
Tutorial an den Start zu bringen.
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.
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 :-)
Demo-Screenshot vom MediaPanelyzer: Alle Medien im Griff und auf einem Blick.
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.
Zwei Form-Units für MediaPanelyzer: Unit 'mainu.pas' mit dem Formular 'TMainF' (oben)
und Unit 'coldimu.pas' mit dem Formular 'TColDimF' (unten).
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;
Das Movie-Panel "TMovP" ist folgendermassen aufgebaut:
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 ...
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;
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;
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).
Ü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;
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;
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;
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.
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;
Der Aufbau des "TMediaP"-Objekts sieht folgendermassen aus:
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.
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;
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;
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.
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;
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;
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.
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;
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.
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.
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.
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;
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;
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;
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;
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;
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.
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.
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;
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;
Ü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;
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).
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.
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;
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;
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;
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:
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).
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.
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.
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;
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;
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.
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.
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;
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
und bei Sortierung nach Grösse
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.
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:
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:
-
Wir holen uns alle Breiten der "TMovP"-Objekte in ein Array "w_a".
-
Dieses Array wird "gewürfelt", sprich, die Reihenfolge wir in zufälliger
Weise geändert und in "wnew_a" gesichert.
-
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".
-
Nun werden noch einmal alle "Zeilen" durchlaufen. Schmalere Zeilen
als "wmax" bedeuten Leerfläche, die Differenz wird daher jeweils
auf die Fehlersumme "err" aufaddiert.
-
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").
-
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.
-
Der Vorgang wird "_inner_trys"-mal wiederholt.
-
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
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;
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;
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.
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.
Popup-Menü mit Kollektionsfunktionen: Funktionen zur Verwaltung fertiger Collagen wie Speichern, Öffnen, Screenshots usw.
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.
Ü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;
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.
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.
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).
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+}
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.
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;
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.
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;
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.
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.
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.
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.
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.
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.
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;
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.
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.
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.
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
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.
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?
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!