Code:

procedure RefreshDesktop;

{©Drkb v.3}

 

var

c1 : cardinal;

begin

c1:=FindWindowEx(FindWindowEx(FindWindow('Progman','Program Manager'),,'SHELLDLL_DefView',''),0,'SysListView32','');

PostMessage(c1,WM_KEYDOWN,VK_F5,0);

PostMessage(c1,WM_KEYUP,VK_F5,1 shl 31);

end;

 

В принципе, все настройки на фоновый рисунок хранятся в реестре. Поэтому надо сначала скопировать картинку в какое-нибудь место (лучше в каталог Виндов) на случай удаления или переноса исходного файла. Информация по обоям хранится в разделе HKEY_CURRENT_USER\Control Panel\Desktop в параметрах TileWallpaper (если 1 - рисунок размножен, 0 - в центре), Wallpaper - путь к файлу обоев (gif, bmp, jpg), WallpaperStyle - если 2, то обои будут растянуты (отсутствует в 95 винде).

ПОсле установки всех занчений обновляешь рабочий стои и наслаждаешься эффектом.

 

Автор ответа: Garik

 

Для этого нужно найти окно "SysListView32" (которое является списком, который содержит иконки рабочего стола). Сперва будем искать главное родительское окно "Progman", которое содержит дочернее окно "SHELLDLL_DefView" , которое в свою очередь имеет дочернее окно "SysListView32". Для этого можно воспользоваться API функцией FindWindow to. Когда Мы получим дескриптор окна "SysListView32", то можно будет воспользоваться макросами ListView_SetTextBkColor и ListView_SetTextColor для установки желаемого цвета.

 

 

Для этого воспользуемся 'Rundll32.exe' и запустим её в 'shellexecute'. Не забудьте добавить 'shellapi' в Ваш список uses.

 

Code:

// переменные

var Srect,Drect,PosForme:TRect;

   iWidth,iHeight,DmX,DmY:Integer;

   iTmpX,iTmpY:Real;

   C:TCanvas;

   Kursor:TPoint;

// Увеличиваем экран, если приложение не свёрнуто в иконку

If not IsIconic(Application.Handle) then begin

// Получаем координаты курсора

GetCursorPos(Kursor);

 

// PosForm представляет прямоугольник с

// координатами Form (image control).

PosForme:=Rect(Form1.Left,

                Form1.Top,

                Form1.Left+Form1.Width,

                Form1.Top+Form1.Height);

 

//Показываем magnified screen

//если курсор за пределами формы.

If not PtInRect(PosForme,Kursor) then begin

 

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

// части экрана. С небольшими модификациями его можно

// использовать для уменьшения

// экрана

iWidth:=Image1.Width;

iHeight:=Image1.Height;

Drect:=Bounds(0,0,iWidth,iHeight);

iTmpX:=iWidth / (Slider.Position * 4);

iTmpY:=iHeight / (Slider.Position * 4);

Srect:=

 

  Rect(Kursor.x,Kursor.y,Kursor.x,Kursor.y);

InflateRect(Srect,Round(iTmpX),Round(iTmpY));

 

//Получаем обработчик(handle) окна рабочего стола.

C:=TCanvas.Create;

try

  C.Handle:=GetDC(GetDesktopWindow);

//Передаём часть изображения окна в TImage.

  Image1.Canvas.CopyRect(Drect,C,Srect);

finally

  C.Free;

end;

 

end;

 

// Обязательно обрабатываем все сообщения Windows.

Application.ProcessMessages;

 

end; // IsIconic

 Автор: Zarko Gajic

 

Code:

function IsActiveDeskTopOn: Boolean;

var

h: hWnd;

begin

h := FindWindow('Progman', nil);

h := FindWindowEx(h, 0,

            'SHELLDLL_DefView', nil);

h := FindWindowEx(h, 0,

      'Internet Explorer_Server', nil);

Result := h <> 0;

end;

 

  

Code:

procedure TForm1.Button1Click(Sender: TObject);

begin

// скрыть иконки

ShowWindow(FindWindow(nil,'Program Manager'),SW_HIDE);

end;

 

procedure TForm1.Button2Click(Sender: TObject);

begin

// показать иконки

ShowWindow(FindWindow(nil,'Program Manager'),SW_SHOW);

end;

 

 

Code:

uses

ComObj, ShlObj, ActiveX;

 

procedure EnableActiveDesktop(bValue: Boolean);

const

CLSID_ActiveDesktop: TGUID = (D1: $75048700; D2: $EF1F; D3: $11D0;

   D4: ($98, $88, $00, $60, $97, $DE, $AC, $F9));

var

MyObject: IUnknown;

ActiveDesk: IActiveDesktop;

twpoComponentOpt: TComponentsOpt;

begin

MyObject := CreateComObject(CLSID_ActiveDesktop);

ActiveDesk := MyObject as IActiveDesktop;

with twpoComponentOpt do

begin

   ZeroMemory(@twpoComponentOpt, SizeOf(TComponentsOpt));

   dwSize := SizeOf(twpoComponentOpt);

   fEnableComponents := bValue;

   // fActiveDesktop := True;

end;

ActiveDesk.SetDesktopItemOptions(twpoComponentOpt, 0);

ActiveDesk.ApplyChanges(AD_APPLY_ALL);

end;

 

Для начала необходимо получить дескриптор рабочего стола, который представляет из себя обычный ListView.

 

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

  Picture: TPicture;

  Desktop: TCanvas;

  X, Y: Integer;

begin

  // Objekte erstellen

// create objects

Picture := TPicture.Create;

  Desktop := TCanvas.Create;

 

  // Bild laden

// load bitmap

Picture.LoadFromFile('bitmap1.bmp');

 

  // Geratekontex vom Desktop ermitteln

// get DC of desktop

Desktop.Handle := GetWindowDC(0);

 

  // Position des Bildes

// position of bitmap

X := 100;

  Y := 100;

 

  // Bild zeichnen

// draw bitmap

Desktop.Draw(X, Y, Picture.Graphic);

 

  // Geratekontex freigeben

ReleaseDC(0, Desktop.Handle);

 

  // Objekte freigeben

// release objects

Picture.Free;

  Desktop.Free;

end;

 

 

 

Как установить обои в формате jpeg. SystemParametersInfo только для bmp.