Platforms to show: All Mac Windows Linux Cross-Platform

/Win/Windows Shortcuts/Create Shortcuts


Required plugins for this example: MBS Win Plugin

You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Win/Windows Shortcuts/Create Shortcuts

This example is the version from Thu, 31th Jul 2019.

Project "Create Shortcuts.xojo_binary_project"
Class App Inherits Application
Const kEditClear = "&Löschen"
Const kFileQuit = "Beenden"
Const kFileQuitShortcut = ""
End Class
Class Window1 Inherits Window
Control Tab Inherits TabPanel
ControlInstance Tab Inherits TabPanel
End Control
Control FileLocation Inherits TextField
ControlInstance FileLocation Inherits TextField
End Control
Control StaticText1 Inherits Label
ControlInstance StaticText1 Inherits Label
End Control
Control FileTarget Inherits TextField
ControlInstance FileTarget Inherits TextField
End Control
Control StaticText2 Inherits Label
ControlInstance StaticText2 Inherits Label
End Control
Control FileDirectory Inherits TextField
ControlInstance FileDirectory Inherits TextField
End Control
Control StaticText3 Inherits Label
ControlInstance StaticText3 Inherits Label
End Control
Control FileArguments Inherits TextField
ControlInstance FileArguments Inherits TextField
End Control
Control StaticText4 Inherits Label
ControlInstance StaticText4 Inherits Label
End Control
Control FileIcon Inherits TextField
ControlInstance FileIcon Inherits TextField
EventHandler Sub TextChange() FileIconTimer.Mode=1 End EventHandler
End Control
Control StaticText5 Inherits Label
ControlInstance StaticText5 Inherits Label
End Control
Control FileIconID Inherits TextField
ControlInstance FileIconID Inherits TextField
EventHandler Sub TextChange() FileIconTimer.Mode=1 End EventHandler
End Control
Control StaticText6 Inherits Label
ControlInstance StaticText6 Inherits Label
End Control
Control PopupFile Inherits PopupMenu
ControlInstance PopupFile Inherits PopupMenu
End Control
Control StaticText7 Inherits Label
ControlInstance StaticText7 Inherits Label
End Control
Control StaticText8 Inherits Label
ControlInstance StaticText8 Inherits Label
End Control
Control LinkURL Inherits TextField
ControlInstance LinkURL Inherits TextField
End Control
Control StaticText9 Inherits Label
ControlInstance StaticText9 Inherits Label
End Control
Control LinkDirectory Inherits TextField
ControlInstance LinkDirectory Inherits TextField
End Control
Control StaticText10 Inherits Label
ControlInstance StaticText10 Inherits Label
End Control
Control LinkIcon Inherits TextField
ControlInstance LinkIcon Inherits TextField
EventHandler Sub TextChange() LinkIconTimer.Mode=1 End EventHandler
End Control
Control StaticText12 Inherits Label
ControlInstance StaticText12 Inherits Label
End Control
Control LinkIconID Inherits TextField
ControlInstance LinkIconID Inherits TextField
EventHandler Sub TextChange() LinkIconTimer.Mode=1 End EventHandler
End Control
Control StaticText13 Inherits Label
ControlInstance StaticText13 Inherits Label
End Control
Control PopupLink Inherits PopupMenu
ControlInstance PopupLink Inherits PopupMenu
End Control
Control StaticText14 Inherits Label
ControlInstance StaticText14 Inherits Label
End Control
Control LinkLocation Inherits TextField
ControlInstance LinkLocation Inherits TextField
End Control
Control BevelButton1 Inherits BevelButton
ControlInstance BevelButton1 Inherits BevelButton
EventHandler Sub Action() dim f as FolderItem = GetSaveFolderItem(MyFileTypes.link, "test.lnk") if f<>Nil then FileLocation.Text = f.NativePath end if End EventHandler
End Control
Control BevelButton2 Inherits BevelButton
ControlInstance BevelButton2 Inherits BevelButton
EventHandler Sub Action() dim f as FolderItem = GetOpenFolderItem(MyFileTypes.exe) if f<>Nil then FileTarget.Text = f.NativePath end if End EventHandler
End Control
Control BevelButton3 Inherits BevelButton
ControlInstance BevelButton3 Inherits BevelButton
EventHandler Sub Action() dim f as FolderItem = SelectFolder if f<>Nil then FileDirectory.Text = f.NativePath end if End EventHandler
End Control
Control BevelButton4 Inherits BevelButton
ControlInstance BevelButton4 Inherits BevelButton
EventHandler Sub Action() dim f as FolderItem = GetOpenFolderItem(MyFileTypes.Any+MyFileTypes.icon+MyFileTypes.exe+MyFileTypes.dll) if f<>Nil then FileIcon.Text = f.NativePath end if End EventHandler
End Control
Control BevelButton5 Inherits BevelButton
ControlInstance BevelButton5 Inherits BevelButton
EventHandler Sub Action() dim f as FolderItem = GetSaveFolderItem(MyFileTypes.url, "test.url") if f<>Nil then FileLocation.Text = f.NativePath end if End EventHandler
End Control
Control BevelButton7 Inherits BevelButton
ControlInstance BevelButton7 Inherits BevelButton
EventHandler Sub Action() dim f as FolderItem = SelectFolder if f<>Nil then LinkDirectory.Text = f.NativePath end if End EventHandler
End Control
Control BevelButton8 Inherits BevelButton
ControlInstance BevelButton8 Inherits BevelButton
EventHandler Sub Action() dim f as FolderItem = GetOpenFolderItem(MyFileTypes.Any+MyFileTypes.icon+MyFileTypes.exe+MyFileTypes.dll) if f<>Nil then LinkIcon.Text = f.NativePath end if End EventHandler
End Control
Control Canvas1 Inherits Canvas
ControlInstance Canvas1 Inherits Canvas
End Control
Control Canvas2 Inherits Canvas
ControlInstance Canvas2 Inherits Canvas
End Control
Control BevelButton9 Inherits BevelButton
ControlInstance BevelButton9 Inherits BevelButton
EventHandler Sub Action() dim w as WindowsShortCutMBS w=new WindowsShortCutMBS w.Arguments=FileArguments.Text w.Command=PopupFile.ListIndex w.Icon=FileIcon.Text w.iconID=val(FileIconID.text) w.Location=FileLocation.text w.Target=FileTarget.text w.WorkingDirectory=FileDirectory.text if w.CreateShortCut then msgBox "Shortcut created." else msgBox "Failed to create shortcut." end if End EventHandler
End Control
Control BevelButton10 Inherits BevelButton
ControlInstance BevelButton10 Inherits BevelButton
EventHandler Sub Action() dim w as WindowsInternetShortcutMBS w=new WindowsInternetShortcutMBS w.Command=PopupLink.ListIndex w.Icon=LinkIcon.text w.iconID=val(LinkIconID.Text) w.Location=LinkLocation.text w.URL=LinkURL.Text w.WorkingDirectory=LinkDirectory.text if w.Createinternetshortcut then msgBox "Internet Shortcut created." else msgBox "Failed to create internet shortcut." end if End EventHandler
End Control
Control LinkIconTimer Inherits Timer
ControlInstance LinkIconTimer Inherits Timer
EventHandler Sub Action() ShowFileIcon Canvas2, LinkIcon.text, val(LinkIconID.text) End EventHandler
End Control
Control FileIconTimer Inherits Timer
ControlInstance FileIconTimer Inherits Timer
EventHandler Sub Action() ShowFileIcon Canvas1, FileIcon.text, val(FileIconID.text) End EventHandler
End Control
EventHandler Sub Open() dim f as FolderItem f = SpecialFolder.Desktop.Child("testfile.lnk") FileLocation.Text = f.NativePath f = SpecialFolder.Desktop.Child("testlink.url") LinkLocation.Text = f.NativePath f = SpecialFolder.Desktop FileDirectory.Text = f.NativePath f = SpecialFolder.Desktop LinkDirectory.Text = f.NativePath f = SpecialFolder.Windows.Child("explorer.exe") FileTarget.Text = f.NativePath FileIcon.Text = f.NativePath FileIconID.Text = "0" LinkIcon.Text = f.NativePath LinkIconID.Text = "0" Exception End EventHandler
Sub ShowFileIcon(c as canvas, path as string, id as integer) dim p as Picture = new Picture(c.Width, c.Height, 32) dim f as FolderItem = GetFolderItem(path, FolderItem.PathTypeAbsolute) if f<>Nil then dim w as integer = min(c.Width, c.Height) call p.Graphics.DrawWindowsIconMBS(f, id, 0, 0, w, w) end if c.backdrop = p Exception End Sub
End Class
MenuBar MenuBar1
MenuItem FileMenu = "&Ablage"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Bearbeiten"
MenuItem EditUndo = "&Rückgängig"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "&Ausschneiden"
MenuItem EditCopy = "&Kopieren"
MenuItem EditPaste = "&Einfügen"
MenuItem EditClear = "#App.kEditClear"
MenuItem UntitledMenu0 = "-"
MenuItem EditSelectAll = "&Alles auswählen"
End MenuBar
MyFileTypes
Filetype application
Filetype link
Filetype icon
Filetype dll
Filetype special/any
Filetype url
End MyFileTypes
End Project

See also:

The items on this page are in the following plugins: MBS Win Plugin.


The biggest plugin in space...