Hola, navengando por la red en busca de opciones para visualizar videos de YouTube en el formulario de la aplicacion, me topé con
este componente está creado por Ali Zairov y esta es su
web. El caso es que después de instalarlo y ejecutar las demos que trae incluidas el .zip, el reproductor de YouTube, da error y no muestra ninguno de los videos que intento ver. Este de abajo es el código de la demo3 del .zip
Código Delphi
[-]
unit uMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.ComCtrls, Vcl.OleCtrls,
SHDocVw, IdBaseComponent, IdAntiFreezeBase, IdAntiFreeze, Xml.xmldom, Xml.XMLIntf, Xml.Win.msxmldom,
Xml.XMLDoc, Winapi.ActiveX, Vcl.YouTubeApi;
type
TMain = class(TForm)
Panel1: TPanel;
Value: TEdit;
Search: TButton;
ListView: TListView;
Panel2: TPanel;
WB: TWebBrowser;
IdAntiFreeze: TIdAntiFreeze;
ListBox: TListBox;
WebBrowser: TWebBrowser;
XMLDocument: TXMLDocument;
YouTube: TYouTube;
procedure EditControlExit(Sender: TObject);
procedure EditControlKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure EditControlKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure ListBoxKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure ListBoxMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ListViewDblClick(Sender: TObject);
procedure SearchClick(Sender: TObject);
procedure ValueEnter(Sender: TObject);
procedure ValueExit(Sender: TObject);
private
public
end;
var
Main: TMain;
EditControl: TEdit;
implementation
{$R *.dfm}
procedure WBLoadHTML(WebBrowser: TWebBrowser; HTMLCode: string);
var
SL: TStringList;
MS: TMemoryStream;
begin
WebBrowser.Navigate('about:blank') ;
while WebBrowser.ReadyState < READYSTATE_INTERACTIVE do
Application.ProcessMessages;
if Assigned(WebBrowser.Document) then
begin
SL := TStringList.Create;
try
MS := TMemoryStream.Create;
try
SL.Text := HTMLCode;
SL.SaveToStream(MS);
MS.Seek(0, 0);
(WebBrowser.Document as IPersistStreamInit).Load(TStreamAdapter.Create(MS));
finally
MS.Free;
end;
finally
SL.Free;
end;
end;
end;
procedure GetPlayer(Code: string);
var
SL: TStringList;
begin
Main.YouTube.Navigate('http://www.youtube.com/watch?v=' + Code);
SL := TStringList.Create;
Código:
Este trozo de código es parte del resto, solo que se creaba un cuadrado en este hilo en vez de mostrar el codigo en si, por eso lo he puesto entre etiquetas code.
SL.Add('<iframe ');
SL.Add('width="442" ');
SL.Add('height="250" ');
SL.Add('src="' + Main.YouTube.GetEmbedURL + '&autoplay=1" ');
SL.Add('frameborder="0" ');
SL.Add('allowfullscreen> ');
SL.Add('</iframe>');
Código Delphi
[-]
WBLoadHTML(Main.WB, SL.Text);
end;
function GetText(Value: string; WebBrowser: TWebBrowser): WideString;
begin;
WebBrowser.Navigate('http://google.com/complete/search?output=toolbar&q=' + Main.YouTube.URLEncodeUTF8(Value) + '&ds=yt');
while WebBrowser.ReadyState <> READYSTATE_Complete do
begin
Application.ProcessMessages;
Sleep(1);
end;
Result := WebBrowser.OleObject.Document.Body.InnerTEXT;
end;
procedure TMain.EditControlExit(Sender: TObject);
begin
if NOT (ListBox.Focused)
then ListBox.Visible := False;
end;
procedure TMain.EditControlKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Key = vk_Down then
begin
ListBox.SetFocus;
ListBox.Selected[0] := True;
EditControl.Text := ListBox.Items.Strings[ListBox.ItemIndex];
end else ListBox.Visible := False;
end;
procedure TMain.EditControlKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
Source, Temp, Text: String;
begin
ListBox.Clear;
if Trim(Value.Text) <> '' then
begin
Source := GetText(StringReplace(Value.Text, ' ', '%20', [rfReplaceAll, rfIgnoreCase]), WebBrowser);
Text := '', Source) - 1));
end;
with ListBox.Items do
begin
Add(Temp);
Next;
end;
end;
if ListBox.Items.Count < 3 then
ListBox.Height := 21 * (ListBox.Items.Count)
else
ListBox.Height := 21 * 3;
ListBox.Top := Value.Top + Value.Height + 5;
ListBox.Visible := True;
ListBox.BringToFront;
end;
end;
procedure TMain.ListBoxMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
EditControl.Text := ListBox.Items.Strings[ListBox.ItemIndex];
EditControl.SetFocus;
TListBox(Sender).Visible := False;
end;
procedure TMain.ListBoxKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = vk_Return then
begin
EditControl.SetFocus;
TListBox(Sender).Visible := False;
end else
begin
EditControl.Text := TListBox(Sender).Items[TListBox(Sender).ItemIndex];
end;
end;
procedure TMain.ListViewDblClick(Sender: TObject);
begin
if ListView.Items.Count = 0 then Exit;
Application.ProcessMessages;
GetPlayer(ListView.Items.Item[ListView.ItemIndex].SubItems.Strings[0]);
end;
procedure TMain.SearchClick(Sender: TObject);
begin
Main.YouTube.Search(Value.Text, XMLDocument, ListView);
end;
procedure TMain.ValueEnter(Sender: TObject);
begin
EditControl := TEdit(Sender);
EditControl.OnExit := EditControlExit;
EditControl.OnKeyUp := EditControlKeyUp;
EditControl.OnKeyDown := EditControlKeyDown;
end;
procedure TMain.ValueExit(Sender: TObject);
begin
EditControl := nil;
end;
end.
El problema es que no encuentro donde está el error, que por cierto NO es de compilación, solo que cuando intento ver algun video, me sale esto:
Por otra parte, lo que realmente busco es mostrar videos de YouTube usando la API de este como lo muestra el código de mi aplicación:
Código Delphi
[-]
unit repro;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.ImgList,
Vcl.OleCtrls, SHDocVw, Vcl.ComCtrls;
type
TytRepro = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Label1: TLabel;
Edit1: TEdit;
Label2: TLabel;
Edit2: TEdit;
Panel3: TPanel;
ListBox1: TListBox;
Panel4: TPanel;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Panel5: TPanel;
ListBox2: TListBox;
Panel6: TPanel;
web: TWebBrowser;
Memo1: TMemo;
StatusBar1: TStatusBar;
Button5: TButton;
Button6: TButton;
Button1: TButton;
Edit3: TEdit;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
private
public
end;
var
ytRepro: TytRepro;
implementation
{$R *.dfm}
procedure TytRepro.Button1Click(Sender: TObject);
begin
listBox1.Items.Add(Edit2.Text);
listBox2.Items.Add(Edit1.Text);
edit1.Clear;
edit2.Clear;
end;
procedure TytRepro.Button2Click(Sender: TObject);
begin
listBox2.DeleteSelected;
listBox1.DeleteSelected;
end;
procedure TytRepro.Button3Click(Sender: TObject);
begin
listBox2.ItemIndex:= listBox1.ItemIndex;
memo1.Lines.Strings[1]:= '"'+ listBox2.Items[listBox2.ItemIndex]+'"';
memo1.Lines.Strings[4]:= '"'+ listBox2.Items[listBox2.ItemIndex]+'"';
memo1.Lines.SaveToFile('codigo.html');
edit3.Text:= memo1.Lines.Strings[4];
web.Navigate(ExtractFilePath(ParamStr(0))+'codigo.html');
end;
procedure TytRepro.Button4Click(Sender: TObject);
begin
close;
end;
procedure TytRepro.Button5Click(Sender: TObject);
begin
ShowMessage('Añade solo la parte final del enlace al video, por ejemplo de:'+chr(13)+
'[https://www.youtube.com/watch?v=7QVM2UUpwmo] usa sólo lo que hay detrás del "="');
end;
procedure TytRepro.Button6Click(Sender: TObject);
begin
ShowMessage('Dale un nombre al vídeo que puedas relacionar con su contenido');
end;
procedure TytRepro.FormClose(Sender: TObject; var Action: TCloseAction);
begin
listBox2.Items.SaveToFile('enlaces.txt');
listBox1.Items.SaveToFile('listado.txt');
end;
procedure TytRepro.FormShow(Sender: TObject);
begin
listBox2.Items.LoadFromFile('enlaces.txt');
listBox1.Items.LoadFromFile('listado.txt');
memo1.Lines.LoadFromFile('codigo.html');
end;
procedure TytRepro.ListBox1Click(Sender: TObject);
begin
listBox2.itemIndex:= listBox1.ItemIndex
end;
end.
Y el contenido del memo sería este:
Código:
<object width="560" height="315">
<param name="movie" value="https://youtube.googleapis.com/v/M7lc1UVf-VE?
version=2&fs=1"</param>
<param name="allowFullScreen" value="true"></param>
<param name="allowScriptAccess" value="always"></param>
<embed src="https://youtube.googleapis.com/v/M7lc1UVf-VE?version=2&fs=1"
type="application/x-shockwave-flash"
allowfullscreen="true"
allowscriptaccess="always"
width="560" height="315">
</embed>
</object>
Y en este caso, lo que ocurre es que no se muestra nada, ni tan siquiera el reproductor. Es decir, el navegador web se queda en blanco. ¿Alguna sugerencia? ¿existe alguna otra forma de teclear un enlace de YouTube en un edit y que al pulsar el botón se muestre el video en el navegador del formulario pero solo el reproductor de video y no la pagina completa?
En fin, sé que he dado muchos datos de golpe y que igual no he sabido explicarme del todo bien, pero a ver si alguien puede echarme una manita.
Gracias de antemano y saludos.