Взаимодействие с оболочкой (shell) операционной системы

         Автозапуск при загрузке Windows

         Как спрятать кнопку на TaskBar

         Получение списка загруженных приложений

         Как узнать версию Windows и DOS

         Как вытащить иконку из .EXE, .DLL, .ICO

         Как изменить состояние кнопок Caps Lock, Num Lock, и подобных

         Как поместить иконку в TrayBar (радом с часами)

         Открыть/Закрыть CD-ROM

         Запретить/Разрешить Ctrl+Alt+Del

         Спрятать/Показать кнопку "Пуск" на панели задач

         Спрятать/Показать панель задач

         Сменить обои на рабочем столе

         Как выяснить расположение панели задач

         Как спрятать программу из списка при Ctrl+Alt+Del

         Программное переключение раскладок клавиатуры

         Запуск текущего Screen-Saver

         Очищение папки "Документы"

         Добавление в меню "Документы"

         Как определить какой шрифт установлен: крупный или мелкий


Автозапуск при загрузке Windows

Для запуска программы при каждой загрузке Windows надо добавить в реестр:

HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run

Чтобы программа запустилась только при следующей загрузке:

HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce


Как спрятать кнопку на TaskBar

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;

Как узнать версию Windows и DOS

Для этого, можно воспользоваться следующей функцией:
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

    Процесс получения иконок из .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, Num Lock, и подобных

Некоторые коды клавиш:

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;

Как поместить иконку в TrayBar (радом с часами)

Для обработки сообщений от иконки используется механизм сообщений.

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;

Открыть/Закрыть CD-ROM

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;

Запретить/Разрешить Ctrl+Alt+Del

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;

Как спрятать программу из списка при 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;

Программное переключение раскладок клавиатуры

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;

Запуск текущего Screen-Saver

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;

main_back.gif (3425 bytes)

Используются технологии uCoz