error al cargar videos de YouTube

[danielmj]

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
    { Private declarations }
  public
    { Public declarations }
  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;

  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
    { Private declarations }
  public
    { Public declarations }
  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');
  //memo1.Lines.SaveToFile('codigo.html');
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:

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

[Edwardfeliz]

Quizas nadie a respondido porque da mucha Hueva llegar hasta donde estas(Descargar el componente, Agregar el codigo, Etc), Si puedes sube el proyecto y manda el enlace.

Saludos!

[danielmj]

Hola Edwardfeliz, no es necesario, ya encontré la solución. Resulta que no había tal error, era mas bien un problema de diseño del formulario, me explico, en el form hay un memo que tiene o debe tener unas medidas exactas, ¿que pasaba si estas medidas no eran las correctas? pues que el texto dentro de este memo, "sufría" saltos de linea cuando no procedía y esto está en relación con el siguiente procedimiento:

Código Delphi [-]
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');    

   web.Navigate(ExtractFilePath(ParamStr(0))+'codigo.html'); end;

Como se puede ver, se hace mención a las lineas 1 y 4 del memo, con lo cual si en este se producía un salto de linea, el valor del listBox2.itemIndex lo insertaba en el lugar que no debía, con lo cual ya el código html (que era el texto del memo) no era correcto y no se lanzaba el reproductor de Youtube.
De todos modos, por tu comentario, creo que no me explique bien, cuando hablaba de un componente, lo hice a modo de buscar alternativas a mi problema, pero como puedes ver, se ha solucionado a base de código, por lo que no tengo necesidad de usar ese componente.

Aquí una captura de la solución del error:


Saludos.

[Edwardfeliz]

Empezado por danielmj

Hola Edwardfeliz, no es necesario, ya encontré la solución. Resulta que no había tal error, era mas bien un problema de diseño del formulario, me explico, en el form hay un memo que tiene o debe tener unas medidas exactas, ¿que pasaba si estas medidas no eran las correctas? pues que el texto dentro de este memo, "sufría" saltos de linea cuando no procedía y esto está en relación con el siguiente procedimiento:

Código Delphi [-]
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');    

   web.Navigate(ExtractFilePath(ParamStr(0))+'codigo.html'); end;

Como se puede ver, se hace mención a las lineas 1 y 4 del memo, con lo cual si en este se producía un salto de linea, el valor del listBox2.itemIndex lo insertaba en el lugar que no debía, con lo cual ya el código html (que era el texto del memo) no era correcto y no se lanzaba el reproductor de Youtube.
De todos modos, por tu comentario, creo que no me explique bien, cuando hablaba de un componente, lo hice a modo de buscar alternativas a mi problema, pero como puedes ver, se ha solucionado a base de código, por lo que no tengo necesidad de usar ese componente.

Aquí una captura de la solución del error:


Saludos.

Excelente!