Текущий архив: 2009.08.16;
Скачать: CL | DM;

Вниз

Как сделать прозрачным главное меню пуск?   Найти похожие ветки 

← →
Nikfel   (2009-06-20 20:40) [0]

Подскажите, пожалуйста. Как сделать прозрачность для меню пуск? Для панели задач и меню я делал так:

procedure TForm1.Timer1Timer(Sender: TObject);
var h:cardinal;
begin
h:=FindWindow("Shell_TrayWnd",nil);
SetWindowLong(h,GWL_EXSTYLE,GetWindowLong(h,GWL_EXSTYLE) or WS_EX_LAYERED);
SetLayeredWindowAttributes(h,0, 200, LWA_ALPHA);
h:=FindWindow("BaseBar",nil);
SetWindowLong(h,GWL_EXSTYLE,GetWindowLong(h,GWL_EXSTYLE) or WS_EX_LAYERED);
SetLayeredWindowAttributes(h,0, 200, LWA_ALPHA);
end;

Но вот с главным меню пуск такое не проходит. Пытался получить хандл так:
H:=FindWindow("Shell_TrayWnd",nil);
H:=FindWindowEx(H,0,"DV2ControlHost","Главное меню");
Но прозрачным меню всеравно не стало. Как осуществить такое? Заранее спасибо.

---

← →
AIK ©   (2009-06-21 08:51) [1]

А ты не пробовал проверить находит ли он твоё окно?

h:=FindWindow("Shell_TrayWnd",nil);
If h<>0 then
 // Значит находит

---

← →
AIK ©   (2009-06-21 08:56) [2]

Вот вариант только что придумал по книжке Фленова

Var
H: HWND;
old: longint;
x: Integer;
begin
x:= 100; // прозрачность от 0 до 255
h:=FindWindow("Shell_TrayWnd",nil);
If h<>0 then
 begin
  old:=GetWindowLongA(h,GWL_EXSTYLE);
  SetWindowLongA(h,GWL_EXSTYLE,old or $80000);
  SetLayeredWindowAttributes(h, 0, x, $2);
end;

---

← →
Nikfel   (2009-06-21 09:45) [3]

Ну это только панель задачь делает прозрачным, но вот с главным меню пуск, такое не проходит, даже если знаешь хандле.

---

← →
Nikfel   (2009-06-21 10:17) [4]

Разобрался как делать главное меню пуск прозрачным:

Var
H: HWND;
old: longint;
x: Integer;
begin
x:= 100; // прозрачность от 0 до 255
h:=FindWindow("DV2ControlHost",nil);
If h<>0 then
begin
 old:=GetWindowLongA(h,GWL_EXSTYLE);
 SetWindowLongA(h,GWL_EXSTYLE,old or $80000);
 SetLayeredWindowAttributes(h, 0, x, $2);
end;

У меня не получалось сделать из-за того что хандле не правильно получал. Сейчас вроде работает нормально.

Спасибо.

---

← →
CSS   (2009-06-21 11:29) [5]

У меня не становится прозрачным... :(

---

← →
Nikfel   (2009-06-21 11:48) [6]

Просто надо поместить это в таймер, а иначе не все будет прозрачным.
procedure transparent(H:hwnd; transparent:integer);
var old: longint;
begin
If h<>0 then
begin
old:=GetWindowLongA(h,GWL_EXSTYLE);
SetWindowLongA(h,GWL_EXSTYLE,old or $80000);
SetLayeredWindowAttributes(h, 0, transparent, $2);
end;
end;

procedure TForm1.Timer2Timer(Sender: PObj);
begin
transparent(FindWindow("DV2ControlHost",nil),255);
transparent(FindWindow("Shell_TrayWnd",nil),255);
transparent(FindWindow("BaseBar",nil),255);
end;

---

← →
AIK ©   (2009-06-21 13:36) [7]

Красива мигает
unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ExtCtrls;

type
 TForm1 = class(TForm)
   Button1: TButton;
   Timer1: TTimer;
   Button2: TButton;
   Button3: TButton;
   Button4: TButton;
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure Button3Click(Sender: TObject);
   procedure Button4Click(Sender: TObject);
   procedure Timer1Timer(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;
 x, y: integer;
implementation

{$R *.dfm}
procedure transparent(H:hwnd; transparent:integer);
var old: longint;
begin
If h<>0 then
begin
old:=GetWindowLongA(h,GWL_EXSTYLE);
SetWindowLongA(h,GWL_EXSTYLE,old or $80000);
SetLayeredWindowAttributes(h, 0, transparent, $2);
end;
end;

procedure TForm1.Button1Click(Sender: TObject); //Для Старт Стоп Таймера
Begin
If timer1.Enabled=true then
Timer1.Enabled:= false else
Timer1.Enabled:= true;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
X:= 255;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
transparent(FindWindow("DV2ControlHost",nil),x);
transparent(FindWindow("Shell_TrayWnd",nil),x);
transparent(FindWindow("BaseBar",nil),x);
If x>= 255 then y:=0 else
If x<=0 then y:=1;

 case y  of
  0:x:=x-5;
  1:x:=x+5;
 end;
end;

end.

---

← →
AIK ©   (2009-06-21 13:38) [8]

>  procedure Button3Click(Sender: TObject);
>  procedure Button4Click(Sender: TObject);


это лишнее

---

← →
юзер   (2009-06-21 21:10) [9]

If timer1.Enabled=true then
Timer1.Enabled:= false else
Timer1.Enabled:= true;

Ужас! Куда мир катится..

---

← →
Б   (2009-06-21 21:20) [10]

> Ужас! Куда мир катится..


Timer1.Enabled:= not Timer1.Enabled;

---

← →
CSS   (2009-06-22 01:27) [11]

Теперь получилось... :)

 >  Красива мигает

А у меня тот код очень интересно себя ведёт при разворачивании пункта "Программы" и его подпунктов... (Классическое меню "Пуск")

---

Страницы: 1 вся ветка

Текущий архив: 2009.08.16;
Скачать: CL | DM;

Наверх

Память: 0.5 MB
Время: 0.021 c