Вот и пример (не помню правда чей)
| Код |
unit UnitMain;
interface
uses
Windows, Messages, Graphics, Controls, Forms, ExtCtrls, Classes;
type
TFormMain = class(TForm)
ImageFormMain: TImage;
Timer: TTimer;
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure TimerTimer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FormMain: TFormMain;
R: HRgn;
implementation
{$R *.dfm}
procedure TFormMain.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
If ssLeft In Shift Then
Begin
ReleaseCapture;
SendMessage(Handle,WM_NCLBUTTONDOWN,HTCAPTION,0);
End;
end;
procedure TFormMain.FormCreate(Sender: TObject);
Var
X1,X,Y: Integer;
begin
X1 := -1;
R := CreateRectRgn(0,0,0,0);
ImageFormMain.Picture.LoadFromFile('1.bmp');
FormMain.BorderStyle := bsNone;
FormMain.Height := ImageFormMain.Picture.Bitmap.Height;
FormMain.Width := ImageFormMain.Picture.Bitmap.Width;
With ImageFormMain.Picture.Bitmap Do
For Y := 0 To Height-1 Do
For X := 0 To Width-1 Do
If Canvas.Pixels[X,Y] <> Canvas.Pixels[0,0] Then
Begin If X1=-1 Then X1 := X; End
Else
If X1>-1 Then
Begin
CombineRgn(R,R,CreateRectRgn(X1,Y,X-1,Y+1),RGN_OR);
X1 := -1;
End;
SetWindowRgn(Handle, R, True);
SetWindowLong(Handle, GWL_EXSTYLE, WS_EX_LAYERED);
end;
procedure TFormMain.TimerTimer(Sender: TObject);
begin
If Timer.Tag = 255 Then Timer.Tag := -255;
If Timer.Tag > 0 Then
SetLayeredWindowAttributes(Handle, 0, Timer.Tag, LWA_ALPHA)
Else
SetLayeredWindowAttributes(Handle, 0, -Timer.Tag, LWA_ALPHA);
Timer.Tag := Timer.Tag+1;
end;
end.
|
Изменения нужно произвести в строчке SetWindowRgn(Handle, R, True); - заменить Handle на дескриптор нужного окна. |
