开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
Main.pas
资源名称：qqdelphiprog.rar　[点击查看]
上传用户：hylc_2004
上传日期：2014-01-23
资源大小：46800k
文件大小：10k
源码类别：

Delphi控件源码

开发平台：

Delphi

Main.pas：源码内容
  1. unit Main;
  3. interface
  5. uses
  6.   Windows, Messages, SysUtils, Graphics, Controls, Forms, Dialogs, DirectShow9,
  7.   ActiveX, StdCtrls, DSUtil, ComCtrls, ShellAPI, Definitions, Buttons, Classes,
  8.   ExtCtrls;
  10. type
  11.   TForm1 = class(TForm, IAsyncExCallBack)
  12.     TmrNillAll: TTimer;
  13.     Label1: TLabel;
  14.     ComboBox1: TComboBox;
  15.     Button6: TButton;
  16.     GroupBox5: TGroupBox;
  17.     Label7: TLabel;
  18.     Label2: TLabel;
  19.     Label8: TLabel;
  20.     Label3: TLabel;
  21.     TrackBar1: TTrackBar;
  22.     TrackBar2: TTrackBar;
  23.     GroupBox4: TGroupBox;
  24.     RadioButton3: TRadioButton;
  25.     RadioButton4: TRadioButton;
  26.     GroupBox2: TGroupBox;
  27.     Label20: TLabel;
  28.     Label21: TLabel;
  29.     Label22: TLabel;
  30.     Label23: TLabel;
  31.     Label24: TLabel;
  32.     Label25: TLabel;
  33.     Label26: TLabel;
  34.     Label27: TLabel;
  35.     GroupBox3: TGroupBox;
  36.     Label16: TLabel;
  37.     Label17: TLabel;
  38.     Label18: TLabel;
  39.     Label19: TLabel;
  40.     GroupBox9: TGroupBox;
  41.     Label5: TLabel;
  42.     Label6: TLabel;
  43.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  44.     procedure FormCreate(Sender: TObject);
  45.     procedure TrackBar1Change(Sender: TObject);
  46.     procedure Button6Click(Sender: TObject);
  47.     procedure TrackBar2Change(Sender: TObject);
  48.     procedure TmrNillAllTimer(Sender: TObject);
  49.     procedure Label19Click(Sender: TObject);
  50.     procedure Label26Click(Sender: TObject);
  51.   private
  52.     FCurrentUrlLocation: string;
  53.     FFontColorGroupbox4: TColor;
  54.     // destroy all used Com Objects
  55.     procedure NillAll;
  56.     // open URL
  57.     procedure OpenURL;
  58.     { All callback strings need to be copied before setting them to a Label
  59.        or any other external Object                                         }
  60.     function AsyncExFilterState(Buffering: LongBool; PreBuffering: LongBool;
  61.       Connecting: LongBool; Playing: LongBool;
  62.       BufferState: integer): HRESULT; stdcall;
  63.     function AsyncExICYNotice(IcyItemName: PChar;
  64.       ICYItem: PChar): HRESULT; stdcall;
  65.     function AsyncExMetaData(Title: PChar; URL: PChar): HRESULT; stdcall;
  66.     function AsyncExSockError(ErrString: PChar): HRESULT; stdcall;
  67.   end;
  69. const
  70.   ConnectCaption = 'connect';
  71.   DisConnectCaption = 'disconnect';
  73. var
  74.   Form1: TForm1;
  75.   GraphBuilder: IGraphBuilder = nil;
  76.   MediaControl: IMediaControl = nil;
  77.   AsyncEx: IBaseFilter = nil;
  78.   FileSource: IFilesourcefilter = nil;
  79.   AsyncExControl: IAsyncExControl = nil;
  80.   Mpeg1Splitter: IBaseFilter = nil;
  81.   Pin: IPin = nil;
  83. implementation
  85. {$R *.dfm}
  87. procedure TForm1.NillAll;
  88. begin
  89.   // MediaControl.Stop is required before destroying filters and interfaces
  90.   if Assigned(MediaControl) then
  91.     MediaControl.Stop;
  92.   if Assigned(AsyncExControl) then
  93.     AsyncExControl.FreeCallback;
  94.   Application.HandleMessage;
  95.   if Assigned(Pin) then
  96.     Pin := nil;
  97.   if Assigned(FileSource) then
  98.     FileSource := nil;
  99.   if Assigned(MediaControl) then
  100.     MediaControl := nil;
  101.   if Assigned(GraphBuilder) then
  102.     GraphBuilder := nil;
  103.   if Assigned(AsyncEx) then
  104.     AsyncEx := nil;
  105.   if Assigned(AsyncExControl) then
  106.     AsyncExControl := nil;
  107.   button6.Caption := ConnectCaption;
  108.   GroupBox4.Font.Color := FFontColorGroupbox4;
  109.   GroupBox4.Enabled := true;
  110.   RadioButton3.Enabled := true;
  111.   RadioButton4.Enabled := true;
  112. end;
  114. procedure TForm1.OpenURL();
  115. begin
  116.   NillAll;
  117.   button6.Caption := DisConnectCaption;
  118.   GroupBox4.Font.Color := clDkGray;
  119.   GroupBox4.Enabled := false;
  120.   RadioButton3.Enabled := false;
  121.   RadioButton4.Enabled := false;
  122.   CheckDSError(CoCreateInstance(TGUID(CLSID_FilterGraph), nil, CLSCTX_INPROC,
  123.     TGUID(IID_IGraphBuilder), GraphBuilder));
  124.   CheckDSError(GraphBuilder.QueryInterface(IID_IMediaControl, MediaControl));
  125.   if failed(CoCreateInstance(CLSID_AsyncEx, nil, CLSCTX_INPROC,
  126.     IID_IBaseFilter, AsyncEx)) then
  127.   begin
  128.     showmessage('you need a registered AsyncEx filter to run this' +
  129.       ' example, location: DSPACKDemosD6-D7FiltersAsyncEx');
  130.     exit;
  131.   end;
  132.   CoCreateInstance(CLSID_Mpeg1Split, nil, CLSCTX_INPROC,
  133.     IID_IBaseFilter, Mpeg1Splitter);
  134.   CheckDSError(GraphBuilder.AddFilter(Mpeg1Splitter, 'MPEG1 Splitter'));
  135.   CheckDSError(AsyncEx.QueryInterface(IID_IAsyncExControl, AsyncExControl));
  136.   if assigned(AsyncExControl) then
  137.     if failed(AsyncExControl.SetCallBack(self)) then
  138.       exit;
  139.   if assigned(AsyncExControl) then
  140.   begin
  141.     if RadioButton3.Checked then
  142.       if failed(AsyncExControl.SetConnectToURL(
  143.         PChar(ComboBox1.Text), TrackBar1.Position * 1000, true)) then
  144.         exit;
  145.     if RadioButton4.Checked then
  146.       if failed(AsyncExControl.SetConnectToURL(
  147.         PChar(ComboBox1.Text), TrackBar1.Position * 1000, false)) then
  148.         exit;
  149.   end;
  150.   if assigned(AsyncExControl) then
  151.     if failed(AsyncExControl.SetBuffersize(
  152.       TrackBar2.Position * 1000)) then
  153.       exit;
  154.   if assigned(AsyncEx) then
  155.     if failed(AsyncEx.FindPin(pinID, Pin)) then
  156.       exit;
  157.   if assigned(GraphBuilder) then
  158.     if failed(GraphBuilder.AddFilter(AsyncEx,
  159.       StringToOleStr('DSPlayer AsyncSource'))) then
  160.       exit;
  161.   if assigned(GraphBuilder) then
  162.     if failed(GraphBuilder.Render(pin)) then
  163.       exit;
  164.   if assigned(MediaControl) then
  165.     if failed(MediaControl.Run) then
  166.       exit;
  167. end;
  169. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  170. begin
  171.   NillAll;
  172.   CoUninitialize;
  173. end;
  175. procedure TForm1.FormCreate(Sender: TObject);
  176. begin
  177.   GroupBox9.DoubleBuffered := true;
  178.   FCurrentUrlLocation := ComboBox1.Text;
  179.   FFontColorGroupbox4 := GroupBox4.Font.Color;
  180.   CoInitialize(nil);
  181.   Label18.Hint := Label18.Caption;
  182.   Label18.ShowHint := true;
  183.   Label19.Hint := Label19.Caption;
  184.   Label19.ShowHint := true;
  185.   Label19.Font.Color := clBlue;
  186.   Label19.Font.Style := [fsUnderline];
  187.   Label24.Hint := Label24.Caption;
  188.   Label24.ShowHint := true;
  189.   Label25.Hint := Label25.Caption;
  190.   Label25.ShowHint := true;
  191.   Label26.Hint := Label26.Caption;
  192.   Label26.ShowHint := true;
  193.   Label26.Font.Color := clBlue;
  194.   Label26.Font.Style := [fsUnderline];
  195.   Label8.Caption := inttostr(TrackBar1.Position) + ' kb';
  196.   Label3.Caption := inttostr(TrackBar2.Position) + ' kb';
  197. end;
  199. procedure TForm1.TrackBar1Change(Sender: TObject);
  200. begin
  201.   Label8.Caption := inttostr(TrackBar1.Position) + ' kb';
  202. end;
  204. procedure TForm1.Button6Click(Sender: TObject);
  205. begin
  206.   if Button6.Caption = ConnectCaption then
  207.   begin
  208.     if (FCurrentUrlLocation <> ComboBox1.Text) then
  209.       FCurrentUrlLocation := ComboBox1.Text;
  210.     OpenURL
  211.   end
  212.   else
  213.     NillAll;
  214. end;
  216. procedure TForm1.TrackBar2Change(Sender: TObject);
  217. begin
  218.   Label3.Caption := inttostr(TrackBar2.Position) + ' kb';
  219.   if assigned(AsyncExControl) then
  220.     AsyncExControl.SetBuffersize(TrackBar2.Position * 1000);
  221. end;
  223. procedure TForm1.TmrNillAllTimer(Sender: TObject);
  224. begin
  225.   NillAll;
  226.   TmrNillAll.Enabled := false;
  227. end;
  229. procedure TForm1.Label19Click(Sender: TObject);
  230. begin
  231.   if (Label19.Caption <> 'N/A') then
  232.     ShellExecute(0, 'open', PChar(Label19.Hint), nil, nil, SW_SHOWNORMAL);
  233. end;
  235. procedure TForm1.Label26Click(Sender: TObject);
  236. begin
  237.   if Label26.Caption <> 'N/A' then
  238.     ShellExecute(0, 'open', PChar(Label26.Hint), nil, nil, SW_SHOWNORMAL);
  239. end;
  241. // DSPlayer AsyncSource CallBack
  243. function TForm1.AsyncExFilterState(Buffering: LongBool; PreBuffering: LongBool;
  244.   Connecting: LongBool; Playing: LongBool;
  245.   BufferState: integer): HRESULT; stdcall;
  246. begin
  247.   if PreBuffering then
  248.     Label6.Caption := '( ' + inttostr(BufferState) + '% ) prebuffering....';
  249.   if Buffering then
  250.     Label6.Caption := '( ' + inttostr(BufferState) + '% ) buffering....';
  251.   if Connecting then
  252.     Label6.Caption := 'connecting....';
  253.   if Playing then
  254.     Label6.Caption := 'playing....';
  255.   if not Buffering and not PreBuffering and not Connecting and not Playing then
  256.   begin
  257.     Label6.Caption := 'N/A';
  258.     Label18.Caption := 'N/A';
  259.     Label19.Caption := 'N/A';
  260.   end;
  261.   Result := S_OK;
  262. end;
  264. function TForm1.AsyncExICYNotice(IcyItemName: PChar;
  265.   ICYItem: PChar): HRESULT; stdcall;
  266. const // ICY Item Names
  267.   ICYMetaInt = 'icy-metaint:';
  268.   ICYName = 'icy-name:';
  269.   ICYGenre = 'icy-genre:';
  270.   ICYURL = 'icy-url:';
  271.   ICYBitrate = 'icy-br:';
  272.   ICYError = 'icy-error:';
  273. begin
  274.   if IcyItemName = ICYError then
  275.   begin
  276.     showmessage(copy(ICYItem, 1, length(ICYItem)));
  277.     TmrNillAll.Enabled := true;
  278.   end;
  279.   if IcyItemName = ICYName then
  280.   begin
  281.     if length(ICYItem) > 39 then
  282.       Label24.Caption := copy(ICYItem, 1, 39) + '...'
  283.     else
  284.       Label24.Caption := copy(ICYItem, 1, length(ICYItem));
  285.     Label24.Hint := copy(ICYItem, 1, length(ICYItem));
  286.   end;
  287.   if (IcyItemName = ICYGenre) then
  288.   begin
  289.     if (length(ICYItem) > 39) then
  290.       Label25.Caption := copy(ICYItem, 1, 39) + '...'
  291.     else
  292.       Label25.Caption := copy(ICYItem, 1, length(ICYItem));
  293.     Label25.Hint := copy(ICYItem, 1, length(ICYItem));
  294.   end;
  295.   if (IcyItemName = ICYURL) then
  296.   begin
  297.     if (length(ICYItem) > 30) then
  298.       Label26.Caption := copy(ICYItem, 1, 30) + '...'
  299.     else
  300.       Label26.Caption := copy(ICYItem, 1, length(ICYItem));
  301.     Label26.Hint := copy(ICYItem, 1, length(ICYItem));
  302.   end;
  303.   if (IcyItemName = ICYBitrate) then
  304.     Label27.Caption := copy(ICYItem, 1, length(ICYItem));
  305.   Result := S_OK;
  306. end;
  308. function TForm1.AsyncExMetaData(Title: PChar; URL: PChar): HRESULT; stdcall;
  309. begin
  310.   if (length(Title) > 50) then
  311.     Label18.Caption := copy(Title, 1, 45) + '...'
  312.   else
  313.     Label18.Caption := copy(Title, 1, length(Title));
  314.   Label18.Hint := copy(Title, 1, length(Title));
  315.   if (length(URL) > 50) then
  316.     Label19.Caption := copy(URL, 1, 45) + '...'
  317.   else
  318.     Label19.Caption := copy(URL, 1, length(URL));
  319.   Label19.Hint := copy(URL, 1, length(URL));
  320.   Result := S_OK;
  321. end;
  323. function TForm1.AsyncExSockError(ErrString: PChar): HRESULT; stdcall;
  324. begin
  325.   showmessage('can not connect to URL'#13#10#13#10 +
  326.     'Reason:'#13#10 + copy(ErrString, 1, length(ErrString)));
  327.   TmrNillAll.Enabled := true;
  328.   Result := S_OK;
  329. end;
  331. end.