[Винды]Прозрачно/Не прозрачно при наведении/убирании курсора с окна

[Человек_Борща]

Всем добнрого времени суток!

Вопрос таков:
Как реализовать прозрачность в программе?

интересует:
Плавное появление и скрытие окна.
Показ окна(влавно) при наведению мыши и скрытие окна(плавно) при убирании курсора с окна.


Про AlphaBlend известно, как реализовать интересуещее..

[BuT@JL]

procedure TForm1.FormDeactivate(Sender: TObject);
begin
ReleaseCapture;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if GetCapture = 0 then
    SetCapture(Form1.Handle);
  if PtInRect(Rect(Form1.Left,Form1.Top, Form1.Left + Form1.Width, Form1.Top + Form1.Height), ClientToScreen(Point(x, y))) then
    begin
    timer1.Enabled:=true;
    timer2.Enabled:=false;
    end
  else
    begin
    timer1.Enabled:=false;
    timer2.Enabled:=true;
    end
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if alphablendvalue<255 then alphablendvalue:=alphablendvalue+1;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
if alphablendvalue>1 then alphablendvalue:=alphablendvalue-1;
end;

end.

[asmodey1]

То BuT@JL - что-то вы намудрили, да и вообще не то предложили...
Делаем так:

type
TForm1 = class(TForm)
private
procedure CMMOUSEENTER(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMOUSELEAVE(var Message: TMessage); message CM_MOUSELEAVE;
public
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.CMMOUSEENTER;
begin
while AlphaBlendValue<255 do
begin
AlphaBlendValue:=AlphaBlendValue+1;
Application.ProcessMessages;
end;
end;

procedure TForm1.CMMOUSELEAVE;
begin
while AlphaBlendValue>1 do
begin
AlphaBlendValue:=AlphaBlendValue-1;
Application.ProcessMessages;
end;
end;

[ArtGrek]

на половину поддерживаю asmodey1

procedure TForm1.CMMOUSEENTER;
begin
while AlphaBlendValue<255 do
begin
AlphaBlendValue:=AlphaBlendValue+1;
Application.ProcessMessages;
end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if (Mouse.CursorPos.X < Left + 10) or (Mouse.CursorPos.X > Left + Width - 10) or
    (Mouse.CursorPos.Y < Top + 10) or (Mouse.CursorPos.Y > Top + Height - 10) then
    while AlphaBlendValue>2 do
    begin
      AlphaBlendValue:=AlphaBlendValue-1;
      Application.ProcessMessages;
    end;
end;

[x128]

uses Math;

const
  a_min=80;
  a_max=240;
  a_step=4;

...

procedure TForm1.FormCreate(Sender: TObject);
begin
  AlphaBlend:=true;
  AlphaBlendValue:=a_min;
  Timer1.Interval:=1;
  Timer1.Enabled:=false;
end;

procedure TForm1.FormMouseEnter(Sender: TObject);
begin
  with Timer1 do begin
    Tag:=1;
    Enabled:=true;
  end;
end;

procedure TForm1.FormMouseLeave(Sender: TObject);
begin
  with Timer1 do begin
    Tag:=-1;
    Enabled:=true;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  AlphaBlendValue:=EnsureRange(AlphaBlendValue+(Timer1.Tag*a_step), a_min, a_max);
  if (AlphaBlendValue=a_min) or (AlphaBlendValue=a_max) then Timer1.Enabled:=false;
end;

[ArtGrek]

x128

procedure TForm1.FormMouseLeave(Sender: TObject);

а что надо зделать что б выполнилась ета процедура?

[x128]

В событиях формы даблкликнуть по OnMouseLeave, если старая делфи, тогда сделать свой обработчик как писал asmodey1.

для делфи 7

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Image1: TImage;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    procedure MouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure MouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

const
  a_min=80;
  a_max=240;
  a_step=4;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  AlphaBlend:=true;
  AlphaBlendValue:=a_min;
  Timer1.Interval:=1;
  Timer1.Enabled:=false;
end;

procedure TForm1.MouseEnter(var Message: TMessage);
begin
  with Timer1 do begin
    Tag:=1;
    Enabled:=true;
  end;
end;

procedure TForm1.MouseLeave(var Message: TMessage);
begin
  with Timer1 do begin
    Tag:=-1;
    Enabled:=true;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  AlphaBlendValue:=EnsureRange(AlphaBlendValue+(Timer1.Tag*a_step), a_min, a_max);
  if (AlphaBlendValue=a_min) or (AlphaBlendValue=a_max) then Timer1.Enabled:=false;
end;

[ArtGrek]

а в какои ето версии, я просто первое что подумал ето такои вариант, но у меня нет етого
а разве ето событие происходит если убрать с формы мышь, но окно при етом будет активно

[x128]

Событие MouseEnter приходит когда курсор попадает на клиентскую область окна (даже если окно не активно), MouseLeave соответственно, когда курсор уходит. В старых версиях делфи <=7 в менеджере событий их нет, во всех более новых есть.

[ArtGrek]

а зачем тогда таимер, вот то что сказал asmodey1 ток в ети события, на Д2009,
на Д7 у меня не работает Leave, даже вариант asmodey1

procedure TForm1.FormMouseEnter(Sender: TObject);
begin
  while AlphaBlendValue<255 do
  begin
    AlphaBlendValue:=AlphaBlendValue+1;
    Application.ProcessMessages;
  end;
end;

procedure TForm1.FormMouseLeave(Sender: TObject);
begin
  while AlphaBlendValue>2 do
  begin
    AlphaBlendValue:=AlphaBlendValue-1;
    Application.ProcessMessages;
  end;
end;