itemprop.pas

动态提示控件

{$I DFS.INC}  { Standard defines for all Delphi Free Stuff components }

{ -----------------------------------------------------------------------------}
{ ItemProp v3.54                                                               }
{ -----------------------------------------------------------------------------}
{ A unit to provide access to a file's context menu, properties dialog, and    }
{ default action.                                                              }
{                                                                              }
{ Copyright 2000-2001, Brad Stowers.  All Rights Reserved.                     }
{                                                                              }
{ Copyright:                                                                   }
{ All Delphi Free Stuff (hereafter "DFS") source code is copyrighted by        }
{ Bradley D. Stowers (hereafter "author"), and shall remain the exclusive      }
{ property of the author.                                                      }
{                                                                              }
{ Distribution Rights:                                                         }
{ You are granted a non-exlusive, royalty-free right to produce and distribute }
{ compiled binary files (executables, DLLs, etc.) that are built with any of   }
{ the DFS source code unless specifically stated otherwise.                    }
{ You are further granted permission to redistribute any of the DFS source     }
{ code in source code form, provided that the original archive as found on the }
{ DFS web site (http://www.delphifreestuff.com) is distributed unmodified. For }
{ example, if you create a descendant of TDFSColorButton, you must include in  }
{ the distribution package the colorbtn.zip file in the exact form that you    }
{ downloaded it from http://www.delphifreestuff.com/mine/files/colorbtn.zip.   }
{                                                                              }
{ Restrictions:                                                                }
{ Without the express written consent of the author, you may not:              }
{   * Distribute modified versions of any DFS source code by itself. You must  }
{     include the original archive as you found it at the DFS site.            }
{   * Sell or lease any portion of DFS source code. You are, of course, free   }
{     to sell any of your own original code that works with, enhances, etc.    }
{     DFS source code.                                                         }
{   * Distribute DFS source code for profit.                                   }
{                                                                              }
{ Warranty:                                                                    }
{ There is absolutely no warranty of any kind whatsoever with any of the DFS   }
{ source code (hereafter "software"). The software is provided to you "AS-IS", }
{ and all risks and losses associated with it's use are assumed by you. In no  }
{ event shall the author of the softare, Bradley D. Stowers, be held           }
{ accountable for any damages or losses that may occur from use or misuse of   }
{ the software.                                                                }
{                                                                              }
{ Support:                                                                     }
{ Support is provided via the DFS Support Forum, which is a web-based message  }
{ system.  You can find it at http://www.delphifreestuff.com/discus/           }
{ All DFS source code is provided free of charge. As such, I can not guarantee }
{ any support whatsoever. While I do try to answer all questions that I        }
{ receive, and address all problems that are reported to me, you must          }
{ understand that I simply can not guarantee that this will always be so.      }
{                                                                              }
{ Clarifications:                                                              }
{ If you need any further information, please feel free to contact me directly.}
{ This agreement can be found online at my site in the "Miscellaneous" section.}
{------------------------------------------------------------------------------}
{ The lateset version of my components are always available on the web at:     }
{   http://www.delphifreestuff.com/                                            }
{ See ItemProp.txt for notes, known issues, and revision history.              }
{ -----------------------------------------------------------------------------}
{ Date last modified:  June 28, 2001                                           }
{ -----------------------------------------------------------------------------}

unit ItemProp;

interface

// See the included ShellFix.txt file if you get a compile error on 'MyShlObj'.
uses Windows, Classes,
     {$IFDEF DFS_COMPILER_2}
     MyShlObj, OLE2;
     {$ELSE}
     ShlObj, ActiveX;
     {$ENDIF}

{$IFDEF DFS_COMPILER_2}
const 
  CMF_CANRENAME = $00000010;
{$ENDIF}

type
  DFS_HWND = {$IFDEF DFS_DELPHI} HWND {$ELSE} pointer {$ENDIF};


//------------------------------------------------------------------------------
// You must pass fully qualified path names to all of these functions.  No
// guarantees are made as to what will happen for relative pathnames.
// If you are calling for a subdirectory (i.e. no filename), it is your
// responsibility to insure that there is *NO* trailing backslash.
//------------------------------------------------------------------------------


//------------------------------------------------------------------------------
// DisplayContextMenu displays the right click menu for the given file or
// directory and processes the item selected, if any.  Parent is the window
// handle for the owning window of any error messages that may need to be
// displayed by the system, MyForm.Handle is generally fine.  Pos is the X, Y
// position to display the menu at given in screen (absolute) coordinates.
//------------------------------------------------------------------------------

{$IFDEF DFS_COMPILER_4_UP}
function DisplayContextMenu(const Filename: string; Parent: DFS_HWND;
   Pos: TPoint; ShowRename: boolean; var RenameSelected: boolean): boolean; overload;

function DisplayContextMenu(const Directory: string; Items: TStringList;
   Parent: DFS_HWND; Pos: TPoint; ShowRename: boolean;
   var RenameSelected: boolean): boolean; overload;

function DisplayContextMenu(AParent: IShellFolder; var APIDL: PItemIDList;
   Attr: ULONG; Parent: DFS_HWND; Pos: TPoint; PidlCount: integer;
   ShowRename: boolean; var RenameSelected: boolean): boolean; overload;

{$ELSE}

function DisplayContextMenu(const Filename: string; Parent: DFS_HWND;
   Pos: TPoint; ShowRename: boolean; var RenameSelected: boolean): boolean;

function DisplayContextMenuList(const Directory: string; Items: TStringList;
   Parent: DFS_HWND; Pos: TPoint; ShowRename: boolean;
   var RenameSelected: boolean): boolean;

function DisplayContextMenuPIDL(AParent: IShellFolder; var APIDL: PItemIDList;
   Attr: ULONG; Parent: DFS_HWND; Pos: TPoint; PidlCount: integer;
   ShowRename: boolean; var RenameSelected: boolean): boolean;

{$ENDIF}

//------------------------------------------------------------------------------
// DisplayPropertiesDialog displays, oddly enough, the properties dialog for
// the given file or directory.  Parent is the window handle for the owning
// window of any error messages that may need to be displayed by the system,
// MyForm.Handle is generally fine.
//------------------------------------------------------------------------------
{$IFDEF DFS_COMPILER_4_UP}
function DisplayPropertiesDialog(const Filename: string;
   Parent: DFS_HWND): boolean; overload;

function DisplayPropertiesDialog(const Directory: string; Items: TStringList;
   Parent: DFS_HWND): boolean; overload;

function DisplayPropertiesDialog(AParent: IShellFolder; var APIDL: PItemIDList;
   Attr: ULONG; Parent: DFS_HWND; PidlCount: integer): boolean; overload;

{$ELSE}

function DisplayPropertiesDialog(const Filename: string; Parent: DFS_HWND): boolean;

function DisplayPropertiesDialogList(const Directory: string; Items: TStringList;
   Parent: DFS_HWND): boolean;

function DisplayPropertiesDialogPIDL(AParent: IShellFolder; var APIDL: PItemIDList;
   Attr: ULONG; Parent: DFS_HWND; PidlCount: integer): boolean;

{$ENDIF}

//------------------------------------------------------------------------------
// PerformDefaultAction causes the item's double-click action to be taken.
// Parent is the window handle for the owning window of any error messages
// that may need to be displayed by the system, MyForm.Handle is generally fine.
//------------------------------------------------------------------------------
{$IFDEF DFS_COMPILER_4_UP}
function PerformDefaultAction(const Filename: string;
   Parent: DFS_HWND): boolean; overload;

function PerformDefaultAction(const Directory: string; Items: TStringList;
   Parent: DFS_HWND): boolean; overload;

function PerformDefaultAction(AParent: IShellFolder; var APIDL: PItemIDList;
   Attr: ULONG; Parent: DFS_HWND; PidlCount: integer): boolean; overload;

{$ELSE}

function PerformDefaultAction(const Filename: string;
   Parent: DFS_HWND): boolean;

function PerformDefaultActionList(const Directory: string; Items: TStringList;
   Parent: DFS_HWND): boolean;

function PerformDefaultActionPIDL(AParent: IShellFolder; var APIDL: PItemIDList;
   Attr: ULONG; Parent: DFS_HWND; PidlCount: integer): boolean;
   
{$ENDIF}


//------------------------------------------------------------------------------
// PerformVerb causes executes the given verb for the item.  Common verbs are
// 'delete', 'cut', 'copy', 'paste', etc. Parent is the window handle for the
// owning window of any error messages that may need to be displayed by the
// system, MyForm.Handle is generally fine.
//------------------------------------------------------------------------------
{$IFDEF DFS_COMPILER_4_UP}
function PerformVerb(const Verb, Filename: string;
   Parent: DFS_HWND): boolean; overload;

function PerformVerb(const Verb, Directory: string; Items: TStringList;
   Parent: DFS_HWND): boolean; overload;

function PerformVerb(const Verb: string; AParent: IShellFolder;
   var APIDL: PItemIDList; Attr: ULONG; Parent: DFS_HWND;
   PidlCount: integer): boolean; overload;

{$ELSE}

function PerformVerb(const Verb, Filename: string; Parent: DFS_HWND): boolean;

function PerformVerbList(const Verb, Directory: string; Items: TStringList;
   Parent: DFS_HWND): boolean;

function PerformVerbPIDL(const Verb: string; AParent: IShellFolder;
   var APIDL: PItemIDList; Attr: ULONG; Parent: DFS_HWND;
   PidlCount: integer): boolean;
{$ENDIF}


//------------------------------------------------------------------------------
// Utility function that you probably won't need, but included just in case.
// Caller is responsible for calling shell malloc Free for PIDL param when done.
//------------------------------------------------------------------------------
function GetPIDLAndShellFolder(Path: string;
   {$IFDEF DFS_COMPILER_4_UP} out {$ELSE} var {$ENDIF} Folder: IShellFolder;
   var PIDL: PItemIDList; ShellMalloc: IMalloc;
   Parent: DFS_HWND): boolean;

type
  PPIDLArray = ^TPIDLArray;
  TPIDLArray = array[0..0] of PItemIDList;


implementation

uses SysUtils, Forms, Controls, Messages;


const
  IID_IContextMenu3: TGUID = (
    D1:$BCFCE0A0; D2:$EC17; D3:$11D0; D4:($8D,$10,$00,$A0,$C9,$0F,$27,$19));

{$IFDEF DFS_COMPILER_3}
const
  SID_IContextMenu3      = '{BCFCE0A0-EC17-11d0-8D10-00A0C90F2719}';

type
  { D3 and C3 got the declaration of IContextMenu2 wrong in ShlObj.pas unit. }
  IContextMenu2 = interface(IContextMenu)
    [SID_IContextMenu2]
    function HandleMenuMsg(uMsg: UINT; wParam: WPARAM; lParam: LPARAM): HResult;
       stdcall;
  end;

  { Only D4 has this one }
  IContextMenu3 = interface(IContextMenu2)
    [SID_IContextMenu3]
    function HandleMenuMsg2(uMsg: UINT; wParam: WPARAM; lParam: LPARAM;
      var Result: longint): HResult; stdcall;
  end;

{$ELSE} {$IFDEF DFS_COMPILER_2}
  { D2 and C1 don't have IContextMenu2 declared at all... }
const
  IID_IContextMenu2: TGUID = (
    D1:$000214F4; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));

type
  IContextMenu2 = class(IContextMenu)
    function HandleMenuMsg(uMsg: UINT; wParam: WPARAM; lParam: LPARAM): HResult;
       virtual; stdcall; abstract;
  end;

  { Only D4 has this one }
  IContextMenu3 = class(IContextMenu2)
    function HandleMenuMsg2(uMsg: UINT; wParam: WPARAM; lParam: LPARAM;
      var Result: longint): HResult; virtual; stdcall; abstract;
  end;
{$ENDIF} {$ENDIF}

const
  CMD_ID_OFFSET = 1;

var
  IsCM2: boolean;
  IsCM3: boolean;
  g_ShowRename: boolean;
  g_RenameSelected: boolean;

type
  DoubleWord = record
    case boolean of
      TRUE: (Lo, Hi: word);
      FALSE: (DW: DWORD);
  end;

function MenuCallbackProc(Wnd: HWND; Msg: UINT; wParam: WPARAM;
   lParam: LPARAM): LResult; stdcall; export;
var
  CM2: IContextMenu2;
  CM3: IContextMenu3;
  Name,
  Help: string;
  CM: IContextMenu;
  DWParam: DoubleWord absolute wParam;
begin
  case Msg of
    WM_CREATE:
      begin
        if IsCM3 then
        begin
          // get pointer to the IContextMenu3 on whose behalf we're acting
          CM3 := IContextMenu3(PCreateStruct(lParam).lpCreateParams);
          // Save it in window info
          SetWindowLong(Wnd, GWL_USERDATA, LongInt(CM3));
        end
        else if IsCM2 then
        begin
          // get pointer to the IContextMenu2 on whose behalf we're acting
          CM2 := IContextMenu2(PCreateStruct(lParam).lpCreateParams);
          // Save it in window info
          SetWindowLong(Wnd, GWL_USERDATA, LongInt(CM2));
        end
        else
        begin
          // get pointer to the IContextMenu on whose behalf we're acting
          CM := IContextMenu(PCreateStruct(lParam).lpCreateParams);
          // Save it in window info
          SetWindowLong(Wnd, GWL_USERDATA, LongInt(CM));