I'm working on an app for sending bills. The client must have the ability to add a leter in rich format. Using Debenu, I scan and then print char by char to retrieve the font styles. This works pretty good, accept for the printing.
The Picture to the left is my richedit and to the right is my PDF. As you can see, character spacing is a little bid off
This is a small bit of code that does the copying and character spacing.
'XPos' is the left position of the line. After each printed char, I'm adding the width of the selected char to XPos
XPos := 42;
for I := 0 to length(RichEdit.Text) - 1 do
begin
RichEdit.SelStart := I;
RichEdit.SelLength := 1;
PDF.DrawText(XPos, YPos, RichEdit.SelText);
XPos := XPos + Canvas.TextWidth(RichEdit.SelText);
end;
The X and YPos for the PDF are floats, while the Canvas.TextWidth are in integers. Is it possible the actual positions on the canvas are a bit more accurate? If that is the case, how do I get those positions in floats?
I'm using Delphi XE-5 and Debenu Quick PDF Library 9.1 for creating the pdf's.
Edit:
As pointed out by LU RD. In FireMonkey the Canvas.Textwidth are floats. I did a quick check with an EditBox, Button and Label:
Label1.Text := floattostr(Canvas.TextWidth(edit1.seltext));
In this test the Label shows a very specific number for char width.
This leaves me to believe that I was right that char width's are indeed floats and I need to start implementing mjn's sugestion of transferring a full string with the same properties to my PDF.
Debenu has this function:
function TDebenuPDFLibrary0915.CharWidth(CharCode: Integer): Integer;
If you devide the return value by 1000 and multiply it by the text size, you will get the right width for the char.
This is the solution to my own question:
XPos := 42;
for I := 0 to length(RichEdit.Text) do
begin
RichEdit.SelStart := I;
RichEdit.SelLength := 1;
PDF.DrawText(XPos, YPos, RichEdit.SelText);
str := RichEdit.SelText;
if length(str) > 0 then
chr := char(str[1]);
XPos := XPos + (PDF.CharWidth(Ord(chr)) / 1000 * 12);
end;
Mind you, this is still work in progress. But the essential is here.
Related
How can I set TImage size as double value? Example Image1.width := 50.1; or what component accept it, because TImage only accept integer values.
I'm working with download files, and one image should be the number of elements to download, so Image1.width max value is 340, i need to divide this value by the amount of files who will be downloaded, and increase this value on image1.width when every download be finished, but TImage only accept Integer value.
I already did it using "Round" but it is not what I need.
As answered, you cannot set the image's size to any floating point value.
However, using coordinate spaces and transformations functions, you can set an arbitrary transformation between a logical coordinate system and the viewing device. This can be used to increase the logical extent of the image's canvas size with each download and yet keep the image on the screen with an entirely different size.
The below example demonstrates the concept by drawing 4 rows and 4 columns of a 256x256 image on a 105x105 bitmap canvas of a TPicture of a TImage. Basically it achieves to draw a single 256x256 image on a 26.25x26.25 px. surface.
uses
pngimage;
procedure TForm1.Button1Click(Sender: TObject);
const
Col = 4;
Row = 4;
var
Png: TPngImage;
ImgCanvas: TCanvas;
ExtX, ExtY: Integer;
MapMode: Integer;
Size: TSize;
i, j: Integer;
begin
Png := TPngImage.Create;
try
Png.LoadFromFile('...\Attention.png');
Png.Draw(Canvas, Rect(0, 0, Png.Width, Png.Height)); // original picture
Image1.Picture.Bitmap.Canvas.Brush.Color := Color;
Image1.Picture.Bitmap.SetSize(Image1.Width, Image1.Height);
ImgCanvas := Image1.Picture.Bitmap.Canvas;
SetStretchBltMode(ImgCanvas.Handle, HALFTONE);
MapMode := SetMapMode(ImgCanvas.Handle, MM_ISOTROPIC);
if MapMode <> 0 then
try
ExtX := Png.Width * Col;
ExtY := Png.Height * Row;
if not GetWindowExtEx(ImgCanvas.Handle, Size) then
RaiseLastOSError;
if not SetWindowExtEx(ImgCanvas.Handle, Size.cx * ExtX div Image1.Width,
Size.cy * ExtY div Image1.Height, nil) then
RaiseLastOSError;
if not SetViewportExtEx(ImgCanvas.Handle, Size.cx, Size.cy, nil) then
RaiseLastOSError;
i := 0;
j := 0;
while j < ExtY do begin
while i < ExtX do begin
Png.Draw(ImgCanvas, Rect(i, j, i + Png.Width, j + Png.Height));
Inc(i, Png.Width);
end;
i := 0;
Inc(j, Png.Height);
end;
finally
SetMapMode(ImgCanvas.Handle, MapMode);
end
else
RaiseLastOSError;
finally
Png.Free;
end;
end;
Probably worth noting that GDI may not be the best graphics system when scaling is involved. For quick reference, here's what the above yields:
Assuming you're using the VCL framework, all controls across Delphi are Integer based. You simply cannot assign a float value, not without first converting it to an integer.
The Firemonkey framework on the other hand is widely based on float values.
I want to paint a monochome bitmap stretched at 200% with two colors: pure black and pure white.
I use the following code, but nothing gets displayed.
If I replace SRCCOPY with SRCPAINT I get a white rectangle, but still no random 2x2 blocks get painted as is supposed to happen.
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowCell(Form1.Canvas); //Using another canvas does not help.
end;
procedure ShowCell(Canvas: TCanvas);
const
cHeight = 100;
cWidth = 50; //50 * 8 = 400 pixels
var
bmpinfo: PBitmapInfo;
color: PRGBQUAD;
i: Integer;
x,y,h: integer;
DataBuffer: array[0..cHeight-1,0..cWidth-1] of byte;
ScanLineWidth: integer;
Cell: TLifeCell;
Coordinate: TCoordinate;
begin
GetMem(bmpinfo, SizeOf(TBitmapInfo) + SizeOf(TRGBQUAD)*2);
color:= #bmpinfo^.bmiColors[0];
color^.rgbRed:= 255;
color^.rgbBlue:= 255;
color^.rgbGreen:= 255;
color^.rgbReserved:= 0;
Inc(color);
color^.rgbRed:= 0;
color^.rgbBlue:= 0;
color^.rgbGreen:= 0;
color^.rgbReserved:= 0;
with bmpinfo.bmiHeader do begin
biSize:= SizeOf(bmpinfo.bmiHeader);
biWidth:= cWidth*8; //8 pixels per byte
biHeight:= cHeight;
biPlanes:= 1;
biBitCount:= 1;
biCompression:= BI_RGB;
biSizeImage:= 0;
biXPelsPerMeter:= 0;
biYPelsPerMeter:= 0;
biClrUsed:= 0;
biClrImportant:= 0;
end;
ScanlineWidth:= cWidth div 8;
if (ScanlineWidth mod 4) <> 0 then Inc(ScanlineWidth, 4 - ScanlineWidth mod 4);
for x:= 0 to cwidth-1 do begin
for y:= 0 to cheight-1 do begin
DataBuffer[x][y]:= Random(255);
end;
end;
StretchDIBits(Canvas.Handle, 0, 0, cHeight*2, cWidth*2*8, 0, 0, cHeight, cWidth*8,
#DataBuffer, bmpinfo^, DIB_RGB_COLORS, SRCCOPY);
FreeMem(bmpinfo);
end;
What am I doing wrong here?
It works for me with some corrections - cwidth/cheight in the cycle and main - width and height arguments of StretchDiBits function were exchanged. Has GetLastError reported wrong param values? (In my case - not)
for x:= 0 to cwidth-1 do begin
for y:= 0 to cheight-1 do begin
DataBuffer[x][y]:= Random(255);
end;
end;
StretchDIBits(Canvas.Handle, 0,0,cWidth*2*8,cHeight*2,0,0,cwidth*8,cHeight,#DataBuffer,
bmpinfo^, DIB_RGB_COLORS, SRCCOPY);
Another possible issue - you defined cWidth (data buffer width) independently of ScanlineWidth calculation.
There are a number of errors:
Bitmap declaration does not match StretchDIBits call.
Bitmap is upside down
Loop has x and y reversed
Status code is not checked (and finally)
For performance reasons the width of a bitmap should be a multiple of 4 (or 8) bytes
Bitmap declaration does not match StretchDIBits call
The problem is that the declaration of the bitmap must match the arguments of StretchDIBits. If these do not match you'll get a silent error and nothing will get displayed.
Here are the problem lines:
with bmpinfo.bmiHeader do begin
biSize:= SizeOf(bmpinfo.bmiHeader);
biWidth:= cWidth*8; //8 pixels per byte must match srcWidth.
biHeight:= cHeight; // must match srcHeight below.
StretchDIBits(Canvas.Handle,0,0,cWidth*2*8,cHeight*2
,0,0,cwidth*8,cHeight, //srcWidth,srcHeight
#DataBuffer, bmpinfo^, DIB_RGB_COLORS, SRCCOPY);
If either the srcWidth or srcHeight parameter exceed the dimensions of the bitmap the call will fail.
In the call to StretchDIBits in the question Height and Width are reversed, making the bitmap too large and forcing an error, preventing display.
Bitmap is upside down
Because IBM has had it's grubby hands on the bitmap format logic went out the window and the default for bitmaps is to be upside down.
BITMAPINFOHEADER
biHeight The height of the bitmap, in pixels. If biHeight is positive, the bitmap is a bottom-up DIB and its origin is the lower-left corner. If biHeight is negative, the bitmap is a top-down DIB and its origin is the upper-left corner.
Unless you want your data to be upside down, you'd better make biHeight negative, like so:
with bmpinfo.bmiHeader do begin
biSize:= SizeOf(bmpinfo.bmiHeader);
biWidth:= cWidth*8; //8 pixels per byte must match srcWidth.
biHeight:= -cHeight; // "-" = TopDown: must match srcHeight below.
Loop has x and y reversed
In the loop, take note that x and y are reversed in the buffer.
for y:= 0 to cHeight-1 do begin
for x:= 0 to cWidth-1 do begin //fill scanlines in the inner loop.
DataBuffer[y][x]:= Random(256); //y,x must be reversed!
end; {for x}
end; {for y}
Status code is not checked
If I had bothered to check the return value of StretchDIBits than I could have saved myself the bother. I would have known there was an error.
If the function succeeds, the return value is the number of scan lines copied. Note that this value can be negative for mirrored content.
If the function fails, or no scan lines are copied, the return value is 0.
Success:= StretchDIBits(.....
Assert(Success <> 0,'StretchDIBits error, check your arguments');
For performance reasons the width of a bitmap should be a multiple of 4 bytes
If you are going to write to your bitmap buffer using (32-bit) integers, you'd better make sure your bitmap width is a multiple of 4 bytes, or you're going to suffer delays due to misaligned writes.
If you use 64-bit Int64 writes, make it a multiple of 8 bytes.
Windows only enforces a 2-byte alignment. This is because the bitmaps need to stay compatible with 16-bit Windows bitmaps.
bmWidthBytes The number of bytes in each scan line. This value must be divisible by 2, because the system assumes that the bit values of a bitmap form an array that is word aligned
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.
Does anyone know how to get the width and height of text in a TRichEdit control, in the same way that you would use TextWidth and TextHeight on a TCanvas?
The reason I need to know this doing this is I have a RichEdit on a non-visible form that I copy the contents of to a canvas using Richedit.Perform(EM_FORMATRANGE, ...). The problem is that the EM_FORMATRANGE requires a parameter of type TFormatRange in which the target rect is specified, but I don't know what the rect should be because I don't know in advance the size of the contents in the RichEdit. Hope that makes sense.
Again use EM_FORMATRANGE for measuring, see EM_FORMATRANGE Message on MSDN:
wParam Specifies whether to render the
text. If this parameter is a nonzero
value, the text is rendered.
Otherwise, the text is just measured.
Generally you would already have a destination area, which has a width and height, where you'd do the drawing, like printing on a paper or producing a preview on a predefined surface. A most simple example for a predefined width to get the required height could be;
var
Range: TFormatRange;
Rect: TRect;
LogX, LogY, SaveMapMode: Integer;
begin
Range.hdc := ACanvas.Handle;
Range.hdcTarget := ACanvas.Handle;
LogX := GetDeviceCaps(Range.hdc, LOGPIXELSX);
LogY := GetDeviceCaps(Range.hdc, LOGPIXELSY);
Range.rc.Left := 0;
Range.rc.Right := RichEdit1.ClientWidth * 1440 div LogX; // Any predefined width
Range.rc.Top := 0;
Range.rc.Bottom := Screen.Height * 1440 div LogY; // Some big number
Range.rcPage := Range.rc;
Range.chrg.cpMin := 0;
Range.chrg.cpMax := -1;
RichEdit1.Perform(EM_FORMATRANGE, 0, Longint(#Range));
ShowMessage(IntToStr(Range.rc.Bottom * LogY div 1440)); // Get the height
RichEdit1.Perform(EM_FORMATRANGE, 0, 0); // free cache
For a more complete example see this article, or in general any RichEdit previewing/printing code...
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;