This function is useful to obtain number of system colors currently available
function GetSysColorsNumber(Canvas: TCanvas): LongInt;
begin
Result := (LongInt(1) shl GetDeviceCaps(Canvas.Handle, BitsPixel))
*LongInt(GetDeviceCaps(Canvas.Handle, Planes));
end;
Author
Target
Keywords
Description
Paul van Dinther (paul@diprode.com)
D2/D3/D4/D5
Bitmap, Resize, Shrink
Fast Quality reduction of Bitmap size using the
Scanline system colors.
function Shrink(PBitmap: TBitmap; Scale: Double): TBitmap;
var
LBitmap: TBitmap;
DX, DY: Integer;
SX, SY: Integer;
SBox: TRect;
DLine: PByteArray;
SLine: PByteArray;
ScaleF: Double;
PixCount: Integer;
LR,LG,LB: Integer;
LSX, LDX: Integer;
begin
Result := nil;
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
Result := PBitmap;
Exit;
end;
if Scale = 0 then
begin
PBitmap.Width := 0;
PBitmap.Height := 0;
Result := PBitmap;
end;
ScaleF := 1 / Scale;
LBitmap := TBitmap.Create;
LBitmap.PixelFormat := pf24Bit;
LBitmap.Assign(PBitmap);
PBitmap.Width := round(LBitmap.Width * Scale);
PBitmap.Height := round(LBitmap.Height * Scale);
file://for each pixel in PBitmap do...
for DY := 0 to PBitmap.Height - 1 do
begin
DLine := PBitmap.ScanLine[DY];
for DX := 0 to PBitmap.Width - 1 do
begin
SBox.Left := trunc(DX * ScaleF);
SBox.Top := trunc(DY * ScaleF);
SBox.Right := trunc((DX + 1) * ScaleF);
SBox.Bottom := trunc((DY + 1) * ScaleF);
LR := 0;
LG := 0;
LB := 0;
PixCount := 0;
for SY := SBox.Top to SBox.Bottom - 1 do
begin
SLine := LBitmap.ScanLine[SY];
for SX := SBox.Left to SBox.Right - 1 do
begin
LSX := SX * 3;
inc(LR,SLine[LSX]);
inc(LG,SLine[LSX + 1]);
inc(LB,SLine[LSX + 2]);
inc(PixCount);
end;
end;
LDX := DX * 3;
DLine[LDX] := LR div PixCount;
DLine[LDX + 1] := LG div PixCount;
DLine[LDX + 2] := LB div PixCount;
LR := 0;
LG := 0;
LB := 0;
end;
end;
LBitmap.Free;
result := PBitmap;
end;
