关于图像(100分)

  • 主题发起人 主题发起人 liuove
  • 开始时间 开始时间
L

liuove

Unregistered / Unconfirmed
GUEST, unregistred user!
1.抓取屏幕上任意大小的图像比如在(100,100)--(300,300)处抓出来保存成BMP图
2.JPEG图像大变小的问题如:800*600的图变成200*150 怎么图像颜色老变重?
 
1、
var deaktopcanvas:tcanvas;
I:INTEGER;
point:tpoint;
begin
deaktopcanvas:=tcanvas.create;
deaktopcanvas.handle:=getdc(hwnd_desktop);
form1.Visible:=false;
try
BITMAP.Canvas.CopyMode:=CMSRCCOPY;
bitmap.canvas.copyrect(BITMAP.Canvas.cliprect,
deaktopcanvas,deaktopcanvas.cliprect);
point:=mouse.CursorPos ;
bitmap.Canvas.draw(point.x,point.y,mousebmp);
i:=1;
while i=1 do
begin
try
MyJpeg.Assign(Bitmap); // Assign the BitMap to MyJpeg object
MyJpeg.SaveToFile('1.JPG'); // Save the JPEG to Disk
I:=2;
except
i:=1;
end;
end;
finally
releasedc(handle,hwnd_desktop);
end;
end;
 
感谢, 不过试了下不太好用.我现在要在屏上100,100 200,200 给截下来,放在form1的image1 里.详细告诉我一下好吗?(加分!)
 
原来的代码,重写个
procedure TForm1.Button1Click(Sender: TObject);
var deaktopcanvas:tcanvas;
begin

deaktopcanvas:=tcanvas.create;
deaktopcanvas.handle:=getdc(hwnd_desktop);
try
Image1.Picture.Bitmap.Canvas.CopyMode:=CMSRCCOPY;
image1.Picture.bitmap.canvas.copyrect(rect(100,100,200,200),
deaktopcanvas,rect(100,100,200,200));
finally
releasedc(handle,hwnd_desktop);
end;
end;
 
帮我分析一下这段:
var fullscreen:Tbitmap;
fullscreencanvs:tcanvas;
dc:hdc;
Begin
fullscreen:=Tbitmap.creat;
fullscreen.width:=100;
fullscreen.height:=200;
dc:=getdc(0);
fullscreencanvas:=tcanvas.creat;
fullscreencanvas.handle:=dc;
fullscreen.canvas.copyrect(rect(0,0,screen.width,screen.height),fullscreencanvas,
rect(0,0,screen.width,screen.height);
fullscreencanvas.free;
releasedc(0,dc);
image1.picture.bitmap:=fullscreen;
image1.heigth:=fullscreen.height;
image1.width:=fullscreen.width;
fullscreen.free;

////不管怎么改坐标参数,它总是从屏幕左上角开始抓啊?
///好不容易改过来了,可以图像不是放大了,就是缩小了,我要的是原图的大小啊.
 

问题一:
//Joe
//******************
//下面的代码抓矩形:
function CaptureScreen(const Rect: TRect; const BitDepth: TPixelFormat =
pfDevice): TBitmap;
var
hDC: Windows.HDC;
hDesktop: THandle;
begin
// create and define the bitmap
Result := Graphics.TBitmap.Create;

try
case BitDepth of
pfCustom, pfDevice:
Result.PixelFormat := pfDevice;
else
Result.PixelFormat := BitDepth;
end;

Result.Width := Rect.Right - Rect.Left;
Result.Height := Rect.Bottom - Rect.Top;

hDesktop := GetDeskTopWindow();
hDC := GetDC(hDesktop);
try
BitBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, hDC,
Rect.Left, Rect.Top, SRCCOPY);
finally
ReleaseDC(hDesktop, hDC);
end;

except
FreeAndNil(Result);
end;
end;
 
你的代码,最少有十处错误。
下面的代码,copy ARect范围的屏幕
procedure TForm1.Button1Click(Sender: TObject);
var fullscreen:Tbitmap;
fullscreencanvas:tcanvas;
dc:hdc;
aRect:TRect;
Begin
aRect:=Rect(0,0,200,200);
fullscreen:=Tbitmap.create;
fullscreen.width:=Arect.Right-Arect.Left;
fullscreen.height:=ARect.Bottom-Arect.Top;
dc:=getdc(0);
fullscreencanvas:=tcanvas.create;
fullscreencanvas.handle:=dc;
fullscreen.canvas.copyrect(rect(0,0,Fullscreen.Width,Fullscreen.height),fullscreencanvas,
ARect);
fullscreencanvas.free;
releasedc(0,dc);
image1.picture.bitmap:=fullscreen;
image1.height:=fullscreen.height;
image1.width:=fullscreen.width;
fullscreen.free;
end;
 
好的,谢谢!
帮我解决一下第二个问题怎么样?
 
不会,如果你有线索可以一起研究一下
 
后退
顶部