?
Solved

sendto context menu

Posted on 2003-03-12
11
Medium Priority
?
552 Views
Last Modified: 2010-08-05
How to display and give the functionality of the sendto context menu along with the icons in a VB application
0
Comment
Question by:venuvrk
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
11 Comments
 

Expert Comment

by:shijaz_a
ID: 8120481
The send to menu is located at C:\WINDOWS\SendTo
All shortcuts placed here appear in the context menu.

All you have to do is use an API to find the Windows directory. For this u need to add the foll declaration in a module:

Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Put this in the form

    Dim x As Long
    Dim Buffer As String
    Buffer = Space(255)
   
    x = GetWindowsDirectory(Buffer, Len(Buffer))
    'remove trailing null char '\0'
    Buffer = Left(Buffer, Len(Buffer) - 1)
    Label1.Caption = Buffer

Label1 will contain windows directory.

Now you can get the SendTo directory:
    Dim SendToPath as String
    SendToPath = Label1.Caption & "\SendTo"

Now u can access these shortcuts and use them anyway you like or put them in ur own menu.
0
 
LVL 3

Expert Comment

by:DocM
ID: 8121537
Private Declare Function SHGetSpecialFolderLocation Lib "shell32" (ByVal hwnd As Long, ByVal nFolder As Long, Pidl As Long) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal Pidl As Long, ByVal FolderPath As String) As Long

Private Const CSIDL_SENDTO = &H9
Private Const MAX_PATH = 260

Private Function SendToPath() As String

    Dim Pidl As Long
    Dim sFolderPath As String
    If SHGetSpecialFolderLocation(0, CSIDL_SENDTO, Pidl) = 0 Then
        sFolderPath = String(MAX_PATH, 0)
        If SHGetPathFromIDList(Pidl, ByVal sFolderPath) Then
            SendToPath = Left(sFolderPath, InStr(1, sFolderPath, Chr(0)) - 1)
        End If
    End If
End Function

Private Sub Command1_Click()
   
File1.Path = SendToPath

End Sub
0
 

Author Comment

by:venuvrk
ID: 8149807
thanks shijaz_a  and DocM  but that does not help me out... i need to show the menu with icons and functionality ...

 i have a app which has the functionality  of sending files to mydocument or desktop .. or any thing whihc is under sendto folder....

 so i need to build a menu and display it...
please help me out it very urgent
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 1

Accepted Solution

by:
thaimin earned 800 total points
ID: 8316155
The following code will generate a menu that has the names of all the files in the send to folder. When you click on one of the menu items, a message box pops up with the full file name. You could make it run a Shell(file) to run that file. It assumes no file there has more then one "." in the name, and the every file name excluding the extension is unique.

To use this script you need:
  a menu
  a submenu of that menu called SendToFile with an index of 0, visible, and not enabled.

Option Explicit

Private Declare Function SHGetSpecialFolderLocation Lib "shell32" (ByVal hwnd As Long, ByVal nFolder As Long, Pidl As Long) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal Pidl As Long, ByVal FolderPath As String) As Long

Private Const CSIDL_SENDTO = &H9
Private Const MAX_PATH = 260

Private Sub Form_Load()
    Dim path As String
    Dim file As String
    Dim i As Integer
    path = SendToPath()
    i = 1
    file = path & "\" & Dir(path & "\*.*") 'get first file
    Do
        Load SendToFile(i) 'create new menu item
        SendToFile(i).Visible = True
        SendToFile(i).Checked = False
        SendToFile(i).Caption = FileName(file)
        i = i + 1
        file = path & "\" & Dir 'get next file
    Loop Until (file = path & "\")
    SendToFile(0).Visible = False 'hide the original which we copied
End Sub

'When the menu item is clicked
Private Sub SendToFile_Click(Index As Integer)
    If Index = 0 Then Exit Sub 'this is the dummy
    Dim file As String
    Dim path As String
    path = SendToPath()
    file = path & "\" & SendToFile(Index).Caption
    file = path & "\" & Dir(file & ".*") 'gets the extension
    MsgBox file
End Sub

'Gets SendTo path
Private Function SendToPath() As String
   Dim Pidl As Long
   Dim sFolderPath As String
   If SHGetSpecialFolderLocation(0, CSIDL_SENDTO, Pidl) = 0 Then
       sFolderPath = String(MAX_PATH, 0)
       If SHGetPathFromIDList(Pidl, ByVal sFolderPath) Then
           SendToPath = Left(sFolderPath, InStr(1, sFolderPath, Chr(0)) - 1)
       End If
   End If
End Function

'Gets the filename part of a full path
Private Function FileName(ByVal path As String) As String
    Dim slash As Integer
    Dim LastSlash As Integer
    slash = 0
Get_slash:
    slash = InStr(slash + 1, path, "\")
    If (slash <> 0) Then 'if there was another slash..
        LastSlash = slash
        GoTo Get_slash 'try again
    End If
    FileName = Mid(path, LastSlash + 1, InStr(1, path, ".") - LastSlash - 1)
End Function
0
 
LVL 1

Expert Comment

by:thaimin
ID: 8316165
That code is missing the icon part, which I do not know how to do, but I will try to find out how to.
0
 
LVL 1

Expert Comment

by:thaimin
ID: 8317126
This code will now generate the menu with all the icons. The menu also will popup when you right-click the background. A slight warning though is that this will look a lot worse then the Windows one becuase the one in Windows can use 16 x 16 pxl icons, where in Visual Basic, you can only use a 13 x 13 pxl icon. Also, on my computer at least, all drives are missing from the Send To list through this script becuase they are not actually in the SendTo folder, but instead are added later. If you want this script can be modified to include an a drive.

To use this script you need:
 a menu called FileMenu
 a submenu called SendTo
 a submenu of SendTo called SendToFile with an index of 0, visible, and not enabled.
 two picture boxes, with all default settings
 an imagelist (Microsoft Windows Common Controls 5.0 or higher)


'****Send To Menu Generator****
Option Explicit

Private Declare Function SHGetSpecialFolderLocation Lib "shell32" (ByVal hwnd As Long, ByVal nFolder As Long, Pidl As Long) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal Pidl As Long, ByVal FolderPath As String) As Long
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long
Private Declare Function ExtractAssociatedIcon Lib "shell32.dll" Alias "ExtractAssociatedIconA" (ByVal hInst As Long, ByVal lpIconPath As String, lpiIcon As Long) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Integer
Private Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long

Private Const CSIDL_SENDTO = &H9
Private Const MAX_PATH = 260

Private Sub Form_Load()
    Dim path As String, file As String
    Dim hMenu As Long, hSubMenu As Long, hSendToMenu As Long, menuID As Long, retval As Long
    Dim i As Integer
    ImageList1.ImageHeight = 13 'setup imagelist
    ImageList1.ImageWidth = 13
    Picture1.Appearance = 0
    Picture1.BorderStyle = 0 'setup picture boxes
    Picture1.Visible = False
    Picture2.Appearance = 0
    Picture2.BorderStyle = 0
    Picture2.Visible = False
    hMenu = GetMenu(Me.hwnd) 'get all the menus
    hSubMenu = GetSubMenu(hMenu, 0)
    hSendToMenu = GetSubMenu(hSubMenu, 0)
    path = SendToPath()
    i = 1
    file = Dir(path & "\*.*") 'get first file
    Do
        Load SendToFile(i) 'create new menu item
        SendToFile(i).Visible = True
        SendToFile(i).Checked = False
        SendToFile(i).Caption = RemoveExt(file)
        GetIcon path & "\" & file, i 'Saves icon to the imagelist
        menuID = GetMenuItemID(hSendToMenu, i) 'get the item in the menu
        retval = SetMenuItemBitmaps(hMenu, menuID, 0, ImageList1.ListImages(i).Picture, ImageList1.ListImages(i).Picture) 'Pictures(i).Picture, Pictures(i).Picture) 'draw the icon
        i = i + 1
        file = Dir 'get next file
    Loop Until (file = "")
    SendToFile(0).Visible = False 'hide the original which we copied
End Sub

'When the menu item is clicked
Private Sub SendToFile_Click(index As Integer)
    If index = 0 Then Exit Sub 'this is the dummy menu item
    Dim file As String
    Dim path As String
    path = SendToPath()
    file = path & "\" & SendToFile(index).Caption
    file = path & "\" & Dir(file & ".*") 'gets the extension
    MsgBox file
End Sub

'Gets SendTo path
Private Function SendToPath() As String
   Dim Pidl As Long
   Dim sFolderPath As String
   If SHGetSpecialFolderLocation(0, CSIDL_SENDTO, Pidl) = 0 Then
       sFolderPath = String(MAX_PATH, 0)
       If SHGetPathFromIDList(Pidl, ByVal sFolderPath) Then
           SendToPath = Left(sFolderPath, InStr(1, sFolderPath, Chr(0)) - 1)
       End If
   End If
End Function

'Removes the extension part of a filename
Private Function RemoveExt(ByVal file As String) As String
    RemoveExt = Left(file, InStr(1, file, ".") - 1)
End Function

'Shows the menu on a left click
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  If Button = 2 Then
    PopupMenu FileMenu, 2, x, y
  End If
End Sub

'Gets the icon of a file and save it to ImageList1 at index
'Needs 2 hidden picture boxes, Picture1 and Picture2
Private Sub GetIcon(ByVal filePath As String, index As Integer)
    Dim iconH As Long, mIcon As Long
    Picture1.Height = 32 * Screen.TwipsPerPixelY 'Make the box the right size
    Picture1.Width = 32 * Screen.TwipsPerPixelX
    iconH = ExtractAssociatedIcon(App.hInstance, filePath, mIcon) 'Get the icon
    DrawIcon Picture1.hdc, 0, 0, iconH 'Draw using the icon handle
    DrawIcon Picture1.hdc, 0, 0, mIcon 'Draw the secondary icon handle
    DestroyIcon iconH 'Free memory
    Picture1.Refresh
    Picture2.Height = 13 * Screen.TwipsPerPixelY 'Make the box the right size
    Picture2.Width = 13 * Screen.TwipsPerPixelX
    Picture2.PaintPicture Picture1.Image, 0, 0, Picture2.Width, Picture2.Height 'Draw the icon at reduced size
    Picture2.Refresh
    Picture2.Picture = Picture2.Image 'Turn from image into bitmap
    ImageList1.ListImages.Add index, filePath, Picture2.Picture 'Make the new icon in the imagelist
End Sub
0
 

Author Comment

by:venuvrk
ID: 8317363
  Thank you thaimin for the answer.
   I have already got the solution in the same manner you have done it, anyway thanks a lot for your genuine help.
0
 

Expert Comment

by:CleanupPing
ID: 9056410
venuvrk:
This old question needs to be finalized -- accept an answer, split points, or get a refund.  For information on your options, please click here-> http:/help/closing.jsp#1 
EXPERTS:
Post your closing recommendations!  No comment means you don't care.
0
 
LVL 1

Expert Comment

by:thaimin
ID: 9163568
I think that I should get the points for being the one who actually answered the question, even though venuvrk achieved it in the same way.
0
 
LVL 49

Expert Comment

by:DanRollins
ID: 9664469
Moderator, my recommended disposition is:

    Accept thaimin's comment(s) as an answer.

DanRollins -- EE database cleanup volunteer
0

Featured Post

On Demand Webinar: Networking for the Cloud Era

Did you know SD-WANs can improve network connectivity? Check out this webinar to learn how an SD-WAN simplified, one-click tool can help you migrate and manage data in the cloud.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses
Course of the Month9 days, 20 hours left to enroll

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question