喫茶XRAYトップページ

[スレッド全体]
[4745] [お気に入りに追加]のダイアログ表示返信　削除
2011/5/13 (金) 16:50:16 Mr.XRAY
[お気に入りに追加]のダイアログ表示のコードを書いてみました．
shdocvw.dll内のDoAddToFavDlgという関数で表示(モーダル表示)できるんだそうです．

VCLで未定義のWin32 API関数の使用
http://mrxray.on.coocan.jp/Delphi/Others/Usage_Win32API.htm#01

で，関数そのものを使うのは簡単にできるんですが．
やってみちら，文字が1文字分しか処理してくれんない．
この関数，Ansi版だったんですね．で，AnsiCharに直して動作しました．

う〜む．何か，つまらない．
サンプルプログラム集掲載はボツですね．
動作確認は，Windows 7 U64 + Delphi 2010(UP5)です．

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ShlObj;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

  //PITEMIDLISTの使用にはusesにShlObjが必要
  //文字列はAnsiでないと正常動作しない
  function DoAddToFavDlg(
             hWindow     : HWND;
             wpszInitDir : PAnsiCHAR;
             cchInitDir  : UINT;
             wspzFile    : PAnsiCHAR;
             cchInitFDir : UINT;
             pidlBrowse  : PITEMIDLIST
             ): BOOL; stdcall; external 'shdocvw.dll';

var
  Form1: TForm1;

implementation

uses ActiveX;

{$R *.dfm}

//=============================================================================
//  お気に入りダイアログの表示(タスクバーにアイコン表示なし)
//
//  使用する関数のMSDNの記事より
//  http://msdn.microsoft.com/en-us/library/aa753580%28VS.85%29.aspx
//
//  BOOL DoAddToFavDlg(
//    HWND hwnd,
//    CHAR *pszInitDir,
//    UINT cchInitDir,
//    CHAR *pszFile,
//    UINT cchInitDir,
//    LPITEMIDLIST pidlBrowse
//  );
//
//  PItemIDListの使用にはusesにActiveXが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  wpszInitDir : array[0..MAX_PATH - 1] of AnsiChar;
  wpszFile    : array[0..MAX_PATH - 1] of AnsiChar;
  pidlBrowse  : PItemIDList;
begin
  StrPCopy(wpszFile, '素敵なサイト');
  //[お気に入り]フォルダの項目識別子を取得
  SHGetSpecialFolderLocation(Handle,
                             CSIDL_FAVORITES,
                             pidlBrowse);

  //DoAddToFavDlgはAnsi版であることに注意
  if DoAddToFavDlg(Handle,
                  wpszInitDir,  //終了後に入力した名前のフルパス名が戻ってくる
                  MAX_PATH,
                  wpszFile,     //終了後に入力した名前部分のみが戻ってくる
                  MAX_PATH,
                  pidlBrowse)   //作成先のフォルダを項目識別子で指定
                  then begin;


    //ここに実際の[お気に入り]への登録コードを書く
  end;

  //項目識別子の解放
  CoTaskMemFree(pidlBrowse);
end;

end.


[4746] Re:[お気に入りに追加]のダイアログ表示返信　削除
2011/5/13 (金) 19:39:22 Mr.XRAY
こっちの方がいいような気がします
このコードでは，実際に追加作業もします．

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

  function AddUrlToFavorites(
             hWindow     : HWND;
             pszUrlW     : LPCWSTR;
             pszTitleW   : LPCWSTR;
             fDisplayUI  : BOOL
             ): Integer; stdcall; external 'shdocvw.dll';

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  お気に入りダイアログの表示(タスクバーにアイコン表示なし)
//
//  使用する関数のMSDNの記事より
//  http://msdn.microsoft.com/en-us/library/aa753579%28v=VS.85%29.aspx
//
//  STDAPI AddUrlToFavorites(
//      HWND hwnd,
//      LPCWSTR pszUrlW,
//      LPCWSTR pszTitleW,
//      BOOL fDisplayUI
//  );
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AURL       : String;
  ATitle     : String;
  fDisplayUI : Boolean;
begin
  AURL   :=  'http://mrxray.on.coocan.jp/';
  ATitle := '素敵なサイト';
  //fDisplayUI := True;にするとダイアログを表示しない
  fDisplayUI := False;

  AddUrlToFavorites(Handle, PChar(AURL), PChar(ATitle), fDisplayUI);
end;

end.

[4747] Re2:[お気に入りに追加]のダイアログ表示返信　削除
2011/5/13 (金) 23:55:29 Mr.XRAY
2番目(AddUrlToFavorites関数を使用した)の動作確認環境が書いてありませんでした．
dllのバージョンは調べていません...

Windows XP(SP3) + Delphi 2010 + IE6
Windows Vista + IE7
Windows 7 U64 + IE8ではダイアログは表示しませんでした．
残念ですが．

最初のサンプルコードは，上のいずれでも動作しました．

[4748] Re3:[お気に入りに追加]のダイアログ表示返信　削除
2011/5/14 (土) 00:14:37 Mr.XRAY
参考までに，IShellUIHelperを使用したコードです．
これは，ダイアログのアイコンがタスクバーに(モードレス)表示されます．
Windows XP + IE6
Vista + IE7
Windows 7 U64 + IE8で表示されます．

ダイアログのハンドルを操作して，タスクバーのアイコンを非表示に
もできますが，クラス名が#32770なのて，ちょっと面倒ですね．
もっとも，タスクバーに非表示にしても，モーダル表示となるわけでは
ありません．

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses SHDocVw, ComObj;

{$R *.dfm}

//=============================================================================
//  お気に入りダイアログの表示(タスクバーにアイコン表示あり)
//
//  IShellUIHelperの使用にはusesにSHDocVwが必要
//  CreateComObjectの使用にはusesにComObjが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  UIHelper : IShellUIHelper;
  AURL     : String;
  ATitle   : OleVariant;
begin
  UIHelper := CreateComObject(CLASS_ShellUIHelper) as IShellUIHelper;
  AURL     := 'http://mrxray.on.coocan.jp/';
  ATitle   := '素敵なサイト';

  UIHelper.AddFavorite(AURL, ATitle);
end;

end.

[4751] Re4:[お気に入りに追加]のダイアログ表示返信　削除
2011/5/14 (土) 21:57:19 Mr.XRAY
> 参考までに，IShellUIHelperを使用したコードです．

TEmbeddedWBコンポーネントですと，内部で処理してくれますので，
例えば，以下のようにダイアログを表示できます．

[942_TEmbeddedWBコンポーネント]
http://mrxray.on.coocan.jp/Delphi/plSamples/942_TEmbeddedWB.htm

procedure TForm1.Button1Click(Sender: TObject);
begin
  EmbeddedWB1.AddToFavorites(EmbeddedWB1.LocationURL,
                             EmbeddedWB1.Doc2.title);
end;


あるいは，TFavoritesMenuコンポーネントを配置して，

procedure TForm1.FormCreate(Sender: TObject);
begin
  FavoritesMenu1.CreateMenu;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  FavoritesMenu1.AddFavorite(nil);
end;

[▼次のスレッド]
INCM/CMT
Cyclamen v3.82