:: MVP ::
|
|
:: RSS ::
|
|
|
Как определить, что приложение зависло?
// Способ первый
function IsAppResponding(Wnd: HWND): Boolean;
const
TIMEOUT = 50;
var
Res: {$IFDEF CPUX86}DWORD{$ELSE IFDEF CPUX86}PDWORD_PTR{$ENDIF};
begin
Result := SendMessageTimeout(Wnd, WM_NULL, 0, 0,
SMTO_NORMAL or SMTO_ABORTIFHUNG, TIMEOUT, Res) <> 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if IsAppResponding(Handle) then
ShowMessage('Приложение не зависло')
else
ShowMessage('Приложение зависло');
end;
// Способ второй
// Win9X/ME
function IsAppResponding9X(dwThreadId: DWORD): Boolean;
type
TIsHungThread = function(dwThreadId: DWORD): BOOL; stdcall;
var
hUser32: THandle;
IsHungThread: TIsHungThread;
begin
Result := True;
hUser32 := GetModuleHandle('User32.dll');
if hUser32 > 0 then
begin
@IsHungThread := GetProcAddress(hUser32, 'IsHungThread');
if Assigned(IsHungThread) then
Result := not IsHungThread(dwThreadId);
end;
end;
// Win NT/2000/XP
function IsAppRespondingNT(Wnd: HWND): Boolean;
type
TIsHungAppWindow = function(Wnd: HWND): BOOL; stdcall;
var
hUser32: THandle;
IsHungAppWindow: TIsHungAppWindow;
begin
Result := True;
hUser32 := GetModuleHandle('User32.dll');
if hUser32 > 0 then
begin
@IsHungAppWindow := GetProcAddress(hUser32, 'IsHungAppWindow');
if Assigned(IsHungAppWindow) then
Result := not IsHungAppWindow(Wnd);
end;
end;
function IsAppRespondig(Wnd: HWND): Boolean;
begin
if not IsWindow(Wnd) then
begin
ShowMessage('Неверный идентификатор');
Exit;
end;
if Win32Platform = VER_PLATFORM_WIN32_NT then
Result := IsAppRespondingNT(Wnd)
else
Result := IsAppResponding9X(GetWindowThreadProcessId(Wnd, nil));
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Res: DWORD;
begin
if IsAppResponding(Handle) then
ShowMessage('Приложение не зависло')
else
ShowMessage('Приложение зависло');
end;
|
Как определить состояние формы Normal/Minimized/Maximized?
// Способ первый
procedure TForm1.Timer1Timer(Sender: TObject);
begin
case WindowState of
wsNormal: Caption := 'Normal';
wsMinimized: Caption := 'Minimized';
wsMaximized: Caption := 'Maximized';
end;
end;
// Способ второй
procedure TForm1.Timer1Timer(Sender: TObject);
var
wp: TWindowPlacement;
begin
wp.length := SizeOf(TWindowPlacement);
GetWindowPlacement(Handle, @wp);
case wp.showCmd of
SW_NORMAL: Caption := 'Normal';
SW_SHOWMINIMIZED: Caption := 'Minimized';
SW_SHOWMAXIMIZED: Caption := 'Maximized';
end;
end;
|
Как определить "оригинальные" (wsNormal) размеры формы?
procedure TForm1.Button1Click(Sender: TObject);
var
wp: TWindowPlacement;
r: Trect;
begin
if WindowState = wsMaximized then
begin
wp.length := SizeOf(TWindowPlacement);
GetWindowPlacement(Handle, @wp);
R := wp.rcNormalPosition;
end
else
GetWindowRect(Handle, r);
ShowMessage(Format('Left: %d'#13'Top: %d'#13'Right: %d'#13'Bottom: %d',
[r.Left, r.Top, r.Right, r.Bottom]));
end;
|
Как скрыть главное окно приложения при старте?
// В dpr файле проекта пишем
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1);
Application.ShowMainForm := False; // <--
Application.Run;
end.
|
Как не дать приложению развернуться из иконки?
type
TForm1 = class(TForm)
private
procedure WMQueryOpen(var Msg: TWMQueryOpen); message WM_QUERYOPEN;
{...}
end;
implementation
procedure TForm1.WMQueryOpen(var Msg: TWMQueryOpen);
begin
Msg.Result := 0;
end;
|
Как получить хендл предыдущего активнго окна?
procedure TForm1.Button1Click(Sender: TObject);
function GetPrevWindowHandle: HWND;
begin
Result := GetWindow(Application.Handle, GW_HWNDPREV);
end;
var
Buf: array[0..255] of Char;
begin
GetWindowText(GetPrevWindowHandle, Buf, SizeOf(Buf));
ShowMessage(StrPas(Buf));
end;
|
Как запретить окну переходить в прозрачный режим при нажатии клавишь Win+Space?
type
TForm1 = class(TForm)
{...}
protected
procedure CreateHandle; override;
{...}
end;
implementation
uses
{...,} Winapi.DwmApi;
procedure TForm1.CreateHandle;
const
Val: Integer = DWMWA_ALLOW_NCPAINT;
var
Res: Integer;
begin
inherited CreateHandle;
Res := DwmSetWindowAttribute(Handle, DWMWA_EXCLUDED_FROM_PEEK, @Val, SizeOf(Val));
{$IFDEF DEBUG}
if Res <> S_OK then
ShowMessage(SysErrorMessage(Res));
{$ENDIF}
end;
|
Как убрать окно из обработки Flip3D (трехмерный переключатель окон, вызываемый комбинацией Win+Tab)?
type
TForm1 = class(TForm)
{...}
protected
procedure CreateHandle; override;
{...}
end;
implementation
uses
{...,} Winapi.DwmApi;
procedure TForm1.CreateHandle;
const
Val: Integer = DWMFLIP3D_EXCLUDEABOVE; // DWMFLIP3D_EXCLUDEBELOW;
var
Res: Integer;
begin
inherited CreateHandle;
Res := DwmSetWindowAttribute(Handle, DWMWA_FLIP3D_POLICY, @Val, SizeOf(Val));
{$IFDEF DEBUG}
if Res <> S_OK then
ShowMessage(SysErrorMessage(Res));
{$ENDIF}
end;
|
Как получить путь к исполняемому файлу?
// Способ первый
function GetExeFileName: string;
var
Buffer: array[0..MAX_PATH] of Char;
begin
SetString(Result, Buffer,
GetModuleFileName(HInstance, Buffer, SizeOf(Buffer)));
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GetExeFileName);
end;
// Способ второй
function GetExeFileName: string;
begin
Result := Application.ExeName;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GetExeFileName);
end;
// Способ третий
function GetExeFileName: string;
begin
Result := ParamStr(0);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GetExeFileName);
end;
|
Как заставить окно всегда рисоваться (не)активным?
type
TForm32 = class(TForm)
private
procedure WMNCActivate(var Msg: TWMNCActivate); message WM_NCACTIVATE;
public
{ Public declarations }
end;
var
Form32: TForm32;
implementation
{$R *.dfm}
{ TForm32 }
procedure TForm32.WMNCActivate(var Msg: TWMNCActivate);
begin
// True - всегда активно
// False - всегда неактивно
Msg.Active := True;
inherited;
end;
|
При использовании материала - ссылка на сайт обязательна
|
|