434 lines
13 KiB
ObjectPascal
434 lines
13 KiB
ObjectPascal
// SPDX-License-Identifier: LGPL-3.0-linking-exception
|
|
{
|
|
Created by BGRA Controls Team
|
|
Dibo, Circular, lainz (007) and contributors.
|
|
For detailed information see readme.txt
|
|
|
|
Site: https://sourceforge.net/p/bgra-controls/
|
|
Wiki: http://wiki.lazarus.freepascal.org/BGRAControls
|
|
Forum: http://forum.lazarus.freepascal.org/index.php/board,46.0.html
|
|
}
|
|
{******************************* CONTRIBUTOR(S) ******************************
|
|
- Edivando S. Santos Brasil | mailedivando@gmail.com
|
|
(Compatibility with delphi VCL 11/2018)
|
|
|
|
***************************** END CONTRIBUTOR(S) *****************************}
|
|
unit BGRAPascalScript;
|
|
// Note: overloaded procedures not supported, use unique identifiers
|
|
{$I bgracontrols.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, BGRABitmap, BGRABitmapTypes;
|
|
|
|
type
|
|
TBGRAColor = longword;
|
|
|
|
var
|
|
BitmapArray: array of TBGRABitmap;
|
|
|
|
{Internal use only}
|
|
procedure bgra_Initialization;
|
|
procedure bgra_Finalization;
|
|
|
|
procedure bgra_AddBitmap(id: integer);
|
|
function bgra_GetHighestID: integer;
|
|
|
|
function BGRAColorToBGRAPixel(AColor: TBGRAColor): TBGRAPixel;
|
|
|
|
function rgb(red, green, blue: byte): TBGRAColor;
|
|
function rgba(red, green, blue, alpha: byte): TBGRAColor;
|
|
function getBlue(AColor: TBGRAColor): byte;
|
|
function getGreen(AColor: TBGRAColor): byte;
|
|
function getRed(AColor: TBGRAColor): byte;
|
|
function getAlpha(AColor: TBGRAColor): byte;
|
|
function setBlue(AColor: TBGRAColor; AValue: byte): TBGRAColor;
|
|
function setGreen(AColor: TBGRAColor; AValue: byte): TBGRAColor;
|
|
function setRed(AColor: TBGRAColor; AValue: byte): TBGRAColor;
|
|
function setAlpha(AColor: TBGRAColor; AValue: byte): TBGRAColor;
|
|
|
|
{Constructors}
|
|
procedure bgra_Create(id: integer);
|
|
procedure bgra_CreateWithSize(id: integer; AWidth, AHeight: integer);
|
|
procedure bgra_CreateFromFile(id: integer; AFilename: string);
|
|
procedure bgra_Destroy(id: integer);
|
|
procedure bgra_DestroyAll;
|
|
|
|
procedure bgra_Fill(id: integer; AColor: TBGRAColor);
|
|
procedure bgra_SetPixel(id: integer; x, y: integer; AColor: TBGRAColor);
|
|
function bgra_GetPixel(id: integer; x, y: integer): TBGRAColor;
|
|
|
|
{Loading functions}
|
|
procedure bgra_SaveToFile(id: integer; const filename: string);
|
|
|
|
{Filters - direct apply}
|
|
procedure bgra_FilterSmartZoom3(id: integer; Option: TMedianOption);
|
|
procedure bgra_FilterMedian(id: integer; Option: TMedianOption);
|
|
procedure bgra_FilterSmooth(id: integer);
|
|
procedure bgra_FilterSharpen(id: integer; Amount: single);
|
|
procedure bgra_FilterSharpenRect(id: integer; ABounds: TRect; Amount: single);
|
|
procedure bgra_FilterContour(id: integer);
|
|
procedure bgra_FilterPixelate(id: integer; pixelSize: integer;
|
|
useResample: boolean; filter: TResampleFilter);
|
|
procedure bgra_FilterBlurRadial(id: integer; radius: integer; blurType: TRadialBlurType);
|
|
procedure bgra_FilterBlurRadialRect(id: integer; ABounds: TRect;
|
|
radius: integer; blurType: TRadialBlurType);
|
|
procedure bgra_FilterBlurMotion(id: integer; distance: integer;
|
|
angle: single; oriented: boolean);
|
|
procedure bgra_FilterBlurMotionRect(id: integer; ABounds: TRect;
|
|
distance: integer; angle: single; oriented: boolean);
|
|
procedure bgra_FilterCustomBlur(id: integer; mask: integer);
|
|
procedure bgra_FilterCustomBlurRect(id: integer; ABounds: TRect; mask: integer);
|
|
procedure bgra_FilterEmboss(id: integer; angle: single);
|
|
procedure bgra_FilterEmbossRect(id: integer; angle: single; ABounds: TRect);
|
|
procedure bgra_FilterEmbossHighlight(id: integer; FillSelection: boolean);
|
|
procedure bgra_FilterEmbossHighlightBorder(id: integer; FillSelection: boolean;
|
|
BorderColor: TBGRAColor);
|
|
procedure bgra_FilterEmbossHighlightBorderAndOffset(id: integer;
|
|
FillSelection: boolean; BorderColor: TBGRAColor; Offset: TPoint);
|
|
procedure bgra_FilterGrayscale(id: integer);
|
|
procedure bgra_FilterGrayscaleRect(id: integer; ABounds: TRect);
|
|
procedure bgra_FilterNormalize(id: integer; eachChannel: boolean);
|
|
procedure bgra_FilterNormalizeRect(id: integer; ABounds: TRect; eachChannel: boolean);
|
|
procedure bgra_FilterRotate(id: integer; origin: TPointF; angle: single;
|
|
correctBlur: boolean);
|
|
procedure bgra_FilterSphere(id: integer);
|
|
procedure bgra_FilterTwirl(id: integer; ACenter: TPoint; ARadius: single;
|
|
ATurn: single; AExponent: single);
|
|
procedure bgra_FilterTwirlRect(id: integer; ABounds: TRect; ACenter: TPoint;
|
|
ARadius: single; ATurn: single; AExponent: single);
|
|
procedure bgra_FilterCylinder(id: integer);
|
|
procedure bgra_FilterPlane(id: integer);
|
|
|
|
implementation
|
|
|
|
procedure bgra_Initialization;
|
|
begin
|
|
|
|
end;
|
|
|
|
procedure bgra_Finalization;
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 0 to High(BitmapArray) do
|
|
FreeAndNil(BitmapArray[i]);
|
|
BitmapArray := nil;
|
|
end;
|
|
|
|
procedure bgra_AddBitmap(id: integer);
|
|
begin
|
|
if id + 1 > length(BitmapArray) then
|
|
SetLength(BitmapArray, id + 1);
|
|
FreeAndNil(BitmapArray[id]);
|
|
end;
|
|
|
|
function bgra_GetHighestID: integer;
|
|
begin
|
|
Result := High(BitmapArray);
|
|
end;
|
|
|
|
function BGRAColorToBGRAPixel(AColor: TBGRAColor): TBGRAPixel;
|
|
begin
|
|
Result := TBGRAPixel(
|
|
{$IFDEF ENDIAN_BIG}
|
|
SwapEndian
|
|
{$ENDIF}
|
|
(AColor));
|
|
end;
|
|
|
|
function rgb(red, green, blue: byte): TBGRAColor;
|
|
begin
|
|
Result := blue + (green shl 8) + (red shl 16) + $ff000000;
|
|
end;
|
|
|
|
function rgba(red, green, blue, alpha: byte): TBGRAColor;
|
|
begin
|
|
Result := blue + (green shl 8) + (red shl 16) + (alpha shl 24);
|
|
end;
|
|
|
|
function getBlue(AColor: TBGRAColor): byte;
|
|
begin
|
|
Result := AColor and $ff;
|
|
end;
|
|
|
|
function getGreen(AColor: TBGRAColor): byte;
|
|
begin
|
|
Result := (AColor shr 8) and $ff;
|
|
end;
|
|
|
|
function getRed(AColor: TBGRAColor): byte;
|
|
begin
|
|
Result := (AColor shr 16) and $ff;
|
|
end;
|
|
|
|
function getAlpha(AColor: TBGRAColor): byte;
|
|
begin
|
|
Result := AColor shr 24;
|
|
end;
|
|
|
|
function setBlue(AColor: TBGRAColor; AValue: byte): TBGRAColor;
|
|
begin
|
|
Result := (AColor and $ffffff00) or AValue;
|
|
end;
|
|
|
|
function setGreen(AColor: TBGRAColor; AValue: byte): TBGRAColor;
|
|
begin
|
|
Result := (AColor and $ffff00ff) or (AValue shl 8);
|
|
end;
|
|
|
|
function setRed(AColor: TBGRAColor; AValue: byte): TBGRAColor;
|
|
begin
|
|
Result := (AColor and $ff00ffff) or (AValue shl 16);
|
|
end;
|
|
|
|
function setAlpha(AColor: TBGRAColor; AValue: byte): TBGRAColor;
|
|
begin
|
|
Result := (AColor and $00ffffff) or (AValue shl 24);
|
|
end;
|
|
|
|
procedure bgra_Create(id: integer);
|
|
begin
|
|
bgra_AddBitmap(id);
|
|
BitmapArray[id] := TBGRABitmap.Create;
|
|
end;
|
|
|
|
procedure bgra_CreateWithSize(id: integer; AWidth, AHeight: integer);
|
|
begin
|
|
bgra_AddBitmap(id);
|
|
BitmapArray[id] := TBGRABitmap.Create(AWidth, AHeight);
|
|
end;
|
|
|
|
procedure bgra_CreateFromFile(id: integer; AFilename: string);
|
|
begin
|
|
bgra_AddBitmap(id);
|
|
BitmapArray[id] := TBGRABitmap.Create(AFilename);
|
|
end;
|
|
|
|
procedure bgra_Destroy(id: integer);
|
|
begin
|
|
FreeAndNil(BitmapArray[id]);
|
|
end;
|
|
|
|
procedure bgra_DestroyAll;
|
|
var
|
|
id: integer;
|
|
begin
|
|
for id := 0 to bgra_GetHighestID do
|
|
bgra_Destroy(id);
|
|
SetLength(BitmapArray, 0);
|
|
end;
|
|
|
|
procedure bgra_Fill(id: integer; AColor: TBGRAColor);
|
|
begin
|
|
if Assigned(BitmapArray[id]) then
|
|
BitmapArray[id].Fill(TBGRAPixel(
|
|
{$IFDEF ENDIAN_BIG}
|
|
SwapEndian
|
|
{$ENDIF}
|
|
(AColor)));
|
|
end;
|
|
|
|
procedure bgra_SetPixel(id: integer; x, y: integer; AColor: TBGRAColor);
|
|
begin
|
|
if Assigned(BitmapArray[id]) then
|
|
BitmapArray[id].SetPixel(x, y, TBGRAPixel(
|
|
{$IFDEF ENDIAN_BIG}
|
|
SwapEndian
|
|
{$ENDIF}
|
|
(AColor)));
|
|
end;
|
|
|
|
function bgra_GetPixel(id: integer; x, y: integer): TBGRAColor;
|
|
begin
|
|
if Assigned(BitmapArray[id]) then
|
|
Result :=
|
|
{$IFDEF ENDIAN_BIG}
|
|
SwapEndian
|
|
{$ENDIF}
|
|
(TBGRAColor(BitmapArray[id].GetPixel(x, y)))
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
procedure bgra_SaveToFile(id: integer; const filename: string);
|
|
begin
|
|
BitmapArray[id].SaveToFile(filename);
|
|
end;
|
|
|
|
procedure bgra_FilterSmartZoom3(id: integer; Option: TMedianOption);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterSmartZoom3(Option) as TBGRABitmap);
|
|
end;
|
|
|
|
procedure bgra_FilterMedian(id: integer; Option: TMedianOption);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterMedian(Option) as TBGRABitmap);
|
|
end;
|
|
|
|
procedure bgra_FilterSmooth(id: integer);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterSmooth as TBGRABitmap);
|
|
end;
|
|
|
|
procedure bgra_FilterSharpen(id: integer; Amount: single);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterSharpen(Amount) as TBGRABitmap);
|
|
end;
|
|
|
|
procedure bgra_FilterSharpenRect(id: integer; ABounds: TRect; Amount: single);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterSharpen(ABounds, Amount) as
|
|
TBGRABitmap);
|
|
end;
|
|
|
|
procedure bgra_FilterContour(id: integer);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterContour as TBGRABitmap);
|
|
end;
|
|
|
|
procedure bgra_FilterPixelate(id: integer; pixelSize: integer;
|
|
useResample: boolean; filter: TResampleFilter);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterPixelate(pixelSize,
|
|
useResample, filter) as TBGRABitmap);
|
|
end;
|
|
|
|
procedure bgra_FilterBlurRadial(id: integer; radius: integer;
|
|
blurType: TRadialBlurType);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterBlurRadial(radius, blurType) as
|
|
TBGRABitmap);
|
|
end;
|
|
|
|
procedure bgra_FilterBlurRadialRect(id: integer; ABounds: TRect;
|
|
radius: integer; blurType: TRadialBlurType);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterBlurRadial(ABounds,
|
|
radius, blurType) as TBGRABitmap);
|
|
end;
|
|
|
|
procedure bgra_FilterBlurMotion(id: integer; distance: integer;
|
|
angle: single; oriented: boolean);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterBlurMotion(distance,
|
|
angle, oriented) as TBGRABitmap);
|
|
end;
|
|
|
|
procedure bgra_FilterBlurMotionRect(id: integer; ABounds: TRect;
|
|
distance: integer; angle: single; oriented: boolean);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterBlurMotion(ABounds,
|
|
distance, angle, oriented) as TBGRABitmap);
|
|
end;
|
|
|
|
procedure bgra_FilterCustomBlur(id: integer; mask: integer);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterCustomBlur(BitmapArray[mask]) as
|
|
TBGRABitmap);
|
|
end;
|
|
|
|
procedure bgra_FilterCustomBlurRect(id: integer; ABounds: TRect; mask: integer);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterCustomBlur(ABounds,
|
|
BitmapArray[mask]) as TBGRABitmap);
|
|
end;
|
|
|
|
procedure bgra_FilterEmboss(id: integer; angle: single);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterEmboss(angle) as TBGRABitmap);
|
|
end;
|
|
|
|
procedure bgra_FilterEmbossRect(id: integer; angle: single; ABounds: TRect);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterEmboss(angle, ABounds) as
|
|
TBGRABitmap);
|
|
end;
|
|
|
|
procedure bgra_FilterEmbossHighlight(id: integer; FillSelection: boolean);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterEmbossHighlight(FillSelection) as
|
|
TBGRABitmap);
|
|
end;
|
|
|
|
procedure bgra_FilterEmbossHighlightBorder(id: integer; FillSelection: boolean;
|
|
BorderColor: TBGRAColor);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterEmbossHighlight(
|
|
FillSelection, BGRAColorToBGRAPixel(BorderColor)) as TBGRABitmap);
|
|
end;
|
|
|
|
procedure bgra_FilterEmbossHighlightBorderAndOffset(id: integer;
|
|
FillSelection: boolean; BorderColor: TBGRAColor; Offset: TPoint);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterEmbossHighlight(
|
|
FillSelection, BGRAColorToBGRAPixel(BorderColor), Offset) as TBGRABitmap);
|
|
end;
|
|
|
|
procedure bgra_FilterGrayscale(id: integer);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterGrayscale as TBGRABitmap);
|
|
end;
|
|
|
|
procedure bgra_FilterGrayscaleRect(id: integer; ABounds: TRect);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterGrayscale(ABounds) as TBGRABitmap);
|
|
end;
|
|
|
|
procedure bgra_FilterNormalize(id: integer; eachChannel: boolean);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterNormalize(eachChannel) as
|
|
TBGRABitmap);
|
|
end;
|
|
|
|
procedure bgra_FilterNormalizeRect(id: integer; ABounds: TRect; eachChannel: boolean);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterNormalize(ABounds, eachChannel) as
|
|
TBGRABitmap);
|
|
end;
|
|
|
|
procedure bgra_FilterRotate(id: integer; origin: TPointF; angle: single;
|
|
correctBlur: boolean);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterRotate(origin,
|
|
angle, correctBlur) as TBGRABitmap);
|
|
end;
|
|
|
|
procedure bgra_FilterSphere(id: integer);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterSphere as TBGRABitmap);
|
|
end;
|
|
|
|
procedure bgra_FilterTwirl(id: integer; ACenter: TPoint; ARadius: single;
|
|
ATurn: single; AExponent: single);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterTwirl(ACenter,
|
|
ARadius, ATurn, AExponent) as TBGRABitmap);
|
|
end;
|
|
|
|
procedure bgra_FilterTwirlRect(id: integer; ABounds: TRect; ACenter: TPoint;
|
|
ARadius: single; ATurn: single; AExponent: single);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterTwirl(ABounds,
|
|
ACenter, ARadius, ATurn, AExponent) as TBGRABitmap);
|
|
end;
|
|
|
|
procedure bgra_FilterCylinder(id: integer);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterCylinder as TBGRABitmap);
|
|
end;
|
|
|
|
procedure bgra_FilterPlane(id: integer);
|
|
begin
|
|
BGRAReplace(BitmapArray[id], BitmapArray[id].FilterPlane as TBGRABitmap);
|
|
end;
|
|
|
|
initialization
|
|
bgra_Initialization;
|
|
|
|
finalization
|
|
bgra_Finalization;
|
|
|
|
end.
|