Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Membre émérite
    [VCL][RIO]Créer des éléments dans le menu démarrer de Windows
    Bonjour à tous

    Je suis sûr qu'il existe quelque chose pour faire ça dans la JCL mais je ne trouve pas le bon fichier de code.
    Quelqu'un saurait où ça se trouve ?
    J'ai téléchargé la dernière version mais quand j'essaie d'afficher l'aide je ramasse des erreurs de fichiers introuvables.

  2. ###raw>post.musername###
    Membre à l'essai
    Bonsoir,

    Trouvé surSwissDelphiCenter (est-ce que je peux le citer?) : https://www.swissdelphicenter.ch/en/...ode.php?id=317

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    uses
      Registry,
      ActiveX,
      ComObj,
      ShlObj;
     
    type
      ShortcutType = (_DESKTOP, _QUICKLAUNCH, _SENDTO, _STARTMENU, _OTHERFOLDER);
     
    function CreateShortcut(SourceFileName: string; // the file the shortcut points to
                            Location: ShortcutType; // shortcut location
                            SubFolder,  // subfolder of location
                            WorkingDir, // working directory property of the shortcut
                            Parameters,
                            Description: string): //  description property of the shortcut
                            string;
    const
      SHELL_FOLDERS_ROOT = 'Software\MicroSoft\Windows\CurrentVersion\Explorer';
      QUICK_LAUNCH_ROOT = 'Software\MicroSoft\Windows\CurrentVersion\GrpConv';
    var
      MyObject: IUnknown;
      MySLink: IShellLink;
      MyPFile: IPersistFile;
      Directory, LinkName: string;
      WFileName: WideString;
      Reg: TRegIniFile;
    begin
     
      MyObject := CreateComObject(CLSID_ShellLink);
      MySLink := MyObject as IShellLink;
      MyPFile := MyObject as IPersistFile;
     
      MySLink.SetPath(PChar(SourceFileName));
      MySLink.SetArguments(PChar(Parameters));
      MySLink.SetDescription(PChar(Description));
     
      LinkName := ChangeFileExt(SourceFileName, '.lnk');
      LinkName := ExtractFileName(LinkName);
     
      // Quicklauch
      if Location = _QUICKLAUNCH then
      begin
        Reg := TRegIniFile.Create(QUICK_LAUNCH_ROOT);
        try
          Directory := Reg.ReadString('MapGroups', 'Quick Launch', '');
        finally
          Reg.Free;
        end;
      end
      else
      // Other locations
      begin
        Reg := TRegIniFile.Create(SHELL_FOLDERS_ROOT);
        try
        case Location of
          _OTHERFOLDER : Directory := SubFolder;
          _DESKTOP     : Directory := Reg.ReadString('Shell Folders', 'Desktop', '');
          _STARTMENU   : Directory := Reg.ReadString('Shell Folders', 'Start Menu', '');
          _SENDTO      : Directory := Reg.ReadString('Shell Folders', 'SendTo', '');
        end;
        finally
          Reg.Free;
        end;
      end;
     
      if Directory <> '' then
      begin
        if (SubFolder <> '') and (Location <> _OTHERFOLDER) then
          WFileName := Directory + '\' + SubFolder + '\' + LinkName
        else
          WFileName := Directory + '\' + LinkName;
     
     
        if WorkingDir = '' then
          MySLink.SetWorkingDirectory(PChar(ExtractFilePath(SourceFileName)))
        else
          MySLink.SetWorkingDirectory(PChar(WorkingDir));
     
        MyPFile.Save(PWChar(WFileName), False);
        Result := WFileName;
      end;
    end;
     
    function GetProgramDir: string;
    var
      reg: TRegistry;
    begin
      reg := TRegistry.Create;
      try
        reg.RootKey := HKEY_CURRENT_USER;
        reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders', False);
        Result := reg.ReadString('Programs');
        reg.CloseKey;
      finally
        reg.Free;
      end;
    end;
     
    // Some examples:
     
    procedure TForm1.Button1Click(Sender: TObject);
    const
     PROGR = 'c:\YourProgram.exe';
    var
      resPath: string;
    begin
      //Create a Shortcut in the Quckick launch toolbar
      CreateShortcut(PROGR, _QUICKLAUNCH, '','','','Description');
     
      //Create a Shortcut on the Desktop
      CreateShortcut(PROGR, _DESKTOP, '','','','Description');
     
      //Create a Shortcut in the Startmenu /"Programs"-Folder
      resPath := CreateShortcut(PROGR, _OTHERFOLDER, GetProgramDir,'','','Description');
      if resPath <> '' then
      begin
        ShowMessage('Shortcut Successfully created in: ' + resPath);
      end;
    end;
    Je ne sais pas si cela marche avec les dernières versions de Windows ni si ça t'aidera.

    Bonne soirée,
    Seb.
      0  0

  3. #3
    Membre émérite
    Je vais tester ça.
    Merci

    Et bienvenue au nouvel inscrit !