Subject:           Re: Applying a 3x3 convolution using scanline
      Date:           Mon, 29 Jun 1998 15:23:50 +0300
      From:           Lazikas <sechidis@hypernet.hyper.gr>
 Organization:        Central Computing Facility, Aristotle University of Thessaloniki
        To:           Archie Reynolds <areynolds@gwent.nhs.gov.uk>
 Newsgroups:          borland.public.delphi.graphics



Archie Reynolds wrote:

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



// Image Library
//
// Copyright (C) 1997-1998, Earl F. Glynn, Overland Park, KS  USA.
// All Rights Reserved.

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



"fetched" by Franz Glaser for the TP-links site