Screenshot des Windows-Desktops

[manfred07]

Hi Leute,

ich hätte da mal eine Frage im Bezug Screenshot des Windows-Desktops.
Wie kann ich einen bestimmten Ausschnitt vom Desktop als Bitmap in Image1 kopieren ?
Und wie kann ich einen bestimmten Ausschnitt von einen Formular als Bitmap in eine Image1 kopieren?

zum Beispiel

Desktop: von left:=150;
von top:=200;
und der Ausschnitt 200X200 Pixel

und beim Formular auch so.

Wäre echt super von euch wenn ihr mir da helfen könnte.
Vielen Dank in vorraus.

Mit freundlichen Gruß

Manfred

[manfred07]

Hi Leute,
ich hätte da mal eine Frage im Bezug Screenshot des Windows-Desktops. Wie kann ich einen bestimmten Ausschnitt vom Desktop als Bitmap in Image1 kopieren ? Und wie kann ich einen bestimmten Ausschnitt von einen Formular als Bitmap in eine Image1 kopieren?

zum Beispiel

Desktop: von left:=150; von top:=200; und der Ausschnitt 200X200 Pixel

und beim Formular auch so.

Wäre echt super von euch wenn ihr mir da helfen könnte. Vielen Dank in vorraus.

Mit freundlichen Gruß

Manfre

[Gast_1]

__________________________________________________ _______
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,clipbrd, StdCtrls, Buttons, ExtCtrls, IdMessage, IdBaseComponent,
IdComponent, IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP,
ToolWin, ComCtrls, jpeg, ExtDlgs;

type
TForm1 = class(TForm)
Image1: TImage;
CoolBar1: TCoolBar;
Timer1: TTimer;
Image2: TImage;
SaveDialog1: TSaveDialog;
Panel1: TPanel;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
Edit1: TEdit;
procedure FormCreate(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure SaveDialog1CanClose(Sender: TObject; var CanClose: Boolean);
procedure CheckBox1Click(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);

private
function CaptureDesktop: TBitmap;
procedure CopyToClipboard;
procedure SetDelay ( const Value: Integer );
procedure SetAutomatic ( const Value: Boolean );
procedure SetMinimized ( const Value: Boolean );

{ Private declarations }
public

{ Public declarations }

end;

var
Form1: TForm1;
fAutomatic: Boolean; // send image to clipboard
fBitmap: TBitmap; // captured bitmap
fDelay: Integer; // delay for screen refresh - may be set by enduser in Delay property
fMinimized: Boolean;
fOnCapture: TNotifyEvent; // fires after capture
s:integer;
auto:integer;
implementation

{$R *.dfm}
function Tform1.CaptureDesktop: TBitmap;
var
Handles: HWND;
ScreenDC: HDC;
Rect: TRect;
lpPal: PLogPalette;
begin
// Get mainform out of the way
if fMinimized then
Application.Minimize;
// Give screen time to refresh by delay
Sleep ( fDelay );
Handles := GetDesktopWindow ( );
ScreenDC := GetDC ( Handles );
GetWindowRect ( Handles, Rect );
// do we have a palette device? - Thanks to Joe C. Hecht
if ( GetDeviceCaps ( ScreenDC, RASTERCAPS ) and RC_PALETTE = RC_PALETTE ) then
begin
// allocate memory for a logical palette
GetMem ( lpPal, sizeof ( TLOGPALETTE ) + ( 255 * sizeof ( TPALETTEENTRY ) ) );
// zero it out to be neat
FillChar ( lpPal^, sizeof ( TLOGPALETTE ) + ( 255 * sizeof ( TPALETTEENTRY ) ), #0 );
// fill in the palette version
lpPal^.palVersion := $300;
// grab the system palette entries
lpPal^.palNumEntries :=
GetSystemPaletteEntries ( ScreenDC, 0, 256, lpPal^.palPalEntry );
if ( lpPal^.PalNumEntries <> 0 ) then
// create the palette
fBitmap.Palette := CreatePalette ( lpPal^ );
FreeMem ( lpPal, sizeof ( TLOGPALETTE ) + ( 255 * sizeof ( TPALETTEENTRY ) ) );
end;
try
fBitmap.Width := form1.width;
fBitmap.Height := form1.Height;
BitBlt ( fBitmap.Canvas.Handle, 0, 0, fBitmap.Width, fBitmap.height, ScreenDC, form1.left+4, form1.top+22, SRCCOPY );
ReleaseDC ( Handles, ScreenDC );
Result := TBitmap.Create;
Result.Assign ( fBitmap );
if fAutomatic then CopyToClipboard;
if Assigned ( fOnCapture ) then fOnCapture ( Self );
finally
ReleaseDC ( Handles, ScreenDC );
if fMinimized then
// Restore mainform to original state
Application.Restore;
end;
end;
procedure Tform1.SetDelay ( const Value: Integer );
begin
fDelay := Value;
end;
procedure Tform1.SetMinimized ( const Value: Boolean );
begin
if Value <> fMinimized then
fMinimized := Value;
end;

procedure Tform1.SetAutomatic ( const Value: Boolean );
begin
fAutomatic := Value;
end;

procedure Tform1.CopyToClipboard;
begin
Clipboard.Assign ( fBitmap );
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
auto:=0;
form1.Width:=250;
form1.Height:=250;

fAutomatic := True;
fMinimized := false;
fDelay := 500;
fBitmap := TBitmap.Create;
SetDelay(fDelay);
SetAutomatic(fAutomatic);
SetMinimized(FMinimized);

end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin

image2.Hide;
capturedesktop;
image1.picture.Assign(clipboard);
image1.Picture.SaveToFile('c:\emre.bmp');
if checkbox2.Checked=true then begin
auto:=auto+1;
image1.Picture.SaveToFile(edit1.text+'\'+inttostr( auto)+'.bmp');
image2.Show;
end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
form1.Width:=form1.Height;

end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
image2.Show;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
savedialog1.Execute;
end;

procedure TForm1.SaveDialog1CanClose(Sender: TObject;
var CanClose: Boolean);
begin
renamefile('c:\emre.bmp',savedialog1.filename);
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if checkbox1.Checked=true then begin
timer1.Enabled:=true;
end
else if checkbox1.Checked=false then begin
timer1.Enabled:=false;
end;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=13 then begin
speedbutton2.Click;
end;
if key=32 then begin
speedbutton1.Click;
end;
if key=75 then begin
speedbutton3.Click;
end;
if key=27 then begin
coolbar1.Hide;
end;
if key =17 then begin
coolbar1.Show;
end;
end;

end.
__________________________________________________ ____
und du brauchst die componente...
Image1: TImage;
CoolBar1: TCoolBar;
Timer1: TTimer;
Image2: TImage;
SaveDialog1: TSaveDialog;
Panel1: TPanel;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
Edit1: TEdit;
__________________________________________________ ____

form1.transparentcolor:=true

[Uwe Mankin]

Dies Listing stammt nicht von mir selbst,
ich bekam es von jemandem (nicht aus diesem Forum)
der mir bei derselben Frage behilflich war:

function CreateScreenShot(left,top,width,height: integer): TBitMap;
var
DeskWnd: Hwnd;
deskdc: hdc;
deskCV: TCanvas;
R: TRect;
begin
result:=TBitMap.create;
DeskWnd:=GetDeskTopWindow;
DeskDC:=GetWindowDC(DeskWnd);
DeskCV:=TCanvas.create;
DeskCV.handle:=DeskDC;
if width<=0 then width:=Screen.width;
if height<=0 then height:=Screen.height;
left:=max(0,left);
top:=max(0,top);
Width:=min(width,Screen.width-left);
Height:=min(height,Screen.Height-top);
R:=bounds(left,top,width,height);
try
result.handleType:=bmDib;
result.PixelFormat:=pf24bit;
result.width:=Width;
result.height:=Height;
result.canvas.copyMode:=cmSrcCopy;
result.Canvas.copyRect(R,deskCV,R);
finally
DeskCV.free;
ReleaseDC(deskWnd,deskDC);
end;
end