Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  4 495

•  TDictionary Custom Sort  6 521

•  Fast Watermark Sources  6 311

•  3D Designer  9 253

•  Sik Screen Capture  6 644

•  Patch Maker  7 020

•  Айболит (remote control)  7 028

•  ListBox Drag & Drop  5 899

•  Доска для игры Реверси  97 225

•  Графические эффекты  7 233

•  Рисование по маске  6 529

•  Перетаскивание изображений  5 399

•  Canvas Drawing  5 769

•  Рисование Луны  5 477

•  Поворот изображения  5 006

•  Рисование стержней  3 560

•  Paint on Shape  2 820

•  Генератор кроссвордов  3 697

•  Головоломка Paletto  2 978

•  Теорема Монжа об окружностях  3 783

•  Пазл Numbrix  2 495

•  Заборы и коммивояжеры  3 177

•  Игра HIP  2 144

•  Игра Go (Го)  2 079

•  Симулятор лифта  2 455

•  Программа укладки плитки  2 121

•  Генератор лабиринта  2 596

•  Проверка числового ввода  2 273

•  HEX View  2 604

•  Физический маятник  2 214

 
скрыть

  Форум  

Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Как программно заменить обои на рабочем столе 3




unit Walpaper;

interface

uses
{$IFDEF WIN32}Windows, Registry, {$ELSE}WinTypes, WinProcs, IniFiles, {$ENDIF}
  Classes, Controls, SysUtils;

type
  TWallPaper = class(TComponent)
  private
    PC: array[0..$FF] of Char;
{$IFDEF WIN32}
    Reg: TRegistry;
{$ELSE}
    Reg: TIniFile;
    WinIniPath: string;
{$ENDIF}

    function GetWallpaper: string;
    procedure SetWallpaper(Value: string);
    function GetTile: Boolean;
    procedure SetTile(Value: Boolean);
    function GetStretch: Boolean;
    procedure SetStretch(Value: Boolean);
  protected
{$IFNDEF WIN32}
    constructor Create(aOwner: TComponent); override;
{$ENDIF}
  public
  published
    property Wallpaper: string read GetWallpaper write SetWallpaper;
    property Tile: Boolean read GetTile write SetTile;
    property Stretch: Boolean read GetStretch write SetStretch;
  end;

procedure Register;

implementation

{$IFNDEF WIN32}

constructor TWallpaper.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  GetWindowsDirectory(PC, $FF);
  WinIniPath := StrPas(PC) + '\WIN.INI';
end;
{$ENDIF}

function TWallpaper.GetWallpaper: string;
begin
{$IFDEF WIN32}
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_CURRENT_USER;
  Reg.OpenKey('\Control Panel\desktop\', False);
  Result := Reg.ReadString('Wallpaper');
  Reg.Free;
{$ELSE}
  Reg := TIniFile.Create(WinIniPath);
  Result := Reg.ReadString('Desktop', 'Wallpaper', '');
  Reg.Free;
{$ENDIF}
end;

procedure TWallpaper.SetWallpaper(Value: string);
begin
  if not (csDesigning in ComponentState) and
    not (csLoading in ComponentState) and
    not (csReading in ComponentState) then
  begin
    StrPCopy(PC, Value);
    SystemParametersInfo(spi_SetDeskWallpaper, 0, @PC, spif_UpdateIniFile);
  end;
end;

function TWallpaper.GetTile: Boolean;
begin
{$IFDEF WIN32}
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_CURRENT_USER;
  Reg.OpenKey('\Control Panel\desktop\', False);
  Result := Boolean(StrToInt(Reg.ReadString('TileWallpaper')));
  Reg.Free;
{$ELSE}
  Reg := TIniFile.Create(WinIniPath);
  Result := Reg.ReadBool('Desktop', 'TileWallpaper', False);
  Reg.Free;
{$ENDIF}
end;

procedure TWallpaper.SetTile(Value: Boolean);
begin
  if not (csDesigning in ComponentState) and
    not (csLoading in ComponentState) and
    not (csReading in ComponentState) then
  begin
{$IFDEF WIN32}
    Reg := TRegistry.Create;
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.OpenKey('\Control Panel\desktop\', False);
    Reg.WriteString('TileWallpaper', IntToStr(Integer(Value)));
    Reg.Free;
{$ELSE}
    Reg := TIniFile.Create(WinIniPath);
    Reg.WriteBool('Desktop', 'TileWallpaper', Value);
    Reg.Free;
{$ENDIF}
    SetWallpaper(Wallpaper);
  end;
end;

function TWallpaper.GetStretch: Boolean;
var
  i: Integer;
begin
{$IFDEF WIN32}
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.OpenKey('\Control Panel\desktop\', False);
    i := StrToInt(Reg.ReadString('WallpaperStyle'));
  except
  end;
  Reg.Free;
{$ELSE}
  Reg := TIniFile.Create(WinIniPath);
  i := Reg.ReadInteger('Desktop', 'WallpaperStyle', 0);
  Reg.Free;
{$ENDIF}
  Result := i = 2;
end;

procedure TWallpaper.SetStretch(Value: Boolean);
var
  v: Integer;
begin
  if not (csDesigning in ComponentState) and
    not (csLoading in ComponentState) and
    not (csReading in ComponentState) then
  begin
    if Value then
      v := 2
    else
      v := 0;

{$IFDEF WIN32}
    Reg := TRegistry.Create;
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.OpenKey('\Control Panel\desktop\', False);
    Reg.WriteString('WallpaperStyle', IntToStr(v));
    Reg.Free;
{$ELSE}
    Reg := TIniFile.Create(WinIniPath);
    Reg.WriteInteger('Desktop', 'WallpaperStyle', v);
    Reg.Free;
{$ENDIF}
    SetWallpaper(Wallpaper);
  end;
end;

procedure Register;
begin
  RegisterComponents('JohnUtilend;

end.
Ответ 3:
WinAPI:
BOOL SystemParametersInfo(
  UINT uiAction, // system parameter to query or set
  UINT uiParam, // depends on action to be taken
  PVOID pvParam, // depends on action to be taken
  UINT fWinIni // user profile update flag
  );

uiAction := SPI_SETDESKWALLPAPER Sets the desktop wallpaper.
pvParam := 'Имя BMP файла'#0
uiParam := 0
fWinIni := SPIF_UPDATEINIFILE








Copyright © 2004-2025 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте