Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionuses printers; procedure TForm1.Button1Click(Sender: TObject); var FormImage : Tbitmap; begin FormImage := GetFormImage; try Printer.BeginDoc; Printer.Canvas.StretchDraw(Rect(0,0,Printer.PageWidth,Printer.PageHeight),FormImage); Printer.EndDoc finally FreeAndNil(FormImage); end; end;
unit Unit1;_______________________________________
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, printers;
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TForm1 = class(TForm) Image1: TImage; Button1: TButton; procedure Button1Click(Sender: TObject); private { Déclarations privées } public { Déclarations publiques } end; var Form1: TForm1; implementation {$R *.dfm} uses printers; procedure TForm1.Button1Click(Sender: TObject); var FormImage : Tbitmap; begin FormImage := GetFormImage; try Printer.BeginDoc; Printer.Canvas.StretchDraw(Rect(0,0,Printer.PageWidth,Printer.PageHeight),FormImage); Printer.EndDoc finally FreeAndNil(FormImage); end; end; end.
function PrintWindow(ahwnd: HWND; hdcBlt: HDC; nFlags: UINT): Bool; stdcall; external 'User32.dll' name 'PrintWindow'; implementation {$R *.dfm} uses printers; // ATTENTION cette fonction crée un TBitmap c'est à vous de le libérer à la fin function DoShot(const aHandle: THandle): TBitmap; var DC, hdcMem: HDC; aRect: TRect; hBMP: HBitmap; aWidth, aHeight: Integer; begin Result := TBitmap.Create; dc := GetWindowDC(aHandle); if (dc > 0) then try hdcMem := CreateCompatibleDC(dc); if (hdcMem > 0) then try GetWindowRect(aHandle, aRect); aWidth := aRect.Right - aRect.Left; aHeight := aRect.Bottom - aRect.Top; hBMP := CreateCompatibleBitmap(dc, aWidth, aHeight); if (hBMP > 0) then try SelectObject(hdcMem, hBMP); PrintWindow(aHandle, hdcMem, 0); with Result do try Width := aWidth; Height := aHeight; BitBlt(Canvas.Handle, 0, 0, aWidth, aHeight, hdcMem, 0, 0, srcCopy); except begin FreeAndNil(Result); raise Exception.Create('La capture a échouée'); end; end; finally DeleteObject(hBMP); end; finally DeleteObject(hdcMem); end; finally ReleaseDC(aHandle, dc); end; end; procedure TForm1.Button1Click(Sender: TObject); var FormImage : Tbitmap; begin FormImage := DoShot; // <-- ceci a changé try Printer.BeginDoc; Printer.Canvas.StretchDraw(Rect(0,0,Printer.PageWidth,Printer.PageHeight), FormImage); Printer.EndDoc finally FreeAndNil(FormImage); end; end;
« Mais je suis pas certain que ton code fonctionne réellement (relis la question de CharlyLima) quand la fenêtre à capturer est en partie en dehors de l'écran !!! »
uses clipbrd, printers; procedure TForm1.Button1Click(Sender: TObject); var BMP : Tbitmap; begin keybd_event(VK_SNAPSHOT,1,0,0); //Capture d'ecran de la fenêtre active. if Clipboard.HasFormat(cf_BitMap) then begin BMP := Tbitmap.Create; try BMP.LoadFromClipboardFormat(cf_BitMap,ClipBoard.GetAsHandle(cf_Bitmap),0); Printer.BeginDoc; Printer.Canvas.StretchDraw(Rect(0,0,self.Width*5,self.Height*5),BMP); Printer.EndDoc; finally FreeAndNil(BMP); end; end else exit; end;
procedure TForm1.Button1Click(Sender: TObject);
var FormImage : Tbitmap;
begin
FormImage := DoShot(GetForegroundWindow); // <-- ceci a changé
...