We help IT Professionals succeed at work.

Runtime Loading of Images into TImageList Has No Transperancy.

ThievingSix
ThievingSix asked
on
Ok, so a little background:
I am currently creating a home media center via a custom Windows shell that will run on a VM that is fullscreen on a second monitor (Which is connected to a TV).

Question 2:
Now this application is gathering media from a folder, making a thumbnail, and displaying in a ListView. I am using mplayer from the command line to grab a png image of a frame, saving it, then loading it into a ImageList.

Now the saved frame isn't set as it changes size with the aspect ratio of the media I'm thumbnailing.

Let's say the thumbnail generated is 200x175. The ImageList component expects a 200x200 image.

What I end up doing it creating a new bitmap to 200x200, center the thumbnail, and adding it to the ImageList, which gets used by the ListView. Code here:

 
procedure AddSizedImage(ImageList: TImageList; Bitmap: TPNGImage);
var
  BMPSized : TBitmap;
begin
  BMPSized := TBitmap.Create;
  Try
    BMPSized.Width := ImageList.Width;
    BMPSized.Height := ImageList.Height;
    BMPSized.Canvas.Draw(((BMPSized.Width - Bitmap.Width) div 2), ((BMPSized.Height - Bitmap.Height) div 2), Bitmap);
    ImageList.AddMasked(BMPSized, clWhite);
  Finally
    FreeAndNil(BMPSized);
  end;
end;

procedure CreateVideoThumbs(const FileNames: TStringList; Size: Integer);
var
  FilePath : String;
  Parameters : String;
  I : Integer;
begin
  FilePath := ExtractFilePath(ParamStr(0)) + 'mplayer\mplayer.exe';
  Parameters := Format('-nosound -vo png -frames 1 -ss 300 -vf scale=%d:-3', [Size, Size]);
  For I := 0 To FileNames.Count - 1 Do
    begin
    Parameters := Parameters + Format(#32'"%s"', [FileNames.Strings[I]]);
  end;
  ExecAndWait(FilePath, Parameters, False);
end;

procedure GetFileBitmaps(ImageList: TImageList; FileList: TStringList);
const
  ThumbSize = 325;
var
  I : Integer;
  NewThumb : TPNGImage;
  PicturePath : String;
begin
  ImageList.Clear;
  ImageList.Width := ThumbSize;
  ImageList.Height := Round(ThumbSize * 0.75);
  CreateVideoThumbs(FileList, ThumbSize);
  NewThumb := TPNGImage.Create;
  Try
    For I := 1 To FileList.Count Do
      begin
      PicturePath := Format('%s\%.8d.png', [ExtractFilePath(ParamStr(0)) + 'mplayer', I]);
      If FileExists(PicturePath) Then
        begin
        NewThumb.LoadFromFile(PicturePath);
        AddSizedImage(ImageList, NewThumb);
        DeleteFile(PicturePath);
      end;
    end;
  Finally
    NewThumb.Free;
  end;
end;

Open in new window


So, what am I missing, I get white borders around the images when the thumbnails aren't 200x200. Is this a limitation of the ListView component or have I screwed up making the image transparent somewhere?
Comment
Watch Question

Top Expert 2010

Commented:
What is your Delphi and Windows versions? I've checked it on Delphi 7/WinXP. There is no border around the images.

Author

Commented:
Delphi 2009, Win7
Untitled.png
Top Expert 2010
Commented:
I've reproduced it under Delphi 7/Win XP. I had to change background color for ListView.

Try this:

procedure AddSizedImage(ImageList: TImageList; Bitmap: TPNGImage);
var
    BMPSized : TBitmap;
begin
    BMPSized := TBitmap.Create;
    Try
        BMPSized.Width := ImageList.Width;
            BMPSized.Height := ImageList.Height;
            BMPSized.Canvas.Brush.Color:= clWhite;
            BMPSized.Canvas.FillRect( Rect(0, 0, BMPSized.Width, BMPSized.Height) );

            BMPSized.Canvas.Draw(((BMPSized.Width - Bitmap.Width) div 2), ((BMPSized.Height - Bitmap.Height) div 2), Bitmap);
            ImageList.AddMasked(BMPSized, clWhite);
    Finally
            FreeAndNil(BMPSized);
    end;
end;

Author

Commented:
I could have sworn that I've tried that!! SWORN!

Yet this time it works, I must have missed something before.

Anyway, it works now. Thank you.