Fonctionnalités du shell avec Lazarus

Lazarus Logo

J’essaye en ce moment de converir un composant Delphi vers Lazarus. Le travail se passe bien mais j’ai quelques difficultés à trouver des équivalent multi-plateforme FPC/Lazarus. Ceci serait fatalement complexe puisques ces fonctions concerne l’integration du shell (comprendre fonction de bas niveau du bureau) et chacun a sa propre approche.

Voici le code classique qui me donne des maux de tête :

//Cette fonction spécifique à Windows devrais être difficile à convertir
//On aurais besoin ici de quelque chose utilisant les types mime, de toute façon
//beaucoup plus de code serais nécéssaire...
procedure GetFileExtensionShellDescription(Ext: string;
var FileTypeName: string; var ShellImageIndex: Integer);
var
  I, J: Integer;
  T: string;
  L: TImageList;
  sFI: TSHFileInfo; //Spécifique à Windows mais un autre type pourrais être équivalent
  Icon: TIcon;
  PCh: PChar;
  P: PFileDescriptionRecord;

begin
  FileTypeName := '';
  I := RegisteredExtensions.IndexOf(Ext); //un TStringList défini en variable globale
  if I = -1 then
  begin
    New(P);
    P^.FileType := '';
    Icon := TIcon.Create;
    for J := 0 to 1 do
    begin
      if J = 0 then
        L := ShellSmallImageList
      else
        L := ShellLargeImageList; //les deux sont des TImageList
      GetMem(PCh, MAX_PATH);
      GetTempPath(MAX_PATH, PCh); //ces lignes peuvent être remplacés
      T := PCh + 'TEMP' + Ext;     //par GetTempDir dans FileUtil
      FreeMem(PCh);
      TFileStream.Create(T, fmCreate or fmOpenWrite).Destroy;
      //ce qui suit est le plus gros problème... Impossible de trouver un
      //équivalent avec Lazarus. Des idées ? Les types Mime et l'implémentation
      //FreeDesktop devraient fournir ceci...
      if SHGetFileInfo(PChar(T), 0, sFI, SizeOf(sFI),
        SHGFI_TYPENAME or SHGFI_ICON or
        (SHGFI_SMALLICON * (1 - J) + J * SHGFI_LARGEICON)) <> 0 then
      begin
        Icon.ReleaseHandle;
        Icon.Handle := sFI.hIcon;
        P^.FileType := sFI.szTypeName;
      end;
      P^.OpenImageIndex := L.AddIcon(I);
      P^.CloseImageIndex := P^.OpenImageIndex;
      if J = 1 then
        I := RegisteredExtensions.AddObject(Ext, TObject(P));
    end;
    Icon.Destroy;
  end;
  with PFileDescriptionRecord(RegisteredExtensions.Objects[I])^ do
  begin
    ShellImageIndex := CloseImageIndex;
    FileTypeName := FileType;
  end;
end;

Le problème a l’air simple, nous avons juste besoin de retrouver les icones du système pour chaques extentions de fichiers mais rien n’est actuellement disponible dans Lazarus pour le faire simplement. Je sais que FreeDesktop fourni un interface commun pour tout les environnements de burreau modernes sous Linux, autorisant ce genre de fonctionnalités, de telle sorte que baucoup de logiciels n’utilisant pas la même API peuvent le faire (ex. des applications Gnome lancées sous KDE qui utilisent les thèmes de KDE). Y a-t-il un moyen d’envisager une telle implementation qui est la base de l’intégration du burreau ? Ceci devrais être une excellente valeur ajoutée à Lazarus…

Partagez éthiquement

5 thoughts on “Fonctionnalités du shell avec Lazarus”

  1. Once I have more information, yes, I will continue it. But, curently, this problem is looking for a developper to implement those missing functionnalities. As Mattias (one of the main Lazarus developper) said, this should become part of Lazarus-cc (stand for component collection) and not LCL.

    As we discuss of this with Lazarus develloper LCL must be totally multiplatform and there’s too many differencies between desktop implementation to warranty it. Nevertheless, Lazarus team is very active and once a basic multiplatform implementation will be done (for exemple, working on two platform like Linux with Freedesktop specifications and Windows with VCL inspiration), the other platforms will be quickly implemented by other devellopers.

    To be honest what is needed right know is someone to do it. If you have the competances, you’re more than welcome of course! 😉

Laisser un commentaire

Votre adresse e-mail ne sera pas publiée. Les champs obligatoires sont indiqués avec *