这个是截屏的东西
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, RzTray, ImgList, TB2Item, TBSkinPlus, Menus, Clipbrd, Unit2;
const
MappingFileName = 'HookHandleFile';
WM_MOUSEHOOK = WM_USER + 1;
type
TForm1 = class(TForm)
RzTrayIcon1: TRzTrayIcon;
TBPopupMenu1: TTBPopupMenu;
TBSkin1: TTBSkin;
TBItem1: TTBItem;
TBImageList1: TTBImageList;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBItem1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
FScreenCanvas: TCanvas;
FBitmap: TBitmap;
FClipboard: TClipboard;
FEnable: Boolean;
FHFileMapping: Cardinal;
FHotKeyID1: Integer;
FHotKeyID2: Integer;
FPtStart: TPoint;
FPtEnd: TPoint;
FMouseDown: Boolean;
procedure WMHotKey(var Msg: TMessage); message WM_HOTKEY;
procedure WMMouseHook(var Msg: TMessage); message WM_MOUSEHOOK;
procedure EraseBkGnd(var Msg: TMessage); message WM_ERASEBKGND;
procedure DrawRect(pStart, pEnd: TPoint);
procedure CopyBitmap(pStart, pEnd: TPoint);
procedure DrawCurrsor;
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function SetHook: Boolean; stdcall; external 'Project2.dll';
function UnHook: Boolean; stdcall; external 'Project2.dll';
procedure TForm1.FormCreate(Sender: TObject);
var
P: ^Cardinal;
begin
FMouseDown := False;
FEnable := False;
FBitmap := TBitmap.Create;
FClipboard := TClipboard.Create;
FScreenCanvas := TCanvas.Create;
FHotKeyID1 := GlobalAddAtom('F1');
FHotKeyID2 := GlobalAddAtom('F2');
if not RegisterHotKey(Handle, FHotKeyID1, MOD_CONTROL, VK_TAB) then
MessageBox(Handle, PChar('热键注册失败'), PChar('提示'), MB_OK);
if not RegisterHotKey(Handle, FHotKeyID2, MOD_CONTROL, Word('Q')) then
MessageBox(Handle, PChar('热键注册失败'), PChar('提示'), MB_OK);
FHFileMapping := CreateFileMapping(0, nil, PAGE_READWRITE, 0, SizeOf(Integer), MappingFileName);
P := MapViewOfFile(FHFileMapping, FILE_SHARE_WRITE, 0, 0, 0);
P^ := Handle;
if not SetHook then
MessageBox(Handle, PChar('安装钩子失败'), PChar('提示'), MB_OK);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
GlobalDeleteAtom(FHotKeyID1);
GlobalDeleteAtom(FHotKeyID2);
CloseHandle(FHFileMapping);
UnHook;
FScreenCanvas.Free;
FClipboard.Free;
FBitmap.Free;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
ShowWindow(Application.Handle, SW_HIDE);
end;
procedure TForm1.EraseBkGnd(var Msg: TMessage);
begin
;
end;
procedure TForm1.WMHotKey(var Msg: TMessage);
begin
case Msg.LParamHi of
VK_TAB:
begin
//DrawCurrsor;
FEnable := True;
Visible := True;
end;
Word('Q'): Close;
end;
end;
procedure TForm1.TBItem1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.WMMouseHook(var Msg: TMessage);
begin
if not FEnable then Exit;
case Msg.WParam of
WM_LBUTTONDOWN:
begin
FMouseDown := True;
FPtStart.X := Msg.LParamLo;
FPtStart.Y := Msg.LParamHi;
FPtEnd.X := Msg.LParamLo;
FPtEnd.Y := Msg.LParamHi;
end;
WM_LBUTTONUP:
begin
FMouseDown := False;
DrawRect(FPtStart, FPtEnd);
CopyBitmap(FPtStart, FPtEnd);
FEnable := False;
Visible := False;
end;
WM_MOUSEMOVE:
begin
if FMouseDown then
begin
if (FPtStart.X <> FPtEnd.X) and (FPtStart.Y <> FPtEnd.Y) then
DrawRect(FPtStart, FPtEnd);
FPtEnd.X := Msg.LParamLo;
FPtEnd.Y := Msg.LParamHi;
if (FPtStart.X <> FPtEnd.X) and (FPtStart.Y <> FPtEnd.Y) then
DrawRect(FPtStart, FPtEnd);
end;
end;
end;
end;
procedure TForm1.DrawRect(pStart, pEnd: TPoint);
var
ARect: TRect;
begin
if pStart.X < pEnd.X then
begin
ARect.Left := pStart.X;
ARect.Right := pEnd.X;
end else
begin
ARect.Left := pEnd.X;
ARect.Right := pStart.X;
end;
if pStart.Y < pEnd.Y then
begin
ARect.Top := pStart.Y;
ARect.Bottom := pEnd.Y;
end else
begin
ARect.Top := pEnd.Y;
ARect.Bottom := pStart.Y;
end;
FScreenCanvas.Handle := GetDC(0);
FScreenCanvas.DrawFocusRect(ARect);
ReleaseDC(0, FScreenCanvas.Handle);
end;
procedure TForm1.CopyBitmap(pStart, pEnd: TPoint);
var
ARect: TRect;
begin
if pStart.X < pEnd.X then
begin
ARect.Left := pStart.X;
ARect.Right := pEnd.X;
end else
begin
ARect.Left := pEnd.X;
ARect.Right := pStart.X;
end;
if pStart.Y < pEnd.Y then
begin
ARect.Top := pStart.Y;
ARect.Bottom := pEnd.Y;
end else
begin
ARect.Top := pEnd.Y;
ARect.Bottom := pStart.Y;
end;
FBitmap.FreeImage;
FBitmap.Width := ARect.Right - ARect.Left;
FBitmap.Height := ARect.Bottom - ARect.Top;
FScreenCanvas.Handle := GetDC(0);
FBitmap.Canvas.CopyRect(Rect(0, 0, FBitmap.Width, FBitmap.Height), FScreenCanvas, ARect);
ReleaseDC(0, FScreenCanvas.Handle);
FClipboard.Assign(FBitmap)
end;
procedure TForm1.DrawCurrsor;
var
pt: TPoint;
ico: TIcon;
begin
if not GetCursorPos(pt) then Exit;
Application.ProcessMessages;
ico := TIcon.Create;
ico.Handle:= GetCursor;
FScreenCanvas.Draw(pt.X, pt.Y, ico);
ico.Free;
end;
end.
按热键Ctrl+Table开始,拉裁减框有了,获取裁剪框的图片也有了,自己需要Load张图片放窗体上,要把位图转换为jpg,我想可以不用转,直接用jpg的Canvas进行拷贝就行了。我是把截取的图放到了剪贴板