


千歳通りフラワー公園、谷田部、つくば市
function Kuwahara8Ex(var bmp: TBitmap; nBlock: integer; bDetail: Boolean = true): Boolean; var w, h, x, y, i, ix, iy, block, sblock, numBlock: integer; indx, min, d: integer; t: double; tmp: TBitmap; src, dst: TBmpData8; sig: array[0..7] of integer; sum: array[0..7] of integer; Xini: array[0..7] of integer; Yini: array[0..7] of integer; begin result := false; if bmp.PixelFormat <> pf8bit then exit; if (nBlock > 8) or (nBlock < 1) then exit; w := bmp.Width; h := bmp.Height; block := nBlock * 2 + 1; sblock := block - 1; numBlock := block * block; tmp := TBitmap.Create; tmp.PixelFormat := pf24bit; tmp.Width := w + sblock * 2; tmp.Height := h + sblock * 2; tmp.Canvas.Draw(sblock, sblock, bmp); GrayScale(tmp); src := TBmpData8.Create(tmp); dst := TBmpData8.Create(bmp); for y := 0 to h-1 do for x := 0 to w-1 do begin Xini[0] := x - sblock; Yini[0] := y - sblock; // upper-left Xini[1] := x; Yini[1] := y - sblock; // upper-right Xini[2] := x; Yini[2] := y; // lower-right Xini[3] := x - sblock; Yini[3] := y; // lower-left; Xini[4] := x - nBlock; Yini[4] := y - sblock; // upper Xini[5] := x; Yini[5] := y - nBlock; // right Xini[6] := x - nBlock; Yini[6] := y; // lower Xini[7] := x - sblock; Yini[7] := y - nBlock; // left for i := 0 to 7 do begin sum[i] := 0; for ix := Xini[i] to Xini[i] + sblock do for iy := Yini[i] to Yini[i] + sblock do sum[i] := sum[i] + src[ix+sblock, iy+sblock]^; sum[i] := sum[i] div numBlock; sig[i] := 0; for ix := Xini[i] to Xini[i] + sblock do for iy := Yini[i] to Yini[i] + sblock do begin d := src[ix+sblock, iy+sblock]^; sig[i] := sig[i] + (sum[i] - d) * (sum[i] - d); end; sig[i] := sig[i] div numBlock; end; min := 90000; indx := 0; for i := 0 to 7 do if (sig[i] < min) then begin min := sig[i]; indx:= i; end; if (bDetail) then begin t := Max(0.5, 1.0 - Sqrt(sig[indx]) / 60); dst[x, y]^ := AdjustByte(t * sum[indx] + (1 - t) * dst[x, y]^); end else dst[x, y]^ := AdjustByte(sum[indx]); end; dst.Free; src.Free; tmp.Free; result := true; end;
uses VCLImageUtils, RinkakuUtils, Clipbrd; procedure TForm1.Button1Click(Sender: TObject); var bmp, tmp: TBitmap; begin bmp := LoadPng('C:\Home\ImgWork\RaceQueen.png'); if not Assigned(bmp) then exit; bmp.PixelFormat := pf24bit; tmp := BmpClone(bmp); if Rinkaku(tmp, 15) and Contrast8(tmp, 100, 0.04) and AntiBlackOut(bmp, tmp, 60, 30, 0.8) and Kuwahara8Ex(tmp, 1, true) then begin Canvas.Draw(5, 35, tmp); Clipboard.Assign(tmp); end; bmp.Free; tmp.Free; end;
function ByteSort(Item1, Item2: Pointer): Integer; begin result := byte(Item1)-byte(Item2); end; function Median8(var bmp: TBitmap; area: integer = 1):Boolean; var tmp:TBitmap; w, h, ix, iy, x, y, xx, yy: integer; src, dst: TBmpData8; ll: TList; md, num, indx: integer; begin result := false; if bmp.PixelFormat <> pf8bit then exit; if (area<1) or (area>4) then exit; w := bmp.Width; h := bmp.Height; num := (2*area+1)*(2*area+1); md := Round(num/2); ll := TList.Create; ll.Capacity := num; ll.Count := num; tmp := BmpClone(bmp); src := TBmpData8.Create(tmp); dst := TBmpData8.Create(bmp); for iy := 0 to h-1 do for ix := 0 to w-1 do begin indx := 0; for y := iy-area to iy+area do for x := ix-area to ix+area do begin if (y<0) or (y>h-1) then yy := iy else yy := y; if (x<0) or (x>w-1) then xx := ix else xx := x; ll[indx] := pointer(src[xx, yy]^); inc(indx); end; ll.Sort(ByteSort); dst[ix, iy]^ := byte(ll[md]); end; dst.Free; src.Free; ll.Free; tmp.Free; result := true; end;
function SetTwoColorGrayScalePalette(var bmp: TBitmap; Dark, Bright: TColor):Boolean; var i: integer; ct: array[0..255] of TRGBQuad; dr, dg, db, br, bg, bb: Byte; begin result := false; if bmp.PixelFormat <> pf8bit then exit; Dark := ColorToRGB(Dark); Bright := ColorToRGB(Bright); dr := GetRValue(Dark); dg := GetGValue(Dark); db := GetBValue(Dark); br := GetRValue(Bright); bg := GetGValue(Bright); bb := GetBValue(Bright); for i := 0 to 255 do begin ct[i].rgbRed := Round(dr+(br-dr)*i/255); ct[i].rgbGreen := Round(dg+(bg-dg)*i/255); ct[i].rgbBlue := Round(db+(bb-db)*i/255); ct[i].rgbReserved := 0; end; SetDIBColorTable(bmp.Canvas.Handle,0,256,ct); DeleteObject(bmp.ReleasePalette); result := true; end;
uses VCLImageUtils, RinkakuUtils, Clipbrd; procedure TForm1.Button1Click(Sender: TObject); var bmp, tmp: TBitmap; begin bmp := LoadPng('C:\Home\ImgWork\RaceQueen.png'); if not Assigned(bmp) then exit; bmp.PixelFormat := pf24bit; tmp := BmpClone(bmp); if Rinkaku(tmp, 15) and Contrast8(tmp, 100, 0.04) and AntiBlackOut(bmp, tmp, 60, 30, 0.8) and Kuwahara8Ex(tmp, 1, true) and Median8(tmp, 1) and SetTwoColorGrayScalePalette(tmp, RGB(50, 20, 0), RGB(255, 230, 240)) then begin Canvas.Draw(5, 35, tmp); Clipboard.Assign(tmp); end; bmp.Free; tmp.Free; end;