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

        check.gif (991 bytes) Автозапуск при загрузке Windows

        check.gif (991 bytes) Как спрятать кнопку на TaskBar

        check.gif (991 bytes) Получение списка загруженных приложений

        check.gif (991 bytes) Как узнать версию Windows и DOS

        check.gif (991 bytes) Как вытащить иконку из .EXE, .DLL, .ICO

        check.gif (991 bytes) Как изменить состояние кнопок Caps Lock, Num Lock, и подобных

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

        check.gif (991 bytes) Открыть/Закрыть CD-ROM

        check.gif (991 bytes) Запретить/Разрешить Ctrl+Alt+Del

        check.gif (991 bytes) Спрятать/Показать кнопку "Пуск" на панели задач

        check.gif (991 bytes) Спрятать/Показать панель задач

        check.gif (991 bytes) Сменить обои на рабочем столе

        check.gif (991 bytes) Как выяснить расположение панели задач

        check.gif (991 bytes) Как спрятать программу из списка при Ctrl+Alt+Del

        check.gif (991 bytes) Программное переключение раскладок клавиатуры

        check.gif (991 bytes) Запуск текущего Screen-Saver

        check.gif (991 bytes) Очищение папки "Документы"

        check.gif (991 bytes) Добавление в меню "Документы"

        check.gif (991 bytes) Как определить какой шрифт установлен: крупный или мелкий


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



Hosted by uCoz