Manipulate-Bitmaps-in-a-self-contained-static-class


            Title: Manipulate Bitmaps in a self contained static class
Question: Static class for TBitmap manipulation. No need to create class as it is STATIC. eg. Bitmaps.Grayscale(MyBitmap). Easy to use with JPG and other formats, simply convert to TBitmap, call class function and convert the TBitmap back to original format.
Answer:
unit MW_Bitmaps;
interface
{$REGION 'Documentation'}
// =================================================================================================
// UltraRAD Components
// Mike Heydon
//
// Bitmaps - Class of static bitmap functions. All calls are callable from
// the class itself and no instance of the class needs to be instantiated or
// freed. Attempting to create an instance of the class will generate runtime
// error.
//
// =================================================================================================
{$ENDREGION}
uses Windows, SysUtils, Graphics;
{$REGION 'Types and Classes'}
type
 {Bitmaps Class}
 Bitmaps = class(TObject)
 strict private const
 C_VERSION = '1.0.1';
 strict private
 class function IntToByte(AInteger : integer) : byte;
 class function ColorToTriple(AColor : TColor) : TRGBTriple;
 public
 constructor Create;
 class function Version : string;
 class procedure Blur(ABitmap : TBitmap);
 class procedure ChangeRGB(ABitmap : TBitmap;
 AIncRed,AIncGreen,AIncBlue : byte);
 class procedure ColorNoise(ABitmap : TBitmap; AAmount : integer = 100);
 class procedure Contrast(ABitmap : TBitmap; APercent : integer = 50);
 class procedure Darken(ABitmap : TBitmap; APercent : integer = 50);
 class procedure Emboss(ABitmap : TBitmap; ADepth : byte = 1);
 class procedure Flaxen(ABitmap : TBitmap);
 class procedure FlipHorizontal(ABitmap : TBitmap);
 class procedure FlipVertical(ABitmap : TBitmap);
 class procedure GrayScale(ABitmap : TBitmap);
 class procedure Lighten(ABitmap : TBitmap; APercent : byte = 50);
 class procedure MonoNegative(ABitmap : TBitmap);
 class procedure MonoNoise(ABitmap : TBitmap; AAmount : integer = 100);
 class procedure Mosaic(ABitmap : TBitmap; ASize : integer = 5);
 class procedure Negative(ABitmap : TBitmap);
 class procedure Posterize(ABitmap: TBitmap; AAmount : integer = 255);
 class procedure Saturation(ABitmap : TBitmap; APercent : integer = 90);
 class procedure Sepia(ABitmap : TBitmap; APercentDark : byte = 90);
 class procedure Twotone(ABitmap : TBitmap ; const ALightColor,
 ADarkColor : TColor; APercent : integer = 50);
 end;
{$ENDREGION}
// -------------------------------------------------------------------------------------------------
implementation
{$REGION 'Bitmaps Class'}
// =============================================================================
// Generate a runtime error if an attempt is made to create an instance
// of the class
// =============================================================================
constructor Bitmaps.Create;
begin
 raise Exception.Create('Bitmaps.Create - Cannot create an instance, ' +
 'class contains static functions only. ' +
 'Usage Example : Bitmaps.Grayscale(MyBitmap)');
end;
// =============================================================================
// Retrieve the class version as defined by C_VERSION
// =============================================================================
class function Bitmaps.Version : string;
begin
 Result := C_VERSION;
end;
class function Bitmaps.IntToByte(AInteger : integer) : byte;
var iResult : byte;
begin
 if AInteger 255 then
 iResult := 255
 else
 if AInteger 0 then
 iResult := 0
 else
 iResult := AInteger;
 Result := iResult;
end;
class function Bitmaps.ColorToTriple(AColor : TColor) : TRGBTriple;
type
 TRGBStruc = record
 case TColor of
 1 : (ColorValue: TColor);
 2 : (Bytes: array [0..3] of Byte);
 end;
var rCol : TRGBStruc;
begin
 rCol.ColorValue := AColor;
 Result.rgbtRed := rCol.Bytes[0];
 Result.rgbtGreen := rCol.Bytes[1];
 Result.rgbtBlue := rCol.Bytes[2];
end ;
// =============================================================================
// Change RGB to New in Bitmap
// Increment or Decrememt the RGB colors by values.
// =============================================================================
class procedure Bitmaps.ChangeRGB(ABitmap : TBitmap;
 AIncRed,AIncGreen,AIncBlue : byte);
var iCol,iRow : integer;
 pRow : ^TRGBTriple;
begin
 ABitmap.PixelFormat := pf24bit;
 for iRow := 0 to ABitmap.Height - 1 do begin
 pRow := ABitmap.ScanLine[iRow];
 for iCol := 0 to ABitmap.Width -1 do begin
 pRow^.rgbtBlue := self.IntToByte(AIncBlue + pRow^.rgbtBlue);
 pRow^.rgbtGreen := self.IntToByte(AIncGreen + pRow^.rgbtGreen);
 pRow^.rgbtRed := self.IntToByte(AIncRed + pRow^.rgbtRed);
 inc(pRow);
 end;
 end;
end;
// =============================================================================
// Flaxen the Bitmap
// =============================================================================
class procedure Bitmaps.Flaxen(ABitmap : TBitmap);
var iCol,iRow : integer;
 pWsk1,pWsk2,pWsk3 : ^TRGBTriple;
begin
 ABitmap.PixelFormat := pf24bit;
 for iRow := 0 to ABitmap.Height - 1 do begin
 pWsk1 := ABitmap.ScanLine[iRow];
 pWsk2 := pWsk1;
 pWsk3 := pWsk1;
 inc(pWsk2);
 inc(pWsk3,2);
 for iCol := 0 to ABitmap.Width - 1 do begin
 pWsk1^.rgbtRed := (pWsk1^.rgbtRed + pWsk2^.rgbtGreen +
 pWsk3^.rgbtBlue) div 3;
 pWsk2^.rgbtGreen := (pWsk1^.rgbtGreen + pWsk2^.rgbtGreen +
 pWsk3^.rgbtBlue) div 3;
 pWsk2^.rgbtBlue := (pWsk1^.rgbtBlue + pWsk2^.rgbtGreen +
 pWsk3^.rgbtBlue) div 3;
 inc(pWsk1);
 inc(pWsk2);
 inc(pWsk3);
 end;
 end;
end;
// =============================================================================
// Add Colored Noise Speckle
// =============================================================================
class procedure Bitmaps.ColorNoise(ABitmap : TBitmap; AAmount : integer = 100);
var pWsk : ^byte;
 iCol,iRow : integer;
begin
 ABitmap.PixelFormat := pf24bit;
 for iRow := 0 to ABitmap.Height - 1 do begin
 pWsk := ABitmap.ScanLine[iRow];
 for iCol := 0 to ABitmap.Width * 3 - 1 do begin
 pWsk^ := self.IntToByte(pWsk^ + (Random(AAmount) - (AAmount shr 1)));
 inc(pWsk);
 end;
 end;
end;
// =============================================================================
// Change to Gray Scale
// =============================================================================
class procedure Bitmaps.GrayScale(ABitmap : TBitmap);
var pRow : ^TRGBTriple;
 iCol,iRow,iIndex : integer;
begin
 ABitmap.PixelFormat := pf24bit;
 for iRow := 0 to ABitmap.Height - 1 do begin
 pRow := ABitmap.ScanLine[iRow];
 for iCol := 0 to ABitmap.Width - 1 do begin
 iIndex := ((pRow^.rgbtRed * 77 + pRow^.rgbtGreen * 150 +
 pRow^.rgbtBlue * 29) shr 8);
 pRow^.rgbtBlue := iIndex;
 pRow^.rgbtGreen := iIndex;
 pRow^.rgbtRed := iIndex;
 inc(pRow);
 end;
 end;
end;
// =============================================================================
// Change Bitmap to Sepia
// =============================================================================
class procedure Bitmaps.Sepia(ABitmap : TBitmap; APercentDark : byte = 90);
var iDepth : byte;
 pRow : ^TRGBTriple;
 iCol,iRow : Integer;
begin
 if APercentDark = 100 then
 iDepth := 0
 else
 iDepth := 255 - trunc((APercentDark / 100.0) * 255.0);
 ABitmap.PixelFormat:=pf24bit;
 for iRow := 0 to ABitmap.Height - 1 do begin
 pRow := ABitmap.ScanLine[iRow];
 for iCol := 0 to ABitmap.Width -1 do begin
 pRow^.rgbtBlue :=(pRow^.rgbtBlue + pRow^.rgbtGreen + pRow^.rgbtRed) div 3;
 pRow^.rgbtGreen := pRow^.rgbtBlue;
 pRow^.rgbtRed := pRow^.rgbtBlue;
 inc(pRow^.rgbtRed,iDepth * 2);
 inc(pRow^.rgbtGreen,iDepth);
 if pRow^.rgbtRed (iDepth * 2) then pRow^.rgbtRed := 255;
 if pRow^.rgbtGreen iDepth then pRow^.rgbtGreen := 255;
 inc(pRow);
 end;
 end;
end;
// =============================================================================
// Posterize a Bitmap
// =============================================================================
class procedure Bitmaps.Posterize(ABitmap: TBitmap; AAmount: integer = 255);
var iCol,iRow : integer;
 pWsk : ^byte;
begin
 ABitmap.PixelFormat := pf24bit;
 if AAmount 0 then AAmount := 1;
 for iRow := 0 to ABitmap.Height - 1 do begin
 pWsk := ABitmap.Scanline[iRow];
 for iCol := 0 to ABitmap.Width * 3 - 1 do begin
 pWsk^ := self.IntToByte(round(pWsk^ / AAmount) * AAmount);
 inc(pWsk);
 end;
 end;
end;
// =============================================================================
// Emboss a Bitmap
// =============================================================================
class procedure Bitmaps.Emboss(ABitmap : TBitmap; ADepth : byte = 1);
 var x, y, i : integer;
 p1, p2: PByteArray;
begin
 if ADepth 10 then aDepth := 10;
 if ADepth = 0 then ADepth := 1;
 ABitmap.PixelFormat := pf24bit;
 for i := 0 to ADepth do begin
 for y := 0 to ABitmap.Height - 2 do begin
 p1 := ABitmap.ScanLine[y];
 p2 := ABitmap.ScanLine[y+1];
 for x := 0 to ABitmap.Width do begin
 p1[x * 3] := (p1[x * 3] + (p2[(x + 3) * 3] xor $FF)) shr 1;
 p1[x * 3 + 1] := (p1[x * 3 + 1] + (p2[(x + 3) * 3 + 1] xor $FF)) shr 1;
 p1[x * 3 + 2] := (p1[x * 3 + 1] + (p2[(x + 3) * 3 + 1] xor $FF)) shr 1;
 end;
 end;
 end;
end;
// =============================================================================
// Add Mono Noise to Bitmap
// =============================================================================
class procedure Bitmaps.MonoNoise(ABitmap : TBitmap; AAmount: integer = 100);
var pRow : ^TRGBTriple;
 iCol,iRow,iNoise : integer;
begin
 ABitmap.PixelFormat := pf24bit;
 for iRow := 0 to ABitmap.Height - 1 do begin
 pRow := ABitmap.ScanLine[iRow];
 for iCol := 0 to ABitmap.Width - 1 do begin
 iNoise := Random(AAmount) - (AAmount shr 1);
 pRow^.rgbtBlue :=self.IntToByte(pRow^.rgbtBlue + iNoise);
 pRow^.rgbtGreen :=self.IntToByte(pRow^.rgbtGreen + iNoise);
 pRow^.rgbtRed :=self.IntToByte(pRow^.rgbtRed + iNoise);
 inc(pRow);
 end;
 end;
end;
// =============================================================================
// Blur a Bitmap
// =============================================================================
class procedure Bitmaps.Blur(ABitmap : TBitmap);
var pTL,pTC,pTR,pBL,
 pBC,pBR,pLL,pLC,pLR : ^TRGBTriple;
 iCol,iRow : integer;
begin
 ABitmap.PixelFormat := pf24bit;
 for iRow := 1 to ABitmap.Height - 2 do begin
 pTL := ABitmap.ScanLine[iRow - 1];
 pTC := pTL;
 pTR := pTL;
 pBL := ABitmap.ScanLine[iRow];
 pBC := pBL;
 pBR := pBL;
 pLL := ABitmap.ScanLine[iRow + 1];
 pLC := pLL;
 pLR := pLL;
 inc(pTC);
 inc(pTR,2);
 inc(pBC);
 inc(pBR,2);
 inc(pLC);
 inc(pLR,2);
 for iCol := 1 to (ABitmap.Width - 2) do begin
 pBC^.rgbtRed:= (pBC^.rgbtRed + pBL^.rgbtRed + pBR^.rgbtRed +
 pTC^.rgbtRed + pTL^.rgbtRed + pTR^.rgbtRed +
 pLL^.rgbtRed + pLC^.rgbtRed + pLR^.rgbtRed) div 9 ;
 pBC^.rgbtGreen:=(pBC^.rgbtGreen + pBL^.rgbtGreen + pBR^.rgbtGreen +
 pTC^.rgbtGreen + pTL^.rgbtGreen + pTR^.rgbtGreen +
 pLL^.rgbtGreen + pLC^.rgbtGreen + pLR^.rgbtGreen) div 9 ;
 pBC^.rgbtBlue:=(pBC^.rgbtBlue + pBL^.rgbtBlue + pBR^.rgbtBlue +
 pTC^.rgbtBlue + pTL^.rgbtBlue + pTR^.rgbtBlue +
 pLL^.rgbtBlue + pLC^.rgbtBlue + pLR^.rgbtBlue ) div 9 ;
 inc(pTL);
 inc(pTC);
 inc(pTR);
 inc(pBL);
 inc(pBC);
 inc(pBR);
 inc(pLL);
 inc(pLC);
 inc(pLR);
 end;
 end;
end;
// =============================================================================
// Mosaic
// =============================================================================
class procedure Bitmaps.Mosaic(ABitmap : TBitmap ; ASize : integer = 5);
var x,y,i,j : integer;
 p1,p2 : pByteArray;
 r,g,b : byte;
begin
 if ASize 20 then ASize := 20;
 if ASize 2 then ASize := 2;
 ABitmap.PixelFormat := pf24bit;
 y := 0;
 repeat
 p1:= ABitMap.Scanline[y];
 repeat
 j := 1;
 repeat
 p2 := ABitMap.Scanline[y];
 x := 0;
 repeat
 r := p1[x * 3];
 g := p1[x * 3 + 1];
 b := p1[x * 3 + 2];
 i :=1;
 repeat
 p2[x * 3]:=r;
 p2[x * 3 + 1] := g;
 p2[x * 3 + 2] := b;
 inc(x);
 inc(i);
 until (x = ABitMap.Width) or (i ASize);
 until x = ABitMap.Width;
 inc(j);
 inc(y);
 until (y = ABitMap.Height) or (j ASize);
 until (y = ABitMap.Height) or (x = ABitMap.Width);
 until y = ABitMap.Height;
end;
// =============================================================================
// Lighten Bitmap
// =============================================================================
class procedure Bitmaps.Lighten(ABitmap : TBitmap; APercent : byte = 50);
var pWsk : ^byte;
 iCol,iRow,iAmount : integer;
begin
 if APercent = 100 then
 iAmount := 255
 else
 iAmount := trunc((APercent / 100.0) * 255);
 ABitmap.PixelFormat := Graphics.pf24bit;
 for iRow := 0 to ABitmap.Height - 1 do begin
 pWsk := ABitmap.ScanLine[iRow];
 for iCol := 0 to ABitmap.Width * 3 - 1 do begin
 pWsk^ := self.IntToByte(pWsk^ + ((255 - pWsk^) * iAmount) div 255);
 inc(pWsk);
 end;
 end;
end;
// =============================================================================
// Darken Bitmap
// =============================================================================
class procedure Bitmaps.Darken(ABitmap : TBitmap; APercent : integer = 50);
var pWsk : ^byte;
 iCol,iRow,iAmount : integer;
begin
 if APercent = 100 then
 iAmount := 255
 else
 iAmount := trunc((APercent / 100.0) * 255);
 ABitmap.Pixelformat := pf24bit;
 for iRow := 0 to ABitmap.Height - 1 do begin
 pWsk := ABitmap.ScanLine[iRow];
 for iCol := 0 to ABitmap.Width * 3 - 1 do begin
 pWsk^ := self.IntToByte(pWsk^ - (pWsk^ * iAmount) div 255);
 inc(pWsk);
 end;
 end;
end;
// =============================================================================
// Twotone a bitmap into Light and Dark with Threshold Percent
// =============================================================================
class procedure Bitmaps.Twotone(ABitmap : TBitmap ; const ALightColor,
 ADarkColor : TColor; APercent : integer = 50);
var pRow : ^TRGBTriple;
 rLight,rDark : TRGBTriple;
 iCol,iRow,iIndex,iAmount : integer;
begin
 rLight := self.ColorToTriple(ALightColor);
 rDark := self.ColorToTriple(ADarkColor);
 if APercent = 100 then
 iAmount := 255
 else
 iAmount := trunc((APercent / 100.0) * 255);
 ABitmap.PixelFormat := pf24bit;
 for iRow := 0 to ABitmap.Height - 1 do begin
 pRow := ABitmap.ScanLine[iRow];
 for iCol := 0 to ABitmap.Width -1 do begin
 iIndex := ((pRow^.rgbtRed * 77 + pRow^.rgbtGreen * 150 +
 pRow^.rgbtBlue * 29) shr 8);
 if iIndex iAmount then
 pRow^ := rLight
 else
 pRow^ := rDark;
 inc(pRow);
 end;
 end;
end;
// =============================================================================
// Negative of a Bitmap
// =============================================================================
class procedure Bitmaps.Negative(ABitmap : TBitmap);
var iCol,iRow : integer;
 pWsk : ^byte;
begin
 ABitmap.PixelFormat := pf24bit;
 for iRow := 0 to ABitmap.Height - 1 do begin
 pWsk := ABitmap.ScanLine[iRow];
 for iCol := 0 to (ABitmap.Width * 3) - 1 do begin
 pWsk^ := not pWsk^;
 inc(pWsk);
 end;
 end;
end;
class procedure Bitmaps.MonoNegative(ABitmap : TBitmap);
begin
 self.GrayScale(ABitMap);
 self.Negative(ABitMap);
end;
// =============================================================================
// Saturation
// =============================================================================
class procedure Bitmaps.Saturation(ABitmap : TBitmap; APercent : integer = 90);
var pWsk : ^TRGBTriple;
 iGray,iCol,iRow,iAmount : integer;
begin
 ABitmap.PixelFormat := pf24bit;
 if APercent = 100 then
 iAmount := 255
 else
 iAmount := trunc((APercent / 100.0) * 255);
 for iRow := 0 to ABitmap.Height-1 do begin
 pWsk := ABitmap.ScanLine[iRow];
 for iCol := 0 to ABitmap.Width - 1 do begin
 iGray := (pWsk^.rgbtBlue + pWsk^.rgbtGreen + pWsk^.rgbtRed) div 3;
 pWsk^.rgbtRed := self.IntToByte(iGray + (((pWsk^.rgbtRed - iGray) *
 iAmount) div 255));
 pWsk^.rgbtGreen := self.IntToByte(iGray + (((pWsk^.rgbtGreen - iGray) *
 iAmount) div 255));
 pWsk^.rgbtBlue := self.IntToByte(iGray + (((pWsk^.rgbtBlue - iGray) *
 iAmount) div 255));
 inc(pWsk);
 end;
 end;
end;
// =============================================================================
// Change contrast of Bitmap
// =============================================================================
class procedure Bitmaps.Contrast(ABitmap : TBitmap; APercent : integer = 50);
var pWsk : ^byte;
 iCol,iRow,iAmount : integer;
begin
 if APercent = 100 then
 iAmount := 255
 else
 iAmount := trunc((APercent / 100.0) * 255);
 ABitmap.PixelFormat := pf24bit;
 for iRow := 0 to ABitmap.Height - 1 do begin
 pWsk := ABitmap.ScanLine[iRow];
 for iCol := 0 to ABitmap.Width * 3 -1 do begin
 if pWsk^ 127 then
 pWsk^ := self.IntToByte(pWsk^ + (abs(127 - pWsk^) * iAmount) div 255)
 else
 pWsk^ := self.IntToByte(pWsk^ - (abs(127 - pWsk^) * iAmount) div 255);
 inc(pWsk);
 end;
 end;
end;
// =============================================================================
// Flip Horizontal
// =============================================================================
class procedure Bitmaps.FlipHorizontal(ABitmap : TBitmap);
type TByteTriple = array [0..2] of byte;
var pByteL,pByteR : ^TByteTriple;
 aByteTemp : TByteTriple;
 iCol,iRow : integer;
begin
 ABitmap.PixelFormat:=pf24bit;
 for iRow :=0 to ABitmap.Height - 1 do begin
 pByteL := ABitmap.ScanLine[iRow];
 pByteR := ABitmap.ScanLine[iRow];
 inc(pByteR,ABitmap.Width - 1);
 for iCol := 0 to (ABitmap.Width -1) div 2 do begin
 aByteTemp := pByteL^;
 pByteL^ := pByteR^;
 pByteR^ := aByteTemp;
 inc(pByteL);
 dec(pByteR);
 end;
 end;
end;
// =============================================================================
// Flip Vertical
// =============================================================================
class procedure Bitmaps.FlipVertical(ABitmap : TBitmap);
var pByteTop,pByteBottom : ^byte;
 iByteTemp : byte;
 iCol,iRow : integer;
begin
 ABitmap.PixelFormat:=pf24bit;
 for iRow := 0 to (ABitmap.Height - 1) div 2 do begin
 pByteTop := ABitmap.ScanLine[iRow];
 pByteBottom := ABitmap.ScanLine[ABitmap.Height - 1 - iRow];
 for iCol :=0 to ABitmap.Width * 3 - 1 do begin
 iByteTemp := pByteTop^;
 pByteTop^ := pByteBottom^;
 pByteBottom^ := iByteTemp;
 inc(pByteTop);
 inc(pByteBottom);
 end;
 end;
end;
{$ENDREGION}
end.
Graphic Delphi
