Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
Having a (send-to) Menu In Your Programs Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
29-Oct-02
Category
VCL-Menu
Language
Delphi 4.x
Views
91
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			Author: Abu Zant Ruslan

If you are interested in getting the windows send-to menu in your programs, try the 
following code !!

Answer:

Here Is The Whole Unit 
1   unit uSendTo;
2   
3   interface
4   
5   uses
6     SysUtils, Windows, Messages, Classes, Controls, Forms,
7     Dialogs, StdCtrls, ExtCtrls, Menus, ComCtrls, FileCtrl,
8     ShellAPI, ShlObj, ActiveX, ComObj;
9   
10  // Very basic example - a Form with a FileListBox and a PopupMenu...
11  type
12    TForm1 = class(TForm)
13      PopupMenu1: TPopupMenu;
14      FileListBox1: TFileListBox;
15      procedure FormCreate(Sender: TObject);
16    private
17      procedure SendToItemClick(Sender: TObject); // MenuItem event-handler
18    public
19      { Public declarations }
20    end;
21  
22    // declare a special type of TMenuItem to store the EXE name...
23  type
24    TMyMenuItem = class(TMenuItem)
25    public Verb: string;
26    end;
27  
28  var
29    Form1: TForm1;
30  implementation
31  
32  {$R *.DFM}
33  
34  // a pipe-delimited list of file extensions that are normally hidden...
35  const
36    HiddenExtensions = '.LNK|.DESKLINK|.MYDOCS|.MAPIMAIL';
37  
38    // Get path to the SendTo folder (Like Madshi says) ...
39  
40  function GetSendToFolder: string;
41  var
42    pIDL: pItemIDList;
43    Buffer: array[0..MAX_PATH] of char;
44    Malloc: IMalloc;
45  begin
46    SHGetSpecialFolderLocation(0, CSIDL_SENDTO, pIDL);
47    ShGetPathFromIdList(pIDL, PChar(@Buffer));
48    Result := Buffer;
49    OLECheck(SHGetMalloc(Malloc));
50    if pIDL <> nil then
51      Malloc.Free(pIDL);
52  end;
53  
54  // Recursive function to find all items in SendTo folder
55  // Creates sub-menu items if the folder has sub-directories...
56  
57  procedure CreateMenuItems(Path: string; aMenuItem: TMenuItem);
58  var
59    SR: TSearchRec;
60    MI: TMyMenuItem;
61    procedure AddIf;
62    begin
63      if SR.Attr and faDirectory <= 0 then
64      begin // if it's a file
65        MI := TMyMenuItem.Create(Form1);
66        if pos(UpperCase(ExtractFileExt(SR.Name)), HiddenExtensions) > 0 then
67          MI.Caption := ChangeFileExt(SR.Name, '')
68        else
69          MI.Caption := SR.Name;
70        MI.Verb := Path + SR.Name;
71        MI.OnClick := Form1.SendToItemClick; //Assign event handler
72        aMenuItem.Add(MI)
73      end
74      else if SR.Name[1] <> '.' then
75      begin // if it's a folder
76        MI := TMyMenuItem.Create(Form1);
77        MI.Caption := SR.Name;
78        aMenuItem.Add(MI);
79        CreateMenuItems(Path + SR.Name, MI); // Recursive call
80      end;
81    end;
82  begin
83    if Path[Length(Path)] <> '\' then
84      Path := Path + '\';
85    if FindFirst(Path + '*', faAnyFile, SR) = 0 then
86    begin
87      AddIf;
88      while FindNext(SR) = 0 do
89        AddIf;
90    end;
91  end;
92  
93  // Find the EXE that the shortcut points to -
94  // Adapted from Elliott Shevin's TShortcutLink component
95  // (this could be modified to get the icon, ShowState, etc... )
96  
97  function GetShortcutTarget(ShortcutFilename: string): string;
98  var
99    Psl: IShellLink;
100   Ppf: IPersistFile;
101   WideName: array[0..MAX_PATH] of WideChar;
102   pResult: array[0..MAX_PATH - 1] of Char;
103   Data: TWin32FindData;
104 const
105   IID_IPersistFile: TGUID = (D1: $0000010B; D2: $0000; D3: $0000; D4:
106     ($C0, $00, $00, $00, $00, $00, $00, $46));
107 begin
108   CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IID_IShellLinkA, 
109 psl);
110   psl.QueryInterface(IID_IPersistFile, ppf);
111   MultiByteToWideChar(CP_ACP, 0, pChar(ShortcutFilename), -1, WideName, Max_Path);
112   ppf.Load(WideName, STGM_READ);
113   psl.Resolve(0, SLR_ANY_MATCH);
114   psl.GetPath(@pResult, MAX_PATH, Data, SLGP_UNCPRIORITY);
115   Result := StrPas(@pResult);
116 end;
117 
118 procedure TForm1.SendToItemClick(Sender: TObject);
119 begin
120   // Just shows the filename - you could use ShellExecute or CreateProcess instead
121   // But need some special handling for MyDocuments, Desktop and MailRecipient
122   ShowMessage(GetShortcutTarget(TMyMenuItem(Sender).Verb));
123 end;

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


!! OR TRY THIS MORE DEBUGGED VERSION !!!

Fixed:
1. Memory leak (no FindClose) 
2. Kludge for removing file extensions that are normally hidden (now uses WinAPI to 
get the descriptive name)
3. Removed unessary duplication (Addif; while, etc - changed to repeat) 
4. Added the all important but missing FormCreate event to show how this works... 

124 
125 // Recursive function to find all items in SendTo folder
126 // Creates sub-menu items if the folder has sub-directories...
127 
128 procedure CreateMenuItems(Path: string; aMenuItem: TMenuItem);
129 var
130   SR: TSearchRec;
131   MI: TMyMenuItem;
132   oSHFileInfo: SHFileInfo;
133 
134   procedure AddItemToMenu;
135   begin
136     MI := TMyMenuItem.Create(Form1);
137 
138     if SR.Attr and faDirectory <= 0 then
139     begin // if it's a file
140       // get system file information for item
141       FillChar(oSHFileInfo, Sizeof(SHFileInfo), 0);
142 
143       // get systems' "proper" name for item
144       SHGetFileInfo(PChar(Path + SR.Name), 0, oSHFileInfo, Sizeof(SHFileInfo),
145         SHGFI_DISPLAYNAME);
146       MI.Caption := oSHFileInfo.szDisplayName;
147 
148       MI.Verb := Path + SR.Name;
149       MI.OnClick := Form1.SendToItemClick; //Assign event handler
150       aMenuItem.Add(MI);
151 
152     end
153     else if SR.Name[1] <> '.' then
154     begin // if it's a folder
155       MI.Caption := SR.Name;
156       aMenuItem.Add(MI);
157       CreateMenuItems(Path + SR.Name, MI); // Recursive call
158     end;
159   end;
160 begin
161   Path := IncludeTrailingBackSlash(Path);
162   if FindFirst(Path + '*', faAnyFile, SR) = 0 then
163   begin
164     try
165       repeat
166         AddItemToMenu;
167       until (FindNext(SR) <> 0);
168     finally
169       FindClose(SR);
170     end;
171   end;
172 end;
173 
174 procedure TForm1.FormCreate(Sender: TObject);
175 begin
176   CreateMenuItems(GetSendToFolder(), popupmenu1.Items);
177   // to mimic the windows Send to menu you will:
178   // 1. need to sort popupmenu1.Items alphabetically
179   // 2. retrieve the icons
180   // 3. find out how to execute them!
181 end;


Have Fun !!

			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC