Solved

auto print screen

Posted on 2011-02-22
6
235 Views
Last Modified: 2012-05-11
hi how do I auto print screen?

keybd_event(VK_SNAPSHOT, 1, 0, 0);
?????
0
Comment
Question by:eNarc
6 Comments
 
LVL 9

Accepted Solution

by:
rawinnlnx9 earned 84 total points
ID: 34955732
0
 
LVL 19

Assisted Solution

by:Thommy
Thommy earned 250 total points
ID: 34956258
Make a screenshot of a form...
function FormularScreenShot(Bmp: TBitmap; h : hWnd): Boolean;  
var  
  TheRect: TRect;  
  TheWidth, TheHeight: Integer;  
begin  
  with Bmp do try  
    GetWindowRect(h, TheRect);  
    TheWidth  := TheRect.Right - TheRect.Left;  
    TheHeight := TheRect.Bottom - TheRect.Top;  
    Width := TheWidth;  
    Height := TheHeight;  
    BitBlt(Canvas.Handle, 0, 0, TheWidth, TheHeight, GetWindowDC(h), 0, 0, SRCCOPY);  
    Result := True;  
  finally  
    ReleaseDC(h, GetWindowDC(h));  
  end;  
end;

Open in new window

0
 
LVL 19

Assisted Solution

by:Thommy
Thommy earned 250 total points
ID: 34956277
Saves form screenshot into a file...
function FormularSaveScreenShotToFile(FileName: String; h : hWnd): Boolean;  
var  
  TheRect: TRect;  
  TheWidth, TheHeight: Integer;  
begin  
  with TBitmap.Create do try  
    GetWindowRect(h, TheRect);  

 
    TheWidth  := TheRect.Right - TheRect.Left;  
    TheHeight := TheRect.Bottom - TheRect.Top;  

 
    Width := TheWidth;  
    Height := TheHeight;  

 
    BitBlt(Canvas.Handle, 0, 0, TheWidth, TheHeight, GetWindowDC(h), 0, 0, SRCCOPY);  

 
    Result := True;  

 
    try SaveToFile(Filename) except Result := False end;  
  finally  
    ReleaseDC(h, GetWindowDC(h));  
    Free;  
  end;  
end;

Open in new window

0
Networking for the Cloud Era

Join Microsoft and Riverbed for a discussion and demonstration of enhancements to SteelConnect:
-One-click orchestration and cloud connectivity in Azure environments
-Tight integration of SD-WAN and WAN optimization capabilities
-Scalability and resiliency equal to a data center

 
LVL 19

Assisted Solution

by:Thommy
Thommy earned 250 total points
ID: 34956285
And also have a look at this...

How to Capture the Screen Shot of the Active Window
http://delphi.about.com/od/adptips2006/qt/captureactive.htm
0
 
LVL 32

Assisted Solution

by:ewangoya
ewangoya earned 83 total points
ID: 34957506
try this
uses
  Printers;

function CreateDesktopBitmap: TBitmap;
var
  DC: HDC;
  GDW: Cardinal;
  R: TRect;
begin
  GDW := GetDesktopWindow;
  DC := GetDC(GDW);
  try
    R := Rect(0, 0, GetDeviceCaps(DC, HORZRES), GetDeviceCaps(DC, VERTRES));

    Result := TBitmap.Create;
    try
      Result.Width := R.Right - R.Left;
      Result.Height := R.Bottom - R.Top;
      //copy desktop image to bitmap
      BitBlt(Result.Canvas.Handle, R.Left, R.Top, R.Right, R.Bottom, DC, 0, 0, SRCCOPY);
    except
      FreeAndNil(Result);
    end;
  finally
    ReleaseDC(GDW, DC);
  end;
end;

procedure PrintBitmap(ABitmap: TBitmap; const ARect: TRect);
var
  PInfo: PBitmapInfo;
  InfoSize, ImageSize: DWORD;
  PImage: Pointer;
  Bits: HBITMAP;
begin
  Printer.BeginDoc;
  try
    Bits := ABitmap.Handle;
    GetDIBSizes(Bits, InfoSize, ImageSize);
    PInfo := AllocMem(InfoSize);
    try
      PImage := AllocMem(ImageSize);
      try
        GetDIB(Bits, 0, PInfo^, PImage^);

        StretchDIBits(Printer.Canvas.Handle,
          ARect.Left, ARect.Top, ARect.Right, ARect.Bottom,
          0, 0, ABitmap.Width, ABitmap.Height,
          PImage, PInfo^, DIB_RGB_COLORS, SRCCOPY);
      finally
        FreeMem(PImage, ImageSize);
      end;
    finally
     FreeMem(PInfo, InfoSize);
    end;
  finally
    Printer.EndDoc;
  end;
end;

procedure TForm3.Button1Click(Sender: TObject);
var
  Bitmap: TBitmap;
  R: TRect;
  ScaleX, ScaleY: Integer;
begin
  Bitmap := CreateDesktopBitmap;
  try
    if Assigned(Bitmap) then
    begin
      R.Left := 0;
      ScaleX := GetDeviceCaps(Handle, logPixelsX) div PixelsPerInch;
      R.Right := Bitmap.Width * ScaleX;

      R.Top := 0;
      ScaleY := GetDeviceCaps(Handle, logPixelsY) div PixelsPerInch;
      R.Bottom := Bitmap.Height * ScaleY;

      PrintBitmap(Bitmap, R);
    end;
  finally
    FreeAndNil(Bitmap);
  end;
end;

Open in new window

0
 
LVL 24

Assisted Solution

by:jimyX
jimyX earned 83 total points
ID: 34957747
If you set bScan value to "1" you get the active window. To get the whole screen set it to "0":
keybd_event(VK_SNAPSHOT, 0, 0, 0);

Open in new window


VOID WINAPI keybd_event(
  __in  BYTE bVk,
  __in  BYTE bScan,
  __in  DWORD dwFlags,
  __in  ULONG_PTR dwExtraInfo
);

If that's not what you meant please could you explain you want.
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
find a node in VST 2 73
Find and Replace Stream with 0s 8 69
Dev express lookupcombo 3 35
Microsoft Access 97 and Delphi XE2 9 54
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…
I've attached the XLSM Excel spreadsheet I used in the video and also text files containing the macros used below. https://filedb.experts-exchange.com/incoming/2017/03_w12/1151775/Permutations.txt https://filedb.experts-exchange.com/incoming/201…

829 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question