Get the coordinates of the limits of a text with Delphi - delphi

Hi I use the follow code to draw a rotate text in my Delphi application. The user can choose if use or not use GDI+ to draw the text:
procedure TForm1.Button1Click(Sender: TObject);
var
MyLogFont: TLogFont;
MyFont: HFont;
t: string;
ff: IGPFontfamily;
ft: IGPFont;
br: IGPSolidBrush;
gr: IGPGraphics;
pp: TGPPointF;
Pen: IGPPen;
begin
t := 'Hello';
if not DrawUsingGDIP.Checked then
begin
// Draw using GDI
FillChar(MyLogFont, Sizeof(MyLogFont), 0);
with MyLogFont do
begin
lfHeight:=0;
lfWidth:=0;
lfEscapement:=-StrToInt(Edit1.Text)*10;
lfOrientation:=-StrToInt(Edit1.Text)*10;
lfWeight:=FW_NORMAL;
lfItalic:=0;
lfUnderline:=0;
lfStrikeOut:=0;
lfCharSet:=DEFAULT_CHARSET;
lfOutPrecision:=OUT_DEFAULT_PRECIS;
lfClipPrecision:=CLIP_DEFAULT_PRECIS;
lfQuality:=DEFAULT_QUALITY;
lfPitchAndFamily:=1;
end;
MyFont:=CreateFontIndirect(MyLogFont);
Form1.Canvas.Font.Handle:=MyFont;
Form1.Canvas.Font.Name := 'Arial';
Form1.Canvas.Font.Size := 13;
Form1.Canvas.TextOut(103, 100, t);
end
else
begin
// Draw using GDI+
Pen := TGPPen.Create($FF000000);
ff := TGPFontFamily.Create('Arial');
ft := TGPFont.Create(ff, 16, FontStyleRegular, UnitPixel);
br := TGPSolidBrush.Create(TGPColor.Red);
gr := TGPGraphics.Create(Form1.Canvas.Handle);
gr.SetTextRenderingHint(TextRenderingHintAntiAlias);
gr.TranslateTransform(100.0, 100.0);
gr.RotateTransform(StrToInt(Edit1.Text));
pp := TGPPointF.Create(0, 0);
gr.DrawString(t, ft, pp, br);
gr.ResetTransform;
end;
end;
Now I need know (if possible without draw the text) the coordinates of the vertices of the rectangle that bounds the text (see the image):
Is there a simple way to get these coordinates both with and without use GDI+ library?

For the GDI implementation you can use something like
tsiz := Form1.Canvas.TextExtent(t); // tsiz : tagSIZE
ang := (2.0*Pi*StrToInt(Edit1.Text))/360; // ang : double
tpts[0].X := 100; // tpts : Array[0..4] of TPoint
tpts[0].Y := 100;
tpts[1].X := 100 + Round(tsiz.cx * Cos(ang));
tpts[1].Y := 100 + Round(tsiz.cx * Sin(ang));
tpts[2].X := tpts[1].X - Round(tsiz.cy*Sin(ang));
tpts[2].Y := tpts[1].Y + Round(tsiz.cy*Cos(ang));
tpts[3].X := tpts[0].X - Round(tsiz.cy*Sin(ang));
tpts[3].Y := tpts[0].Y + Round(tsiz.cy*Cos(ang));
tpts[4] := tpts[0];
//tpts now contains corner points of the bounding rect
Form1.Canvas.TextOut(100, 100, t); // draw text
Form1.Canvas.Polyline(tpts); // draw bounding rect
for GDI+ it's a lot easier
sft := TGPStringFormat.GenericDefault; // sft : IGPStringFormat
mRect := gr.MeasureString(t, ft, pp, sft); // mRect : TGPRectF
// do this after transforms
// mRect is now the bounding rect
gr.DrawRectangle(Pen,mRect);
// mRect is transformed by DrawRectangle - coordinates can be
// calculated in the same way as the GDI case where
// mRect.Width -> tsiz.cx and mRect.Height -> tsiz.cy

Related

How to draw text in a canvas vertical + horizontal with Delphi 10.2

I want to draw on a canvas a word vertically and next to it a word horizontally.
I used a old suggestion like this :
in the maiForm's create event :
GetObject(MainForm.Font.Handle,SizeOf(TLogFont),#LogFont);
NewLogFont := LogFont;
NewLogFont.lfEscapement := 900;
NewFont := CreateFontIndirect(NewLogFont);
OldFont := MainForm.Font.Handle;
where
LogFont,NewLogFont : TLogFont;
NewFont,OldFont : HFont;
and in drawing routine :
fontTemp := TFont.Create;
fontTemp.Assign(aCanvas.Font);
......
aCanvas.Font.Handle := newFont; // if i coment this line the two strings drawn verically else both drawn horizonatlly
aCanvas.Font.Size := 8;
h := textHeight('1');
aCanvas.textOut(x,y,aString);
aCanvas.Font.Assign(fontTemp);
aCanvas.textOut(x+20,y,bString);
.....
fontTemp.Free;
In my old application (D2007) it worked ok but in Delphi 10.2, the change of orientation (from vert to horiz) changes both strings to horiz.
Any help please ?
No, as you said it is not an absolutely rare code. This approach lets you rotate text without using VCL's canvas properties.
Pure WinAPI for output text with rotation
The code below uses no VCL's capabilities to output rotated text onto provided device context (HDC).
procedure TForm1.DrawTextRotatedA(ADC: HDC; AFontHandle: HFONT;
Angle, X, Y: Integer; AColor: COLORREF; AText: String);
var
LogFont: tagLOGFONT;
OldFontHandle: HFONT;
NewFontHandle: HFONT;
begin
if (ADC = 0) or (AFontHandle = 0) then
Exit;
if GetObject(AFontHandle, SizeOf(LogFont), #LogFont) = 0 then
Exit;
// Set color of text and its rotation angle
SetTextColor(ADC, AColor);
if Angle > 360 then
Angle := 0;
LogFont.lfEscapement := Angle * 10;
LogFont.lfCharset := 1;
LogFont.lfOutPrecision := OUT_TT_PRECIS;
LogFont.lfQuality := PROOF_QUALITY;
// Create new font
NewFontHandle := CreateFontIndirect(LogFont);
try
OldFontHandle := SelectObject(ADC, NewFontHandle);
try
// Output result
SetBKMode(ADC, TRANSPARENT);
try
TextOut(ADC, X, Y, LPCWSTR(AText), Length(AText));
finally
SetBKMode(ADC, OPAQUE);
end;
finally
// Restore font handle
NewFontHandle := SelectObject(ADC, OldFontHandle);
end;
finally
// Delete font handle
DeleteObject(NewFontHandle);
end;
end;
There are places for improvements but this is just an example to prove you are wrong calling such a code rare. This example expects HFONT as one of arguments to perform all actions over it. You probably could get font handle from TControl by using WM_GETFONT message, but most of VCL's components don't honor this message (it works, f.e. with TListView which returns correct font handle). Trying to get font handle from HDC returns System font that doesn't support rotation at all. Perhaps I did something wrong but I have acted accordingly to microsoft.docs.
Using VCL for output text with rotation
I didn't get what code you have provide in your question should to do (it is cannot be compiled) so I rewrite it to show you how to output rotated text with using VCL's capabilities.
procedure TForm1.DrawTextRotatedB(ACanvas: TCanvas; Angle, X, Y: Integer;
ATextColor: TColor; AText: String);
var
NewX: Integer;
NewY: integer;
Escapement: Integer;
LogFont: TLogFont;
NewFontHandle: HFONT;
OldFontHandle: HFONT;
begin
if not Assigned(ACanvas) then
Exit;
// Get handle of font and prepare escapement
GetObject(ACanvas.Font.Handle, SizeOf(LogFont), #LogFont);
if Angle > 360 then
Angle := 0;
Escapement := Angle * 10;
// We must initialise all fields of the record structure
LogFont.lfWidth := 0;
LogFont.lfHeight := ACanvas.Font.Height;
LogFont.lfEscapement := Escapement;
LogFont.lfOrientation := 0;
if fsBold in ACanvas.Font.Style then
LogFont.lfWeight := FW_BOLD
else
LogFont.lfWeight := FW_NORMAL;
LogFont.lfItalic := Byte(fsItalic in ACanvas.Font.Style);
LogFont.lfUnderline := Byte(fsUnderline in ACanvas.Font.Style);
LogFont.lfStrikeOut := Byte(fsStrikeOut in ACanvas.Font.Style);
LogFont.lfCharSet := ACanvas.Font.Charset;
LogFont.lfOutPrecision := OUT_DEFAULT_PRECIS;
LogFont.lfClipPrecision := CLIP_DEFAULT_PRECIS;
LogFont.lfQuality := DEFAULT_QUALITY;
LogFont.lfPitchAndFamily := DEFAULT_PITCH;
StrPCopy(LogFont.lfFaceName, ACanvas.Font.Name);
// Create new font with rotation
NewFontHandle := CreateFontIndirect(LogFont);
try
// Set color of text
ACanvas.Font.Color := ATextColor;
// Select the new font into the canvas
OldFontHandle := SelectObject(ACanvas.Handle, NewFontHandle);
try
// Output result
ACanvas.Brush.Style := VCL.Graphics.bsClear;
try
ACanvas.TextOut(X, Y, AText);
finally
ACanvas.Brush.Style := VCL.Graphics.bsSolid;
end;
finally
// Restore font handle
NewFontHandle := SelectObject(ACanvas.Handle, OldFontHandle);
end;
finally
// Delete the deselected font object
DeleteObject(NewFontHandle);
end;
end;
Using case
Here is the code showing how to use procedures for rotating text.
procedure TForm1.aButton1Click(Sender: TObject);
var
DC: HDC;
begin
Repaint;
DC := GetDC(Handle);
try
DrawTextRotatedA(DC, Canvas.Font.Handle, TrackBar1.Position, 100, 100, clNavy, 'String');
finally
ReleaseDC(Handle, DC);
end;
DrawTextRotatedB(Canvas, TrackBar1.Position, 200, 100, clNavy, 'String');
end;
Sometimes it is faster to output rotated text onto DC without VCL. This could be useful if you are trying to deal with control that have no access to canvas. F.e. if you will try to paint tooltip (tooltip_class32) in your own style you probably might want to use the first method to output text (rotated or not).
Information
Here are links from docs.microsoft. they describe how and why one or another function was used.
About Device Contexts
TextOutW function
SetTextColor function
tagLOGFONTW structure
GetObject function
WM_GETFONT message
It's simple!
TFont has the property orientation that does the work! All this stuf I used is absolutely rare.

Need a method to calculate the extents of the actual drawing items in a tcanvas

I am using a paintbox component to draw various shapes using rect, polygon and other canvas methods. After the user has created the drawing, I want to save a bitmap for use in a listbox. The problem is that the drawing may only use a small portion of the canvas and the resulting image in the listbox would be very small unless I adjust its size by selecting only the used portion of the paintbox's original canvas. So the question is how do I determine what portion of the canvas has been used so I can extract only that part of the canvas to load into a bitmap for display in listbox?
(Note:I edited above to clarify the question a bit)
The actual program has a paintbox (200x200) and an image (32 x 32). The image gets its bitmap from the paintbox using Bitmap1.Canvas.CopyRect(Dest, PaintBox1.Canvas, Source);. If the drawing in the paintbox is only 20x20 in the 200x200 paintbox.canvas, then the resulting bitmap in the Image.canvas will be very small in the 32x32 image.canvas. I need it to be enlarged and that means that I must determine the actual size of the used area in the paintbox and change the source size in 'CopyRec'.
One approach I have worked out is based on the assumption that the various items that have been drawn such as circles, rectangles, text, etc are all placed on a neutral background. In that case I can read the bitmap using tbitmap.scanline to compare the color of the drawing vs the background color and calculate the extents of the drawing in each row to determine the extents of the drawing in the overall bitmap.
TRGBTriple = packed record
rgbtBlue: Byte;
rgbtGreen: Byte;
rgbtRed: Byte;
end;
TRGBTripleArray = ARRAY[Word] of TRGBTriple;
pRGBTripleArray = ^TRGBTripleArray; // use a PByteArray for pf8bit color
function findBMPExtents (Bmp : tbitmap; BkgdClr : longint):trect;
// finds the extents of an image in a background or BkgdClr color
//works on 24 bit colors
var
P : pRGBTripleArray;
x,y : integer;
tfound, bfound, done : boolean;
WorkTrpl : TRGBTriple;
WorkRect : trect;
begin
result.top := 0;
result.bottom := Bmp.height;
result.left := Bmp.Width;
result.right := 0;
tfound := false;
bfound := false;
WorkTrpl := getRGB (BkgdClr);
//find left and top
y := 0;
done := false;
Repeat
P := Bmp.ScanLine[y];
x := 0;
Repeat
if (p[x].rgbtBlue <> WorkTrpl.rgbtBlue) or
(p[x].rgbtGreen <> WorkTrpl.rgbtGreen) or
(p[x].rgbtRed <> WorkTrpl.rgbtRed) then
begin
tfound := true;
if x <= result.left then begin
result.left := x;
done := true;
end;
end;
inc (x);
until (x = bmp.width) or done;
done := false;
inc (y);
if not tfound then
inc(result.top);
until (y = bmp.height);
//find right and bottom
y := bmp.height - 1;
done := false;
Repeat
P := Bmp.ScanLine[y];
x := bmp.width-1;
Repeat
if (p[x].rgbtBlue <> WorkTrpl.rgbtBlue) or
(p[x].rgbtGreen <> WorkTrpl.rgbtGreen) or
(p[x].rgbtRed <> WorkTrpl.rgbtRed) then
begin
bfound := true;
if x >= result.right then begin
result.right := x;
done := true;
end;
end;
dec (x);
Until (x = 0) or done;
if not bfound then
dec(result.bottom);
done := false;
dec (y);
Until (y = -1);
dec(result.bottom);
end;

Firemonkey Rotate Text

I want to draw Text on a canvas. To do the rotation I used the following code from https://forums.embarcadero.com/thread.jspa?messageID=440010
//bm is a TImage
a := 45;
c:= bm.Canvas;
CurrentM := c.Matrix;
a:=-radian(a);
m.m11:= cos(a); m.m12:=sin(a); m.m13:=0;
m.m21:=-sin(a); m.m22:=cos(a); m.m23:=0;
m.m31:=0; m.m32:=0; m.m33:=1;
c.setmatrix(M);
c.BeginScene;
c.filltext(rectf(100,100,5000,5000), 'test rotated string', false,1,[],ttextalign.taLeading,ttextalign.taLeading);
c.EndScene;
This works fine. I have set my rectangle's right and bottom to 5000 so that I do not have to be worried about my rectangle being to small.
The problem is that I now want to change my TextAlignment properties. So to draw text from right to left I had to adjust my rectangle and then draw it in the following way:
c.BeginScene;
c.filltext(rectf((100 - 5000),100,100,5000), 'test rotated string', false,1,[],ttextalign.taTrailing,ttextalign.taLeading);
c.EndScene;
So basically I moved the x value of my rectangle's TopLeft and moved it back 5000 (again I am using 5000 to make sure my text fit). I then set the x value of my rectangle's bottom right to where the x value was in my previous example's rectangle's TopLeft.
This work fine for a 0 degree rotation, but as soon as I change the degrees I does not draw my text at the correct place. I assume this is because the text will rotate around the rectangle's TopLeft position (which is altered to make the text write from right to left).
I assume this is because the text will rotate around the rectangle's TopLeft position
No, the rotation is centered around the current origin of the canvas. By default, that is coordinate 0, 0, but could be altered by the currently set deformation matrix. The typical way to go is: choose a rotation center, move the origin to that center, rotate, move back to the changed origin, and then draw. See TControl.MatrixChanged for reference. But there are many other ways.
Hereby an example of how to paint text from the lower left to the upper right within a form:
procedure TForm1.FormPaint(Sender: TObject; Canvas: TCanvas;
const ARect: TRectF);
var
Angle: Single;
R: TRectF;
S: String;
H: Single;
Matrix: TMatrix;
begin
Canvas.Fill.Color := TAlphaColors.Black;
Angle := -ArcTan2(ClientHeight, ClientWidth);
R := ClientRect;
S := 'Text from bottom-left...';
H := Canvas.TextHeight(S);
Matrix := CreateRotationMatrix(Angle);
Matrix.m31 := Sin(Angle) * (ClientHeight - H);
Matrix.m32 := ClientHeight * (1 - Cos(Angle));
Canvas.SetMatrix(Matrix);
Canvas.FillText(R, S, False, 1, [], TTextAlign.taLeading,
TTextAlign.taTrailing);
S := '...to top-right';
Matrix.m31 := ClientWidth * (1 - Cos(Angle)) + Sin(Angle) * H;
Matrix.m32 := -Sin(Angle) * ClientWidth;
Canvas.SetMatrix(Matrix);
Canvas.FillText(R, S, False, 1, [], TTextAlign.taTrailing,
TTextAlign.taLeading);
end;
Update:
This code does not yet take an already shifted origin into account.
In response to your comment, the following code draws text from coordinate 50, 100 down, 90° rotated around that point, using the method explained above, on a PaintBox which is arbitrarily positioned on the form.
procedure TForm1.PaintBox1Paint(Sender: TObject; Canvas: TCanvas);
const
S = 'Hello World';
var
R: TRectF;
OriginalMatrix: TMatrix;
ShiftMatrix: TMatrix;
RotationMatrix: TMatrix;
ShiftBackMatrix: TMatrix;
Matrix: TMatrix;
begin
PaintBox1.Canvas.Fill.Color := TAlphaColors.Black;
R.Right := 50;
R.Bottom := 100;
R.Left := R.Right - 5000;
R.Top := R.Bottom - 5000;
OriginalMatrix := PaintBox1.Canvas.Matrix;
ShiftMatrix := IdentityMatrix;
ShiftMatrix.m31 := -R.Right;
ShiftMatrix.m32 := -R.Bottom;
RotationMatrix := CreateRotationMatrix(DegToRad(-90));
ShiftBackMatrix := IdentityMatrix;
ShiftBackMatrix.m31 := R.Right;
ShiftBackMatrix.m32 := R.Bottom;
Matrix := MatrixMultiply(RotationMatrix, ShiftBackMatrix);
Matrix := MatrixMultiply(ShiftMatrix, Matrix);
Matrix := MatrixMultiply(Matrix, OriginalMatrix);
PaintBox1.Canvas.SetMatrix(Matrix);
PaintBox1.Canvas.FillText(R, S, False, 1, [], TTextAlign.taTrailing,
TTextAlign.taTrailing);
PaintBox1.Canvas.SetMatrix(OriginalMatrix);
end;
Which can be reduced to:
procedure TForm1.PaintBox1Paint(Sender: TObject; Canvas: TCanvas);
const
S = 'Hello World';
var
R: TRectF;
SaveMatrix: TMatrix;
Matrix: TMatrix;
begin
PaintBox1.Canvas.Fill.Color := TAlphaColors.Black;
R := RectF(-Canvas.TextWidth(S), -Canvas.TextHeight(S), 0, 0);
SaveMatrix := PaintBox1.Canvas.Matrix;
Matrix := CreateRotationMatrix(DegToRad(-90));
Matrix.m31 := 50;
Matrix.m32 := 100;
PaintBox1.Canvas.MultyMatrix(Matrix);
PaintBox1.Canvas.FillText(R, S, False, 1, [], TTextAlign.taTrailing,
TTextAlign.taTrailing);
PaintBox1.Canvas.SetMatrix(SaveMatrix);
end;
Which in turn evolves into this general routine:
procedure DrawRotatedText(Canvas: TCanvas; const P: TPointF; RadAngle: Single;
const S: String; HTextAlign, VTextAlign: TTextAlign);
var
W: Single;
H: Single;
R: TRectF;
SaveMatrix: TMatrix;
Matrix: TMatrix;
begin
W := Canvas.TextWidth(S);
H := Canvas.TextHeight(S);
case HTextAlign of
TTextAlign.taCenter: R.Left := -W / 2;
TTextAlign.taLeading: R.Left := 0;
TTextAlign.taTrailing: R.Left := -W;
end;
R.Width := W;
case VTextAlign of
TTextAlign.taCenter: R.Top := -H / 2;
TTextAlign.taLeading: R.Top := 0;
TTextAlign.taTrailing: R.Top := -H;
end;
R.Height := H;
SaveMatrix := Canvas.Matrix;
Matrix := CreateRotationMatrix(RadAngle);
Matrix.m31 := P.X;
Matrix.m32 := P.Y;
Canvas.MultyMatrix(Matrix);
Canvas.FillText(R, S, False, 1, [], HTextAlign, VTextAlign);
Canvas.SetMatrix(SaveMatrix);
end;
procedure TForm1.PaintBox1Paint(Sender: TObject; Canvas: TCanvas);
begin
PaintBox1.Canvas.Fill.Color := TAlphaColors.Black;
DrawRotatedText(PaintBox1.Canvas, PointF(50, 100), DegToRad(-90),
'Hello world', TTextAlign.taTrailing, TTextAlign.taTrailing);
end;
procedure TmsLineWithArrow.DoDrawTo(const aCanvas: TCanvas;
const aOrigin: TPointF);
var
l_Proxy : TmsShape;
l_OriginalMatrix: TMatrix;
l_Matrix: TMatrix;
l_Angle : Single;
l_CenterPoint : TPointF;
l_TextRect : TRectF;
begin
inherited;
aCanvas.BeginScene;
if (StartPoint <> FinishPoint) then
begin
l_OriginalMatrix := aCanvas.Matrix;
try
l_Proxy := TmsSmallTriangle.Create(FinishPoint);
try
// in Radian
l_Angle := GetArrowAngleRotation;
// create a point around which will rotate
l_CenterPoint := TPointF.Create(FinishPoint.X, FinishPoint.Y);
l_Matrix := l_OriginalMatrix;
l_Matrix := l_Matrix * TMatrix.CreateTranslation(-l_CenterPoint.X,-l_CenterPoint.Y);
l_Matrix := l_Matrix * TMatrix.CreateRotation(l_Angle);
l_Matrix := l_Matrix * TMatrix.CreateTranslation(l_CenterPoint.X,l_CenterPoint.Y);
aCanvas.SetMatrix(l_Matrix);
l_Proxy.DrawTo(aCanvas, aOrigin);
finally
FreeAndNil(l_Proxy);
end;//try..finally
finally
aCanvas.SetMatrix(l_OriginalMatrix);
aCanvas.EndScene;
end;
end;//(StartPoint <> FinishPoint)
end;
This code working in XE5 Firemonkey application.
all source here
https://bitbucket.org/ingword/mindstream
For people interested, here you will find the C++Builder version I use for FMX (tested on 10.2 / Tokyo) :
Function :
// Draw rotated text on pMainBitmap ; Rot = should be multiple of 90° !
void DrawRotatedText( TBitmap * pMainBitmap, TRectF TextDestRect, String StrTxt, int Rot )
(add of course "{" and "}" between the following code... always an error with the editor to post this answer...)
int SizeTextW = pMainBitmap->Canvas->TextWidth( StrTxt );
int SizeTextH = pMainBitmap->Canvas->TextHeight( StrTxt );
int SizeTextMax = (SizeTextW>SizeTextH)?SizeTextW:SizeTextH;
TRectF TheTextRect;
TheTextRect.init( 0, 0, SizeTextMax, SizeTextMax );
TBitmap * pBitmapText = new TBitmap( SizeTextMax, SizeTextMax );
if ( pBitmapText )
{
/* background color used */
pBitmapText->Clear( claBlack );
pBitmapText->Canvas->BeginScene();
// use same color than main bitmap for text
pBitmapText->Canvas->Fill->Color = pMainBitmap->Canvas->Fill->Color;
pBitmapText->Canvas->FillText(TheTextRect, StrTxt, false, 100,
TFillTextFlags()/* << TFillTextFlag::RightToLeft*/, TTextAlign::Center,
TTextAlign::Center);
pBitmapText->Canvas->EndScene();
// Canvas->EndScene must be done before doing bitmap rotate/flip...!
if( Rot==180 )
pBitmapText->FlipVertical( );
else if ( Rot!=0 )
pBitmapText->Rotate( Rot );
int PosSrcX = 0;
int PosSrcY = 0;
if ( SizeTextW>SizeTextH )
PosSrcX = (SizeTextMax-SizeTextH)/2;
else
PosSrcY = (SizeTextMax-SizeTextW)/2;
TheTextRect.init( PosSrcX, PosSrcY, PosSrcX+SizeTextH, PosSrcY+SizeTextW );
int iPosDestX = TextDestRect.left;
int iPosDestY = TextDestRect.top;
if ( (TextDestRect.right-TextDestRect.left)>SizeTextH )
iPosDestX = iPosDestX+(TextDestRect.right-TextDestRect.left-SizeTextH)/2;
if ( (TextDestRect.bottom-TextDestRect.top)>SizeTextW )
iPosDestY = iPosDestY + (TextDestRect.bottom-TextDestRect.top-SizeTextW)/2;
TextDestRect.left = iPosDestX;
TextDestRect.top = iPosDestY;
TextDestRect.right = TextDestRect.left+SizeTextH;
TextDestRect.bottom = TextDestRect.top+SizeTextW;
pMainBitmap->Canvas->DrawBitmap( pBitmapText, TheTextRect, TextDestRect, 100, true );
delete( pBitmapText );
}

Change orientation of a shape

I would like to know if there is a way to change the orientation of a TShape thus instead of a square , i would like to rotate it to look like a diamond..
If not a way with TShape, how could this be done?
A Delphi TShape is nothing more than drawing a bunch of vector graphics.
You can "rotate" the X/Y coordinates themselves with a 2-D transformation matrix. Computer Graphics 101:
http://www.cs.uic.edu/~jbell/CourseNotes/ComputerGraphics/2DTransforms.html
http://www.willamette.edu/~gorr/classes/GeneralGraphics/Transforms/transforms2d.htm
A TShape itself cannot be rotated. But you can use a TPaintBox to draw your own graphics anyway you wish, it is just a matter of mathematically plotting the points to draw between. For example:
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
Points: array[0..3] of TPoint;
W, H: Integer;
begin
W := PaintBox1.Width;
H := PaintBox1.Height;
Points[0].X := W div 2;
Points[0].Y := 0;
Points[1].X := W;
Points[1].Y := H div 2;
Points[2].X := Points[0].X;
Points[2].Y := H;
Points[3].X := 0;
Points[3].Y := Points[1].Y;
PaintBox1.Canvas.Brush.Color := clBtnFace;
PaintBox1.Canvas.FillRect(Rect(0, 0, W, H));
PaintBox1.Canvas.Brush.Color := clBlue;
PaintBox1.Canvas.Pen.Color := clBlack;
PaintBox1.Canvas.Pen.Width := 1;
PaintBox1.Canvas.Polygon(Points);
end;

How to calculate an area of a Windows region (HRGN) in pixels?

What is the fastest way of getting the area of any arbitrary Windows region?
I know I can enumerate all points of bounding rectangle and call the PtInRegion() function but it seems not very fast. Maybe you know some faster way?
When you call GetRegionData, you'll get a list of non-overlapping rectangles that make up the region. Add up their areas, something like this:
function GetRegionArea(rgn: HRgn): Cardinal;
var
x: DWord;
Data: PRgnData;
Header: PRgnDataHeader;
Rects: PRect;
Width, Height: Integer;
i: Integer;
begin
x := GetRegionData(rgn, 0, nil);
Win32Check(x <> 0);
GetMem(Data, x);
try
x := GetRegionData(rgn, x, Data);
Win32Check(x <> 0);
Header := PRgnDataHeader(Data);
Assert(Header.iType = rdh_Rectangles);
Assert(Header.dwSize = SizeOf(Header^));
Rects := PRect(Cardinal(Header) + Header.dwSize);
// equivalent: Rects := PRect(#Data.Buffer);
Result := 0;
for i := 0 to Pred(Header.nCount) do begin
Width := Rects.Right - Rects.Left;
Height := Rects.Bottom - Rects.Top;
Inc(Result, Width * Height);
Inc(Rects);
end;
finally
FreeMem(Data);
end;
end;

Resources