Виртуальная библиотека Delphi

О состоянии клавиатуры дают информацию следующие функции:

GetKeyState, GetAsyncKeyState, GetKeyboardState.

Чтобы упростить себе жизнь и не возиться с этими функциями снова и снова я написал маленькие функции:

function AltKeyDown : boolean;

begin

result:=(Word(GetKeyState(VK_MENU)) and $8000)<>0;

end;

function CtrlKeyDown : boolean;

begin

result:=(Word(GetKeyState(VK_CONTROL)) and $8000)<>0;

end;

function ShiftKeyDown : boolean;

begin

result:=(Word(GetKeyState(VK_SHIFT)) and $8000)<>0;

end;

А заодно и для клавиш переключателей:

function CapsLock : boolean;

begin

result:=(GetKeyState(VK_CAPITAL) and 1)<>0;

end;

function InsertOn : boolean;

begin

result:=(GetKeyState(VK_INSERT) and 1)<>0;

end;

function NumLock : boolean;

begin

result:=(GetKeyState(VK_NUMLOCK) and 1)<>0;

end;

function ScrollLock : boolean;

begin

result:=(GetKeyState(VK_SCROLL) and 1)<>0;

end;

При написании разнообразны программ типа заставок, менеджеров управления компьютером… возникает необходимость переводить компьютер в режим «спячки». Для включения этого режима в Windows 95 (и только в ней !!) предусмотрена команда API:

SetSystemPowerState(Suspended, Mode: Boolean):boolean;

Suspended должно быть TRUE для ухода в спячку.

Mode — режим входа в спячку. Если TRUE, то всем программам и драйверам посылается Message PBT_APMSUSPEND, по которому они должны немедленно прекратить работу. Если FALSE, то посылается Message PBT_APMQUERYSUSPEND запроса на спячку, и драйвера в ответ могут дать отказ на включение режима спячки.

Возврат функции SetSystemPowerState: TRUE — режим включен.

procedure TForm1.Button1Click(Sender: TObject);

VAR

Wnd : hWnd;

buff: ARRAY [0..127] OF Char;

begin

ListBox1.Clear;

Wnd := GetWindow(Handle, gw_HWndFirst);

WHILE Wnd <> 0 DO BEGIN {Не показываем:}

IF (Wnd <> Application.Handle) AND {-Собственное окно}

IsWindowVisible(Wnd) AND {-Невидимые окна}

(GetWindow(Wnd, gw_Owner) = 0) AND {-Дочерние окна}

(GetWindowText(Wnd, buff, sizeof(buff)) <> 0){-Окна без заголовков}

THEN BEGIN

GetWindowText(Wnd, buff, sizeof(buff));

ListBox1.Items.Add(StrPas(buff));

END;

Wnd := GetWindow(Wnd, gw_hWndNext);

END;

ListBox1.ItemIndex := 0;

end;

Внеся изменения (выделенные цветом) в свой проект вы получите приложение, которое не видно в TaskBar и на него нельзя переключиться по Alt-Tab

program Project1;

uses

Forms,

Windows,

Unit1 in 'Unit1.pas' {Form1};

{$R *.RES}

var

ExtendedStyle : integer;

begin

Application.Initialize;

ExtendedStyle:=GetWindowLong(application.Handle, GWL_EXSTYLE);

SetWindowLong(Application.Handle, GWL_EXSTYLE, ExtendedStyle or WS_EX_TOOLWINDOW {AND NOT WS_EX_APPWINDOW});

Application.CreateForm(TForm1, Form1);

Application.Run;

end.

Если включить синий коментарий, то получите очень интересное приложение. Оно не видно в TaskBar и на него нельзя переключиться по Alt-Tab, но когда приложение минимизируется оно остается на рабочем столе в виде свернутого заголовка (прямо как в старом добром Windows 3.11)

Только сpазу пpедупpеждаю пpо гpабли, на котоpые я наступал:

Будь готов к тому, что если пpи попытке закpытия пpиложения в OnCloseQuery или OnClose выводится вопpос о подтвеpждении, то могут быть пpоблемы с автоматическим завеpшением пpогpаммы пpи shutdown — под Win95 пpосто зависает, под WinNT не завеpшается. Очевидно, что сообщение выводится, но его не видно (пpичем SW_RESTORE не сpабатывает). Решение — ловить WM_QueryEndSession и после всяких завеpшающих действий и вызова CallTerminateProcs выдавать Halt.

А вот как отрубить показ файла в Ctrl-Alt-Del

function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';

implementation

procedure TForm1.Button1Click(Sender: TObject);

begin //Hide

if not (csDesigning in ComponentState) then

RegisterServiceProcess(GetCurrentProcessID, 1);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin //Show

if not (csDesigning in ComponentState) then

RegisterServiceProcess(GetCurrentProcessID, 0);

end;

sProgTitle: Название для программы

sCmdLine: Имя EXE файла с путем доступа

bRunOnce: Запустить только один раз или постоянно при загрузке Windows

procedure RunOnStartup(sProgTitle, sCmdLine : string; bRunOnce : boolean);

var

sKey : string;

reg : TRegIniFile;

begin

if (bRunOnce)then sKey := 'Once'

else sKey := '';

reg := TRegIniFile.Create('');

reg.RootKey := HKEY_LOCAL_MACHINE;

reg.WriteString('Software\Microsoft'

+ '\Windows\CurrentVersion\Run'

+ sKey + #0,

sProgTitle, sCmdLine);

reg.Free;

end;

// Например

RunOnStartup('Title of my program','MyProg.exe',False );

Примечание. Этот пример удобно использовать при написании деинсталляторов — добавить однократный вызов деинсталлятора и запросить от пользователя перезагрузку. Этот прием позволит безболезненно удалять DLL и им подобные файлы, которые обычном способом удалить невозможно (они загружены в силу того, что использовались деинсталлируемой программой или работают в момент деинсталляции).

uses ShellAPI;

function DeleteFileWithUndo( sFileName : string ) : boolean;

var fos : TSHFileOpStruct;

begin

sFileName:= sFileName+#0;

FillChar( fos, SizeOf( fos ), 0 );

with fos do begin

wFunc := FO_DELETE;

pFrom := PChar( sFileName );

fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT;

end;

Result := ( 0 = ShFileOperation( fos ) );

end;

uses ShellAPI, ShlOBJ;

procedure AddToStartDocumentsMenu( sFilePath : string );

begin

SHAddToRecentDocs( SHARD_PATH, PChar( sFilePath ) );

end;

// Например

AddToStartDocumentsMenu( 'c:\windows\MyWork.txt' );

program wallpapr;

uses Registry, WinProcs;

procedure SetWallpaper(sWallpaperBMPPath : String; bTile : boolean );

var

reg : TRegIniFile;

begin

// Изменяем ключи реестра

// HKEY_CURRENT_USER

// Control Panel\Desktop

// TileWallpaper (REG_SZ)

// Wallpaper (REG_SZ)

reg := TRegIniFile.Create('Control Panel\Desktop' );

with reg do begin

WriteString( '', 'Wallpaper', sWallpaperBMPPath );

if( bTile )then begin

WriteString('', 'TileWallpaper', '1' );

end else begin

WriteString('', 'TileWallpaper', '0' );

end;

end;

reg.Free;

// Оповещаем всех о том, что мы

// изменили системные настройки

SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Nil, SPIF_SENDWININICHANGE );

end;

begin

// пример установки WallPaper по центру рабочего стола

SetWallpaper('c:\winnt\winnt.bmp', False );

end.

procedure TForm1.FormCreate(Sender: TObject);

var Style: Longint;

begin

Style := GetWindowLong(Handle, GWL_STYLE);

SetWindowLong(Handle, GWL_STYLE, Style And Not WS_SYSMENU);

end;