|
:: MVP ::
|
|
|
:: RSS ::
|
|
|
Как перехватить нажатие клавиш в Windows, даже если приложение неактивно?
// Timer1.Interval = 100
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if GetAsyncKeyState(VK_RETURN) <> 0 then
ShowMessage('Вы нажали на Enter');
if GetAsyncKeyState(VK_SPACE) <> 0 then
ShowMessage('Вы нажали на Space');
if GetAsyncKeyState(VK_ESCAPE) <> 0 then
ShowMessage('Вы нажали на Escape');
end;
|
Как включить/отключить перерисовку окна при его перетаскивании?
// Способ первый
procedure SetDragFullWindows(check: Boolean);
var
flag: Boolean;
begin
if check then
SystemParametersInfo(SPI_SETDRAGFULLWINDOWS, 1, @flag, 0)
else
SystemParametersInfo(SPI_SETDRAGFULLWINDOWS, 0, @flag, 0);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SetDragFullWindows(True);
end;
// Способ второй
procedure SetDragFullWindows(check: Boolean);
begin
SystemParametersInfo(SPI_SETDRAGFULLWINDOWS, Ord(check), nil, 0);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SetDragFullWindows(True);
end;
|
Как реализовать функцию "свернуть все окна"?
// Способ первый
procedure MinimizeAll;
var
Wnd: HWND;
begin
Wnd := FindWindow('Shell_TrayWnd', nil);
if Wnd <> 0 then
SendMessage(Wnd, WM_COMMAND, $019F, 0);
end;
// Способ второй
uses
ComObj;
procedure TForm1.Button1Click(Sender: TObject);
var
z: OleVariant;
begin
z := CreateOleObject('Shell.Application');
z.MinimizeAll; // или z.ToggleDesktop;
z := Unassigned;
end;
// Способ третий
procedure TForm1.Button1Click(Sender: TObject);
begin
keybd_event(VK_LWIN, 0, 0, 0);
keybd_event(Ord('M'), 0, 0, 0);
keybd_event(Ord('M'), 0, KEYEVENTF_KEYUP, 0);
keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0);
end;
|
Как включить/отключить режим автоскрытия у панели задач?
uses
ShellAPI;
// Включить режим автоскрытия
procedure TForm1.Button1Click(Sender: TObject);
var
pData: TAppBarData;
begin
ZeroMemory(@pData, SizeOf(TAppBarData));
pData.cbSize := SizeOf(TAppBarData);
pData.hWnd := FindWindow('Shell_TrayWnd', nil);
pData.lParam := ABS_ALWAYSONTOP or ABS_AUTOHIDE;
SHAppBarMessage(ABM_SETSTATE, pData);
end;
// Отключить режим автоскрытия
procedure TForm1.Button2Click(Sender: TObject);
var
pData: TAppBarData;
begin
ZeroMemory(@pData, SizeOf(TAppBarData));
pData.cbSize := SizeOf(TAppBarData);
pData.hWnd := FindWindow('Shell_TrayWnd', nil);
pData.lParam := ABS_ALWAYSONTOP;
SHAppBarMessage(ABM_SETSTATE, pData);
end;
|
Как определить расположение панели задач на экране?
uses
ShellAPI;
function DetectTaskBarPos: UInt;
var
AppBarData: TAppBarData;
ClientRect, Rect: TRect;
begin
AppBarData.hWnd := FindWindow('Shell_TrayWnd', nil);
GetClientRect(AppBarData.hWnd, ClientRect);
GetWindowRect(AppBarData.hwnd, Rect);
if Rect.Top > 0 then
Result := ABE_BOTTOM
else if Rect.Bottom < Screen.Height then
Result := ABE_TOP
else if Rect.Right < Screen.Width then
Result := ABE_LEFT
else
Result := ABE_RIGHT;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
case DetectTaskBarPos of
ABE_LEFT: ShowMessage('Панель находится слева');
ABE_RIGHT: ShowMessage('Панель находится справа');
ABE_TOP: ShowMessage('Панель находится вверху');
ABE_BOTTOM: ShowMessage('Панель находится внизу');
end;
end;
|
Как сменить обои на рабочем столе?
uses
Registry;
procedure ChangeWallpaper(WallPath: string);
var
Reg: TRegistry;
begin
with TRegistry.Create do
begin
RootKey := HKEY_CURRENT_USER;
OpenKey('Control Panel\Desktop', False);
WriteString('Wallpaper', WallPath);
CloseKey;
Free;
end;
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE);
end;
// Более универсальный вариант
uses
Registry, ShlObj, ComObj;
procedure ChangeWallpaper(WallPath: string);
var
Reg: TRegistry;
ActiveDesktop: IActiveDesktop;
begin
with TRegistry.Create do
begin
RootKey := HKEY_CURRENT_USER;
OpenKey('Control Panel\Desktop', False);
WriteString('Wallpaper', WallPath);
CloseKey;
Free;
end;
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE);
ActiveDesktop := CreateComObject(CLSID_ActiveDesktop) as IActiveDesktop;
ActiveDesktop.ApplyChanges(AD_APPLY_ALL or AD_APPLY_FORCE);
end;
|
Как изменить стиль отображения обоев на рабочем столе?
uses
Registry;
// Pos = 0 - по цунтру
// = 1 - замостить
// = 2 - растянуть
procedure ChangeWallpaperPos(Pos: Byte);
var
Reg: TRegistry;
begin
with TRegistry.Create do
begin
RootKey := HKEY_CURRENT_USER;
OpenKey('Control Panel\Desktop', False);
case Pos of
0: begin
WriteString('TileWallpaper', '0');
WriteString('WallpaperStyle', '0');
end;
1: begin
WriteString('TileWallpaper', '1');
WriteString('WallpaperStyle', '0');
end;
2: begin
WriteString('TileWallpaper', '0');
WriteString('WallpaperStyle', '2');
end;
end;
CloseKey;
Free;
end;
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE);
end;
|
Как включить Drop Shadow Effect окна в Windows XP?
type
TForm1 = class(TForm)
protected
procedure CreateParams(var Params: TCreateParams); override;
end;
procedure TForm1.CreateParams(var Params: TCreateParams);
const
CS_DROPSHADOW = $00020000;
begin
inherited;
Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW;
end;
|
Как определить время простаивания системы?
function LastInput: DWord;
var
LInput: TLastInputInfo;
begin
LInput.cbSize := SizeOf(TLastInputInfo);
GetLastInputInfo(LInput);
Result := GetTickCount - LInput.dwTime;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Caption := Format('Система простаивает %d ms', [LastInput]);
end;
|
Как изменить шрифт и выравнивание в заголовке формы?
function IsAdmin: boolean;
const
SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5));
SECURITY_BUILTIN_DOMAIN_RID = $00000020;
DOMAIN_ALIAS_RID_ADMINS = $00000220;
var
hAccessToken: THandle;
ptgGroups: PTokenGroups;
dwInfoBufferSize: DWORD;
psidAdministrators: PSID;
i: Integer;
bSuccess: BOOL;
begin
Result := False;
bSuccess := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, hAccessToken);
if not bSuccess then
begin
if GetLastError = ERROR_NO_TOKEN then
bSuccess := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, hAccessToken);
end;
if bSuccess then
begin
GetMem(ptgGroups, 1024);
bSuccess := GetTokenInformation(hAccessToken, TokenGroups,
ptgGroups, 1024, dwInfoBufferSize);
CloseHandle(hAccessToken);
if bSuccess then
begin
AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2, SECURITY_BUILTIN_DOMAIN_RID,
DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, psidAdministrators);
{$R-}
for i := 0 to ptgGroups.GroupCount-1 do
if EqualSid(psidAdministrators, ptgGroups.Groups[i].Sid) then
begin
Result := True;
Break;
end;
{$R+}
FreeSid(psidAdministrators);
end;
FreeMem(ptgGroups);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
case IsAdmin of
True: ShowMessage('У нас есть права администратора');
False: ShowMessage('У нас нет прав администратора');
end;
end;
|
|
При использовании материала - ссылка на сайт обязательна
|
|