Recent Posts
Selamat datang di Coding Delphi Land Weblog kumpulan source code pemogram delphi
(Bukan maksud untuk menggurui tetapi marilah kita berbagi ilmu tuk perkembangan kemajuan teknologi kita
Selasa, 17 November 2009
Resize Image 2
uses Windows, SysUtils, Graphics;
procedure ResizeImage(Src, Dst: TBitmap);
type
TRGBArray = array[Word] of TRGBTriple;
pRGBArray = ^TRGBArray;
var
x, y: Integer;
xP, yP: Integer;
xP2, yP2: Integer;
SrcLine1, SrcLine2: pRGBArray;
t3: Integer;
z, z2, iz2: Integer;
DstLine: pRGBArray;
DstGap: Integer;
w1, w2, w3, w4: Integer;
begin
Src.PixelFormat := pf24Bit;
Dst.PixelFormat := pf24Bit;
if (Src.Width = Dst.Width) and (Src.Height = Dst.Height) then
Dst.Assign(Src)
else
begin
DstLine := Dst.ScanLine[0];
DstGap := Integer(Dst.ScanLine[1]) - Integer(DstLine);
xP2 := MulDiv(pred(Src.Width), $10000, Dst.Width);
yP2 := MulDiv(pred(Src.Height), $10000, Dst.Height);
yP := 0;
for y := 0 to pred(Dst.Height) do
begin
xP := 0;
SrcLine1 := Src.ScanLine[yP shr 16];
if (yP shr 16 < pred(Src.Height)) then
SrcLine2 := Src.ScanLine[succ(yP shr 16)]
else
SrcLine2 := Src.ScanLine[yP shr 16];
z2 := succ(yP and $FFFF);
iz2 := succ((not yp) and $FFFF);
for x := 0 to pred(Dst.Width) do
begin
t3 := xP shr 16;
z := xP and $FFFF;
w2 := MulDiv(z, iz2, $10000);
w1 := iz2 - w2;
w4 := MulDiv(z, z2, $10000);
w3 := z2 - w4;
DstLine[x].rgbtRed := (SrcLine1[t3].rgbtRed * w1 +
SrcLine1[t3 + 1].rgbtRed * w2 +
SrcLine2[t3].rgbtRed * w3 + SrcLine2[t3 + 1].rgbtRed * w4) shr 16;
DstLine[x].rgbtGreen :=
(SrcLine1[t3].rgbtGreen * w1 + SrcLine1[t3 + 1].rgbtGreen * w2 +
SrcLine2[t3].rgbtGreen * w3 + SrcLine2[t3 + 1].rgbtGreen * w4) shr 16;
DstLine[x].rgbtBlue := (SrcLine1[t3].rgbtBlue * w1 +
SrcLine1[t3 + 1].rgbtBlue * w2 +
SrcLine2[t3].rgbtBlue * w3 +
SrcLine2[t3 + 1].rgbtBlue * w4) shr 16;
Inc(xP, xP2);
end;
Inc(yP, yP2);
DstLine := pRGBArray(Integer(DstLine) + DstGap);
end;
end;
end;
procedure ResizeImage(Src, Dst: TBitmap);
type
TRGBArray = array[Word] of TRGBTriple;
pRGBArray = ^TRGBArray;
var
x, y: Integer;
xP, yP: Integer;
xP2, yP2: Integer;
SrcLine1, SrcLine2: pRGBArray;
t3: Integer;
z, z2, iz2: Integer;
DstLine: pRGBArray;
DstGap: Integer;
w1, w2, w3, w4: Integer;
begin
Src.PixelFormat := pf24Bit;
Dst.PixelFormat := pf24Bit;
if (Src.Width = Dst.Width) and (Src.Height = Dst.Height) then
Dst.Assign(Src)
else
begin
DstLine := Dst.ScanLine[0];
DstGap := Integer(Dst.ScanLine[1]) - Integer(DstLine);
xP2 := MulDiv(pred(Src.Width), $10000, Dst.Width);
yP2 := MulDiv(pred(Src.Height), $10000, Dst.Height);
yP := 0;
for y := 0 to pred(Dst.Height) do
begin
xP := 0;
SrcLine1 := Src.ScanLine[yP shr 16];
if (yP shr 16 < pred(Src.Height)) then
SrcLine2 := Src.ScanLine[succ(yP shr 16)]
else
SrcLine2 := Src.ScanLine[yP shr 16];
z2 := succ(yP and $FFFF);
iz2 := succ((not yp) and $FFFF);
for x := 0 to pred(Dst.Width) do
begin
t3 := xP shr 16;
z := xP and $FFFF;
w2 := MulDiv(z, iz2, $10000);
w1 := iz2 - w2;
w4 := MulDiv(z, z2, $10000);
w3 := z2 - w4;
DstLine[x].rgbtRed := (SrcLine1[t3].rgbtRed * w1 +
SrcLine1[t3 + 1].rgbtRed * w2 +
SrcLine2[t3].rgbtRed * w3 + SrcLine2[t3 + 1].rgbtRed * w4) shr 16;
DstLine[x].rgbtGreen :=
(SrcLine1[t3].rgbtGreen * w1 + SrcLine1[t3 + 1].rgbtGreen * w2 +
SrcLine2[t3].rgbtGreen * w3 + SrcLine2[t3 + 1].rgbtGreen * w4) shr 16;
DstLine[x].rgbtBlue := (SrcLine1[t3].rgbtBlue * w1 +
SrcLine1[t3 + 1].rgbtBlue * w2 +
SrcLine2[t3].rgbtBlue * w3 +
SrcLine2[t3 + 1].rgbtBlue * w4) shr 16;
Inc(xP, xP2);
end;
Inc(yP, yP2);
DstLine := pRGBArray(Integer(DstLine) + DstGap);
end;
end;
end;
1 komentar:
gan ada codingya buat merubah skala gambar,,
contohnya, skala awal 200x200 trus diubah menjadi 30x30 gitu
sebelumnya terimaksih
Posting Komentar