Resim üzerinde zoom penceresi

[davut]

form üzerindeki TImage üzerinde bir zoom penceresi koymak istiyorum. Biraz araştırmadan sonra bir kod buldum, fakat resmin orjinalinden değilde, ekrandaki görüntüsünü büyüttüğü için işimi görmüyor. (işine yarayacak olan varsa mesaja ekleyebilirim)

Benim istediğim
örnek olarak, 1200*1024 boyutundaki bir bitmap i form üzerinde strech yapılmış bir TImage üzerinde orjinal boyutundan küçük görünen bir resmin üzerinde farenin koordinatına göre görüntüyü büyüterek başka bir TImage nesnesinde göstermek. Resmin üzerinde bir çeşit büyüteç gibi.
bunu nasıl yapabiliriz?

[danaci]

kodu mesaj içeriğine ekleyebilirmisiniz

[loxka]

Jedi komponentlerin içinde TJvZoom adlı bir component var, bahsettiğiniz işlemi gayet güzel yapıyor.

[sTb]

S.A.
image1 in size nı 320 x 240 olarak ayarlayıp bir resim ekleyin.
image2 de zoom lanmış halini gösterecektir.

Kod: Tümünü seç

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
const
 CopyWidth = 100; 
 CopyHeight = 100;
 var
 w,h:integer;
begin

  w:=X*image1.Picture.Width div 320;
  h:=Y*image1.Picture.Height div 240;
  Image2.Picture.Bitmap.Width := CopyWidth;
  Image2.Picture.Bitmap.Height := CopyHeight;
  Image2.Picture.Bitmap.Canvas.CopyRect(Rect(0, 0, CopyWidth, CopyHeight), Image1.Picture.Bitmap.Canvas, Rect(w, h, CopyWidth + w, CopyHeight + h));
end;

kolay gelsin.

[davut]

kodu mesaj içeriğine ekleyebilirmisiniz

Kod: Tümünü seç

procedure TForm1.WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
begin
   inherited;
   Msg.MinMaxInfo^.ptMinTrackSize := Point(158, 177); // min form size
   Msg.MinMaxInfo^.ptMaxTrackSize := Point(350, 350); // max form size (width, height)
end;


procedure TForm1.FormResize(Sender: TObject);
begin
		// panel in the middle of the form
  Panel1.Left:=(Form1.ClientWidth Div 2) - Panel1.Width div 2;
  Panel1.Top:=(Form1.ClientHeight Div 2) - Panel1.Height div 2;
  Image1.Picture:=nil;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
	Timer1.Interval:=0;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Srect,Drect,PosForme:TRect;
  iWidth,iHeight,DmX,DmY:Integer;
  iTmpX,iTmpY:Real;
  C:TCanvas;
  hDesktop: Hwnd;
  Kursor:TPoint;
begin
 If not IsIconic(Application.Handle) then begin
  hDesktop:= form2.Handle;
  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;

 	 iWidth:=Image1.Width;
		 iHeight:=Image1.Height;
    Drect:=Rect(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));
    // 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));

   C:=TCanvas.Create;
   try
     C.Handle:=GetDC(FORM2.Handle);
     Image1.Canvas.CopyRect(Drect,C,Srect);
    finally
      ReleaseDC(hDesktop, C.Handle);
      C.Free;
    end;
    If cbSrediste.Checked=True then begin // show crosshair
    	with Image1.Canvas do begin
        DmX:=Slider.Position * 2 * (Kursor.X-Srect.Left);
        DmY:=Slider.Position * 2 * (Kursor.Y-Srect.Top);
   		 MoveTo(DmX - (iWidth div 4),DmY); // -
   		 LineTo(DmX + (iWidth div 4),DmY); // -
    		 MoveTo(DmX,DmY - (iHeight div 4)); // |
   		 LineTo(DmX,DmY + (iHeight div 4)); // |
      end; // with image1.Canvas
    end; // show crosshair
  	Application.ProcessMessages;
	end // Cursor not inside form
   else begin  // cursor inside form
   	If Panel1.Visible=False then Panel1.Visible:=True;
   	If Image1.Visible=True then Image1.Visible:=False;
  end;
 end; // IsIconic
end;

[davut]

S.A.
image1 in size nı 320 x 240 olarak ayarlayıp bir resim ekleyin.
image2 de zoom lanmış halini gösterecektir.

Kod: Tümünü seç

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
const
 CopyWidth = 100; 
 CopyHeight = 100;
 var
 w,h:integer;
begin

  w:=X*image1.Picture.Width div 320;
  h:=Y*image1.Picture.Height div 240;
  Image2.Picture.Bitmap.Width := CopyWidth;
  Image2.Picture.Bitmap.Height := CopyHeight;
  Image2.Picture.Bitmap.Canvas.CopyRect(Rect(0, 0, CopyWidth, CopyHeight), Image1.Picture.Bitmap.Canvas, Rect(w, h, CopyWidth + w, CopyHeight + h));
end;

kolay gelsin.

a.s.
bu kodu deneyince aslında güzel, fakat image1'e bmp değilde jpeg bir resim ekleyince image2 de boş gösteriyor. Bu sorunu nasıl çözebiliriz? jpeg dosya okunurken bitmap e nasıl çevrilir?

teşekkürler.

[sTb]

Kod: Tümünü seç

  var
  img:tbitmap;
  begin
  img:=tbitmap.create;
  img.Assign(image1.Picture.Graphic);
  Image2.Picture.Bitmap.Canvas.CopyRect(Rect(0, 0, 100, 100), img.Canvas, Rect(w, h, 100 + w, 100 + h));
  img.free;

şeklinde jpg veya bmp resimler içinde kullanabilirsiniz.

[davut]

çok sağol, bu işimi görecek herhalde.

Image1 i strech olarak ayarladım, image2 de orjinal boyutunu gösteriyor.

aslında diğer örnekteki gibi zoompercent ini ayarlayabilsek çok şık olurdu... (Slider.Position * 4 diyor ya, slider dediği bir trackbar, zoom 2x 3x 4x gibi seçenek yapılabilir). ama bu kod farklı bir mantıkla çalışıyor.

[sTb]

3 tane radiobutton ilave edip kodu aşaıdaki şekilde değiştiriniz.
Ek olarak; image1 in boyutunu istenilen şekilde ayarlayabilirsiniz ( ilk örnekte 320/240 olması şarttı)

Kod: Tümünü seç

var
 w,h,CopyWidth,CopyHeight:integer;
 img:tbitmap;
begin
  if radiobutton1.Checked then
   begin
    CopyWidth:=100;
    CopyHeight:=100;
   end;
  if radiobutton2.Checked then
   begin
    CopyWidth:=50;
    CopyHeight:=50;
   end;
  if radiobutton3.Checked then
   begin
    CopyWidth:=25;
    CopyHeight:=25;
   end;
  w:=X*image1.Picture.Width div image1.width; 
  h:=Y*image1.Picture.Height div image1.height;
  Image2.Picture.Bitmap.Width := 100;// CopyWidth;
  Image2.Picture.Bitmap.Height := 100;//CopyHeight;
  img:=tbitmap.create;
  img.Assign(image1.Picture.Graphic);
  Image2.Picture.Bitmap.Canvas.CopyRect(Rect(0, 0, 100, 100), img.Canvas, Rect(w, h, CopyWidth + w, CopyHeight + h));
  img.free;

Madem bişiler yapıyoruz şık olsun o zaman değil mi ?

Kolay gelsin...

[davut]

teşekkürler kardeş, bu kodlar sayesinde tatmin edici birşeyler ortaya çıktı.