Итак, Рабочий стол- это первое что мы видим после загрузки пользователя.
Сначала я дам код, как изменить фоновый рисунок на Столе. Вот что надо
написать:
implementation
Uses ShlObj, ComObj;
procedure ChangeWallpaper;
const
CLSID_ActiveDesktop: TGUID =
'{75048700-EF1F-11D0-9888-006097DEACF9}';
var
ActiveDesktop:
IActiveDesktop;
begin
ActiveDesktop :=
CreateComObject(CLSID_ActiveDesktop)
as
IActiveDesktop;
ActiveDesktop.SetWallpaper('Путь к файлу',
0);
ActiveDesktop.ApplyChanges(AD_APPLY_ALL or AD_APPLY_FORCE);
end;
Затем в нажатии на кнопку пишем:
procedure TForm1.ButtonClick(Sender:
TObject);
begin
ChangeWallpaper;
end;
Всё, с первым пунктом покончено. Второе, как скрыть иконки на рабочем
столе:
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;
Всё элементарно. Третье, как зазумить часть Стола. Нам понадобиться Timer,
Image:
private
procedure WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo); message
WM_GETMINMAXINFO;
public
//…
procedure TForm1.WMGetMinMaxInfo(var Msg:
TWMGetMinMaxInfo);
begin
inherited;
Msg.MinMaxInfo^.ptMinTrackSize :=
Point(158, 177); // Минимальный размер формы
Msg.MinMaxInfo^.ptMaxTrackSize
:= Point(350, 350); // Максимальный размер формы
end;
Теперь в процедуре изменения размеров формы пишем:
procedure TForm1.FormResize(Sender:
TObject);
begin
Image1.Picture:=nil;
end;
И обязательно при уничтожении:
procedure TForm1.FormDestroy(Sender:
TObject);
begin
Timer1.Interval:=0;
end;
И финал пишем в таймере:
procedure TForm1.Timer1Timer(Sender:
TObject);
var
Srect,Drect,PosForme:TRect;
FWidth,FHeight,X,Y:Integer;
TmpX,TmpY:Real;
CanvasX:TCanvas;
Kursor:TPoint;
begin
//
Увеличиваем экран, если приложение не свёрнуто
If not
IsIconic(Application.Handle) then begin
GetCursorPos(Kursor);// Координаты
курсора
PosForme:=Rect(Form1.Left,Form1.Top,Form1.Left+Form1.Width,Form1.Top+Form1.Height);
If
not PtInRect(PosForme,Kursor) then begin
If Panel1.Visible=True then Panel1.Visible:=False;
If Image1.Visible=False
then Image1.Visible:=True;
// Далее код можно использовать для увеличения выбранной части
экрана.
FWidth:=Image1.Width;
FHeight:=Image1.Height;
Drect:=Rect(0,0,FWidth,FHeight);
//zoom
TmpX:=FWidth
/ (TrackBar1.Position * 4);
TmpY:=FHeight / (TrackBar1.Position * 4);
Srect:=Rect(Kursor.x,Kursor.y,Kursor.x,Kursor.y);
InflateRect(Srect,Round(TmpX),Round(TmpY));
//
move Srect if outside visible area of the screen
If Srect.Left<0 then
OffsetRect(Srect,-Srect.Left,0);
If Srect.Top<0 then
OffsetRect(Srect,0,-Srect.Top);
If Srect.Right>Screen.Width then
OffsetRect(Srect,-(Srect.Right-Screen.Width),0);
If
Srect.Bottom>Screen.Height then
OffsetRect(Srect,0,-(Srect.Bottom-Screen.Height));
CanvasX:=TCanvas.Create; //Получаем handle окна рабочего
стола.
try
CanvasX.Handle:=GetDC(GetDesktopWindow);
Image1.Canvas.CopyRect(Drect,CanvasX,Srect);
//Передаём часть изображения в TImage.
finally
CanvasX.Free;
end;
If
CheckBox1.Checked=True then begin
with Image1.Canvas do
begin
X:=TrackBar1.Position * 2 *
(Kursor.X-Srect.Left);
Y:=TrackBar1.Position * 2 *
(Kursor.Y-Srect.Top);
MoveTo(X - (FWidth div 4),Y);
LineTo(X + (FWidth div
4),Y);
MoveTo(X,Y - (FHeight div 4));
LineTo(X,Y + (FHeight div
4));
end;
end;
Application.ProcessMessages; // Это чтобы Windows не
повис.
end
else begin
If Panel1.Visible=False then
Panel1.Visible:=True;
If Image1.Visible=True then
Image1.Visible:=False;
end;
end;
end;
Исходник к последней части качать здесь (8,83 КБ)
>>