type
TRGBArray =
array[0..32767]
of TRGBTriple;
PRGBArray = ^TRGBArray;
type
TfrmMain =
class(TForm)
...
private
{ Private-Deklarationen }
HG: TBitmap;
FRegion: THandle;
function CreateRegion(Bmp: TBitmap): THandle;
public
...
end;
implementation
function TfrmMain.CreateRegion(Bmp: TBitmap): THandle;
var
X, Y, StartX: Integer;
Excl: THandle;
Row: PRGBArray;
TransparentColor: TRGBTriple;
begin
Bmp.PixelFormat := pf24Bit;
Result := CreateRectRGN(0, 0, Bmp.Width, Bmp.Height);
for Y := 0
to Bmp.Height - 1
do
begin
Row := Bmp.Scanline[Y];
StartX := -1;
if Y = 0
then
TransparentColor := Row[0];
for X := 0
to Bmp.Width - 1
do
begin
if (Row[X].rgbtRed = TransparentColor.rgbtRed)
and
(Row[X].rgbtGreen = TransparentColor.rgbtGreen)
and
(Row[X].rgbtBlue = TransparentColor.rgbtBlue)
then
begin
if StartX = -1
then StartX := X;
end
else
begin
if StartX > -1
then
begin
Excl := CreateRectRGN(StartX, Y, X + 1, Y + 1);
try
CombineRGN(Result, Result, Excl, RGN_DIFF);
StartX := -1;
finally
DeleteObject(Excl);
end;
end;
end;
end;
if StartX > -1
then
begin
Excl := CreateRectRGN(StartX, Y, Bmp.Width, Y + 1);
try
CombineRGN(Result, Result, Excl, RGN_DIFF);
finally
DeleteObject(Excl);
end;
end;
end;
end;
//Borderstyle muss bsNone sein
procedure TfrmMain.FormCreate(Sender: TObject);
var Bmp: TBitmap;
begin
HG:=TBitmap.Create;
HG.LoadFromFile(ResPath+'
Monitor.bmp');
Bmp := TBitmap.Create;
try
bmp.Assign(HG);
Width:=HG.Width;
ClientHeight:=HG.Height;
FRegion := CreateRegion(Bmp);
SetWindowRGN(
Handle, FRegion, True);
finally
Bmp.Free;
end;
...
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
DeleteObject(FRegion);
HG.Free;
end;
procedure TfrmMain.FormPaint(Sender: TObject);
begin
BitBlt(canvas.handle, 0, 0, Clientwidth, Clientheight,HG.Canvas.handle, 0, 0, SRCCOPY);
end;