Projekt mit anderer StartForm starten, Ergänzung mit individuellem Icon Im Tipp wird gezeigt, wie man beim Starten eines Projekts mit einer speziellen Startform auch ein individuelles Icon benutzen kann.
Autor:   Dietrich Herrmann	Bewertung:     [ Jetzt bewerten ]	Views:  4.209
ohne Homepage	System:  Win7, Win8, Win10, Win11	kein Beispielprojekt

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 6 Bewertung insgesamt: sehr gut Durchschnittliche Bewertung: 4.5 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Dieser Tipp basiert auf meinem Tipp  Projekt mit anderer StartForm starten". Da wird so vorgegangen, dass beim Starten des Programms mittels Angabe in einem Startparameter (CommandLine) verschiedene Startformen eines Projekts benutzt werden können. Dabei wird davon ausgegangen, dass für jede Benutzung mit einer anderen Startform auch eine entsprechende Verknüpfung erzeugt und verwendet wird. Diese Erweiterung des Tipps geht von dieser Grundlage aus, ist aber ergänzt um die Besonderheit, dass für jede Verknüpfung auch ein spezifisches Icon angezeigt wird.

Das Projekt muss dazu so eingestellt sein, dass das "Anwendungsframework aktivieren" NICHT eingestellt ist. Dann kann das Projekt mit einer SUB Main gestartet werden. Mein erweiterter Code der Sub Main sieht so aus:

''' <summary>
''' Start - SubMain
''' </summary>
Public Class Start
 
  <STAThread()>
  Public Shared Sub Main(ByVal args As String())
    Application.EnableVisualStyles()
    Application.SetCompatibleTextRenderingDefault(False)
 
    Dim deskTopPath As String = Environment.GetFolderPath(Environment.SpecialFolder.Desktop)
    Dim p As String = Application.StartupPath
 
    Dim aField() As String = {"/strtFrm=", "/lnkIcon="}
    Dim fField() As Form = {Form1, Form2, Form3, Form4, Form5,
      Form6, frmUnicodes, Form7, Form8, Form9, Form10,
      Form11, Form12, frmSetSettings}
    Dim fnField() As String = {Form1.Name, Form2.Name, Form3.Name, Form4.Name,
      Form5.Name, Form6.Name, frmUnicodes.Name, Form7.Name, Form8.Name, Form9.Name,
      Form10.Name, Form11.Name, Form12.Name, frmSetSettings.Name}
 
    Dim lnkField() As String = {"", "", "", "", "", "",
      "", "", "", "", "", "dhTest - Emoji", "dhTest - WEB", "dhTest - SetSettings"}
    Dim icoField() As String = {"", "", "", "", "", "",
      "", "", "", "", "", "grinning-face_1f600.ico", "agt_web.ico", "preferences_system.ico"}
 
    Dim idx As Short, sp(), nl, ni, lnkDir As String
    Dim startFlag As Boolean = False, nf As New Form
 
    ' Startparameter einstellen
    Dim clFeld As Array = ParseCommandLineArgs(aField)
    For i As Short = 0 To clFeld.Length - 1
      sp = Split(clFeld(i), "=")
      Select Case sp(0)
 
        Case "/strtFrm"   ' Startform einstellen
          idx = fnField.IndexOf(fnField, sp(1))
          nf = fField(idx)
          If icoField(idx) <> "" Then _
            nf.Icon = New Icon(p + "" + icoField(idx))  ' ist Icon-File angegeben?
 
        Case "/lnkIcon"   ' zugehöriges Icon einstellen
          startFlag = True
          ni = sp(1) + ".ico"  ' Icon-File wählen
          p = PathOnly(ni)     ' ist Pfad angegeben im Startparameter
          If p <> "" Then _
            ni = Replace(Replace(ni, p, ""), "", "")
      End Select
    Next
 
    ' Icon der Verknüpfung einstellen
    Try
      nl = "" + lnkField(idx) + ".lnk"         ' Name der Verknüpfung
      If Not startFlag Then ni = icoField(idx) ' Name des Icons
      If ni <> "" Then
        ni = "" + ni
        If IsShortcut(deskTopPath + nl) Then   ' gibt es eine Verknüpfung?
          lnkDir = ReadLnk(deskTopPath + nl, , "Icon") ' Verknüpfungsdaten lesen
          sp = Split(lnkDir, ",")
          ' Debug.Print(sp(0))
          If sp(0) <> p + ni Then _
            ChangeShortCutIcon(deskTopPath + nl, p + ni) ' ändern des Verknüpfungs-Icon
        End If
      End If
    Catch ex As Exception
    End Try
 
    Application.Run(nf)  ' starten der Application
  End Sub
End Class

Die Variablen aFied, fField und fnField sind im Vorgängertipp erklärt.

Der Code ist um folgende spezielle Variablen ergänzt:

• lnkField: das Feld enthält die Namen der Verknüpfungen je Startform (der Verknüpfungsname ist genau der Text, der unter dem Verknüpfungsicon steht). Er muss in diesem Feld genau so angegeben werden, wie er dann bei der Verknüpfung auf dem Desktop geschrieben steht.
   
• icoField enthält die Namen der Icon-Files, die je Startform verwendet werden sollen. Die Files speicher ich im Folder Application.StartupPath (andere Lösungen sind möglich, bspw. Ressource).

Das individuelle Icon wird nur in eine vorhandene Verknüpfung gespeichert und dann auch nur, wenn die existierende Verknüpfung ein andres Icon besitzt als im Icon-Namenfeld angegeben! Ich verwende vorzugsweise Icons der Größe 32x32.

Für die Anwendung des Tipps ist die Funktion ParseCommandLineArgs notwendig (siehe Vorgängertipp).
Außerdem wird benötigt das Modul dhmodShortCut:

Imports System.IO
Imports System.Runtime.InteropServices
Imports IWshRuntimeLibrary
 
Module dhmodShortCut
 
  Public Const SHCNE_ASSOCCHANGED As Integer = &H8000000
  Public Const SHCNF_IDLIST = 0
 
  'Notify the shell of a change
  <DllImport("Shell32.dll")>
  Public Sub SHChangeNotify(wEventId As Integer, uFlags As Integer,
    dwItem1 As IntPtr, dwItem2 As IntPtr)
  End Sub
 
  <DllImport("Shell32.dll", EntryPoint:="#660")>
  Public Function FileIconInit(<MarshalAs(UnmanagedType.Bool)> ByVal fRestoreCache As Boolean) _
  As <MarshalAs(UnmanagedType.Bool)> Boolean
  End Function
 
  ' SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, IntPtr.Zero, IntPtr.Zero)

  ''' <summary>
  '''    Erstellung ShortCut (Verknüpfung)
  ''' </summary>
  ''' <param name="folder">der Ordner, in dem die Verknüpfung erstellt wird</param>
  ''' <param name="name">der Name der Verknüpfung, der angezeigt wird</param>
  ''' <param name="target">die Application, die von der Verknüpfung ausgeführt wird</param>
  ''' <param name="description">eine Beschreibung (Tooltip) der Verknüpfung</param>
  ''' <param name="arguments">Befehlszeilenargumente für die Verknüpfung</param>
  ''' <param name="iconPath">der Pfad zum Icon der Verknüpfung</param>
  ''' <param name="workingdir">das Arbeitsverzeichnis der Verknüpfung</param>
  Public Sub CreateShortcut2(folder As String, name As String,
    target As String, description As String,
    arguments As String, iconPath As String,
    workingdir As String)
 
    Dim shortcutFullName As String = Path.Combine(folder, name + ".lnk")
    shortcutFullName = Replace(shortcutFullName, ".EXE", "")
    Try
      Dim shell As New WshShell
      Dim link As WshShortcut = shell.CreateShortcut(shortcutFullName)
      With link
        .Arguments = arguments
        .Description = description
        .IconLocation = iconPath
        .TargetPath = target '+ ".exe"
        .WorkingDirectory = workingdir
        .Save()
      End With
    Catch ex As Exception
      MessageBox.Show(String.Format("Die Verknüpfung ""{0}"" konnte nicht erstellt werden." _
                + vbLf + vbLf + "{1}", shortcutFullName, ex.ToString()),
                "Create Shortcut", MessageBoxButtons.OK, MessageBoxIcon.Information)
    End Try
  End Sub

  ''' <summary>
  '''    Verknüpfungsdaten auslesen
  ''' </summary>
  ''' <param name="filename">der Dateiname der Verknüpfung</param>
  ''' <param name="dbg">Daten im Direktfenster zeigen ja|nein</param>
  ''' <param name="retVal">festlegen des Rückgabewertes</param>
  ''' <remarks></remarks>
  ''' <returns></returns>
  Public Function ReadLnk(filename As String,
    Optional dbg As Boolean = False,
    Optional retVal As String = "") As String
 
    Dim direc As String
    Dim shortCut As IWshShortcut
    shortCut = CType((New WshShell).CreateShortcut(filename), IWshShortcut)
    If dbg Then
      Debug.Print("")
      Debug.Print("Lnk-Datei: " + filename)
      With shortCut
        Debug.Print("Auszuführende Datei: " + .TargetPath)
        Debug.Print("Arbeitsverzeichnis: " + .WorkingDirectory)
        Debug.Print("Beschreibung: " + .Description)
        Debug.Print("Start-Parameter: " + .Arguments)
        Debug.Print("HotKey: " + .Hotkey)
        Debug.Print("Icon: " + .IconLocation)
      End With
    End If
 
    ' Rückgabe der Verknüpfung
    If shortCut.WorkingDirectory = "" Then ' bspw. bei Office-Programmen
      direc = filename
    Else
      direc = shortCut.WorkingDirectory
    End If
 
    Select Case retVal
      Case ""
        Return If(shortCut.WorkingDirectory.Contains("%"), shortCut.TargetPath, direc)
      Case "Target" : Return shortCut.TargetPath
      Case "Working" : Return shortCut.WorkingDirectory
      Case "Descript" : Return shortCut.Description
      Case "Arguments" : Return shortCut.Arguments
      Case "HotKey" : Return shortCut.Hotkey
      Case "Icon" : Return shortCut.IconLocation
    End Select
  End Function

  Public Function IsShortcut(strPath As String) As Boolean
    If Not IO.File.Exists(strPath) Then Return False
 
    Dim directory As String = Path.GetDirectoryName(strPath)
    Dim strFile As String = Path.GetFileName(strPath)
 
    Dim shell As Shell32.Shell = New Shell32.Shell()
    Dim folder As Shell32.Folder = shell.NameSpace(directory)
    Dim folderItem As Shell32.FolderItem = folder.ParseName(strFile)
 
    If folderItem IsNot Nothing Then Return folderItem.IsLink
    Return False
  End Function

  Public Function ResolveShortcut(strPath As String) As String
    If IsShortcut(strPath) Then
      Dim directory As String = Path.GetDirectoryName(strPath)
      Dim strFile As String = Path.GetFileName(strPath)
 
      Dim shell As Shell32.Shell = New Shell32.Shell()
      Dim folder As Shell32.Folder = shell.NameSpace(directory)
      Dim folderItem As Shell32.FolderItem = folder.ParseName(strFile)
 
      Dim link As Shell32.ShellLinkObject = folderItem.GetLink
 
      Return link.Path
    Else
      Return String.Empty
    End If
  End Function

  ''' <summary>
  '''    Extract ShortCut-Icon
  ''' </summary>
  ''' <param name="fileName"></param>
  ''' <param name="art"></param>
  ''' <returns></returns>
  Public Function GetShortCutIcon(fileName As String, Optional art As Short = 1) As Object
    Dim ShortcutIcon As Icon, ShortcutImage As Image
    Dim shortCut As IWshShortcut
    shortCut = CType((New WshShell).CreateShortcut(fileName), IWshShortcut)
    If art = 1 Then
      ShortcutImage =
        Icon.ExtractAssociatedIcon((CType(New WshShell().CreateShortcut(fileName), IWshShortcut)).TargetPath).ToBitmap()
      Return ShortcutImage
    Else
      ShortcutIcon =
        Icon.ExtractAssociatedIcon((CType(New WshShell().CreateShortcut(fileName), IWshShortcut)).TargetPath)
      Return ShortcutIcon
    End If
  End Function

  ''' <summary>
  ''' Change the Icon in .lnk file
  ''' COM reference to 'Microsoft Shell Controls And Automation' needed
  ''' </summary>
  ''' <param name="shortcutFullPath"></param>
  ''' <param name="newIconPath"></param>
  Public Sub ChangeShortCutIcon(shortcutFullPath As String, newIconPath As String,
                      Optional ix As Short = 0)
    ' Load the shortcut
    Dim shell As New Shell32.Shell()
    Dim folder As Shell32.Folder =
      shell.[NameSpace](Path.GetDirectoryName(shortcutFullPath))
    Dim folderItem As Shell32.FolderItem =
      folder.Items().Item(Path.GetFileName(shortcutFullPath))
    Dim currentLink As Shell32.ShellLinkObject =
      DirectCast(folderItem.GetLink, Shell32.ShellLinkObject)
    currentLink.SetIconLocation(newIconPath, ix)
    ' Save the link to commit the changes
    currentLink.Save()
 
    shell = Nothing
    folder = Nothing
    folderItem = Nothing
    currentLink = Nothing
  End Sub

  ''' <summary>
  ''' Change link-target in .lnk file
  ''' COM reference to 'Microsoft Shell Controls And Automation' needed
  ''' </summary>
  ''' <param name="shortcutFullPath"></param>
  ''' <param name="newTarget"></param>
  Public Sub ChangeShortCutTarget(shortcutFullPath As String, newTarget As String)
    ' Load the shortcut
    Dim shell As New Shell32.Shell()
    Dim folder As Shell32.Folder =
      shell.[NameSpace](Path.GetDirectoryName(shortcutFullPath))
    Dim folderItem As Shell32.FolderItem =
      folder.Items().Item(Path.GetFileName(shortcutFullPath))
    Dim currentLink As Shell32.ShellLinkObject =
      DirectCast(folderItem.GetLink, Shell32.ShellLinkObject)
    ' Assign the new path here
    currentLink.Path = newTarget
    ' Save the link to commit the changes
    currentLink.Save()
  End Sub

  ' überprüfen, was sich in der Zwischenablage befindet
  Public Function testClipboard() As String
    Dim cTyp As String
    With My.Computer.Clipboard
      If .ContainsImage Then
        cTyp = "img"
      ElseIf .ContainsAudio Then
        cTyp = "aud"
      ElseIf .ContainsFileDropList Then
        cTyp = "fdl"
      ElseIf .ContainsData("specialFormat") Then
        cTyp = "dat"
      ElseIf .ContainsText Then
        cTyp = "txt"
      Else
        cTyp = "not"
      End If
    End With
    Return cTyp
  End Function

  ' lesen aus der Zwischenablage
  Public Function readClipboard(ByVal cTyp As String) As Object
    Dim obj As Object
    With My.Computer.Clipboard
      Select Case cTyp
        Case "img"
          obj = .GetImage
        Case "aud"
          obj = .GetAudioStream
        Case "fdl"
          obj = .GetFileDropList
        Case "dat"
          obj = .GetData("specialFormat")
        Case "txt"
          obj = .GetText
        Case Else
          obj = Nothing
      End Select
    End With
    Return obj
  End Function
End Module

Und die Funktion PathOnly:

Public Function PathOnly(ByVal mPath As String) As String
  Return Path.GetDirectoryName(mPath)
End Function