mirror of
https://github.com/HeidiSQL/HeidiSQL.git
synced 2025-08-06 18:24:26 +08:00
2173 lines
58 KiB
ObjectPascal
2173 lines
58 KiB
ObjectPascal
// **************************************************************************************************
|
|
//
|
|
// Unit Vcl.Styles.Utils.Graphics
|
|
// unit for the VCL Styles Utils
|
|
// https://github.com/RRUZ/vcl-styles-utils/
|
|
//
|
|
// The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License");
|
|
// you may not use this file except in compliance with the License. You may obtain a copy of the
|
|
// License at http://www.mozilla.org/MPL/
|
|
//
|
|
// Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF
|
|
// ANY KIND, either express or implied. See the License for the specific language governing rights
|
|
// and limitations under the License.
|
|
//
|
|
// The Original Code is Vcl.Styles.Utils.Graphics.pas.
|
|
//
|
|
// The Initial Developer of the Original Code is Rodrigo Ruz V.
|
|
// Portions created by Rodrigo Ruz V. are Copyright (C) 2012-2021 Rodrigo Ruz V.
|
|
// All Rights Reserved.
|
|
//
|
|
// **************************************************************************************************
|
|
|
|
unit Vcl.Styles.Utils.Graphics;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.UITypes,
|
|
System.Classes,
|
|
System.SysUtils,
|
|
Winapi.Windows,
|
|
Vcl.Styles,
|
|
Vcl.Themes,
|
|
Vcl.StdCtrls,
|
|
Vcl.GraphUtil,
|
|
Vcl.Graphics;
|
|
|
|
type
|
|
TImageFilterCallback = procedure(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
|
|
const
|
|
MaxHue = 180;
|
|
MinHue = -180;
|
|
DefHue = 0;
|
|
|
|
MaxSat = 255;
|
|
MinSat = 0;
|
|
DefSat = 0;
|
|
|
|
MaxLig = 255;
|
|
MinLig = -255;
|
|
DefLig = 0;
|
|
|
|
procedure _ProcessBitmap32(const Dest: TBitmap; Value: Integer; _Process: TImageFilterCallback); overload;
|
|
procedure _ProcessBitmap24(const ABitMap: TBitmap; Value: Integer; _Process: TImageFilterCallback); overload;
|
|
|
|
procedure GetRGB(Col: TColor; var R, G, B: byte);
|
|
function _HSLtoRGB(HueValue, SaturationValue, LightValue: Double): TColor;
|
|
procedure _RGBtoHSL(RGB: TColor; var HueValue, SaturationValue, LightValue: Double);
|
|
|
|
procedure _Hue(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
procedure _Hue24(var ABitMap: TBitmap; Value: Integer);
|
|
procedure _Hue32(const ABitMap: TBitmap; Value: Integer);
|
|
|
|
procedure _Sepia(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
procedure _Sepia24(const ABitMap: TBitmap; Value: byte = 32);
|
|
procedure _Sepia32(const ABitMap: TBitmap; Value: byte = 32);
|
|
|
|
procedure _BlendMultiply(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
procedure _BlendMultiply24(const ABitMap: TBitmap; Value: Integer);
|
|
procedure _BlendMultiply32(const ABitMap: TBitmap; Value: Integer);
|
|
|
|
procedure _Lightness(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
procedure _Lightness24(var ABitMap: TBitmap; Value: Integer);
|
|
procedure _Lightness32(const ABitMap: TBitmap; Value: Integer);
|
|
|
|
procedure _Darkness(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
procedure _Darkness24(var ABitMap: TBitmap; Value: Integer);
|
|
procedure _Darkness32(const ABitMap: TBitmap; Value: Integer);
|
|
|
|
procedure _Saturation(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
procedure _Saturation24(var ABitMap: TBitmap; Value: Integer);
|
|
procedure _Saturation32(const ABitMap: TBitmap; Value: Integer);
|
|
|
|
procedure _SetRComponent(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
procedure _SetGComponent(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
procedure _SetBComponent(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
|
|
procedure _SetRGB24(const ABitMap: TBitmap; DR, DG, DB: Integer);
|
|
procedure _SetRGB32(const ABitMap: TBitmap; DR, DG, DB: Integer);
|
|
|
|
procedure _BlendBurn(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
procedure _BlendBurn24(const ABitMap: TBitmap; Value: Integer);
|
|
procedure _BlendBurn32(const ABitMap: TBitmap; Value: Integer);
|
|
|
|
procedure _BlendAdditive(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
procedure _BlendAdditive24(const ABitMap: TBitmap; Value: Integer);
|
|
procedure _BlendAdditive32(const ABitMap: TBitmap; Value: Integer);
|
|
|
|
procedure _BlendDodge(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
procedure _BlendDodge24(const ABitMap: TBitmap; Value: Integer);
|
|
procedure _BlendDodge32(const ABitMap: TBitmap; Value: Integer);
|
|
|
|
procedure _BlendOverlay(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
procedure _BlendOverlay24(const ABitMap: TBitmap; Value: Integer);
|
|
procedure _BlendOverlay32(const ABitMap: TBitmap; Value: Integer);
|
|
|
|
procedure _BlendDifference(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
procedure _BlendDifference24(const ABitMap: TBitmap; Value: Integer);
|
|
procedure _BlendDifference32(const ABitMap: TBitmap; Value: Integer);
|
|
|
|
procedure _BlendLighten(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
procedure _BlendLighten24(const ABitMap: TBitmap; Value: Integer);
|
|
procedure _BlendLighten32(const ABitMap: TBitmap; Value: Integer);
|
|
|
|
procedure _BlendDarken(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
procedure _BlendDarken24(const ABitMap: TBitmap; Value: Integer);
|
|
procedure _BlendDarken32(const ABitMap: TBitmap; Value: Integer);
|
|
|
|
procedure _BlendScreen(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
procedure _BlendScreen24(const ABitMap: TBitmap; Value: Integer);
|
|
procedure _BlendScreen32(const ABitMap: TBitmap; Value: Integer);
|
|
|
|
procedure Bitmap8_Grayscale(ABitMap: TBitmap);
|
|
procedure Bitmap24_Grayscale(ABitMap: TBitmap);
|
|
procedure Bitmap32_Grayscale(ABitMap: TBitmap);
|
|
|
|
procedure Bitmap32_SetAlpha(ABitMap: TBitmap; AlphaValue: byte);
|
|
// Set the Alpha and Color of a 32 bit Bitmap
|
|
procedure Bitmap32_SetAlphaAndColor(ABitMap: TBitmap; AlphaValue: byte; AColor: TColor);
|
|
// Set the Alpha value for a specific Color of a 32 bit Bitmap
|
|
procedure Bitmap32_SetAlphaByColor(ABitMap: TBitmap; AlphaValue: byte; AColor: TColor);
|
|
|
|
// Set the Alpha value for all Colors, except the Color Param of a 32 bit Bitmap
|
|
procedure Bitmap32_SetAlphaExceptColor(ABitMap: TBitmap; AlphaValue: byte; AColor: TColor);
|
|
|
|
type
|
|
TColorFilter = class
|
|
private
|
|
FColorValue: Integer;
|
|
public
|
|
constructor Create(AColorValue: Integer);
|
|
property ColorValue: Integer read FColorValue Write FColorValue;
|
|
function ProcessColor(AColor: TColor): TColor; virtual; abstract;
|
|
end;
|
|
|
|
TBitmapFilter = class(TColorFilter)
|
|
private
|
|
// FColorValue: Integer;
|
|
FUseBitmap: Boolean;
|
|
FSourceBitmap: TBitmap;
|
|
public
|
|
constructor Create(AColorValue: Integer);
|
|
constructor CreateBitMap(ASourceBitmap: TBitmap);
|
|
procedure ProcessBitmap(ABitMap: TBitmap); virtual; abstract;
|
|
end;
|
|
|
|
TBitmap32HueFilter = class(TBitmapFilter)
|
|
public
|
|
procedure ProcessBitmap(ABitMap: TBitmap); override;
|
|
function ProcessColor(AColor: TColor): TColor; override;
|
|
end;
|
|
|
|
TBitmap32SaturationFilter = class(TBitmapFilter)
|
|
public
|
|
procedure ProcessBitmap(ABitMap: TBitmap); override;
|
|
function ProcessColor(AColor: TColor): TColor; override;
|
|
end;
|
|
|
|
TBitmap32LightnessFilter = class(TBitmapFilter)
|
|
public
|
|
procedure ProcessBitmap(ABitMap: TBitmap); override;
|
|
function ProcessColor(AColor: TColor): TColor; override;
|
|
end;
|
|
|
|
TBitmap32SepiaFilter = class(TBitmapFilter)
|
|
public
|
|
procedure ProcessBitmap(ABitMap: TBitmap); override;
|
|
function ProcessColor(AColor: TColor): TColor; override;
|
|
end;
|
|
|
|
TBitmap32RedFilter = class(TBitmapFilter)
|
|
public
|
|
procedure ProcessBitmap(ABitMap: TBitmap); override;
|
|
function ProcessColor(AColor: TColor): TColor; override;
|
|
end;
|
|
|
|
TBitmap32GreenFilter = class(TBitmapFilter)
|
|
public
|
|
procedure ProcessBitmap(ABitMap: TBitmap); override;
|
|
function ProcessColor(AColor: TColor): TColor; override;
|
|
end;
|
|
|
|
TBitmap32BlueFilter = class(TBitmapFilter)
|
|
public
|
|
procedure ProcessBitmap(ABitMap: TBitmap); override;
|
|
function ProcessColor(AColor: TColor): TColor; override;
|
|
end;
|
|
|
|
TBitmap32BlendBurn = class(TBitmapFilter)
|
|
public
|
|
procedure ProcessBitmap(ABitMap: TBitmap); override;
|
|
function ProcessColor(AColor: TColor): TColor; override;
|
|
end;
|
|
|
|
TBitmap32BlendMultiply = class(TBitmapFilter)
|
|
public
|
|
procedure ProcessBitmap(ABitMap: TBitmap); override;
|
|
function ProcessColor(AColor: TColor): TColor; override;
|
|
end;
|
|
|
|
TBitmap32BlendAdditive = class(TBitmapFilter)
|
|
public
|
|
procedure ProcessBitmap(ABitMap: TBitmap); override;
|
|
function ProcessColor(AColor: TColor): TColor; override;
|
|
end;
|
|
|
|
TBitmap32BlendDodge = class(TBitmapFilter)
|
|
public
|
|
procedure ProcessBitmap(ABitMap: TBitmap); override;
|
|
function ProcessColor(AColor: TColor): TColor; override;
|
|
end;
|
|
|
|
TBitmap32BlendOverlay = class(TBitmapFilter)
|
|
public
|
|
procedure ProcessBitmap(ABitMap: TBitmap); override;
|
|
function ProcessColor(AColor: TColor): TColor; override;
|
|
end;
|
|
|
|
TBitmap32BlendDifference = class(TBitmapFilter)
|
|
public
|
|
procedure ProcessBitmap(ABitMap: TBitmap); override;
|
|
function ProcessColor(AColor: TColor): TColor; override;
|
|
end;
|
|
|
|
TBitmap32BlendLighten = class(TBitmapFilter)
|
|
public
|
|
procedure ProcessBitmap(ABitMap: TBitmap); override;
|
|
function ProcessColor(AColor: TColor): TColor; override;
|
|
end;
|
|
|
|
TBitmap32BlendDarken = class(TBitmapFilter)
|
|
public
|
|
procedure ProcessBitmap(ABitMap: TBitmap); override;
|
|
function ProcessColor(AColor: TColor): TColor; override;
|
|
end;
|
|
|
|
TBitmap32BlendScreen = class(TBitmapFilter)
|
|
public
|
|
procedure ProcessBitmap(ABitMap: TBitmap); override;
|
|
function ProcessColor(AColor: TColor): TColor; override;
|
|
end;
|
|
|
|
procedure GradientRoundedFillCanvas(const ACanvas: TCanvas; const AStartColor, AEndColor: TColor; const ARect: TRect;
|
|
const Direction: TGradientDirection; Radius: Integer);
|
|
|
|
procedure AlphaBlendFillCanvas(const ACanvas: TCanvas; const AColor: TColor; const ARect: TRect;
|
|
SourceConstantAlpha: byte); overload;
|
|
procedure AlphaBlendFillCanvas(const DC: HDC; const AColor: TColor; const ARect: TRect;
|
|
SourceConstantAlpha: byte); overload;
|
|
|
|
procedure AlphaBlendRectangle(const ACanvas: TCanvas; const AColor: TColor; const ARect: TRect;
|
|
SourceConstantAlpha: byte); overload;
|
|
procedure AlphaBlendRectangle(const DC: HDC; const AColor: TColor; const ARect: TRect;
|
|
SourceConstantAlpha: byte); overload;
|
|
|
|
procedure DrawStyleElement(HDC: HDC; LDetails: TThemedElementDetails; pRect:
|
|
TRect; RestoreDC: Boolean = True; const AStyle: TCustomStyleServices =
|
|
nil); overload;
|
|
{$IF (CompilerVersion >= 33)}
|
|
procedure DrawStyleElement(HDC: HDC; LDetails: TThemedElementDetails; pRect: TRect; ClipRect: pRect; DPI: Integer = 0;
|
|
RestoreDC: Boolean = True); overload;
|
|
{$IFEND}
|
|
procedure DrawStyleDownArrow(HDC: HDC; LRect: TRect; AColor: TColor);
|
|
procedure DrawStyleFillRect(HDC: HDC; LRect: TRect; AColor: TColor);
|
|
procedure DrawStyleRectangle(HDC: HDC; LRect: TRect; AColor: TColor);
|
|
|
|
procedure DrawStyleArrow(HDC: HDC; Direction: TScrollDirection; Location: TPoint; Size: Integer; AColor: TColor);
|
|
procedure DrawStyleParentBackground(Handle: THandle; DC: HDC; const ARect: TRect);
|
|
procedure DrawStyleParentBackgroundEx(Handle: THandle; DC: HDC; const ARect: TRect);
|
|
|
|
procedure RotateBitmap(ABitMap: TBitmap; Rads: Single; AdjustSize: Boolean; BackGroundColor: TColor = clNone);
|
|
procedure FlipBitmap24Horizontal(ABitMap: TBitmap);
|
|
procedure FlipBitmap32Horizontal(ABitMap: TBitmap);
|
|
|
|
function ColorIsBright(AColor: TColor): Boolean;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Winapi.Messages,
|
|
Vcl.Controls,
|
|
{$IFDEF USE_ZIP}
|
|
System.Zip,
|
|
{$ENDIF}
|
|
System.Types,
|
|
System.Math, Vcl.Forms;
|
|
|
|
type
|
|
PRGBArray24 = ^TRGBArray24;
|
|
TRGBArray24 = array [0 .. 0] of TRGBTriple;
|
|
|
|
PRGBArray32 = ^TRGBArray32;
|
|
TRGBArray32 = array [0 .. 0] of TRGBQuad;
|
|
|
|
type
|
|
TMirrorKind = (mtHorizontal, mtVertical, mtBoth);
|
|
|
|
procedure MirrorBitMap(ABitMap: TBitmap; MirrorType: TMirrorKind);
|
|
var
|
|
LRect: TRect;
|
|
begin
|
|
|
|
case MirrorType of
|
|
|
|
mtHorizontal:
|
|
begin
|
|
LRect.Left := ABitMap.Width;
|
|
LRect.Top := 0;
|
|
LRect.Right := -ABitMap.Width;
|
|
LRect.Bottom := ABitMap.Height
|
|
end;
|
|
|
|
mtVertical:
|
|
begin
|
|
LRect.Left := 0;
|
|
LRect.Top := ABitMap.Height;
|
|
LRect.Right := ABitMap.Width;
|
|
LRect.Bottom := -ABitMap.Height
|
|
end;
|
|
|
|
mtBoth:
|
|
begin
|
|
LRect.Left := ABitMap.Width;
|
|
LRect.Top := ABitMap.Height;
|
|
LRect.Right := -ABitMap.Width;
|
|
LRect.Bottom := -ABitMap.Height
|
|
end;
|
|
|
|
end;
|
|
|
|
StretchBlt(ABitMap.Canvas.Handle, LRect.Left, LRect.Top, LRect.Right, LRect.Bottom, ABitMap.Canvas.Handle, 0, 0,
|
|
ABitMap.Width, ABitMap.Height, SRCCOPY);
|
|
end;
|
|
|
|
procedure GetRGB(Col: TColor; var R, G, B: byte);
|
|
var
|
|
Color: $0 .. $FFFFFFFF;
|
|
begin
|
|
Color := ColorToRGB(Col);
|
|
R := ($000000FF and Color);
|
|
G := ($0000FF00 and Color) shr 8;
|
|
B := ($00FF0000 and Color) shr 16;
|
|
end;
|
|
|
|
function ColorIsBright(AColor: TColor): Boolean;
|
|
var
|
|
R, G, B: byte;
|
|
Delta: Double;
|
|
begin
|
|
GetRGB(AColor, R, G, B);
|
|
Delta := 1 - ((0.299 * R) + (0.587 * G) + (0.114 * B)) / 255;
|
|
Result := (Delta < 0.5);
|
|
end;
|
|
|
|
procedure _FlipBitmap24Horizontal(ABitMap: TBitmap);
|
|
var
|
|
LRGBArray24: PRGBArray24;
|
|
LRGBTriple: TRGBTriple;
|
|
x, y: Integer;
|
|
begin
|
|
for y := 0 to ABitMap.Height - 1 do
|
|
begin
|
|
LRGBArray24 := ABitMap.ScanLine[y];
|
|
for x := 0 to ABitMap.Width div 2 do
|
|
begin
|
|
{$IFOPT R+}
|
|
{$DEFINE RANGEON}
|
|
{$R-}
|
|
{$ELSE}
|
|
{$UNDEF RANGEON}
|
|
{$ENDIF}
|
|
LRGBTriple := LRGBArray24[x];
|
|
LRGBArray24[x] := LRGBArray24[ABitMap.Width - x - 1];
|
|
LRGBArray24[ABitMap.Width - x - 1] := LRGBTriple;
|
|
{$IFDEF RANGEON}
|
|
{$R+}
|
|
{$UNDEF RANGEON}
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure _FlipBitmap32Horizontal(ABitMap: TBitmap);
|
|
var
|
|
LRGBArray32: PRGBArray32;
|
|
LRGBQuad: TRGBQuad;
|
|
x, y: Integer;
|
|
begin
|
|
if ABitMap.PixelFormat <> pf32bit then
|
|
exit;
|
|
|
|
for y := 0 to ABitMap.Height - 1 do
|
|
begin
|
|
LRGBArray32 := ABitMap.ScanLine[y];
|
|
for x := 0 to ABitMap.Width div 2 do
|
|
begin
|
|
{$IFOPT R+}
|
|
{$DEFINE RANGEON}
|
|
{$R-}
|
|
{$ELSE}
|
|
{$UNDEF RANGEON}
|
|
{$ENDIF}
|
|
LRGBQuad := LRGBArray32[x];
|
|
LRGBArray32[x] := LRGBArray32[ABitMap.Width - x - 1];
|
|
LRGBArray32[ABitMap.Width - x - 1] := LRGBQuad;
|
|
{$IFDEF RANGEON}
|
|
{$R+}
|
|
{$UNDEF RANGEON}
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure FlipBitmap24Horizontal(ABitMap: TBitmap);
|
|
begin
|
|
if ABitMap.PixelFormat <> pf24bit then
|
|
exit;
|
|
MirrorBitMap(ABitMap, TMirrorKind.mtHorizontal);
|
|
end;
|
|
|
|
procedure FlipBitmap32Horizontal(ABitMap: TBitmap);
|
|
begin
|
|
if ABitMap.PixelFormat <> pf32bit then
|
|
exit;
|
|
MirrorBitMap(ABitMap, TMirrorKind.mtHorizontal);
|
|
end;
|
|
|
|
procedure RotateBitmap(ABitMap: TBitmap; Rads: Single; AdjustSize: Boolean; BackGroundColor: TColor = clNone);
|
|
var
|
|
C: Single;
|
|
S: Single;
|
|
LXForm: TXForm;
|
|
LBuffer: TBitmap;
|
|
begin
|
|
C := Cos(Rads);
|
|
S := Sin(Rads);
|
|
LXForm.eM11 := C;
|
|
LXForm.eM12 := S;
|
|
LXForm.eM21 := -S;
|
|
LXForm.eM22 := C;
|
|
LBuffer := TBitmap.Create;
|
|
try
|
|
LBuffer.TransparentColor := ABitMap.TransparentColor;
|
|
LBuffer.TransparentMode := ABitMap.TransparentMode;
|
|
LBuffer.Transparent := ABitMap.Transparent;
|
|
LBuffer.Canvas.Brush.Color := BackGroundColor;
|
|
if AdjustSize then
|
|
begin
|
|
LBuffer.Width := Round(ABitMap.Width * Abs(C) + ABitMap.Height * Abs(S));
|
|
LBuffer.Height := Round(ABitMap.Width * Abs(S) + ABitMap.Height * Abs(C));
|
|
LXForm.eDx := (LBuffer.Width - ABitMap.Width * C + ABitMap.Height * S) / 2;
|
|
LXForm.eDy := (LBuffer.Height - ABitMap.Width * S - ABitMap.Height * C) / 2;
|
|
end
|
|
else
|
|
begin
|
|
LBuffer.Width := ABitMap.Width;
|
|
LBuffer.Height := ABitMap.Height;
|
|
LXForm.eDx := (ABitMap.Width - ABitMap.Width * C + ABitMap.Height * S) / 2;
|
|
LXForm.eDy := (ABitMap.Height - ABitMap.Width * S - ABitMap.Height * C) / 2;
|
|
end;
|
|
SetGraphicsMode(LBuffer.Canvas.Handle, GM_ADVANCED);
|
|
SetWorldTransform(LBuffer.Canvas.Handle, LXForm);
|
|
BitBlt(LBuffer.Canvas.Handle, 0, 0, LBuffer.Width, LBuffer.Height, ABitMap.Canvas.Handle, 0, 0, SRCCOPY);
|
|
ABitMap.Assign(LBuffer);
|
|
finally
|
|
LBuffer.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure Bitmap8_Grayscale(ABitMap: TBitmap);
|
|
var
|
|
LPalette: HPalette;
|
|
LMaxLogPalette: TMaxLogPalette;
|
|
Lbyte: Integer;
|
|
LColors: array [0 .. 255] of TRGBQuad;
|
|
begin
|
|
if ABitMap.PixelFormat <> pf8bit then
|
|
exit;
|
|
LPalette := ABitMap.Palette;
|
|
if LPalette = 0 then
|
|
exit;
|
|
|
|
if GetPaletteEntries(LPalette, 0, 256, LColors) = 0 then
|
|
exit;
|
|
Lbyte := 0;
|
|
|
|
while (LColors[Lbyte].rgbBlue = Lbyte) and (LColors[Lbyte].rgbGreen = Lbyte) and (LColors[Lbyte].rgbRed = Lbyte) do
|
|
Inc(Lbyte);
|
|
if Lbyte > 256 then
|
|
exit;
|
|
LMaxLogPalette.palVersion := $0300;
|
|
LMaxLogPalette.palNumEntries := 256;
|
|
for Lbyte := 0 to 255 do
|
|
with LMaxLogPalette.palPalEntry[Lbyte] do
|
|
begin
|
|
peBlue := Lbyte;
|
|
peGreen := Lbyte;
|
|
peRed := Lbyte;
|
|
peFlags := 0;
|
|
end;
|
|
|
|
LPalette := CreatePalette(PLogPalette(@LMaxLogPalette)^);
|
|
ABitMap.Palette := LPalette;
|
|
ABitMap.Modified := True;
|
|
end;
|
|
|
|
procedure Bitmap24_Grayscale(ABitMap: TBitmap);
|
|
var
|
|
x: Integer;
|
|
y: Integer;
|
|
LGrayColor: byte;
|
|
LRGBTriple: PRGBTriple;
|
|
begin
|
|
if ABitMap.PixelFormat <> pf24bit then
|
|
exit;
|
|
|
|
for y := 0 to ABitMap.Height - 1 do
|
|
begin
|
|
LRGBTriple := ABitMap.ScanLine[y];
|
|
for x := 0 to ABitMap.Width - 1 do
|
|
begin
|
|
LGrayColor := Round((0.299 * LRGBTriple.rgbtRed) + (0.587 * LRGBTriple.rgbtGreen) +
|
|
(0.114 * LRGBTriple.rgbtBlue));
|
|
LRGBTriple.rgbtRed := LGrayColor;
|
|
LRGBTriple.rgbtGreen := LGrayColor;
|
|
LRGBTriple.rgbtBlue := LGrayColor;
|
|
Inc(LRGBTriple);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure Bitmap32_SetAlpha(ABitMap: TBitmap; AlphaValue: byte);
|
|
var
|
|
x: Integer;
|
|
y: Integer;
|
|
LRGBQuad: PRGBQuad;
|
|
begin
|
|
if ABitMap.PixelFormat <> pf32bit then
|
|
exit;
|
|
for y := 0 to ABitMap.Height - 1 do
|
|
begin
|
|
LRGBQuad := ABitMap.ScanLine[y];
|
|
for x := 0 to ABitMap.Width - 1 do
|
|
begin
|
|
LRGBQuad.rgbReserved := AlphaValue;
|
|
Inc(LRGBQuad);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure Bitmap32_SetAlphaAndColor(ABitMap: TBitmap; AlphaValue: byte; AColor: TColor);
|
|
var
|
|
x, y: Integer;
|
|
LRGBQuad: PRGBQuad;
|
|
R, G, B: byte;
|
|
begin
|
|
GetRGB(AColor, R, G, B);
|
|
if ABitMap.PixelFormat <> pf32bit then
|
|
exit;
|
|
for y := 0 to ABitMap.Height - 1 do
|
|
begin
|
|
LRGBQuad := ABitMap.ScanLine[y];
|
|
for x := 0 to ABitMap.Width - 1 do
|
|
begin
|
|
LRGBQuad.rgbRed := R;
|
|
LRGBQuad.rgbGreen := G;
|
|
LRGBQuad.rgbBlue := B;
|
|
LRGBQuad.rgbReserved := AlphaValue;
|
|
Inc(LRGBQuad);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure Bitmap32_SetAlphaByColor(ABitMap: TBitmap; AlphaValue: byte; AColor: TColor);
|
|
var
|
|
x, y: Integer;
|
|
LRGBQuad: PRGBQuad;
|
|
begin
|
|
if ABitMap.PixelFormat <> pf32bit then
|
|
exit;
|
|
for y := 0 to ABitMap.Height - 1 do
|
|
begin
|
|
LRGBQuad := ABitMap.ScanLine[y];
|
|
for x := 0 to ABitMap.Width - 1 do
|
|
begin
|
|
if Cardinal(ColorToRGB(AColor)) = RGB(LRGBQuad.rgbRed, LRGBQuad.rgbGreen, LRGBQuad.rgbBlue) then
|
|
LRGBQuad.rgbReserved := AlphaValue;
|
|
Inc(LRGBQuad);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure Bitmap32_SetAlphaExceptColor(ABitMap: TBitmap; AlphaValue: byte; AColor: TColor);
|
|
var
|
|
x, y: Integer;
|
|
LRGBQuad: PRGBQuad;
|
|
LColorRef: COLORREF;
|
|
begin
|
|
if ABitMap.PixelFormat <> pf32bit then
|
|
exit;
|
|
|
|
LColorRef := Cardinal(ColorToRGB(AColor));
|
|
for y := 0 to ABitMap.Height - 1 do
|
|
begin
|
|
LRGBQuad := ABitMap.ScanLine[y];
|
|
for x := 0 to ABitMap.Width - 1 do
|
|
begin
|
|
if LColorRef <> RGB(LRGBQuad.rgbRed, LRGBQuad.rgbGreen, LRGBQuad.rgbBlue) then
|
|
LRGBQuad.rgbReserved := AlphaValue;
|
|
Inc(LRGBQuad);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure Bitmap32_Grayscale(ABitMap: TBitmap);
|
|
var
|
|
x, y: Integer;
|
|
LGrayColor: byte;
|
|
LRGBQuad: PRGBQuad;
|
|
begin
|
|
if ABitMap.PixelFormat <> pf32bit then
|
|
exit;
|
|
|
|
for y := 0 to ABitMap.Height - 1 do
|
|
begin
|
|
LRGBQuad := ABitMap.ScanLine[y];
|
|
for x := 0 to ABitMap.Width - 1 do
|
|
begin
|
|
LGrayColor := Round((0.299 * LRGBQuad.rgbRed) + (0.587 * LRGBQuad.rgbGreen) + (0.114 * LRGBQuad.rgbBlue));
|
|
LRGBQuad.rgbRed := LGrayColor;
|
|
LRGBQuad.rgbGreen := LGrayColor;
|
|
LRGBQuad.rgbBlue := LGrayColor;
|
|
Inc(LRGBQuad);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure DrawStyleArrow(HDC: HDC; Direction: TScrollDirection; Location: TPoint; Size: Integer; AColor: TColor);
|
|
var
|
|
SaveIndex: Integer;
|
|
LCanvas: TCanvas;
|
|
begin
|
|
SaveIndex := SaveDC(HDC);
|
|
LCanvas := TCanvas.Create;
|
|
try
|
|
LCanvas.Handle := HDC;
|
|
LCanvas.Pen.Color := AColor;
|
|
LCanvas.Brush.Style := bsClear;
|
|
DrawArrow(LCanvas, Direction, Location, Size);
|
|
finally
|
|
LCanvas.Handle := 0;
|
|
LCanvas.Free;
|
|
RestoreDC(HDC, SaveIndex);
|
|
end;
|
|
end;
|
|
|
|
procedure DrawStyleFillRect(HDC: HDC; LRect: TRect; AColor: TColor);
|
|
var
|
|
SaveIndex: Integer;
|
|
LCanvas: TCanvas;
|
|
begin
|
|
LCanvas := TCanvas.Create;
|
|
SaveIndex := SaveDC(HDC);
|
|
try
|
|
LCanvas.Handle := HDC;
|
|
LCanvas.Brush.Color := AColor;
|
|
// LCanvas.Rectangle(LRect.Left, LRect.Top, LRect.Left + LRect.Width, LRect.Top + LRect.Height);
|
|
LCanvas.FillRect(LRect);
|
|
finally
|
|
LCanvas.Handle := 0;
|
|
LCanvas.Free;
|
|
RestoreDC(HDC, SaveIndex);
|
|
end;
|
|
end;
|
|
|
|
procedure DrawStyleRectangle(HDC: HDC; LRect: TRect; AColor: TColor);
|
|
var
|
|
SaveIndex: Integer;
|
|
LCanvas: TCanvas;
|
|
begin
|
|
LCanvas := TCanvas.Create;
|
|
SaveIndex := SaveDC(HDC);
|
|
try
|
|
LCanvas.Handle := HDC;
|
|
LCanvas.Brush.Style := bsClear;
|
|
LCanvas.Pen.Color := AColor;
|
|
LCanvas.Rectangle(LRect.Left, LRect.Top, LRect.Left + LRect.Width, LRect.Top + LRect.Height);
|
|
finally
|
|
LCanvas.Handle := 0;
|
|
LCanvas.Free;
|
|
RestoreDC(HDC, SaveIndex);
|
|
end;
|
|
end;
|
|
|
|
procedure DrawStyleDownArrow(HDC: HDC; LRect: TRect; AColor: TColor);
|
|
var
|
|
SaveIndex, x, y, I: Integer;
|
|
LColor: TColor;
|
|
LCanvas: TCanvas;
|
|
begin
|
|
SaveIndex := SaveDC(HDC);
|
|
LCanvas := TCanvas.Create;
|
|
try
|
|
LCanvas.Handle := HDC;
|
|
with LCanvas do
|
|
begin
|
|
LColor := Pen.Color;
|
|
try
|
|
Pen.Color := AColor;
|
|
x := LRect.Right - 8;
|
|
y := LRect.Top + (LRect.Height div 2) + 1;
|
|
for I := 3 downto 0 do
|
|
begin
|
|
MoveTo(x - I, y - I);
|
|
LineTo(x + I + 1, y - I);
|
|
end;
|
|
finally
|
|
Pen.Color := LColor;
|
|
end;
|
|
end;
|
|
finally
|
|
LCanvas.Handle := 0;
|
|
LCanvas.Free;
|
|
RestoreDC(HDC, SaveIndex);
|
|
end;
|
|
end;
|
|
|
|
procedure DrawStyleParentBackground(Handle: THandle; DC: HDC; const ARect: TRect);
|
|
var
|
|
LBuffer: TBitmap;
|
|
LPoint: TPoint;
|
|
LParentHandle: THandle;
|
|
begin
|
|
if (Handle = 0) or (ARect.Width <= 0) or (ARect.Height <= 0) then
|
|
exit;
|
|
|
|
LPoint := Point(ARect.Left, ARect.Top);
|
|
LBuffer := TBitmap.Create;
|
|
try
|
|
LParentHandle := GetParent(Handle);
|
|
if LParentHandle <> 0 then
|
|
begin
|
|
LBuffer.SetSize(ARect.Width, ARect.Height);
|
|
SendMessage(LParentHandle, WM_ERASEBKGND, LBuffer.Canvas.Handle, 0);
|
|
|
|
// ClientToScreen(Handle, LPoint);
|
|
// ScreenToClient(LParentHandle, LPoint);
|
|
// BitBlt(DC, ARect.Left, ARect.Top, ARect.Width, ARect.Height, LBuffer.Canvas.Handle, LPoint.X, LPoint.Y, SRCCOPY)
|
|
end;
|
|
finally
|
|
LBuffer.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure DrawStyleParentBackgroundEx(Handle: THandle; DC: HDC; const ARect: TRect);
|
|
var
|
|
LBuffer: TBitmap;
|
|
LPoint: TPoint;
|
|
LParentHandle: THandle;
|
|
begin
|
|
if (Handle = 0) or (ARect.Width <= 0) or (ARect.Height <= 0) then
|
|
exit;
|
|
LPoint := Point(ARect.Left, ARect.Top);
|
|
LBuffer := TBitmap.Create;
|
|
try
|
|
LParentHandle := GetParent(Handle);
|
|
if (LParentHandle <> 0) then
|
|
begin
|
|
LBuffer.SetSize(ARect.Width, ARect.Height);
|
|
SendMessage(LParentHandle, WM_ERASEBKGND, LBuffer.Canvas.Handle, 0);
|
|
ClientToScreen(Handle, LPoint);
|
|
ScreenToClient(LParentHandle, LPoint);
|
|
BitBlt(DC, ARect.Left, ARect.Top, ARect.Width, ARect.Height, LBuffer.Canvas.Handle, LPoint.x, LPoint.y, SRCCOPY)
|
|
end;
|
|
finally
|
|
LBuffer.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure DrawStyleElement(HDC: HDC; LDetails: TThemedElementDetails; pRect:
|
|
TRect; RestoreDC: Boolean = True; const AStyle: TCustomStyleServices = nil);
|
|
var
|
|
SaveIndex: Integer;
|
|
LStyle: TCustomStyleServices;
|
|
begin
|
|
SaveIndex := 0;
|
|
if Assigned(AStyle) then
|
|
LStyle := AStyle
|
|
else
|
|
LStyle := StyleServices;
|
|
if RestoreDC then
|
|
SaveIndex := SaveDC(HDC);
|
|
try
|
|
{$IF (CompilerVersion >= 34)}
|
|
if Assigned(Application.Mainform) then
|
|
LStyle.DrawElement(HDC, LDetails, pRect, nil, Application.MainForm.Monitor.PixelsPerInch)
|
|
else
|
|
LStyle.DrawElement(HDC, LDetails, pRect, nil, Screen.PixelsPerInch);
|
|
{$ELSE}
|
|
LStyle.DrawElement(HDC, LDetails, pRect, nil);
|
|
{$ENDIF}
|
|
finally
|
|
if (SaveIndex > 0) and RestoreDC then
|
|
Winapi.Windows.RestoreDC(HDC, SaveIndex);
|
|
end;
|
|
end;
|
|
|
|
{$IF (CompilerVersion >= 33)}
|
|
|
|
procedure DrawStyleElement(HDC: HDC; LDetails: TThemedElementDetails; pRect: TRect; ClipRect: pRect; DPI: Integer = 0;
|
|
RestoreDC: Boolean = True);
|
|
var
|
|
SaveIndex: Integer;
|
|
begin
|
|
SaveIndex := 0;
|
|
|
|
if RestoreDC then
|
|
SaveIndex := SaveDC(HDC);
|
|
|
|
try
|
|
StyleServices.DrawElement(HDC, LDetails, pRect, ClipRect, DPI);
|
|
finally
|
|
if (SaveIndex > 0) and RestoreDC then
|
|
Winapi.Windows.RestoreDC(HDC, SaveIndex);
|
|
end;
|
|
end;
|
|
{$IFEND}
|
|
|
|
procedure GradientRoundedFillCanvas(const ACanvas: TCanvas; const AStartColor, AEndColor: TColor; const ARect: TRect;
|
|
const Direction: TGradientDirection; Radius: Integer);
|
|
var
|
|
LBuffer: TBitmap;
|
|
LRect: TRect;
|
|
LRgn: THandle;
|
|
LPoint: TPoint;
|
|
begin
|
|
LBuffer := TBitmap.Create;
|
|
try
|
|
LBuffer.Width := 1;
|
|
LBuffer.Height := ARect.Height;
|
|
LRect.Create(0, 0, 1, ARect.Height);
|
|
GradientFillCanvas(LBuffer.Canvas, AStartColor, AEndColor, LRect, Direction);
|
|
|
|
LRgn := CreateRoundRectRgn(ARect.Left, ARect.Top, ARect.Left + ARect.Width, ARect.Top + ARect.Height, Radius, Radius);
|
|
if LRgn > 0 then
|
|
try
|
|
GetWindowOrgEx(ACanvas.Handle, LPoint);
|
|
OffsetRgn(LRgn, -LPoint.x, -LPoint.y);
|
|
SelectClipRgn(ACanvas.Handle, LRgn);
|
|
ACanvas.StretchDraw(Rect(ARect.Left, ARect.Top, ARect.Left + ARect.Width, ARect.Top + ARect.Height), LBuffer);
|
|
SelectClipRgn(ACanvas.Handle, 0);
|
|
finally
|
|
DeleteObject(LRgn);
|
|
end;
|
|
finally
|
|
LBuffer.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure AlphaBlendRectangle(const ACanvas: TCanvas; const AColor: TColor; const ARect: TRect;
|
|
SourceConstantAlpha: byte); overload;
|
|
begin
|
|
AlphaBlendRectangle(ACanvas.Handle, AColor, ARect, SourceConstantAlpha);
|
|
end;
|
|
|
|
procedure AlphaBlendRectangle(const DC: HDC; const AColor: TColor; const ARect: TRect;
|
|
SourceConstantAlpha: byte); overload;
|
|
var
|
|
SaveIndex: Integer;
|
|
LCanvas: TCanvas;
|
|
LRect: TRect;
|
|
begin
|
|
SaveIndex := SaveDC(DC);
|
|
LCanvas := TCanvas.Create;
|
|
try
|
|
LCanvas.Handle := DC;
|
|
AlphaBlendFillCanvas(LCanvas, AColor, ARect, SourceConstantAlpha);
|
|
LCanvas.Pen.Color := AColor;
|
|
LCanvas.Brush.Style := bsClear;
|
|
LRect := ARect;
|
|
LCanvas.Rectangle(LRect.Left, LRect.Top, LRect.Left + LRect.Width, LRect.Top + LRect.Height);
|
|
finally
|
|
LCanvas.Handle := 0;
|
|
LCanvas.Free;
|
|
RestoreDC(DC, SaveIndex);
|
|
end;
|
|
end;
|
|
|
|
procedure AlphaBlendFillCanvas(const ACanvas: TCanvas; const AColor: TColor; const ARect: TRect;
|
|
SourceConstantAlpha: byte);
|
|
begin
|
|
AlphaBlendFillCanvas(ACanvas.Handle, AColor, ARect, SourceConstantAlpha);
|
|
end;
|
|
|
|
procedure AlphaBlendFillCanvas(const DC: HDC; const AColor: TColor; const ARect: TRect;
|
|
SourceConstantAlpha: byte); overload;
|
|
var
|
|
LBuffer: TBitmap;
|
|
LBlendFunc: TBlendFunction;
|
|
begin
|
|
LBuffer := TBitmap.Create;
|
|
try
|
|
LBuffer.Width := ARect.Width;
|
|
LBuffer.Height := ARect.Height;
|
|
LBuffer.Canvas.Brush.Color := AColor;
|
|
LBuffer.Canvas.FillRect(Rect(0, 0, ARect.Width, ARect.Height));
|
|
ZeroMemory(@LBlendFunc, SizeOf(LBlendFunc));
|
|
LBlendFunc.BlendOp := AC_SRC_OVER;
|
|
LBlendFunc.BlendFlags := 0;
|
|
LBlendFunc.SourceConstantAlpha := SourceConstantAlpha;
|
|
LBlendFunc.AlphaFormat := 0;
|
|
AlphaBlend(DC, ARect.Left, ARect.Top, LBuffer.Width, LBuffer.Height, LBuffer.Canvas.Handle, 0, 0, LBuffer.Width, LBuffer.Height, LBlendFunc);
|
|
finally
|
|
LBuffer.Free;
|
|
end;
|
|
end;
|
|
|
|
function RoundIntToByte(I: Integer): byte;
|
|
begin
|
|
if I > 255 then
|
|
Result := 255
|
|
else if I < 0 then
|
|
Result := 0
|
|
else
|
|
Result := I;
|
|
end;
|
|
|
|
procedure _ProcessBitmap32(const Dest: TBitmap; Value: Integer; _Process: TImageFilterCallback); overload;
|
|
var
|
|
R, G, B, a: byte;
|
|
x, y: Integer;
|
|
ARGB: TColor;
|
|
Line, Delta: NativeInt;
|
|
begin
|
|
Line := NativeInt(Dest.ScanLine[0]);
|
|
Delta := NativeInt(Dest.ScanLine[1]) - Line;
|
|
for y := 0 to Dest.Height - 1 do
|
|
begin
|
|
for x := 0 to Dest.Width - 1 do
|
|
begin
|
|
{$IFOPT R+}
|
|
{$DEFINE RANGEON}
|
|
{$R-}
|
|
{$ELSE}
|
|
{$UNDEF RANGEON}
|
|
{$ENDIF}
|
|
R := PRGBArray32(Line)[x].rgbRed;
|
|
G := PRGBArray32(Line)[x].rgbGreen;
|
|
B := PRGBArray32(Line)[x].rgbBlue;
|
|
a := PRGBArray32(Line)[x].rgbReserved;
|
|
{$IFDEF RANGEON}
|
|
{$R+}
|
|
{$UNDEF RANGEON}
|
|
{$ENDIF}
|
|
_Process(RGB(R, G, B), Value, ARGB);
|
|
GetRGB(ARGB, R, G, B);
|
|
{$IFOPT R+}
|
|
{$DEFINE RANGEON}
|
|
{$R-}
|
|
{$ELSE}
|
|
{$UNDEF RANGEON}
|
|
{$ENDIF}
|
|
PRGBArray32(Line)[x].rgbRed := R;
|
|
PRGBArray32(Line)[x].rgbGreen := G;
|
|
PRGBArray32(Line)[x].rgbBlue := B;
|
|
PRGBArray32(Line)[x].rgbReserved := a;
|
|
{$IFDEF RANGEON}
|
|
{$R+}
|
|
{$UNDEF RANGEON}
|
|
{$ENDIF}
|
|
end;
|
|
Inc(Line, Delta);
|
|
end;
|
|
end;
|
|
|
|
procedure _ProcessBitmap32(const Source, Dest: TBitmap; _Process: TImageFilterCallback); overload;
|
|
var
|
|
R, G, B, a: byte;
|
|
x, y: Integer;
|
|
ARGB: TColor;
|
|
LineDest, DeltaDest: NativeInt;
|
|
LineSource, DeltaSource: NativeInt;
|
|
Value: TColor;
|
|
SourceN: TBitmap;
|
|
begin
|
|
SourceN := TBitmap.Create;
|
|
try
|
|
SourceN.SetSize(Dest.Width, Dest.Height);
|
|
SourceN.PixelFormat := pf32bit;
|
|
|
|
y := 0;
|
|
while y < Dest.Height do
|
|
begin
|
|
x := 0;
|
|
while x < Dest.Width do
|
|
begin
|
|
SourceN.Canvas.Draw(x, y, Source);
|
|
x := x + Source.Width;
|
|
end;
|
|
y := y + Source.Height;
|
|
end;
|
|
|
|
LineDest := NativeInt(Dest.ScanLine[0]);
|
|
DeltaDest := NativeInt(Dest.ScanLine[1]) - LineDest;
|
|
|
|
LineSource := NativeInt(SourceN.ScanLine[0]);
|
|
DeltaSource := NativeInt(SourceN.ScanLine[1]) - LineSource;
|
|
|
|
for y := 0 to Dest.Height - 1 do
|
|
begin
|
|
for x := 0 to Dest.Width - 1 do
|
|
begin
|
|
{$IFOPT R+}
|
|
{$DEFINE RANGEON}
|
|
{$R-}
|
|
{$ELSE}
|
|
{$UNDEF RANGEON}
|
|
{$ENDIF}
|
|
R := PRGBArray32(LineDest)[x].rgbRed;
|
|
G := PRGBArray32(LineDest)[x].rgbGreen;
|
|
B := PRGBArray32(LineDest)[x].rgbBlue;
|
|
a := PRGBArray32(LineDest)[x].rgbReserved;
|
|
{$IFDEF RANGEON}
|
|
{$R+}
|
|
{$UNDEF RANGEON}
|
|
{$ENDIF}
|
|
Value := RGB(PRGBArray24(LineSource)[x].rgbtRed, PRGBArray24(LineSource)[x].rgbtGreen,
|
|
PRGBArray24(LineSource)[x].rgbtBlue);
|
|
|
|
_Process(RGB(R, G, B), Value, ARGB);
|
|
GetRGB(ARGB, R, G, B);
|
|
|
|
{$IFOPT R+}
|
|
{$DEFINE RANGEON}
|
|
{$R-}
|
|
{$ELSE}
|
|
{$UNDEF RANGEON}
|
|
{$ENDIF}
|
|
PRGBArray32(LineDest)[x].rgbRed := R;
|
|
PRGBArray32(LineDest)[x].rgbGreen := G;
|
|
PRGBArray32(LineDest)[x].rgbBlue := B;
|
|
PRGBArray32(LineDest)[x].rgbReserved := a;
|
|
{$IFDEF RANGEON}
|
|
{$R+}
|
|
{$UNDEF RANGEON}
|
|
{$ENDIF}
|
|
end;
|
|
Inc(LineDest, DeltaDest);
|
|
Inc(LineSource, DeltaSource);
|
|
end;
|
|
finally
|
|
SourceN.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure _ProcessBitmap24(const ABitMap: TBitmap; Value: Integer; _Process: TImageFilterCallback); overload;
|
|
var
|
|
R, G, B: byte;
|
|
x, y: Integer;
|
|
ARGB: TColor;
|
|
Line, Delta: NativeInt;
|
|
begin
|
|
Line := NativeInt(ABitMap.ScanLine[0]);
|
|
Delta := NativeInt(ABitMap.ScanLine[1]) - Line;
|
|
for y := 0 to ABitMap.Height - 1 do
|
|
begin
|
|
for x := 0 to ABitMap.Width - 1 do
|
|
begin
|
|
{$IFOPT R+}
|
|
{$DEFINE RANGEON}
|
|
{$R-}
|
|
{$ELSE}
|
|
{$UNDEF RANGEON}
|
|
{$ENDIF}
|
|
R := PRGBArray24(Line)[x].rgbtRed;
|
|
G := PRGBArray24(Line)[x].rgbtGreen;
|
|
B := PRGBArray24(Line)[x].rgbtBlue;
|
|
{$IFDEF RANGEON}
|
|
{$R+}
|
|
{$UNDEF RANGEON}
|
|
{$ENDIF}
|
|
_Process(RGB(R, G, B), Value, ARGB);
|
|
GetRGB(ARGB, R, G, B);
|
|
|
|
{$IFOPT R+}
|
|
{$DEFINE RANGEON}
|
|
{$R-}
|
|
{$ELSE}
|
|
{$UNDEF RANGEON}
|
|
{$ENDIF}
|
|
PRGBArray24(Line)[x].rgbtRed := R;
|
|
PRGBArray24(Line)[x].rgbtGreen := G;
|
|
PRGBArray24(Line)[x].rgbtBlue := B;
|
|
{$IFDEF RANGEON}
|
|
{$R+}
|
|
{$UNDEF RANGEON}
|
|
{$ENDIF}
|
|
end;
|
|
Inc(Line, Delta);
|
|
end;
|
|
end;
|
|
|
|
procedure _ProcessBitmap24(const Source, Dest: TBitmap; _Process: TImageFilterCallback); overload;
|
|
var
|
|
R, G, B: byte;
|
|
x, y: Integer;
|
|
ARGB: TColor;
|
|
LineDest, DeltaDest: NativeInt;
|
|
LineSource, DeltaSource: NativeInt;
|
|
Value: TColor;
|
|
SourceN: TBitmap;
|
|
begin
|
|
SourceN := TBitmap.Create;
|
|
try
|
|
SourceN.SetSize(Dest.Width, Dest.Height);
|
|
SourceN.PixelFormat := pf24bit;
|
|
|
|
y := 0;
|
|
while y < Dest.Height do
|
|
begin
|
|
x := 0;
|
|
while x < Dest.Width do
|
|
begin
|
|
SourceN.Canvas.Draw(x, y, Source);
|
|
x := x + Source.Width;
|
|
end;
|
|
y := y + Source.Height;
|
|
end;
|
|
|
|
LineDest := NativeInt(Dest.ScanLine[0]);
|
|
DeltaDest := NativeInt(Dest.ScanLine[1]) - LineDest;
|
|
|
|
LineSource := NativeInt(SourceN.ScanLine[0]);
|
|
DeltaSource := NativeInt(SourceN.ScanLine[1]) - LineSource;
|
|
|
|
for y := 0 to Dest.Height - 1 do
|
|
begin
|
|
for x := 0 to Dest.Width - 1 do
|
|
begin
|
|
R := PRGBArray24(LineDest)[x].rgbtRed;
|
|
G := PRGBArray24(LineDest)[x].rgbtGreen;
|
|
B := PRGBArray24(LineDest)[x].rgbtBlue;
|
|
|
|
Value := RGB(PRGBArray24(LineSource)[x].rgbtRed, PRGBArray24(LineSource)[x].rgbtGreen, PRGBArray24(LineSource)[x].rgbtBlue);
|
|
|
|
_Process(RGB(R, G, B), Value, ARGB);
|
|
GetRGB(ARGB, R, G, B);
|
|
|
|
PRGBArray32(LineDest)[x].rgbRed := R;
|
|
PRGBArray32(LineDest)[x].rgbGreen := G;
|
|
PRGBArray32(LineDest)[x].rgbBlue := B;
|
|
end;
|
|
Inc(LineDest, DeltaDest);
|
|
Inc(LineSource, DeltaSource);
|
|
end;
|
|
finally
|
|
SourceN.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure _Sepia(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
var
|
|
ARGB: TColor;
|
|
R, G, B: byte;
|
|
begin
|
|
GetRGB(AColor, R, G, B);
|
|
ARGB := (R + G + B) div 3;
|
|
|
|
R := ARGB + (Value * 2);
|
|
G := ARGB + (Value * 1);
|
|
B := ARGB + (Value * 1);
|
|
|
|
if R <= ((Value * 2) - 1) then
|
|
R := 255;
|
|
if G <= (Value - 1) then
|
|
G := 255;
|
|
|
|
NewColor := RGB(R, G, B);
|
|
end;
|
|
|
|
procedure _Sepia24(const ABitMap: TBitmap; Value: byte);
|
|
begin
|
|
_ProcessBitmap24(ABitMap, Value, _Sepia);
|
|
end;
|
|
|
|
procedure _Sepia32(const ABitMap: TBitmap; Value: byte);
|
|
begin
|
|
_ProcessBitmap32(ABitMap, Value, _Sepia);
|
|
end;
|
|
|
|
procedure _Hue(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
var
|
|
ARGB: TColor;
|
|
H, S, L: Double;
|
|
begin
|
|
_RGBtoHSL(AColor, H, S, L);
|
|
H := H + Value / 360;
|
|
ARGB := _HSLtoRGB(H, S, L);
|
|
NewColor := ARGB;
|
|
end;
|
|
|
|
procedure _Hue24(var ABitMap: TBitmap; Value: Integer);
|
|
begin
|
|
_ProcessBitmap24(ABitMap, Value, _Hue);
|
|
end;
|
|
|
|
procedure _Hue32(const ABitMap: TBitmap; Value: Integer);
|
|
begin
|
|
_ProcessBitmap32(ABitMap, Value, _Hue);
|
|
end;
|
|
|
|
{
|
|
if b = 0 then
|
|
result := 0
|
|
else begin
|
|
c := 255 - (((255-a) SHL 8) DIV b);
|
|
if c < 0 then result := 0 else result := c;
|
|
end;
|
|
}
|
|
|
|
procedure _BlendBurn(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
var
|
|
ARGB: TColor;
|
|
R, G, B: byte;
|
|
br, bg, bb: byte;
|
|
C: Integer;
|
|
begin
|
|
GetRGB(AColor, R, G, B);
|
|
ARGB := Value;
|
|
GetRGB(ARGB, br, bg, bb);
|
|
|
|
if br = 0 then
|
|
R := 0
|
|
else
|
|
begin
|
|
C := RoundIntToByte(255 - (((255 - R) SHL 8) DIV br));
|
|
R := C;
|
|
end;
|
|
|
|
if bg = 0 then
|
|
G := 0
|
|
else
|
|
begin
|
|
C := RoundIntToByte(255 - (((255 - G) SHL 8) DIV bg));
|
|
G := C;
|
|
end;
|
|
|
|
if bb = 0 then
|
|
B := 0
|
|
else
|
|
begin
|
|
C := RoundIntToByte(255 - (((255 - B) SHL 8) DIV bb));
|
|
B := C;
|
|
end;
|
|
|
|
NewColor := RGB(R, G, B);
|
|
end;
|
|
|
|
procedure _BlendBurn24(const ABitMap: TBitmap; Value: Integer);
|
|
begin
|
|
_ProcessBitmap24(ABitMap, Value, _BlendBurn);
|
|
end;
|
|
|
|
procedure _BlendBurn32(const ABitMap: TBitmap; Value: Integer);
|
|
begin
|
|
_ProcessBitmap32(ABitMap, Value, _BlendBurn);
|
|
end;
|
|
|
|
{ result := (a*b) SHR 8; }
|
|
|
|
procedure _BlendMultiply(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
var
|
|
R, G, B: byte;
|
|
ARGB: TColor;
|
|
br, bg, bb: byte;
|
|
begin
|
|
ARGB := Value;
|
|
GetRGB(AColor, R, G, B);
|
|
|
|
GetRGB(ARGB, br, bg, bb);
|
|
R := (R * br) shr 8;
|
|
G := (G * bg) shr 8;
|
|
B := (B * bb) shr 8;
|
|
|
|
NewColor := RGB(R, G, B);
|
|
end;
|
|
|
|
procedure _BlendMultiply24(const ABitMap: TBitmap; Value: Integer);
|
|
begin
|
|
_ProcessBitmap24(ABitMap, Value, _BlendMultiply);
|
|
end;
|
|
|
|
procedure _BlendMultiply32(const ABitMap: TBitmap; Value: Integer);
|
|
begin
|
|
_ProcessBitmap32(ABitMap, Value, _BlendMultiply);
|
|
end;
|
|
|
|
{
|
|
c := a+b;
|
|
if c > 255 then result := 255 else result := c;
|
|
}
|
|
procedure _BlendAdditive(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
var
|
|
R, G, B: byte;
|
|
ARGB: TColor;
|
|
br, bg, bb: byte;
|
|
C: Integer;
|
|
begin
|
|
ARGB := Value;
|
|
GetRGB(AColor, R, G, B);
|
|
GetRGB(ARGB, br, bg, bb);
|
|
|
|
C := RoundIntToByte(R + br);
|
|
R := C;
|
|
C := RoundIntToByte(G + bg);
|
|
G := C;
|
|
C := RoundIntToByte(B + bb);
|
|
B := C;
|
|
|
|
NewColor := RGB(R, G, B);
|
|
end;
|
|
|
|
procedure _BlendAdditive24(const ABitMap: TBitmap; Value: Integer);
|
|
begin
|
|
_ProcessBitmap24(ABitMap, Value, _BlendAdditive);
|
|
end;
|
|
|
|
procedure _BlendAdditive32(const ABitMap: TBitmap; Value: Integer);
|
|
begin
|
|
_ProcessBitmap32(ABitMap, Value, _BlendAdditive);
|
|
end;
|
|
|
|
{
|
|
if b = 255 then
|
|
result := 255
|
|
else begin
|
|
c := (a SHL 8) DIV (255-b);
|
|
if c > 255 then result := 255 else result := c;
|
|
end;
|
|
}
|
|
procedure _BlendDodge(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
var
|
|
R, G, B: byte;
|
|
ARGB: TColor;
|
|
br, bg, bb: byte;
|
|
C: Integer;
|
|
begin
|
|
GetRGB(AColor, R, G, B);
|
|
|
|
ARGB := Value;
|
|
GetRGB(ARGB, br, bg, bb);
|
|
|
|
if br = 255 then
|
|
R := 255
|
|
else
|
|
begin
|
|
C := RoundIntToByte((R SHL 8) DIV (255 - br));
|
|
R := C;
|
|
end;
|
|
|
|
if bg = 255 then
|
|
G := 255
|
|
else
|
|
begin
|
|
C := RoundIntToByte((G SHL 8) DIV (255 - bg));
|
|
G := C;
|
|
end;
|
|
|
|
if bb = 255 then
|
|
B := 255
|
|
else
|
|
begin
|
|
C := RoundIntToByte((B SHL 8) DIV (255 - bb));
|
|
B := C;
|
|
end;
|
|
|
|
NewColor := RGB(R, G, B);
|
|
end;
|
|
|
|
procedure _BlendDodge24(const ABitMap: TBitmap; Value: Integer);
|
|
begin
|
|
_ProcessBitmap24(ABitMap, Value, _BlendDodge);
|
|
end;
|
|
|
|
procedure _BlendDodge32(const ABitMap: TBitmap; Value: Integer);
|
|
begin
|
|
_ProcessBitmap32(ABitMap, Value, _BlendDodge);
|
|
end;
|
|
|
|
{
|
|
if a < 128 then
|
|
result := (a*b) SHR 7
|
|
else
|
|
result := 255 - ((255-a) * (255-b) SHR 7);
|
|
}
|
|
procedure _BlendOverlay(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
var
|
|
R, G, B: byte;
|
|
ARGB: TColor;
|
|
br, bg, bb: byte;
|
|
C: Integer;
|
|
begin
|
|
GetRGB(AColor, R, G, B);
|
|
ARGB := Value;
|
|
GetRGB(ARGB, br, bg, bb);
|
|
|
|
if R < 128 then
|
|
R := RoundIntToByte((R * br) shr 7)
|
|
else
|
|
begin
|
|
C := RoundIntToByte(255 - ((255 - R) * (255 - br) SHR 7));
|
|
R := C;
|
|
end;
|
|
|
|
if G < 128 then
|
|
G := RoundIntToByte((G * bg) shr 7)
|
|
else
|
|
begin
|
|
C := RoundIntToByte(255 - ((255 - G) * (255 - bg) SHR 7));
|
|
G := C;
|
|
end;
|
|
|
|
if B < 128 then
|
|
B := RoundIntToByte((R * bb) shr 7)
|
|
else
|
|
begin
|
|
C := RoundIntToByte(255 - ((255 - B) * (255 - bb) SHR 7));
|
|
B := C;
|
|
end;
|
|
|
|
NewColor := RGB(R, G, B);
|
|
end;
|
|
|
|
procedure _BlendOverlay24(const ABitMap: TBitmap; Value: Integer);
|
|
begin
|
|
_ProcessBitmap24(ABitMap, Value, _BlendOverlay);
|
|
end;
|
|
|
|
procedure _BlendOverlay32(const ABitMap: TBitmap; Value: Integer);
|
|
begin
|
|
_ProcessBitmap32(ABitMap, Value, _BlendOverlay);
|
|
end;
|
|
|
|
{
|
|
result := abs(a-b);
|
|
}
|
|
|
|
procedure _BlendDifference(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
var
|
|
R, G, B: byte;
|
|
ARGB: TColor;
|
|
br, bg, bb: byte;
|
|
begin
|
|
GetRGB(AColor, R, G, B);
|
|
ARGB := Value;
|
|
GetRGB(ARGB, br, bg, bb);
|
|
R := Abs(R - br);
|
|
G := Abs(G - bg);
|
|
B := Abs(B - bb);
|
|
NewColor := RGB(R, G, B);
|
|
end;
|
|
|
|
procedure _BlendDifference24(const ABitMap: TBitmap; Value: Integer);
|
|
begin
|
|
_ProcessBitmap24(ABitMap, Value, _BlendDifference);
|
|
end;
|
|
|
|
procedure _BlendDifference32(const ABitMap: TBitmap; Value: Integer);
|
|
begin
|
|
_ProcessBitmap32(ABitMap, Value, _BlendDifference);
|
|
end;
|
|
|
|
{
|
|
if a > b then
|
|
result := a
|
|
else
|
|
result := b;
|
|
}
|
|
procedure _BlendLighten(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
var
|
|
R, G, B: byte;
|
|
ARGB: TColor;
|
|
br, bg, bb: byte;
|
|
begin
|
|
GetRGB(AColor, R, G, B);
|
|
|
|
ARGB := Value;
|
|
GetRGB(ARGB, br, bg, bb);
|
|
|
|
R := IfThen(R > br, R, br);
|
|
G := IfThen(G > bg, G, bg);
|
|
B := IfThen(B > bb, B, bb);
|
|
|
|
NewColor := RGB(R, G, B);
|
|
end;
|
|
|
|
procedure _BlendLighten24(const ABitMap: TBitmap; Value: Integer);
|
|
begin
|
|
_ProcessBitmap24(ABitMap, Value, _BlendLighten);
|
|
end;
|
|
|
|
procedure _BlendLighten32(const ABitMap: TBitmap; Value: Integer);
|
|
begin
|
|
_ProcessBitmap32(ABitMap, Value, _BlendLighten);
|
|
end;
|
|
|
|
{
|
|
if a < b then
|
|
result := a
|
|
else
|
|
result := b;
|
|
}
|
|
procedure _BlendDarken(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
var
|
|
R, G, B: byte;
|
|
ARGB: TColor;
|
|
br, bg, bb: byte;
|
|
begin
|
|
GetRGB(AColor, R, G, B);
|
|
ARGB := Value;
|
|
GetRGB(ARGB, br, bg, bb);
|
|
R := IfThen(R < br, R, br);
|
|
G := IfThen(G < bg, G, bg);
|
|
B := IfThen(B < bb, B, bb);
|
|
NewColor := RGB(R, G, B);
|
|
end;
|
|
|
|
procedure _BlendDarken24(const ABitMap: TBitmap; Value: Integer);
|
|
begin
|
|
_ProcessBitmap24(ABitMap, Value, _BlendDarken);
|
|
end;
|
|
|
|
procedure _BlendDarken32(const ABitMap: TBitmap; Value: Integer);
|
|
begin
|
|
_ProcessBitmap32(ABitMap, Value, _BlendDarken);
|
|
end;
|
|
|
|
{
|
|
result := 255 - ((255-a) * (255-b) SHR 8);
|
|
}
|
|
procedure _BlendScreen(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
var
|
|
R, G, B: byte;
|
|
ARGB: TColor;
|
|
br, bg, bb: byte;
|
|
C: Integer;
|
|
begin
|
|
GetRGB(AColor, R, G, B);
|
|
|
|
ARGB := Value;
|
|
GetRGB(ARGB, br, bg, bb);
|
|
|
|
C := RoundIntToByte(255 - ((255 - R) * (255 - br) SHR 8));
|
|
R := C;
|
|
|
|
C := RoundIntToByte(255 - ((255 - G) * (255 - bg) SHR 8));
|
|
G := C;
|
|
|
|
C := RoundIntToByte(255 - ((255 - B) * (255 - bb) SHR 8));
|
|
B := C;
|
|
|
|
NewColor := RGB(R, G, B);
|
|
end;
|
|
|
|
procedure _BlendScreen24(const ABitMap: TBitmap; Value: Integer);
|
|
begin
|
|
_ProcessBitmap24(ABitMap, Value, _BlendScreen);
|
|
end;
|
|
|
|
procedure _BlendScreen32(const ABitMap: TBitmap; Value: Integer);
|
|
begin
|
|
_ProcessBitmap32(ABitMap, Value, _BlendScreen);
|
|
end;
|
|
|
|
procedure _SetRComponent(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
var
|
|
R, G, B: byte;
|
|
begin
|
|
GetRGB(AColor, R, G, B);
|
|
R := RoundIntToByte(R + Value);
|
|
NewColor := RGB(R, G, B);
|
|
end;
|
|
|
|
procedure _SetGComponent(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
var
|
|
R, G, B: byte;
|
|
begin
|
|
GetRGB(AColor, R, G, B);
|
|
G := RoundIntToByte(G + Value);
|
|
NewColor := RGB(R, G, B);
|
|
end;
|
|
|
|
procedure _SetBComponent(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
var
|
|
R, G, B: byte;
|
|
begin
|
|
GetRGB(AColor, R, G, B);
|
|
B := RoundIntToByte(B + Value);
|
|
NewColor := RGB(R, G, B);
|
|
end;
|
|
|
|
procedure _SetRGB24(const ABitMap: TBitmap; DR, DG, DB: Integer);
|
|
var
|
|
R, G, B: byte;
|
|
x, y: Integer;
|
|
Line, Delta: NativeInt;
|
|
begin
|
|
Line := NativeInt(ABitMap.ScanLine[0]);
|
|
Delta := NativeInt(ABitMap.ScanLine[1]) - Line;
|
|
for y := 0 to ABitMap.Height - 1 do
|
|
begin
|
|
for x := 0 to ABitMap.Width - 1 do
|
|
begin
|
|
R := PRGBArray24(Line)[x].rgbtRed;
|
|
G := PRGBArray24(Line)[x].rgbtGreen;
|
|
B := PRGBArray24(Line)[x].rgbtBlue;
|
|
PRGBArray24(Line)[x].rgbtRed := RoundIntToByte(R + DR);
|
|
PRGBArray24(Line)[x].rgbtGreen := RoundIntToByte(G + DG);
|
|
PRGBArray24(Line)[x].rgbtBlue := RoundIntToByte(B + DB);
|
|
end;
|
|
Inc(Line, Delta);
|
|
end;
|
|
end;
|
|
|
|
procedure _SetRGB32(const ABitMap: TBitmap; DR, DG, DB: Integer);
|
|
var
|
|
R, G, B, a: byte;
|
|
x, y: Integer;
|
|
Line, Delta: NativeInt;
|
|
begin
|
|
Line := NativeInt(ABitMap.ScanLine[0]);
|
|
Delta := NativeInt(ABitMap.ScanLine[1]) - Line;
|
|
for y := 0 to ABitMap.Height - 1 do
|
|
begin
|
|
for x := 0 to ABitMap.Width - 1 do
|
|
begin
|
|
R := PRGBArray32(Line)[x].rgbRed;
|
|
G := PRGBArray32(Line)[x].rgbGreen;
|
|
B := PRGBArray32(Line)[x].rgbBlue;
|
|
a := PRGBArray32(Line)[x].rgbReserved;
|
|
PRGBArray32(Line)[x].rgbRed := RoundIntToByte(R + DR);
|
|
PRGBArray32(Line)[x].rgbGreen := RoundIntToByte(G + DG);
|
|
PRGBArray32(Line)[x].rgbBlue := RoundIntToByte(B + DB);
|
|
PRGBArray32(Line)[x].rgbReserved := a;
|
|
end;
|
|
Inc(Line, Delta);
|
|
end;
|
|
end;
|
|
|
|
procedure _Saturation(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
var
|
|
R, G, B: byte;
|
|
Gray: Integer;
|
|
begin
|
|
GetRGB(AColor, R, G, B);
|
|
Gray := (R + G + B) div 3;
|
|
R := RoundIntToByte(Gray + (((R - Gray) * Value) div 255));
|
|
G := RoundIntToByte(Gray + (((G - Gray) * Value) div 255));
|
|
B := RoundIntToByte(Gray + (((B - Gray) * Value) div 255));
|
|
NewColor := RGB(R, G, B);
|
|
end;
|
|
|
|
procedure _Saturation24(var ABitMap: TBitmap; Value: Integer);
|
|
begin
|
|
_ProcessBitmap24(ABitMap, Value, _Saturation);
|
|
end;
|
|
|
|
procedure _Saturation32(const ABitMap: TBitmap; Value: Integer);
|
|
begin
|
|
_ProcessBitmap32(ABitMap, Value, _Saturation);
|
|
end;
|
|
|
|
procedure _Lightness(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
var
|
|
R, G, B: byte;
|
|
begin
|
|
GetRGB(AColor, R, G, B);
|
|
R := RoundIntToByte(R + ((255 - R) * Value) div 255);
|
|
G := RoundIntToByte(G + ((255 - G) * Value) div 255);
|
|
B := RoundIntToByte(B + ((255 - B) * Value) div 255);
|
|
NewColor := RGB(R, G, B);
|
|
end;
|
|
|
|
procedure _Lightness24(var ABitMap: TBitmap; Value: Integer);
|
|
begin
|
|
_ProcessBitmap24(ABitMap, Value, _Lightness);
|
|
end;
|
|
|
|
procedure _Lightness32(const ABitMap: TBitmap; Value: Integer);
|
|
begin
|
|
_ProcessBitmap32(ABitMap, Value, _Lightness);
|
|
end;
|
|
|
|
procedure _Darkness(const AColor: TColor; Value: Integer; out NewColor: TColor);
|
|
var
|
|
R, G, B: byte;
|
|
begin
|
|
GetRGB(AColor, R, G, B);
|
|
R := RoundIntToByte(R - ((R) * Value) div 255);
|
|
G := RoundIntToByte(G - ((G) * Value) div 255);
|
|
B := RoundIntToByte(B - ((B) * Value) div 255);
|
|
NewColor := RGB(R, G, B);
|
|
end;
|
|
|
|
procedure _Darkness24(var ABitMap: TBitmap; Value: Integer);
|
|
begin
|
|
_ProcessBitmap24(ABitMap, Value, _Darkness);
|
|
end;
|
|
|
|
procedure _Darkness32(const ABitMap: TBitmap; Value: Integer);
|
|
begin
|
|
_ProcessBitmap32(ABitMap, Value, _Darkness);
|
|
end;
|
|
|
|
function _HSLtoRGB(HueValue, SaturationValue, LightValue: Double): TColor;
|
|
var
|
|
M1, M2: Double;
|
|
|
|
function HueToColourValue(Hue: Double): byte;
|
|
var
|
|
V: Double;
|
|
begin
|
|
if Hue < 0 then
|
|
Hue := Hue + 1
|
|
else if Hue > 1 then
|
|
Hue := Hue - 1;
|
|
|
|
if 6 * Hue < 1 then
|
|
V := M1 + (M2 - M1) * Hue * 6
|
|
else if 2 * Hue < 1 then
|
|
V := M2
|
|
else if 3 * Hue < 2 then
|
|
V := M1 + (M2 - M1) * (2 / 3 - Hue) * 6
|
|
else
|
|
V := M1;
|
|
Result := Round(255 * V);
|
|
end;
|
|
|
|
var
|
|
R, G, B: byte;
|
|
begin
|
|
if SaturationValue = 0 then
|
|
begin
|
|
R := Round(255 * LightValue);
|
|
G := R;
|
|
B := R;
|
|
end
|
|
else
|
|
begin
|
|
if LightValue <= 0.5 then
|
|
M2 := LightValue * (1 + SaturationValue)
|
|
else
|
|
M2 := LightValue + SaturationValue - LightValue * SaturationValue;
|
|
M1 := 2 * LightValue - M2;
|
|
R := HueToColourValue(HueValue + 1 / 3);
|
|
G := HueToColourValue(HueValue);
|
|
B := HueToColourValue(HueValue - 1 / 3);
|
|
end;
|
|
|
|
Result := RGB(R, G, B);
|
|
end;
|
|
|
|
procedure _RGBtoHSL(RGB: TColor; var HueValue, SaturationValue, LightValue: Double);
|
|
|
|
function Max(a, B: Double): Double;
|
|
begin
|
|
if a > B then
|
|
Result := a
|
|
else
|
|
Result := B;
|
|
end;
|
|
|
|
function Min(a, B: Double): Double;
|
|
begin
|
|
if a < B then
|
|
Result := a
|
|
else
|
|
Result := B;
|
|
end;
|
|
|
|
var
|
|
R, G, B, D, Cmax, Cmin: Double;
|
|
begin
|
|
R := GetRValue(RGB) / 255;
|
|
G := GetGValue(RGB) / 255;
|
|
B := GetBValue(RGB) / 255;
|
|
Cmax := Max(R, Max(G, B));
|
|
Cmin := Min(R, Min(G, B));
|
|
|
|
LightValue := (Cmax + Cmin) / 2;
|
|
|
|
if Cmax = Cmin then
|
|
begin
|
|
HueValue := 0;
|
|
SaturationValue := 0;
|
|
end
|
|
else
|
|
begin
|
|
D := Cmax - Cmin;
|
|
|
|
if LightValue < 0.5 then
|
|
SaturationValue := D / (Cmax + Cmin)
|
|
else
|
|
SaturationValue := D / (2 - Cmax - Cmin);
|
|
|
|
if R = Cmax then
|
|
HueValue := (G - B) / D
|
|
else if G = Cmax then
|
|
HueValue := 2 + (B - R) / D
|
|
else
|
|
HueValue := 4 + (R - G) / D;
|
|
|
|
HueValue := HueValue / 6;
|
|
if HueValue < 0 then
|
|
HueValue := HueValue + 1;
|
|
end;
|
|
end;
|
|
|
|
{ TBitmap32Filter }
|
|
|
|
{ TBitmap32HueFilter }
|
|
procedure TBitmap32HueFilter.ProcessBitmap(ABitMap: TBitmap);
|
|
begin
|
|
if ABitMap.PixelFormat = pf32bit then
|
|
_ProcessBitmap32(ABitMap, ColorValue, _Hue)
|
|
else if ABitMap.PixelFormat = pf24bit then
|
|
_ProcessBitmap24(ABitMap, ColorValue, _Hue);
|
|
end;
|
|
|
|
function TBitmap32HueFilter.ProcessColor(AColor: TColor): TColor;
|
|
begin
|
|
_Hue(AColor, ColorValue, Result);
|
|
end;
|
|
|
|
{ TBitmap32SaturationFilter }
|
|
|
|
procedure TBitmap32SaturationFilter.ProcessBitmap(ABitMap: TBitmap);
|
|
begin
|
|
if ABitMap.PixelFormat = pf32bit then
|
|
_ProcessBitmap32(ABitMap, ColorValue, _Saturation)
|
|
else if ABitMap.PixelFormat = pf24bit then
|
|
_ProcessBitmap24(ABitMap, ColorValue, _Saturation);
|
|
end;
|
|
|
|
function TBitmap32SaturationFilter.ProcessColor(AColor: TColor): TColor;
|
|
begin
|
|
_Saturation(AColor, ColorValue, Result);
|
|
end;
|
|
|
|
{ TBitmap32LightnessFilter }
|
|
|
|
procedure TBitmap32LightnessFilter.ProcessBitmap(ABitMap: TBitmap);
|
|
begin
|
|
if ABitMap.PixelFormat = pf32bit then
|
|
begin
|
|
if ColorValue >= 0 then
|
|
_ProcessBitmap32(ABitMap, ColorValue, _Lightness)
|
|
else
|
|
_ProcessBitmap32(ABitMap, Abs(ColorValue), _Darkness);
|
|
end
|
|
else if ABitMap.PixelFormat = pf24bit then
|
|
begin
|
|
if ColorValue >= 0 then
|
|
_ProcessBitmap24(ABitMap, ColorValue, _Lightness)
|
|
else
|
|
_ProcessBitmap24(ABitMap, Abs(ColorValue), _Darkness);
|
|
end;
|
|
end;
|
|
|
|
function TBitmap32LightnessFilter.ProcessColor(AColor: TColor): TColor;
|
|
begin
|
|
if ColorValue >= 0 then
|
|
_Lightness(AColor, ColorValue, Result)
|
|
else
|
|
_Darkness(AColor, Abs(ColorValue), Result);
|
|
end;
|
|
|
|
{ TBitmap32SepiaFilter }
|
|
|
|
procedure TBitmap32SepiaFilter.ProcessBitmap(ABitMap: TBitmap);
|
|
begin
|
|
if ABitMap.PixelFormat = pf32bit then
|
|
_ProcessBitmap32(ABitMap, ColorValue, _Sepia)
|
|
else if ABitMap.PixelFormat = pf24bit then
|
|
_ProcessBitmap24(ABitMap, ColorValue, _Sepia);
|
|
end;
|
|
|
|
function TBitmap32SepiaFilter.ProcessColor(AColor: TColor): TColor;
|
|
begin
|
|
_Sepia(AColor, ColorValue, Result);
|
|
end;
|
|
|
|
{ TColorFilter }
|
|
|
|
constructor TColorFilter.Create(AColorValue: Integer);
|
|
begin
|
|
inherited Create;
|
|
FColorValue := AColorValue;
|
|
end;
|
|
|
|
{ TBitmap32BlueFilter }
|
|
|
|
procedure TBitmap32BlueFilter.ProcessBitmap(ABitMap: TBitmap);
|
|
begin
|
|
if ABitMap.PixelFormat = pf32bit then
|
|
_SetRGB32(ABitMap, 0, 0, ColorValue)
|
|
else if ABitMap.PixelFormat = pf24bit then
|
|
_SetRGB24(ABitMap, 0, 0, ColorValue);
|
|
end;
|
|
|
|
function TBitmap32BlueFilter.ProcessColor(AColor: TColor): TColor;
|
|
begin
|
|
_SetBComponent(AColor, ColorValue, Result);
|
|
end;
|
|
|
|
{ TBitmap32RedFilter }
|
|
|
|
procedure TBitmap32RedFilter.ProcessBitmap(ABitMap: TBitmap);
|
|
begin
|
|
if ABitMap.PixelFormat = pf32bit then
|
|
_SetRGB32(ABitMap, ColorValue, 0, 0)
|
|
else if ABitMap.PixelFormat = pf24bit then
|
|
_SetRGB24(ABitMap, ColorValue, 0, 0);
|
|
end;
|
|
|
|
function TBitmap32RedFilter.ProcessColor(AColor: TColor): TColor;
|
|
begin
|
|
_SetRComponent(AColor, ColorValue, Result);
|
|
end;
|
|
|
|
{ TBitmap32GreenFilter }
|
|
|
|
procedure TBitmap32GreenFilter.ProcessBitmap(ABitMap: TBitmap);
|
|
begin
|
|
if ABitMap.PixelFormat = pf32bit then
|
|
_SetRGB32(ABitMap, 0, ColorValue, 0)
|
|
else if ABitMap.PixelFormat = pf24bit then
|
|
_SetRGB24(ABitMap, 0, ColorValue, 0);
|
|
end;
|
|
|
|
function TBitmap32GreenFilter.ProcessColor(AColor: TColor): TColor;
|
|
begin
|
|
_SetGComponent(AColor, ColorValue, Result);
|
|
end;
|
|
|
|
{ TBitmap32BlendBurn }
|
|
|
|
procedure TBitmap32BlendBurn.ProcessBitmap(ABitMap: TBitmap);
|
|
begin
|
|
if FUseBitmap then
|
|
begin
|
|
if ABitMap.PixelFormat = pf32bit then
|
|
_ProcessBitmap32(FSourceBitmap, ABitMap, _BlendBurn)
|
|
else if ABitMap.PixelFormat = pf24bit then
|
|
_ProcessBitmap24(FSourceBitmap, ABitMap, _BlendBurn)
|
|
end
|
|
else if ABitMap.PixelFormat = pf32bit then
|
|
_ProcessBitmap32(ABitMap, ColorValue, _BlendBurn)
|
|
else if ABitMap.PixelFormat = pf24bit then
|
|
_ProcessBitmap24(ABitMap, ColorValue, _BlendBurn);
|
|
end;
|
|
|
|
function TBitmap32BlendBurn.ProcessColor(AColor: TColor): TColor;
|
|
begin
|
|
_BlendBurn(AColor, ColorValue, Result);
|
|
end;
|
|
|
|
{ TBitmap32BlendMultiply }
|
|
|
|
procedure TBitmap32BlendMultiply.ProcessBitmap(ABitMap: TBitmap);
|
|
begin
|
|
if FUseBitmap then
|
|
begin
|
|
if ABitMap.PixelFormat = pf32bit then
|
|
_ProcessBitmap32(FSourceBitmap, ABitMap, _BlendMultiply)
|
|
else if ABitMap.PixelFormat = pf24bit then
|
|
_ProcessBitmap24(FSourceBitmap, ABitMap, _BlendMultiply)
|
|
end
|
|
else if ABitMap.PixelFormat = pf32bit then
|
|
_ProcessBitmap32(ABitMap, ColorValue, _BlendMultiply)
|
|
else if ABitMap.PixelFormat = pf24bit then
|
|
_ProcessBitmap24(ABitMap, ColorValue, _BlendMultiply);
|
|
end;
|
|
|
|
function TBitmap32BlendMultiply.ProcessColor(AColor: TColor): TColor;
|
|
begin
|
|
_BlendMultiply(AColor, ColorValue, Result);
|
|
end;
|
|
|
|
{ TBitmap32BlendAdditive }
|
|
|
|
procedure TBitmap32BlendAdditive.ProcessBitmap(ABitMap: TBitmap);
|
|
begin
|
|
if FUseBitmap then
|
|
begin
|
|
if ABitMap.PixelFormat = pf32bit then
|
|
_ProcessBitmap32(FSourceBitmap, ABitMap, _BlendAdditive)
|
|
else if ABitMap.PixelFormat = pf24bit then
|
|
_ProcessBitmap24(FSourceBitmap, ABitMap, _BlendAdditive)
|
|
end
|
|
else if ABitMap.PixelFormat = pf32bit then
|
|
_ProcessBitmap32(ABitMap, ColorValue, _BlendAdditive)
|
|
else if ABitMap.PixelFormat = pf24bit then
|
|
_ProcessBitmap24(ABitMap, ColorValue, _BlendAdditive);
|
|
end;
|
|
|
|
function TBitmap32BlendAdditive.ProcessColor(AColor: TColor): TColor;
|
|
begin
|
|
_BlendAdditive(AColor, ColorValue, Result);
|
|
end;
|
|
|
|
{ TBitmap32BlendDodge }
|
|
|
|
procedure TBitmap32BlendDodge.ProcessBitmap(ABitMap: TBitmap);
|
|
begin
|
|
if FUseBitmap then
|
|
begin
|
|
if ABitMap.PixelFormat = pf32bit then
|
|
_ProcessBitmap32(FSourceBitmap, ABitMap, _BlendDodge)
|
|
else if ABitMap.PixelFormat = pf24bit then
|
|
_ProcessBitmap24(FSourceBitmap, ABitMap, _BlendDodge)
|
|
end
|
|
else if ABitMap.PixelFormat = pf32bit then
|
|
_ProcessBitmap32(ABitMap, ColorValue, _BlendDodge)
|
|
else if ABitMap.PixelFormat = pf24bit then
|
|
_ProcessBitmap24(ABitMap, ColorValue, _BlendDodge);
|
|
end;
|
|
|
|
function TBitmap32BlendDodge.ProcessColor(AColor: TColor): TColor;
|
|
begin
|
|
_BlendDodge(AColor, ColorValue, Result);
|
|
end;
|
|
|
|
{ TBitmap32BlendOverlay }
|
|
|
|
procedure TBitmap32BlendOverlay.ProcessBitmap(ABitMap: TBitmap);
|
|
begin
|
|
if FUseBitmap then
|
|
begin
|
|
if ABitMap.PixelFormat = pf32bit then
|
|
_ProcessBitmap32(FSourceBitmap, ABitMap, _BlendOverlay)
|
|
else if ABitMap.PixelFormat = pf24bit then
|
|
_ProcessBitmap24(FSourceBitmap, ABitMap, _BlendOverlay)
|
|
end
|
|
else if ABitMap.PixelFormat = pf32bit then
|
|
_ProcessBitmap32(ABitMap, ColorValue, _BlendOverlay)
|
|
else if ABitMap.PixelFormat = pf24bit then
|
|
_ProcessBitmap24(ABitMap, ColorValue, _BlendOverlay);
|
|
end;
|
|
|
|
function TBitmap32BlendOverlay.ProcessColor(AColor: TColor): TColor;
|
|
begin
|
|
_BlendOverlay(AColor, ColorValue, Result);
|
|
end;
|
|
|
|
{ TBitmap32BlendLighten }
|
|
|
|
procedure TBitmap32BlendLighten.ProcessBitmap(ABitMap: TBitmap);
|
|
begin
|
|
if FUseBitmap then
|
|
begin
|
|
if ABitMap.PixelFormat = pf32bit then
|
|
_ProcessBitmap32(FSourceBitmap, ABitMap, _BlendLighten)
|
|
else if ABitMap.PixelFormat = pf24bit then
|
|
_ProcessBitmap24(FSourceBitmap, ABitMap, _BlendLighten)
|
|
|
|
end
|
|
else if ABitMap.PixelFormat = pf32bit then
|
|
_ProcessBitmap32(ABitMap, ColorValue, _BlendLighten)
|
|
else if ABitMap.PixelFormat = pf24bit then
|
|
_ProcessBitmap24(ABitMap, ColorValue, _BlendLighten);
|
|
end;
|
|
|
|
function TBitmap32BlendLighten.ProcessColor(AColor: TColor): TColor;
|
|
begin
|
|
_BlendLighten(AColor, ColorValue, Result);
|
|
end;
|
|
|
|
{ TBitmap32BlendDarken }
|
|
|
|
procedure TBitmap32BlendDarken.ProcessBitmap(ABitMap: TBitmap);
|
|
begin
|
|
if FUseBitmap then
|
|
begin
|
|
if ABitMap.PixelFormat = pf32bit then
|
|
_ProcessBitmap32(FSourceBitmap, ABitMap, _BlendDarken)
|
|
else if ABitMap.PixelFormat = pf24bit then
|
|
_ProcessBitmap24(FSourceBitmap, ABitMap, _BlendDarken)
|
|
end
|
|
else if ABitMap.PixelFormat = pf32bit then
|
|
_ProcessBitmap32(ABitMap, ColorValue, _BlendDarken)
|
|
else if ABitMap.PixelFormat = pf24bit then
|
|
_ProcessBitmap24(ABitMap, ColorValue, _BlendDarken);
|
|
end;
|
|
|
|
function TBitmap32BlendDarken.ProcessColor(AColor: TColor): TColor;
|
|
begin
|
|
_BlendDarken(AColor, ColorValue, Result);
|
|
end;
|
|
|
|
{ TBitmap32BlendScreen }
|
|
|
|
procedure TBitmap32BlendScreen.ProcessBitmap(ABitMap: TBitmap);
|
|
begin
|
|
if FUseBitmap then
|
|
begin
|
|
if ABitMap.PixelFormat = pf32bit then
|
|
_ProcessBitmap32(FSourceBitmap, ABitMap, _BlendScreen)
|
|
else if ABitMap.PixelFormat = pf24bit then
|
|
_ProcessBitmap24(FSourceBitmap, ABitMap, _BlendScreen)
|
|
end
|
|
else if ABitMap.PixelFormat = pf32bit then
|
|
_ProcessBitmap32(ABitMap, ColorValue, _BlendScreen)
|
|
else if ABitMap.PixelFormat = pf24bit then
|
|
_ProcessBitmap24(ABitMap, ColorValue, _BlendScreen);
|
|
end;
|
|
|
|
function TBitmap32BlendScreen.ProcessColor(AColor: TColor): TColor;
|
|
begin
|
|
_BlendScreen(AColor, ColorValue, Result);
|
|
end;
|
|
|
|
{ TBitmap32BlendDifference }
|
|
|
|
procedure TBitmap32BlendDifference.ProcessBitmap(ABitMap: TBitmap);
|
|
begin
|
|
if FUseBitmap then
|
|
begin
|
|
if ABitMap.PixelFormat = pf32bit then
|
|
_ProcessBitmap32(FSourceBitmap, ABitMap, _BlendDifference)
|
|
else if ABitMap.PixelFormat = pf24bit then
|
|
_ProcessBitmap24(FSourceBitmap, ABitMap, _BlendDifference)
|
|
end
|
|
else if ABitMap.PixelFormat = pf32bit then
|
|
_ProcessBitmap32(ABitMap, ColorValue, _BlendDifference)
|
|
else if ABitMap.PixelFormat = pf24bit then
|
|
_ProcessBitmap24(ABitMap, ColorValue, _BlendDifference);
|
|
end;
|
|
|
|
function TBitmap32BlendDifference.ProcessColor(AColor: TColor): TColor;
|
|
begin
|
|
_BlendDifference(AColor, ColorValue, Result);
|
|
end;
|
|
|
|
{ TBitmapFilter }
|
|
|
|
constructor TBitmapFilter.CreateBitMap(ASourceBitmap: TBitmap);
|
|
begin
|
|
inherited Create(clNone);
|
|
FSourceBitmap := ASourceBitmap;
|
|
FUseBitmap := True;
|
|
end;
|
|
|
|
constructor TBitmapFilter.Create(AColorValue: Integer);
|
|
begin
|
|
inherited Create(AColorValue);
|
|
FUseBitmap := False;
|
|
FSourceBitmap := nil;
|
|
end;
|
|
|
|
end.
|