Büyüteç (Zoom tool) yapımı?

[Sedat Atif]

Merhaba,

Sistemi fazla yormayan bir büyüteç nasıl yapabilirim? Hani açılınca ekrandaki herhangi bir alanın büyütülmüş görüntüsünü gösteren programcıklardan... Bir takım kodlar buldum ama performansı düşük bilgisayarlarda bir süre açık kalınca sorun çıkardı...

Teşekkürler.

[husonet]

Merhaba

Bunun için formuna 1 adet mouse, 1 adet panel ve 1 adet timer bileşeni yerleştir. Timer bileşeninin intevral özelliğiniz 25 yap.


Örnek

Kod: Tümünü seç

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Srect,Drect,PosForme:TRect;
  iWidth,iHeight,DmX,DmY:Integer;
  iTmpX,iTmpY:Real;
  C:TCanvas;
  Kursor:TPoint;
  ZoomFactor: Integer;
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;
     iWidth:=Image1.Width;
     iHeight:=Image1.Height;
     Drect:=Rect(0,0,iWidth,iHeight);

     { 2x kadar büyütür. 4x icin 2, ...}
     ZoomFactor := 1;
     iTmpX:=iWidth / (ZoomFactor * 4);
     iTmpY:=iHeight / (ZoomFactor * 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(GetDesktopWindow);
       Image1.Canvas.CopyRect(Drect,C,Srect);
     finally
       C.Free;
     end;
     Application.ProcessMessages;
  end // Cursor Form'un icinde degil
  else
  begin  // cursor Form'un icinde
    If Panel1.Visible=False then Panel1.Visible:=True;
    If Image1.Visible=True then Image1.Visible:=False;
  end;
end;

Kolay Gelsin...

[Sedat Atif]

İşte bahsettiğim kod bu kod, bunu kullanınca bir süre sonra bilgisayar iyice yavaşlıyor, en sonunda da "canvas does not allow drawing" vs gibi hatalar çıkıyor ard arda.

Ne yapabilirim?

[husonet]

Nekadar zaman geçtikten sonra yavaşlamaya başlıyor.

[husonet]

20 dakikadır çalıştırıyorum hiç bir problem yok ne bir yavaşlama nede başka birşey Makinam P 4.1,5 işletim sistemim XP Delphi 6 kullanıyorum.

Kolay Gelsin...

[mussimsek]

Merhaba,

Win9x serisi (95/98/ME) işletim sistemi kullanıyorsanız, bunların GDI kaynakları son derece sınırlı olduğu için bu tip problemler çok çıkıyor. Kesin çözüm NT tabanlı bir sisteme geçmek.

Kolay gelsin.

[Sedat Atif]

Merhaba.

Önceden dediğim gibi sadece eski sistemlerde (P3 800) olmuyormuş, yeni sayılabileceklerde de oluyormuş.

Test sistemi:
WinXP Pro
Celeron 1700
512 MB RAM

Program Delphi 6 ile yapıldı, test sırasında Delphi açık değildi.

Yeni bir program oluşturulup hiçbir ayar değiştirilmeden bir TImage, bir TPanel, bir TTimer yerleştirildi ve gerekli kodlar kopyalanıp yapıştırıldı. Ha, TTimer'ın intevral özelliği 25 yapıldı tabi.

Delphi kapatılıp Project1.exe çalıştırıldı. Birkaç dakika sonra sistemde yavaşlama başladı. Yaklaşık 10 dakika geçtiğinde ard arda "Canvas does not allow drawing" hataları alınmaya başlandı. Öyle ki task manager'ı açıp project1'i terminate etmekte oldukça zorlanıldı. Ne yazık ki...

Not: Daha önceki denememden hatırladığım kadarıyla TTimer'ın intevral özelliğine daha büyük değerler girildiğinde hata mesajları daha geç çıkıyor.

[husonet]

Arkadaşlar işyerindeki makinada Test ettim aynı problemi 25 dakika sonra bendede veriyor.

İlginç

[husonet]

Merhaba
Arkadaşlar Kodun orjinali buldum ve biraz düzenleme yaptım kodda şimdilik bir problem yok gibi yinede test edip sonuçları yazarsanız memnun olurum.

Kod: Tümünü seç

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Srect,Drect,PosForme:TRect;
  iWidth,iHeight,DmX,DmY:Integer;
  iTmpX,iTmpY:Real;
  C:TCanvas;
  hDesktop: Hwnd;
  Kursor:TPoint;
  ZoomFactor: Integer;
begin
 If not IsIconic(Application.Handle) then
 begin
    hDesktop:= GetDesktopWindow;
    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);
            { 2x kadar büyütür. 4x icin 2, ...}
            ZoomFactor := 1;
            iTmpX:=iWidth / (ZoomFactor * 4);
            iTmpY:=iHeight / (ZoomFactor * 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(GetDesktopWindow);
                Image1.Canvas.CopyRect(Drect,C,Srect);
            finally
                ReleaseDC(hDesktop, C.Handle);
                C.Free;
            end;
            with Image1.Canvas do
            begin
                DmX:=ZoomFactor * 4 * (Kursor.X-Srect.Left);
                DmY:=ZoomFactor * 4 * (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
            Application.ProcessMessages;
    end // Cursor Form'un icinde degil
    else
    begin  // cursor Form'un icinde
    If Panel1.Visible=False then
        Panel1.Visible:=True;
    If Image1.Visible=True then
        Image1.Visible:=False;
    end;
 end;
End;

Kolay Gelsin...

[mege]

Kod: Tümünü seç

finally
  ReleaseDC(hDesktop, C.Handle);
  C.Free;
end; 

hocam koddaki şu fark memoryi şişiriyor olabilir.

The ReleaseDC function releases a device context (DC), freeing it for use by other applications....
The application must call the ReleaseDC function for each call to the GetWindowDC function and for each call to the GetDC function that retrieves a common DC....

Kaynak : http://msdn.microsoft.com/library/defau ... s_66hv.asp