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.