Delphi image canvas... paint an area (triangle, rectangle, polygons) - delphi

I have a variable number of points on a canvas.
Sometime its four other times 3 points, or 6.
Is there a function that can paint the area inside?
Thank you for your help.

Use the TCanvas.Polygon function. Declare an array of TPoint, set its length to the count of your points, specify each point's coordinates (optionally modify canvas pen and/or brush) and pass this array to the TCanvas.Polygon function. Like in this boring example:
procedure TForm1.Button1Click(Sender: TObject);
var
Points: array of TPoint;
begin
SetLength(Points, 3);
Points[0] := Point(5, 5);
Points[1] := Point(55, 5);
Points[2] := Point(30, 30);
Canvas.Pen.Width := 2;
Canvas.Pen.Color := clRed;
Canvas.Brush.Color := clYellow;
Canvas.Polygon(Points);
end;
Here's how it looks like:

As a complement to TLama's excellent answer, this is a case where you can obtain pretty convenient syntax using the open array construct. Consider the helper function
procedure DrawPolygon(Canvas: TCanvas; const Points: array of integer);
var
arr: array of TPoint;
i: Integer;
begin
SetLength(arr, Length(Points) div 2);
for i := 0 to High(arr) do
arr[i] := Point(Points[2*i], Points[2*i+1]);
Canvas.Polygon(arr);
end;
defined and implemented once and for all. Now you can do simply
Canvas.Pen.Width := 2;
Canvas.Pen.Color := clRed;
Canvas.Brush.Color := clYellow;
DrawPolygon(Canvas, [5, 5, 55, 5, 30, 30]);
to draw the same figure as in TLama's example.

As a complement to both TLama's and Andreas answer, here's another alternative :
procedure TForm1.Button1Click(Sender: TObject);
begin
Canvas.Pen.Color := clRed;
Canvas.Brush.Color := clYellow;
Self.Canvas.Polygon( [Point(5,5), Point(55,5), Point(30,30)]);
end;
Utilizing open array construct and Point record.

Related

How can i use TRect in delphi to paint with a angle?

I want to paint something similar to the image? How can I rotate the TRect, to paint with a specific angle?
You need to specify the coordinates of the quadrilateral manually:
procedure TForm1.FormPaint(Sender: TObject);
var
W10,
H10,
Delta: Integer;
begin
W10 := ClientWidth div 10;
H10 := ClientHeight div 10;
Delta := W10;
Canvas.Brush.Color := clWhite;
Canvas.FillRect(ClientRect);
Canvas.Pen.Color := clBlack;
Canvas.Pen.Width := 8;
Canvas.Polygon(
[
Point(W10, H10),
Point(W10, ClientHeight - H10),
Point(ClientWidth - W10, ClientHeight - H10),
Point(ClientWidth - W10, H10)
]
);
Canvas.Brush.Color := $E8A200;
Canvas.Polygon(
[
Point(W10, H10),
Point(W10, ClientHeight - H10),
Point(ClientWidth div 2 - Delta, ClientHeight - H10),
Point(ClientWidth div 2 + Delta, H10)
]
);
end;
procedure TForm1.FormResize(Sender: TObject);
begin
Invalidate;
end;
produces the following output:
To rotate your drawing, you can use a Direct2D canvas and set the transformation as a rotation (You can translate, rotate, scale, skew, and combine several of them).
Example:
In your form, add the following:
private
FD2DCanvas : TDirect2DCanvas;
function CreateD2DCanvas: Boolean;
protected
procedure CreateWnd; override;
Then implement CreateD2DCanvas() and CreateWnd():
function TForm1.CreateD2DCanvas: Boolean;
begin
try
FD2DCanvas.Free;
FD2DCanvas := TDirect2DCanvas.Create(Handle);
Result := TRUE;
except
Result := FALSE;
end;
end;
procedure TForm1.CreateWnd;
begin
inherited;
CreateD2DCanvas;
end;
You must also provide a OnResize event handler like this:
procedure TForm1.FormResize(Sender: TObject);
begin
// When the windows is resized, we needs to recreate RenderTarget
CreateD2DCanvas;
Invalidate;
end;
And finally provide a OnPaint event handler like this:
procedure TForm1.FormPaint(Sender: TObject);
var
Rect1 : D2D1_RECT_F;
begin
FD2DCanvas.BeginDraw;
try
FD2DCanvas.Brush.Color := clRed;
FD2DCanvas.RenderTarget.SetTransform(TD2DMatrix3x2F.Identity);
Rect1 := Rect(50, 70, 80, 100);
FD2DCanvas.FillRectangle(Rect1);
FD2DCanvas.RenderTarget.SetTransform(TD2DMatrix3x2F.Rotation(30.0, Rect1.Left, Rect1.Top));
FD2DCanvas.Brush.Color := clYellow;
FD2DCanvas.FillRectangle(Rect1);
finally
FD2DCanvas.EndDraw;
end;
end;
Don't forget to add Winapi.D2D1 and Vcl.Direct2D in the uses clause.
The simple example above draw two rectangles (Actually squares), the first not rotated, the second rotated 30 degrees. Of course you can make as many transformations as you like. To combine transformations, you have to multiply them. Warning: this is not commutative: a translation followed by a rotation is not the same as the same rotation followed by the same rotation!
Edit: I wrote a blog post about this topic: https://francois-piette.blogspot.com/2020/08/direct2d-canvas-for-delphi-forms.html

How draw a shadow effect in a complete Bitmap image?

I want know if is possible draw a shadow effect in a complete Bitmap image already existent and after have a effect similar to this example below, where all area behind modal Form is my new Bitmap image already with the shadow effect? =>
This is pretty easy. First we need a routine that fades a given bitmap:
procedure FadeBitmap(ABitmap: TBitmap);
type
PRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = array[word] of TRGBTriple;
var
SL: PRGBTripleArray;
y: Integer;
x: Integer;
begin
ABitmap.PixelFormat := pf24bit;
for y := 0 to ABitmap.Height - 1 do
begin
SL := ABitmap.ScanLine[y];
for x := 0 to ABitmap.Width - 1 do
with SL[x] do
begin
rgbtRed := rgbtRed div 2;
rgbtGreen := rgbtGreen div 2;
rgbtBlue := rgbtBlue div 2;
end;
end;
end;
Then, when we want to display our modal message, we create a bitmap 'screenshot' of our current form, fade it, and place it on top of all controls of the form:
procedure TForm1.ButtonClick(Sender: TObject);
var
bm: TBitmap;
pn: TPanel;
img: TImage;
begin
bm := GetFormImage;
try
FadeBitmap(bm);
pn := TPanel.Create(nil);
try
img := TImage.Create(nil);
try
img.Parent := pn;
pn.BoundsRect := ClientRect;
pn.BevelOuter := bvNone;
img.Align := alClient;
img.Picture.Bitmap.Assign(bm);
pn.Parent := Self;
ShowMessage('Hello, Faded Background!');
finally
img.Free;
end;
finally
pn.Free;
end;
finally
bm.Free;
end;
end;
Hint: If you have more than one modal dialog to display in your application, you probably want to refactor this. To this end, have a look at TApplicationEvent's OnModalBegin and OnModalEnd events.

Delphi How to draw 2d array of TColor on TCanvas quickly?

I have a 2-dimensional array of TColor. And also I have a TCanvas. How can I draw this color map on canvas faster than with a for cycle?
For Example:
type
T2DAr = array of array of TColor;
var
ar: T2DAr;
Form1: TForm; // mainform
function main;
var x, y: integer;
begin
{filling array with colors as a 10x10}
for x := 0 to length(ar)-1 do
for y := 0 to length(ar[x])-1 do
Form1.Canvas.Pixels[x, y] := ar[x, y];
end;
This way works too slowly. I need a faster algorithm.
This has been answered many times. The answer is: use scanlines instead of the terribly slow Pixels property. Example:
function CreateBitmapReallyFast: TBitmap;
const
WHITE: TRGBTriple = (rgbtBlue: 255; rgbtGreen: 255; rgbtRed: 255);
BLACK: TRGBTriple = (rgbtBlue: 0; rgbtGreen: 0; rgbtRed: 0);
var
y: Integer;
scanline: PRGBTriple;
x: Integer;
begin
result := TBitmap.Create;
result.SetSize(1920, 1080);
result.PixelFormat := pf24bit;
for y := 0 to result.Height - 1 do
begin
scanline := result.ScanLine[y];
for x := 0 to result.Width - 1 do
begin
if odd(x) then
scanline^ := WHITE
else
scanline^ := BLACK;
inc(scanline);
end;
end;
end;
Even cooler:
with scanline^ do
begin
rgbtBlue := Random(255);
rgbtGreen := Random(255);
rgbtRed := Random(255);
end;
To try it:
procedure TForm1.FormPaint(Sender: TObject);
var
bm: TBitmap;
begin
bm := CreateBitmapReallyFast;
try
Canvas.Draw(0, 0, bm);
finally
bm.Free;
end;
end;
Of course, if you have a (packed) array of TRGBTriple or TRGBQuad, and the pixel format of the bitmap is the same, you can simply Move the data in memory from the array to the bitmap's scanlines.

How to draw transparent text on form?

Is there a way to draw a transparent text on form that has some controls? If I use TLabel control, it would always show behind controls on the form.
You cannot use a TLabel control, since it is not a windowed control, and therefore it will be hidden by every windowed child control of the form. You could use a TStaticText, which is indeed a windowed control (a STATIC control), but it will be a bit difficult to make it truly transparent, I'd suppose.
You can use layered windows for this:
Create a new VCL project, and add a bunch of windowed controls to it.
Create a new form in the project, named splash. Set BorderStyle to bsNone, and set the font name, size, and colour to whatever you desire (e.g., Segoe UI, 42, red).
Add a public method
procedure Tsplash.UpdateSplash(const Str: string);
var
R: TRect;
P: TPoint;
S: TPoint;
bm: TBitmap;
bf: TBlendFunction;
EXSTYLE: DWORD;
x, y: integer;
pixel: PRGBQuad;
TextRed,
TextGreen,
TextBlue: byte;
begin
EXSTYLE := GetWindowLong(Handle, GWL_EXSTYLE);
SetWindowLong(Handle, GWL_EXSTYLE, EXSTYLE or WS_EX_LAYERED);
R := ClientRect;
bm := TBitmap.Create;
try
bm.PixelFormat := pf32bit;
bm.SetSize(ClientWidth, ClientHeight);
bm.Canvas.Brush.Color := clBlack;
bm.Canvas.FillRect(ClientRect);
bm.Canvas.Font.Assign(Self.Font);
bm.Canvas.Font.Color := clWhite;
DrawText(bm.Canvas.Handle, PChar(Str), Length(Str), R,
DT_SINGLELINE or DT_VCENTER or DT_CENTER or DT_WORD_ELLIPSIS);
TextRed := GetRValue(Font.Color);
TextGreen := GetGValue(Font.Color);
TextBlue := GetBValue(Font.Color);
for y := 0 to bm.Height - 1 do
begin
pixel := bm.ScanLine[y];
x := 0;
while x < bm.Width do
begin
with pixel^ do
begin
rgbReserved := (rgbRed + rgbGreen + rgbBlue) div 3;
rgbBlue := TextBlue * rgbReserved div 255;
rgbGreen := TextGreen * rgbReserved div 255;
rgbRed := TextRed * rgbReserved div 255;
end;
inc(pixel);
inc(x);
end;
end;
P := Point(0, 0);
S := Point(bm.Width, bm.Height);
bf.BlendOp := AC_SRC_OVER;
bf.BlendFlags := 0;
bf.SourceConstantAlpha := 255;
bf.AlphaFormat := AC_SRC_ALPHA;
UpdateLayeredWindow(Handle, 0, nil, #S, bm.Canvas.Handle, #P, 0, #bf,
ULW_ALPHA)
finally
bm.Free;
end;
end;
To your main form, add private methods
procedure TForm1.CreateSplash;
var
p: TPoint;
begin
splash.Visible := true;
UpdateSplash;
end;
procedure TForm1.UpdateSplash;
var
p: TPoint;
begin
if not (Assigned(splash) and splash.Visible) then Exit;
p := ClientToScreen(Point(0, 0));
splash.SetBounds(p.X, p.Y, ClientWidth, ClientHeight);
splash.UpdateSplash('Sample Text');
end;
and call UpdateSplash every time the form is moved or resized:
procedure TForm1.WMMove(var Message: TWMMove);
begin
UpdateSplash;
end;
procedure TForm4.FormResize(Sender: TObject);
begin
UpdateSplash;
end;
Finally, you can do, just to try it out,
procedure TForm1.FormClick(Sender: TObject);
begin
if splash.Visible then
splash.Hide
else
CreateSplash;
end;
Compiled demo EXE

how to retrieve exact text width for RenderText in Graphics32

I think my question is clear enough, but I explain more. Simply, when we are using AntiAlias on RenderText procedure, the value gotten within TextWidth function is not correct. What can I do to get the right text width?
You can look for the algorithm in their own code. They must also calculate it. Anyway this is how I do it.
function TGR32Canvas.TextWidth(const Text: string): Integer;
var
TempFont: TFont;
TempWidth: Integer;
begin
if Text <> '' then
begin
TempFont := TFont.Create;
try
TempFont.Assign(Font);
TempFont.Size := Font.Size shl AA_MODE;
TempWidth := GetTextWidth(Text, TempFont);
finally
TempFont.Free;
end;
end
else
TempWidth := 0;
TempWidth := (TempWidth shr AA_MODE + 1) shl AA_MODE;
Result := TempWidth shr AA_MODE;
end;
The GetTextWidth function is simple. You can do it differently.
function GetTextWidth(const Text: string; const Font: TFont): Integer;
var
Canvas: TCanvas;
begin
Canvas := TCanvas.Create;
try
Canvas.Handle := GetDC(0);
try
Canvas.Font.Assign(Font);
Result := Canvas.TextWidth(Text);
finally
ReleaseDC(0, Canvas.Handle);
end;
finally
Canvas.Free;
end;
end;
You can also use the Windows API function GetTextExtentPoint32
Do some google to find example on Delphi

Resources