<GRIN> 
I figured that would be your next question.
Here is some beta code to do just that. I have not tested the functions very much yet. Note that the function Bitmap24UnusedColor only works for 24-bit bitmaps. I am hopeing that this will work most of the time for ImageEn because usually ImageEn stores the bitmaps as 24-bit. If not I have no solution for other bitdepths at this time.
b]function IsColorInBitmap(AImageEnView: TImageEnView; AColor: TColor): boolean;
{ Return True if AColor is contained in the AImageEnView.IEBitmap or False if not. }
var
i: integer;
j: integer;
iColor: TColor;
iRGB: TRGB;
begin
for i := 0 to AImageEnView.IEBitmap.Width - 1 do
for j := 0 to AImageEnView.IEBitmap.Height - 1 do
begin
iRGB := AImageEnView.IEBitmap.Pixels[0, AImageEnView.IEBitmap.Height - 1];
iColor := TRGB2TColor(iRGB);
if iColor = AColor then
Result := True
else
Result := False;
end;
end;
function Bitmap24UnusedColor(const ABitmap: TBitmap): TColor;
{ Return a unused color or -1 if all colors are used. }
var
BitArray: Pointer;
p: integer;
ma: PByte;
mb: integer;
mc: integer;
md: PByte;
na: integer;
nb: integer;
nba: PByte;
nbb: integer;
oaa: PByte;
oab: integer;
ob, oc: integer;
o: integer;
begin
{$IFDEF DEBUG}
if ABitmap.PixelFormat <> pf24bit then
raise Exception.Create('Intended only for 24bit bitmaps');
{$ENDIF}
GetMem(BitArray, 8192);
{ p is the 'given' B value }
for p := 0 to 255 do
begin
ZeroMemory(BitArray, 8192);
{ m is used to scan through the bitmap scanlines }
ma := ABitmap.Scanline[0];
mb := integer(ABitmap.Scanline[1]) - integer(ABitmap.Scanline[0]);
for mc := 0 to ABitmap.Height - 1 do
begin
md := ma;
{ n is used to scan through the scanline's pixels }
for na := 0 to ABitmap.Width - 1 do
begin
if md^ = p then
begin
Inc(md);
nb := (md^ shl 8);
Inc(md);
nb := (nb or md^);
Inc(md);
{ splitting up the 16bit value into a bit array index consisting of byte pointer and bit mask }
nba := PByte(Cardinal(BitArray) + Cardinal(nb shr 3));
nbb := (128 shr (nb and 7));
{ and making sure appropriate bit is set }
nba^ := (nba^ or nbb);
end
else
Inc(md, 3);
end;
Inc(ma, mb);
end;
oaa := BitArray;
for oab := 0 to 8191 do
begin
if oaa^ <> 255 then
begin
ob := 0;
oc := 128;
while True do
begin
if (oaa^ and oc) = 0 then
break;
Inc(ob);
oc := (oc shr 1);
end;
{ making complete 16bit value }
o := ((oab shl 3) or ob);
{ that's it }
FreeMem(BitArray, 8192);
Result := RGB((o and 255), (o shr 8), p);
exit;
end;
Inc(oaa);
end;
end;
FreeMem(BitArray, 8192);
Result := TColor(-1);
end;
procedure TForm1.RoundCorners1Click(Sender: TObject);
var
iColor1: TColor;
iColor2: TColor;
iRGB: TRGB;
begin
iColor1 := clBlack;
if not IsColorInBitmap(ImageEnView1, iColor1) then
else
begin
MessageBox(0, PChar(ColorToString(iColor1) + ' is in the bitmap.'), 'Warning', MB_ICONWARNING
or
MB_OK);
iColor2 := Bitmap24UnusedColor(ImageEnView1.Bitmap);
MessageBox(0, PChar('Replacing ' + ColorToString(iColor1) + ' with ' + ColorToString(iColor2) +
'.'), 'Warning', MB_ICONWARNING or
MB_OK);
end;
if iColor2 = -1 then
begin
MessageBox(0, 'All colors are used', 'Warning', MB_ICONWARNING or MB_OK);
exit;
end;
ImageEnView1.Proc.RoundImage(20, 20);
ImageEnView1.IO.Params.BitsPerSample := 8;
ImageEnView1.IO.Params.SamplesPerPixel := 4;
iRGB := TColor2TRGB(iColor2);
ImageEnView1.Proc.SetTransparentColors(iRGB, iRGB, 0);
ImageEnView1.Height := ImageEnView1.Height + 23;
ImageEnView1.Width := ImageEnView1.Width + 23;
ImageEnView1.ScrollBars := ssNone;
ImageEnView1.Proc.AddSoftShadow(4, 4, 4, True, clBlack, 100);
ImageEnView1.Bitmap.Modified := True;
ImageEnView1.Update;
end[/b];
William Miller
Adirondack Software & Graphics
Email: w2m@frontiernet.net
EBook: http://www.imageen.com/ebook/
Apprehend: http://www.frontiernet.net/~w2m/index.html
Search
Ugly holes from RoundCorners algorithm
Posted - May 26 2013 : 14:29:57
