How to blur a licence plate

unit Unit4;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, jpeg, ComCtrls;
 
type
  TfrmBlur = class(TForm)
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    TrackBar1: TTrackBar;
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    fPtStart: TPoint;
    fPtEnd: TPoint;
    fCaptured: Boolean;
    fCapturing: Boolean;
    function MakeRect(Pt1, Pt2: TPoint): TRect;
    procedure DrawBorder;
    function ImageRect: TRect;
    procedure BlurPortion(aPicture: TPicture; aRect: TRect);
  public
    constructor Create(AOwner: TComponent); override;
  end;
 
var
  frmBlur: TfrmBlur;
 
implementation
 
uses Math, GBlur2;
 
{$R *.dfm}
 
function TfrmBlur.MakeRect(Pt1, Pt2: TPoint) : TRect;
begin
  Result := Rect(
    IfThen(pt1.X < pt2.X, pt1.X, pt2.X),
    IfThen(pt1.Y < pt2.Y, pt1.Y, pt2.Y),
    IfThen(pt1.X < pt2.X, pt2.X, pt1.X),
    IfThen(pt1.Y < pt2.Y, pt2.Y, pt1.Y));
end;
 
constructor TfrmBlur.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fPtStart := Point(-1, -1);
  Image2.Picture.Bitmap := TBitmap.Create;
  with Image2.Picture.Bitmap do
  begin
    Width := 10;
    Height := 10;
    PixelFormat := pf24bit;
  end;
end;
 
function TfrmBlur.ImageRect: TRect;
var PtRB: TPoint;
begin
  PtRb := Point(Image1.Left + Image1.Picture.Width, Image1.Top + Image1.Picture.Height);
  Result := MakeRect(fPtStart, fPtEnd);
  OffsetRect(Result, Image1.Left, Image1.Top);
  Result := Rect(
    IfThen(Result.Left < Image1.Left, Image1.Left, Result.Left),
    IfThen(Result.Top < Image1.Top, Image1.Top, Result.Top),
    IfThen(Result.Right > PtRB.X, PtRB.X, Result.Right),
    IfThen(Result.Bottom > PtRB.Y, PtRB.Y, Result.Bottom));
end;
 
procedure TfrmBlur.DrawBorder;
begin
  DrawFocusRect(Canvas.Handle, ImageRect);
end;
 
procedure TfrmBlur.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if fCaptured then
    DrawBorder;
  fPtStart := Point(X, Y);
  fPtEnd := fPtStart;
  DrawBorder;
  fCapturing := true;
  fCaptured := true;
end;
 
procedure TfrmBlur.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   if fCapturing then
   begin
    DrawBorder;
    fPtEnd := Point(X, Y);
    DrawBorder;
  end;
end;
 
procedure TfrmBlur.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var PtEnd: TPoint;
begin
  if fCaptured then
  begin
    DrawBorder;
    fPtEnd := Point(X, Y);
    BlurPortion(Image1.Picture, ImageRect);
  end;
  fCapturing := false;
  fCaptured := false;
end;
 
procedure TfrmBlur.BlurPortion(aPicture: TPicture; aRect: TRect);
var B: TBitmap;
begin
  OffSetRect(aRect, -Image1.Left, -Image1.Top);
  B := TBitmap.Create;
  try
    TJPEGImage(aPicture.Graphic).DIBNeeded;
    B.Assign(aPicture.Graphic);
    with Image2.Picture.Bitmap do
    begin
      Assign(B);
      Image1.Picture.Bitmap.Assign(B);
      Width := aRect.Right - aRect.Left;
      Height := aRect.Bottom - aRect.Top;
      BitBlt(Canvas.Handle, 0, 0, Width, Height, B.Canvas.Handle, aRect.Left, aRect.Top, SRCCOPY);
    end;
    Image3.Picture.Assign(Image2.Picture);
    GBlur(Image3.Picture.Bitmap, TrackBar1.Position);
    BitBlt(Image1.Picture.Bitmap.Canvas.Handle, aRect.Left, aRect.Top, aRect.Right - aRect.Left, aRect.Bottom - aRect.Top,
      Image3.Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
  finally
    FreeAndNil(B);
  end;
end;
 
end.

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:

  unit GBlur2;
 
  interface
 
  uses
    Windows, Graphics;
 
  type
    PRGBTriple = ^TRGBTriple;
    TRGBTriple = packed record
      b: byte; {easier to type than rgbtBlue}
      g: byte;
      r: byte;
    end;
    PRow = ^TRow;
    TRow = array[0..1000000] of TRGBTriple;
    PPRows = ^TPRows;
    TPRows = array[0..1000000] of PRow;
 
  const
    MaxKernelSize = 100;
 
  type
    TKernelSize = 1..MaxKernelSize;
    TKernel = record
      Size: TKernelSize;
      Weights: array[-MaxKernelSize..MaxKernelSize] of single;
    end;
  {the idea is that when using a TKernel you ignore the Weights except
  for Weights in the range -Size..Size.}
 
  procedure GBlur(theBitmap: TBitmap; radius: double);
 
  implementation
 
  uses SysUtils;
 
  procedure MakeGaussianKernel(var K: TKernel; radius: double; MaxData, DataGranularity: double);
  {makes K into a gaussian kernel with standard deviation = radius. For the
   current application you set MaxData = 255 and DataGranularity = 1. Now
  the procedure sets the value of K.Size so that when we use K we will
  ignore the Weights that are so small they can't possibly matter. (Small Size
  is good because the execution time is going to be propertional to K.Size.)}
  var
    j: integer;
    temp, delta: double;
    KernelSize: TKernelSize;
  begin
    for j := Low(K.Weights) to High(K.Weights) do
    begin
      temp := j / radius;
      K.Weights[j] := exp(-temp * temp / 2);
    end;
    {now divide by constant so sum(Weights) = 1:}
    temp := 0;
    for j := Low(K.Weights) to High(K.Weights) do
      temp := temp + K.Weights[j];
    for j := Low(K.Weights) to High(K.Weights) do
      K.Weights[j] := K.Weights[j] / temp;
    {now discard (or rather mark as ignorable by setting Size) the entries that
    are too small to matter - this is important, otherwise a blur with a small radius
    will take as long as with a large radius...}
    KernelSize := MaxKernelSize;
    delta := DataGranularity / (2 * MaxData);
    temp := 0;
    while (temp < delta) and (KernelSize > 1) do
    begin
      temp := temp + 2 * K.Weights[KernelSize];
      dec(KernelSize);
    end;
    K.Size := KernelSize;
    {now just to be correct go back and jiggle again so the sum of the entries
    we'll be using is exactly 1}
    temp := 0;
    for j := -K.Size to K.Size do
      temp := temp + K.Weights[j];
    for j := -K.Size to K.Size do
      K.Weights[j] := K.Weights[j] / temp;
  end;
 
  function TrimInt(Lower, Upper, theInteger: integer): integer;
  begin
    if (theInteger <= Upper) and (theInteger >= Lower) then
      result := theInteger
    else
      if theInteger > Upper then
        result := Upper
      else
        result := Lower;
  end;
 
  function TrimReal(Lower, Upper: integer; x: double): integer;
  begin
    if (x < upper) and (x >= lower) then
      result := trunc(x)
    else
      if x > Upper then
        result := Upper
      else
        result := Lower;
  end;
 
  procedure BlurRow(var theRow: array of TRGBTriple; K: TKernel; P: PRow);
  var
    j, n: integer;
    tr, tg, tb: double; {tempRed, etc}
    w: double;
  begin
    for j := 0 to High(theRow) do
    begin
      tb := 0;
      tg := 0;
      tr := 0;
      for n := -K.Size to K.Size do
      begin
        w := K.Weights[n];
        {the TrimInt keeps us from running off the edge of the row...}
        with theRow[TrimInt(0, High(theRow), j - n)] do
        begin
          tb := tb + w * b;
          tg := tg + w * g;
          tr := tr + w * r;
        end;
      end;
      with P[j] do
      begin
        b := TrimReal(0, 255, tb);
        g := TrimReal(0, 255, tg);
        r := TrimReal(0, 255, tr);
      end;
    end;
    Move(P[0], theRow[0], (High(theRow) + 1) * Sizeof(TRGBTriple));
  end;
 
  procedure GBlur(theBitmap: TBitmap; radius: double);
  var
    Row, Col: integer;
    theRows: PPRows;
    K: TKernel;
    ACol: PRow;
    P: PRow;
 
  begin
    if (theBitmap.HandleType <> bmDIB) or (theBitmap.PixelFormat <> pf24Bit) then
      raise exception.Create('GBlur only works for 24-bit bitmaps');
    MakeGaussianKernel(K, radius, 255, 1);
    GetMem(theRows, theBitmap.Height * SizeOf(PRow));
    GetMem(ACol, theBitmap.Height * SizeOf(TRGBTriple));
    {record the location of the bitmap data:}
    for Row := 0 to theBitmap.Height - 1 do
      theRows[Row] := theBitmap.Scanline[Row];
    {blur each row:}
    P := AllocMem(theBitmap.Width * SizeOf(TRGBTriple));
    for Row := 0 to theBitmap.Height - 1 do
      BlurRow(Slice(theRows[Row]^, theBitmap.Width), K, P);
    {now blur each column}
    ReAllocMem(P, theBitmap.Height * SizeOf(TRGBTriple));
    for Col := 0 to theBitmap.Width - 1 do
    begin
      {first read the column into a TRow:}
      for Row := 0 to theBitmap.Height - 1 do
        ACol[Row] := theRows[Row][Col];
      BlurRow(Slice(ACol^, theBitmap.Height), K, P);
      {now put that row, um, column back into the data:}
      for Row := 0 to theBitmap.Height - 1 do
        theRows[Row][Col] := ACol[Row];
    end;
    FreeMem(theRows);
    FreeMem(ACol);
    ReAllocMem(P, 0);
  end;
end.

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172: