Skip to content

Commit

Permalink
Image tweaks
Browse files Browse the repository at this point in the history
  • Loading branch information
@ollydev
ollydev committed Feb 11, 2025
1 parent 1f7876e commit c83f0df
Show file tree
Hide file tree
Showing 4 changed files with 177 additions and 53 deletions.
6 changes: 6 additions & 0 deletions Source/script/imports/simba.import_image.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1719,6 +1719,11 @@ procedure _LapeImage_Fonts(const Params: PParamArray; const Result: Pointer); LA
PStringArray(Result)^ := TSimbaImage.Fonts();
end;

procedure _LapeImage_FindAlpha(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
begin
PPointArray(Result)^ := PSimbaImage(Params^[0])^.FindAlpha(PByte(Params^[1])^);
end;

(*
TImage.FindColor
----------------
Expand Down Expand Up @@ -2034,6 +2039,7 @@ procedure ImportSimbaImage(Script: TSimbaScript);
addGlobalFunc('function TImage.Fonts: TStringArray; static;', @_LapeImage_Fonts);
addGlobalFunc('function TImage.LoadFonts(Dir: String): Boolean; static;', @_LapeImage_LoadFonts);

addGlobalFunc('function TImage.FindAlpha(Value: Byte): TPointArray;', @_LapeImage_FindAlpha);
addGlobalFunc('function TImage.FindColor(Color: TColor; Tolerance: Single = 0): TPointArray;', @_LapeImage_FindColor);
addGlobalFunc('function TImage.FindImage(Image: TImage; Tolerance: Single = 0): TPoint;', @_LapeImage_FindImage);

Expand Down
159 changes: 117 additions & 42 deletions Source/simba.image.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -42,7 +42,7 @@ TSimbaImage = class(TSimbaBaseClass)
FCenter: TPoint;

FData: PColorBGRA;
FDataSize: SizeUInt;
FDataUpper: PColorBGRA;
FDataOwner: Boolean;

FLineStarts: TSimbaImageLineStarts;
Expand All @@ -68,6 +68,7 @@ TSimbaImage = class(TSimbaBaseClass)
function GetFontItalic: Boolean;
function GetLineStart(const Y: Integer): PColorBGRA;
function GetDrawColorAsBGRA: TColorBGRA;
function GetDataSize: SizeUInt;

procedure SetPixel(const X, Y: Integer; const Color: TColor);
procedure SetAlpha(const X, Y: Integer; const Value: Byte);
Expand All @@ -93,9 +94,11 @@ TSimbaImage = class(TSimbaBaseClass)
constructor CreateFromMatrix(Mat: TSingleMatrix; ColorMapType: Integer = 0); overload;
destructor Destroy; override;

property Data: PColorBGRA read FData;
property DataSize: SizeUInt read FDataSize;
property DataOwner: Boolean read FDataOwner;
property Data: PColorBGRA read FData; // @data[0]
property DataUpper: PColorBGRA read FDataUpper; // @data[high(data)]
property DataSize: SizeUInt read GetDataSize; // width*height*4

property Width: Integer read FWidth;
property Height: Integer read FHeight;
property Center: TPoint read FCenter;
Expand All @@ -116,7 +119,6 @@ TSimbaImage = class(TSimbaBaseClass)
property Pixel[X, Y: Integer]: TColor read GetPixel write SetPixel; default;
property Alpha[X, Y: Integer]: Byte read GetAlpha write SetAlpha;

procedure DataRange(out Lo, Hi: PColorBGRA);
function InImage(const X, Y: Integer): Boolean;

procedure SetSize(NewWidth, NewHeight: Integer);
Expand Down Expand Up @@ -263,6 +265,7 @@ TSimbaImage = class(TSimbaBaseClass)
// Basic finders, use Target.SetTarget(img) for all
function FindColor(Color: TColor; Tolerance: Single): TPointArray;
function FindImage(Image: TSimbaImage; Tolerance: Single): TPoint;
function FindAlpha(Value: Byte): TPointArray;
end;

PSimbaImage = ^TSimbaImage;
Expand All @@ -286,8 +289,7 @@ implementation
simba.zip,
simba.nativeinterface,
simba.containers,
simba.threading,
simba.target;
simba.threading;

function TSimbaImage.Copy: TSimbaImage;
begin
Expand Down Expand Up @@ -723,7 +725,6 @@ function TSimbaImage.Compare(Other: TSimbaImage): Single;

function TSimbaImage.PixelDifference(Other: TSimbaImage; Tolerance: Single): Integer;
var
Upper: PtrUInt;
P1, P2: PColorBGRA;
begin
Result := 0;
Expand All @@ -732,9 +733,7 @@ function TSimbaImage.PixelDifference(Other: TSimbaImage; Tolerance: Single): Int

P1 := Data;
P2 := Other.Data;

Upper := PtrUInt(P1) + FDataSize;
while (PtrUInt(P1) < PtrUInt(Upper)) do
while (P1 <= FDataUpper) do
begin
if (not SimilarRGB(P1^, P2^, Tolerance)) then
Inc(Result);
Expand All @@ -746,8 +745,8 @@ function TSimbaImage.PixelDifference(Other: TSimbaImage; Tolerance: Single): Int

function TSimbaImage.PixelDifferenceTPA(Other: TSimbaImage; Tolerance: Single): TPointArray;
var
I: Integer;
P1, P2: PColorBGRA;
I: Integer;
Buffer: TSimbaPointBuffer;
begin
if (FWidth <> Other.Width) or (FHeight <> Other.Height) then
Expand Down Expand Up @@ -785,18 +784,108 @@ procedure TSimbaImage.FromLazBitmap(LazBitmap: TBitmap);

function TSimbaImage.FindColor(Color: TColor; Tolerance: Single): TPointArray;
var
Target: TSimbaTarget;
Col: TColorBGRA;
Ptr: PColorBGRA;
X,Y,W,H: Integer;
Buffer: TSimbaPointBuffer;
begin
Target.SetImage(Self);
Result := Target.FindColor(Color, Tolerance, Target.Bounds);
Col := TSimbaColorConversion.ColorToBGRA(Color);
Ptr := FData;

W := FWidth - 1;
H := FHeight - 1;
for Y := 0 to H do
for X := 0 to W do
begin
if SimilarRGB(Col, Ptr^, Tolerance) then
Buffer.Add(X, Y);

Inc(Ptr);
end;

Result := Buffer.ToArray(False);
end;

function TSimbaImage.FindImage(Image: TSimbaImage; Tolerance: Single): TPoint;

function Match(const Ptr: TColorBGRA; const ImagePtr: TColorBGRA): Boolean; inline;
begin
Result := (ImagePtr.A = ALPHA_TRANSPARENT) or SimilarRGB(Ptr, ImagePtr, Tolerance);
end;

function Hit(Ptr: PColorBGRA): Boolean;
var
X, Y: Integer;
ImagePtr: PColorBGRA;
begin
ImagePtr := Image.Data;

for Y := 0 to Image.Height - 1 do
begin
for X := 0 to Image.Width - 1 do
begin
if (not Match(Ptr^, ImagePtr^)) then
Exit(False);
Inc(ImagePtr);
Inc(Ptr);
end;

Inc(Ptr, FWidth - Image.Width);
end;

Result := True;
end;

var
Target: TSimbaTarget;
SearchWidth, SearchHeight: Integer;
Ptr: PColorBGRA;
X, Y: Integer;
begin
Target.SetImage(Self);
Result := Target.FindImage(Image, Tolerance, Target.Bounds);
SearchWidth := (FWidth - Image.Width) - 1;
SearchHeight := (FHeight - Image.Height) - 1;
Ptr := FData;

for Y := 0 to SearchHeight do
begin
Ptr := @FData[Y * FWidth];
for X := 0 to SearchWidth do
begin
if Hit(Ptr) then
begin
Result.X := X;
Result.Y := Y;

Exit;
end;

Inc(Ptr);
end;
end;

Result.X := -1;
Result.Y := -1;
end;

function TSimbaImage.FindAlpha(Value: Byte): TPointArray;
var
Ptr: PColorBGRA;
X,Y,W,H: Integer;
Buffer: TSimbaPointBuffer;
begin
Ptr := FData;

W := FWidth-1;
H := FHeight-1;
for Y := 0 to H do
for X := 0 to W do
begin
if (Ptr^.A = Value) then
Buffer.Add(X, Y);

Inc(Ptr);
end;

Result := Buffer.ToArray(False);
end;

procedure TSimbaImage.DrawTPA(TPA: TPointArray);
Expand Down Expand Up @@ -1114,13 +1203,10 @@ procedure TSimbaImage.Fill(Color: TColor);

procedure TSimbaImage.FillWithAlpha(Value: Byte);
var
Upper: PtrUInt;
Ptr: PColorBGRA;
begin
Upper := PtrUInt(@FData[FWidth * FHeight]);
Ptr := FData;

while (PtrUInt(Ptr) < Upper) do
while (Ptr <= FDataUpper) do
begin
Ptr^.A := Value;

Expand Down Expand Up @@ -1169,7 +1255,6 @@ procedure TSimbaImage.ClearInverted(Box: TBox);

procedure TSimbaImage.SplitChannels(var B,G,R: TByteArray);
var
Upper: PtrUInt;
Src: PColorBGRA;
DestB, DestG, DestR: PByte;
begin
Expand All @@ -1182,8 +1267,7 @@ procedure TSimbaImage.SplitChannels(var B,G,R: TByteArray);
DestR := @R[0];

Src := FData;
Upper := PtrUInt(FData) + FDataSize;
while (PtrUInt(Src) < Upper) do
while (Src <= FDataUpper) do
begin
DestB^ := Src^.B;
DestG^ := Src^.G;
Expand All @@ -1200,7 +1284,6 @@ procedure TSimbaImage.FromChannels(const B,G,R: TByteArray; W, H: Integer);
var
Dst: PColorBGRA;
SrcB, SrcG, SrcR: PByte;
Upper: PtrUInt;
begin
SetSize(W, H);
if (Length(B) <> W*H) or (Length(G) <> W*H) or (Length(R) <> W*H) then
Expand All @@ -1211,8 +1294,7 @@ procedure TSimbaImage.FromChannels(const B,G,R: TByteArray; W, H: Integer);
SrcG := @G[0];
SrcR := @R[0];

Upper := PtrUInt(FData) + FDataSize;
while (PtrUInt(Dst) < Upper) do
while (Dst <= FDataUpper) do
begin
Dst^.A := ALPHA_OPAQUE;
Dst^.B := SrcB^;
Expand Down Expand Up @@ -1509,6 +1591,11 @@ function TSimbaImage.GetDrawColorAsBGRA: TColorBGRA;
Result := TSimbaColorConversion.ColorToBGRA(FDrawColor, FDrawAlpha);
end;

function TSimbaImage.GetDataSize: SizeUInt;
begin
Result := (FWidth * FHeight) * SizeOf(TColorBGRA);
end;

procedure TSimbaImage.SetFontAntialiasing(Value: Boolean);
begin
FTextDrawer.Antialiased := Value;
Expand Down Expand Up @@ -1604,7 +1691,7 @@ procedure TSimbaImage.SetSize(NewWidth, NewHeight: Integer);
FreeMem(FData);

FData := NewData;
FDataSize := (NewWidth * NewHeight) * SizeOf(TColorBGRA);
FDataUpper := @NewData[(NewWidth * NewHeight) - 1];
FWidth := NewWidth;
FHeight := NewHeight;
FCenter := TPoint.Create(FWidth div 2, FHeight div 2);
Expand Down Expand Up @@ -1804,17 +1891,11 @@ procedure TSimbaImage.Offset(X, Y: Integer);
function TSimbaImage.isBinary: Boolean;
var
Ptr: PColorBGRA;
Upper: PtrUInt;
begin
if (FDataSize = 0) then
Exit(False);

Ptr := FData;
Upper := PtrUInt(FData) + FDataSize;
while (PtrUInt(Ptr) < Upper) and ((Ptr^.R = 0) and (Ptr^.G = 0) and (Ptr^.B = 0)) or ((Ptr^.R = 255) and (Ptr^.G = 255) and (Ptr^.B = 255)) do
while (Ptr <= FDataUpper) and ((Ptr^.R = 0) and (Ptr^.G = 0) and (Ptr^.B = 0)) or ((Ptr^.R = 255) and (Ptr^.G = 255) and (Ptr^.B = 255)) do
Inc(Ptr);

Result := PtrUInt(Ptr) = Upper;
Result := Ptr > FDataUpper;
end;

function TSimbaImage.DetachData: TDetachedImageData;
Expand Down Expand Up @@ -1980,12 +2061,6 @@ destructor TSimbaImage.Destroy;
inherited Destroy();
end;

procedure TSimbaImage.DataRange(out Lo, Hi: PColorBGRA);
begin
Lo := Pointer(FData);
Hi := Pointer(FData) + FDataSize;
end;

end.


24 changes: 13 additions & 11 deletions Source/simba.image_filters.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -508,8 +508,7 @@ function SimbaImage_Threshold(Image: TSimbaImage; Invert: Boolean; C: Integer):
Level, Max, Min, I, J, NumPixels: Integer;
Mean, Variance: Single;
Mu, Omega, LevelMean, LargestMu: Single;
Upper: PtrUInt;
Ptr: PColorBGRA;
Ptr, Upper: PColorBGRA;
begin
Result := Image.GreyScale();

Expand All @@ -520,9 +519,9 @@ function SimbaImage_Threshold(Image: TSimbaImage; Invert: Boolean; C: Integer):
NumPixels := Result.Width * Result.Height;

// Compute histogram and determine min and max pixel values
Upper := PtrUInt(Result.Data) + Result.DataSize;
Ptr := Result.Data;
while (PtrUInt(Ptr) < Upper) do
Upper := Result.DataUpper;
while (Ptr <= Upper) do
begin
Histogram[Ptr^.R] := Histogram[Ptr^.R] + 1.0;
if (Ptr^.R < Min) then
Expand Down Expand Up @@ -577,7 +576,7 @@ function SimbaImage_Threshold(Image: TSimbaImage; Invert: Boolean; C: Integer):

// Do thresholding using computed level
Ptr := Result.Data;
while (PtrUInt(Ptr) < Upper) do
while (Ptr <= Upper) do
begin
if (Invert and (Ptr^.R <= Level)) or ((not Invert) and (Ptr^.R >= Level)) then
Ptr^.AsInteger := $FFFFFFFF
Expand Down Expand Up @@ -698,8 +697,9 @@ procedure SimbaImage_ReplaceColor(Image: TSimbaImage; OldColor, NewColor: TColor
Old := TSimbaColorConversion.ColorToBGRA(OldColor);
New := TSimbaColorConversion.ColorToBGRA(NewColor, ALPHA_OPAQUE);

Image.DataRange(Ptr, Upper);
while (PtrUInt(Ptr) < PtrUInt(Upper)) do
Ptr := Image.Data;
Upper := Image.DataUpper;
while (Ptr <= Upper) do
begin
if SimilarRGB(Old, Ptr^, Tol) then
Ptr^ := New;
Expand All @@ -717,8 +717,9 @@ procedure SimbaImage_ReplaceColorBinary(Image: TSimbaImage; Color: TColor; Tol:
begin
Col := TSimbaColorConversion.ColorToBGRA(Color);

Image.DataRange(Ptr, Upper);
while (PtrUInt(Ptr) < PtrUInt(Upper)) do
Ptr := Image.Data;
Upper := Image.DataUpper;
while (Ptr <= Upper) do
begin
if SimilarRGB(Col, Ptr^, Tol) then
Ptr^ := WHITE
Expand All @@ -744,8 +745,9 @@ procedure SimbaImage_ReplaceColorBinary(Image: TSimbaImage; Colors: TColorArray;
for I := 0 to High(Colors) do
Cols[I] := TSimbaColorConversion.ColorToBGRA(Colors[I]);

Image.DataRange(Ptr, Upper);
while (PtrUInt(Ptr) < PtrUInt(Upper)) do
Ptr := Image.Data;
Upper := Image.DataUpper;
while (Ptr <= Upper) do
begin
for I := 0 to High(Cols) do
if SimilarRGB(Cols[I], Ptr^, Tol) then
Expand Down
Loading

0 comments on commit c83f0df

Please sign in to comment.