Function SmartShrinkBitmap0(PBitmap: TBitMap; Scale: Double): Boolean;
var
Out_X, Out_Y: Integer;
Source_X, Source_Y: Integer;
ScanImageBox: TRect;
ShrinkImageLine: PByteArray;
SourceImageLine: PByteArray;
ScaleF: Double;
PixCount: Integer;
Local_Red, Local_Green, Local_Blue: Integer;
Local_Scr_X, local_dest_X: Integer;
SourceBitmap: TBitMap;
begin
Result := False;
// no work to to ....
if not assigned(PBitmap)
or (Scale > 1)
or (Scale < 0)
or (PBitmap.Width < 2)
or (PBitmap.Height < 2)
then
exit;
if Scale = 1
then
begin
exit;
end;
if Scale = 0
then
begin
PBitmap.Width := 0;
PBitmap.Height := 0;
exit;
end;
ScaleF := 1 / Scale;
// Daten von PBitMap in new SourceBitmap Kopieren
SourceBitmap := TBitMap.Create;
SourceBitmap.PixelFormat := pf24bit;
SourceBitmap.Assign(PBitmap);
// set values for new out bitmap
PBitmap.Width := round(SourceBitmap.Width * Scale);
PBitmap.Height := round(SourceBitmap.Height * Scale);
PBitmap.PixelFormat := pf24bit;
try // try...finally
try // try...except
// for each pixel in new OutBitmap do...
for Out_Y := 0
to PBitmap.Height - 1
do
begin
ShrinkImageLine := PBitmap.Scanline[Out_Y];
for Out_X := 0
to PBitmap.Width - 1
do
begin
ScanImageBox.Left := trunc(Out_X * ScaleF);
ScanImageBox.Top := trunc(Out_Y * ScaleF);
ScanImageBox.Right := trunc((Out_X + 1) * ScaleF);
ScanImageBox.Bottom := trunc((Out_Y + 1) * ScaleF);
Local_Red := 0;
Local_Green := 0;
Local_Blue := 0;
PixCount := 0;
for Source_Y := ScanImageBox.Top
to ScanImageBox.Bottom - 1
do
begin
SourceImageLine := SourceBitmap.Scanline[Source_Y];
for Source_X := ScanImageBox.Left
to ScanImageBox.Right - 1
do
begin
/// hier entsteht die AV ???
[B]
Local_Scr_X := Source_X * 3;
inc(Local_Red, SourceImageLine[Local_Scr_X]);
[/B]
inc(Local_Green, SourceImageLine[Local_Scr_X + 1]);
inc(Local_Blue, SourceImageLine[Local_Scr_X + 2]);
inc(PixCount);
end;
end;
local_dest_X := Out_X * 3;
If local_dest_X > 32000
then
Raise Exception.CreateFmt('
Variable LDX to high ...(%d)', [local_dest_X]);
// Raise Exception.Create ('Variable LDX to high ...('+ inttostr (LDX)+')');
ShrinkImageLine[local_dest_X] := Local_Red
div PixCount;
ShrinkImageLine[local_dest_X + 1] := Local_Green
div PixCount;
ShrinkImageLine[local_dest_X + 2] := Local_Blue
div PixCount;
end;
end;
Result := True;
except
// If the code produces an Exception ....
on E:
Exception do
// {--Only for debuging reasons }
ShowMessageFmt(E.ClassName + '
error raised, with message : ' +
E.
Message + #13#10 + '
Variables values:' + #13#10 +
'
out_X=' + Inttostr(Out_X) + '
, ' + '
out_Y=' + Inttostr(Out_Y) + #13#10 +
'
src_x=' + Inttostr(Source_X) + '
, ' + '
src_Y=' + Inttostr(Source_Y) + #13#10 +
'
ScanBOX.TOP=' + Inttostr(ScanImageBox.TOP) + #13#10 +
'
ScanBOX.LEFT=' + Inttostr(ScanImageBox.LEFT) + #13#10 +
'
ScanBOX.RIGHT=' + Inttostr(ScanImageBox.Right) + #13#10 +
'
ScanBOX.BOTTOM=' + Inttostr(ScanImageBox.Bottom) + #13#10 +
'
LDX=' + Inttostr(local_dest_X) + #13#10 +
'
LSX=' + Inttostr(Local_Scr_X) + #13#10 +
'
PBitmap=%p, OutBitmap=%p' + '
DLine=%p, Dimensions=' + #13#10 +
'
Inbmp Size ' + Inttostr(SourceBitmap.Height) + '
x' + Inttostr(SourceBitmap.Width)+ '
pixel' + #13#10 +
'
Outbmp Size ' + Inttostr(PBitmap.Height) + '
x' + Inttostr(PBitmap.Width)+ '
pixel' + #13#10 +
'
Scale :' + Floattostr(Scale) +
'
ScaleF:' + Floattostr(ScaleF),
[SourceBitmap.Scanline[0], PBitmap.Scanline[0], ShrinkImageLine]);
end;
// Try...except...end;
finally
SourceBitmap.free;
end;
// Try...finally...end;
end;