This code works on the PngImage component (from G.Daud). Now it doesn't compile after PngImage is replaced with PngComponents for D7 (http://code.google.com/p/cubicexplorer/downloads/list).
function Bmp32ToPng(bmp: TBitmap): TPngObject;
var
x, y: integer;
src, dst: PngImage.pByteArray;
begin
Result:= nil;
if bmp.PixelFormat<>pf32bit then
Exit;
Result:= TPngObject.CreateBlank(COLOR_RGBALPHA, 8, bmp.Width, bmp.Height);
Result.Canvas.Draw(0, 0, bmp);
for y:= 0 to bmp.Height-1 do begin
src:= bmp.ScanLine[y];
dst:= Result.AlphaScanLine[y];
for x:= 0 to bmp.Width-1 do
dst[x]:= src[x*4+3];
end;
end;
The Createblank method does not exist in PngComponents. It can't be replaced with a simple Create then setting Width/height. Width/height are R/O in PngComponents.
How to convert 32bpp BMP (e.g. got from shell32.dll) to PNG?
GraphicEx and PngComponents and pngimage are conflicting. To solve it:
1) always put them in uses clause in specific order - first - GraphicEx or PngComponents, last - pngimage.
2) build Project. It is not enough to run (or compile) project after uses clause was changed.
PS) pngimage installed with PNGcomponent package, BUT this version is outdated
Related
Follwing on:
How to load large bitmap in FMX (fire monkey)
I have come to a need to draw whats on TBitmapSurface on the FMX.Graphics.TBitmap, i have found a lot of answer regarding this on the web, but they are either in VLC instead of FMX or their goal is saving and loading instead of drawing on a TBitmap, which is why i asked a new question here.
Now here is my current code for loading my image on the TBitmapSurface :
var
bitmapSurf: TBitmapSurface;
path: string;
begin
path := 'image.jpg';
bitmapSurf := TBitmapSurface.Create;
TBitmapCodecManager.LoadFromFile(path, bitmapSurf);
end;
Now after searching for a bit i found that i can use Scanline on the TBitmapSurface, but i didn't know how to use it to draw on the TBitmap, on the web some people had used TBitmap.canvas.draw, but such a thing doesn't exist on the FMX!.
In the end my goal is to draw a very large image (1000*16000) which is loaded in the TBitmapSurface on more then 1 TBitmap (because TBitmap doesn't support more then 8192px and my height is 16000px, i need to draw this on two TBitmap).
I am using Delphi 10.2.3.
Thanks.
You can split the large image (from a file) to two TImage components as follows
Load the image from file to a TBitmapSurface as you already do in your code.
Then create another TBitmapSurface and set its size to the half of the large one. Copy the first half of the large image to this surface and assign it to Image1.Bitmap. Then copy the latter half to this surface and assign that to Image2.Bitmap.
var
srce, dest: TBitmapSurface;
path: string;
scan: integer;
w, h1, h2: integer;
begin
path := 'C:\tmp\Imgs\res.bmp';
srce := TBitmapSurface.Create;
try
TBitmapCodecManager.LoadFromFile(path, srce);
dest := TBitmapSurface.Create;
try
// first half
w := srce.Width;
h1 := srce.Height div 2;
dest.SetSize(w, h1, TPixelFormat.RGBA);
for scan := 0 to h1-1 do
Move(srce.Scanline[scan]^, TBitmapSurface(dest).Scanline[scan]^, srce.Width * 4);
Image1.Bitmap.Assign(dest);
// second half
h2 := srce.Height - h1;
dest.SetSize(w, h2, TPixelFormat.RGBA);
for scan := h1 to srce.Height-1 do
Move(srce.Scanline[scan]^, TBitmapSurface(dest).Scanline[scan-h1]^, srce.Width * 4);
Image2.Bitmap.Assign(dest);
finally
dest.Free;
end;
finally
srce.Free;
end;
I need a e method which compares content of two files together, files can be BMP, JPEG, PNG, TIF
I tried this
procedure TForm1.Button1Click(Sender: TObject);
var
f1, f2 : TFileStream;
Bytes1: TBytes;
Bytes2: TBytes;
i: integer;
s: booleAN;
begin
f1 := TFileStream.Create('C:\Output\Layout 1.JPG' , fmOpenRead);
f2 := TFileStream.Create('C:\Data\Layout 1.JPG' , fmOpenRead );
if f1.Size <> f2.Size then
begin
ShowMessage('size');
exit;
end;
SetLength(Bytes1, f1.Size);
f1.Read(Bytes1[0], f1.Size);
SetLength(Bytes2, f2.Size);
f2.Read(Bytes2[0], f2.Size);
s:= true;
for I := 1 to length(Bytes1) do
begin
if Bytes1[i] <> Bytes2[i] then
begin
s := false;
Exit;
end;
end;
if s then
ShowMessage('same');
end;
but this is not working fine for me my files are both the same in content but their size are different in 2 byte.
one of the files is the on that I have to give to user the other one is the files that user is opening the same file and make a copy of it, so why they are 2 byte different i have no idea but they should be away to compare content of these files
The code has one error. Dynamic arrays are zero based so the loop should be:
for I := 0 to high(Bytes1) do
The code is very inefficient. It should not read all the content at once. And you should use CompareMem to compare blocks of memory.
You say that the files have different size, but you expect them to compare equal. Well, that makes no sense. Your code explicitly checks that the sizes match, as it should.
Opening and reading a JPEG file will modify the content because JPEG is a lossy compression algorithm.
Your subject suggests that you wish to compare PowerPoint files but the files are in fact JPEG images.
If you are going to compare JPEGs you probably need to include a range, something like
Const
DELTA = 2 ;
if (Bytes1[i] - Bytes2[i] > DELTA) OR (Bytes1[i] - Bytes2[i] < -DELTA) then
In Delphi I have an unknown number of image file names stored in a details table. These image files can be Bitmaps, Jpegs, PNGS and ICO files.
What's the paradigm / best practice to load and display those in a listview or a listbox on the go?
I take it I would somehow need to load those to a ImageList in OnBeforeScroll event of a master table and then assign that to a listview. Database components used are dbGO.
I only need to display thumbnails of predefined size (in a VCL program).
The simplest method is to use TPicture, since the loading of different graphic formats is already implemented and you do have to care about different image classes .
You have to ensure that the required units are included in the with uses so here e.g. jpeg, gifimg, and pngimg.
After loading with TPicture.LoadFromFile the images are painted, centered and scaled, on a prepared Bitmap with the dimensions of the Imagelist.
Last step is simply to call teh AddBitmap procedure with the Bitmap and nil for the mask.
// make sure you included the needed units
// uses pngImage,jpeg,gifimg;
Procedure LoadImagesFromDataset2ImageList(il: TImageList; DS: TDataset; const FileFieldname: String);
var
P: TPicture;
bmp: TBitmap;
Function CalcRectAndPrepare: TRect; // calculate Rect for here centered/streched output
var // and fill the bitmap with the desired beckground color
f: Double;
begin
bmp.Canvas.Brush.Color := clWhite;
bmp.Canvas.FillRect(Rect(0, 0, bmp.Width, bmp.Height));
if P.Width > P.Height then
f := bmp.Width / P.Width
else
f := bmp.Height / P.Height;
Result.Left := Round(bmp.Width - P.Width * f) div 2;
Result.Top := Round(bmp.Height - P.Height * f) div 2;
Result.Right := bmp.Width - Result.Left;
Result.Bottom := bmp.Height - Result.Top;
end;
begin
P := TPicture.Create;
bmp := TBitmap.Create;
try
bmp.Width := il.Width;
bmp.Height := il.Height;
DS.First;
while not DS.Eof do
begin
if FileExists(DS.Fieldbyname(FileFieldname).asString) then
begin
P.LoadFromFile(DS.Fieldbyname(FileFieldname).asString);
bmp.Canvas.StretchDraw(CalcRectAndPrepare, P.Graphic);
il.Add(bmp, nil);
end;
DS.Next;
end;
finally
P.Free;
bmp.Free;
end;
end;
"Unknown number" sounds like there may be a huge number of images. So pre-rendered thumbnails would be very helpful. If your application can create thumbnails for all images and keep them in a separate database this would reduce the CPU resource usage for shrinking them. And you could reference the thumbnail database from your master database.
One thing I would check if RAM could be a limitation is how many instances of the actual thumbnail will be created in your application, for example if you load 1000 database records which all refer to the same thumbnail, does the database access component allocate 1000 image objects (using 1000 times more RAM than needed) or only one, which is referenced 1000 times. Also the de-allocation of the image data is important.
I have discovered that animated GIFs created using Delphi 2009's TGIFImage sometimes doesn't play correctly in some GIF viewers. The problem is that the animation is restarted prematurely.
Consider the following example:
program GIFAnomaly;
{$APPTYPE CONSOLE}
uses
Windows, Types, Classes, SysUtils, Graphics, GIFImg;
var
g: TGIFImage;
bm: TBitmap;
procedure MakeFrame(n: integer);
var
x: Integer;
y: Integer;
begin
for x := 0 to 256 - 1 do
for y := 0 to 256 - 1 do
bm.Canvas.Pixels[x, y] := RGB((x + n) mod 255,
(x + y - 2*n) mod 255, (x*y*n div 500) mod 255);
end;
var
i: integer;
begin
bm := TBitmap.Create;
bm.SetSize(256, 256);
g := TGIFImage.Create;
g.Animate := true;
for i := 0 to 499 do
begin
MakeFrame(i);
TGIFGraphicControlExtension.Create(g.Add(bm)).Delay := 3;
Writeln('Creating frame ', i+1, ' of 500.');
end;
TGIFAppExtNSLoop.Create(g.Images.Frames[0]).Loops := 0;
g.SaveToFile('C:\Users\Andreas Rejbrand\Desktop\test.gif');
end.
(This is the simplest example I could find that exhibits the problem.)
The output is a rather large animated GIF. In Internet Explorer 11, the entire 15-second 'movie' is played properly, but in Google Chrome the 'movie' is prematurely restarted after only about four seconds.
Why is this?
Is there something wrong with the output GIF file?
If so, is there something wrong with my code above, or is there a problem with GIFImg?
If not, what is the nature of the problem in the viewer? What fraction of the available viewers have this problem? Is there a way to 'avoid' this problem during GIF creation?
For the benefit of the SO user, the above code is a minimal working example. Of course, I wasn't creating these psychedelic patterns when I discovered the issue. Instead, I was working on a Lorenz system simulator, and produced this GIF animation which does play in IE but not in Chrome:
In Internet Explorer 11, the model is rotated 360 degrees before the animation is restarted. In Google Chrome, the animation is restarted prematurely after only some 20 degrees.
The Lorenz image works in Internet Explorer 11.0.9600.17239, The GIMP 2.8.0, Opera 12.16
The Lorenz image does not work in Google Chrome 36.0.1985.143 m, Firefox 26.0, 27.0.1, 31.0.
If I open a 'problematic' GIF in The GIMP and let GIMP (re)save it as an animated GIF, the result works in every viewer. The following is the GIMPed version of the Lorenz animation:
Comparing the two files using a hex editor, and using the Wikipedia article as a reference, it seems, for instance, like the 'NETSCAPE' string is at the wrong place in the original (unGIMPed) version. It is somewhat strange, that even if I set the width and height of the GIF image, the corresponding values in the Logical Screen Descriptor are not there.
It's a bug in TGIFImage's LZW encoder.
In some very rare circumstances the LZW encoder will output an extra zero byte at the end of the LZW steam. Since the LZW end block marker is also a zero byte, a strict GIF reader might choke on this or interpret it as the end of the GIF (although the end of file marker is $3B).
The reason some GIF readers can handle this is probably that GIFs with this problem was common many years ago. Apparently TGIFImage wasn't the only library to make that particular mistake.
To fix the problem make the following modification to gifimg.pas (change marked with *):
procedure TGIFWriter.FlushBuffer;
begin
if (FNeedsFlush) then
begin
FBuffer[0] := Byte(FBufferCount-1); // Block size excluding the count
Stream.WriteBuffer(FBuffer, FBufferCount);
FBufferCount := 1; // Reserve first byte of buffer for length
FNeedsFlush := False; // *** Add this ***
end;
end;
Edit: This turned out not to be the answer but I'm keeping it as the rule about the loop extension still applies.
The NETSCAPE loop extension must be the first extension:
var
Frame: TGIFFrame;
...
for i := 0 to 499 do
begin
MakeFrame(i);
Frame := g.Add(bm);
if (i = 0) then
TGIFAppExtNSLoop.Create(Frame).Loops := 0;
TGIFGraphicControlExtension.Create(Frame).Delay := 3;
Writeln('Creating frame ', i+1, ' of 500.');
end;
See: The TGIFImage FAQ.
Apart from that I see nothing wrong with your GIF, but you could reduce the size a bit with a global color table.
How to draw Unicode text on TCustomControl? Are there other options to make it without the Canvas?
Yes, you are right on spot. Still, I would recommend you to upgrade to Delphi 2009 or later in which the VCL has full Unicode support and everything is much easier.
Anyhow, you can do
procedure TMyControl.Paint;
var
S: WideString;
r: TRect;
begin
inherited;
r := ClientRect;
S := 'This is the integral sign: '#$222b;
DrawTextW(Canvas.Handle, PWideChar(S), length(S), r, DT_SINGLELINE or
DT_CENTER or DT_VCENTER or DT_END_ELLIPSIS);
end;
in old versions of Delphi (I think. The code compiles in Delphi 7 in my virtual Windows 95 machine, but I see no text. That is because Windows 95 is too old, I think.)
Update
If you want to support very old operating systems, like Windows 95 and Windows 98, you need to use TextOutW instead of DrawTextW, since the latter isn't implemented (source). TextOut is less powerful then DrawText, so you need to compute the position manually if you want to center the text inside a rectangle, for instance.
procedure TMyControl.Paint;
var
S: WideString;
begin
inherited;
S := 'This is the integral sign: '#$222b;
TextOutW(Canvas.Handle, 0, 0, PWideChar(S), length(S));
end;