| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Как сделать прозрачным главное меню пуск? [D7, WinXP]

Nikfel ©   (2009-06-20 20:40:00) 

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

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','Главное меню');
Но прозрачным меню всеравно не стало. Как осуществить такое? Заранее спасибо.

---

CSS   (2009-06-22 01:27:00) [1]

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

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

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

---

Б   (2009-06-21 21:20:00) [2]

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


Timer1.Enabled:= not Timer1.Enabled;

---

юзер   (2009-06-21 21:10:00) [3]

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

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

---

AIK   (2009-06-21 13:38:00) [4]

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


это лишнее

---

AIK   (2009-06-21 13:36:00) [5]

Красива мигает
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.

---

Nikfel   (2009-06-21 11:48:00) [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;

---

CSS   (2009-06-21 11:29:00) [7]

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

---

Nikfel   (2009-06-21 10:17:00) [8]

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

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;

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

Спасибо.

---

Nikfel   (2009-06-21 09:45:00) [9]

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

---

AIK   (2009-06-21 08:56:00) [10]

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

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;

---

AIK   (2009-06-21 08:51:00) [11]

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

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

---

Наверх