Проблема при уменьшении изображения произвольного размера до размера 95x67. Изображение не уменьшается, а всё его содержимое исчезает (отсканированный текстовый документ), размер увеличивается с 700Kb до 17Mb. Пожалуйста, посмотрите что может быть не так в этом фрагменте исходного текста. Процедуру procedure StretchCoolW(x, y, Width, Height : Integer; Rect : TRect; var S, D : TBitmap); для уменьшения изображения я взял из http://forum.vingrad.ru/index.php?showtopic=33117, и вроде бы она должна работать нормально. Может быть не так использую?
| Код |
unit IODU4;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ComCtrls, ExtCtrls, Mask, Dialogs, DBCtrls, ExtDlgs, IBServices,
DB, IBCustomDataSet, IBTable, JPEG, Math;
type
TRGB=record
r:byte;
g:byte;
b:byte;
end;
ARGB=array [0..1] of TRGB;
PARGB=^ARGB;
PRGB = ^TRGB;
...
var
AddInDocForm: TAddInDocForm;
bmpb, bmpt: Graphics.TBitmap;
...
procedure TAddInDocForm.StretchCoolW(x, y, Width, Height : Integer; Rect : TRect; var S, D : TBitmap);
var
i,j,k,p,Sheight1:integer;
p1: pargb;
col,r,g,b : integer;
Sh, Sw : Extended;
Xp : array of PARGB;
begin
s.PixelFormat:=pf24bit;
d.PixelFormat:=pf24bit;
if width+x>d.Width then
d.Width:=width+x;
if Height+y>d.Height then
d.Height:=height+y;
Sw:=(Rect.Right-Rect.Left)/width;
Sh:=(Rect.Bottom-Rect.Top)/height;
Sheight1:=(Rect.Bottom-Rect.Top)-1;
SetLength(Xp,S.height);
for i:=0 to S.height-1 do
Xp[i]:=s.ScanLine[i];
for i:=y to height+y-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-y)) to Min(S.Height-1-Rect.Top,Round(Sh*(i+1-y))-1) do
begin
for p:=Round(Sw*j) to Min(Round(Sw*(j+1))-1,S.Width-1-Rect.Left) do
begin
inc(col);
inc(r,Xp[k+Rect.Top,p+Rect.Left].r);
inc(g,Xp[k+Rect.Top,p+Rect.Left].g);
inc(b,Xp[k+Rect.Top,p+Rect.Left].b);
end;
end;
if col<>0 then
begin
p1[j+x].r:=r div col;
p1[j+x].g:=g div col;
p1[j+x].b:=b div col;
end;
end;
end;
end;
procedure TAddInDocForm.OKBtnClick(Sender: TObject);
var
W, H: Integer;
begin
...
begin
IODocsDataModule.INDOCSIBTable.fieldbyname('IMAGEFNAME').AsString := AddInImgEdit.Text;
W:= bmpb.Width;
H:= bmpb.Height;
bmpt := Graphics.TBitmap.Create;
StretchCoolW(0,0,W,H,rect(0,0,95,67),bmpb,bmpt);
(IODocsDataModule.INDOCSIBTableIMAGE as TBlobField).Assign(bmpt);
end;
...
MainForm.Tag := 1;
IODocsDataModule.INDOCSIBTable.Post;
AddInDocForm.Close;
end;
end;
|
|
