Firemonkey Rotate Text - delphi

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 );
}

Related

Delphi: How to print multiple images in one page using Printer?

I cannot seem to figure out how to print multiple images in one page using Printer,
I want to display images side by side like this:
But the problem is the images always display in full page like this:
I have this code:
procedure TForm1.Button1Click(Sender: TObject);
var
MyRect: TRect;
scale: Double;
Bitmap : TBitmap;
i: integer;
begin
try
Bitmap := TBitmap.Create;
Bitmap.Width := Image1.Picture.Width;
Bitmap.Height := Image1.Picture.Height;
Bitmap.Canvas.Draw(0,0,Image1.Picture.Graphic);
if PrintDialog1.Execute then
begin
if Printer.Orientation = poPortrait then
scale := GetDeviceCaps(Printer.Handle, LOGPIXELSX) / Screen.PixelsPerInch
else
scale := GetDeviceCaps(Printer.Handle, LOGPIXELSY) / Screen.pixelsperinch;
Printer.BeginDoc;
MyRect := Rect(0,0, trunc(Bitmap.Width * scale), trunc(Bitmap.Height * scale));
Printer.Canvas.StretchDraw(MyRect, Bitmap);
Printer.EndDoc;
end;
finally
Bitmap.Free;
end;
end;
I want to the printer to printout images side by side, how can I accomplish that?
Can any one help me please?
Update:
procedure TForm1.Button1Click(Sender: TObject);
var
MyRect: TRect;
scale: Double;
Bitmap : TBitmap;
i, x, y, width, height, img_count: integer;
begin
Bitmap := TBitmap.Create;
x := 0;
y := 0;
img_count := 3;
try
begin
Bitmap.Width := Image1.Picture.Width;
Bitmap.Height := Image1.Picture.Height;
Bitmap.Canvas.Draw(0,0,Image1.Picture.Graphic);
if PrintDialog1.Execute then
begin
if Printer.Orientation = poPortrait then
scale := GetDeviceCaps(Printer.Handle, LOGPIXELSX) / Screen.PixelsPerInch
else
scale := GetDeviceCaps(Printer.Handle, LOGPIXELSY) / Screen.pixelsperinch;
Printer.BeginDoc;
for i := 1 to img_count do
begin
width := trunc(Bitmap.Width * scale / img_count);
height := trunc(Bitmap.Height * scale / img_count);
MyRect := Rect(x, y, width, height);
Printer.Canvas.StretchDraw(MyRect, Bitmap);
x := x + width;
end;
Printer.EndDoc;
end;
end;
finally
Bitmap.Free;
end;
end;
Now it displays the images like sticking at each other, an I want them to display with a little margin between them:
This is when I add margins:
This is without margins:
You have to halfway understand your code, then it will all become obvious. Canvas and Rect are literally just that - and if you max your rectangle out by scale you'll never put two pictures side by side. Cut the values in half and use understand the parameters of functions - I'll use more variables to make it more obvious why your approach is very easy to solve:
var
x, y, width, height: Integer;
...
begin
...
Printer.BeginDoc;
x:= 0; // Start on top left
y:= 0;
width:= trunc( Bitmap1.Width* scale/ 2 ); // Half of the size
height:= trunc( Bitmap1.Height* scale/ 2 )
Printer.Canvas.StretchDraw( Rect( x, y, width, height ), Bitmap1 );
x:= width; // Continue after picture on the right side
width:= trunc( Bitmap2.Width* scale/ 2 ); // Again half of the size
height:= trunc( Bitmap2.Height* scale/ 2 )
Printer.Canvas.StretchDraw( Rect( x, y, width, height ), Bitmap2 );
Printer.EndDoc;
This example presumes Bitmap1 and Bitmap2 have similar dimensions.

Delphi multi color value in TStringGrid

I want the currency values ​​in the TStringGrid table to have different color decimals. How can do that?
You need to draw the cells yourself by implementing an OnDrawCell handler.
Something like this:
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
Grid: TStringGrid;
S: string;
Val: Double;
FracVal, IntVal: Integer;
FracStr, IntStr: string;
IntW, FracW, W, H: Integer;
Padding: Integer;
const
PowersOfTen: array[0..8] of Integer =
(
1,
10,
100,
1000,
10000,
100000,
1000000,
10000000,
100000000
);
Decimals = 2;
BgColor = clWhite;
IntColor = clBlack;
FracColor = clRed;
begin
Grid := Sender as TStringGrid;
if (ACol < Grid.FixedCols) or (ARow < Grid.FixedRows) then
Exit;
Grid.Canvas.Brush.Color := BgColor;
Grid.Canvas.FillRect(Rect);
S := Grid.Cells[ACol, ARow];
Padding := Grid.Canvas.TextWidth('0') div 2;
if not TryStrToFloat(S, Val) or not InRange(Val, Integer.MinValue, Integer.MaxValue) then
begin
Grid.Canvas.TextRect(Rect, S, [tfSingleLine, tfVerticalCenter, tfLeft]);
Exit;
end;
IntVal := Trunc(Val);
IntStr := IntVal.ToString;
if Decimals > 0 then
IntStr := IntStr + FormatSettings.DecimalSeparator;
IntW := Grid.Canvas.TextWidth(IntStr);
FracVal := Round(Frac(Abs(Val)) * PowersOfTen[Decimals]);
FracStr := FracVal.ToString.PadRight(Decimals, '0');
if Decimals = 0 then
FracStr := '';
FracW := Grid.Canvas.TextWidth(FracStr);
W := IntW + FracW;
H := Grid.Canvas.TextHeight(IntStr);
if W >= Grid.ColWidths[ACol] - 2*Padding then
begin
S := '###';
Grid.Canvas.TextRect(Rect, S, [tfSingleLine, tfVerticalCenter, tfRight]);
end
else
begin
Grid.Canvas.Font.Color := IntColor;
Grid.Canvas.TextOut(Rect.Right - Padding - W,
Rect.Top + Rect.Height div 2 - H div 2, IntStr);
Grid.Canvas.Font.Color := FracColor;
Grid.Canvas.TextOut(Rect.Right - Padding - FracW,
Rect.Top + Rect.Height div 2 - H div 2, FracStr);
end;
end;
This code will write non-numeric data left-aligned as is. For numeric data, it will draw the values with a fixed number of decimals. You can choose the decimals (0..8), as well as the colours of the integral and fractional parts. If the number doesn't fit in its cell, ### will be displayed instead.
I haven't fully tested the code. I'll leave that to you as an exercise.
Update: Sorry, I forgot you are using Delphi 7. This means that you need to replace IntVal.ToString with IntToStr(IntVal) and so on.

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;

Delphi - gradial fade of bitmap edges

Any library/code to fade the edges of a bitmap in a gradient manner?
Something like this:
Edit: final code
Ok came up with this code after your example, it's ~10 times faster after optimization with scanlines. Ideally I think I should convert it to use a 32bit bitmap instead and modify the actual alpha layer, but this works for now, ty!
procedure FadeEdges(b: TBitmap; Depth, Start, Col: TColor);
Var f, x, y, i: Integer;
w,h: Integer;
pArrays: Array of pRGBArray;
xAlpha: Array of byte;
sR, sG, sB: Byte;
a,a2: Double;
r1,g1,b1: Double;
Lx,Lx2: Integer;
procedure AlphaBlendPixel(X, Y: Integer);
begin
pArrays[y,x].rgbtRed := Round(r1 + pArrays[y,x].rgbtRed * a2);
pArrays[y,x].rgbtGreen := Round(g1 + pArrays[y,x].rgbtGreen * a2);
pArrays[y,x].rgbtBlue := Round(b1 + pArrays[y,x].rgbtBlue * a2);
end;
procedure AlphaBlendRow(Row: Integer; Alpha: Byte);
Var bR, bG, bB, xA: Byte;
t: Integer;
s,s2: Double;
begin
s := alpha / 255;
s2 := (255 - Alpha) / 255;
for t := 0 to b.Width-1 do begin
bR := pArrays[Row,t].rgbtRed;
bG := pArrays[Row,t].rgbtGreen;
bB := pArrays[Row,t].rgbtBlue;
pArrays[Row,t].rgbtRed := Round(sR*s + bR*s2);
pArrays[Row,t].rgbtGreen := Round(sG*s + bG*s2);
pArrays[Row,t].rgbtBlue := Round(sB*s + bB*s2);
end;
end;
begin
b.PixelFormat := pf24bit;
// cache scanlines
SetLength(pArrays,b.Height);
for y := 0 to b.Height-1 do
pArrays[y] := pRGBArray(b.ScanLine[y]);
// pre-calc Alpha
SetLength(xAlpha,Depth);
for y := 0 to (Depth-1) do
xAlpha[y] := Round(Start + (255 - Start)*y/(Depth-1));
// pre-calc bg color
sR := GetRValue(Col);
sG := GetGValue(Col);
sB := GetBValue(Col);
// offsets
w := b.Width-Depth;
h := b.Height-Depth;
for i := 0 to (Depth-1) do begin
a := xAlpha[i] / 255;
a2 := (255 - xAlpha[i]) / 255;
r1 := sR * a;
g1 := sG * a;
b1 := sB * a;
Lx := (Depth-1)-i;
Lx2 := i+w;
for y := 0 to b.Height - 1 do begin
AlphaBlendPixel(Lx, y); // Left
AlphaBlendPixel(Lx2, y); // right
end;
end;
for i := 0 to (Depth-1) do begin
AlphaBlendRow((Depth-1)-i, xAlpha[i]); // top
AlphaBlendRow(i+(h), xAlpha[i]); // bottom
end;
SetLength(xAlpha,0);
SetLength(pArrays,0);
end;
Final result: (left = original, right = blended on hovering with a ListView)
edit: further speed improvements, twice as fast as original proc.
I can give you some code I wrote a couple of years ago to achieve this. It might be useful as a guide. The code is part of a class that manipulates a bitmap and this is the part that fades the left edge of the bitmap into a white background:
procedure TScreenShotEnhancer.FadeOutLeft(Position, Start: Integer);
var
X, Y: Integer;
F, N: Integer;
I: Integer;
begin
BeginUpdate;
try
N := Position;
for I := 0 to N - 1 do begin
X := Position - I - 1;
F := Round(Start + (255 - Start)*I/N);
for Y := 0 to Height - 1 do
AlphaBlendPixel(X, Y, clWhite, F);
end;
finally
EndUpdate;
end;
end;
The actual work is done in this method:
procedure TScreenShotEnhancer.AlphaBlendPixel(X, Y: Integer; Color: TColor;
Alpha: Byte);
var
backgroundColor: TColor;
displayColor: TColor;
dR, dG, dB: Byte;
bR, bG, bB: Byte;
sR, sG, sB: Byte;
begin
backgroundColor := Bitmap.Canvas.Pixels[X, Y];
bR := GetRValue(backgroundColor);
bG := GetGValue(backgroundColor);
bB := GetBValue(backgroundColor);
sR := GetRValue(Color);
sG := GetGValue(Color);
sB := GetBValue(Color);
dR := Round(sR * alpha / 255 + bR * (255 - alpha) / 255);
dG := Round(sG * alpha / 255 + bG * (255 - alpha) / 255);
dB := Round(sB * alpha / 255 + bB * (255 - alpha) / 255);
displayColor := RGB(dR, dG, dB);
Bitmap.Canvas.Pixels[X, Y] := displayColor;
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