cximage zoom özelliğini ve rect

Delphi'de kod yazma ile ilgili sorularınızı bu foruma yazabilirsiniz.
Cevapla
nodetail
Üye
Mesajlar: 74
Kayıt: 04 Eki 2008 10:30

cximage zoom özelliğini ve rect

Mesaj gönderen nodetail »

Merhaba

cximage1 'de zoom yaptıgım görüntüyü başka bir imege'a almak istiyorum bir nevi crop olacak
ama hep image1'in zoom'suz halini alabiliyorum.

Kod: Tümünü seç

var
bmp1, bmp2 : TBitmap;
Rect1: TRect;
bWidth, bHeight: integer;
begin
with Rect1 do
  begin
    Left := cxImage1.Left;
    Right := 480;
    Top := 0;
    Bottom := 605;
  bWidth:=480;
  bHeight:=605;
  end;

bmp1 := TBitmap.Create;
bmp2 := TBitmap.Create;
bmp2.Width := bWidth;
bmp2.Height := bHeight;
  try
  bmp1.Assign(cximage1.Picture.Graphic);
  bmp2.Canvas.CopyRect(Rect(0, 0, bWidth, bHeight), bmp1.Canvas, Rect1);
  cximage2.Picture.Assign(bmp2)
  finally
  bmp1.Free;
  bmp2.Free;
  end;
zoom edildikten sonraki image1 de görünen görüntüyü nasıl image2'ye alabiliriz.
Kullanıcı avatarı
loaded
Üye
Mesajlar: 122
Kayıt: 12 Eki 2010 09:45
Konum: Konya
İletişim:

Re: cximage zoom özelliğini ve rect

Mesaj gönderen loaded »

Kod: Tümünü seç

 cximage2.Canvas.CopyRect(rect(0,0,cxImage2.Width,cxImage2.Height) ,cxImage1.Canvas,rect(0,0,cxImage1.Width,cxImage1.Height));
Kalk ve işe yarar bir şey yap! Çünkü Allah (c.c.) yeniden başlayanların yardımcısıdır.
nodetail
Üye
Mesajlar: 74
Kayıt: 04 Eki 2008 10:30

Re: cximage zoom özelliğini ve rect

Mesaj gönderen nodetail »

loaded yazdı: 15 Kas 2020 09:08

Kod: Tümünü seç

 cximage2.Canvas.CopyRect(rect(0,0,cxImage2.Width,cxImage2.Height) ,cxImage1.Canvas,rect(0,0,cxImage1.Width,cxImage1.Height));
Incompatible types: 'TCanvas' and 'TcxCanvas'

hatası verdi
Kullanıcı avatarı
loaded
Üye
Mesajlar: 122
Kayıt: 12 Eki 2010 09:45
Konum: Konya
İletişim:

Re: cximage zoom özelliğini ve rect

Mesaj gönderen loaded »

Kusura bakmayın, açıklama yapmam gerekiyordu, Lazarus kullanıyorum, koddaki cximage1 ve 2 aslında image nesneleri, onda da mantık aynıdır diye düşünmüştüm, Lazarusta sorunsuz çalışıyor.
Kalk ve işe yarar bir şey yap! Çünkü Allah (c.c.) yeniden başlayanların yardımcısıdır.
nodetail
Üye
Mesajlar: 74
Kayıt: 04 Eki 2008 10:30

Re: cximage zoom özelliğini ve rect

Mesaj gönderen nodetail »

Benzer kodla alıyorum görüntüyü ama dediğim gibi resmin normal görüntüsünü alıyor, ben zoom yapınca veya scroll barla kenarlara gidince çerçeve içinde kalan alanı almak istiyorum
Kullanıcı avatarı
Commandx
Üye
Mesajlar: 181
Kayıt: 01 Oca 2008 05:34

Re: cximage zoom özelliğini ve rect

Mesaj gönderen Commandx »

bunun için getscreenshot unitinden faydalanacağız.

Kod: Tümünü seç

{  GetScreenShot   bu dosya komponenti gösterdiğinde
o komponentin glyph sini bmp jpg ekran görüntüsnü alır    }

unit GetScreenShot;

interface

uses Classes,Windows,Controls,JPeg,Forms,Graphics,SysUtils;

procedure SaveScreenShot(FileName: String; UseJPEG: Boolean;
                       Quality: integer; Control: TControl);

implementation

procedure SaveScreenShot(FileName: String; UseJPEG: Boolean;
                       Quality: integer; Control: TControl);
var x, y, dx, dy : integer;
   hSourcDC, hDestDC,
   hBM, hbmold : THandle;
   image : TJPEGimage;
   bitmap : TBitmap;
   TempPoint : TPoint;
   TempControl : TControl;
begin
 if (Control = nil) then
 begin
   // no component specified, grab the whole screen
   x := 0;
   y := 0;
   dx := screen.Width;
   dy := screen.Height;
 end
 else
 begin
   if (Control.Parent <> nil) then
   begin
     TempPoint := Control.Parent.ClientToScreen(Control.BoundsRect.TopLeft);
     x := TempPoint.x;
     y := TempPoint.y;
   end
   else
   begin
     if (Control is TForm) then
     begin
       if TForm(Control).FormStyle=fsMDIChild then
       begin
         TempPoint := Control.BoundsRect.TopLeft;
         ClientToScreen(Application.MainForm.ClientHandle,TempPoint);
         x := TempPoint.x;
         y := TempPoint.y;
       end
       else
       begin
         x := Control.BoundsRect.Left;
         y := Control.BoundsRect.Top;
       end;
     end
     else
     begin
       x := Control.Left;
       y := Control.Top;
     end;
   end;

   dx := Control.Width;
   dy := Control.Height;
 end;

 try
   hSourcDC := CreateDC('DISPLAY', nil, nil, nil);
   hDestDC := CreateCompatibleDC(hSourcDC);
   hBM := CreateCompatibleBitMap(hSourcDC, dx, dy);
   hbmold := SelectObject(hDestDC, hBM);
   BitBlt(hDestDC, 0, 0, dx, dy, hSourcDC, x, y, SRCCopy);

   image := TJPEGImage.Create;
   bitmap := TBitmap.Create;
   try
     bitmap.Handle := hBM;
     bitmap.HandleType := bmDIB;

     if (not UseJPEG) then
     begin
       bitmap.SaveToFile(ChangeFileExt(FileName, '.bmp'));
     end
     else
     begin
       // copy the bitmap to the jpeg image
       image.Assign(bitmap);
       // set the quality factor (1..100);
       image.CompressionQuality := Quality;
       // and compress it into JPEG format
       image.Compress;
       // save image to the disk
       image.SaveToFile(ChangeFileExt(FileName, '.jpg'));
     end;
   finally
     image.Free;
     bitmap.Free;
   end;

 finally
   if hbmold <> 0 then
     SelectObject(hDestDC, hbmold);
   if hbm <> 0 then
     DeleteObject(hbm);
   if hDestDC <> 0 then
     DeleteDC(hDestDC);
   if hSourcDC <> 0 then
     DeleteDC(hSourcDC);
 end;
end;

end.

Form üzerine Bir adet open picture dialog iki adet buton , 1 adet jedinin jvmovablebevel komponentini ve iki adet timage nesnesini ekledik

Kod: Tümünü seç

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes,Graphics,Controls,Forms,
  Dialogs, ExtDlgs, StdCtrls,ExtCtrls, JvMovableBevel,jpeg, getscreenshot,JvZoom,
  JvBaseThumbnail, JvThumbnails,CLIPBRD, JvComponentBase, Menus,SHELLAPI,
  Buttons, JvExExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    JvMovableBevel1: TJvMovableBevel;
    BitBtn1: TBitBtn;
    OpenPictureDialog1: TOpenPictureDialog;
    Image2: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    Label3: TLabel;
    procedure BitBtn1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure ResmiBoyutlandir(KaynakResim:string; Y:integer; G:integer);
var
 Bitmap     : TBitmap;
 img1 : TBitmap;
 XRect : TRect;
begin
 try
 Bitmap := TBitmap.Create;
 Bitmap.Width  := Form1.image1.Picture.Width;
 Bitmap.Height := Form1.image1.Picture.Height;
 Bitmap.Canvas.Draw(0, 0,Form1.Image1.Picture.Graphic);
 img1 := TBitmap.Create();
 img1.Height := Y;
 img1.Width := G;
 XRect := Rect(0, 0, G, Y);
 img1.Canvas.StretchDraw(XRect,bitmap);
 Form1.Image1.Picture.Graphic := bitmap; //orijinal resim
 Bitmap.Free;
 img1.Free;
except
 Application.MessageBox('Hata oluştu','Hata',MB_OK+MB_ICONERROR);
end;
end;


procedure TForm1.BitBtn1Click(Sender: TObject);
var
y,x:integer;
 ResimAdi,adi:String;
  ExeStream: TFileStream;
 DOSYA:STRING;
 begin
 try

  y:=(JvMovableBevel1.height);
  x:=(JvMovableBevel1.width);
  adi:=extractfilename(OpenPictureDialog1.FileName);//Resmin Adını Label2 de gösteriyoruz.
  ResimAdi:=(OpenPictureDialog1.FileName);
  ResmiBoyutlandir(resimadi,y,x);
 SaveScreenShot(ExtractFilePath(Application.ExeName)+'\a.jpg',true,255,jvmovablebevel1);
 image2.Picture.LoadFromFile(ExtractFilePath(Application.ExeName)+'\a.jpg');
 DOSYA:=ExtractFilePath(Application.ExeName)+'a.jpg';
  ExeStream := TFileStream.Create(DOSYA, fmOpenRead or fmShareDenyNone);
 try

 finally
  ExeStream.Free;
end;
 except
  end;
//---------FOTOYU 90 C DÖNDÜRME
//-------------------------------------
//---------FOTOYU FLİP VERTICAL
//-------------------------------------


end;

procedure TForm1.Button1Click(Sender: TObject);

 var//Resim'i imageye yüklüyoruz.
 yol:AnsiString;
begin
 if OpenPictureDialog1.Execute Then
 begin
  yol:=OpenPictureDialog1.FileName;
  Image1.Picture.LoadFromFile(yol);
  end;
end;
end.

D7 ile çalışıyor, projelerimde bunu kullanıyorum.
Dosya ekleri
bevel crop.rar
(3.17 KiB) 79 kere indirildi
En son Commandx tarafından 29 Kas 2020 10:26 tarihinde düzenlendi, toplamda 1 kere düzenlendi.
http://www.delphibasics.co.uk/RTL.asp?Name=DaysBetween
http://www.neonhaber.com/Static/mega-co ... index.html
www.delphican.con
Function PARSE( text, ilk, son:String ): String; //
begin
Delete(Text, 1, pos(ilk, Text) + Length(ilk)-1);
Result := Copy(Text, 1, Pos(Son, Text)-1);
end;
Kullanıcı avatarı
loaded
Üye
Mesajlar: 122
Kayıt: 12 Eki 2010 09:45
Konum: Konya
İletişim:

Re: cximage zoom özelliğini ve rect

Mesaj gönderen loaded »

Anladım, o zaman aşağıdaki kod işinizi görecektir. Lazarusta yazılmış ve denenmiştir.

Kod: Tümünü seç

    image2.AutoSize:=true; // Zoom görüntüsünün aktarılacağı İmage Nesnesi
    image2.Stretch:=true;
    image2.Picture.Bitmap.SetSize(ScrollBox1.Width-ScrollBox1.HorzScrollBar.Size-2,ScrollBox1.Height-ScrollBox1.VertScrollBar.Size-2);
    image2.Picture.Bitmap:=Nil;
    image2.Canvas.CopyRect(image2.Canvas.ClipRect,ScrollBox1.Canvas,rect(0,0,ScrollBox1.Canvas.ClipRect.Width,ScrollBox1.Canvas.ClipRect.Height));
Kalk ve işe yarar bir şey yap! Çünkü Allah (c.c.) yeniden başlayanların yardımcısıdır.
nodetail
Üye
Mesajlar: 74
Kayıt: 04 Eki 2008 10:30

Re: cximage zoom özelliğini ve rect

Mesaj gönderen nodetail »

İlginize çok teşekkürler 3.parti bir bileşenle çözdüm şimdilik
Cevapla