Napisy do filmów
Adam Boduch
Nie jest to takie proste, gdyż nie istniają gotowe funkcje typu
LoadTextToMovie :) Trzeba sobie trochę popisać. Gotowiec, który tutaj
przedstawiam umożliwia wyświetlanie napisów do filmów, ale jest warunek.
Plik musi być zapisany w formacie czasowym, a nie ramkowym.
do programu użyłem kontrolki ActiveX - SynVideo. to z prostego powodu -
standardowe TMediaPlayer nie radzi sobie z filmami zakodowanymi w DivX. Tą
kontrolkę ActiveX powinieneś mieć w swoim systemie. Z menu Components wybierz Import ActiveX Control. Następnie z listy odszukaj pozycję
SynVideo, zaznacz ją i naciśnij przycisk Install. Jeżeli nie masz takiej
kontrolki - dołączyłem ją do kodu źródłowego programu, który możesz
ściągnąć stąd: www.4programmers.net/programmes/reyalp.zip
Tak więc zaczynamy. W swoim programie stworzyłem moduł VideoTxt, który
zawiera klasę TVideoText, która jest dziedziczona z klasy TThread. Klasa ta przedstawia się następująco:
type
TVideoText = class(TThread)
private
FText : TStringList; // tutaj przechowywane sa napisy
protected
procedure Execute; override;
public
constructor Create(VideoText : string);
destructor Destroy; override;
function ShowText(Time: TTime) : string; virtual; // procedura, sluzy
do wyswietlania tekstu
end;
Kluczową rolę odgrywa tutaj funkcja ShowText, która interpretuje plik i zwraca tekst do wyświetlenia.
function TVideoText.ShowText(Time: TTime): string;
var
I : Integer;
iTime : TTime;
iString : string;
begin
{
w tej proceudrze parametr jest typu TTime, ktory zawiera czas odtwarzania
filmu. Na tej podstawie przeszukiwany zostaje plik tekstowy. Kazda linia jest
podzielona na dwie czesci - pierwsza: czas wyswietlania tekstu oraz tekst
do wyswietlenia. Nastepnie pierwsza czesc zostaje porownana z parametrem Time.
}
Result := '';
for I := 0 to FText.Count -1 do
begin
iTime := StrToTime(Copy(FText[i], 1, 8)); // skopiuj do zmiennej czas
iString := Copy(FText[i], 10, Length(FText[i]) - 8); // skopiuj do
zmiennej tekst
if iTime = Time then Result := iString;
end;
end;
Jednak zasada jej działania jest prosta. W pętli analizuje napisy, które zostają wcześniej załadowane do zmiennej FText. Rozbija każdą linijkę na
dwie części - czas wyświetlenia napisu oraz sam napis. Wszystko to za pomocą funkcji Copy. Zauważyłeś zapewne, że funkcja ShowText zawiera parametr Time typu TTime. Ten parametr zawierać będzie czas odtwarzania filmu w formie zmiennej TTime. Jeżeli parametr oraz zmienna iTime będą
takie same funkcja zwraca napis do filmu - zmienną iString.
Oto kod całego modułu:
(****************************************************************)
(* *)
(* Copyright (c) 2002 by Adam Boduch *)
(* http://4programmers.net *)
(* adam@4programmers.net *)
(* *)
(****************************************************************)
unit VideoTxt;
interface
uses Windows, Classes, ExtCtrls, SysUtils, Controls;
const TimeOut = 5; // czas wyswietlania napisu
type
TVideoText = class(TThread)
private
FText : TStringList; // tutaj przechowywane sa napisy
protected
procedure Execute; override;
public
constructor Create(VideoText : string);
destructor Destroy; override;
function ShowText(Time: TTime) : string; virtual; // procedura, sluzy
do wyswietlania tekstu
end;
implementation
{ TVideoText }
constructor TVideoText.Create(VideoText : string);
begin
inherited Create(FALSE);
FText := TStringList.Create; // stworz zmienna
FText.LoadFromFile(VideoText); // zaladuj tekst filmu do pliku
end;
destructor TVideoText.Destroy;
begin
FText.Free; // zwolnij zmienna
inherited Destroy;
end;
procedure TVideoText.Execute;
begin
end;
function TVideoText.ShowText(Time: TTime): string;
var
I : Integer;
iTime : TTime;
iString : string;
begin
{
w tej proceudrze parametr jest typu TTime, ktory zawiera czas odtwarzania
filmu. Na tej podstawie przeszukiwany zostaje plik tekstowy. Kazda linia
jest
podzielona na dwie czesci - pierwsza: czas wyswietlania tekstu oraz tekst
do wyswietlenia. Nastepnie pierwsza czesc zostaje porownana z parametrem Time.
}
Result := '';
for I := 0 to FText.Count -1 do
begin
iTime := StrToTime(Copy(FText[i], 1, 8)); // skopiuj do zmiennej czas
iString := Copy(FText[i], 10, Length(FText[i]) - 8); // skopiuj do
zmiennej tekst
if iTime = Time then Result := iString;
end;
end;
end.
Tak więc Engine :) naszego programu już mamy. Teraz pozostała do
rozwiązania równie ważna o ile nie wazniejsza sprawa - interpretacja długości filmu oraz pozycji odtwarzania. Kontrolka ActiveX SynVideo (dalej
nazywać ją będę po prostu Video), która zostaje tutaj użyta podaje długość filmu w sekundach. Teraz nasza rola, aby rozbić tę wartość na godziny,
minuty oraz sekundy. Odpowiadać za to będzie funkcja Convert:
function TMainForm.Convert(Time: Integer): TTime;
{
ta procedura przeksztalca parametr Time, ktory zawiera czas trwania
filmu lub
jego pozycje. Parametr ten jest typu Integer, ktory trzeba nastepnie
rozbic na godziny, minuty i sekundy. ZAZNACZAM jednak, ze procedura ta
nie
jest do konca dopracowana i moze zawierac bledy.
Parametr tej procedury zawiera zmienna typu Integer, ktora to zawiera
ilosc sekund - np. 247.
}
var
MSec : Integer;
Sec, Min, Hour : Word;
begin
MSec := Time;
{ uzyskujemy liczbe minut z filmu - np. 247 div 60 = 4,.. }
Min := MSec div 60;
{ teraz uzyskujemy liczbe godzin - np. 4 div 60 = 0 }
Hour := Min div 60;
Sec := MSec - (Min * 60);
{ jezeli liczba minut jest wieksza od 60 to odejmujemy od tej liczby
godzine }
if Min > 60 then
Min := Min - 60;
{ tutaj uzyskujemy liczbe sekund }
{ na podstawie wszystkich danych formuujemy zmienna typu TTime }
Result := EncodeTime(Hour, Min, Sec, 0);
end;
Funkcja zwraca zmienną w postacii TTime, czyli np. 00:04:07
Przyjrzyjmy się jej dokładniej... Załóżmy, że parametr tej funkcji zawiera
liczbę Integer - np. 247 która oznacza długość trwania filmu - 247 sek.
Funkcja ta najpierw z tej wartości wyłania ilość minut: 247 div 60 = 4 min.
to już mamy. Teraz liczbę godzin - tutaj będziemy dzielić liczbę minut na godziny: 4 min div 60 = 0 h. Teraz sekundy: od 247 odejmujemy liczbę minut
pomnożoną przez 60, czyli: 247 - (4 * 60) = 7 sek. Mamy czas filmu:
00:04:07. W tej funkcji jest jeszcze jeden warunek. Jeżeli liczba minut
jest większa od 60 to znaczy, że trwa od dłużej niż godzinę - np. jeżeli
zmienna Min zawiera liczbę 105 (min) to odejmujemy od niej liczbę 60 i
zostaje czas w minutach: 45 min. Następnie wszystko zostaje łączone
do "kupy" za pomocą funkcji EncodeTime.
Komponent Video zawiera zdarzenie OnProgress, które jest wywołuywane
podczas odtwarzania filmu. Zawiera ono informacje jak np. czas, który
upłynoł od początku filmu. W przypadku zwykłego MediaPlayer'a należałoby
korzystać z komponentu Timer. Oto obsługa zdarzenia OnProgress:
procedure TMainForm.VideoPlayProgress(Sender: TObject; progressInPercent,
timeFromBegin: Integer);
begin
{ ta procedura pokazuje proces w odtwarzaniu filmu. Na pasku wyswietl czas
ktory
uplynol od czasu wlaczenia filmu oraz pozostaly czas filmu }
StatusBar.Panels[1].Text := TimeToStr(Convert(timeFromBegin)) + '/' +
TimeToStr(Convert(Video.GetTotalTime));
PaintTheText(VideoText.ShowText(Convert(timeFromBegin))); // namaluj tekst
Track.Position := progressInPercent; // pokaz na pasku proces postepu
end;
Na pasku stanu programu będzie wyświetlany czas, który upłynoł od poczatku
filmu oraz całkowity czas trwania utworu. Przy tej okazji będziemy
korzystać z napisanej przez nasz wcześniej funkcji Convert. Tutaj jak
zapewne zauważyłeś wywoływana zostaje także funkcja PaintTheText (zaraz ją
napiszemy). to ona będzie wyświetlała tekst na komponencie. Tutaj
skorzystamy także z naszej klasy TVideoText, a konktretnie z jej funkcji - ShowText.
Oto procedura PaintTheText:
procedure TMainForm.PaintTheText(const Text: string);
begin
{
ta procedura wyswietla napisy do filmu, a konkretnie maluje je na
komponencie
Video korzystajac z funkcji API - DrawText. Czas ktory potrzebny jest na
wyswietlenie
napisu okreslony jest w stalej TimeOut w module VideoTxt. Jezeli ten czas
uplynie
to nastepuje odswiezenie obszaru komponentu
}
if (Length(Text) = 0) and (iTimeOut >= TimeOut) then
begin
Video.Repaint;
iTimeOut := 0;
end else if (Length(Text) > 0) and (iTimeout < TimeOut) then begin
Video.Repaint; end;
DrawText(VideoCanvas.Handle, PChar(Text), -1, R, DT_CENTER);
Inc(iTimeOut); // zwieksz zmienna
end;
W module VideoTxt zadeklarowana została stała oznaczająca czas po którym
napis zniknie. Tutaj ją należy wykorzystać. Także odświeżenie komponentu
Video nastąpi dopiero po domyślnych 5 sek. Oto właściwie wszystkie
potrzebne nam funkcje. Oto cały kod źródłowy programu:
(****************************************************************)
(* *)
(* Copyright (c) 2002 by Adam Boduch *)
(* http://4programmers.net *)
(* adam@4programmers.net *)
(* *)
(****************************************************************)
(*
UWAGA!
-----
Ja jako autor nie odpowiadam za prawidlowe dzialanie tego programu.
Zaznaczam, ze jest to tylko projekt, a nie kompletny program i moze
zawierac bledy. Ja tylko podsunelem Ci pomysl, na rozwizanie tego
zadania...
od Ciebie zalezy reszta...
*)
unit MainFrm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
OleCtrls, StdCtrls, ExtCtrls, ComCtrls, MPlayer, VideoTxt, ToolWin,
ImgList, SYNVIDEO1Lib_TLB, jpeg;
type
TMainForm = class(TForm)
ToolBar: TToolBar;
btnOpen: TToolButton;
ToolButton1: TToolButton;
btnPlay: TToolButton;
btnStop: TToolButton;
ImageList: TImageList;
OpenDialog: TOpenDialog;
btnLoadText: TToolButton;
StatusBar: TStatusBar;
Video: TSynVideo1;
btnAbout: TToolButton;
Track: TScrollBar;
procedure FormDestroy(Sender: TObject);
procedure btnOpenClick(Sender: TObject);
procedure btnPlayClick(Sender: TObject);
procedure btnStopClick(Sender: TObject);
procedure btnLoadTextClick(Sender: TObject);
procedure VideoPlayProgress(Sender: TObject; progressInPercent,
timeFromBegin: Integer);
procedure FormPaint(Sender: TObject);
procedure TrackScroll(Sender: TObject; ScrollCode: TScrollCode;
var ScrollPos: Integer);
procedure btnAboutClick(Sender: TObject);
private
VideoCanvas : TCanvas; // klasa TCanvas, ktora dotyczyc bedzie komponentu Video
R : TRect; // obszar wyswietlania napisow...
function Convert(Time: Integer) : TTime; // funkcja konwertuje
parametr na godziny, minuty, sek
procedure PaintTheText(const Text : string); // rysuje (wyswietla) napis
end;
{ klasa dziedziczaca z TJPEGImage, ktora posiada jedna dodatkowa
funkcje ladowania z zasobow }
TJPEGRes = class(TJPEGImage)
public
procedure LoadFromResource(const ResID: PChar); virtual;
end;
var
MainForm: TMainForm;
VideoText : TVideoText;
implementation
{$R *.DFM}
{ zmienna pomocnicza...
Odlicza czas, ktory uplynol od czasu wyswietlenia napisu }
var iTimeOut : Byte = 0;
{ TJPEGRes }
procedure TJPEGRes.LoadFromResource(const ResID: PChar);
var
Res : TResourceStream; // utworz zmienna
begin
{ zalduj obrazek z zasobow }
Res := TResourceStream.Create(hInstance, ResID, 'JPEGFILE');
try
LoadFromStream(Res); // laduj obrazek do strumienia ze zmiennej Res
finally
Res.Free; // zwolnij pamiec
end;
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
{ usun klasy }
VideoText.Free;
VideoCanvas.Free;
end;
function TMainForm.Convert(Time: Integer): TTime;
{
ta procedura przeksztalca parametr Time, ktory zawiera czas trwania
filmu lub
jego pozycje. Parametr ten jest typu Integer, ktory trzeba nastepnie
rozbic na godziny, minuty i sekundy. ZAZNACZAM jednak, ze procedura ta
nie
jest do konca dopracowana i moze zawierac bledy.
Parametr tej procedury zawiera zmienna typu Integer, ktora to zawiera
ilosc sekund - np. 247.
}
var
MSec : Integer;
Sec, Min, Hour : Word;
begin
MSec := Time;
{ uzyskujemy liczbe minut z filmu - np. 247 div 60 = 4,.. }
Min := MSec div 60;
{ teraz uzyskujemy liczbe godzin - np. 4 div 60 = 0 }
Hour := Min div 60;
Sec := MSec - (Min * 60);
{ jezeli liczba minut jest wieksza od 60 to odejmujemy od tej liczby
godzine }
if Min > 60 then
Min := Min - 60;
{ tutaj uzyskujemy liczbe sekund }
{ na podstawie wszystkich danych formuujemy zmienna typu TTime }
Result := EncodeTime(Hour, Min, Sec, 0);
end;
procedure TMainForm.btnOpenClick(Sender: TObject);
begin
if OpenDialog.Execute then
begin
VideoText.Free; // zwalniamy klase
Video.Close; // zamykamy wideo
Video.OpenVideo := OpenDialog.FileName; // otwieramy nowy plik
{ tutaj nastepuje ustawienie nowych pozycji }
Width := Video.Width + 60;
Height := Video.Height + 140;
Track.Width := Video.Width;
Track.Top := Video.Top + Video.Height + 1;
Track.Left := Video.Left;
ToolBar.Width := Track.Width;
ToolBar.Top := Track.Top + Track.Height + 1;
ToolBar.Left := Track.Left;
{ tutaj nastepuje sprawdzenie, czy istnieje plik tekstowy z napisami -
znajduje go
jezeli plik tekstowy jest tej samej nazwy co plik z filemem }
if FileExists(ExtractFilePath(OpenDialog.FileName) + ChangeFileExt
(ExtractFileName(OpenDialog.FileName), '.txt')) then
begin
VideoText := TVideoText.Create(ExtractFilePath(OpenDialog.FileName) +
ChangeFileExt(ExtractFileName(OpenDialog.FileName), '.txt'));
StatusBar.Panels[0].Text := 'Tekst załadowany';
end else StatusBar.Panels[0].Text := '';
btnPlay.Enabled := True;
btnStop.Enabled := True;
end;
end;
procedure TMainForm.btnPlayClick(Sender: TObject);
begin
Video.Play; // odpalaj
end;
procedure TMainForm.btnStopClick(Sender: TObject);
begin
Video.Stop; // zatrzymaj
end;
procedure TMainForm.btnLoadTextClick(Sender: TObject);
begin
if OpenDialog.Execute then
begin
{ zaladuj nowy tekst do filmu }
VideoText := TVideoText.Create(OpenDialog.FileName);
StatusBar.Panels[0].Text := 'Tekst załadowany';
end;
end;
procedure TMainForm.VideoPlayProgress(Sender: TObject; progressInPercent,
timeFromBegin: Integer);
begin
{ ta procedura pokazuje proces w odtwarzaniu filmu. Na pasku wyswietl czas
ktory
uplynol od czasu wlaczenia filmu oraz pozostaly czas filmu }
StatusBar.Panels[1].Text := TimeToStr(Convert(timeFromBegin)) + '/' + TimeToStr(Convert(Video.GetTotalTime));
PaintTheText(VideoText.ShowText(Convert(timeFromBegin))); // namaluj tekst
Track.Position := progressInPercent; // pokaz na pasku proces postepu
end;
procedure TMainForm.FormPaint(Sender: TObject);
var
JPG : TJPEGRes;
begin
JPG := TJPEGRes.Create; // tworzenie nowej klasy
try
JPG.LoadFromResource('102'); // zaladowanie odpowiedniego zasobu
VideoCanvas := TCanvas.Create; // stworzenie nowej klasy Canvas
VideoCanvas.Handle := GetDC(Video.Handle); // pobranie uchwytu do
komponentu
VideoCanvas.Brush.Color := clBlack;
{ zamaluj wszystko na czarno }
VideoCanvas.Rectangle(0, 0, Video.Width, Video.Height);
VideoCanvas.Brush.Style := bsClear;
VideoCanvas.Font.Color := clWhite;
VideoCanvas.Font.name := 'Arial';
VideoCanvas.Font.Size := 10;
VideoCanvas.Draw(0, 0, JPG); // wyswietlenie obrazka
R := Rect(0, Video.Height - 30, Video.Width, Video.Height);
finally
JPG.Free;
end;
end;
procedure TMainForm.PaintTheText(const Text: string);
begin
{
ta procedura wyswietla napisy do filmu, a konkretnie maluje je na
komponencie
Video korzystajac z funkcji API - DrawText. Czas ktory potrzebny jest na
wyswietlenie
napisu okreslony jest w stalej TimeOut w module VideoTxt. Jezeli ten czas
uplynie
to nastepuje odswiezenie obszaru komponentu
}
if (Length(Text) = 0) and (iTimeOut >= TimeOut) then
begin
Video.Repaint;
iTimeOut := 0;
end else if (Length(Text) > 0) and (iTimeout < TimeOut) then begin Video.Repaint; end;
DrawText(VideoCanvas.Handle, PChar(Text), -1, R, DT_CENTER);
Inc(iTimeOut); // zwieksz zmienna
end;
procedure TMainForm.TrackScroll(Sender: TObject; ScrollCode: TScrollCode;
var ScrollPos: Integer);
var
Per : Int64;
begin
{
komponent Track pokazuje postep w odtwarzaniu filmu w procentach.
Nastepnie
mnozymy wartosc, ktora przed chwila nastawiles przez ogolna liczbe
klatek/sek.
i dzielimy przez 100. Na tej podstawie przesuwamy o zadana ilosc klatek.
}
Per := (ScrollPos * Video.GetTotalFrames) div 100;
Video.Seek(Per);
end;
procedure TMainForm.btnAboutClick(Sender: TObject);
begin
MessageBox(Handle, PChar(
' Copyright (c) 2002 by Adam Boduch ' + #13 +
' http://www.4programmers.net ' + #13 +
' adam@4programmers.net '), 'O programie...', MB_OK +
MB_ICONINFORMATION);
end;
end.
Cały kod możesz ściągnąc stąd: www.4programmers.net/programmes/reyalp.zip
Radzę również poczytać artykuły o wątkach, klasach i kontrolkach ActiveX. Wszystke te artykuły znajdziesz w dziale Delphi.
"Floating Poin division by zero" Division by zero jak mógłbyś sam się domyślić oznacza dzielenie przez zero, co jak wiemy jest niewykonalne. W jakimś punkcie programu występuje dzielenie, przy którym nie ma hmm... odwołania czy coś aby błąd nie wyskakiwał.
Chyba nie lubi dzielić / 0 ?
Czy działa to równiez z komponentami DS pack??
Gdzie mogę znaleźć ten komponent SynVideo. Nigdzie go nie ma.
mie tsh :(
Dlaczego wyskakuje mi błąd Floating Poin division by zero ??? poroszę mi powiedzieć co jest nie tak. Z góry dzięki. Omestes@interia.pl
Dlaczego wyskakuje mi błąd Floating Poin division by zero ??? poroszę mi powiedzieć co jest nie tak. Z góry dzięki. Omestes@interia.pl