| Код |
...
type
TRGB=record
r:byte;
g:byte;
b:byte;
end;
ARGB=array [0..1] of TRGB;
PARGB=^ARGB;
PRGB = ^TRGB;
...
procedure StretchCool(Width, Height : integer; var S,D : TBitmap); StdCall
var
i, j, k, p : Integer;
p1 : PARGB;
col, r, g, b, Sheight1 : integer;
Sh, Sw : Extended;
Xp : array of PARGB;
begin
If Width=0 then exit;
If Height=0 then exit;
S.PixelFormat:=pf24bit;
D.PixelFormat:=pf24bit;
D.Width:=Width;
D.Height:=Height;
Sh:=S.height/height;
Sw:=S.width/width;
Sheight1:=S.height-1;
SetLength(Xp,S.height);
for i:=0 to Sheight1 do
Xp[i]:=s.ScanLine[i];
for i:=0 to Height-1 do
begin
p1:=D.ScanLine[i];
for j:=0 to Width-1 do
begin
col:=0;
r:=0;
g:=0;
b:=0;
for k:=Round(Sh*i) to Min(Round(Sh*(i+1))-1,Sheight1) do
begin
for p:=Round(Sw*j) to Min(Round(Sw*(j+1))-1,S.Width-1) do
begin
inc(col);
inc(r,Xp[k,p].r);
inc(g,Xp[k,p].g);
inc(b,Xp[k,p].b);
end;
end;
if col<>0 then
begin
p1[j].r:=r div col;
p1[j].g:=g div col;
p1[j].b:=b div col;
end;
end;
end;
end;
...
|
Импортирую её из DLL| Код |
procedure StretchCool(Width, Height : integer; var S,D : TBitmap); StdCall; external 'lib.dll';
|
|
