Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2005.08.21;
Скачать: CL | DM;

Вниз

Как узнать запущено ли хоть одно полноэкранное приложение?   Найти похожие ветки 

 
rolex   (2005-07-29 19:46) [0]

Чтобы запретить в своей программе различные OSD и popup окошки, нужно узнать запущено ли хоть одно полноэкранное приложение (игры, заставка...).
Как это можно сделать?


 
Джо ©   (2005-07-29 19:49) [1]

Искать все видимые окна верхнего уровня в системе. Проверить их размер и состояние.
?


 
rolex   (2005-07-29 19:59) [2]

А как? Можно примером?


 
TUser ©   (2005-07-29 20:08) [3]

EnumWindows
GetWindowRect


 
Джо ©   (2005-07-29 20:36) [4]

Вот нашел у себя в старых исходниках. Когда-то делал класс-энумератор для своих (скромных) целей.


unit WEnum;

interface
uses Windows, SysUtils, Classes, Contnrs;

type
 TOSWindow = class
 private
   FHandle: THandle;
   FText: string;
   function GetHandleValid: Boolean;
   procedure SetWindowProperties;
   function GetVisible: Boolean;
   function GetRect: TRect;
   function GetIconic: Boolean;
   function GetMaximized: Boolean;
 public
   property Handle: THandle read FHandle;
   property HandleValid: Boolean read GetHandleValid;
   property Visible: Boolean read GetVisible;
   property Text: string read FText;
   property Rect: TRect read GetRect;
   property Iconic: Boolean read GetIconic;
   property Maximized: Boolean read GetMaximized;
   constructor Create (AHandle: THandle);
 end;

 TWindowEnumerator = class
 private
   FList: TObjectList;
   FPosition: Integer;
   function GetCurrent: TOSWindow;
   procedure AddWindow (AHandle: THandle);
 public
   procedure Reset;
   procedure Populate;
   function MoveNext: Boolean;
   property Current: TOSWindow read GetCurrent;
   constructor Create;
   destructor Destroy; override;
 end;

implementation
uses Dialogs;

function EnumWindowProc (AHandle: THandle; lParm: LPARAM): BOOL; stdcall;
var
 Enumerator: TWindowEnumerator;
begin
 TWindowEnumerator(lParm).AddWindow(AHandle);
 Result := True
end;

{ TOSWindows }

constructor TOSWindow.Create(AHandle: THandle);
begin
 FHandle := AHandle;
 SetWindowProperties;
end;

function TOSWindow.GetHandleValid: Boolean;
begin
 Result := IsWindow(FHandle);
end;

{ TWindowEnumerator }

function TWindowEnumerator.MoveNext: Boolean;
begin
 Result := FPosition < FList.Count - 1;
 if Result then
   Inc(FPosition);
end;

function TWindowEnumerator.GetCurrent: TOSWindow;
begin
 Result := TOSWindow(FList[FPosition])
end;

procedure TWindowEnumerator.Populate;
begin
 FList.Clear;
 if not EnumWindows(@EnumWindowProc,Integer(Self)) then
   RaiseLastOSError

end;

constructor TWindowEnumerator.Create;
begin
 FList := TObjectList.Create(True);
 Populate;
 FPosition := -1;
end;

destructor TWindowEnumerator.Destroy;
begin
 FList.Free;
 inherited;
end;

procedure TWindowEnumerator.AddWindow(AHandle: THandle);
begin
 FList.Add(
   TOSWindow.Create(AHandle)
 )
end;

function TOSWindow.GetIconic: Boolean;
begin
 Result := Windows.IsIconic(FHandle)
end;

function TOSWindow.GetMaximized: Boolean;
begin
 Result := Windows.IsZoomed(FHandle)
end;

function TOSWindow.GetRect: TRect;
begin
 GetWindowRect(FHandle,Result)
end;

function TOSWindow.GetVisible: Boolean;
begin
 Result := IsWindowVisible(FHandle)
end;

procedure TOSWindow.SetWindowProperties;
var
 Len: Integer;
 AText: string;
begin
 Len := GetWindowTextLength(FHandle);
 SetLength (AText,Len+1);
 GetWindowText(FHandle,PChar(AText),Len+1);
 FText := AText
end;

procedure TWindowEnumerator.Reset;
begin
 FPosition := -1
end;

end.

Например, найти все видимые и максимизированные окна верхнего уровня и вывести из заголовок, можно так:

procedure TForm6.Button1Click(Sender: TObject);
var
 WinEnum: TWindowEnumerator;
begin
 WinEnum := TWindowEnumerator.Create;
 try
   while WinEnum.MoveNext do
   begin
     if (WinEnum.Current.Visible) and (WinEnum.Current.Maximized) then
       ShowMessage(WinEnum.Current.Text)
   end;
 finally
   WinEnum.Free;
 end;
end;

Тебе нужно будет свойство Rect.
Кстати, перед каждым опросом свойства не мешало бы подстраховываться вызовом метода HandleValid - потому как окна уже может и не быть в момент вызова :-)
В, общем, экспериментируй.
П.С. Класс - черновой, писанный для себя, так что, внимательно изучи его работу перед использованием. Можешь его расширять, как тебе будет угодно.


 
rolex   (2005-07-29 21:12) [5]

Накалякал пока такой код:
...
   procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
 public
 end;

var
 Form1: TForm1;
 FullScrExe:Boolean;

implementation

{$R *.DFM}
Function WindowToWidth(WD: HWND):integer;
Var ARect:TRect;
begin
GetWindowRect(WD, ARect);
Result:=ARect.Right-ARect.Left;
end;

Function WindowToHeight(WD: HWND):integer;
Var ARect:TRect;
begin
GetWindowRect(WD, ARect);
Result:=ARect.Bottom-ARect.Top;
end;

function EnumWindowsProc(Wnd: HWND): BOOL; stdcall;
begin
Result:=True;
if (IsWindowVisible(Wnd) or IsIconic(wnd)) and ((GetWindowLong(Wnd, GWL_HWNDPARENT) = 0) or
(GetWindowLong(Wnd, GWL_HWNDPARENT) = GetDesktopWindow)) and (GetWindowLong(Wnd, GWL_EXSTYLE) and WS_EX_TOOLWINDOW = 0) then
if (WindowToWidth(Wnd)>=Screen.Width) and (WindowToHeight(Wnd)>=Screen.Height) then FullScrExe:=true;
end;

function ExistFullApplication:boolean;
begin
FullScrExe:=false;
EnumWindows(@EnumWindowsProc, 0);
Result:=FullScrExe;
end;

procedure TForm1.WMHotKey(var Msg: TWMHotKey);
begin
case msg.HotKey of
1: if form1.Visible then
     begin
     FadeOut; hide;
     end else
       if ExistFullApplication=false then
         begin
         show;
         FadeIn;
         end;
2: begin if (Visible=false) and (ExistFullApplication=false) then begin show; FadeIn; end; Timer1.Enabled:=False; Timer1.Enabled:=True; TrackBar2.Position:=TrackBar2.Position-656; end;
3: begin if (Visible=false) and (ExistFullApplication=false) then begin show; FadeIn; end; Timer1.Enabled:=False; Timer1.Enabled:=True; TrackBar2.Position:=TrackBar2.Position+656; end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 Mixer:=TAudioMixer.Create(Self);
 RegisterHotKey(Form1.Handle, 1, 0, 255);
 RegisterHotKey(Form1.Handle, 2, 0, 174);
 RegisterHotKey(Form1.Handle, 3, 0, 175);
end;

...

При нажатии на клавишу (msg.hotkey=1, 2, 3...), вылазиет ошибка. А если проверять таймером, то всё нормально.
Т.е. эта функция плохо работает когда нажата клавиша на клавиатуре. Помогите.


 
rolex   (2005-07-29 21:12) [6]


> Джо ©

Спасибо. щас ваш попробую.


 
Джо ©   (2005-07-29 21:32) [7]


> [6] rolex   (29.07.05 21:12)
> Спасибо. щас ваш попробую.

Там нет ничего нового. Просто удобный костяк и оболочка для перебора окон. У тебя - процедурный подход, у меня объектно-ориентированный. Суть одна.


 
rolex   (2005-07-29 21:34) [8]

Мля с примером Джо у меня ничего не выходит. Помгите лучше мне мой доделать.


 
Джо ©   (2005-07-29 21:39) [9]


>  [8] rolex   (29.07.05 21:34)
> Мля с примером Джо у меня ничего не выходит.

Мля, ты исключительно вежливый пацан.


 
rolex   (2005-07-29 21:52) [10]

Итак, методом тыка обнаружил, что проблема в этой функции, а конкретно в выделенных строках:
function EnumWindowsProc(Wnd: HWND): BOOL; stdcall;
begin
Result:=True;
if (IsWindowVisible(Wnd) or IsIconic(wnd)) and ((GetWindowLong(Wnd, GWL_HWNDPARENT) = 0) or
(GetWindowLong(Wnd, GWL_HWNDPARENT) = GetDesktopWindow)) and (GetWindowLong(Wnd, GWL_EXSTYLE) and WS_EX_TOOLWINDOW = 0) then

if (WindowToWidth(Wnd)>=Screen.Width) and (WindowToHeight(Wnd)>=Screen.Height) then FullScrExe:=true;
end;

Помогите разобраться. Пожалуйста.


> Джо ©   (29.07.05 21:39) [9]
>
> >  [8] rolex   (29.07.05 21:34)
> > Мля с примером Джо у меня ничего не выходит.
>
> Мля, ты исключительно вежливый пацан.

Извини, если что.


 
Джо ©   (2005-07-29 21:56) [11]


> Result:=True;
> if (IsWindowVisible(Wnd) or IsIconic(wnd)) and ((GetWindowLong(Wnd,
> GWL_HWNDPARENT) = 0) or
> (GetWindowLong(Wnd, GWL_HWNDPARENT) = GetDesktopWindow))
> and (GetWindowLong(Wnd, GWL_EXSTYLE) and WS_EX_TOOLWINDOW
> = 0) then
> if (WindowToWidth(Wnd)>=Screen.Width) and (WindowToHeight(Wnd)>=Screen.Height)
> then FullScrExe:=true;
> end;

Именно для того, чтобы не возиться с таким безобразным кодом, я и сделал свою оболочку. Расширь ее как того требует твоя задача.


 
Джо ©   (2005-07-29 21:56) [12]

Сейчас накатаю пример.


 
Джо ©   (2005-07-29 22:16) [13]

Немного подправил класс TOSWindow, внеся в него необходимые свойста: FullScreen, ToolWindow.


unit Unit7;

interface
uses Windows, SysUtils, Classes, Contnrs;

type
 TOSWindow = class
 private
   FHandle: THandle;
   FRect: TRect;
   FText: string;
   function GetHandleValid: Boolean;
   procedure SetWindowProperties;
   function GetVisible: Boolean;
   function GetIconic: Boolean;
   function GetMaximized: Boolean;
   function GetFullScreen: Boolean;
   function GetToolWindow: Boolean;
 public
   property Handle: THandle read FHandle;
   property HandleValid: Boolean read GetHandleValid;
   property Visible: Boolean read GetVisible;
   property Text: string read FText;
   property Rect: TRect read FRect;
   property Iconic: Boolean read GetIconic;
   property Maximized: Boolean read GetMaximized;
   property ToolWindow: Boolean read GetToolWindow;
   property FullScreen: Boolean read GetFullScreen;
   constructor Create (AHandle: THandle);
 end;

 TWindowEnumerator = class
 private
   FList: TObjectList;
   FPosition: Integer;
   function GetCurrent: TOSWindow;
   procedure AddWindow (AHandle: THandle);
 public
   procedure Reset;
   procedure Populate;
   function MoveNext: Boolean;
   property Current: TOSWindow read GetCurrent;
   constructor Create;
   destructor Destroy; override;
 end;

implementation
uses Dialogs, Types;

function EnumWindowProc (AHandle: THandle; lParm: LPARAM): BOOL; stdcall;
var
 Enumerator: TWindowEnumerator;
begin
 TWindowEnumerator(lParm).AddWindow(AHandle);
 Result := True
end;

{ TOSWindows }

constructor TOSWindow.Create(AHandle: THandle);
begin
 FHandle := AHandle;
 SetWindowProperties;
end;

function TOSWindow.GetFullScreen: Boolean;
begin
 Result :=
   Visible and
   (FRect.Left = 0) and
   (FRect.Top = 0) and
   (FRect.Right = GetSystemMetrics(SM_CXSCREEN)) and
   (FRect.Bottom = GetSystemMetrics(SM_CYSCREEN));
end;

function TOSWindow.GetHandleValid: Boolean;
begin
 Result := IsWindow(FHandle);
end;

{ TWindowEnumerator }

function TWindowEnumerator.MoveNext: Boolean;
begin
 Result := FPosition < FList.Count - 1;
 if Result then
   Inc(FPosition);
end;

function TWindowEnumerator.GetCurrent: TOSWindow;
begin
 Result := TOSWindow(FList[FPosition])
end;

procedure TWindowEnumerator.Populate;
begin
 FList.Clear;
 if not EnumWindows(@EnumWindowProc,Integer(Self)) then
   RaiseLastOSError

end;

constructor TWindowEnumerator.Create;
begin
 FList := TObjectList.Create(True);
 Populate;
 FPosition := -1;
end;

destructor TWindowEnumerator.Destroy;
begin
 FList.Free;
 inherited;
end;

procedure TWindowEnumerator.AddWindow(AHandle: THandle);
begin
 FList.Add(
   TOSWindow.Create(AHandle)
 )
end;

function TOSWindow.GetIconic: Boolean;
begin
 Result := Windows.IsIconic(FHandle)
end;

function TOSWindow.GetMaximized: Boolean;
begin
 Result := Windows.IsZoomed(FHandle)
end;

function TOSWindow.GetToolWindow: Boolean;
begin
 Result :=
   (GetWindowLong(FHandle, GWL_EXSTYLE) and WS_EX_TOOLWINDOW) = WS_EX_TOOLWINDOW;
end;

function TOSWindow.GetVisible: Boolean;
begin
 Result := IsWindowVisible(FHandle)
end;

procedure TOSWindow.SetWindowProperties;
var
 Len: Integer;
 AText: string;
begin
 Len := GetWindowTextLength(FHandle);
 SetLength (AText,Len+1);
 GetWindowText(FHandle,PChar(AText),Len+1);
 FText := AText;

 GetWindowRect(FHandle,FRect);
end;

procedure TWindowEnumerator.Reset;
begin
 FPosition := -1
end;

end.

---
Теперь проверка выглядит так:
---

procedure TForm6.Button1Click(Sender: TObject);
var
 WinEnum: TWindowEnumerator;
begin
 Memo1.Clear;
 WinEnum := TWindowEnumerator.Create;
 try
   while WinEnum.MoveNext do
   begin
     if WinEnum.Current.FullScreen and not WinEnum.Current.ToolWindow then

       Memo1.Lines.Add(WinEnum.Current.Text) // делаешь с окном, что хочешь
   end;
 finally
   WinEnum.Free;
 end;
end;

Посмотри код добавленных свойств, точнее их акцессоров. Добавь еще несколько свойств по их образцу, чтобы уточнить, что ты имеешь в виду под "на весь экран".  Возможно, того, что есть, хватит.
П.С.
Есть проекрасный способ, чтобы не путаться во всех этих проверках. А именно, разбиение сложного условия на составляющие. Что я и пытался продемонстрировать.


 
rolex   (2005-07-30 10:54) [14]

Вот функция (всё-таки сам сделал и по своему):
Function WindowToWidth(WD: HWND):integer;
Var ARect:TRect;
begin
GetWindowRect(WD, ARect);
Result:=ARect.Right-ARect.Left;
end;

Function WindowToHeight(WD: HWND):integer;
Var ARect:TRect;
begin
GetWindowRect(WD, ARect);
Result:=ARect.Bottom-ARect.Top;
end;

function ExistFullApplication:boolean;
var
 Wnd: hWnd;
 buff: array[0..127] of Char;
 xres:boolean;
begin
 xres:=false;
 Wnd := GetWindow(Form1.Handle, gw_HWndFirst);
 while Wnd <> 0 do begin {Не показываем:}
   GetWindowText(Wnd, buff, sizeof(buff));
   if (Wnd <> Application.Handle) and {-Собственное окно}
     IsWindowVisible(Wnd) and {-Невидимые окна}
     (GetWindow(Wnd, gw_Owner) = 0) and {-Дочернии окна}
     (StrPas(buff)<>"Program Manager") and
     (GetWindowText(Wnd, buff, sizeof(buff)) <> 0) {-Окна без заголовков}
     and (WindowToWidth(Wnd)>=Screen.Width) and (WindowToHeight(Wnd)>=Screen.Height)
     then xres:=True;
   Wnd := GetWindow(Wnd, gw_hWndNext);
 end;
Result:=xres;
end;


Проверьте, правильная ли она. Вроде у меня работает.



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

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

Наверх




Память: 0.51 MB
Время: 0.028 c
3-1120566360
DelphiN!
2005-07-05 16:26
2005.08.21
Вывод оригинальных значений столбца в таблицах


1-1122823023
TStas
2005-07-31 19:17
2005.08.21
Как делят потоки стек?


11-1105680010
DmiSb
2005-01-14 08:20
2005.08.21
Проверить содержимое каталога


14-1122893696
Andreyy
2005-08-01 14:54
2005.08.21
Посоветуйте книгу по D7 пожалуйста


1-1123129297
Kara
2005-08-04 08:21
2005.08.21
Ошибка SQL





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский