關於delphi截圖(20分)

  • 主题发起人 主题发起人 pllink_qyd
  • 开始时间 开始时间
P

pllink_qyd

Unregistered / Unconfirmed
GUEST, unregistred user!
我用這段代碼。。別人給我的。為什麼不行阿?誰能告訴應該怎麼改嗎?謝謝
procedure TForm1.Button1Click(Sender: TObject);
var
Mybmp : Tbitmap;
Mycan : Tcanvas;
cx,cy,dc: Integer; // 屏幕尺寸
R : TRect;
FPixFmt : TPixelFormat;
begin
Mybmp := Tbitmap.Create;
Mycan := TCanvas.Create; //屏幕截取
dc := GetwindowDC(0);
try
Mycan.Handle := dc;
cx := GetSystemMetrics(SM_CXSCREEN);
cy := GetSystemMetrics(SM_CYSCREEN);
R := Rect(0, 0, cx, cy);
Mybmp.Width := R.Right;
Mybmp.Height := R.Bottom;
Mybmp.PixelFormat := FPixFmt;
//BitBlt(Mybmp.Canvas.Handle, 0, 0, cx, cy, Mycan.Handle, 0, 0, SRCCOPY);
Mybmp.Canvas.CopyRect(R, Mycan, R);
finally
releaseDC(0, DC);
end;
Mycan.Handle := 0;
Mycan.Free;
end;
 
以上代碼要如何修改。。可以做的跟QQ截圖一樣阿?感謝各位達人了…
 
那个没有设置FPixFmt的值,(pfDevice, pf1bit, pf4bit, pf8bit, pf15bit, pf16bit, pf24bit, pf32bit, pfCustom)
 
procedure TForm1.Button1Click(Sender: TObject);
var
Mybmp : Tbitmap;
Mycan : Tcanvas;
cx,cy,dc: Integer;
R : TRect;
FPixFmt : TPixelFormat;
begin
FPixFmt := pf32bit;
Mybmp := Tbitmap.Create;
Mycan := TCanvas.Create;
dc := GetwindowDC(0);
try
Mycan.Handle := dc;
cx := GetSystemMetrics(SM_CXSCREEN);
cy := GetSystemMetrics(SM_CYSCREEN);
R := Rect(0, 0, cx, cy);
Mybmp.Width := R.Right;
Mybmp.Height := R.Bottom;
Mybmp.PixelFormat := FPixFmt;
BitBlt(Mybmp.Canvas.Handle, 0, 0, cx, cy, Mycan.Handle, 0, 0, SRCCOPY);
Mybmp.Canvas.CopyRect(R, Mycan, R);
finally
releaseDC(0, DC);
end;
Mycan.Handle := 0;
Mycan.Free;

self.Image1.Picture.Bitmap := Mybmp;
end;
 
謝謝。。那能不能想QQ那樣不是取固定位置的圖片。而是用拉的阿?隨便拉取。保存到Image1裡
 
简单点的方法,就是把hb_126截的图放到image里,通过鼠标选择再截一次,再放到某处
 
呵呵。。不好意思。我理解不了。。能具體點嗎?用代碼來現實嗎?謝謝。。
還有有什麼函數可以獲取當前鼠標的x,y坐標阿?
 
一个简单的例子
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Buttons;

type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
Button2: TButton;
procedure Button2Click(Sender: TObject);
private
MouX, MouY: Integer;
procedure KeyDown1(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure MouseDown1(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure MouseUp1(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);
var
FForm: TForm;
l:longint;
begin
Application.CreateForm(TForm,FForm);
with FForm do
begin
WindowState := wsMaximized;
BorderStyle := bsNone;
l:=GetWindowLong(Handle, GWL_EXSTYLE);
l := l Or $80000;
SetWindowLong (Handle, GWL_EXSTYLE, l);
SetLayeredWindowAttributes(Handle, 0, 1, 2);
OnKeyDown := KeyDown1;
OnMouseDown := MouseDown1;
OnMouseUp := MouseUp1;
ShowModal;
end;
end;

procedure TForm1.KeyDown1(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VK_ESCAPE then
begin
(Sender as TForm).Close;
end;
end;

procedure TForm1.MouseDown1(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
p: TPoint;
begin
GetCursorPos(P);
MouX := P.X;
MouY := p.Y;
end;

procedure TForm1.MouseUp1(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Mybmp : Tbitmap;
Mycan : Tcanvas;
dc: Integer;
R : TRect;
FPixFmt : TPixelFormat;
p: TPoint;
begin
FPixFmt := pf32bit;
Mybmp := Tbitmap.Create;
Mycan := TCanvas.Create;
dc := GetwindowDC(0);
try
Mycan.Handle := DC;
GetCursorPos(P);
R := Rect(MouX, MouY, P.X, P.Y);
Mybmp.Width := R.Right;
Mybmp.Height := R.Bottom;
Mybmp.PixelFormat := FPixFmt;
BitBlt(Mybmp.Canvas.Handle, MouX, MouY, P.X, P.Y, Mycan.Handle, 0, 0, SRCCOPY);
Mybmp.Canvas.CopyRect(R, Mycan, R);
finally
ReleaseDC(0, DC);
end;
Mycan.Handle := 0;
Mycan.Free;

self.Image1.Picture.Bitmap := Mybmp;
end;

end.
 
hb_126:首先很感謝你為我解答,那少少分就當我的一點心意吧。。我的MSN,qyd_0591@hotmail.com..希望你能加我。。做個朋友。其實我想拜師。
其次,為什麼你最後的那個我運行的時候。。會提示這個錯誤:
Project Project1.exe raised exception class EReadError with message 'Invalid property value'.
這個是什麼原因阿?
 
后退
顶部