type TIcon=Class
Constructor Create(aWidth,aHeight,aBitsPerPixel:Integer);
Destructor Destroy;
override;
private
FPixels:Pointer;
FBitsperPixel:Integer;
FTransparentcolor:Cardinal;
FWidth:Integer;
FHeight:Integer;
procedure PutPixel(x,y:Integer; Color:Cardinal);
function GetPixel(x,y:Integer):Cardinal;
public
property Width:Integer
read FWidth;
property Height:Integer
read FHeight;
property Transparentcolor:Cardinal
read FTransparentcolor
write FTransparentcolor;
property Pixel[x,y:Integer]:Cardinal
read getPixel
write PutPixel;
function GetIconCopy:HIcon;
end;
implementation
{ TIcon }
function TIcon.GetIconCopy: HIcon;
var mask,pos:PByte;
i,a:Integer;
len:Integer;
begin
len:=(FWidth*FHeight)
div 8+1;
getmem(mask,len);
fillchar(mask^,len,0);
pos:=mask;
try
a:=7;
for i:=0
to (FWidth*FHeight)-1
do
begin
if Pixel[i
mod FWidth,i
div FWidth]=transparentcolor
then
pos^:=pos^
or (1
shl a);
dec(a);
if a<0
then
begin
a:=7;
inc(pos);
end;
end;
result:=CreateIcon(hInstance,FWidth,fHeight,1,FBitsPerPixel,mask,FPixels);
finally
freemem(mask);
end;
end;
function TIcon.GetPixel(x, y: Integer): Cardinal;
var pos:Integer;
pb:PByte;
i:Integer;
bit:Integer;
begin
result:=0;
if (x>=0)
and(x<FWidth)
and(y>=0)
and(y<fHEight)
then
begin
pos:=y*FWidth+x;
pb:=pointer(integer(FPixels)+Fbitsperpixel*pos
div 8);
bit:=Fbitsperpixel*pos
mod 8;
for i:=0
to FBitsperPixel-1
do
begin
if pb^
and (1
shl bit)>0
then
result:=result
or (1
shl i);
inc(bit);
if bit=8
then
begin
bit:=0;
inc(pb);
end;
end;
end;
end;
procedure TIcon.PutPixel(x, y: Integer; Color: Cardinal);
var pos:Integer;
Pb:PByte;
bit:Integer;
i:Integer;
begin
if (x>=0)
and(x<FWidth)
and(y>=0)
and(y<fHEight)
then
begin
pos:=y*FWidth+x;
pb:=pointer(integer(FPixels)+Fbitsperpixel*pos
div 8);
bit:=Fbitsperpixel*pos
mod 8;
for i:=0
to FBitsperPixel-1
do
begin
if Color
and (1
shl i) = 0
then
pb^:=pb^
and (255-(1
shl bit))
else
pb^:=pb^
or (1
shl bit);
inc(bit);
if bit=8
then
begin
bit:=0;
inc(pb);
end;
end;
end;
end;