:: 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;
|
При использовании материала - ссылка на сайт обязательна
|
|