Skip to content

Commit

Permalink
dev
Browse files Browse the repository at this point in the history
  • Loading branch information
@ollydev
ollydev committed Feb 4, 2024
1 parent 6abcd22 commit 509ce43
Show file tree
Hide file tree
Showing 7 changed files with 325 additions and 833 deletions.
52 changes: 28 additions & 24 deletions Source/image/simba.image.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,7 @@ interface
ESimbaImageThreshMethod = (MEAN, MIN_MAX);
{$POP}

TSimbaImageRowPtrs = array of PColorBGRA;
TSimbaImageLineStarts = array of PColorBGRA;

PSimbaImage = ^TSimbaImage;
TSimbaImage = class(TSimbaBaseClass)
Expand All @@ -35,6 +35,8 @@ TSimbaImage = class(TSimbaBaseClass)
FDataOwner: Boolean;
FDataSize: SizeUInt;

FLineStarts: TSimbaImageLineStarts;

FTextDrawer: TSimbaTextDrawer;

procedure NotifyUnfreed; override;
Expand Down Expand Up @@ -63,12 +65,13 @@ TSimbaImage = class(TSimbaBaseClass)
procedure _DrawImage(Image: TSimbaImage; P: TPoint);
procedure _DrawImageAlpha(Image: TSimbaImage; P: TPoint; Alpha: Byte);

function GetPixel(X, Y: Integer): TColor;
function GetPixel(const X, Y: Integer): TColor;
function GetFontAntialiasing: Boolean;
function GetFontName: String;
function GetFontSize: Single;
function GetFontBold: Boolean;
function GetFontItalic: Boolean;
function GetLineStart(const Y: Integer): PColorBGRA;

procedure SetPixel(X, Y: Integer; Color: TColor);
procedure SetFontAntialiasing(Value: Boolean);
Expand Down Expand Up @@ -96,12 +99,17 @@ TSimbaImage = class(TSimbaBaseClass)
property Data: PColorBGRA read FData write FData;
property DataOwner: Boolean read FDataOwner write FDataOwner;
property DataSize: SizeUInt read FDataSize;

property LineStarts: TSimbaImageLineStarts read FLineStarts;
property LineStart[Line: Integer]: PColorBGRA read GetLineStart;

property Width: Integer read FWidth;
property Height: Integer read FHeight;
property Center: TPoint read FCenter;

property Pixel[X, Y: Integer]: TColor read GetPixel write SetPixel; default;

property TextDrawer: TSimbaTextDrawer read FTextDrawer;
property FontName: String read GetFontName write SetFontName;
property FontSize: Single read GetFontSize write SetFontSize;
property FontAntialiasing: Boolean read GetFontAntialiasing write SetFontAntialiasing;
Expand Down Expand Up @@ -228,8 +236,6 @@ TSimbaImage = class(TSimbaBaseClass)
function ThresholdAdaptive(Alpha, Beta: Byte; AInvert: Boolean; Method: ESimbaImageThreshMethod; K: Integer): TSimbaImage;
function ThresholdSauvola(Radius: Integer; AInvert: Boolean = False; R: Single = 128; K: Single = 0.5): TSimbaImage;

function RowPtrs: TSimbaImageRowPtrs;

function SaveToFile(FileName: String; OverwriteIfExists: Boolean = False): Boolean;
function SaveToString: String;

Expand Down Expand Up @@ -490,15 +496,6 @@ procedure TSimbaImage.DrawMatrix(Matrix: TSingleMatrix; ColorMapID: Integer = 0)
end;
end;

function TSimbaImage.RowPtrs: TSimbaImageRowPtrs;
var
I: Integer;
begin
SetLength(Result, FHeight);
for I := 0 to High(Result) do
Result[I] := @FData[FWidth * I];
end;

function TSimbaImage.SaveToString: String;
begin
Result := SimbaImage_ToString(Self);
Expand Down Expand Up @@ -1429,7 +1426,7 @@ function TSimbaImage.RotateBilinear(Radians: Single; Expand: Boolean): TSimbaIma
MidY := (NewHeight - 1) / 2;

Result.SetSize(NewWidth, NewHeight);
Result.SetAlpha(0);
Result.SetAlpha(0);

Dec(NewWidth);
Dec(NewHeight);
Expand Down Expand Up @@ -1647,14 +1644,14 @@ function TSimbaImage.BoxBlur(Radius: Integer): TSimbaImage;
function TSimbaImage.Convolute(Matrix: TDoubleMatrix): TSimbaImage;
var
X, Y, YY, XX, CX, CY: Integer;
SrcRows, DestRows: TSimbaImageRowPtrs;
SrcRows, DestRows: TSimbaImageLineStarts;
MatWidth, MatHeight, MidX, MidY: Integer;
NewR, NewG, NewB: Double;
begin
Result := TSimbaImage.Create(FWidth, FHeight);

SrcRows := RowPtrs;
DestRows := Result.RowPtrs;
SrcRows := LineStarts;
DestRows := Result.LineStarts;

if Matrix.GetSize(MatWidth, MatHeight) then
begin
Expand Down Expand Up @@ -1922,6 +1919,11 @@ function TSimbaImage.GetFontItalic: Boolean;
Result := FTextDrawer.Italic;
end;

function TSimbaImage.GetLineStart(const Y: Integer): PColorBGRA;
begin
Result := FLineStarts[Y];
end;

procedure TSimbaImage.SetFontAntialiasing(Value: Boolean);
begin
FTextDrawer.Antialiased := Value;
Expand Down Expand Up @@ -2021,6 +2023,10 @@ procedure TSimbaImage.SetSize(NewWidth, NewHeight: Integer);
FWidth := NewWidth;
FHeight := NewHeight;
FCenter := TPoint.Create(FWidth div 2, FHeight div 2);

SetLength(FLineStarts, FHeight);
for I := 0 to High(FLineStarts) do
FLineStarts[I] := @FData[FWidth * I];
end;
end;

Expand Down Expand Up @@ -2116,14 +2122,12 @@ function TSimbaImage.ResizeBilinear(NewWidth, NewHeight: Integer): TSimbaImage;
X, Y, OldX, OldY: Integer;
p0, p1, p2, p3: TColorBGRA;
RatioX, RatioY, dX, dY: Single;
SrcRows: TSimbaImageRowPtrs;
Color: TColorBGRA;
W,H: Integer;
begin
Result := TSimbaImage.Create(NewWidth, NewHeight);

Color := DefaultPixel;
SrcRows := RowPtrs;

RatioX := (FWidth - 1) / NewWidth;
RatioY := (FHeight - 1) / NewHeight;
Expand All @@ -2136,10 +2140,10 @@ function TSimbaImage.ResizeBilinear(NewWidth, NewHeight: Integer): TSimbaImage;
OldX := Trunc(RatioX * X);
OldY := Trunc(RatioY * Y);

p0 := SrcRows[OldY, OldX ];
p1 := SrcRows[OldY, OldX + 1];
p2 := SrcRows[OldY + 1, OldX ];
p3 := SrcRows[OldY + 1, OldX + 1];
p0 := FLineStarts[OldY, OldX ];
p1 := FLineStarts[OldY, OldX + 1];
p2 := FLineStarts[OldY + 1, OldX ];
p3 := FLineStarts[OldY + 1, OldX + 1];

if ShouldResize(p0, p1, p2, p3) then
begin
Expand Down Expand Up @@ -2772,7 +2776,7 @@ procedure TSimbaImage.NotifyUnfreed;
end;
end;

function TSimbaImage.GetPixel(X, Y: Integer): TColor;
function TSimbaImage.GetPixel(const X, Y: Integer): TColor;
begin
AssertInImage('GetPixel', X, Y);

Expand Down
63 changes: 43 additions & 20 deletions Source/image/simba.image_textdrawer.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,8 @@ interface

type
TSimbaFreeTypeFontLoader = class
private
function GetFontNames: TStringArray;
protected
type
TFontCacheEntry = record
Expand All @@ -33,14 +35,15 @@ TFontCacheEntry = record
function LoadFonts(Dir: String): Boolean;
function GetFont(AName: String; ASize: Single; AAntialised, ABold, AItalic: Boolean): TFreeTypeFont;

property FontNames: TStringArray read FFontNames;
property FontNames: TStringArray read GetFontNames;
end;

TSimbaTextDrawer = class(TFPImageFreeTypeDrawer)
protected
FWidth: Integer;
FHeight: Integer;
FData: PColorBGRA;
FCurrentX, FCurrentY: Integer;
FCurrentColor: PColorBGRA;
FSimbaImage: TObject;
FFonts: TStringArray;
Expand All @@ -52,6 +55,8 @@ TSimbaTextDrawer = class(TFPImageFreeTypeDrawer)
FBold: Boolean;
FItalic: Boolean;
FLock: TSimpleEnterableLock;
FDrawn: Boolean;
FDrawnBox: TBox;

procedure MoveToPixel(X, Y: Integer); override;
function GetCurrentColor: TFPColor; override;
Expand All @@ -67,6 +72,9 @@ TSimbaTextDrawer = class(TFPImageFreeTypeDrawer)
property Bold: Boolean read FBold write FBold;
property Italic: Boolean read FItalic write FItalic;

property Drawn: Boolean read FDrawn;
property DrawnBox: TBox read FDrawnBox;

procedure DrawText(Text: String; Position: TPoint; Color: TColor); overload;
procedure DrawText(Text: String; Box: TBox; Center: Boolean; Color: TColor); overload;

Expand All @@ -86,6 +94,13 @@ implementation
Forms, FileUtil, LazFileUtils, LazFreeTypeFontCollection,
simba.image, simba.image_utils;

function TSimbaFreeTypeFontLoader.GetFontNames: TStringArray;
begin
LoadSystemFonts();

Result := FFontNames;
end;

procedure TSimbaFreeTypeFontLoader.LoadSystemFonts;
var
SearchPaths, FontFiles: TStringList;
Expand Down Expand Up @@ -259,46 +274,52 @@ function TSimbaFreeTypeFontLoader.GetFont(AName: String; ASize: Single; AAntiali
procedure TSimbaTextDrawer.MoveToPixel(X, Y: Integer);
begin
FCurrentColor := @FData[Y * FWidth + X];
end;

function FastRoundDiv257(valueWord: LongWord): byte; inline;
begin
result := LongWord(valueWord + 127 - (valueWord shr 8)) shr 8;
FCurrentX := X;
FCurrentY := Y;
end;

function TSimbaTextDrawer.GetCurrentColor: TFPColor;
begin
with FCurrentColor^ do
begin
Result.Red := R + (R shr 8);// shl 8 + R; // TFPColor fields are 16 bits. So duplicate our 8 bit data
Result.Green := G + (G shr 8); //G shl 8 + G;
Result.Blue := B + (B shr 8); //B shl 8 + B;
Result.Alpha := A + (A shr 8); //A shl 8 + A;
Result.Red := R + (R shr 8); // TFPColor fields are 16 bits. So duplicate our 8 bit data
Result.Green := G + (G shr 8);
Result.Blue := B + (B shr 8);
Result.Alpha := A + (A shr 8);
end;
end;

procedure TSimbaTextDrawer.SetCurrentColorAndMoveRight(const AColor: TFPColor);
var
bgra: TColorBGRA;
BGRA: TColorBGRA;
begin

//bgra.R := AColor.Red + (Result.Red shr 8);
//bgra.G := AColor.Green + (Result.Green shr 8);
//bgra.B := AColor.Blue + (Result.Blue shr 8);
//
bgra.R := AColor.Red div 257;
bgra.G := AColor.Green div 257;
bgra.B := AColor.Blue div 257;
bgra.A := AColor.Alpha shr 8;
BGRA.R := AColor.Red div 257;
BGRA.G := AColor.Green div 257;
BGRA.B := AColor.Blue div 257;
BGRA.A := AColor.Alpha shr 8;

BlendPixel(FCurrentColor, BGRA);

if FDrawn then
begin
if (FCurrentX > FDrawnBox.X2) then FDrawnBox.X2 := FCurrentX else
if (FCurrentX < FDrawnBox.X1) then FDrawnBox.X1 := FCurrentX;
if (FCurrentY > FDrawnBox.Y2) then FDrawnBox.Y2 := FCurrentY else
if (FCurrentY < FDrawnBox.Y1) then FDrawnBox.Y1 := FCurrentY;
end else
begin
FDrawn := True;
FDrawnBox := TBox.Create(FCurrentX, FCurrentY, FCurrentX, FCurrentY);
end;

Inc(FCurrentColor);
Inc(FCurrentX);
end;

procedure TSimbaTextDrawer.MoveRight;
begin
Inc(FCurrentColor);
Inc(FCurrentX);
end;

function TSimbaTextDrawer.GetClipRect: TRect;
Expand All @@ -320,6 +341,8 @@ procedure TSimbaTextDrawer.BeginDrawing;
FClipRect.Right := FWidth;
FClipRect.Bottom := FHeight;

FDrawn := False;

FFont := SimbaFreeTypeFontLoader.GetFont(FFontName, FSize, FFontAntialised, FBold, FItalic);
if (FFont = nil) then
SimbaException('Font "%s" not found', [FFontName]);
Expand Down
Loading

0 comments on commit 509ce43

Please sign in to comment.