Here is my problem, I want to know actual length of the text in pixels (note that various letters have different length in some fonts). I am going to use this for better column width adjustment in DBGrid.
You can use the Canvas.TextWidth and Canvas.TextHeight functions.
Option 1, using the canvas of the control
WidthInPixels := Label1.Canvas.TextWidth('My Text');
Option 2, creating a temporary canvas (using a Tbitmap)
Function GetWidthText(const Text:String; Font:TFont) : Integer;
var
LBmp: TBitmap;
begin
LBmp := TBitmap.Create;
try
LBmp.Canvas.Font := Font;
Result := LBmp.Canvas.TextWidth(Text);
finally
LBmp.Free;
end;
end;
if you have a Delphi component has a "Canvas" property, then you can use Component.Canvas.TextWidth. For example: to get the width of the text of DBGrid you can use:
DBGrid1.Canvas.TextWidth('Stack');
Here you can find complete reference about this issue:
Length of Delphi string in pixels
Related
My application allows users to create text objects on a canvas. This object can be saved to a project file to be loaded later.
In order that the objects look the same after loading on various platforms I have implemented the text object as a path. This also allows users to use downloaded fonts and then open the project file on a different device without that font - without the text changing appearance.
The path is created using TTextLayout.ConvertToPath and drawn using TCanvas.FillPath. This works fine for most fonts, but has an issue with some others.
The image below shows the result (top) with the Bahnschrift font. Bottom shows how it should look using MS Paint. This font seems to have intersecting paths and I think the issue is that FillPath is using an alternate fill mode, which doesn't seem to be an option to change.
I have also tested the same font in Inkscape as an SVG by creating the text and converting it to a path, but it's drawn correctly. The path data created by Delphi and Inkscape are essentially the same (the t consists of 2 closed regions that cross each other), so it's the way they're drawn that must be different.
Can anyone suggest a fix for this?
Here's the code
procedure TMainForm.Button1Click(Sender: TObject);
Var
LPath : TPathData;
LLayout : TTextLayout;
begin
LLayout := TTextLayoutManager.DefaultTextLayout.Create;
LLayout.Text := 'test';
LLayout.Font.Family := 'Bahnschrift';
LPath := TPathData.Create;
LLayout.ConvertToPath(LPath);
// Draw the path to a bitmap
SavePathBitmap(LPath, 'Path_test');
LLayout.Free;
LPath.Free;
end;
procedure TMainForm.SavePathBitmap(APath : TPathData ; AFileName : String);
var
bmp : TBitmap;
rect : TRectF;
begin
APath.Scale(10, 10); // Enlarge
rect := APath.GetBounds;
APath.Translate(-rect.Left + 5, -rect.Top + 5); // offset onto bitmap
bmp := TBitmap.Create(Trunc(rect.Width)+10, Trunc(rect.Height)+10);
with bmp.Canvas do if BeginScene then begin
Clear(TAlphaColorRec.White);
Fill.Color := TAlphaColorRec.Black;
FillPath(APath, 1);
EndScene;
bmp.SaveToFile(AFileName + '.png');
end;
bmp.Free;
end;
I have a form which I need to print but only a certain section of it and then enlarge it (increase the scale). So far I have the following code:
procedure TForm1.PrintButtonClick(Sender: TObject);
var
printDialog : TPrintDialog;
begin
printDialog := TPrintDialog.Create(Form1);
if printDialog.Execute then
begin
Printer.Orientation := poLandscape; //Better fit than portrait
Form1.PrintScale:=poPrintToFit;
Form1.Print;
end;
end;
However, this prints the whole form. I've googled around and found a few different things that might help but I'm not sure how to use them:
GetFormImage - Is there a way of selecting a specific area with this or does it just take the whole form?
Using a rectangle with given coordinates e.g rectangle1:= rect(Left, Top, Right, Bottom); but then how do I print scale the rectangle to a larger size and print it? As well, seen as though Delphi only gives Left and Top properties, is Right just another name for the furthest left value you want to go to?
UPDATE:
I have tried to create a custom bitmap and then stretch it but I'm not using the strechdraw correctly. It doesn't actually stretch when printed:
procedure TForm1.PrintButtonClick(Sender: TObject);
var
printDialog: TPrintDialog;
Rectangle, stretched: TRect;
Bitmap: TBitmap;
begin
Bitmap := TBitmap.Create;
try
Rectangle := Rect(0, 90, 1450, 780);
stretched := Rect(0, 0, 5000, 3000); //what numbers do i put in here for streching it?
Bitmap.SetSize(Form1.Width, Form1.Height);
Bitmap.Canvas.CopyRect(Rectangle, Form1.Canvas, Rectangle);
Bitmap.Canvas.StretchDraw(stretched, Bitmap); //not sure how to use this
finally
printDialog := TPrintDialog.Create(Form1);
if printDialog.Execute then
begin
with printer do
begin
BeginDoc;
Canvas.Draw(0, 90, Bitmap);
EndDoc;
end;
end;
Bitmap.Free;
end;
end;
Is the try and finally necessary?
When I printed without the stretchdraw it was really small but when I printed with the stretchdraw, a lot of the image was missing so I must be using it wrong
Get rid of your stretched variable and the Bitmap.Canvas.StretchDraw (you can also get rid of the TPrintDialog if you'd like).
// Capture your bitmap content here, and then use this code to scale and print.
Printer.Orientation := poLandscape;
Printer.BeginDoc;
Printer.Canvas.StretchDraw(Rect(0, 0, Printer.PageWidth, Printer.PageHeight), Bitmap);
Printer.EndDoc;
I have created a print preview object which allows me to organise several graphic objects from different sources onto a printed page.
In order to render these objects on the printer canvas I have to first render them to a bitmap of the calculated size and then render the bitmap to the Tprinter canvas at the correct positions using the canvas.draw(x,y,bitmap) method.
I found out early on that a device independent bitmap is required and set the pixel format to pf24bit.
Tried this on the office HP laserjet, works fine, HP colour Deskjet works fine, Cannon colour printer however does not work or occasionally gives intermittent graphics at random points.
Now if I get the graphical objects to render directly to the printer canvas, then all work OK.
Rendering directly to the printer canvas however is not a workable long term solution for me for various reasons.
So, my question is, what is it about the Tprinter.canvas that makes it hardware dependent and is there any workarounds ?
Some example code which divides the page up into 4 quadrants with margins and cell padding and puts a graphical object in each quadrant. Each graphical object has a RenderToBitmap method which draws the graphics.
procedure TMultiPrintForm.PrintBtnClick(Sender: TObject);
var w,h,h2,w2,mv,iw,ih,pv,cw,ch:integer; Abmp:Tbitmap;
begin
Abmp:=Tbitmap.create;
Abmp.PixelFormat := pf24bit;
try
with Printer do
begin
w:=pagewidth;
h:=pageheight;
h2:=h div 2;
w2:=w div 2;
mv:=h*margin.value div 200; //margin percentage div 2
pv:=h*padding.value div 400; //padding percentage div 4
iw:=w-mv; //internal width
ih:=h-mv; //internal height
cw:=(iw-mv) div 2-pv; //Quadrant Cell Width
ch:=(ih-mv) div 2-pv; //Quadrant Cell Height
Abmp.width:=cw;
Abmp.height:=ch;
If Fsources[0]<>nil then
begin
Fsources[0].rendertoBitmap(Abmp);
canvas.draw(mv,mv,Abmp);
end;
If Fsources[1]<>nil then
begin
Fsources[1].rendertoBitmap(Abmp);
canvas.draw(w2+pv,mv,Abmp);
end;
If Fsources[2]<>nil then
begin
Fsources[2].rendertoBitmap(Abmp);
canvas.draw(mv,h2+pv,Abmp);
end;
If Fsources[3]<>nil then
begin
Fsources[3].rendertoBitmap(Abmp);
canvas.draw(w2+pv,h2+pv,Abmp);
end;
end;
finally
printer.Enddoc;
Abmp.free;
end
end;
On further investigation around the net, I accumulated some suggestions into a PrintBitmap procedure which uses a technique recommended by Microsoft.
I replaced all the Canvas.draw calls with PrintBitmap calls (it assumes begindoc and enddoc are set outside the calls).
Being as its the weekend, I can't test it on the problem printers in the office but it does at least not break the printing on the home HP Deskjet printer (which works anyway with both methods).
procedure PrintBitmap(X,Y:integer; Abmp:Tbitmap);
var Info: PBitmapInfo;
InfoSize,ImageSize: DWORD; Image: Pointer;
DIBWidth, DIBHeight: LongInt;
begin
with Printer do
begin
GetDIBSizes(Abmp.Handle, InfoSize, ImageSize);
Info := AllocMem(InfoSize);
Image := AllocMem(ImageSize);
try
GetDIB(Abmp.Handle, 0, Info^, Image^);
with Info^.bmiHeader do
begin
DIBWidth := biWidth;
DIBHeight := biHeight;
end;
StretchDIBits(Canvas.Handle, X, Y, DIBWidth, DIBHeight, 0, 0,
DIBWidth, DIBHeight, Image, Info^, DIB_RGB_COLORS, SRCCOPY);
finally
FreeMem(Image, ImageSize);
FreeMem(Info, InfoSize);
end
end;
end;
I want to load a picture (32 bit-depth, transparent) from a TImageList to an TImage. The standard approach would be ImageList.GetBitmap(Index, Image.Picture.Bitmap);. However the GetBitmap method doesn't work with transparency, so I always get a non-transparent bitmap.
The workaround is rather simple - ImageList offers another method, GetIcon, which works OK with transparency. Code to load a transparent Image would be:
ImageList.GetIcon(Index, Image.Picture.Icon);
And don't forget to set proper ImageList properties:
ImageList.ColorDepth:=cd32bit;
ImageList.DrawingStyle:=dsTransparent;
I too have had various issues with passing in images from the a tImageList. So I have a simple wrapper routine that generally does the job and it enforces the transparency. The code below is Delphi 2005 and imlActiveView is the tImageList component that has my set of button glyph images.
procedure TfrmForm.LoadBitmap (Number : integer; bmp : tBitMap);
var
ActiveBitmap : TBitMap;
begin
ActiveBitmap := TBitMap.Create;
try
imlActiveView.GetBitmap (Number, ActiveBitmap);
bmp.Transparent := true;
bmp.Height := ActiveBitmap.Height;
bmp.Width := ActiveBitmap.Width;
bmp.Canvas.Draw (0, 0, ActiveBitmap);
finally
ActiveBitmap.Free;
end
end;
Here is an example of use where the 5th imlActiveView image is passed into the btnNavigate.Glyph.
LoadBitmap (5, btnNavigate.Glyph)
I have an input edit field where the user can enter data. I want the box width to be at least 191px (min) and maximum 450px (max).
procedure THauptform.edtEingabeChange(Sender: TObject);
begin
// Scale
if Length(edtEingabe.Text) > 8 then
begin
if Hauptform.Width <= 450 then
begin
verschiebung := verschiebung + 9;
// The initial values like 'oldedtEingabeWidth' are global vars.
edtEingabe.Width := oldedtEingabeWidth + verschiebung;
buDo.Left := oldbuDoLeft + verschiebung;
Hauptform.Width := oldHauptformWidth + verschiebung;
end;
end;
end;
This works for ENTERING text. But when I delete one char, it does not scale back accordingly.
In your code, nothing will happen when your text is less than 8 characters long.
Also, I don't see any condition under which your width becomes smaller. It only becomes larger (by 9) with each iteration.
By the way, you appear to be multiplying by 9 as an average character width. You can use Canvas.TextWidth to determine the actual width required by the text without estimating.
If you want to use "9" anyway, you should name it as a constant to make clear what it is.
Quick and dirty using TextWidth:
const
MAX_EINGABE_WIDTH = 450;
MIN_EINGABE_WIDTH = 191;
procedure THauptform.edtEingabeChange(Sender: TObject);
var Width: Integer;
begin
// Scale
Width := edtEingabe.Canvas.TextWidth(edtEingabe.Text);
if Width > MAX_EINGABE_WIDTH then
Width := MAX_EINGABE_WIDTH
else if Width < MIN_EINGABE_WIDTH then
Width := MIN_EINGABE_WIDTH
edtEingabe.Width := Width;
end;
You're just adding 9 everytime the text changes and the length is grater than 8 - regardless of the change. You need to make it a function based on the length instead.
Something like this would do the trick:
procedure THauptform.edtEingabeChange(Sender: TObject);
var
len: integer;
additionalWidth: integer;
begin
len := Length(edtEingabe.Text);
if len <=8 then
additionalWidth:=0
else
additionalWidth:=(len-8)*9; //Assuming we need an extra 9 pixels per character after the 8th one
if additionalWidth > 259 then additionalWidth := 259; // maximum - minimum
edtEingabe.Width := 191 + additionalWidth;
Width := OriginalFormWidth + additionalWidth; // You'll need to know what the minimum width of your form is
end;
This isn't really a very pretty solution, though - changing all of those properties in the same way is ugly. Instead, since it appears you're also resizing the form, you can change the Anchors property of your edit box to make it maintain its margin to the right side as well, and only resize your form.
However, you probably want to consider if this is really a good idea. Why not let the input field just have a single size? In general, it looks better if windows don't resize on their own.
Do something like this:
procedure THauptform.edtEingabeChange(Sender: TObject);
var
Edit:TEdit;
begin
Edit := TEdit(Sender);
Edit.Width := Canvas.TextWidth(Edit.Text+' |')+
Edit.Padding.Left+
Edit.Padding.Right;
end;
Note 1: Don't manually try to limit the size. Instead, set Constraints.MinWidth and Constraints.MaxWidth via the property editor. That leaves your code clean and useless GUI stuff like this in the .dfm.
Note 2: TEdit doesn't have any public canvas property that you can use to get the text width.
Note 3: I don't like this kind of interface with growing and shrinking inputs, but it's probably just a matter of personal taste.