Виртуальная библиотека Delphi - [9]

  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.

Как запретить кнопку Close [x] в заголовке окна.

procedure TForm1.FormCreate(Sender: TObject);
var Style: Longint;
begin
 Style := GetWindowLong(Handle, GWL_STYLE);
 SetWindowLong(Handle, GWL_STYLE, Style And Not WS_SYSMENU);
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
 if (Key = VK_F4) and (ssAlt in Shift) then begin
  MessageBeep(0); Key := 0;
 end;
end;

Каким образом можно изменить системное меню формы?

Hе знаю как насчет акселераторов, надо поискать, а вот добавить Item — пожалуйста

type
 TMyForm=class(TForm)
 procedure wmSysCommand(var Message:TMessage); message WM_SYSCOMMAND;
end;
const
 ID_ABOUT = WM_USER+1;
 ID_CALENDAR=WM_USER+2;
 ID_EDIT = WM_USER+3;
 ID_ANALIS = WM_USER+4;
implementation
procedure TMyForm.wmSysCommand;
begin
 case Message.wParam of
 ID_CALENDAR:DatBitBtnClick(Self) ;
 ID_EDIT :EditBitBtnClick(Self);
 ID_ANALIS:AnalisButtonClick(Self);
 end;
 inherited;
end;
procedure TMyForm.FormCreate(Sender: TObject);
var SysMenu:THandle;
begin
 SysMenu:=GetSystemMenu(Handle,False);
 InsertMenu(SysMenu,Word(-1),MF_SEPARATOR,ID_ABOUT,'');
 InsertMenu(SysMenu,Word(-1),MF_BYPOSITION,ID_Calendar, 'Calendar');
 InsertMenu(SysMenu,Word(-1),MF_BYPOSITION,ID_Analis, 'Analis');
 InsertMenu(SysMenu,Word(-1),MF_BYPOSITION,ID_Edit, 'Edit');
end;

Запуск внешней программы и ожидание ее завершения

procedure TForm1.Button1Click(Sender: TObject);
var
 si : Tstartupinfo;
 p : Tprocessinformation;
begin
 FillChar( Si, SizeOf( Si ) , 0 );
 with Si do begin
  cb := SizeOf( Si);
  dwFlags := startf_UseShowWindow;
  wShowWindow := 4;
 end;
 Application.Minimize;
 Createprocess(nil,'notepad.exe',nil,nil,false,
 Create_default_error_mode,nil,nil,si,p);
 Waitforsingleobject(p.hProcess,infinite);
 Application.Restore;
end;

Как узнать местоположение специальных папок у Windows?

var
 FolderPath :string;
 Registry := TRegistry.Create;
try
 Registry.RootKey := HKey_Current_User;
 Registry.OpenKey('Software\Microsoft\Windows\'+
  'CurrentVersion\Explorer\Shell Folders', False);
 FolderName := Registry.ReadString('StartUp');
 {Cache, Cookies, Desktop, Favorites,
 Fonts, Personal, Programs, SendTo, Start Menu, Startp}
finally
 Registry.Free;
end;

Как засунуть в исполняемый файл wav-файл, и затем проиграть этот звук?

В файл MyWave.rc пишешь:

MyWave RCDATA LOADONCALL MyWave.wav

Затем компилируешь

brcc32.exe MyWave.rc

получаешь MyWave.res.

В своей программе пишешь:

{$R MyWave.res}
procedure RetrieveMyWave;
var
 hResource: THandle;
 pData: Pointer;
begin
 hResource:=LoadResource( hInstance, FindResource(hInstance, 'MyWave', RT_RCDATA));
 try
  pData := LockResource(hResource);
  if pData = nil then raise Exception.Create('Cannot read MyWave');
  // Здесь pData указывает на MyWave
  // Теперь можно, например, проиграть его (Win32):
  PlaySound('MyWave', 0, SND_MEMORY);
 finally
  FreeResource(hResource);
 end;
end;

Как скрыть таскбар?

procedure TForm1.Button1Click(Sender: TObject);
var
 hTaskBar : THandle;
begin
 hTaskbar := FindWindow('Shell_TrayWnd', Nil);
 ShowWindow(hTaskBar, SW_HIDE);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
 hTaskBar : THandle;
begin
 hTaskbar := FindWindow('Shell_TrayWnd', Nil);
 ShowWindow(hTaskBar, SW_SHOWNORMAL);
end;

События нажатия на системные кнопки формы (минимизация, закрытие...)

Хотелось бы чтобы при нажатии на кнопку minimize программа исчезала из таскбара.

При нажатии на эти кнопки происходит сообщение WM_SYSCOMMAND, его то и надо перехватить.

При этом:

uCmdType = wParam; // type of system command requested

xPos = LOWORD(lParam); // horizontal postion, in screen coordinates

yPos = HIWORD(lParam); // vertical postion, in screen coordinates

Пример:

Type TMain = class(TForm)
 ....
protected
 Procedure WMGetSysCommand(var Message :TMessage); message WM_SYSCOMMAND;
end;
.....
//------------------------------------------------------------------------
// Обработка сообщения WM_SYSCOMMAND (перехват минимизации окна)
//------------------------------------------------------------------------
Procedure TForm1.WMGetSysCommand(var Message : TMessage) ;
Begin
 IF (Message.wParam = SC_MINIMIZE) Then Form1.Visible:=False
 Else Inherited;
End;

Подключение и отключение сетевых дисководов

Для работы с сетевыми дисководами (и ресурсами типа LPT порта) в WIN API 16 и WIN API 32 следующие функции:

1.Подключить сетевой ресурс

WNetAddConnection(NetResourse,Password, LocalName:PChar):longint;

где NetResourse — имя сетевого ресурса (например '\\P166\c')

Password — пароль на доступ к ресурсу (если нет пароля, то пустая строка)

LocalName — имя, под которым сетевой ресурс будет отображен на данном компьютере (например 'F:')

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

WNetAddConnection('\\P166\C','','F:');

Функция возвращает код ошибки. Для всех кодов предописаны константы, наиболее часто используемые :