[Delphi]Thubnails-jak w Media Player Classic

0

W jaki sposób można stworzyć tego typu zrzuty np.: http://www.fotosik.pl/showFullSize.php?id=d365f0c6bb410222 ...Takie funkcje ma na przykład MPC... U mnie zmiana rozdzielczości obrazka kończy się "rozpikselowaniem" :( Do robienia zrzutu wykorzystuję SampleGrabber z paczki DsPack. Nie wiem w jaki sposób należy zmiejszać obrazki i umieszczać je w rzędach oddzielone od siebie... Z tego co zauważyłem, MPC oblicza ilość kratek w które mają być wklejone obrazki, oblicza długość filmu i dzieli przez liczbę kratek, potem automatycznie przeskakuje do klatek filmu i wkleja je na bitmapę...

Tu taki przykład:

procedure TForm1.Button2Click(Sender: TObject);
begin
OpenDialog1.Execute;
FilterGraph1.Active := true;
FilterGraph1.RenderFile(OpenDialog1.FileName);
FilterGraph1.Play;
end;

procedure TForm1.Button1Click(Sender: TObject); {ScreenShot}
var
thumbnail, tlo,  timer : TBitmap;
a : integer;
begin
FilterGraph1.Stop;
tlo := TBitmap.Create;
tlo.Canvas.Brush.Color := RGB(224,224,224);

{rozdzielczość}
tlo.Width := SpinEdit2.Value;   
tlo.Height := SpinEdit3.Value; {np. 600 x 600 pikseli}

with tlo.Canvas do
begin
tlo.Canvas.Pen.Width := 2;
tlo.Canvas.Rectangle(5,70,SpinEdit3.Value - 5, 5)
end;
tlo.canvas.Font.Size:=11;
tlo.Canvas.Font.Style := Canvas.Font.Style + [fsBold];
tlo.Canvas.TextOut(1,2, ' Informacje:');
tlo.canvas.Font.Size:=7;
tlo.Canvas.TextOut(10,18, 'Nazwa pliku: ' + ExtractFileName(OpenDialog1.FileName));
tlo.Canvas.TextOut(10,24, 'Długość: ' + Panel2.Caption);
timer := TBitmap.Create;
timer.Width := 48;
timer.Height := 13;
timer.Canvas.Brush.Color := clBlack;
timer.Canvas.Font.Color := clWhite;
timer.Canvas.Font.Style := Canvas.Font.Style + [fsBold];
timer.Canvas.Font.Size := 7;
timer.Canvas.TextOut(0,0, Panel1.Caption);

thumbnail := TBitmap.Create;
SampleGrabber1.GetBitmap(thumbnail); {pobieranie zrzutu}
thumbnail.Canvas.Draw(0, 0, timer);
tlo.Canvas.Draw(10,73, thumbnail);
tlo.SaveToFile('test.bmp'); {zapis pliku}
thumbnail.Free;
logo.Free;
tlo.Free;
end;

procedure TForm1.DSTrackBar1Timer(sender: TObject; CurrentPos,
  StopPos: Cardinal);
begin
Panel2.Caption := Format('%s',[TimeToStr(StopPos / (24*3600*1000))]);
Panel1.Caption := Format('%s', [TimeToStr(CurrentPos / (24*3600*1000))]);
end;

Proszę o pomoc....

0

Musisz uzyc jakiegos algorytmu na przeskalowanie aby uzyskac dobra jakosc - np: Lanczos3, najlepszy z mozliwych.

0

Pozostaje jeszcze rozmieszczenie obrazków na głównej bitmapie, tak aby nie wychodziły poza nią.....

1 użytkowników online, w tym zalogowanych: 0, gości: 1