The goal is to have animated GIFs playing inside image components with good image quality even after resizing one of the image components.
TImage example
This is the resized TImage, very bad image quality but flawless animation:
// GIF = TGIFImage
// TImage = TImage
GIF.Animate := True;
TImage.Stretch := True;
TImage.Proportional := True;
TImage.Picture.Assign(GIF);
TImage32 example
This is a resized TImage32 from the graphics32 library, very good image quality but no animation at all, only the first frame ist visible:
// GIF = TGIFImage
// TImage32 = TImage32
GIF.Animate := True;
TImage32.ScaleMode := smResize;
TImage32.BitmapAlign := baCenter;
TImage32.Bitmap.Assign(GIF);
I need to have the TImage32 component play the animation or for the TImage component to have better resampling.
Graphics32 is not meant to display animations (like in a GIF) out of the box. Furthermore it does not contain a native GIF decoder. The code you show relies on the internal TPicture decoder from Delphi. A conversion to TImage32 with assign will only copy the first frame and thus it will result in a still image.
In order to display animations you need further code. As mentioned in the comments it would make sense to first copy the each frame of the GIF to a TBitmap32 instance (TImage32 has too much overhead). Than you need to perform the animation. If possible this should relate to the display refresh rate or take at least the time interval since the last drawing into account.
If for example your monitor uses 60fps and your gif contains 30 frames per second than you need to display each frame for two refresh cycles. Though, this would be an easy situation.
Things will get slightly more complicated if your gif contains 29 frames per second (for example). You need to develop an algorithm to pick the right frame for the current time.
So far I have not seen any implementation of the above for Graphics32, but it's not that complicated once you know what to do.
Related
I am trying to draw a source image (GR32 TBitmap32) that contains some fully transparent and also partially transparent pixels on a normal (TBitmap) image while preserving the transparency in the source image.
I use this:
BMP32.DrawTo(BMP.Canvas.Handle, 0, 0);
but the image is not drawn transparently.
Code:
Everything is pretty basic: I have a background bitmap (Bkg) in which I load, at application start up, an image.
Then in procedure Apply I load a second image from disk (the one with transparency) and I draw the it over the background.
var Bkg: TBitmap;
procedure TfrmPhoto.FormCreate(Sender: TObject);
begin
Bkg:= LoadGraphEx(GetAppDir+ 'bkg.bmp'); { Load bitmap from file }
{
Bkg.Transparent:= TRUE;
Bkg.PixelFormat:= pf32bit;
Bkg.TransparentColor:= clPink;
}
end;
procedure TfrmPhoto.Apply2;
VAR
Loader: TBitmap;
BMP32: tbitmap32;
begin
BMP32:= TBitmap32.Create;
TRY
Loader:= TBitmap.Create;
TRY
Loader.LoadFromFile('c:\Transparent.BMP');
BMP32.Assign(Loader);
FINALLY
FreeAndNil(Loader);
END;
{ Mix images }
BMP32.DrawTo(Bkg.Canvas.Handle, 0, 0); <----- The problem is here
imgPreview.Picture.Assign(Bkg); { This is a TImage where I see the result }
FINALLY
FreeAndNil(BMP32);
END;
end;
It worked (but with 2 disadvantages) with TransparentBlt().
I am not happy with the way TransparentBlt handles the semitransparent pixels (the edge of the rotate image). After merging the src image into the background the edges look bad.
In order to use TransparentBlt, I had to define a color (clPink) in the source image as transparent. This means that if the source image has some pink in it, the result will look really nasty (it will be treated as transparent). Let's pray for non-pink images!
If you find a way to transfer the image (while preserving transparency) directly from Bitmap32 into the background please post and I will accept your answer!
A solution (still a hack) I see here is to process everything in a TBitmap32 and then 'export' the final result as TBitmap. I will try this tomorrow.
Update:
Solution:
This is how to merge two TBitmap32 images while preserving transparency:
Dst.CombineMode:= cmBlend;
Dst.DrawMode:= dmBlend;
Src.Draw(0, 0, Dst);
Dst and Src are TBitmap32 images. It doesn't work with TBitmap.
As already suggested by yourself, I would recommend performing blending operations entirely in the TBitmap32 domain! The reason for this is the fact that it offers more choices in regards of blending and it uses MMX/SSE/SSE2 where available (on modern machines always the case). With this one can typically get a notable performance boost in contrast to letting GDI perform the blending.
In particular this is not a good idea as GDI typically does not make use of any SIMD opcodes (MMX/SSE).
It also depends on how much each part changes. For example, typically the background is rather static and need to be transfered into a TBitmpa32 only occassionally on changes (e.g. on VCL style or UI theme changes). With each transfer (GR32 <-> TBitmap and alike) an implict conversion (DIB <-> DDB) might happen, which makes the entire blending an O(n²) operation. So you'd better transfer (with an implicit conversion) to TBitmap32 just once and then perform the blending entirely in the GR32 domain.
On the contrary, if the TBitmap32 is rather static and the TBitmap (or background) changes a lot, it might probably be better to leave GR32 alone and copy the TBitmap32 to TBitmap and perform the blending with GDI. Despite the fact that the GDI blending is slightly slower, you avoid the additional copy. Otherwise your bottleneck will likely be the memory throughput, while processing speed never can touch the limits.
It is dmBlend DrawMode of TBitmap32 to turn on the transparency, but it only works between two TBitmap32 bitmaps. Do not use TBitmap32 with transparent images to draw directly on HDC, Canvas or TBitmap. Use dmBlend and DrawTo or BlockTransfer() to draw on another TBitmap32. For example, to draw transparently on a TBitmap, create an intermediary cache TBitmap32:
Copy the image from TBitmap to the cache TBitmap32;
Apply your transparent image to the cache TBitmap32 using DrawTo or BlockTransfer(), avoid using Canvas or HDC to mix two images because they lose alpha layer information;
Copy the image back from the cache TBitmap32 to your TBitmap.
I'm trying to display an animated GIF in a Firemonkey HD form using TImage but I do not see any methods for animation.
Using Vcl.Imaging.gifImg is not an option because types differ.
Can someone suggest a way to solve this problem or probably component to animate GIF images under Firemonkey?
The only way I find for now is:
create TGIFImage instance and load the GIF image
loop through gif.images:
a. save current image to stream
b. Image1.bitmap.loadFromStream [Image1 is FMX:TImage]
Is there any smarter solution?
You can use TBitmapListAnimation with a single image which has each frame of the animation inside a long strip. eg, if your animation has 4 frames and is 32px by 32px then you need to create an image 128px wide by 32px high and add each frame side by side...
Then add a TImage to the form (you don't have to load a bitmap into this)
Add a TBitmapListAnimation with the TImage as it's parent
Double click AnimationBitmap and load your animation image strip
Drop down PropertyName and pick Bitmap
Set AnimationCount to 4 and AnimationRowCount 1 for this example
Set enabled to true
TBitmapListAnimation has good control over animation frame rates, reversing, looping and interpolation. I couldn't find a way to get a .gif to animate in FireMonkey2 but if you have the means to convert an animated .gif into a 'cartoon strip' then this is a good way to do animations.
PS This is Delphi XE3...so can't say if these components existed in previous version.
I have a Image list assigned to a listview to display transparent images.
There is a slight issue with this regarding some transparent images that are added, and that is they are sometimes hard to see/find in the listview.
See this example image:
You will notice that the images (noticeably the mouse) is barely viewable, infact if a empty image was added you would not even see it, the number captions come to the rescue here to show there is something actually there.
But I would like to make the images visually easier to see. I thought maybe having another image underneath the transparent images would work - of course though it could not affect the actual image.
So with that in mind, I made a bitmap of a chessboard grid:
I feel this would be the most suitable way of representing transparent areas of the images just like Paint.NET etc does.
To further illustrate this example I have modified the original image to show how it would look, if we had the chessboard bitmap as the underlay image:
Having the chessboard there would indicate there is a list item there in the first place, and the bitmap of the chessboard grid could be darker or an altogether different kind of image. As I said earlier if there was no image you would see nothing at all, so better to show an empty chess grid or other bitmap than nothing.
So, how can I display a second image underneath the original images using a imagelist to give a result similar to the example above? The underneath image could be anything - just another loaded bitmap for example.
If you store the chessboard as the first image (with index 0) and make the overlay image from the current image in the OnGetImageIndex event handler, it will do what you want to. However I'm not sure how efficient is to make the overlay image every time the event is fired.
procedure TForm1.ListView1GetImageIndex(Sender: TObject; Item: TListItem);
begin
// make the overlay (with overlay index 1) from the
// image with index Item.Index + 1
ImageList1.Overlay(Item.Index + 1, 1);
// use the first image from the list as a background
Item.ImageIndex := 0;
// and assign just created overlay index for overlay
Item.OverlayIndex := 1;
end;
I seems that what you need is a TImageList with extra capabilities.
As a starting point, I suggests you to consider TImageListEx described in the book Inside Delphi 2006
Excerpt:
The TImageListEx component is a TImageList descendant that can use the
images from another image list to generate disabled images, which can
be used on toolbars and other user interface elements.
The TImageListEx component is a TImageList descendant that can use the
images from another image list to generate disabled images, which can
be used on toolbars and other user interface elements.
There are several benefits of the TImageListEx component:
It eliminates the need for creating disabled glyphs.
It eliminates the need for adding the disabled glyphs to an additional TImageList component at design time.
It can drastically reduce the size of the .dfm file and of the entire application, especially in large applications that use a lot of
glyphs.
It's extremely fast, taking only milliseconds to disable all images in an image list, even when there are number of images.
It's extremely lightweight. (If you add it to an application that already uses the standard TImageList component, it won't increase the
size of the executable at all, and if you add it to an application
that doesn't use the standard TImageList component, the overhead is
only 2 KB.)
It's far from your requirements but yet detailed enough to show how to extend TImageList.
WHAT I AM TRYING TO DO
I am trying to draw multiple graphics to a Timage, These graphics that i Draw consist of ordered layers with Foodfills and lines.
I use multiple buffers to ensure ordering and double buffering.
WHAT I AM DOING
procedure DrawScene();
var
ObjLength,LineLength,Filllength,Obj,lin,angle,i:integer;
Npoints : array[0..1] of Tpoint;
Objmap:TBitmap;
wholemap:TBitmap;
begin
wholemap := TBitmap.Create;
wholemap.Width:=area;
wholemap.height:=area;
ObjLength:=length(Objects);
for Obj:=0 to (ObjLength-1) do
if objects[Obj].Visible then
begin
// create object bitmap
if Objects[obj].Tag='FBOX' then
begin
Objmap := TBitmap.Create;
Objmap.Width:=area;
Objmap.height:=area;
Objmap.Transparent:=true;
Objmap.Canvas.Rectangle((objects[obj].Boundleft-4)+objects[obj].Position.x,area-((objects[obj].boundtop+4)+objects[obj].Position.y),(objects[obj].boundright+4)+objects[obj].Position.x,area-((objects[obj].boundbottom-4)+objects[obj].Position.y));
end;
//draw object
LineLength:=length(objects[Obj].Lines)-1;
angle:=objects[Obj].Rotation;
for lin:=0 to (LineLength) do
begin
for i:=0 to 1 do
begin
Npoints[i] := PointAddition(RotatePoint(objects[obj].Lines[lin].Point[i],angle),objects[obj].Position,false);
end;
Objmap:=DrawLine(Npoints[0].x,Npoints[0].y,Npoints[1].x,Npoints[1].y,objects[obj].Lines[lin].Color,Objmap);
end;
Filllength:=length(objects[Obj].Fills)-1;
for i:=0 to Filllength do
begin
Npoints[0]:=PointAddition(RotatePoint(objects[Obj].Fills[i].Point,objects[Obj].Rotation),objects[Obj].Position,false);
Objmap:=fillpoint( Npoints[0].x, Npoints[0].y,objects[Obj].Fills[i].color,Objmap);
end;
//write object to step frame
wholemap.Canvas.Draw(0,0,Objmap);
Objmap.Free;
end;
// write step frame to Visible Canvas
mainwindow.bufferim.Canvas.Draw(0,0,wholemap);
mainwindow.RobotArea.Picture.Graphic:=mainwindow.bufferim.Picture.Graphic;
wholemap.Free;
end;
WHAT I EXPECT
I expect to see each image object layered on top of one another with each image layer being the complete image for that layer.
im my example it is a robot with a flag behind it.
the flag is drawn first and then the robot.
WHAT I GET(on a pc)
on a pc i get what i expect and all appears to be correct.
WHAT I GET(on a laptop)
On a nearly every laptop and some pc's i only see the robot.
i put in some statments to see if it is drawing the flag and it does. the game can even interact with the flag in the correct manner.
further investigation showed me that it was only showing the last image drawn my "drawscene", and when images were drawn directly to the wholecanvas everthing apeared(this cannot be done for overlapping fill layers reasons)
WHAT I THINK IS HAPPENING
so what i deduced is that the Timage.transparent property of the Timage is not working or is being computed differently on some machines..
i did a test to prove this and made a canvas red. then to that canvas i drew at 0,0 i Timage with property transparent=true with just one dot in the middle to the red canvas. the resuly was a white canvas with a dot in the middle.
I am assuming and findings indicate that machines with very basic graphics drivers seem to treat null or transparent as white where as more powerful machines seem to treat null or transparent as transparent.
this seems to be a bit of a failure due to the fact that the Timage.Transparent property was true.
EDIT:
UPDATE!!!
It would appear to be that on ATI graphics cards if a colour is "null" then it is interpreted in the format of PF24bit and therefore no alpha channel and no transparency.
on Nvidia cards it takes it as PF32bit and treats null as transparent.
the obvious way to get around that woulf be to set the bitmaptype to PF32bit, but that does still not work.
I then assumed that maybe that is not enough and I should make sure that the background is SET to transparent rather than being left as null.. but there are no tools ( that I can see) inside the Timage to set colour with alpha. all canvas drawing functions require a Tcolor that is RGB 24 bit and ony a TcolorRef with RGBA 32 bit would do....
is there a way of drawing with alpha 0?
WHAT I THINK I NEED TO KNOW
How to force the Transparent property to work on all machines
or a way to make laptops not paste in transparent as white
Or a way to achieve the same result.
Anyone have any solutions or ideas?
I have been using an Graphics library (AggPas) to help with drawing graphics and one of the things I've noticed is that I always need a line Bitmap.PixelFormat = pf32bit to get it to draw transparancies.
Having said that I use TransformImage from the AggPas library to copy the Image with a transparent background to another one and AggPas only accepts pf24bit or pf32bits as Pixel formats (otherwise it doesn't attach to the bitmap)
I've seen similar behaviour on different machines in the past (a few years back).
They were caused by different video cards and drivers.
Either the NVideo or the ATI ones were getting the wrong results, but I forgot which ones.
It could be reproduced on both laptops and regular PC's.
So: what video cards and drivers do you use?
--jeroen
I would explicitly set the bitmap format to pf32bit for each bitmap you create to ensure the problem isnt converting colors from 32 to 16 bit (if thats the native video resolution of the bitmaps getting created), which might interfere with how the transparency works. Also, I've had better luck specifically setting the transparency color in the past.
Another option - perhaps a better one in the long run, is to instead set the Alpha Channel on the images (ie, use PNG files), and use the GDI function AlphaBlend() to draw the graphics.
I have an old program written in borland pascal and in Delphi if I use the Form1.Canvas.LineTo and MoveTo functions I get a flickering effect. Can anyone tell me how to get rid of the flickering?
Try to set DoubleBuffered to true in Form.OnCreate.
A general technique for reducing flicker in animated graphics operations is called double buffering. The idea is that you do all drawing to an offscreen bitmap, then when you've finished rendering the whole scene, copy the entire bitmap to the visible display.
The term also relates to hardware-supported techniques such as the ability to exchange the whole video display buffer with an alternate one, which is used in dedicated systems like console video games.
Although using double buffering is usually the best solution, it is not always the right solution, and definitely not the most memory saving solution. However if you only draw a part of the image, I'd go with that solution as well setting DoubleBuffered to true as mentioned in the other comments.
However if you fill the entire components area every time you draw anyway, you might want to choose a different approach. If you set the ControlStyle to csOpaque you'll avoid having the component erase the background, and thereby removing a source of the flickering, without having to double buffer. This of course requires you to draw on the entire component area, so the solution is only really suitable if you do.
In general however if memory consumption is of no importance, I'd go for the double buffering as well, I just wanted to supply you with an alternative. :)
Easy code sample on the double buffering.
Create Buffer ( TBitmap )
Draw on the Buffer canvas.
Draw the bitmap on the canvas. Form1.Canvas for example.
Buffer := TBitmap.Create;
try
Buffer.Width:=Form1.Width;
Buffer.Height:=Form1.Height;
//clearBuffer
Buffer.Canvas.FillRect(Buffer.Canvas.ClipRect);
//draw Something
Buffer.Canvas.TextOut(0,0,'Hello World');
Buffer.Canvas.Rectangle(0,1,2,3);
//drawBuffer on canvas
Form1.Canvas.Draw(0,0,Buffer);
finally
Buffer.free
end;
Double Buffering is one way but not always sufficient. Imagine you paint a shape at runtime, it depends on your repaint method. Forces the control to repaint its image on the screen could be crucial.
Call Repaint to force the control to repaint its image immediately. If the ControlStyle property includes csOpaque, the control paints itself directly.
So double buffering plus invalidate and [csOpaque] as controlstyle could be an improvement:
var Compass: TPaintBox;
procedure TForm1ForceRepaint(Sender: TObject);
{Called when display type or compass angle changes}
begin
compass.controlstyle:= [csOpaque];
while heading.value<0 do heading.Value:=heading.Value+360;
while heading.value>360 do heading.Value:=heading.Value-360;
compass.Invalidate;
end;
In my case, none of the above-mentioned solutions really worked. I have two graphics which are overlaying one on another. The change of the DoubleBuffered property has solved the flickering problem, but the background graphics was not correctly rendered.
After a small research, I have found two alternative fixes described on page https://delphi-bar.blogspot.com/2012/11/prevent-screen-refresh-and-flickering.html.
LockWindowUpdate(Handle);
try
// Code goes here
finally
LockWindowUpdate(0);
end;
As discussed for example here, it is not always a recommended way. The second option, in my case, has fixed almost completely the flicker problem:
SendMessage(Handle, WM_SETREDRAW, WPARAM(False), 0);
try
// Code goes here
finally
SendMessage(Handle, WM_SETREDRAW, WPARAM(True), 0);
RedrawWindow(Handle, nil, 0, RDW_ERASE or RDW_FRAME or RDW_INVALIDATE or RDW_ALLCHILDREN);
end;