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.
Related
I'm trying to draw a simple image with OnPaint method. The code compiles just fine, but when the application starts, it shows "Object lock not owned" error and nothing else happens. Could you please tell me what mistake I made? The code shows the OnPaint event I'm using. Thank you all for your help.
procedure TTabbedForm.Image1Paint(Sender: TObject; Canvas: TCanvas;
const ARect: TRectF);
var
p1, p2, p3, p4, p5, p6: TPointF;
prst1: TRectF;
i :Integer;
begin
Image1.Bitmap.Canvas.Stroke.Color := TAlphaColors.Black;
Image1.Bitmap.Canvas.Stroke.Thickness := 3;
p1 := TPointF.Create(PX, PY);
Image1.Bitmap.Canvas.BeginScene;
with TabbedForm do begin
for i := 0 to 360 do
if (i mod 15)=0 then
begin
p2 := TPointF.Create(Round(PX+PP*sin(i*pi/180)), Round(PY+PP*cos(i*pi/180)));
Image1.Bitmap.Canvas.DrawLine(p1, p2, 100);
end;
for i := 0 to PP do
if (i mod 20)=0 then
begin
prst1 := TRectF.Create(PX+i,PY+i,PX-i,PY-i);
Image1.Bitmap.Canvas.DrawEllipse(prst1, 100);
end;
for i := 0 to 400 do
if (i mod 20)=0 then
begin
p3 := TPointF.Create(i,2*PP);
p4 := TPointF.Create(i,2*PP+2*PP);
Image1.Bitmap.Canvas.DrawLine(p3, p4, 100);
end;
for i := 0 to 400 do
if (i mod 20)=0 then
begin
p5 := TPointF.Create(0,2*PP+i);
p6 := TPointF.Create(2*PP+2*PP,2*PP+i);
Image1.Bitmap.Canvas.DrawLine(p5, p6, 100);
end;
Image1.Bitmap.Canvas.EndScene;
end;
end;
The error message "Object lock not owned" is the message of EMonitorLockException, which is documented to be raised "whenever a thread tries to release the lock on a non-owned monitor". Since you have not responded to my request for an MCVE, and I have not been able to reproduce this error, I can not confirm whether it is due to an unsuccessful lock aquisition through Canvas.BeginScene, or something else.
You can use either a TImage or a TPaintBox for your drawing. Using a TImage provides many benefits such as directly loading an image file, drawing on that image and saving your image to a file directly in various formats, like .bmp, .jpg or .png (maybe others too). A TPaintBox is more lightweight and doesnt have an own bitmap, but uses the parent components surface to draw on (therefore the need for an OnPaint() handler). Loading from / saving to file must be done e.g. through a separate TBitmap.
So yes, you may continue to use a TImage control if you want, but in that case, do not use the OnPaint event for the drawing as you are now. A TImage has a built in mechanism to paint itself when needed. You only need to draw your drawing once to the built-in bitmap canvas. In the following code the image is drawn in a ButtonClick() event. Also note, that with the TImage you must use BeginScene - EndScene correctly as documented.
You must also set the TImage.Bitmap.Size before drawing on it. If this was not set elsewhere in your code of what you have shown, then that may be another reason why your code produced no image.
Draw your image on Image1.Bitmap.Canvas e.g. in a OnClick() event of a button:
procedure TTabbedForm.Button1Click(Sender: TObject);
var
p1, p2, p3, p4, p5, p6: TPointF;
prst1: TRectF;
i: integer;
begin
Image1.Bitmap.SetSize(300, 300); // must be set before call to BeginScene
if Image1.Bitmap.Canvas.BeginScene then
try
Image1.Bitmap.Canvas.Stroke.Color := TAlphaColors.Black;
Image1.Bitmap.Canvas.Stroke.Thickness := 1;
p1 := TPointF.Create(px, py);
for i := 0 to 360 do
if (i mod 15) = 0 then
begin
pp := i;
p2 := TPointF.Create(Round(px + pp * sin(i * pi / 180)),
Round(py + pp * cos(i * pi / 180)));
Image1.Bitmap.Canvas.DrawLine(p1, p2, 100);
end;
for i := 0 to pp do
...
for i := 0 to 400 do
...
for i := 0 to 400 do
....
finally
Image1.Bitmap.Canvas.EndScene;
end;
end;
I think you get this error message, because you're drawing on the canvas at a time when you're not allowed to. Potential causes for this are:
You're drawing on the bitmap of the image from the paint event of the image. Images are for displaying pre-generated or loaded bitmaps, and since modifying the bitmap should trigger the OnPaint event, I think it's a bad idea to make those changes from that same event. It's asking for an endless loop, or other unwanted side effects.
You're using BeginScene/EndScene incorrectly. You should only proceed drawing if BeginScene returns true. And actually it's not needed to call them at all when drawing on the given canvas of a paint event.
You're (partially) using a global instance of the form instead of the current instance (Self), which could (depending on your application), lead to drawing on the wrong instance.
Small disclaimer: I left your code as-is as much as possible, just changed the things that I think could potentially cause your problem. I think these changes all make sense, but I must admit I've never done much painting in FMX, so maybe some of these are a bit naive or over-protective (or blatantly wrong).
Things that are different in this code compared to yours:
Use a TPaintbox (you'll have to add a TPaintbox named 'Paintbox1', and add this method to it's OnPaint handler). Paintboxes are for direct drawing. You could also keep the image, if you would be able to pre-render the image's bitmap on specific events, like the start of your application, a click of a button, a timer, and so on.
Correct use of BeginScene and EndScene, with an if and a try..finally block. BeginScene will give you a lock or not, and return a boolean depending on the success. You should only proceed if you actually acquired the lock, and only call EndScene in that case too, because they are ref counted, and doing this wrong could screw up the refcount, and therefor all further painting in your application.
Stroke settings inside the scene as well. Not 100% sure if needed, but I guess it's part of drawing the scene too, right?
Left out BeginScene..EndScene completely. The Paintbox or Image control should already have called that itself. See FMX.Graphics.TCanvas.BeginScene docs
Just use Canvas. It's passed as a parameter to the event handler, so better to use that, then to try and find the right canvas yourself.
Removed the with. This is a bit of a long shot, but it looked like you were referring to a global TTabbedForm variable, and since you are inside a TTabbedForm method, you should be able to use the properties and methods of the current instance as-is, or prepend with Self. if you run into naming conflicts. It's always better to not rely on those globals for forms and datamodules, and you'll actually run into problems if you want to have multiple instances of your form, in which case your original code would partially operate on the wrong instance.
procedure TTabbedForm.Paintbox1Paint(
Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
var
p1, p2, p3, p4, p5, p6: TPointF;
prst1: TRectF;
i :Integer;
begin
p1 := TPointF.Create(PX, PY);
Canvas.Stroke.Color := TAlphaColors.Black;
Canvas.Stroke.Thickness := 3;
for i := 0 to 360 do
if (i mod 15)=0 then
begin
p2 := TPointF.Create(Round(PX+PP*sin(i*pi/180)), Round(PY+PP*cos(i*pi/180)));
Canvas.DrawLine(p1, p2, 100);
end;
for i := 0 to PP do
if (i mod 20)=0 then
begin
prst1 := TRectF.Create(PX+i,PY+i,PX-i,PY-i);
Canvas.DrawEllipse(prst1, 100);
end;
for i := 0 to 400 do
if (i mod 20)=0 then
begin
p3 := TPointF.Create(i,2*PP);
p4 := TPointF.Create(i,2*PP+2*PP);
Canvas.DrawLine(p3, p4, 100);
end;
for i := 0 to 400 do
if (i mod 20)=0 then
begin
p5 := TPointF.Create(0,2*PP+i);
p6 := TPointF.Create(2*PP+2*PP,2*PP+i);
Canvas.DrawLine(p5, p6, 100);
end;
end;
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
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
I am trying to convert a bitmap file to rtf using Delphi 2007.
I used below code for conversion.
function BitmapToRTF(pict: TBitmap): string;
var
bi, bb, rtf: string;
bis, bbs: Cardinal;
achar: ShortString;
hexpict: string;
I: Integer;
begin
GetDIBSizes(pict.Handle, bis, bbs);
SetLength(bi, bis);
SetLength(bb, bbs);
GetDIB(pict.Handle, pict.Palette, PChar(bi)^, PChar(bb)^);
rtf := '{\rtf1 {\pict\dibitmap0 ';
SetLength(hexpict, (Length(bb) + Length(bi)) * 2);
I := 2;
for bis := 1 to Length(bi) do
begin
achar := Format('%x', [Integer(bi[bis])]);
if Length(achar) = 1 then
achar := '0' + achar;
hexpict[I - 1] := achar[1];
hexpict[I] := achar[2];
Inc(I, 2);
end;
for bbs := 1 to Length(bb) do
begin
achar := Format('%x', [Integer(bb[bbs])]);
if Length(achar) = 1 then
achar := '0' + achar;
hexpict[I - 1] := achar[1];
hexpict[I] := achar[2];
Inc(I, 2);
end;
rtf := rtf + hexpict + ' }}';
Result := rtf;
end;
Now my problem is i was not able to view the image in MS Word or Viewer.
But i can view the image in word pad.
Please suggest me in solving this problem.
I think the problem is that the Word implementation for RTF rendering asks for more information than the Wordpad's one (I think that for security reasons -avoid overflow attacks-), but this is pure speculation I must confess.
Try being accurate when describing your bitmap info: for example if the bitmap is 32-bit use \wbmbitspixel32, put the width and height in your rtf encoding with \picw and \pich, etc. May be you have luck with that.
Here is an example of this:
http://www.scribd.com/doc/25967552/Rtf1-Ansi-Ansicpg1252-Uc2-Deff0-Deflang1033-Fonttbl-f0-Froman-Fcharset0-Fprq2-Panose-02020603050405020304-Times-New-Roman-f1-Fswiss-Fchar
How can you convert an image to a textfile?
RTF is RichtTextFormat i guess?
I would take the bmp and put it with the Microsoft Word API into a Document and save the document was rtf.
Tobi
If you want to view the image in MS Word or Word Viewer, convert the image to EMF file and embed it inside the RTF tags. (Note: here you cant view the image in Wordpad)
{\rtf1 {\pict\emfblif <emf source> }}
If you want to view the image in Wordpad, convert the image into bitmap and embed it inside the RTF tags.
{\rtf1 {\pict\dibitmap0 <bitmap source> }}
I dont know why this happens.