Delphi Xe4. Form, ActionManager, ImageList (with 32x32 Icons), ActionMainMenuBar.
I can not ensure that the icons are displayed correctly. What should you do?
At the same time, if I apply any vcl style of decoration, it displays fine. But if the style of "Windows" by default, the text moves out of the icon. Help.
Sorry for the bad English.
This is a valid question, the TActionMainMenuBar is meant to be designed to be able to handle custom icon sizes as menu images, just as the native menus can handle them fine. One indication of that can be found in the comments in the code, f.i. in the below VCL code you can find the comment 16 is standard image size so adjust for larger images.
The faulty code, I believe, is in TCustomMenuItem.CalcBounds in 'ActnMenus.pas'. Below excerpt is from D2007. Notice the line below I commented with some exclamation marks. After the ascendant class TCustomActionControl calculates the positioning of text and image in its CalcLayout method, the TCustomMenuItem ruins it with the hard-coded 24 in the said statement.
procedure TCustomMenuItem.CalcBounds;
var
AWidth, AHeight: Integer;
NewTextBounds: TRect;
ImageSize: TPoint;
ImageOffset: Integer;
begin
inherited CalcBounds;
ImageSize := GetImageSize;
AHeight := FCYMenu;
if Separator then
AHeight := FCYMenu div 3 * 2
else
// 16 is standard image size so adjust for larger images
if ImageSize.Y > 16 then
AHeight := ImageSize.Y + 4;
if ActionClient = nil then exit;
if ImageSize.X <= 16 then
ImageOffset := 24
else
ImageOffset := ImageSize.X + 6; // Leave room for an image frame
NewTextBounds := TextBounds;
OffsetRect(NewTextBounds, 24 - TextBounds.Left, // <- !!!!!
AHeight div 2 - TextBounds.Bottom div 2 - 1);
TextBounds := NewTextBounds;
ShortCutBounds := Rect(0,0,0,0);
if ActionClient.ShortCut <> 0 then
begin
Windows.DrawText(Canvas.Handle, PChar(ActionClient.ShortCutText), -1,
FShortCutBounds, DT_CALCRECT);
// Left offset is determined when the item is painted to make it right justified
FShortCutBounds.Top := TextBounds.Top;
FShortCutBounds.Bottom := TextBounds.Bottom;
AWidth := TextBounds.Right + FShortCutBounds.Right + ImageOffset + Spacing;
end
else
AWidth := TextBounds.Right + TextBounds.Left;
SetBounds(Left, Top, AWidth, AHeight);
end;
The 24 is an assumption based on images having 16 or less pixels width. What should be used instead is the ImageOffset value calculated just a few lines above. Replace
OffsetRect(NewTextBounds, 24 - TextBounds.Left,
AHeight div 2 - TextBounds.Bottom div 2 - 1);
with
OffsetRect(NewTextBounds, ImageOffset - TextBounds.Left,
AHeight div 2 - TextBounds.Bottom div 2 - 1);
and you'll have something like this:
You'll notice some other weirdness though, items not having images are still settling for a small image layout. IMO all menu items should have the same basic layout, but the design of action menus allow different layouts for individual items. One other weird thing is the checked state of an item with an image ('Action6'), although I'm not sure if I'm missing a setting here or if it would qualify as a bug otherwise.
Related
I need to print an image that is aquired from a scanner.
When the scan fits on one A4 page, there is no problem and my code prints perfect.
However, when the scan does not fits, but needs 2 pages, only one page is printed. The first.
This is my code so far
procedure TFormMain.PrintPicture;
var
MyRect: TRect;
Scale: Double;
begin
try
Printer.BeginDoc;
Scale := Printer.PageWidth / ImgHolder.Picture.Bitmap.Width;
MyRect.Left := 0;
MyRect.Top := 0;
MyRect.Right := trunc(ImgHolder.Picture.Bitmap.Width * Scale);
MyRect.Bottom := trunc(ImgHolder.Picture.Bitmap.Height * Scale);
Printer.Canvas.StretchDraw(MyRect, ImgHolder.Picture.Bitmap);
Printer.EndDoc;
except
on E:Exception do
begin
MessageBox(Handle, PChar('Printing failed' + chr(13) + E.Message), PChar(Caption), MB_OK or MB_ICONWARNING);
end;
end;
end;
when the image holds one page, the height of MyRect = 13092
when the image holds 2 pages, the height is 26185
This seems correct to me, but still only the first page is printed.
So I must be doing it all wrong, can someone please point me in the correct direction on how to print an image that is higher then the height of one page
EDIT
I want to print on more than one page if the image is larger.
I do not want to scale down the image to one page.
The reason for the scale in my code is because I could not print correct at first, and I find this code in another question that solved that for me.
But now it seems this approach is wrong.
So I would appreciate if I could get some help in setting up my printing correct.
If the user scans 2 or 3 times, the image will be made larger and the new scan will be added to the image at the bottom.
This is how the image gets longer than one page.
Now I need to print this image complete, so on more than one page if needed
There are many ways to print an image.
First, please remember that your screen and your printer have different resolutions (in pixels per inch, say). Typically, a printer has much higher resolution than a PC monitor, so if you print your full-screen 1920×1080 image on an A4 page, you will get a very small image on the page unless you magnify it.
Now, having said that, let's us consider two common scenarios (you want the second one).
Scaling the image so it fits perfectly on a single page
By "fits perfectly", I mean the image is scaled proportionally, preserving its aspect ratio, so that it is as large as possible on the page without being clipped.
Let (uses Math)
ScaleX := Printer.PageWidth / Bitmap.Width;
ScaleY := Printer.PageHeight / Bitmap.Height;
Scale := Min(ScaleX, ScaleY).
Then Scale is your scaling factor.
Indeed, ScaleX is the greatest scaling factor that allows the image to fit the page horizontally. For instance, if the paper is 1000×1000 and the image 2000×1000, you clearly need to shrink it to at least ScaleX = 50% to make it fit horizontally. On the other hand, if the image is 1000×5000, the problem is not the width but the height, and you clearly need to shrink it to at least ScaleY = 20% to make it fit vertically.
So if the image is 2000×5000, you need the scale factor to be 50% or less to make it fit horizontally, and you need the scale factor to be 20% or less to make it fit vertically. The greatest scale factor satisfying these two restrictions is 20%, the minimum of 50% and 20%.
procedure PrintBitmap(ABitmap: TBitmap);
begin
Printer.BeginDoc;
var ScaleX := Printer.PageWidth / ABitmap.Width;
var ScaleY := Printer.PageHeight / ABitmap.Height;
var Scale := Min(ScaleX, ScaleY);
var W := Round(ABitmap.Width * Scale); // Note: scaling proportionally,
var H := Round(ABitmap.Height * Scale); // same factor
Printer.Canvas.Brush.Color := clRed;
Printer.Canvas.StretchDraw(
TRect.Create( // Centre on page
Point((Printer.PageWidth - W) div 2, (Printer.PageHeight - H) div 2),
W, H
),
ABitmap
);
Printer.EndDoc;
end;
For example,
procedure TForm1.FormCreate(Sender: TObject);
begin
var bm := TBitmap.Create;
try
bm.LoadFromFile('K:\Sally.bmp');
PrintBitmap(bm);
finally
bm.Free;
end;
end;
Having a fixed image size, potentially spanning several pages
Now, instead suppose you have a fixed image size (W, H) and you want to print it on as many pages as needed. Then you need to loop through the 2D paper grid and draw each page separately:
procedure PrintBitmap(ABitmap: TBitmap);
var
W, H: Integer;
ImgPageWidth, ImgPageHeight: Integer;
function GetSourceRect(Row, Col: Integer): TRect;
begin
Result := TRect.Create(
Point(Col * ImgPageWidth, Row * ImgPageHeight),
ImgPageWidth, ImgPageHeight
);
end;
function GetDestRect(Row, Col: Integer): TRect;
begin
Result := Rect(0, 0, Printer.PageWidth, Printer.PageHeight);
end;
begin
Printer.BeginDoc;
W := ABitmap.Width * 4; // Hardcoding these in this example
H := ABitmap.Height * 4;
ImgPageWidth := Round(ABitmap.Width * (Printer.PageWidth / W));
ImgPageHeight := Round(ABitmap.Height * (Printer.PageHeight / H));
var PageCountX := Ceil(W / Printer.PageWidth); // Image width in pages
var PageCountY := Ceil(H / Printer.PageHeight); // Image height in pages
// Notice that the total page count is PageCountX * PageCountY.
for var y := 0 to PageCountY - 1 do
for var x := 0 to PageCountX - 1 do
begin
if x + y > 0 then
Printer.NewPage;
Printer.Canvas.CopyRect(
GetDestRect(y, x),
ABitmap.Canvas,
GetSourceRect(y, x)
);
end;
Printer.EndDoc;
end;
or
To print a big image on several pages, you have to loop on the width and on the height (two loops) to create pages with partial image. To print one partial image, you can use TCanvas.CopyRect
I have an RTF document with defined page settings:
(...}\paperw16840\paperh11907\margl794\margt709\margr794\margb983\viewkind4\\uc1\trowd\....)
In my app I use a TRichEdit to show the document.
The TRichEdit has a TPanel as its Parent, and is using Align=alClient and AlignWithMargins=True.
I set the Panel's Width to 16840 * PixelsPerInch/1440 (1123 pixels) and I see that is equal to the page's width, as shown in MSWord (scale=100%).
Setting the RichEdit's Margins to 794 * PixelsPerInch/1440 (53 pixels), the Width of the RichEdit is smaller than it must be, or the margins are bigger than they must be (compared with MSWord).
No borders, no other margins, except what I set in code:
function pixelsOf(prop : string) : integer;
var
i,j,l : integer;
begin
result := -1;
l := length(prop);
i := pos(prop,s);
if i > 0 then begin
j := i+l;
while s[j] in ['0'..'9'] do inc(j);
result := round(strToIntDef(copy(s,i+l,j-i-l),-1)*PixelsPerInch/1440);
end;
end;
paperW := pixelsOf('\paperw'); // pixelsOf() calcs twips*pixelsPerInch/1440
PanelPreview.Width := paperW;
Lm := pixelsOf('\margl');
RichEdit1.Margins.Left := Lm;
Rm := pixelsOf('\margr');
RichEdit1.Margins.Right := Rm;
Tm := pixelsOf('\margt');
RichEdit1.Margins.Top := Tm;
The value of paperW gives the correct Panel width (compared with MSWord), but the values of Lm and Rm give bigger margins, so the RichEdit becomes narrower.
How can I calculate the correct margins so the RichEdit has the same layout as MSWord?
This maybe helps. I noticed that :
TRichedit leaves a space about 10 pixels at the left side (the rendering is starting after this space). Is there a parameter that can be fix this other than margins.left ?
TRicheditdoesn't render any table wider than its width (MSword do
this adjusting the margins). So the TRichedit trancates everything
outside its margins.
The result of the above is that the left margin seems wider than must be and truncates the right side of the table if it is winder.
see the image
I have two questions about KOL.
I have a main form. As I see this placed on the TForm's position.
I wanna put it to the screen center.
How can I access it's coordinates, or the handle for "SetWindowPos"?
I have 4 labels in the form. For 2 of them I want to use smaller fonts. But I don't found any Font Size property... How to do it then?
1.1. How to center form on screen ?
Use the CenterOnForm method. As description says, if it's applied to a form, centers form on screen:
Form.CenterOnForm(nil);
1.2. How to get form position ?
Just like in Delphi by the Left and Top properties or e.g. by the Position property. The following pseudo-code results to the same:
ShowMessage('Form pos.: [' +
Int2Str(Form.Left) + '; ' +
Int2Str(Form.Top) + ']'
);
ShowMessage('Form pos: [' +
Int2Str(Form.Position.X) + '; ' +
Int2Str(Form.Position.Y) + ']'
);
Note, that unless you change the form position by yourself or until the applet is running, both properties returns 0. The form position, if you didn't set it, is adjusted when the applet starts.
1.3. How to get form handle ?
Use either the Handle property or the GetWindowHandle method. The following pseudo-code results to the same:
ShowMessage(Int2Str(Form.Handle));
ShowMessage(Int2Str(Form.GetWindowHandle));
2. How to change the font size ?
As #David already mentioned in his post, use the Font.FontHeight property. Just one sidenote, the default font when you create e.g. that label is set to System to which is not possible to change the size, so don't be surprised when the size changes won't be applied. Here's a quote from the source:
Value 0 (default) says to use system default value, negative values
are to represent font height in "points", positive - in pixels. In XCL
usually positive values (if not 0) are used to make appearance
independent from different local settings.
And here's a sample usage shown on positioned label creation:
Label1 := NewLabel(Form, 'Label1').SetPosition(8, 8);
Label1.Font.FontName := 'Tahoma';
Label1.Font.FontHeight := -11;
3. Example project
program Project1;
uses
KOL;
type
PForm1 = ^TForm1;
TForm1 = object(TObj)
Form, Label1, Label2, Label3, Label4: PControl;
end;
var
Form1: PForm1;
procedure CreateForm(var Result: PForm1; AParent: PControl);
begin
New(Result, Create);
with Result^ do
begin
Form := NewForm(AParent, 'Caption').SetSize(320, 240);
Form.CenterOnForm(nil);
Label1 := NewLabel(Form, 'Label1').SetPosition(8, 8);
Label1.Font.FontName := 'Tahoma';
Label1.Font.FontHeight := -11;
Label2 := NewLabel(Form, 'Label2').SetPosition(72, 8);
Label2.Font.FontName := 'Tahoma';
Label2.Font.FontHeight := -11;
Label3 := NewLabel(Form, 'Label3').SetPosition(136, 8);
Label3.Font.FontName := 'Tahoma';
Label3.Font.FontHeight := -15;
Label4 := NewLabel(Form, 'Label4').SetPosition(200, 8);
Label4.Font.FontName := 'Tahoma';
Label4.Font.FontHeight := -15;
end;
end;
begin
Applet := NewApplet('Test');
CreateForm(Form1, Applet);
Run(Applet);
end.
Question 1
Call the SetPosition and SetSize methods on the form.
Form.SetPosition(x,y);
Form.SetSize(w,h);
Question 2
Use Font.FontHeight.
MyControl.Font.FontHeight := ...;
If you want to call SetWindowPos, you can retrieve the handle calling the GetWindowHandle method of the returned pointer.
Please, don't ask more than 1 question per question.
I have two forms, Form1 and Form2
I have a TLabel on Form1 which an onclick event which calls Form2.show;
What I am trying to do, if figure out how I can make form2 show 5px below the label centered between the label :) Form2 is small and just shows some options.
I can use the mouse position but it's not quite good enough.
I was thinking something like
// Set top - add 20 for the title bar of software
Form2.Top := Form1.Top + Label1.Top + Label1.Height + 20;
// Set the Left
Form2.Left := Form1.Left + Label1.Left + round(Label1.Width / 2) - round(form2.Width/2);
but I think there can be a better way
You need to set the coordinates for Form2 using the coordinate system of it's Parent. Assuming the Parent is the Desktop (since you're attempting to compensate for the height of the title bar), this can do it:
procedure ShowForm;
var P: TPoint;
begin
// Get the top-left corner of the Label in *screen coordinates*. This automatically compensates
// for whatever height the non-client area of the window has.
P := Label1.ScreenToClient(Label1.BoundsRect.TopLeft);
// Assign the coordinates of Form2 based on the translated coordinates (P)
Form2.Top := P.Y + 5; // You said you want it 5 pixels lower
Form2.Left := P.X + 5 + (Label1.Width div 2); // Use div since you don't care about the fractional part of the division
end;
You'll need to adapt the code for the positioning of Form2 based on your centering requirement, I didn't quite understand what you want. And of course, if a frame or panel is enough, it's better! Take a good look at Guillem's solution.
procedure TForm2.AdjustPosition(ARefControl: TControl);
var
LRefTopLeft: TPoint;
begin
LRefTopLeft := ARefControl.ScreenToClient(ARefControl.BoundsRect.TopLeft);
Self.Top := LRefTopLeft.Y + ARefControl.Height + 5;
Self.Left := LRefTopLeft.X + ((ARefControl.Width - Self.Width) div 2);
end;
Then you can have the form adjust itself relative to any desired control as follows:
Form2.AdjustPosition(Form1.Label1);
Do you really need Form2 to be a form? You could choose to create a frame containing the Form2 logic and use a hidden TPanel as its parent. When the user clicks on the Label1 you show then the panel.
Something like following. When you create Form1 or when you click on Label1 (depending on your needs):
Frame := TFrame1.Create(Self);
Frame.Parent := Panel1;
In the OnClick event for Label1:
Panel1.Top := Label1.Top + 5;
Panel1.Left := Label1.Left + round(Label1.Width / 2) - round(form2.Width/2);
Panel1.Visible := true;
When the user is done just hide the panel again (and destroy the Frame if necessary). If you keep the Frame alive while the user is using Form1 remember to free it when leaving the form.
HTH
The ClientOrigin property will return the lebel's upper-left corner in screen coordinates, so you do not need to determine it manually:
var
Pt: TPoint;
begin
Pt := Label1.ClientOrigin;
Form2.Left := Pt.X + Round(Label1.Width / 2) - Round(Form2.Width/2);
Form2.Top := Pt.Y + Label1.Height + 5;
end;
When you edit a TLabel's caption in the form designer, it resizes the TLabel for you. Is there any way I can get a TMemo to do that, at runtime?
I'd like to be able to take a TMemo, assign something to its .lines.text property, and then tell it to resize itself and not exceed a certain width, though it can get as tall as it wants to. Anyone know how to do that?
This works just fine for me. The constant added (8) might vary on whether you are using a border and/or bevel, experiment with it.
procedure TForm1.Memo1Change(Sender: TObject);
var
LineHeight: Integer;
DC: HDC;
SaveFont : HFont;
Metrics : TTextMetric;
Increase: Integer;
LC: Integer;
begin
DC := GetDC(Memo1.Handle);
SaveFont := SelectObject(DC, Memo1.Font.Handle);
GetTextMetrics(DC, Metrics);
SelectObject(DC, SaveFont);
ReleaseDC(Memo1.Handle, DC);
LineHeight := Metrics.tmHeight;
Increase := Memo1.Height;
LC := Memo1.Lines.Count;
if LC < 1 then
LC := 1;
Memo1.Height := LC * LineHeight + 8;
Increase := Memo1.Height - Increase;
Memo1.Parent.Height := Memo1.Parent.Height + Increase;
end;
Set the WordWrap property of the TMemo to true, dump your text into it, count the lines, and set the height to the product of the line count and the line height, but you need to know the line height.
The TMemo does not expose a line height property, but if you're not changing the font or font size at runtime, you can determine the line height experimentally at design time.
Here's the code I used to set the height of the TMemo that had a line height of 13 pixels. I also found that I needed a small constant to account for the TMemo's top and bottom borders. I limited the height to 30 lines (396 pixels) to keep it on the form.
// Memo.WordWrap = True (at design time)
Memo.Text := <ANY AMOUNT OF TEXT>;
Memo.Height := Min(19 + Memo.Lines.Count * 13, 396);
If you absolutely must extract the line height from the object at runtime, then you might use Someone's answer. Or, you can use TRichEdit, which has the SelAttributes property containing a Height property giving the line height.
-Al.
I've implemented a self-growing TMemo as a nice example of LiveBindings (one of the few useful examples I could come up with for LiveBindings in VCL).
A quote From my Delphi XE2 Development Essentials courseware manual:
"To build this example, place a TMemo component on a VCL form, open the LiveBindings property, and select the “New LiveBinding” option. Pick the TBindExpression choice. Open BindExpressionMemo11 in the Object Inspector and set SourceComponent to Memo1 and SourceExpression to Lines.Count * 22.
To get a better result at runtime, set SourceExpression to the more exact expression
Font.Size - 4 + (Lines.Count + 1) * -1 * (Font.Height - 3)
Finally, in the OnChange event handler of the TMemo, write one line of code:
BindingsList1.Notify(Sender, '');
That’s it. Compile and run to see the growing memo in action.
[screenshot]
Initially, the TMemo control will be two lines high (the line with the contents, and a next line), and whenever we hit enter or word wrapping advances us to the next line, the TMemo control will grow in height (growing down actually, so make sure to leave enough space on the form for the TMemo to expand itself)."
Groetjes, Bob Swart
procedure TTmpMessage.edMsgChange (Sender: TObject);
var
LineHeight : Integer;
DC : HDC;
SaveFont : HFont;
Metrics : TTextMetric;
begin
DC := GetDC ( TRxRichEdit (Sender).Handle );
SaveFont := SelectObject ( DC, TRxRichEdit (Sender).Font.Handle );
GetTextMetrics (DC, Metrics);
SelectObject (DC, SaveFont);
ReleaseDC ( TRxRichEdit (Sender).Handle, DC );
LineHeight := Metrics.tmHeight;
Height := TRxRichEdit (Sender).Lines.Count * LineHeight + 32;
end;
And why not just:
Memo1.Height := Memo1.ContentBounds.Height + 5;