unit Unit3;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes,
System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects, FMX.TextLayout;
type
TForm3 =
class(TForm)
Button1: TButton;
Label1: TLabel;
Image2: TImage;
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
FScreenScale: single;
FTitle:
String;
FDescription:
String;
FTitleTextLayout: TTextLayout;
FDescTextLayout: TTextLayout;
procedure DefaultRenderItem(
const ACanvas: TCanvas;
const ARect: TRectF;
const AImage: TBitmap;
const ASelected: Boolean);
public
{ Public-Deklarationen }
end;
TCanvasHelper =
class helper
for TCanvas
public
procedure PetersFillText(
const ATextLayout: TTextLayout;
const ARect: TRectF;
const AText:
string;
const WordWrap: Boolean;
const AOpacity: single;
const Flags: TFillTextFlags;
const ATextAlign, AVTextAlign: TTextAlign);
end;
var
Form3: TForm3;
implementation
{$R *.fmx}
const
cCardBackgroundColor = $FF3D3D3D;
cCardDescription = $FF0096A6;
cCardDescriptionFocus = $FF37474F;
cGridFont = '
Roboto';
procedure TForm3.Button1Click(Sender: TObject);
var
tick: Cardinal;
i: Integer;
Target: TBitmap;
Image: TBitmap;
begin
FTitle := '
Tile 1';
FDescription := '
Panel 1, lorem ipsum';
tick := TThread.GetTickCount;
FScreenScale := 1;
for i := 1
to 1000
do
begin
Image := TBitmap.Create;
try
// Image.Assign(Image1.Bitmap);
Target := TBitmap.Create(180, 144);
DefaultRenderItem(Target.Canvas, Target.BoundsF, Image, false);
Target.Free;
Target := TBitmap.Create(180, 144);
DefaultRenderItem(Target.Canvas, Target.BoundsF, Image, true);
if i = 1000
then // zu Debugzwecken
Image2.Bitmap.Assign(Target);
Target.Free;
finally
Image.Free;
end;
end;
Label1.Text := IntToStr(TThread.GetTickCount - tick);
end;
procedure TForm3.DefaultRenderItem(
const ACanvas: TCanvas;
const ARect: TRectF;
const AImage: TBitmap;
const ASelected: Boolean);
var
i: Integer;
TH: single;
ABoundsRect: TRectF;
R: TRectF;
TextLayout: TTextLayout;
begin
ABoundsRect := ARect;
with ACanvas
do
begin
BeginScene(
nil);
try
// Shadow - there are much nicer ways to draw a shadow
ClearRect(ARect);
Stroke.Kind := TBrushkind.Solid;
Stroke.Color := TAlphaColorRec.Black;
for i := 0
to 5
do
begin
DrawRect(ABoundsRect, 5, 5, AllCorners, i / 100);;
ABoundsRect := RectF(ABoundsRect.Left + 1, ABoundsRect.Top + 1, ABoundsRect.Right - 1, ABoundsRect.Bottom - 1);
end;
Stroke.Kind := TBrushkind.None;
Fill.Kind := TBrushkind.Solid;
Fill.Color := cCardBackgroundColor;
FillRect(ABoundsRect, 0 * 5, 0 * 5, AllCorners, 1);
TH := ABoundsRect.Height / 3;
if Assigned(AImage)
then
begin
R := RectF(ABoundsRect.Left, 0, ABoundsRect.Right, ABoundsRect.Bottom - TH);
Fill.Bitmap.Bitmap.Assign(AImage);
Fill.Bitmap.WrapMode := TWrapMode.TileStretch;
Fill.Kind := TBrushkind.Bitmap;
FillRect(R, 5, 5, [TCorner.TopLeft, TCorner.TopRight], 1);
end;
R := RectF(ABoundsRect.Left, ABoundsRect.Bottom - TH, ABoundsRect.Right, ABoundsRect.Bottom);
Fill.Kind := TBrushkind.Solid;
if ASelected
then
Fill.Color := cCardDescription
else
Fill.Color := cCardDescriptionFocus;
FillRect(R, 5, 5, [TCorner.BottomLeft, TCorner.BottomRight], 1);
R := RectF(R.Left + 10, R.Top, R.Right - 10, R.Top + (R.Bottom - R.Top) / 2);
Fill.Color := TAlphaColorRec.White;
if FTitle <> '
'
then
begin
if FTitleTextLayout =
nil then
begin
Font.Family := cGridFont;
Font.Size := FScreenScale * 15;
Font.Style := [TFontStyle.fsBold];
FTitleTextLayout := TTextLayoutManager.TextLayoutByCanvas(ACanvas.ClassType).Create(ACanvas);
PetersFillText(FTitleTextLayout, R, FTitle, false, 1, [], TTextAlign.Leading, TTextAlign.Center);
end;
FTitleTextLayout.RenderLayout(ACanvas);
end;
if FDescription <> '
'
then
begin
if FDescTextLayout =
nil then
begin
R.Offset(0, R.Height);
Font.Style := [];
FDescTextLayout := TTextLayoutManager.TextLayoutByCanvas(ACanvas.ClassType).Create(ACanvas);
PetersFillText(FDescTextLayout, R, FDescription, false, 0.8, [], TTextAlign.Leading, TTextAlign.Leading);
end;
FDescTextLayout.RenderLayout(ACanvas);
end;
finally
EndScene;
end;
end;
end;
{ TCanvasHelper }
procedure TCanvasHelper.PetersFillText(
const ATextLayout: TTextLayout;
const ARect: TRectF;
const AText:
string;
const WordWrap: Boolean;
const AOpacity: single;
const Flags: TFillTextFlags;
const ATextAlign, AVTextAlign: TTextAlign);
begin
ATextLayout.BeginUpdate;
ATextLayout.TopLeft := ARect.TopLeft;
ATextLayout.MaxSize := PointF(ARect.Width, ARect.Height);
ATextLayout.Text := AText;
ATextLayout.WordWrap := WordWrap;
ATextLayout.Opacity := AOpacity;
ATextLayout.HorizontalAlign := ATextAlign;
ATextLayout.VerticalAlign := AVTextAlign;
ATextLayout.Font := Self.Font;
ATextLayout.Color := Self.Fill.Color;
ATextLayout.RightToLeft := TFillTextFlag.RightToLeft
in Flags;
ATextLayout.EndUpdate;
end;
end.