Автозапуск при загрузке 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;