type
pByteQuad = ^ByteQuad;
ByteQuad = array[0..3] of byte;
procedure GrayByMinMax(src, dest : TBitmap);
var X : integer;
pPix : pByteQuad;
Bo,Bm,Bx : byte;
begin
if Src.PixelFormat <> pf32bit then
begin
Src.PixelFormat := pf32Bit;
Dest.PixelFormat := pf32Bit;
end;
Dest.Assign(Src);
pPix := Dest.ScanLine[Dest.Height-1];
for X := 0 to (Dest.Width*Dest.Height)-1 do
begin
if pPix^[0] > pPix^[2] then
begin
Bx := pPix^[0];
Bm := pPix^[2];
end
else
begin
Bx := pPix^[2];
Bm := pPix^[0];
end;
if pPix^[1] > Bx then
Bx := pPix^[1]
else
if pPix^[1] < Bm then
Bm := pPix^[1];
Bo := (Bx + Bm) shr 1;
pPix^[0] := Bo; // B
pPix^[1] := Bo; // G
pPix^[2] := Bo; // R
inc(pPix);
end;
end;
{ ------- }
procedure GrayByRGBAverage(src, dest : TBitmap);
var X : integer;
pPix : pByteQuad;
Bo : byte;
begin
if Src.PixelFormat <> pf32bit then
begin
Src.PixelFormat := pf32Bit;
Dest.PixelFormat := pf32Bit;
end;
Dest.Assign(Src);
pPix := Dest.ScanLine[Dest.Height-1];
for X := 0 to (Dest.Width*Dest.Height)-1 do
begin
Bo := (((pPix^[0] + pPix^[1]) shr 1) + pPix^[2]) shr 1;
pPix^[0] := Bo; // B
pPix^[1] := Bo; // G
pPix^[2] := Bo; // R
inc(pPix);
end;
end;
{ ------- }
procedure TrueGrayScale(Src : TBitmap; Dest : TBitmap);
var
X : integer;
Bo : integer;
pPix : pByteQuad;
PCLR : array[0..255] of single;
PCLG : array[0..255] of single;
PCLB : array[0..255] of single;
const
LumRed = 0.2125; // % of red
LumGreen = 0.7154; // % of green
LumBlue = 0.0721; // % of blue
// = 100% (1.0)
begin
if Src.PixelFormat <> pf32bit then
begin
Src.PixelFormat := pf32Bit;
Dest.PixelFormat := pf32Bit;
end;
Dest.Assign(Src);
{ PreCalculs }
for X := 0 to 255 do
begin
PCLR[X] := X*LumRed;
PCLG[X] := X*LumGreen;
PCLB[X] := X*LumBlue;
end;
pPix := Dest.ScanLine[Dest.Height-1];
for X := 0 to (Dest.Width*Dest.Height)-1 do
begin
Bo := byte(Round(PCLB[pPix^[0]] + PCLG[pPix^[1]] + PCLR[pPix^[2]]));
pPix^[0] := Bo;
pPix^[1] := Bo;
pPix^[2] := Bo;
inc(pPix);
end;
end;