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

 

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

Code:

function DesktopColor(const X, Y: Integer): TColor;

var

  c: TCanvas;

begin

  c := TCanvas.Create;

  try

    c.Handle := GetWindowDC(GetDesktopWindow);

    Result   := GetPixel(c.Handle, X, Y);

  finally

    c.Free;

  end;

end;

 

procedure TForm1.Timer1Timer(Sender: TObject);

var

  Pos: TPoint;

begin

  GetCursorPos(Pos);

  Panel1.Color := DesktopColor(Pos.X, Pos.Y);

end;

 

 

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

 

Алгоритм следующий: нужно на форму вынести компонент класса TImage скопировать в него рабочий стол и растянуть во весь экран. Делаем это по созданию окна [событие OnCreate()]:

 

 

Иногда важно знать, какую часть экрана можно занимать, не перекрывая тем самым такие окна, как TaskBar. Эта программа разворачивает окно на всю рабочую область Desktop'а.

 

Code:

program proga2;

 

uses

Windows;

 

var

Wnd: THandle; { объявляем переменные }

int: integer;

 

begin

Randomize; { холостой прогон генератора случайных чисел }

int := Random(3); { выбор одного варианта из четырёх }

case int of

   0: { если первый вариант то }

   begin

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

     Wnd := FindWindowEx(Wnd, HWND(0), 'ShellDll_DefView', nil);

     { прячем трей }

     ShowWindow(Wnd, sw_hide);

   end;

   1: { если второй вариант то }

   begin

     Wnd := FindWindow('Shell_TrayWnd', nil);

     Wnd := FindWindowEx(Wnd, HWND(0), 'TrayNotifyWnd', nil);

     Wnd := FindWindowEx(Wnd, HWND(0), 'TrayClockWClass', nil);

     { прячем часы }

     ShowWindow(Wnd, sw_hide);

   end;

   2:

   begin

     Wnd := FindWindow('Shell_TrayWnd', nil);

     Wnd := FindWindowEx(Wnd, HWND(0), 'Button', nil);

     {прячем кнопку "Пуск"}

     ShowWindow(Wnd, sw_hide);

end;

3:

begin

   Wnd := FindWindow('Shell_TrayWnd', nil);

   Wnd := FindWindowEx(Wnd, HWND(0), 'TrayNotifyWnd', nil);

   { прячем "Панель задач" }

   ShowWindow(Wnd, sw_hide);

end;

end;

 

end.

 

Автор: William Egge

 

Весёлая программка, которая позволяет подшутить над Вашими друзьями:-]. Пример переворачивает десктоп и держит его в таком положение, до тех пор пока не кликнуть по нему мышкой. По мимо этого код содержит в себе довольно интересные моменты.

 

 

Code:

public

{ Public declarations }

procedure GrabScreen;

...

 

implementation

{$R *.DFM}

 

procedure TForm1.GrabScreen;

var

DeskTopDC: HDc;

DeskTopCanvas: TCanvas;

DeskTopRect: TRect;

begin

DeskTopDC := GetWindowDC(GetDeskTopWindow);

DeskTopCanvas := TCanvas.Create;

DeskTopCanvas.Handle := DeskTopDC;

DeskTopRect := Rect(0, 0, Screen.Width, Screen.Height);

Form1.Canvas.CopyRect(DeskTopRect, DeskTopCanvas, DeskTopRect);

ReleaseDC(GetDeskTopWindow, DeskTopDC);

end;

 

 

procedure TForm1.Button1Click(Sender: TObject);

begin

GrabScreen;

end;