> Anyone got an example of applying a 3x3 convolution using scanline
?
> Thanks, Arch
Yep. In fact, i just finished my 3x3 convolution procedure. Follows
my
imagelib unit which is an 'update' of Earl Glynn's ImageLib unit...
I cut some parts of the unit which are not
interesting to you but the
convolution and all the types & variables it needs are here.
Since this
unit is not fully commented (because i just made the 3x3 convolution
)
you can send me an e-mail for any questions.
The speed of the procedure is about 5 seconds using an 1520x1024
color
image in a 166Mhz Pentium with 32 Mb Ram.
The speed using the normal Canvas.Pixels[] procedure was about 34
secs !
I'm trying to optimize the code, so any suggestions will be appreciated.
Lazikas.
// Adds by Lazikas o Pontios
// Added the GetPixelValfromScanedline function
to be used on convolution
// operations.
// 20-21/06/1998 Added the Convolution filters, Sobel Filter.
UNIT ImageLib;
INTERFACE
USES
Windows
// TRGBTriple
,Messages
// WM_USER
,Classes
// Rect
,Graphics
// TCanvas
;
CONST
MaxPixelCount = 32768;
TYPE
pRGBArray = ^TRGBArray;
// Use SysUtils.pByteArray for 8-bit
color
TRGBArray = ARRAY[0..MaxPixelCount-1]
OF TRGBTriple;
Type GrayValuespc = array [0..255] of real; {percentage of
Gray values}
Type GrayValuesab = array [0..255] of longint;
Type RGBMatrixValuesPC = record {percentage}
r,
g,
b : GrayValuespc;
end;
Type RGBMatrixValuesAB = record {absolute}
r,
g,
b : GrayValuesab;
end;
Type RGBTypeEnum = ( RED,GREEN,BLUE);
Type ColorTypeEnum = (GRAY, NOTGRAY);
{define this type so whe will not have 'Out
of range' when we read
from a big image which has 32767*3 bytes
per pixel}
type LLongByteArray = array[0..100000] of byte;
type PLLongByteArray = ^LLongByteArray;
{Trick to read RGB colors fast. To use :
var c : RGBcolor;
c.Bcolor:=GetPixel...;
red:=c.r; green:=c.g; blue:=c.b;}
type RGBcolor = record
case integer of
0: (Bcolor : Tcolor);
1: (r,g,b,st : byte);
2: (H,L :Word);
end;
type ConvolutionMatrix3 = array [1..9] of byte;
type PConvolutionMatrix3 = ^ConvolutionMatrix3;
Type FilterType =
(NOFILTER,LOWPASS1,LOWPASS2,LOWPASS3,LOWPASS4,LAPLACEORIGINAL
,LAPLACE,LAPLACEEDGE,FOCUS,L2H,SOBELf);
const Black = 0;
const White = 255;
var HGrayPalette : HPALETTE;
GrayPalette : PLogPalette;
PROCEDURE PrintBitmap(Canvas: TCanvas; DestRect:
TRect; Bitmap:TBitmap);
Procedure CopyBitmap (BitmapSource, BitmapDest : TBitmap);
procedure MakeGrayPalette (Bitmap : Tbitmap);
function GetPixelVal (i,j: integer; bitmap : TBitmap)
: TColor;
Function CreateGrayPalette : Boolean;
procedure DestroyGrayPalette;
// filters
Procedure Convolution (BitmapSource : TBitmap;
SelectedFilter : FilterType;
Channel : RGBTypeEnum);
IMPLEMENTATION
var
// variables needed
for reading pixel values
PixelFormat : TPixelFormat;
P1, // Scanline 1
P2, // ScanLine 2
P3 // Scanline 3
:PLLongByteArray; // Used for fast convolution
operations on 3x3 matrix
// This is the recommended way to print
images on a printer.
// Based on posting to borland.public.delphi.winapi
by Rodney E Geraghty, 8/8/97.}
PROCEDURE PrintBitmap(Canvas: TCanvas; DestRect: TRect;
Bitmap:TBitmap);
VAR BitmapHeader: pBitmapInfo;
BitmapImage : POINTER;
HeaderSize : INTEGER;
ImageSize : INTEGER;
BEGIN
GetDIBSizes(Bitmap.Handle, HeaderSize, ImageSize);
GetMem(BitmapHeader, HeaderSize);
GetMem(BitmapImage, ImageSize);
TRY
GetDIB(Bitmap.Handle, Bitmap.Palette,
BitmapHeader^, BitmapImage^);
StretchDIBits(Canvas.Handle,
DestRect.Left, DestRect.Top, {Destination Origin}
DestRect.Right - DestRect.Left, {Destination Width}
DestRect.Bottom - DestRect.Top, {Destination Height}
0, 0,
{Source Origin}
Bitmap.Width, Bitmap.Height, {Source Width &
Height}
BitmapImage,
TBitmapInfo(BitmapHeader^),
DIB_RGB_COLORS,
SRCCOPY)
FINALLY
FreeMem(BitmapHeader);
FreeMem(BitmapImage)
END
END {PrintBitmap};
Procedure CopyBitmap (BitmapSource, BitmapDest : TBitmap);
begin
BitmapDest.Height:=BitmapSource.Height;
BitmapDest.Width:=BitmapSource.Width;
BitmapDest.PixelFormat:=BitmapSource.PixelFormat;
BitmapDest.HandleType:=BitmapSource.HandleType;
BitmapDest.Canvas.CopyRect
(Rect(0,0,BitmapDest.width,BitmapDest.height),
BitmapSource.Canvas,
Rect(0,0,BitmapSource.width,BitmapSource.Height)
);
if BitmapSource.PixelFormat = pf8bit then MakeGrayPalette(BitmapDest);
end;
procedure MakeGrayPalette (Bitmap : Tbitmap);
var
pal: PLogPalette;
hpal: HPALETTE;
i: Integer;
begin
pal := nil;
try
GetMem(pal, sizeof(TLogPalette) + sizeof(TPaletteEntry)
* 255);
pal.palVersion := $300;
pal.palNumEntries := 256;
for i := 0 to 255 do
begin
pal.palPalEntry[i].peRed := i;
pal.palPalEntry[i].peGreen := i;
pal.palPalEntry[i].peBlue := i;
end;
hpal := CreatePalette(pal^);
if hpal <> 0 then
Bitmap.Palette := hpal;
finally
FreeMem(pal);
end;
end;
Function CreateGrayPalette : Boolean;
var
i: Integer;
begin
GrayPalette := nil;
try
GetMem(GrayPalette, sizeof(TLogPalette) + sizeof(TPaletteEntry)
* 255);
Graypalette.palVersion := $300;
Graypalette.palNumEntries := 256;
for i := 0 to 255 do
begin
Graypalette.palPalEntry[i].peRed
:= i;
Graypalette.palPalEntry[i].peGreen
:= i;
Graypalette.palPalEntry[i].peBlue
:= i;
end;
hGraypalette := CreatePalette(GrayPalette^);
if hGraypalette <> 0 then CreateGrayPalette:=True
else CreateGrayPalette:=False;
finally
end;
end;
Procedure DestroyGrayPalette;
begin
if hGrayPalette<>0 then FreeMem(GrayPalette);
end;
// It does not work with 256 color images
that use a palette.
// Routine thinks that it is an 8bit grey
scale image and returns
// the pixel value instead of pallete's color
...
function GetPixelVal (i,j: integer; Bitmap : Tbitmap) : TColor;
var C,C1 : RGBColor;
P : ^LLongbyteArray;
a : longint;
begin
if (j<0) or (j>Bitmap.Height) then begin GetPixelVal:=0;
exit; end;
P:=Bitmap.ScanLine[j];
Case Bitmap.PixelFormat of
pf24bit: begin a:=i*3; C.b:=P[a]; C.g:=P[a+1];
C.r:=P[a+2]; end;
pf8bit: begin C.r:=p[i]; C.b:=p[i];
C.g:=p[i]; end;
pf15bit
,pf16bit:
begin
a:=i*2;
c1.b:=P[a];
c1.st:=P[a+1];
// ok,
we have the bits colors at C1.L. Now, find the values
// of
each color band.
// To
get the blue value, we need the last 5 bits of C1.L.
C.b:=c1.L and $001F; // 0000000000011111
// if
color = 0 it remains 0. If color is b11111 its being 255
// else
it has the value of ((color+1)*8). This means that we
// cannot
have value 8 for color! But we have 255.
// This
is how Windows.GetPixeL works - agree or not !
if c.b = $001F then c.b:=255
else
if (c.b in [1..30]) then begin
inc (C.b); C.b:=c.b*8; end;
// Shift
right 5 bits. BLUE color now disappears and the last
// 5
bits have the GREEN value. Do same as before.
C1.L:= C1.L shr 5;
C.g:=c1.L and $001F;
if c.g = $001F then c.g:=255
else
if c.g in [1..30] then begin
inc (C.g); C.g:=c.g*8; end;
// And
finally, shift right 5 bits again. GREEN color have been
// disappeared.
Last 5 bits have the RED value.
C1.L:= C1.L shr 5;
C.r:=C1.L and $001F;
if c.r = $001F then c.r:=255
else
if c.r in [1..30] then begin
inc (C.r); C.r:=c.r*8; end;
end; //pf15bit, pf16bit
end; //case
GetPixelVal:=C.Bcolor;
end;
// This function is similar to GetPixelVal
(i,j) but works more then 5 times !
// faster when we want pixels of the same
row.
// - It doesnot work with 256 color images
that use a color palette.
// Routine thinks that it is an 8bit grey
scale image and returns
// the pixel value instead of pallete's color
value...
// - For comments on code,look at the GetPixelVal
Function.
function GetPixelValfromScanedline (i: integer; PS : PLLongByteArray
): TColor;
var C,C1 : RGBColor;
a : longint;
begin
Case PixelFormat of
pf24bit: begin a:=i*3; C.b:=PS[a]; C.g:=PS[a+1];
C.r:=PS[a+2]; end;
pf8bit: begin C.r:=pS[i]; C.b:=pS[i];
C.g:=pS[i]; end;
pf15bit
,pf16bit:
begin
a:=i*2;
c1.b:=PS[a];
c1.st:=PS[a+1];
C.b:=c1.L and $001F;
if c.b = $001F then c.b:=255
else
if (c.b in [1..30]) then begin
inc (C.b); C.b:=c.b*8; end;
C1.L:= C1.L shr 5;
C.g:=c1.L and $001F;
if c.g = $001F then c.g:=255
else
if c.g in [1..30] then begin
inc (C.g); C.g:=c.g*8; end;
C1.L:= C1.L shr 5;
C.r:=C1.L and $001F;
if c.r = $001F then c.r:=255
else
if c.r in [1..30] then begin
inc (C.r); C.r:=c.r*8; end;
end; //pf15bit, pf16bit
end; //case
GetPixelValfromScanedline:=C.Bcolor;
end;
// It is defined only for gray scale filtering....
Procedure PutpixelToScanline (i:integer; c:integer ;
Ps:PLLongByteArray);
var a : longint;
begin
Case PixelFormat of
pf24bit: begin a:=i*3; PS[a]:=C; PS[a+1]:=C;
PS[a+2]:=C; end;
pf8bit : PS[i]:=c;
end; // case
end;
// CHANGES the BitmapSource applying
a 3x3 convolution.
Procedure Convolution (BitmapSource : TBitmap;
SelectedFilter : FilterType;
Channel : RGBTypeEnum);
var x,y,
i : integer;
a1,a2,a3,b1,b2,b3,c1,c2,c3,k : integer; // convolution
params
C : integer; // new color
Bitmap : TBitmap;
matrixr, // matrix for red band
matrixg, // matrix for green band etc
matrixb : ConvolutionMatrix3;
color : RGBColor;
PS : PLLongByteArray;
P : PConvolutionMatrix3;
begin
// CONVOLUTION filter
case SelectedFilter of
LOWPASS1 : begin a1:=1;
a2:=1; a3:=1; b1:=1; b2:=1; b3:=1;
c1:=1; c2:=1; c3:=1; k:=9; end;
LOWPASS2 : begin a1:=1;
a2:=1; a3:=1; b1:=1; b2:=2; b3:=1;
c1:=1; c2:=1; c3:=1; k:=10; end;
LOWPASS3 : begin a1:=1;
a2:=2; a3:=1; b1:=2; b2:=4; b3:=2;
c1:=1; c2:=2; c3:=1; k:=16; end;
LOWPASS4 : begin a1:=0;
a2:=1; a3:=0; b1:=1; b2:=1; b3:=1;
c1:=0; c2:=1; c3:=0; k:=5; end;
LAPLACE : begin
a1:=1; a2:=-2; a3:=1; b1:=-2; b2:=5; b3:=-2;
c1:=1; c2:=-2; c3:=1; k:=1; end;
LAPLACEORIGINAL:
begin a1:=-1; a2:=-1; a3:=-1; b1:=-1; b2:=9; b3:=-1;
c1:=-1; c2:=-1; c3:=-1; k:=1; end;
LAPLACEEDGE: begin a1:=-1;
a2:=-1; a3:=-1; b1:=-1; b2:=8; b3:=-1;
c1:=-1; c2:=-1; c3:=-1; k:=1; end;
FOCUS:
begin a1:=0; a2:=-1; a3:=0; b1:=-1; b2:=5; b3:=-1;
c1:=0; c2:=-1; c3:=0; k:=1; end;
end; // case;
// If we work with a 8bit gray
scale bitmap the value of the pixel is in RED band.
P:=addr (matrixr); // default is red...
PixelFormat:=BitmapSource.PixelFormat;
Bitmap:=TBitmap.Create;
try
CopyBitmap (BitmapSource,Bitmap);
// for every pixel on
BitmapSource do
for y:=1 to BitmapSource.Height-2 do
begin
P1:=BitmapSource.ScanLine[y-1];
// previous line pointer
P2:=BitmapSource.ScanLine[y];
// current line pointer
P3:=BitmapSource.ScanLine[y+1];
// next line pointer
PS:=Bitmap.ScanLine[y];
// Destination bitmap, current line
For x:=1 to BitmapSource.Width-2
do
begin
// read
RGB value of pixel and put them in corresponding matrixes.
// matrixes keep the 3x3 pixel values. Reset it every time
for i:=1 to 9 do
begin matrixr[i]:=0;
matrixb[i]:=0; matrixg[i]:=0; end;
// read the previous line
color.Bcolor:=GetPixelvalFromScanedLine(x-1,P1);
matrixr[1]:=color.r;
matrixg[1]:=color.g; matrixb[1]:=color.b;
color.Bcolor:=GetPixelvalFromScanedLine(x,P1);
matrixr[2]:=color.r;
matrixg[2]:=color.g; matrixb[2]:=color.b;
color.Bcolor:=GetPixelvalFromScanedLine(x+1,P1);
matrixr[3]:=color.r;
matrixg[3]:=color.g; matrixb[3]:=color.b;
// read current line
color.Bcolor:=GetPixelvalFromScanedLine(x-1,P2);
matrixr[4]:=color.r;
matrixg[4]:=color.g; matrixb[4]:=color.b;
color.Bcolor:=GetPixelvalFromScanedLine(x,P2);
matrixr[5]:=color.r;
matrixg[5]:=color.g; matrixb[5]:=color.b;
color.Bcolor:=GetPixelvalFromScanedLine(x+1,P2);
matrixr[6]:=color.r;
matrixg[6]:=color.g; matrixb[6]:=color.b;
// read next line
color.Bcolor:=GetPixelvalFromScanedLine(x-1,P3);
matrixr[7]:=color.r;
matrixg[7]:=color.g; matrixb[7]:=color.b;
color.Bcolor:=GetPixelvalFromScanedLine(x,P3);
matrixr[8]:=color.r;
matrixg[8]:=color.g; matrixb[8]:=color.b;
color.Bcolor:=GetPixelvalFromScanedLine(x+1,P3);
matrixr[9]:=color.r;
matrixg[9]:=color.g; matrixb[9]:=color.b;
case channel of
RED :
P:=addr(matrixr);
GREEN: P:=addr(matrixg);
BLUE:
P:=addr(matrixb);
end;
c:=a1*P^[1] + a2*P^[2]
+ a3*P^[3] +
b1*P^[4]
+ b2*P^[5] + b3*P^[6] +
c1*P^[7]
+ c2*P^[8] + c3*P^[9] ;
c:= c div k;
if c >255 then c:=255;
if c <0 then c:=0;
PutPixelToScanLine (x,
c,ps);
end;//x
end; // y
//try
CopyBitmap(Bitmap,BitmapSource);
finally
Bitmap.ReleaseHandle;
Bitmap.Free;
end;
end; // procedure Convolution
END {ImageLib}.