|
|
Автозапуск при загрузке
Windows
Как спрятать кнопку на
TaskBar
Получение списка загруженных
приложений
Как узнать версию Windows и
DOS
Как вытащить иконку из .EXE,
.DLL, .ICO
Как изменить состояние кнопок
Caps Lock, Num Lock, и подобных
Как поместить иконку в TrayBar
(радом с часами)
Запретить/Разрешить
Ctrl+Alt+Del
Спрятать/Показать кнопку
"Пуск" на панели задач
Спрятать/Показать панель
задач
Как выяснить расположение
панели задач
Как спрятать программу из
списка при Ctrl+Alt+Del
Программное переключение
раскладок клавиатуры
Как определить какой шрифт
установлен: крупный или мелкий
Для запуска программы при каждой загрузке Windows надо
добавить в
реестр:
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run
Чтобы
программа запустилась только при следующей
загрузке:
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce
ShowWindow(Application.Handle,sw_Hide);
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;
Для этого, можно воспользоваться следующей
функцией:
function GetVersion: LongInt; она возвращает в старшем слове версию
DOS, а в младшем - версию Windows.
var WinV: Word;
DosV: Word;
begin
WinV := GetVersion and $0000FFFF;
DosV := GetVersion shr 16;
Label1.Caption := IntToStr(Hi(DosV))+'.'+IntToStr(Lo(DosV));
Label2.Caption := IntToStr(Lo(WinV))+'.'+IntToStr(Hi(WinV));
end;
Процесс получения иконок из .EXE, .DLL
или .ICO файлов полностью идентичен. Различие только в том, что в .ICO файле
может храниться только одна иконка, а в .EXE и .DLL несколько. Для получения
иконок из файлов, в модуле ShellAPI, есть функция:
function
ExtractIcon(Inst: THandle; FileName: PChar; IconIndex: Word):
HIcon;
где:
Inst - указатель на приложение
вызвавшее функцию,
FileName - имя файла из которого
необходимо получить иконку,
IconIndex - номер необходимой
иконки.
Если функция возвращает значение не равное нулю, то в файле есть
следующая иконка.
В данном примере в компонент Image1 выводится иконка
запущенного файла.
uses ShellAPI;
............
procedure TForm1.FormCreate(Sender: TObject);
var A: array [0..78] of char;
begin
{Получение имени запущенного файла}
StrPCopy(A, ParamStr(0));
{Вывод на экран нулевой иконки из файла}
Image1.Picture.Icon.Handle := ExtractIcon(HInstance, A, 0);
end;
Некоторые коды клавиш: Caps Lock 020 Shift 016 Insert 045 NumLock 144 Contrl 017 Delete 046 Scroll Lock 145 Alt 018 Tab 009
Например для изменения состояния клавиш Caps Lock, Num Lock и Scroll Lock на противоположное:
var KS: TKeyboardState; begin GetKeyboardState(KS); KS[020] := KS[020] xor 1; KS[144] := KS[144] xor 1; KS[145] := KS[145] xor 1; SetKeyboardState(KS); end;
Для обработки сообщений от иконки используется механизм сообщений.
procedure TForm1.Button1Click(Sender: TObject);
var no: TNotifyIconData;
Hicon1: HIcon;
begin
//Помещение иконки в Tray Bar
HIcon1:=ExtractIcon(Handle,'i:\arw01lt.ico',0);
with no do begin
cbSize:=Sizeof(TNotifyIconData);
Wnd:=Handle;
uID:=0;
UFlags:=NIF_MESSAGE+NIF_ICON+NIF_TIP;
SzTip:='Traybar Tip';
HIcon:=HIcon1;
uCallBackMessage:=WM_USER+0;//Определяемое пользователем сообщение
end;
Shell_NotifyIcon(NIM_ADD,@no);
end;
procedure TForm1.Button2Click(Sender: TObject);
var no: TNotifyIconData;
begin
//Удаление иконки
with no do begin
cbSize:=Sizeof(TNotifyIconData);
Wnd:=Handle;
uID:=0;
end;
Shell_NotifyIcon(NIM_Delete,@no);
end;
uses MMsystem;
...
procedure TForm1.Button1Click(Sender: TObject);
begin
mciSendString('Set cdaudio door open wait', nil, 0, handle);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
mciSendString('Set cdaudio door closed wait', nil, 0, handle);
end;
procedure TForm1.Button1Click(Sender: TObject); var old: boolean; begin old:=True; //Убрать SystemParametersInfo(SPI_SCREENSAVERRUNNING,1,@old,0); end; procedure TForm1.Button2Click(Sender: TObject); var old:boolean; begin old:=True; //Восстановить SystemParametersInfo(SPI_SCREENSAVERRUNNING,0,@old,0); end;
procedure StartButton(visi: boolean);
var Tray, Child : hWnd;
C : array [0..127] of char;
S : string;
begin
Tray := FindWindow('Shell_TrayWnd', NIL);
Child := GetWindow(Tray, GW_CHILD);
while Child <> 0 do begin
if GetClassName(Child, C, SizeOf(C)) > 0 then begin
S := StrPAS(C);
if UpperCase(S) = 'BUTTON' then begin
if Visi then
ShowWindow(Child, 1)
else
ShowWindow(Child, 0);
end;
end;
Child := GetWindow(Child, GW_HWNDNEXT);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
StartButton(False);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
StartButton(True);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_HIDE); //Скрыть TaskBar
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_SHOW); // Показать Taskbar
end;
uses Registry;
...
procedure TForm1.Button1Click(Sender: TObject);
var Reg: TRegIniFile;
begin
Reg:=TRegIniFile.Create('Control Panel');
Reg.WriteString('desktop', 'Wallpaper', 'c:\windows\field18.bmp');
Reg.WriteString('desktop', 'TileWallpaper', '0');
Reg.Free;
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil,SPIF_SENDWININICHANGE);
end;
uses ShellApi;
var AppBarData : TAppBarData;
bAlwaysOnTop, //Taskbar всегда на экране
bAutoHide : boolean;
Clrect,rect : TRect;
Edge:UInt; //Местоположение TaskBar
procedure DetectTaskBar;
begin
AppBarData.hWnd := FindWindow('Shell_TrayWnd', nil);
AppBarData.cbSize := sizeof(AppBarData);
bAlwaysOnTop := (SHAppBarMessage(ABM_GETSTATE, AppBardata)
and ABS_ALWAYSONTOP) <> 0;
bAutoHide := (SHAppBarMessage(ABM_GETSTATE, AppBardata)
and ABS_AUTOHIDE) <>0;
GetClientRect(AppBarData.hWnd, Clrect.rc);
GetWindowRect(AppBarData.hwnd, rect);
if (rect.top > 0) then
Edge := ABE_BOTTOM
else if (rect.bottom < screen.height) then
Edge:=ABE_TOP
else if rect.right < screen.width then
Edge:=ABE_LEFT
else
Edge:=ABE_RIGHT;
end;
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;
procedure TForm1.Button1Click(Sender: TObject);//На русский var Layout: array [0.. KL_NAMELENGTH] of char; begin LoadKeyboardLayout( StrCopy(Layout,'00000419'),KLF_ACTIVATE); end; procedure TForm1.Button2Click(Sender: TObject);//На английский var Layout: array [0.. KL_NAMELENGTH] of char; begin LoadKeyboardLayout(StrCopy(Layout,'00000409'),KLF_ACTIVATE); end;
SendMessage(Application.Handle,WM_SYSCOMMAND,SC_SCREENSAVE,0);
SHAddToRecentDocs(SHARD_PATH,nil);
// Для данного файла должно быть зарегистрировано средство просмотра var s: string; begin s:='c:\mydoc.doc'+#0; SHAddToRecentDocs(SHARD_PATH,PChar(s)); end;
function SmallFonts: boolean;
{Значение функции TRUE если мелкий шрифт}
var DC: HDC;
begin
DC:=GetDC(0);
Result:=(GetDeviceCaps(DC, LOGPIXELSX) = 96);
{ В случае крупного шрифта будет 120}
ReleaseDC(0, DC);
end;