[ПриУэт]

привет всем!
подскажите пожалуйста как можно сделать на Delphi что то типа лупы, чтоб прорисовывало заново выбранную часть Image.
вот код программы

Код:

var
 Form1: TForm1;
Type1: Byte;
r:real;
x_min,y_min,x_max,y_max:Real;
n,iter,kr,zel,sin  : Integer;
imagemouse: boolean;
imageRect: TRect;
ia,ib:real;
  a,b:real;
implementation

uses Unit2, Unit3;

{$R *.dfm}


                    {функция построения фрактала Мандельброта}
function MandelBrot(a,b: real): TColor;
var
	x,y,xy: real;
	x2,y2: real;
	r:real;
	k: integer;
begin
 	r:=1;
	x:=0; y:=0;
	k:=iter;               //кол-во итерраций
            {цикл Мандельброта}
	while (k>0)and(r<4) do
    begin
		x2:=x*x;
		y2:=y*y;
		xy:=x*y;
		x:=x2-y2+a;
		y:=2*xy+b;
		r:=x2+y2;
		dec(k)        //уменьшает на единицу к
	end;
	k:=round((k/100)*255);  // приведение полученного K цвету на экране
	MandelBrot:=RGB(k+kr,k+zel,k+sin);  //присвоение цвета фракталу
end;




                {функция построения фрактала Жюлиа}
function Julia(x0,y0: real): TColor;
var
  x,y,x2,y2,xy: real;
  r1: Real;
  speed,k: integer;
begin
    r1:=1;        //Заданный коэффицент
    x:=x0;
    y:=y0;
    k:=iter;      //Колличество итераций

                 {цикл Жюлиа}
    while (k>0)and(r1<4) do
      begin
           r1:=x*x+y*x;
           X2:=X;
           x:=x*x-y*y-a;
           y:=2*x2*y-a;
           dec(k)                  //уменьшает на единицу к
      end;
                                   {round округляет до целого числа }
    k:=round((k/100)*255);           // приведение полученного K цвету на экране
    Julia:=RGB(k+kr,k+zel,k+sin);    //присвоение цвета фракталу

end;




procedure TForm1.TrackBar1Change(Sender: TObject);
begin
edit1.Text:=inttostr(TrackBar1.Position);
end;

procedure TForm1.TrackBar2Change(Sender: TObject);
begin
edit2.Text:=inttostr(TrackBar2.Position);
end;

procedure TForm1.TrackBar3Change(Sender: TObject);
begin
edit3.Text:=inttostr(TrackBar3.Position);
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
TrackBar1.Position:=strtoint(edit1.Text);
end;

procedure TForm1.Edit2Change(Sender: TObject);
begin
TrackBar2.Position:=strtoint(edit2.Text);
end;

procedure TForm1.Edit3Change(Sender: TObject);
begin
TrackBar3.Position:=strtoint(edit3.Text);
end;

procedure TForm1.Button3Click(Sender: TObject);   //сохранение рисунка
var
s:string;

begin
s:=edit5.text;                //считывается название
 SavePictureDialog1.FileName:=s;
 if SavePictureDialog1.Execute
then begin
s:=SavePictureDialog1.FileName;
Image1.Picture.SaveToFile(s+'.bmp');
 ShowMessage(SavePictureDialog1.FileName + ' сохранен рисунок под названием ' + s);
end;
 end;

                               {открытие рисунка в имэйдж}
procedure TForm1.N2Click(Sender: TObject);
var
s:string;

begin
if OpenPictureDialog1.Execute
then begin
s:= OpenPictureDialog1.FileName;
Image1.Picture.LoadFromFile(s);
end;
end;
                                  {закрытие программы}
procedure TForm1.N4Click(Sender: TObject);
begin
close;
end;
                                   {очистка имэйдж}
procedure TForm1.N7Click(Sender: TObject);
begin
Image1.picture:=nil;      //очистка
Form1.Image1.Refresh     //обновление
end;

                             {открытие рисунка в имэйдж}
procedure TForm1.N3Click(Sender: TObject);
var
s:string;

begin
s:=edit5.text;
 SavePictureDialog1.FileName:=s;
 if SavePictureDialog1.Execute
then begin
s:=SavePictureDialog1.FileName;
Image1.Picture.SaveToFile(s+'.bmp');
 ShowMessage(SavePictureDialog1.FileName + ' сохранен рисунок под названием ' + s);
end;
 end;

procedure TForm1.N6Click(Sender: TObject);
begin
if (not Assigned(Form2)) then
Form2:=TForm2.Create(Self);
Form2.Show;
end;

procedure TForm1.N8Click(Sender: TObject);
begin
if (not Assigned(Form3)) then
Form3:=TForm3.Create(Self);
Form3.Show;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
min,max: integer;
hx,hy,x,y: real;
 i,j,n: integer;
 fractal: TColor;

begin
Image1.picture:=nil;
 Image1.Width:=strtoint(Edit10.Text);        //размер имэйдж
 Image1.Height:=strtoint(Edit10.Text);       //размер имэйдж
  Type1:=1;
  kr:=strtoint(Edit1.Text);               //доля красного
  zel:=strtoint(Edit2.Text);             //доля зеленого
  sin:=strtoint(Edit3.Text);            //доля синего
  x_max:=strtofloat(ComboBox2.Text);
  x_min:=strtofloat(ComboBox3.Text);
  y_max:=strtofloat(ComboBox4.Text);
  y_min:=strtofloat(ComboBox5.Text);
   iter:=strtoint(Edit11.Text);
  n:=strtoint(edit10.Text) ;         //размер холста
  y:=y_min;
  a:=strtofloat(ComboBox1.Text);
  hx:=(x_max - x_min)/n;          //сжатие по Х
  hy:=(y_max - y_min)/n;         //сжатие по У
   min:=strtoint(Edit4.Text);
   max:=strtoint(Edit6.Text);
                               {for определяет- где на имейдж рисовать фрактал....}
  for j:=min to max do               //обход всех точек поверхности вывода
  begin
       x:=x_min;
       for i:=min to max do
       begin
            if  RadioButton1.Checked then fractal:=MandelBrot(x,y);
			      if  RadioButton2.Checked then fractal:=Julia(x,y);
            Form1.Image1.Canvas.Pixels[i,j]:=fractal; //прорисовка фрактала
              x:=x+hx;

       end;
           y:=y+hy;

       Form1.Image1.Refresh;  //обновление имэйдж
  end;
   end;
procedure TForm1.BitBtn1Click(Sender: TObject);

var
      hx,hy,x,y: real;
      i,j,n: integer;
      fractal: TColor;

begin
Image1.picture:=nil;
if CheckBox1.Checked = True then begin
if RadioButton1.Checked then begin
ComboBox2.Text:=inttostr(1);
ComboBox3.Text:=inttostr(-2);
ComboBox4.Text:=floattostr(1.2) ;
ComboBox5.Text:=floattostr(-1.2);
 end;                           //так полностью видно фрактал Мандельброта
if RadioButton2.Checked then begin
 ComboBox2.Text:=floattostr(1.5) ;
 ComboBox3.Text:=floattostr(-1.5);
 ComboBox4.Text:=inttostr(1);
 ComboBox5.Text:=inttostr(-1);
 end;                           //так полностью видно фрактал Жюлиа
 end;
 Image1.Width:=strtoint(Edit10.Text);        //размер имэйдж
 Image1.Height:=strtoint(Edit10.Text);       //размер имэйдж
  Type1:=1;
  kr:=strtoint(Edit1.Text);               //доля красного
  zel:=strtoint(Edit2.Text);             //доля зеленого
  sin:=strtoint(Edit3.Text);            //доля синего
  x_max:=strtofloat(ComboBox2.Text);
  x_min:=strtofloat(ComboBox3.Text);
  y_max:=strtofloat(ComboBox4.Text);
  y_min:=strtofloat(ComboBox5.Text);
   iter:=strtoint(Edit11.Text);
  n:=strtoint(edit10.Text) ;         //размер холста
  y:=y_min;
  a:=strtofloat(ComboBox1.Text);
  hx:=(x_max - x_min)/n;          //сжатие по Х
  hy:=(y_max - y_min)/n;         //сжатие по У

                               {цикл определяет- где на имейдж рисовать фрактал....}
  for j:=0 to n do               //обход всех точек поверхности вывода
  begin
       x:=x_min;
       for i:=0 to n do
       begin
            if  RadioButton1.Checked then fractal:=MandelBrot(x,y);
			      if  RadioButton2.Checked then fractal:=Julia(x,y);
            Form1.Image1.Canvas.Pixels[i,j]:=fractal; //прорисовка фрактала
              x:=x+hx;

       end;
           y:=y+hy;

       Form1.Image1.Refresh;  //обновление имэйдж
  end;

end;


                    {координаты курсора}
procedure TForm1.Image1Click(Sender: TObject);
var
  pt: TPoint;
begin
  GetCursorPos(pt);
  pt := ScreenToClient(pt);
  ShowMessage('Coordinates: X=' + IntToStr(pt.X - Image1.Left) +
              ' Y=' + IntToStr(pt.Y - Image1.Top));
  label15.Caption:=inttostr(pt.X - Image1.Left+20);
  label16.Caption:=inttostr(pt.X - Image1.Left-20);
  label17.Caption:=IntToStr(pt.Y - Image1.Top+20);
  label18.Caption:=IntToStr(pt.Y - Image1.Top-20)
end;
end.

[AND_REY]

Вот исходник линзы на Delphi завалялся Glass.rar. Может поможет.