// 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.