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

Composants FMX Delphi Discussion :

Récupérer les icones discussion initiée par Selzig


Sujet :

Composants FMX Delphi

  1. #1
    Rédacteur/Modérateur

    Récupérer les icones discussion initiée par Selzig
    Bonjour Gilles
    Citation Envoyé par Selzig Voir le message

    S'il y a quelqu'un qui sait faire cela nativement en FMX (sans imbriquer évidemment d'units VCL) ?
    Regarde de ce côté FMX.winbitmaps
    je n'ai pas testé mais cela semble correspondre à ta demande
    La seule chose absolue dans un monde comme le nôtre, c'est l'humour. » Albert Einstein

    Delphi installés : D3,D7,D2010,XE4,XE7,D10 (Tokyo, Rio) et peut être quelques autres
    SGBD : Firebird 2.5, 3, SQLite
    générateurs Etats : FastReport, Rave, QuickReport
    OS : Window Vista, Windows 10, Ubuntu, Androïd

  2. #2
    Membre régulier
    Bonjour Serge,

    merci pour ta recherche. Je ne sais toujours pas comment tu trouves tous ces articles !
    Extrait du code du zip :
    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
    unit FreeImageLoader;
    
    //* Uncomment the following line (remove the dot ".") to build with Graphics32
    {.$DEFINE USEGR32}
    
    interface
    
    Uses
        Windows,
        Messages,
        SysUtils,
        Classes,
        VCL.Graphics,
        {$IFDEF USEGR32}
        GR32,
        GR32_Backends,
        {$ENDIF}
        //Helper3delite,
        //Dialogs,
        FreeImage;


    Dans ce cas-là, autant exploiter une librairie Lazarus ou LCL... question simplicité. Mes icônes sont transformées en stream pour être enregistrées dans une base. Donc, si le Timage de FMX arrive à gérer la transparence comme celui de VCL, il y a espoir. Mais quand même... encore une approche non gérée directement par FMX puisqu'il fait appel à VCL.

    Encore merci. Gilles
    Windows, Linux, mac OS X ► Qt - FMX - Lazarus || Androïd, iOS ►FMX - Qt - Windev Mobile - Autres

  3. #3
    Rédacteur/Modérateur

    @Selzig : Récupérer les icones
    Je détoure ici un post de Selzig pour ouvrir une nouvelle discussion sinon Hors Sujet
    Citation Envoyé par Selzig Voir le message

    S'il y a quelqu'un qui sait faire cela nativement en FMX (sans imbriquer évidemment d'units VCL) ?
    Je veux bien croire que FMX sait tout faire mais, en supposant qu'il réponde à mon problème, je découvre cela où ?
    Cordialement. Gilles
    La seule chose absolue dans un monde comme le nôtre, c'est l'humour. » Albert Einstein

    Delphi installés : D3,D7,D2010,XE4,XE7,D10 (Tokyo, Rio) et peut être quelques autres
    SGBD : Firebird 2.5, 3, SQLite
    générateurs Etats : FastReport, Rave, QuickReport
    OS : Window Vista, Windows 10, Ubuntu, Androïd

  4. #4
    Rédacteur/Modérateur

    Citation Envoyé par Selzig Voir le message
    Je ne sais toujours pas comment tu trouves tous ces articles !
    Je suis curieux et j'utilise à fond les moteurs de recherches, l'astuce est dans les mots clés

    Je suis même allé un peu plus loin et ce sans VCL.
    J'ai fouillé dans les sources (répertoire source/rtl/win) tout ce qui concernait HIcon, ExtractIcon, etc.
    Voilà mon second secret

    J'en ai déduit un premier truc, malheureusement ce n'est pas encore ça
    Comme il s'agit de GDI ou plus exactement GDIPlus comme tu as écrit que tu y arrivais avec Lazarus tu devrais y arriver sinon je sais que Gilles Vasseur (gvasseur58) qui sévit sur le forum Lazarus se débrouille plutôt bien avec GDI

    Puisqu'il s'agit de RTL ce n'est absolument pas lié à FMX (à windows par contre puisqu'il s'agit d'API, pour le porter sur Androïd il faudrait certainement passer par des JNI mais je m'écarte)


    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
    interface
    
    uses
      System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
      FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
      FMX.Edit, FMX.Controls.Presentation, FMX.ImgList,FMX.PlatForm.Win,
      Winapi.Windows, Winapi.ShellApi, WinApi.GDIPObj;
    
    type
      TMainForm = class(TForm)
        ExeName: TEdit;
        EllipsesEditButton1: TEllipsesEditButton;
        OpenDialog1: TOpenDialog;
        ImageControl1: TImageControl;
        procedure EllipsesEditButton1Click(Sender: TObject);
      private
        { Déclarations privées }
      public
        { Déclarations publiques }
      end;
    
    var
      MainForm: TMainForm;
    
    implementation
    
    {$R *.fmx}
    
    procedure TMainForm.EllipsesEditButton1Click(Sender: TObject);
    var Icon : HIcon;
        AGDIBitmap : TGPBitmap;
    begin
    if OpenDialog1.Execute then
     begin
       ExeName.Text:=OpenDialog1.FileName;
       Icon:=ExtractIcon(hInstance,Pchar(opendialog1.FileName),0); // j'ai bien quelque chose mais est-ce bon ? je doute de hInstance
       AGDIBitmap.Create(Icon); // Plante ici 
       try
         AGDIBitMap.Save('test.ico',TGuid.Empty,nil); // je doute pour le TGUID et le second paramètre
         ImageControl1.Bitmap.LoadFromFile('test.ico');
       finally
         aGDIBitmap.Free;
       end;
     end;
    end;
    La seule chose absolue dans un monde comme le nôtre, c'est l'humour. » Albert Einstein

    Delphi installés : D3,D7,D2010,XE4,XE7,D10 (Tokyo, Rio) et peut être quelques autres
    SGBD : Firebird 2.5, 3, SQLite
    générateurs Etats : FastReport, Rave, QuickReport
    OS : Window Vista, Windows 10, Ubuntu, Androïd

  5. #5
    Rédacteur/Modérateur

    Bonjour,

    Utiliser les unités VCL.Graphics et VCL.Extctrls, j'ai voulu en avoir le cœur net, je comprends que cela choque d'utiliser des unités VCL (je parle bien d'unités, pas de Dll) alors que l'on est en FMX .
    Avec beaucoup de "précautions" rien n'empêche de faire une unité (FMX.Graphics.VCL) à partir de celles-ci en élaguant l'inutile

    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
     
    {$IFDEF MSWINDOWS}
    uses  Vcl.Graphics, vcl.ExtCtrls;
    {$ENDIF}
     
    {$IFDEF MSWINDOWS}
    procedure TMainForm.EllipsesEditButton1Click(Sender: TObject);
    var
      img : VCL.Extctrls.TImage;
      icoHandle: HIcon;
      InfoData : SHFILEINFO;
      aStream : TMemoryStream;
    begin
    if OpenDialog1.Execute then
     begin
      ExeName.Text:=Opendialog1.FileName;
      img:=VCL.Extctrls.TImage.Create(self);
      aStream : TMemoryStream.Create;
      try
       SHGetFileInfo(PChar(OpenDialog1.FileName), 0, InfoData, SizeOf(InfoData), SHGFI_ICON);
       Img.Picture.Icon.Handle := InfoData.hIcon;
    //   Img.Picture.SaveToFile('temp.ico');
    //   Image1.Bitmap.LoadFromFile('temp.ico');
       img.Picture.SaveToStream(aStream);
       aStream.Position:=0;
       image1.Bitmap.LoadFromStream(aStream);
      finally
       aStream.Free;
       img.free;
      end;
     end;
    end;
    {$ENDIF}

    Cela fonctionne et est accepté malgré de nombreux messages d'attention à la compilation
    [dcc32 Conseil] H2161 Warning: Duplicate resource: Type 12 (CURSOR GROUP), ID 32762; File d:\embarcadero\studio\20.0\lib\Win32\release\controls.res resource kept; file d:\embarcadero\studio\20.0\lib\Win32\release\FMX.Controls.Win.res resource discarded.
    Chose que j'avais déjà rencontré lors de l'écriture de mon tutoriel sur la création d'un composant dual VCL/FMX

    Bien sûr, cette approche est uniquement pour une cible Windows API obligent

    pour Androïd, selon ce que j'ai compris mais pas testé, il faut récupérer un fichier se trouvant dans le dossier /res/drawable_xxx (où xxx dépend de la résolution ?)
    La seule chose absolue dans un monde comme le nôtre, c'est l'humour. » Albert Einstein

    Delphi installés : D3,D7,D2010,XE4,XE7,D10 (Tokyo, Rio) et peut être quelques autres
    SGBD : Firebird 2.5, 3, SQLite
    générateurs Etats : FastReport, Rave, QuickReport
    OS : Window Vista, Windows 10, Ubuntu, Androïd

  6. #6
    Rédacteur/Modérateur

    Bonjour,

    Ce matin je suis reparti sur GDI+ pour ne pas avoir à utiliser ces VCL

    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
     
     uses  Winapi.ShellApi, winapi.GDIPAPi ,winapi.GDIPobj, winapi.GDIPUtil;
     
    procedure TMainForm.EllipsesEditButton1Click(Sender: TObject);
    var
      InfoData : SHFILEINFO;
      GdiBitmap : TGPBitmap;
      Codec :  TGUID;
      aStream : TMemoryStream;
     
     procedure transparence(ABitmap : TBitmap);
     var bitData1 : FMX.Graphics.TBitmapData;  // Tbitmapdata est aussi défini dans GDI il faut donc être explicite
         ColorAlpha : TAlphaColor;                    // couleur qui va être transformée pos (0,0) 
         i,j : integer;
     begin
      if (ABitmap.Map(TMapAccess.ReadWrite, bitData1)) then
        try
          ColorAlpha:=bitData1.GetPixel(0,0);
          for I := 0 to ABitmap.Width - 1 do
            for J := 0 to ABitmap.Height - 1 do
            begin
              if bitData1.GetPixel(i,j)=ColorAlpha then
                bitData1.SetPixel(i,j,TalphaColors.Null);
            end;
        finally
          ABitmap.Unmap(bitData1);
        end;
      end;
     
    begin
    if OpenDialog1.Execute then
     begin
       ExeName.Text:=Opendialog1.FileName;
       SHGetFileInfo(PChar(OpenDialog1.FileName), 0, InfoData, SizeOf(InfoData), SHGFI_ICON);
       gdiBitmap:=TGPBitmap.Create(infodata.hIcon);
       GetEncoderClsid('image/png', codec);  // retrouve le TGUID pour png
       gdiBitmap.Save('test1.png',Codec,nil);  // sauvegarde dans un fichier
       image1.Bitmap.LoadFromFile('test1.png');
       Transparence(Image1.Bitmap);
     end;
    end;

    Si j'ai assez rapidement trouvé comment récupérer l'icône, sauvegarder ce dernier a été plus délicat : il me fallait trouver un TGUID (GetEncoderCLSId).
    Ensuite une sauvegarde dans un fichier ne m'a plus posé de soucis, malheureusement je n'ai pas trouvé moyen d'indiquer la transparence.
    Pour appliquer la transparence j'ai du passé par une procédure (à transformer en fonction)

    La suite :
    • ne pas passer par un fichier mais un stream, seulement GDI+ utilise un IStream
    • éviter cette fonction de transparence si possible.
    La seule chose absolue dans un monde comme le nôtre, c'est l'humour. » Albert Einstein

    Delphi installés : D3,D7,D2010,XE4,XE7,D10 (Tokyo, Rio) et peut être quelques autres
    SGBD : Firebird 2.5, 3, SQLite
    générateurs Etats : FastReport, Rave, QuickReport
    OS : Window Vista, Windows 10, Ubuntu, Androïd

  7. #7
    Expert éminent sénior
    IStream c'est facile à gérer
    TStreamAdapter est un IStream, il se libère tout seul via le compteur de référence

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    var
      Stream: TMemoryStream;
    begin
    ...
        // On crée un flux
        Stream := TMemoryStream.Create();
        try
          gdiBitmap.Save(TStreamAdapter.Create(Stream),Codec,nil);  // sauvegarde dans un stream
          Stream.Seek(soBeginning, 0); // on ne sait jamais !
          image1.Bitmap.LoadFromStream(Stream); // Attention l'extension du fichier, ça fait pas des trucs comme en VCL, ça dépendra en Windows de ce que supporte IWICStream et TBitmapCodecWIC
       finally
         Stream.Free();
       end;
    Aide via F1 - FAQ - Guide du développeur Delphi devant un problème - Pensez-y !
    Attention Troll Méchant !
    "Quand un homme a faim, mieux vaut lui apprendre à pêcher que de lui donner un poisson" Confucius
    Mieux vaut se taire et paraître idiot, Que l'ouvrir et de le confirmer !
    L'ignorance n'excuse pas la médiocrité !

    L'expérience, c'est le nom que chacun donne à ses erreurs. (Oscar Wilde)
    Il faut avoir le courage de se tromper et d'apprendre de ses erreurs

  8. #8
    Rédacteur/Modérateur

    Merci Shai
    Effectivement c'est facile, plus que je ne le pensais

    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
    {$IFDEF MSWINDOWS}
     uses  Winapi.ShellApi, winapi.GDIPAPi ,winapi.GDIPobj, winapi.GDIPUtil;
    {$ENDIF}
     
    procedure TMainForm.EllipsesEditButton1Click(Sender: TObject);
    var
      InfoData : SHFILEINFO;
      GdiBitmap : TGPBitmap;
      Codec :  TGUID;
      aStream : TMemoryStream;
     
     
     function RendreTransparent(aStream : TMemoryStream ) : TBitmap;
     var bitData1 : FMX.Graphics.TBitmapData;
         Color2Alpha : TAlphaColor;
         i,j : integer;
     begin
      Result:=TBitmap.Create;
      aStream.Position:=0;
      Result.LoadFromStream(aStream);
      if (result.Map(TMapAccess.ReadWrite, bitData1)) then
        try
          Color2Alpha:=bitData1.GetPixel(0,0);
          for I := 0 to Result.Width - 1 do
            for J := 0 to Result.Height - 1 do
            begin
              if bitData1.GetPixel(i,j)=Color2Alpha then
                bitData1.SetPixel(i,j,TAlphaColors.Null);
            end;
        finally
          Result.Unmap(bitData1);
        end;
      end;
     
    begin
    if OpenDialog1.Execute then
     begin
      ExeName.Text:=Opendialog1.FileName;
      aStream:=TMemoryStream.Create;
      try
       {$IFDEF MSWINDOWS}
       SHGetFileInfo(PChar(OpenDialog1.FileName),2, InfoData, SizeOf(InfoData), SHGFI_ICON);
       gdiBitmap:=TGPBitmap.Create(infodata.hIcon);
       GetEncoderClsid('image/png', codec);
       gdibitmap.Save(TStreamAdapter.Create(aStream),codec,nil);
       {$ENDIF}
       image1.Bitmap:=RendreTransparent(aStream);
     finally
       aStream.free;
      end;
     end;
    end;
    La seule chose absolue dans un monde comme le nôtre, c'est l'humour. » Albert Einstein

    Delphi installés : D3,D7,D2010,XE4,XE7,D10 (Tokyo, Rio) et peut être quelques autres
    SGBD : Firebird 2.5, 3, SQLite
    générateurs Etats : FastReport, Rave, QuickReport
    OS : Window Vista, Windows 10, Ubuntu, Androïd

  9. #9
    Rédacteur/Modérateur

    J'ai vu après coup (en regardant le forum Lazarus) que la demande portait en fait sur les icônes associées

    cette modification fait l'affaire
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
     
       {$IFDEF MSWINDOWS}
    //   SHGetFileInfo(PChar(OpenDialog1.FileName),2, InfoData, SizeOf(InfoData), SHGFI_ICON);
       w:=0; // w doit être déclaré comme word
       gdiBitmap:=TGPBitmap.Create(ExtractAssociatedIcon(hInstance,Pchar(OpenDialog1.FileName),w));
    La seule chose absolue dans un monde comme le nôtre, c'est l'humour. » Albert Einstein

    Delphi installés : D3,D7,D2010,XE4,XE7,D10 (Tokyo, Rio) et peut être quelques autres
    SGBD : Firebird 2.5, 3, SQLite
    générateurs Etats : FastReport, Rave, QuickReport
    OS : Window Vista, Windows 10, Ubuntu, Androïd