Форум: "Начинающим";
Текущий архив: 2006.05.21;
Скачать: [xml.tar.bz2];

Вниз

Нет ли у кого функции, чтобы сделать Blur?   Найти похожие ветки 

← →
TBlur   (2006-05-07 02:04) [0]

Или smooth, что ли. Или это одно и тоже?

---

← →
Rial ©   (2006-05-07 03:24) [1]

function GaussBlur(Const Bitmap:TBitmap;Const Radius:Double):Boolean;
Type PPRows=^TPRows;
    TPRows=Array[0..0]of pPixelArray;

Const MaxKernelSize=100;

Type TKernelSize=1..MaxKernelSize;
    TKernel=record
     Size:TKernelSize;
     Weights:array[-MaxKernelSize..MaxKernelSize]of Single;
    end;

procedure MakeGaussianKernel(Var K:TKernel;Const Radius:Double;Const MaxData,DataGranularity:Double);
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;
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;
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;
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:pPixelArray);
Var J,N:Integer;
   Tr,Tg,Tb:Double;
   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];
  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,$FF,Tb);
  G:=TrimReal(0,$FF,Tg);
  R:=TrimReal(0,$FF,Tr);
 end;
end;
Move(P[0],TheRow[0],(High(TheRow)+1)*Sizeof(TRGBTriple));
end;

Var Row,Col:Integer;
   TheRows:PPRows;
   K:TKernel;
   ACol,P:pPixelArray;
   H,W:Integer;
begin
Result:=False;
Try
Bitmap.PixelFormat:=pf24bit;
Bitmap.HandleType:=bmDIB;
W:=Bitmap.Width;
H:=Bitmap.Height;
If(Bitmap.HandleType<>bmDIB)or(Bitmap.PixelFormat<>pf24Bit) then Exit;
MakeGaussianKernel(K,Radius,$FF,1);
GetMem(TheRows,H*SizeOf(pPixelArray));
GetMem(ACol,H*(SizeOf(TRGBTriple)+2));
For Row:=0 to H-1 do
 TheRows[Row]:=Bitmap.Scanline[Row];
 P:=AllocMem(W*SizeOf(TRGBTriple));
For Row:=0 to H-1 do
 BlurRow(Slice(TheRows[Row]^,W),K,P);
 ReAllocMem(P,H*(SizeOf(TRGBTriple)+2));
For Col:=0 to W-1 do begin
 For Row:=0 to H-1 do
  ACol[Row]:=TheRows[Row][Col];
  BlurRow(Slice(ACol^,W),K,P);
 For Row:=0 to H-1 do
  TheRows[Row][Col]:=ACol[Row];
end;
FreeMem(TheRows);
FreeMem(ACol);
ReAllocMem(P,0);
Except
Exit;
End;
Result:=True;
end;


Надеюсь, тебе это подойдет.

---

← →
TBlur   (2006-05-07 06:40) [2]

Спасибо ! Пойду попробую.

---

Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2006.05.21;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.45 MB
Время: 0.012 c