FileListBox - fazer no meu programa um menu com o sendto do windows

Top  Previous  Next

Question/Problem/Abstract:

 

I See Many programs like windows explorer itself that implements a send-to menu item, may i do it myself ?? 

Answer:

 

 

Here Is The Whole Unit 

====================== 

unit uSendTo; 

 

interface 

 

uses 

SysUtils, Windows, Messages, Classes, Controls, Forms, 

Dialogs, StdCtrls, ExtCtrls, Menus, ComCtrls, FileCtrl, 

ShellAPI, ShlObj, ActiveX, ComObj ; 

 

// Very basic example - a Form with a FileListBox and a PopupMenu... 

type 

TForm1 = class(TForm) 

   PopupMenu1: TPopupMenu; 

   FileListBox1: TFileListBox; 

   procedure FormCreate(Sender: TObject); 

private 

   procedure SendToItemClick(Sender: TObject); // MenuItem event-handler 

public 

   { Public declarations } 

end

 

// declare a special type of TMenuItem to store the EXE name... 

type TMyMenuItem=class(TMenuItem) 

public Verb:String; 

end

 

var 

Form1: TForm1; 

implementation 

 

{$R *.DFM} 

 

 

// a pipe-delimited list of file extensions that are normally hidden... 

const HiddenExtensions = '.LNK|.DESKLINK|.MYDOCS|.MAPIMAIL'

 

 

// Get path to the SendTo folder (Like Madshi says) ... 

function GetSendToFolder:string; 

var 

pIDL :pItemIDList; 

Buffer: array[0..MAX_PATH]of char; 

Malloc: IMalloc; 

begin 

SHGetSpecialFolderLocation(0, CSIDL_SENDTO, pIDL); 

ShGetPathFromIdList(pIDL, PChar(@Buffer)); 

Result:= Buffer; 

OLECheck(SHGetMalloc(Malloc)); 

if pIDL <> nil then Malloc.Free(pIDL); 

end

 

 

 

 

 

 

 

 

 

 

 

 

 

// Recursive function to find all items in SendTo folder 

// Creates sub-menu items if the folder has sub-directories... 

procedure CreateMenuItems(Path:string; aMenuItem:TMenuItem); 

var 

SR:TSearchRec; 

MI:TMyMenuItem; 

procedure AddIf; 

begin 

if SR.Attr and faDirectory<=0 then begin   // if it's a file 

   MI := TMyMenuItem.Create(Form1); 

   if pos(UpperCase(ExtractFileExt(SR.Name)), HiddenExtensions)>0 then 

   MI.Caption :=ChangeFileExt(SR.Name,''else MI.Caption :=SR.Name; 

   MI.Verb:=Path+SR.Name; 

   MI.OnClick:=Form1.SendToItemClick; //Assign event handler 

   aMenuItem.Add(MI) 

end else if  SR.Name[1]<>'.' then begin  // if it's a folder 

   MI := TMyMenuItem.Create(Form1); 

   MI.Caption := SR.Name; 

   aMenuItem.Add(MI); 

   CreateMenuItems(Path+SR.Name, MI); // Recursive call 

end

end

begin 

   if Path[Length(Path)]<>'\' then Path:=Path+'\'

   if FindFirst(Path+'*',faAnyFile,SR)=0 then begin 

   AddIf; 

   while FindNext(SR)=0 do AddIf; 

end

end

 

// Find the EXE that the shortcut points to - 

// Adapted from Elliott Shevin's TShortcutLink component 

// (this could be modified to get the icon, ShowState, etc... ) 

function GetShortcutTarget(ShortcutFilename:string):string; 

var 

Psl:IShellLink; 

Ppf:IPersistFile; 

WideName:Array [0..MAX_PATH] of WideChar; 

pResult:Array [0..MAX_PATH-1Of Char; 

Data:TWin32FindData; 

const 

IID_IPersistFile: TGUID = ( 

     D1:$0000010B; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46)); 

begin 

CoCreateInstance(CLSID_ShellLink,nil,CLSCTX_INPROC_SERVER, IID_IShellLinkA ,psl); 

psl.QueryInterface(IID_IPersistFile,ppf); 

MultiByteToWideChar(CP_ACP, 0, pChar(ShortcutFilename), -1, WideName, Max_Path); 

ppf.Load(WideName,STGM_READ); 

psl.Resolve(0,SLR_ANY_MATCH); 

psl.GetPath( @pResult,MAX_PATH,Data,SLGP_UNCPRIORITY); 

Result:=StrPas(@pResult); 

end

 

 

procedure TForm1.SendToItemClick(Sender: TObject); 

begin 

// Just shows the filename - you could use ShellExecute or CreateProcess instead 

// But need some special handling for MyDocuments, Desktop and MailRecipient 

ShowMessage(GetShortcutTarget(TMyMenuItem(Sender).Verb)); 

end

 

 

 

after compiling, it will be very easy to U to ge the needed functions and add them tto your own applications !! 

 

 

Have Fun !!