type
TTransClickMask =
class(TCustomControl)
private
FImage: TImage;
FPicture: TPicture;
procedure SetPicture(Value: TPicture);
procedure MakeTransparent;
// procedure DestroyTransparency;
procedure PictureChanged(Sender: TObject);
protected
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
override;
published
property Picture: TPicture
read FPicture
write SetPicture;
end;
{ TTransClickMask ... BETA }
constructor TTransClickMask.Create(AOwner: TComponent);
begin
inherited;
FImage := TImage.Create(Self);
FImage.Parent := Self;
FImage.AutoSize := true;
FPicture := TPicture.Create;
FPicture.OnChange := PictureChanged;
FImage.Picture.Assign(FPicture);
end;
destructor TTransClickMask.Destroy;
begin
FPicture.Free;
FImage.Free;
inherited;
end;
(* procedure TTransClickMask.DestroyTransparency;
var
Rgn: THandle;
begin
Rgn := CreateRectRgn(0, 0, Width, Height);
SetWindowRgn(Handle, Rgn, true);
DeleteObject(Rgn);
end; *)
procedure TTransClickMask.MakeTransparent;
var
x,y : integer;
rgn1,
rgn2 : hrgn;
startx,endx : integer;
begin
// Code entnommen aus der Demo von TCoolForm, mit einem Bugfix
// for every line do...
rgn1 := 0;
for y := 0
to FImage.Picture.BitMap.Height-1
do
begin
x := -1;
repeat
// look for the beginning of a stretch of non-transparent pixels
while (FImage.Picture.bitmap.canvas.pixels[x,y] = $00FFFFFF)
and (x = FImage.Picture.BitMap.width)
do
begin
inc(x);
end;
startx := x;
// look for the end of a stretch of non-transparent pixels
inc(x);
while (FImage.Picture.bitmap.canvas.pixels[x,y]<>$00FFFFFF)
and (x<
(*=*)FImage.Picture.BitMap.width)
do
begin
inc(x);
end;
endx := x;
// do we have some pixels?
if startx <> FImage.Picture.BitMap.Width
then
begin
// do we have a region already?
if rgn1 = 0
then
begin
// Create a region to start with
rgn1 := CreateRectRgn(startx+1,y,endx,y+1);
end else
begin
// Add to the existing region
rgn2 := CreateRectRgn(startx+1, y, endx, y+1);
if rgn2 <> 0
then CombineRgn(rgn1, rgn1, rgn2, RGN_OR);
DeleteObject(rgn2);
end;
end;
until x >= FImage.Picture.BitMap.width - 1;
end;
SetWindowRgn(
Handle, Rgn1, true);
DeleteObject(Rgn1);
end;
procedure TTransClickMask.PictureChanged(Sender: TObject);
begin
// DestroyTransparency;
FImage.Picture.Assign(FPicture);
Width := FPicture.Width;
Height := FPicture.Height;
MakeTransparent;
end;
procedure TTransClickMask.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
if AWidth <> FPicture.Width
then AWidth := FPicture.Width;
if AHeight <> FPicture.Height
then AHeight := FPicture.Height;
inherited;
end;
procedure TTransClickMask.SetPicture(Value: TPicture);
begin
FPicture.Assign(Value);
end;