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;
}
Related
In a Delphi 10.4.2 VCL Application in Windows 10, how can I calculate the height of a TCategoryButtons object at run-time, i.e. the sum of all its button heights and its Category items, as this height could vary depending on its font size?
Measuring the pixel heights at run-time, I have noticed that all buttons have the same height and that the buttons have a different height as the Category items.
Also, note that the buttons do not have a published Height property in the Object Inspector.
But shouldn't it be possible to calculate the sum of all its button heights and its Category items with some low-level methods?
This is a control entirely implemented in Pascal, in Vcl.CategoryButtons.pas.
Therefore, you can see exactly how it is implemented. For instance, in TCategoryButtons.Paint you see its complete drawing code. Similarly, you can investigate the hit testing done in MouseMove (or MouseDown or MouseUp).
Consequently, if nothing else, you can create your own modified version of TCategoryButtons using this code. Your version can save the total height when it has been determined (for instance, certainly after painting).
However, after a quick look, it seems like TButtonCategory.Bounds might be interesting. If you are lucky, this returns the on-screen rect of a category. The Bottom of the last category's rect should be the (effectively used) height of the entire control.
It seems to work for me:
Here I draw a red bar of the same height as the control.
procedure TForm5.FormPaint(Sender: TObject);
begin
var y := CategoryButtons1.Categories[
CategoryButtons1.Categories.Count - 1
].Bounds.Bottom;
Canvas.Brush.Color := clRed;
Canvas.FillRect(Rect(0, 0, ClientWidth, y))
end;
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
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)
I've got a TMemo, and I want to always make it exactly high enough to display the number of lines it contains. Unfortunately, I don't quite know how to calculate that. I can't base it off the .Font.Size property, because that will vary based on DPI. And I can't use TCanvas.TextHeight because TMemo doesn't seem to have a canvas.
Anyone know how to do this right?
I see a problem, i think all lines on a TMemo are equal on height, but some can be empty...
So getting Height of empty ones will give zero while they are not zero height on the TMemo.
So the solution maybe doing something like Memo.Lines.Count*LineHeight
Beware that the Lineheight may not be getted by Canvas.TextHeight since Canvas.TextHeight will give more or less exact height of minimal height for a text... i mean it will not give same height for text 'ABC' than for 'ABCp', etc...
I would recomend (if not want to call Windows API) to use Font.Height, but if it is negative the internal leading of each line is not measured...
So i would recomend to do the next steps (tested):
Asign a positive value for Memo.Font.Height on the OnCreate event or anywhere you want, with this the lineheight ot the TMemo will be such value you asigned
Total height now can be obtained directly by Memo.Lines.Count*LineHeight, since you have asigned a positive value to Memo.Font.Height (remember that would make Memo.Font.Size to be negative)
Personally i do this on the TForm OnCreate event (to ensure it is done only once), just to ensure visual font size is not changed and MyMemo.Font.Height includes internal leading of each line:
MyMemo.Font.Height:=Abs(MyMemo.Font.Size*MyMemo.Font.PixelsPerInch div Screen.PixelsPerInch);
Ensure the previous to be done only once, otherwise the text size will be visaully bigger and bigger, as much as times you run it... it is caused because not allways MyMemo.Font.PixelsPerInch is equal to Screen.PixelsPerInch... in my case they are 80 and 96 respectively.
Then, when i need to know line height i just use:
Abs(MyMemo.Font.Height*Screen.PixelsPerInch div 72)
That gives exact height of one TMemo line, since all lines have the same height, the total height would be:
MyMemo.Lines.Count*Abs(MyMemo.Font.Height*Screen.PixelsPerInch div 72)
So, to make TMemo height as big as its contained text i do this (read the comment of each line, they are very important):
MyMemo.Font.Height:=Abs(MyMemo.Font.Size*MyMemo.Font.PixelsPerInch div Screen.PixelsPerInch); // I do this on the Tform OnCreate event, to ensure only done once
MyMemo.Height:=1+MyMemo.Lines.Count*Abs(MyMemo.Font.Height*Screen.PixelsPerInch div 72); // I do this anywhere after adding the text and/or after editing it
I you do not want to play with Screen.PixelsPerInch you can just do this (read the comment of each line, they are very important):
MyMemo.Font.Height:=Abs(MyMemo.Font.Height); // This may make text size to visually change, that was why i use the corrector by using MyMemo.Font.PixelsPerInch and Screen.PixelsPerInch
MyMemo.Height:=1+MyMemo.Lines.Count*Abs(MyMemo.Font.Height*MyMemo.Font.PixelsPerInch div 72);
Hope this can help anyone.
You can write your own implementation of TCanvas.TextHeight for TMemo:
function CountMemoLineHeights(Memo: TMemo): Integer;
var
DC: HDC;
SaveFont: HFont;
Size: TSize;
I: Integer;
begin
DC:= GetDC(Memo.Handle);
SaveFont:= SelectObject(DC, Memo.Font.Handle);
Size.cX := 0;
Size.cY := 0;
// I have not noticed difference in actual line heights for TMemo,
// so the next line should work OK
Windows.GetTextExtentPoint32(DC, 'W', 1, Size);
// BTW next (commented) line returns Size.cY = 0 for empty line (Memo.Lines[I] = '')
// Windows.GetTextExtentPoint32(DC, Memo.Lines[I], Length(Memo.Lines[I]), Size);
Result:= Memo.Lines.Count * Size.cY;
SelectObject(DC, SaveFont);
ReleaseDC(Memo.Handle, DC);
end;
You need to use a TCanvas for this. You can either create a TBitMap in the background and use its TCanvas (after assigning the Memo's Font property to the Bitmap.Canvas' one), or use a TCanvas from another component. Somthing like this:
BMP:=TBitMap.Create;
TRY
BMP.Canvas.Font.Assign(Memo.Font);
TotalHeight:=0;
FOR LineNo:=1 TO Memo.Lines.Count DO INC(TotalHeight,BMP.Canvas.TextHeight(Memo.Lines[PRED(I)]))
FINALLY
FreeAndNIL(BMP)
END;
Edit:
Or perhaps this one:
BMP:=TBitMap.Create;
TRY
BMP.Canvas.Font.Assign(Memo.Font);
LineHeight:=BMP.Canvas.TextHeight('Wq');
TotalHeight:=Memo.Lines.Count*LineHeight
FINALLY
FreeAndNIL(BMP)
END;
I originally suggested looing at the "Lines" TStrings list member in TMemo.
Instead, please look at the "Font" member in the parent class, TCustomEdit.
'Hope that helps .. PS
I am working with delphi.
I have one scroll box in which I am putting TImage control. Now I wanted to zoom the image rendered into TImage control. So, I am using stretchDraw method of TCanvas. My code is -
if sbZoom.Down then begin
rct := imgmain.Picture.Bitmap.Canvas.ClipRect;
rct := Rect(rct.Left * 2,rct.Top * 2,rct.Right * 2,rct.Bottom * 2);
imgmain.Picture.Bitmap.Canvas.StretchDraw(rct,imgmain.Picture.Bitmap);
imgmain.Repaint;
end;
It is correctly zooming the image, my problem is I want the size of scroll box also should be changed with zooming of image.
Also explain me parameters of Canvas.StretchDraw method. I am little confused with it.
Thank You.
You can do this quite easily without calling StretchDraw:
if Zoomed then begin
Image1.AutoSize := false;
Image1.Stretch := true;
Image1.Width := 2*Image1.Width;
Image1.Height := 2*Image1.Height;
end
else begin
Image1.Stretch := false;
Image1.AutoSize := true;
end;
AutoSize := true assures that the TImage is the same size as the picture inside. During zoom we switch AutoSize off and Stretch on, so the picture is resized to the TImage size (which is still the same here). Then we double the size of the TImage to make the zoom effect. As the TImage is now larger, the scrollbox can work properly.
Uwe Raabe is giving you the right way to do it. Here's why your way doesn't work: A scroll box will show scrollbars and help you see whole controls. In your case, it will only show scrollbars when the TImage object grows larger then the Scrollbox. The Scrollbox can't possibly know the internals of TImage so it doesn't care about TImage.Picture, it only cares about the control. And a TImage that has AutoSize = False doesn't care about it's Picture, it's size stays the same at all times.
Your code repaints the base bitmap onto itself. The problem is, the bitmap has fixed Width and Height: if you paint outside the bitmap's area you're basically silently ignored. When you're "zooming" by StretchDrawing the bitmap onto itself (and I'm surprised it worked to start with!) you're not making the bitmap larger and the stuff that doesn't fit gets silently clipped away. If you do want the internal bitmap to change size then you'll first need to create a new, larger bitmap, draw your enlarged image to the new bitmap and then assign the bitmap to your TImage. If you do this, make sure TImage.AutoSize = True.
You should set the size of the image control to the size of the bitmap.