Save ImageEnView and a Label on it as Png in delphi - delphi

I Put a TImageEnView on my form and put a Label on the TImageEnView.
I want to save this parent and child as one Png or Jpg on my hard drive.
I write this code :
CharLbl.Font.Size := I;
CharLbl.Top:=22;
ImageEnIO1.SaveToFile('D:\output2.png'); // Save in thread 2
ImageEnIO1.WaitThreads(false);
ShowMessage(inttoStr(I));
But the output is only background with out Label. How can I save the label as well?

Try the following:
var
paintbmp:tbitmap;
begin
paintbmp:=tbitmap.Create;
try
paintbmp.Width:=ImageEnIO1.Width;
paintbmp.Height:=ImageEnIO1.Height;
paintbmp.Canvas.Draw(0,0,ImageEnIO1.Picture.Graphic);
paintbmp.Canvas.CopyRect(rect(0,0,ImageEnIO1.Width,ImageEnIO1.Height)
,CharLbl.Canvas
,rect(0,0,ImageEnIO1.Width,ImageEnIO1.Height));
paintbmp.SaveToFile('D:\output2.png');
finally
paintbmp.Free;
end;
end;
Just be careful in order for this to give you what you want the size of the label is to be the same as the image's and the top and left is the same as the image's.
Note: I would still recommend you to see the link I gave you in comments, because it will aid you to learn a valuable tool that would even enable you to write your own component in the future.
Note 2: The output image is not a valid PNG it is still a Bitmap so you still need to convert it.(thanks to Kobik)

Related

Why did CopyRect Flipped the second image in delphi 10.3?

I want to take a screenshot of my page and put the result into a bitmap, Because there is a scrollbar on the page, i have to take several screenshots, and i want to merge those bitmaps.
if have used this code to make a screenshot and save it: Take a screenshot of a particular area in Delphi 7
i used the code to merge them from this page http://www.delphigroups.info/2/8/309463.html
if i copied it directly it would result in the first image being used, and i white rectangle for the second. so i tried to change it a little bit, and now i'm getting both images in one file.
This is the code i use to concatenate the bitmaps:
function ConcatenateBitmaps(const MainBitmap: TBitmap; const BitmapToAdd:
TBitmap): TBitmap;
begin
Result := MainBitmap;
If BitmapToAdd.Width > MainBitmap.Width then
Result.Width := BitmapToAdd.Width;
Result.Height := MainBitmap.Height + MainBitmap.Height;
Result.Canvas.CopyRect(
Rect(0,MainBitmap.Height,BitmapToAdd.Width,BitmapToAdd.Height),
BitmapToAdd.Canvas,
Rect(0,0,BitmapToAdd.Width,BitmapToAdd.Height)
);
end;
The problem is that te second image is being flipped, vertical and horizontal;
What am i doing wrong here?
EDIT:
An example of the result, the first image is good, the second image is flipped:
as i see now, my description was wrong, it's horizontaly mirrored, and verticaly flipped
Cause and quickfix:
The problem is in this part:
Rect(0,MainBitmap.Height,BitmapToAdd.Width,BitmapToAdd.Height)
You make a rectangle of which the top is the total height of the resulting image, and the bottom is the height of the bitmap to add. So this rectangle is basically inverted (its bottom is above its top).
And it's likely deformed as well, since the height of this rectangle is not the height of the bitmap to add.
The quickfix would be:
Rect(0,Result.Height- BitmapToAdd.Height,BitmapToAdd.Width,Result.Height)
Other issues and confusion:
But I think the cause of your confusion is because you think that Result and MainBitmap are two different bitmaps, while actually they are both references to the same bitmap. The assignment you do in the beginning just copies the reference, not the actual TBitmap object.
In addition, you mix up 'height' and 'bottom'. TRect expects you to set top and bottom coordinates, not top and height. This, together with the previous issue, causes not only that the bitmap is upside down, but also that it will be stretched, and partially covering the previous images. The more images you add, the more clear that effect will be.
Personally I think it's way more efficient to modify the existing bitmap in this scenario, mainly because you would otherwise have to clean up your old bitmap all the time, plus that you have a function that magically creates bitmaps. You get the question of ownership of the bitmap objects, and with that, the risk of memory leaks, which is not good, especially when dealing with large bitmaps.
My suggested version:
So, I would just make it a procedure, where the first bitmap is modified by adding the second bitmap to it.
In the version below, I also used Canvas.ClipRect, which is for a bitmap essentially the bounding rectangle of the bitmap. And then I used OffsetRect to 'move' this rectangle(increasing its top Y and bottom Y).
By doing this in a separate variable, you can have a relatively clean version compared to the quick fix I presented above, because you can use the dimensions of MainBitmap before actually modifying it.
procedure AppendBitmap(const MainBitmap: TBitmap; const BitmapToAdd:
TBitmap);
var
TargetRect: TRect;
begin
// Widen the main bitmap if needed
if BitmapToAdd.Width > MainBitmap.Width then
MainBitmap.Width := BitmapToAdd.Width;
// Set TargetRect to the right size
TargetRect := BitmapToAdd.Canvas.ClipRect;
// And then to the right position
OffsetRect(TargetRect, 0, MainBitmap.Height);
// Make room for the bitmap to add
MainBitmap.Height := MainBitmap.Height + BitmapToAdd.Height;
// Draw it in the created space
MainBitmap.Canvas.CopyRect(
TargetRect,
BitmapToAdd.Canvas,
BitmapToAdd.Canvas.ClipRect
);
end;
And if you like, you can make a wrapper function with the signature of the original, that creates a copy of the main image and returns that. Note though, that MainBitmap and the result of this function are no longer the same bitmap, and you have to make sure to properly free both of them when you're done.
function ConcatenateBitmaps(const MainBitmap: TBitmap; const BitmapToAdd:
TBitmap): TBitmap;
begin
Result := TBitmap.Create;
Result.Assign(MainBitmap);
AppendBitmap(Result, BitmapToAdd);
end;
PS: I like questions like this from which I learn something. I never realized you could flip an image by flipping the rect passed to CopyRect. :D

Delphi graphics32 saving layers as transparent PNG goes wrong

I am having a strange problem, and I do not think I can solve it.
I have an ImgView containing layers (transparent png images) and I intend to save all the layers as png files (like a "Save Project" thing), so that later on I can re-open them and place them where I left them. (like an "Open Project" thing)
This is my problem, following steps work just fine:
I add layers (transparent PNG files)
I move them around and place them where I want them
I press save project (so here I save all layers as png image files)
It works
If I do the next following steps, something goes wrong:
I add layers (transparent PNG files)
I move them around and place them where I want them
I change the location of the layers (as in: send to back one layer for example) (so this step is different)
I press save project (so here I save all layers as png image files)
It crashes with "Access violation at address 005380FB in module 'MyApp.exe'. Read of address 000000C0"
Right now it only gives me the above error, but a few runs ago, it pointed me to this line:
procedure TCustomBitmap32.ResetAlpha(const AlphaValue: Byte);
var
I: Integer;
P: PByteArray;
begin
if not FMeasuringMode then <<<<<------ this line
So if I change the index of layers... I cannot save them anymore as PNG ?!?!?!
Here is my save procedure:
for i:=0 to mainForm.ImgView.Layers.Count-2 do
begin
mylay := TBitmapLayer(mainForm.ImgView.Layers.Items[i]);
SaveBMPAsPng(mylay.Bitmap,'C:\MyApp\tmp\'+getLayerPan(i)+'.png');
end;
// where getLayerPan is a function that retrieves a name that I gave to the layer
... and
procedure SaveBmpAsPng(bmp:TBitmap32;dest:string);
var
Y: Integer;
X: Integer;
Png: TPortableNetworkGraphic32;
function IsWhite(Color32: TColor32): Boolean;
begin
Result:= (TColor32Entry(Color32).B = 255) and
(TColor32Entry(Color32).G = 255) and
(TColor32Entry(Color32).R = 255);
end;
begin
bmp.ResetAlpha;
for Y := 0 to bmp.Height-1 do
for X := 0 to bmp.Width-1 do
begin
if IsWhite(bmp.Pixel[X, Y]) then
bmp.Pixel[X,Y]:=Color32(255,255,255,0);
end;
Png:= TPortableNetworkGraphic32.Create;
Png.Assign(bmp);
Png.SaveToFile(dest);
Png.Free;
end;
What could be wrong?
Please help...
EDIT
I think I discovered my problem...
When I move the layers around, the only way (that I know of) to do it clean, is to load all layers into an imagelist (TBitmap32List was my choice at that moment) and after that clean the layers and re-add them from the imagelist to my ImageView in the desired order.
I can only assume that this is where something goes wrong.
It must be because in the layers I have transparent PNGs, and when I load them into the Bitmap32List, I load them as BMPs.
I must look for another way of reorganizing my layers before going any further. I will update you with my solution. If any of you know of a better way of reordering layers in ImageView32, please let me know.
EDIT
So, please observe in the image bellow that the GUI is done, and working. I have the panels representing the layers, I can move them around (as you may see in the image I am dragging layer 'Elementul 0' and movin it up in the chain).
And I repeat, my logic also works when I use temporary files for moving layers up or down in the order. One of the answers suggested that I should just use the Index property to change a layers position in the layers hierarchy, and I am saying that it cannot be done without at least adding new layers to the image. So this is not a double question. It is just a response to one of the answers I received.
Thank you
Your problem is a lot simpler than you might think. Working with layers comes natural:
Send to back
Set the layer's index to 0 or simply call SendToBack. All layers previously before it will have their index increased by 1. All layers previously after it remain at the same position.
Send backward
Decrease the layer's index by 1. The layer previously before it will now come after it, thus has its index increased by one.
Send forward
Increase the layer's index by 1. The layer previously after it will now come before it, thus has its index decreased by one.
Send to front
Set the layer's index to the number of layers minus 1. The layers previously after it have their increased decreased by one.
Hence there is absolutely no need to touch the bitmap, save to disk it to disk, or use any kind of temporary layers to change the order. In virtually every case, the right thing happens when you just set the index of the layer to the position (counting from 0, back to front) you want it to appear at. After moving a panel in your list, you could set the corresponding layer's index to the new index of the panel in the list. However, because the panel is ordered front to back and GR32 orders back to front, you need to translate the index of the panel to the desired index of the layer.
Here's an example how to do that with a TListBox and a TButton:
procedure TForm1.SendBackwardButtonClick(Sender: TObject);
var
LNewListBoxItemIndex: Integer;
begin
// Calculate the new list index and make sure it's valid
LNewListBoxItemIndex := Max(0, Min(ListBox1.ItemIndex + 1, ListBox1.Items.Count - 1));
// Transform the current and new list indices and use them to move the layer
ImgView321.Layers[ListBox1.Items.Count - 1 - ListBox1.ItemIndex].Index :=
ListBox1.Items.Count - 1 - LNewListBoxItemIndex;
// Move the list item
ListBox1.Items.Move(ListBox1.ItemIndex, LNewListBoxItemIndex);
// Preserve the selection (if applicable)
ListBox1.ItemIndex := LNewListBoxItemIndex;
end;
You may also decide to fully synchronize the list with the layers. In that case you should associate each item (possibly TPanel) with a layer.
// Create layers from front to back
LLayer := TBitmapLayer.Create(ImgView321.Layers);
ListBox1.Items.AddObject('First layer', LLayer);
// Could use LPanel := TPanel.Create(...); LPanel.Tag := Integer(Pointer(LLayer)) instead
LLayer := TBitmapLayer.Create(ImgView321.Layers);
ListBox1.Items.AddObject('Second layer', LLayer);
// Now the list is correct but the layers are not in the right order.
// Use the code listed below whenever you need to synchronize the layers
// with the list. In theory it may be slow (O(n^2)) but practically it
// won't matter much assuming you won't have hundreds of layers.
// Don't update the screen every time we move a layer to get closer to the final result
ImgView321.BeginUpdate;
try
for LIndex := 0 to ListBox1.Items.Count - 1 do
// Get the associated layer and make it the least visible of all processed so far
TCustomLayer(ListBox1.Items.Objects[LIndex]).SendToBack;
// Could use TCustomLayer(Pointer(SomePanel.Tag)).SendToBack instead
finally
// Always do this not to have strange behavior after an error
ImgView321.EndUpdate;
end;
// When it's done, update the screen
ImgView321.Changed;
By your description of how you changed the order of the layers, it is most likely the reason for your problem. Since you did not post that part of the code it can not be assessed with certainty.
Anyway, to rearrange the layers, you can use the Index property of TCustomLayer (of which TBitmapLayer is a descendant)
So the solution to the problem is to NOT use a Bitmap32List as a temporary container for png layers when reordering layers, because something gets lost in the process.
So try other solution for reordering. My curent solution is to drop the layers as PNG files to the disk, then reload them from the disk in the desired order.
Another solution (untested yet) would be to create a number of new layers, equal to the number of existing layers, move actual layers there, then get them back one by one in the desired order, and then remove the extra layers.
Anyway. That was the question, and this is the answer so far

Resizing main menu for high DPI/font size

I have an issue with font height in standard main menu/popup menu when it contains images. Looks like this.
When there are no images, there are no problems as displayed above. Main menu uses TImageList with image width/height set to 16.
So I want to preserve image size at 16x16 and center it, to get something like this:
How can I read the font height of the main menu and adjust images in TImageList accordingly? One idea I have is to copy images from one TImageList to another with larger image width/height but I still need to determine proper size from the font size. How do I do that?
UPDATE
I solved this by examining SystemParametersInfo - SPI_GETNONCLIENTMETRICS value and using the iMenuHeight value for TImageList Width/Height. As images are deleted after changing Width/Height, I copied another to another TImageList. Works exactly as it should. Thank you everyone for your most helpful answers.
UPDATE 2
After examining the problem futher the solution which I marked as correct down there is giving better result so I switched to that one instead. Tested on Win7 and XP, appears to be working properly.
You can get the height of Screen.MenuFont by selecting it to a temporary DC:
function GetMenuFontHeight: Integer;
var
DC: HDC;
SaveObj: HGDIOBJ;
Size: TSize;
begin
DC := GetDC(HWND_DESKTOP);
try
SaveObj := SelectObject(DC, Screen.MenuFont.Handle);
GetTextExtentPoint32(DC, '|', 1, Size); // the character doesn't really matter
Result := Size.cy;
SelectObject(DC, SaveObj);
finally
ReleaseDC(HWND_DESKTOP, DC);
end;
end;
Well, Canvas.GetTextHeight('gh') usually helps to get height of text. But in case of different DPI, you can simply scale by Screen.PixelsPerInch / 96.0.
The text height is probably not what you need to use. I suggest that you use icons whose square dimension is equal to the prevailing small icon size. That's the system metric whose ID is SM_CXSMICON. Retrieve the value by calling GetSystemMetrics passing that ID.
You can use Power Menu Component with many advanced features
Download from here : http://elvand.com/downloads/DELPHI/PowerMenu.zip
Delphi7-XE2
size=193 KB
#include <windows.h>
int GetMainMenuHeight(void)
{
NONCLIENTMETRICS Rec;
Rec.cbSize = sizeof(Rec);
if (SystemParametersInfo(SPI_GETNONCLIENTMETRICS, Rec.cbSize, &Rec.cbSize, 0))
return Rec.iMenuHeight;
else return -1;
}

Removing garbage DFM data from TImage32 (Graphics32 library)

I have a control derived from TImage32:
TChromaDisplay = class(TImage32)
Everything is fine except that when I drop my TChromaDisplay on the form, the resulted DFM file is huge (300KB instead of <1KB) because I have garbage data (it is just a gray image) saved in the Bitmap.Data field. The Bitmap image is created and filled with gray color every time I drop my control on a form. I don't want to save the content of the image (garbage) to the DFM file since it makes the EXE larger but I don't know how.
Probably I need to write somewhere in TChromaDisplay.Create that I don't have any image data saved/stored in my TChromaDisplay. But I don't know where/how to do it.
object Display: TChromaDisplay
Left = 0
Top = 0
Width = 1465
Height = 246
Bitmap.Data = {
C0000000C0000000EBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFF
EBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFF
EBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFF
etc
etc
etc
I have tried this in Create but won't help:
Bitmap.Width := 1;
Bitmap.Height:= 1;
Update:
Looking at design time image dialog GR32_Dsgn_Bitmap.pas for TImage32.Bitmap property, the Clear button there uses the Bitmap.Delete procedure what just sets the bitmap size to 0x0. So you can try to call it to clear the bitmap before the form stream is saved:
type
TChromaDisplay = class(TImage32)
protected
procedure WriteState(Writer: TWriter); override;
end;
implementation
procedure TChromaDisplay.WriteState(Writer: TWriter);
begin
Bitmap.Delete;
inherited;
end;
But it still doesn't explain why you have a bitmap data when you put a control on the form. You can also call the Bitmap.Delete in your control constructor after inherited part is done (when the Bitmap is already instantiated).
Still untested, since I can't simulate your problem.
This is not "garbage". It's an image (whether it's one you assigned or one that the control creates in it's constructor). It's a bitmap located at position 0, 0 with a width and height of 1465, 246.
The BitmapData is the data in the bitmap (the pixels, etc.), encoded as a hex string so it will go in the text dfm.
The solution is to figure out how the bitmap is being assigned. It's either:
In the component's constructor (a default image?)
On your form (you've assigned an image in the IDE)
It's not being removed from the DFM from a previous time it was assigned.
The first one requires that you closely examine the source code of the component to figure out where it's being assigned. You can check to see what the bitmap property is called internally (for instance, FBitmap or FImage), and then search for places it gets an image assigned (LoadFromFile, LoadFromStream, LoadFromResource, Assign, and so forth).
The second and third: Backup your dfm just in case. Delete the component from your form. Comment out any code related to it, so your unit will compile. Right-click it, and choose View as Text. Search for TChromaDisplay (or just TChroma), and delete everything you find in the dfm related to it. Right-click and chhose View as Form, and then build your project. Go back into the dfm and make sure all traces of TChroma are still gone.

How can obtain the image which uses windows 7 to draw the parent nodes in a treeview control?

I'm working in a custom control which mix two windows controls (listview and treeview). In some point, I need to draw the image which uses windows 7 (with themes enabled) to identify the parent nodes, I'm using the DrawThemeBackground function with the TVP_GLYPH part and the GLPS_CLOSED state (I tried with all the parts and states related to the TREEVIEW class without luck), but the result image always is the old (+) or (-).
This image show the issue
I want to draw the Arrow image (inside of black circle) instead of the (+) sign (inside of orange circle).
This is the sample code which I use to draw the image.
uses
UxTheme;
procedure TForm40.Button1Click(Sender: TObject);
var
iPartId : integer;
iStateId: integer;
hTheme : THandle;
begin
hTheme := OpenThemeData(Handle, VSCLASS_TREEVIEW);
iPartId := TVP_GLYPH;
iStateId:= GLPS_CLOSED;
//iPartId := TVP_TREEITEM;
//iStateId:= TREIS_NORMAL;
if hTheme <> 0 then
try
//if (IsThemeBackgroundPartiallyTransparent(hTheme, iPartId, iStateId)) then
// DrawThemeParentBackground(Handle, PaintBox1.Canvas.Handle, nil);
DrawThemeBackground(hTheme, PaintBox1.Canvas.Handle, iPartId, iStateId, Rect(0, 0, 31, 31), nil);
finally
CloseThemeData(hTheme);
end;
end;
I check a couple of tools like the application made by Andreas Rejbrand and this too, but I can't find the image which I want.
My question is : how I can obtain the arrow image?
UPDATE
Thanks to the answer posted for Stigma I found additional resources to the values of the parts and states of the Explorer::Treeview class.
VisualStyleRenderer and themes
CodeProject
First of all, in the case of an ordinary ListView or TreeView, one can simply call SetWindowTheme on its handle to apply the proper sort of styling. The example from its MSDN page is as follows:
SetWindowTheme(hwndList, L"Explorer", NULL);
Since we are talking about a custom control, I am not so sure that applies here however. But since SetWindowTheme causes the WM_THEMECHANGED message to be sent to the proper window, it implies that you will just need to use the proper OpenThemeData call for the specific sub theme.
I think Luke's comment is correct. You probably just need to pass 'Explorer::Treeview' rather than the plain style. So, barring years of not having touched Delphi/Pascal:
hTheme := OpenThemeData(Handle, 'Explorer::Treeview');
You must set SetWindowTheme(Handle, 'explorer', nil); before painting to ensure that OpenThemeData will use new explorer style theme. Of course, window handle must be the same for both functions.

Resources