Delphi - Populate an imagelist with icons at runtime 'destroys' transparency - delphi

I've spended hours for this (simple) one and don't find a solution :/
I'm using D7 and the TImageList. The ImageList is assigned to a toolbar.
When I populate the ImageList at designtime, the icons (with partial transparency) are looking fine.
But I need to populate it at runtime, and when I do this the icons are looking pretty shitty - complete loose of the partial transparency.
I just tried to load the icons from a .res file - with the same result.
I've tried third party image lists also without success.
I have no clue what I could do :/
Thanks 2 all ;)
edit:
To be honest I dont know exactly whats going on. Alpha blending is the correkt term...
Here are 2 screenies:
Icon added at designtime:
(source: shs-it.de)
Icon added at runtime:
(source: shs-it.de)
Your comment that alpha blending is not supported just brought the solution:
I've edited the image in an editor and removed the "alpha blended" pixels - and now it looks fine.
But its still strange that the icons look other when added at runtime instead of designtime. If you (or somebody else ;) can explain it, I would be happy ;)
thanks for you support!

To support alpha transparency, you need to create the image list and populate it at runtime:
function AddIconFromResource(ImageList: TImageList; ResID: Integer): Integer;
var
Icon: TIcon;
begin
Icon := TIcon.Create;
try
Icon.LoadFromResourceID(HInstance, ResID);
Result := ImageList.AddIcon(Icon);
finally
Icon.Free;
end;
end;
function AddPngFromResource(ImageList: TImageList; ResID: Integer): Integer;
var
Png: TPngGraphic;
ResStream: TStream;
Bitmap: TBitmap;
begin
ResStream := nil;
Png := nil;
Bitmap := nil;
try
ResStream := TResourceStream.CreateFromID(HInstance, ResID, RT_RCDATA);
Png := TPNGGraphic.Create;
Png.LoadFromStream(ResStream);
FreeAndNil(ResStream);
Bitmap := TBitmap.Create;
Bitmap.Assign(Png);
FreeAndNil(Png);
Result := ImageList.Add(Bitmap, nil);
finally
Bitmap.Free;
ResStream.Free;
Png.Free;
end;
end;
// this could be e.g. in the form's or datamodule's OnCreate event
begin
// create the imagelist
ImageList := TImageList.Create(Self);
ImageList.Name := 'ImageList';
ImageList.DrawingStyle := dsTransparent;
ImageList.Handle := ImageList_Create(ImageList.Width, ImageList.Height, ILC_COLOR32 or ILC_MASK, 0, ImageList.AllocBy);
// populate the imagelist with png images from resources
AddPngFromResource(ImageList, ...);
// or icons
AddIconFromResource(ImageList, ...);
end;

I had the exact same problems a couple of years ago. It's a Delphi problem. I ended up putting the images in the list at design time, even though I really didn't want to. I also had to use a DevExpress image list to get the best results and to use 32 bit color images.

As Jeremy said this is indeed a Delphi limitation.
One work around I've used for images that I was putting onto buttons (PNGs with alpha transparency in my case) is to store the PNGs as resources, and at run time paint them onto a button sized bitmap filled with clBtnFace. The bitmap was then used as the control's glyph.
Delphi's built in support for icons with alpha masks is very limited, however there's an excellent icon library kicon which may help.

Related

How to read a file in a TTask? (Delphi, fmx)

I need to read bitmap files and then copy them in an image component. I would like to do this in a TTask to keep the GUI responsive. If I run the minimized code below, then sometimes the apple image appears correctly and sometimes it appears without content (a grey square). If I put the bmp.LoadFromFile(..) in the TThread.Synchronize, then it seems to works fine, but is it necessary to put it in the TThread.Synchronize?
I do not understand why it does not work as is, because 1) if I look at the source code of LoadFromFile then the procedure starts with TMonitor.Enter(Self); and 2) when I save the bmp twice as commented out in the code, then the first save always contains the correct image (so the LoadFromFile seems to work), but the second save sometimes gives the correct image and sometimes a black image (but with the correct size)?
I am new to threading, so am hoping that someone can shed some light on this and what the correct way is to read images in a TTask. I am using Delphi 10.3.3.
Thanks,
Gerard
procedure TForm1.Button3Click(Sender: TObject);
begin
TTask.Run(procedure
var bmp: TBitmap;
begin
bmp := TBitmap.Create;
bmp.LoadFromFile('apple.bmp');
// bmp.SaveToFile('apple1.bmp');
// bmp.SaveToFile('apple2.bmp');
TThread.Synchronize(nil,
procedure
begin
Form1.Image1.bitmap.CopyFromBitmap(bmp, Rect(0, 0, bmp.Width, bmp.Height), 100, 100 );
end);
bmp.Free;
end);
end;

How to load a transparent Image from ImageList?

I want to load a picture (32 bit-depth, transparent) from a TImageList to an TImage. The standard approach would be ImageList.GetBitmap(Index, Image.Picture.Bitmap);. However the GetBitmap method doesn't work with transparency, so I always get a non-transparent bitmap.
The workaround is rather simple - ImageList offers another method, GetIcon, which works OK with transparency. Code to load a transparent Image would be:
ImageList.GetIcon(Index, Image.Picture.Icon);
And don't forget to set proper ImageList properties:
ImageList.ColorDepth:=cd32bit;
ImageList.DrawingStyle:=dsTransparent;
I too have had various issues with passing in images from the a tImageList. So I have a simple wrapper routine that generally does the job and it enforces the transparency. The code below is Delphi 2005 and imlActiveView is the tImageList component that has my set of button glyph images.
procedure TfrmForm.LoadBitmap (Number : integer; bmp : tBitMap);
var
ActiveBitmap : TBitMap;
begin
ActiveBitmap := TBitMap.Create;
try
imlActiveView.GetBitmap (Number, ActiveBitmap);
bmp.Transparent := true;
bmp.Height := ActiveBitmap.Height;
bmp.Width := ActiveBitmap.Width;
bmp.Canvas.Draw (0, 0, ActiveBitmap);
finally
ActiveBitmap.Free;
end
end;
Here is an example of use where the 5th imlActiveView image is passed into the btnNavigate.Glyph.
LoadBitmap (5, btnNavigate.Glyph)

Transparent image control with resampling in Delphi

I have a form with a background image (painted on the form in Form1.Repaint).
What I am a looking for: A transparent image control, that can smoothly resize (resample) the loaded image.
(I need it to be transparent because the forms background image should be visible through)
What I've tried:
Standard TImage: It's transparent, but it does not resample.
Graphics32 / Image32: Resamples beautifully, but it's not transparent.
I have googled for several hours now for fixes or work-arounds, but without much of a solution. This has nothing to do with the image loaded into Image32 being transparent, but instead the background color of the control still being white (white = the color-property of the Image32 control, and setting it to clNone does not work). This is apparently as designed
GR32ex (The GR32 Extension Components Pack), which supposedly adds a Transparent-property, however it has not been updated in many years, and I can not install it. It throws a gazillion errors on Delphi 2010 and Graphics32 v. 1.9.
Can anybody think of a solution or workaround? All I want is a control with transparency and resampling.
Thanks!
I'm surprised that TImage32 doesn't do transparency. Are you really sure that is the case?
Anyway, if that is so, I would combine the transparency support of TImage with the re-sampling ability of TBitmap32 to build a solution that way. Keep the original image in a TBitmap32 instance. Whenever you need to load it into the TImage component, for example when re-sizing, use TBitmap32 to perform an in-memory re-size and load that re-sized image.
In fact, if you are already painting the form's background yourself, why not paint the image yourself and simply do away with the image control?
Update 1: Websearch reveals a simple way to make TImage32 transparent: http://graphics32.org/news/newsgroups.php?art_group=graphics32.general&article_id=9505
Update 2: The link above is now dead, and the newsgroups can only be accessed via NNTP. I can't be 100% certain, but I think that the linked post was by Michael Haralabos and contained the following file:
unit GR32_ImageEx;
// Transparent TImage32 by Michael Haralabos
interface
uses
Windows, Messages, Classes, GR32_Image, GR32;
type
TImage32Ex = class(TImage32)
private
FTransparent: Boolean;
procedure SetTransparent(const Value: Boolean);
public
procedure ExecClearBackgnd(Dest: TBitmap32; StageNum: Integer); override;
published
property Enabled;
property Transparent: Boolean read FTransparent write SetTransparent;
end;
procedure Register;
implementation
procedure TImage32Ex.ExecClearBackgnd(Dest: TBitmap32; StageNum: Integer);
var
P: TPoint;
SaveIndex: Integer;
begin
if FTransparent and Assigned(Parent) and
not (Assigned(Bitmap) and (BitmapAlign = baTile)) then
begin
SaveIndex := SaveDC(Dest.Handle);
GetViewportOrgEx(Dest.Handle, P);
SetViewportOrgEx(Dest.Handle, P.X - Left, P.Y - Top, nil);
IntersectClipRect(Dest.Handle, 0, 0, Parent.ClientWidth, Parent.ClientHeight);
Parent.Perform(WM_ERASEBKGND, Dest.Handle, 0);
Parent.Perform(WM_PAINT, Dest.Handle, 0);
RestoreDC(Dest.Handle, SaveIndex);
end
else
inherited;
end;
procedure TImage32Ex.SetTransparent(const Value: Boolean);
begin
if FTransparent <> Value then
begin
FTransparent := Value;
Invalidate;
end;
end;
procedure Register;
begin
RegisterComponents('Graphics32', [TImage32Ex]);
end;
end.
Another topic here suggests that this may be what the now dead link referred to: Delphi TImage32 - how to make the component invisible if no picture is loaded?

CopyRect (scaling) with the correct colors in Delphi

In this question I asked about the correct use of the CopyRect method. I got an answer which fixed my problem, but now the colors of the copied rectangle are wrong (limited to 256 values?).
This is the code:
var
Bmp: TBitmap;
begin
Image1.Picture.LoadFromFile(SomeJPGimage);
Bmp := TBitmap.Create;
try
Bmp.Assign(Image1.Picture.Graphic);
with Bmp do
Image2.Canvas.CopyRect(Image2.Canvas.ClipRect, Canvas, Canvas.ClipRect);
finally
Bmp.Free;
end;
end;
The inset with the false colors is Image2. The colors are right if I don't resize.
How do I get the 24 bit color of the source image (a JPG) when resizing?
edit
Draw is not an alternative; I want to copy a scaled version of part of the source image.
This is not caused because of color reduction, or a wrong pixelformat etc.. You're probably shrinking the image while copying and 'StretchBlt' compresses the image to fit in, and depending on the mode, produces some artifacts. For instance the below 128x128 image    
is displayed exactly the same if no resizing is applied. However if it is applied on a 90x100 image for instance, the output is   .
You can change the stretching mode for a slightly better result:
var
Bmp: TBitmap;
begin
Image1.Picture.LoadFromFile(SomeJPGimage);
Bmp := TBitmap.Create;
try
Bmp.Assign(Image1.Picture.Graphic);
SetStretchBltMode(Image2.Canvas.Handle, HALFTONE); // <- here
with Bmp do
Image2.Canvas.CopyRect(Image2.Canvas.ClipRect, Canvas, Canvas.ClipRect);
finally
Bmp.Free;
end;
end;
For the above source picture the output now becomes:
(Having browsed a little 'graphics.pas', the VCL seems to be using halftone only for 8-bit images. I may be wrong or right in this assessment, but in any case halftone stretching mode has no such constraint.)
For anything better, I believe, you have to use a proper graphics library.
Edited again:
Turns out the issue is going against the WRONG canvas (too easy with TImage if you're not used to it). Tried to save files on my last sample and got a huge file on the one I assigned. So I Started looking into some of the other values and found that you need to work against the Bitmap Canvas...
var
BMP: TBitmap;
MyClipRect: TRect;
begin
if OpenDialog1.Execute then
begin
Image1.Picture.LoadFromFile(OpenDialog1.FileName);
Bmp := TBitmap.Create;
try
Bmp.Assign(Image1.Picture.Graphic);
myClipRect.Left := (Bmp.Width div 2);
myClipRect.Top := (Bmp.Height div 2);
myClipRect.Right := (Bmp.Width);
myClipRect.Bottom := (Bmp.Height);
with Image2.Picture.Bitmap do
begin
Width := Bmp.Width div 2;
Height := Bmp.Height div 2;
Canvas.CopyRect(Canvas.ClipRect, Bmp.Canvas, MyClipRect);
end;
Image2.Picture.SaveToFile('image2.bmp');
finally
Bmp.Free;
end;
end;
end;
Hope that finally got it. Yeesh.

Setting up background images for forms in Delphi

How can I make my program load an image and make it the background for a form?
I need the exact code for it. I've looked all over the internet and the only things I've found are various tweaks and fixes to make backgrounds work as intended in special circumstances. I've also tried some Delphi books I have and I can't find it anywhere.
Put a TImageon your form. Make sure it's behind all other controls on the form. You can right-click it and choose the "send to back" menu option.
Load a graphic.
var
img: TBitmap;
begin
img := TBitmap.Create;
try
img.LoadFromFile('S:\background.bmp');
Assign it to the image control.
Image1.Picture := img;
Clean up.
finally
img.Free;
end;
end;
You can also combine the last three steps to load the graphic and put it in the image control all at once. Thanks to Jon for the suggestion.
Image1.Picture.LoadFromFile('B:\background.bmp');
See also: How to add background images to Delphi forms
What I would do is use the forms OnPaint event, get the canvas (Form1.Canvas), and then use the Draw method (which takes an image) to draw the image you want. Something like the following:
procedure TForm1.FormPaint(Sender: TObject);
var
mypic: TBitMap;
begin
mypic := TBitMap.Create;
try
mypic.LoadFromFile('cant.bmp');
Form1.Canvas.Draw(0, 0, mypic);
finally
FreeAndNil(mypic);
end;
end;
Note that this could be extremely slow.
This is the way all my applications show a form image. I load the image at form creation or when the application calls a specific showing event
var
vDest, vRect: TRect;
begin
vRect := Rect(0, 0, FBackgroundImage.Width, FBackgroundImage.Height);
vDest := Rect(0,0,Self.Width, Self.Height);
Canvas.StretchDraw(vDest, FBackgroundImage);
if FileExists(this) then
FBackgroundImage.LoadFromFile(this);
#Brendan
thanks
//from Brendan code;
var
vDest, vRect: TRect;
FBackgroundImage: TGraphic;
begin
FBackgroundImage := image1.Picture.Graphic; //LOAD from invisible image
vRect := Rect(0, 0, FBackgroundImage.Width, FBackgroundImage.Height);
vDest := Rect(0,0,Self.Width, Self.Height);
Canvas.StretchDraw(vDest, FBackgroundImage);
end;

Resources