//...
function TForm1.SetWndRegionFromImg(Bmp: TBitmap; TransparentColor: TColor): Boolean;
type
TTransColState = (trsOn, trsOff);
TRGBQuadArray =
array[WORD]
of Cardinal;
pRGBQuadArray = ^TRGBQuadArray;
var
TransColState: TTransColState;
x, y: Integer;
line: Integer;
count: Integer;
rgn, nrgn: THandle;
pPixelArray: pRGBQuadArray;
begin
Result := TRUE;
if Bmp.PixelFormat <> pf32Bit
then
Bmp.PixelFormat := pf32Bit;
count := 0;
line := 0;
rgn := CreateRectRGN(0, 0, 0, 0);
// First Init Region
nrgn := rgn;
for y := 0
to Bmp.Height - 1
do
begin
pPixelArray := Bmp.Scanline[y];
TransColState := trsOff;
for x := 0
to Bmp.Width - 1
do
begin
if pPixelArray[x] <> COLORREF(TransparentColor)
then
begin
if TransColState = trsOff
then
begin
TransColState := trsOn;
line := x - 1;
inc(line);
end;
end else
begin
if TransColState = trsOn
then
begin
TransColState := trsOff;
if count < 4096
then
begin
nrgn := CreateRectRgn(line, y, x, y + 1);
CombineRgn(Rgn, Rgn, nRgn, RGN_OR);
inc(Count);
end else
begin
ShowMessage('
Debuginfo: To many Regions. Count of Rgn: '#9 + IntToStr(Count));
Application.Terminate;
end;
end;
end;
end;
end;
SetWindowRgn(
Handle, Rgn, TRUE);
DeleteObject(Rgn);
DeleteObject(nRgn);
end;
procedure TForm1.FormCreate(Sender: TObject);
const
LWA_COLORKEY = 1;
// Use crKey as the transparency color.
LWA_ALPHA = 2;
// Use bAlpha to determine the opacity of the layered window..
USER32DLL = '
user32.dll';
var
_SetLayeredWindowAttributes:
function(hWnd: THandle; TRansparentColor: COLORREF;
AlphaValue: Byte; Flags: Cardinal): BOOL;
stdcall;
var
hLib: THandle;
begin
Self.Color := clFuchsia;
Self.BorderStyle := bsNone;
if not (Image1.Picture.Graphic
is TBitmap)
then
begin
ShowMessage('
Fehler: Image muss ein Bitmap sein !');
Application.Terminate;
end;
hLib := LoadLibrary(USER32DLL);
@_SetLayeredWindowAttributes := GetProcAddress(hLib, '
SetLayeredWindowAttributes');
if @_SetLayeredWindowAttributes <>
nil then
begin
SetWindowLong(
Handle, GWL_EXSTYLE, GetWindowLong(
Handle, GWL_EXSTYLE)
or WS_EX_LAYERED);
_SetLayeredWindowAttributes(Self.Handle, COLORREF(clFuchsia), 250, LWA_COLORKEY
or LWA_ALPHA);
end
else
begin
// alternative, im falle das es SetLayeredWindowAttributes nicht gibt
SetWndRegionFromImg(Image1.Picture.Bitmap, clFuchsia);
end;
FreeLibrary(hLib);
end;
//...