unit uDMImageListsBPL;

// Заполняет Image листы картинками из ресурсов
// Имэдж лист чекбоксов и имэдж-лист папок / файлов

interface

uses
  Winapi.Windows,  Winapi.Messages,  System.SysUtils,  System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms,  Vcl.Dialogs,  Vcl.StdCtrls,
  Vcl.ComCtrls,  Vcl.ExtCtrls,  System.ImageList,  Vcl.ImgList;

type
  TDMImageList = class(TDataModule)
    ilFoldersAndFiles: TImageList;
    ilCheckBoxes: TImageList;

    procedure DataModuleCreate(Sender: TObject);
  private
    { Private declarations }


    procedure AddToImageList(ImageList:TImageList; Res_id:WideString);
    procedure FillFilesAndFolders;
    procedure FillCheckBoxes;



  public
    { Public declarations }
  end;

var
  DMImageList: TDMImageList;

implementation

 uses uTreeView;

{%CLASSGROUP 'Vcl.Controls.TControl'}

{$R *.dfm}

{ TDMImageList }




procedure TDMImageList.DataModuleCreate(Sender: TObject);
begin
FillFilesAndFolders;
FillCheckBoxes;
end;



//------------------Добавление в ImageList из ресурсов--------------------------

procedure TDMImageList.AddToImageList(ImageList: TImageList; Res_id: WideString);
var
    rs:TResourceStream;
    twic:twicimage;
    bmp:tbitmap;
    Color:TColor;
    h:THandle;

    myWideCharPtr:PWideChar;

begin

          // Создание
          bmp:=TBitmap.Create;
          twic:=twicimage.Create;
          rs:=nil;


       //   PwideCharString:=PwideChar(WideString(Res_id));
       //   PWideString:=Res_id;

            myWideCharPtr:=Addr(Res_id[1]);

            if FindResource(0,(myWideCharPtr),PChar(RT_RCDATA))<>0
            then
            begin

            rs:=TResourceStream.Create(0,(myWideCharPtr),PChar(RT_RCDATA));
            twic.LoadFromStream(rs);

//            bmp.AlphaFormat:=afDefined; // << Не помогает здесь для прозрачности
            // Иконки хоть и PNG, остаются с чёрным или белым фоном
//            bmp.TransparentMode:=tmAuto;
            //bmp.Transparent:=true;

            //bmp.TransparentColor:=DBTreeViewGlobal.Color;


            bmp.Height:=16;
            bmp.Width:=16;

            bmp.Assign(twic);


            //Чтобы получить белый фон при Release под иконками папок
            //нужно закомментировать нижние 3 строчки
            //При Debug будет прозрачность!

            {
            Color:=DBTreeViewGlobal.Color;
            bmp.TransparentMode:=tmAuto;
            bmp.TransparentColor:=Color;
            }

            bmp.Transparent:=true;

            bmp.TransparentColor:=DBTreeViewGlobal.Color;

            ImageList.AddMasked(bmp,Color); // <<Так работает корректно, только при Debug!!!

            //ImageList.Add(bmp,nil); // << Без цвета прозрачности!!!

            end else showmessage('Ресурс не найден '+Res_id);


          //Уничтожение

          bmp.Free;
          twic.Free;

          if rs<>nil then FreeAndNil(rs);

end;


//-----------------Заполнение чекбоксов(ресурсы)--------------------------------

procedure TDMImageList.FillCheckBoxes;
begin

//Защита от повторного добавления
if ilCheckBoxes.Count<>0 then exit;


AddToImageList(ilCheckBoxes,'Unchecked_id2');
AddToImageList(ilCheckBoxes,'Unchecked_id2');
AddToImageList(ilCheckBoxes,'Checked_id');

//showmessage('ilCheckBoxes '+ilCheckBoxes.Count.ToString());

end;

//----------------------Заполнение папок, файлов(ресурсы)-----------------------

procedure TDMImageList.FillFilesAndFolders;
begin

//Защита от повторного добавления

if ilFoldersAndFiles.Count<>0 then exit;

AddToImageList(ilFoldersAndFiles,'file_id');
AddToImageList(ilFoldersAndFiles,'FolderClosed_id');
AddToImageList(ilFoldersAndFiles,'FolderOpened_id');

//showmessage('ilFoldersAndFiles '+ilFoldersAndFiles.Count.ToString());

end;


end.
