Registriert seit: 18. Aug 2004
Ort: Brackenheim VS08 Pro
2.876 Beiträge
|
Re: Bild weichzeichnen
5. Dez 2005, 16:40
Hier noch eine Routine, die sehr schnell sein sollte.
Delphi-Quellcode:
****************************************************************
* Fastblur routine (c)2005 Roy Magne Klever
* If you improve it send me a copy at [email]roy_m_klever@hotmail.com[/email]
****************************************************************
procedure rkFastBlur(src, dest: TBitmap; radius, rep: integer);
type
PRGB24 = ^TRGB24;
TRGB24 = packed record
B: Byte;
G: Byte;
R: Byte;
end;
TLine24 = array[0..MaxInt div SizeOf(TRGB24) - 1] of TRGB24;
PLine24 = ^TLine24;
var
j, divF, i, w, h, x, y, ny, tx, ty, prg: integer;
p: pRGB24;
ptrS, ptrD, pv: integer;
s0, s1: PLine24;
saR, saG, saB: array of Integer;
begin
dest.Assign(src);
if radius = 0 then
Exit;
divF := (radius * 2) + 1;
w := dest.Width - 1;
h := dest.Height - 1;
SetLength(saR, w + 1 + (radius * 2));
SetLength(saG, w + 1 + (radius * 2));
SetLength(saB, w + 1 + (radius * 2));
s1 := dest.ScanLine[0];
ptrD := integer(dest.ScanLine[1]) - integer(s1);
ny := Integer(s1);
for y := 0 to h do
begin
for j := 1 to rep do
begin
i := -radius;
while i <= w + radius do
begin
tx := i;
if tx < 0 then
tx := 0
else if tx >= w then
tx := w;
with pRGB24(ny + tx * 3)^ do
begin
saR[i + radius] := r + saR[i + radius - 1];
saG[i + radius] := g + saG[i + radius - 1];
saB[i + radius] := b + saB[i + radius - 1];
end;
inc(i);
end;
for x := 0 to w do
begin
tx := x + radius;
with pRGB24(ny + x * 3)^ do
begin
r := ((saR[tx + radius] - saR[tx - 1 - radius]) div divF);
g := ((saG[tx + radius] - saG[tx - 1 - radius]) div divF);
b := ((saB[tx + radius] - saB[tx - 1 - radius]) div divF);
end;
end;
end;
inc(ny, PtrD);
end;
SetLength(saR, h + 1 + (radius * 2));
SetLength(saG, h + 1 + (radius * 2));
SetLength(saB, h + 1 + (radius * 2));
for x := 0 to w do
begin
for j := 1 to rep do
begin
ny := Integer(s1);
i := -radius;
while i <= h + radius do
begin
if (i > 0) and (i < h) then
inc(ny, PtrD);
with pRGB24(ny + x * 3)^ do
begin
saR[i + radius] := r + saR[i + radius - 1];
saG[i + radius] := g + saG[i + radius - 1];
saB[i + radius] := b + saB[i + radius - 1];
end;
inc(i);
end;
ny := Integer(s1);
for y := 0 to h do
begin
ty := y + radius;
with pRGB24(ny + x * 3)^ do
begin
r := ((saR[ty + radius] - saR[ty - 1 - radius]) div divF);
g := ((saG[ty + radius] - saG[ty - 1 - radius]) div divF);
b := ((saB[ty + radius] - saB[ty - 1 - radius]) div divF);
end;
inc(ny, PtrD);
end;
end;
end;
SetLength(saR, 0);
SetLength(saG, 0);
SetLength(saB, 0);
end;
Etwas optimiert, allerdings für die GR32-Lib:
Delphi-Quellcode:
procedure FastBlur(Dst: TBitmap32; Radius: Integer; Passes: Integer = 3);
//****************************************************************
//* Fastblur routine (c)2005 Roy Magne Klever
//* GR32 Conversion and further optimizations by Michael Hansen
//* If you improve it please send a copies to:
//* [email]roy_m_klever@hotmail.com[/email]
//* [email]dyster_tid@hotmail.com[/email]
//****************************************************************
type
PARGB32 = ^TARGB32;
TARGB32 = packed record
B: Byte;
G: Byte;
R: Byte;
A: Byte;
end;
TLine32 = array[0..MaxInt div SizeOf(TARGB32) - 1] of TARGB32;
PLine32 = ^TLine32;
PSumRecord = ^TSumRecord;
TSumRecord = packed record
saB, saG, saR, saA: Cardinal;
end;
var
J, X, Y, w, h, ny, tx, ty: integer;
ptrD: integer;
s1: PLine32;
C: TColor32;
sa: array of TSumRecord;
sr1, sr2: TSumRecord;
n : Cardinal;
begin
if Radius = 0 then Exit;
n := Fixed(1 / ((radius * 2) + 1));
w := Dst.Width - 1;
h := Dst.Height - 1;
SetLength(sa, w + 1 + (radius * 2));
s1 := PLine32(Dst.PixelPtr[0,0]);
ptrD := Integer(Dst.PixelPtr[0,1]) - Integer(s1);
ny := Integer(s1);
for Y := 0 to h do
begin
for J := 1 to Passes do
begin
X := - Radius;
while X <= w + Radius do
begin
tx := X;
if tx < 0 then tx := 0 else if tx >= w then tx := w;
sr1 := sa[X + Radius - 1];
C := PColor32(ny + tx shl 2)^;
with sa[X + Radius] do
begin
saA := sr1.saA + C shr 24;
saR := sr1.saR + C shr 16 and $FF;
saG := sr1.saG + C shr 8 and $FF;
saB := sr1.saB + C and $FF;
end;
inc(X);
end;
for X := 0 to w do
begin
tx := X + Radius;
sr1 := sa[tx + Radius];
sr2 := sa[tx - 1 - Radius];
PColor32(ny + X shl 2)^ := (sr1.saA - sr2.saA) * n shl 8 and
$FF000000 or
(sr1.saR - sr2.saR) * n and $FF0000 or
(sr1.saG - sr2.saG) * n shr 8 and $FF00
or
(sr1.saB - sr2.saB) * n shr 16;
end;
end;
inc(ny, PtrD);
end;
SetLength(sa, h + 1 + (Radius * 2));
for X := 0 to w do
begin
for J := 1 to Passes do
begin
ny := Integer(s1);
Y := - Radius;
while Y <= h + Radius do
begin
if (Y > 0) and (Y < h) then inc(ny, PtrD);
sr1 := sa[Y + Radius - 1];
C := PColor32(ny + X shl 2)^;
with sa[Y + Radius] do
begin
saA := sr1.saA + C shr 24;
saR := sr1.saR + C shr 16 and $FF;
saG := sr1.saG + C shr 8 and $FF;
saB := sr1.saB + C and $FF;
end;
inc(Y);
end;
ny := Integer(s1);
for Y := 0 to h do
begin
ty := Y + Radius;
sr1 := sa[ty + Radius];
sr2 := sa[ty - 1 - Radius];
PColor32(ny + X shl 2)^ := (sr1.saA - sr2.saA) * n shl 8 and
$FF000000 or
(sr1.saR - sr2.saR) * n and $FF0000 or
(sr1.saG - sr2.saG) * n shr 8 and $FF00
or
(sr1.saB - sr2.saB) * n shr 16;
inc(ny, PtrD);
end;
end;
end;
SetLength(sa, 0);
end;
Ein weiterer Algorithmus von dizzy lässt sich in der CodeLib finden.
Sebastian Moderator in der EE
|