Snootae
Grandmaster Cheater
![]() Reputation: 0
Joined: 16 Dec 2006
Posts: 969
Location: --->
|
 Posted: Mon Jun 02, 2008 2:59 am Post subject: [Delphi] Screen shot application |
 |
|
this is just a little screen shot app i made cos i was bored, it simply takes a screenshot of current window when a hotkey is pressed, and saves it
it also is always on top, so you can see easy
Simply press Ctrl + S to take a screenshot
Code:
| Code: | unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Edit1: TEdit;
Label3: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
id1: Integer;
procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
public
{ Public declarations }
end;
var
Form1: TForm1;
i : integer;
implementation
{$R *.dfm}
procedure ScreenShot(activeWindow: bool; destBitmap : TBitmap) ;
var
w,h : integer;
DC : HDC;
hWin : Cardinal;
r : TRect;
begin
if activeWindow then
begin
hWin := GetForegroundWindow;
dc := GetWindowDC(hWin) ;
GetWindowRect(hWin,r) ;
w := r.Right - r.Left;
h := r.Bottom - r.Top;
end
else
begin
hWin := GetDesktopWindow;
dc := GetDC(hWin) ;
w := GetDeviceCaps (DC, HORZRES) ;
h := GetDeviceCaps (DC, VERTRES) ;
end;
try
destBitmap.Width := w;
destBitmap.Height := h;
BitBlt(destBitmap.Canvas.Handle,
0,
0,
destBitmap.Width,
destBitmap.Height,
DC,
0,
0,
SRCCOPY) ;
finally
ReleaseDC(hWin, DC) ;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
id1 := GlobalAddAtom('Hotkey1');
RegisterHotKey(Handle, id1, MOD_CONTROL, $53);
with Self do {Form1,...}
SetWindowPos(Handle, // handle to window
HWND_TOPMOST, // placement-order handle {*}
Left, // horizontal position
Top, // vertical position
Width,
Height,
// window-positioning options
SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
UnRegisterHotKey(Handle, id1);
GlobalDeleteAtom(id1);
end;
procedure TForm1.WMHotKey(var Msg: TWMHotKey);
var
b:TBitmap;
begin
if Msg.HotKey = id1 then
i := i + 1;
b := TBitmap.Create;
try
ScreenShot(TRUE, b) ;
b.SaveToFile(Edit1.Text + IntToStr(i) + '.bmp');
finally
b.FreeImage;
FreeAndNil(b) ;
Label1.caption := 'Screen Saved';
Label2.caption := Edit1.Text + IntToStr(i) + '.bmp';
end;
end;
end. |
its fairly self-explanitory, i got the screen shot code from http://delphi.about.com/od/adptips2006/qt/captureactive.htm
all i did was added the hotkeys and saving options
_________________
|
|
FAQ
Search
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
