Skip to content

Commit

Permalink
ImageBox: Add text drawing
Browse files Browse the repository at this point in the history
  • Loading branch information
@ollydev
ollydev committed Feb 19, 2024
1 parent ba3d2db commit d096b53
Show file tree
Hide file tree
Showing 12 changed files with 444 additions and 108 deletions.
2 changes: 1 addition & 1 deletion Examples/image_drawtext.simba
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@ begin

myBox := [225,25,450,240];
myImage.DrawBox(myBox, Colors.RED);
myImage.DrawText(FormatDateTime('c', Now()), myBox, [ETextDrawAlignment.CENTER, ETextDrawAlignment.VERTICAL_CENTER], Colors.BLACK);
myImage.DrawText(FormatDateTime('c', Now()), myBox, [EDrawTextAlign.CENTER, EDrawTextAlign.VERTICAL_CENTER], Colors.BLACK);

myImage.SetFontBold(True);
myImage.SetFontSize(50);
Expand Down
5 changes: 4 additions & 1 deletion Source/Simba.lpi
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1028,7 +1028,7 @@
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="6">
<Exceptions Count="7">
<Item1>
<Name Value="ESyntaxError"/>
</Item1>
Expand All @@ -1047,6 +1047,9 @@
<Item6>
<Name Value="EFOpenError"/>
</Item6>
<Item7>
<Name Value="EFreeType"/>
</Item7>
</Exceptions>
</Debugging>
</CONFIG>
Binary file modified Source/Simba.res
View file
Binary file not shown.
8 changes: 4 additions & 4 deletions Source/image/simba.image.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -127,7 +127,7 @@ TSimbaImage = class(TSimbaBaseClass)
function TextSize(Text: String): TPoint;

procedure DrawText(Text: String; Position: TPoint; Color: TColor); overload;
procedure DrawText(Text: String; Box: TBox; Alignments: ETextDrawAlignSet; Color: TColor); overload;
procedure DrawText(Text: String; Box: TBox; Alignments: EDrawTextAlignSet; Color: TColor); overload;
procedure DrawTextLines(Text: TStringArray; Position: TPoint; Color: TColor);

procedure SetSize(NewWidth, NewHeight: Integer);
Expand Down Expand Up @@ -1886,7 +1886,7 @@ function TSimbaImage.GetFontAntialiasing: Boolean;

function TSimbaImage.GetFontName: String;
begin
Result := FTextDrawer.FontName;
Result := FTextDrawer.Font;
end;

class function TSimbaImage.FontNames: TStringArray;
Expand Down Expand Up @@ -1921,7 +1921,7 @@ procedure TSimbaImage.SetFontAntialiasing(Value: Boolean);

procedure TSimbaImage.SetFontName(Value: String);
begin
FTextDrawer.FontName := Value;
FTextDrawer.Font := Value;
end;

procedure TSimbaImage.SetFontSize(Value: Single);
Expand Down Expand Up @@ -1959,7 +1959,7 @@ procedure TSimbaImage.DrawText(Text: String; Position: TPoint; Color: TColor);
FTextDrawer.DrawText(Text, Position, Color);
end;

procedure TSimbaImage.DrawText(Text: String; Box: TBox; Alignments: ETextDrawAlignSet; Color: TColor);
procedure TSimbaImage.DrawText(Text: String; Box: TBox; Alignments: EDrawTextAlignSet; Color: TColor);
begin
FTextDrawer.DrawText(Text, Box, Alignments, Color);
end;
Expand Down
225 changes: 142 additions & 83 deletions Source/image/simba.image_textdrawer.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -39,53 +39,69 @@ TFontCacheEntry = record
end;

{$scopedenums on}
ETextDrawAlign = (LEFT, CENTER, RIGHT, JUSTIFY, TOP, VERTICAL_CENTER, BASE_LINE, BOTTOM);
ETextDrawAlignSet = set of ETextDrawAlign;
EDrawTextAlign = (LEFT, CENTER, RIGHT, JUSTIFY, TOP, VERTICAL_CENTER, BASE_LINE, BOTTOM);
EDrawTextAlignSet = set of EDrawTextAlign;
{$scopedenums off}

TSimbaTextDrawer = class(TFPImageFreeTypeDrawer)
TSimbaTextDrawerBase = class(TFPImageFreeTypeDrawer)
protected
FWidth: Integer;
FHeight: Integer;
FData: PColorBGRA;
FCurrentX, FCurrentY: Integer;
FCurrentColor: PColorBGRA;
FSimbaImage: TObject;
FFonts: TStringArray;
FFont: TFreeTypeFont;
FFontName: String;
FFontAntialised: Boolean;
FSize: Single;
FClipRect: TRect;
FBold: Boolean;
FItalic: Boolean;
FLock: TSimpleEnterableLock;
FDrawn: Boolean;
FDrawnBox: TBox;

procedure MoveToPixel(X, Y: Integer); override;
function GetCurrentColor: TFPColor; override;
procedure SetCurrentColorAndMoveRight(const AColor: TFPColor); override;
procedure MoveRight; override;
function GetClipRect: TRect; override;
procedure BeginDrawing;
procedure EndDrawing;

procedure BeginDrawing; virtual;
procedure EndDrawing; virtual;
public
property FontName: String read FFontName write FFontName;
constructor Create; reintroduce;

procedure DrawText(Text: String; Position: TPoint; Color: TColor); overload;
procedure DrawText(Text: String; Box: TBox; Alignments: EDrawTextAlignSet; Color: TColor); overload;

function TextWidth(Text: String): Integer;
function TextHeight(Text: String): Integer;
function TextSize(Text: String): TPoint;

property Font: String read FFontName write FFontName;
property Size: Single read FSize write FSize;
property Antialiased: Boolean read FFontAntialised write FFontAntialised;
property Bold: Boolean read FBold write FBold;
property Italic: Boolean read FItalic write FItalic;
end;

property Drawn: Boolean read FDrawn;
property DrawnBox: TBox read FDrawnBox;
TSimbaTextDrawer = class(TSimbaTextDrawerBase)
protected
FClipRect: TRect;
FWidth: Integer;
FHeight: Integer;
FData: PColorBGRA;
FCurrentX, FCurrentY: Integer;
FCurrentColor: PColorBGRA;
FSimbaImage: TObject;

procedure DrawText(Text: String; Position: TPoint; Color: TColor); overload;
procedure DrawText(Text: String; Box: TBox; Alignments: ETextDrawAlignSet; Color: TColor); overload;
FLock: TSimpleEnterableLock;
FDrawn: Boolean;
FDrawnBox: TBox;

function TextWidth(Text: String): Integer;
function TextHeight(Text: String): Integer;
function TextSize(Text: String): TPoint;
procedure MoveToPixel(X, Y: Integer); override;
function GetCurrentColor: TFPColor; override;
procedure SetCurrentColorAndMoveRight(const AColor: TFPColor); override;
procedure MoveRight; override;
function GetClipRect: TRect; override;

procedure BeginDrawing; override;
procedure EndDrawing; override;
public
property Drawn: Boolean read FDrawn;
property DrawnBox: TBox read FDrawnBox;

constructor Create(SimbaImage: TObject); reintroduce;
end;
Expand Down Expand Up @@ -276,6 +292,106 @@ function TSimbaFreeTypeFontLoader.GetFont(AName: String; ASize: Single; AAntiali
end;
end;

procedure TSimbaTextDrawerBase.MoveToPixel(X, Y: Integer);
begin
SimbaException('MoveToPixel');
end;

function TSimbaTextDrawerBase.GetCurrentColor: TFPColor;
begin
SimbaException('GetCurrentColor');
end;

procedure TSimbaTextDrawerBase.SetCurrentColorAndMoveRight(const AColor: TFPColor);
begin
SimbaException('SetCurrentColorAndMoveRight');
end;

procedure TSimbaTextDrawerBase.MoveRight;
begin
SimbaException('MoveRight');
end;

function TSimbaTextDrawerBase.GetClipRect: TRect;
begin
SimbaException('GetClipRect');
end;

procedure TSimbaTextDrawerBase.BeginDrawing;
begin
FFont := SimbaFreeTypeFontLoader.GetFont(FFontName, FSize, FFontAntialised, FBold, FItalic);
if (FFont = nil) then
SimbaException('Font "%s" not found', [FFontName]);
end;

procedure TSimbaTextDrawerBase.EndDrawing;
begin

end;

constructor TSimbaTextDrawerBase.Create;
begin
FSize := 20;
FFontAntialised := False;
FFontName := GetDefaultFontName();
end;

procedure TSimbaTextDrawerBase.DrawText(Text: String; Position: TPoint; Color: TColor);
begin
BeginDrawing();
try
inherited DrawText('Hello World', FFont, Position.X, Position.Y + FFont.SizeInPoints, TColorToFPColor(Color));
finally
EndDrawing();
end;
end;

procedure TSimbaTextDrawerBase.DrawText(Text: String; Box: TBox; Alignments: EDrawTextAlignSet; Color: TColor);
var
FreeTypeAlignments: TFreeTypeAlignments absolute Alignments;
begin
BeginDrawing();
try
inherited DrawTextRect(Text, FFont, Box.X1, Box.Y1, Box.X2, Box.Y2, TColorToFPColor(Color), FreeTypeAlignments);
finally
EndDrawing();
end;
end;

function TSimbaTextDrawerBase.TextWidth(Text: String): Integer;
begin
BeginDrawing();

try
Result := Round(FFont.TextWidth(Text));
finally
EndDrawing();
end;
end;

function TSimbaTextDrawerBase.TextHeight(Text: String): Integer;
begin
BeginDrawing();

try
Result := Round(FFont.TextHeight(Text));
finally
EndDrawing();
end;
end;

function TSimbaTextDrawerBase.TextSize(Text: String): TPoint;
begin
BeginDrawing();

try
Result.X := Round(FFont.TextWidth(Text));
Result.Y := Round(FFont.TextHeight(Text));
finally
EndDrawing();
end;
end;

procedure TSimbaTextDrawer.MoveToPixel(X, Y: Integer);
begin
FCurrentColor := @FData[Y * FWidth + X];
Expand Down Expand Up @@ -360,66 +476,9 @@ procedure TSimbaTextDrawer.EndDrawing;

constructor TSimbaTextDrawer.Create(SimbaImage: TObject);
begin
FSimbaImage := SimbaImage;
FSize := 20;
FFontAntialised := False;
FFontName := GetDefaultFontName();
end;

procedure TSimbaTextDrawer.DrawText(Text: String; Position: TPoint; Color: TColor);
begin
BeginDrawing();
try
inherited DrawText(Text, FFont, Position.X, Position.Y + FFont.SizeInPoints, TColorToFPColor(Color));
finally
EndDrawing();
end;
end;

procedure TSimbaTextDrawer.DrawText(Text: String; Box: TBox; Alignments: ETextDrawAlignSet; Color: TColor);
var
FreeTypeAlignments: TFreeTypeAlignments absolute Alignments;
begin
BeginDrawing();
try
inherited DrawTextRect(Text, FFont, Box.X1, Box.Y1, Box.X2, Box.Y2, TColorToFPColor(Color), FreeTypeAlignments);
finally
EndDrawing();
end;
end;

function TSimbaTextDrawer.TextWidth(Text: String): Integer;
begin
BeginDrawing();
inherited Create();

try
Result := Round(FFont.TextWidth(Text));
finally
EndDrawing();
end;
end;

function TSimbaTextDrawer.TextHeight(Text: String): Integer;
begin
BeginDrawing();

try
Result := Round(FFont.TextHeight(Text));
finally
EndDrawing();
end;
end;

function TSimbaTextDrawer.TextSize(Text: String): TPoint;
begin
BeginDrawing();

try
Result.X := Round(FFont.TextWidth(Text));
Result.Y := Round(FFont.TextHeight(Text));
finally
EndDrawing();
end;
FSimbaImage := SimbaImage;
end;

initialization
Expand Down
Loading

0 comments on commit d096b53

Please sign in to comment.