Archives décembre 2009

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…