// 只适用R8G8B8的pf24bit Bitmap

unit nau_NoxImageFunctions;

interface

uses
SysUtils, Types, Graphics;

procedure NoxImage_Sharpen( aSrcBitmap: TBitmap; aTarBitmap: TBitmap );
procedure NoxImage_Resize( aSrcBitmap: TBitmap; aTarBitmap: TBitmap; toWidth, toHeight: Integer );

implementation

procedure NoxImage_Sharpen( aSrcBitmap: TBitmap; aTarBitmap: TBitmap );
const
templatePhotoshopSharpenMore
: array [0..2, 0..2] of Double = ( ( -0.25, -0.25, -0.25), (-0.25, 3, -0.25), (-0.25, -0.25, -0.25) );
templatePhotoshopSharpen
: array [0..2, 0..2] of Double = ( ( 0, -0.25, 0), (-0.25, 2, -0.25), (0, -0.25, 0) );
templateMySharpen
: array [0..2, 0..2] of Double = ( ( -0.05, -0.2, 0-0.05), (-0.2, 2, -0.2), (-0.05, -0.2, -0.05) );
templateSharpenKeyPoint: TPoint = (X: 1; Y: 1);

var
template: array [0..2, 0..2] of Double;
type
TRGBRecord = record
R: Byte;
G: Byte;
B: Byte;
Reversed: Byte;
end;
var
aSrcBitmapBuf: array of TRGBRecord; { y*width + x }
aTarBitmapBuf: array of TRGBRecord;
aBitmapWidth: Integer;
aBitmapHeight: Integer;
var
// 循环中的 TarBitmap 点
ix, iy: Integer;

// 内循环模板中的坐标
sxi, syi: Integer;
sx, sy: Integer;

// 色彩值临时
colorR: Double;
colorG: Double;
colorB: Double;

// 原色值和新色值
srcRGB, tarRGB: TRGBRecord;
srcColor: TColor;
tarColor: TColor;

// TarBitmap 一个点在 SrcBitmap 中所占的空间比例
mx, my: Double;

aPointer: PByteArray;

o1, o2, o3: Double;

begin
Move( templatePhotoshopSharpen, template, SizeOf(template) );
aBitmapWidth := aSrcBitmap.Width;
aBitmapHeight := aSrcBitmap.Height;

SetLength( aSrcBitmapBuf, aBitmapWidth * aBitmapHeight );
SetLength( aTarBitmapBuf, aBitmapWidth * aBitmapHeight );

for iy:=0 to aBitmapHeight - 1 do
begin
aPointer := aSrcBitmap.ScanLine[iy];

for ix:=0 to aBitmapWidth - 1 do
begin
aSrcBitmapBuf[iy*aBitmapWidth + ix].B := aPointer[ix*3 + 0];
aSrcBitmapBuf[iy*aBitmapWidth + ix].G := aPointer[ix*3 + 1];
aSrcBitmapBuf[iy*aBitmapWidth + ix].R := aPointer[ix*3 + 2];
end;
end;

aTarBitmap.Width := aBitmapWidth;
aTarBitmap.Height := aBitmapHeight;

// 遍历 TarBitmap 横向所有点
for ix := 0 to aBitmapWidth - 1 do
begin

// 遍历 TarBitmap 纵向所有点
for iy := 0 to aBitmapHeight - 1 do
begin

srcRGB := aSrcBitmapBuf[iy*aBitmapWidth + ix];

if (ix < templateSharpenKeyPoint.X)
or (iy < templateSharpenKeyPoint.Y)
or (ix > aBitmapWidth - 3 + templateSharpenKeyPoint.X )
or (iy > aBitmapHeight - 3 + templateSharpenKeyPoint.Y )
then
begin
tarRGB := srcRGB;
end else
begin

colorR := 0;
colorG := 0;
colorB := 0;

for sxi := 0 to 2 do
begin
sx := ix - templateSharpenKeyPoint.X + sxi;

for syi := 0 to 2 do
begin
sy := iy - templateSharpenKeyPoint.Y + syi;

srcRGB := aSrcBitmapBuf[sy*aBitmapWidth + sx];

colorR := colorR + srcRGB.R * template[sxi, syi];
colorG := colorG + srcRGB.G * template[sxi, syi];
colorB := colorB + srcRGB.B * template[sxi, syi];

end;
end;

if colorR < 0 then colorR := 0;
if colorR > 255 then colorR := 255;
if colorG < 0 then colorG := 0;
if colorG > 255 then colorG := 255;
if colorB < 0 then colorB := 0;
if colorB > 255 then colorB := 255;

tarRGB.R := Round(colorR);
tarRGB.G := Round(colorG);
tarRGB.B := Round(colorB);
end;

aTarBitmapBuf[iy*aBitmapWidth + ix] := tarRGB;

end;
end;

aTarBitmap.PixelFormat := pf24bit;
for iy:=0 to aBitmapHeight - 1 do
begin
aPointer := aTarBitmap.ScanLine[iy];

for ix:=0 to aBitmapWidth - 1 do
begin
aPointer[ix*3 + 0] := aTarBitmapBuf[iy*aBitmapWidth + ix].B;
aPointer[ix*3 + 1] := aTarBitmapBuf[iy*aBitmapWidth + ix].G;
aPointer[ix*3 + 2] := aTarBitmapBuf[iy*aBitmapWidth + ix].R;
end;
end;

end;

procedure NoxImage_Resize( aSrcBitmap: TBitmap; aTarBitmap: TBitmap; toWidth, toHeight: Integer );
type
TRGBRecord = record
R: Byte;
G: Byte;
B: Byte;
Reversed: Byte;
end;
var
aSrcBitmapBuf: array of TRGBRecord; { y*width + x }
aSrcBitmapWidth: Integer;
aSrcBitmapHeight: Integer;
aTarBitmapBuf: array of TRGBRecord;
aTarBitmapWidth: Integer;
var
// 循环中的 TarBitmap 点
ix, iy: Integer;

// TarBitmap 一个点，相对 SrcBitmap 几个点
ScaleX: Double;
ScaleY: Double;

// 循环中的 TarBitmap 点，对应 SrcBitmap 的位置
aSrcIX: Double;
aSrcIY: Double;

// 循环中的 TarBitmap 一个点，在 SrcBitmap 中的真实[起始1]至真实[结束2]
sx1, sx2, sy1, sy2: Integer;
// 在 SrcBitmap 的起始和结束位置中循环
sxi, syi : Integer;

// 色彩值临时
colorR: Double;
colorG: Double;
colorB: Double;

// 原色值和新色值
srcColor: TColor;
tarColor: TColor;

// TarBitmap 一个点在 SrcBitmap 中所占的空间比例
mx, my: Double;

aPointer: PByteArray;

o1, o2, o3: Double;
begin
SetLength( aSrcBitmapBuf, aSrcBitmap.Width * aSrcBitmap.Height );
aSrcBitmapWidth := aSrcBitmap.Width;
aSrcBitmapHeight := aSrcBitmap.Height;

SetLength( aTarBitmapBuf, toWidth * toHeight );
aTarBitmapWidth := toWidth;

for iy:=0 to aSrcBitmapHeight - 1 do
begin
aPointer := aSrcBitmap.ScanLine[iy];

for ix:=0 to aSrcBitmapWidth - 1 do
begin
aSrcBitmapBuf[iy*aSrcBitmapWidth + ix].B := aPointer[ix*3 + 0];
aSrcBitmapBuf[iy*aSrcBitmapWidth + ix].G := aPointer[ix*3 + 1];
aSrcBitmapBuf[iy*aSrcBitmapWidth + ix].R := aPointer[ix*3 + 2];
end;
end;

aTarBitmap.Width := toWidth;
aTarBitmap.Height := toHeight;

ScaleX := aSrcBitmapWidth / toWidth;
ScaleY := aSrcBitmapHeight / toHeight;

o1 := ScaleX * ScaleY;

// 遍历 TarBitmap 横向所有点
for ix := 0 to toWidth - 1 do
begin
// 计算 TarBitmap 横向一个点在 SrcBitmap 中的起始位置，及真实起始与真实结束
aSrcIX := ix * ScaleX;
sx1 := Trunc( aSrcIX );
sx2 := Trunc( aSrcIX + ScaleX );
if sx2 >= aSrcIX + ScaleX + 1 then
begin
sx2 := sx2 - 1;
end;
if sx2 >= aSrcBitmapWidth then
begin
sx2 := aSrcBitmapWidth - 1;
end;

// 遍历 TarBitmap 纵向所有点
for iy := 0 to toHeight - 1 do
begin
// 计算 TarBitmap 纵向一个点在 SrcBitmap 中的起始位置，及真实起始与真实结束
aSrcIY := iy * ScaleY;

sy1 := Trunc( aSrcIY );
sy2 := Trunc( aSrcIY + ScaleY );
if sy2 >= aSrcIY + ScaleY + 1 then
begin
sy2 := sy2 - 1;
end;
if sy2 >= aSrcBitmapHeight then
begin
sy2 := aSrcBitmapHeight - 1;
end;

// 初始化 RGB 值
colorR := 0;
colorG := 0;
colorB := 0;

// 遍历在 SrcBitmap 对应 TarBitmap 的范围内的所有点
for sxi := sx1 to sx2 do
begin
// 计算横向点的比率
if (sxi < aSrcIX) and (sxi > Trunc( aSrcIX + ScaleX ) - 1) then
begin
mx := ScaleX;
end else
if sxi < aSrcIX then
begin
mx := Trunc(aSrcIX) + 1 - aSrcIX;
end else
if sxi > Trunc( aSrcIX + ScaleX ) - 1 then
begin
mx := aSrcIX + ScaleX - Trunc(aSrcIX + ScaleX);
end else
begin
mx := 1;
end;

o2 := mx / o1;

for syi := sy1 to sy2 do
begin
// 计算纵向点的比率
if (syi < aSrcIY) and (syi > Trunc(aSrcIY + ScaleY ) - 1) then
begin
my := ScaleY
end else
if syi < aSrcIY then
begin
my := Trunc(aSrcIY) + 1 - aSrcIY;
end else
if syi > Trunc(aSrcIY + ScaleY ) - 1 then
begin
my := aSrcIY + ScaleY - Trunc(aSrcIY + ScaleY);
end else
begin
my := 1;
end;

{
// 取原色值
srcColor := aSrcBitmap.Canvas.Pixels[sxi, syi];

// 根据比率计算新色彩
colorR := colorR + ((srcColor ) and $FF) * mx * my / ScaleX / ScaleY;
colorG := colorG + ((srcColor shr 8) and $FF) * mx * my / ScaleX / ScaleY;
colorB := colorB + ((srcColor shr 16) and $FF) * mx * my / ScaleX / ScaleY;
}

o3 := my * o2;
//colorR := colorR + aSrcBitmapBuf[sxi,syi].R * mx * my / ScaleX / ScaleY;
//colorG := colorG + aSrcBitmapBuf[sxi,syi].G * mx * my / ScaleX / ScaleY;
//colorB := colorB + aSrcBitmapBuf[sxi,syi].B * mx * my / ScaleX / ScaleY;
colorR := colorR + aSrcBitmapBuf[syi*aSrcBitmapWidth + sxi].R * o3;
colorG := colorG + aSrcBitmapBuf[syi*aSrcBitmapWidth + sxi].G * o3;
colorB := colorB + aSrcBitmapBuf[syi*aSrcBitmapWidth + sxi].B * o3;
end;

end;

aTarBitmapBuf[iy*aTarBitmapWidth + ix].R := Trunc(colorR);
aTarBitmapBuf[iy*aTarBitmapWidth + ix].G := Trunc(colorG);
aTarBitmapBuf[iy*aTarBitmapWidth + ix].B := Trunc(colorB);

//tarColor := (Trunc(colorR)and $FF) or (Trunc(colorG)and $FF shl 8) or (Trunc(colorB)and $FF shl 16);

//aTarBitmap.Canvas.Pixels[ix, iy] := tarColor;
end;
end;

aTarBitmap.PixelFormat := pf24bit;
for iy:=0 to toHeight - 1 do
begin
aPointer := aTarBitmap.ScanLine[iy];

for ix:=0 to toWidth - 1 do
begin
aPointer[ix*3 + 0] := aTarBitmapBuf[iy*aTarBitmapWidth + ix].B;
aPointer[ix*3 + 1] := aTarBitmapBuf[iy*aTarBitmapWidth + ix].G;
aPointer[ix*3 + 2] := aTarBitmapBuf[iy*aTarBitmapWidth + ix].R;
end;
end;

end;

end.