显示一个HTML页面对话框

uses MSHTML , URLMon , ActiveX ;

type

 TShowHTMLDialog = function ( const hwndParent : HWND ; const pmk : IMoniker ;

      const pvarArgIn : Variant ; const pchOptions : POleStr ;

      var pvarArgOut : Variant ): HResult ; stdcall ;

procedure DisplayHTMLDialog ( AURL : string ;

             Resizable : boolean = false ;

             AHeight : integer = 100 ;

             AWidth   : integer = 100 );

var

URLStr : POleStr ;

pmk : IMoniker ;

InParam   : Variant ;

OutParam : Variant ;

Features : PWideChar ;

LibHandle : THandle ;

ShowHTMLDialog : TShowHTMLDialog ;

AParams : Widestring ;

begin

 LibHandle := LoadLibrary ( 'MSHTML.DLL' );

  if LibHandle = 0 then

   Exit ;

  @ ShowHTMLDialog := GetProcAddress ( LibHandle , 'ShowHTMLDialog' );

  if not Assigned ( ShowHTMLDialog ) then

  Exit ;

 URLStr := StringToOleStr ( AURL );

 CreateURLMoniker ( nil , URLStr , pmk );

 SysFreeString ( URLStr );

 TVarData ( InParam ). VType := varOleStr ;

 TVarData ( InParam ). VOleStr := StringToOleStr ( '' );

  if Resizable then

  AParams := 'resizable:yes;'

    else

     AParams := '' ;

 AParams := AParams + Format ( 'dialogHeight:%d pt;' ,[ AHeight ]);

 AParams := AParams + Format ( 'dialogWidth:%d pt;' ,[ AWidth ]);

 Features := PWideChar ( AParams );

 ShowHTMLDialog ( 0 , pmk , InParam , Features , OutParam );

 FreeLibrary ( LibHandle );

end ;

procedure TForm1 . Button1Click ( Sender : TObject );

begin

 DisplayHTMLDialog ( 'http://www.163.com' );

end ;