Рабочий стол
Итак, Рабочий стол- это первое что мы видим после загрузки пользователя. Сначала я дам код, как изменить фоновый рисунок на Столе. Вот что надо написать:
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.LeftScreen.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;
