Programowanie w języku Delphi » Gotowce

Napisy do filmów

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                     *)
(*                   [email protected]                      *)
(*                                                              *)
(****************************************************************)
 
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                     *)
(*                   [email protected]                      *)
(*                                                              *)
(****************************************************************)
(*
 
    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 +
  '            [email protected]       '), '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.

7 komentarzy

ficiek 2009-04-23 16:37

"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ł.

robertfabi 2007-05-06 16:22

Chyba nie lubi dzielić / 0 ?

ojciec redaktor 2006-03-12 15:44

Czy działa to równiez z komponentami DS pack??

Steradian2005 2005-03-27 13:34

Gdzie mogę znaleźć ten komponent SynVideo. Nigdzie go nie ma.