Problem solved!
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Vcl.StdCtrls, hyieutils, iexBitmaps, hyiedefs, iesettings, ieview,
imageenview, Vcl.ExtCtrls;
type
TForm1 = class(TForm)
Panel1: TPanel;
Button1: TButton;
ImageEnView1: TImageEnView;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{Note: Screen.Width and Screen.Height produce incorrect results when using Screen.Width
and Screen.Height to set the dimensions of a bitmap for screen capture on high resolution
monitor similar to that on a Microsoft Surface Pro 3. Both GetDeviceCaps and Monitor return
the correct screen dimensions on a Surface 3 Pro and on Desktop monitors while Screen.Height and
Screen.Width does not. I attempted to use WMI to achieve the same result but this failed
to function in my tests. Subsequently it was determined that both GetDeviceCaps as well as
Monitor returns the correct values. Tested on Windows 10 on a Desktop PC and Desktop Monitor
as well as with a Surface Pro 3 Tablet with Windows 10. Compiled with Delphi 10 Seattle. }
procedure ScreenShot(ActiveWindow: bool; DestBitmap: TBitmap);
{ Capture the desktop using GetDeviceCaps rather than Screen.Width and Screen.Height }
var
iWidth: integer;
iHeight: integer;
DC: HDC;
hWin: Cardinal;
iRect: TRect;
begin
if ActiveWindow then
begin
hWin := GetForegroundWindow;
DC := GetWindowDC(hWin);
GetWindowRect(hWin, iRect);
iWidth := iRect.Right - iRect.Left;
iHeight := iRect.Bottom - iRect.Top;
end
else
begin
hWin := GetDesktopWindow;
DC := GetDC(hWin);
iWidth := GetDeviceCaps(DC, HORZRES);
iHeight := GetDeviceCaps(DC, VERTRES);
end;
try
DestBitmap.Width := iWidth;
DestBitmap.Height := iHeight;
BitBlt(DestBitmap.Canvas.Handle, 0, 0, DestBitmap.Width, DestBitmap.Height,
DC, 0, 0, SRCCOPY);
finally
ReleaseDC(hWin, DC);
end;
end;
procedure ScreenShot2(ActiveWindow: bool; DestBitmap: TBitmap);
{ Capture the desktop using Monitor rather than Screen.Width and Screen.Height }
var
iWidth: integer;
iHeight: integer;
DC: HDC;
hWin: Cardinal;
iRect: TRect;
begin
if ActiveWindow then
begin
hWin := GetForegroundWindow;
DC := GetWindowDC(hWin);
GetWindowRect(hWin, iRect);
iWidth := iRect.Right - iRect.Left;
iHeight := iRect.Bottom - iRect.Top;
end
else
begin
hWin := GetDesktopWindow;
DC := GetDC(hWin);
iWidth := Form1.Monitor.Width;
iHeight := Form1.Monitor.Height;
end;
try
DestBitmap.Width := iWidth;
DestBitmap.Height := iHeight;
BitBlt(DestBitmap.Canvas.Handle, 0, 0, DestBitmap.Width, DestBitmap.Height,
DC, 0, 0, SRCCOPY);
finally
ReleaseDC(hWin, DC);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
{ Capture an image of the Desktop screen on high res monitors by using
GetDeviceCaps to set the bitmap dimensions. Tested on a Surface Pro 3.}
begin
WindowState := wsMinimized;
Sleep(250);
ImageEnView1.Bitmap.PixelFormat := pf24bit;
ScreenShot(False, ImageEnView1.Bitmap);
ImageEnView1.Update;
WindowState := wsNormal;
end;
procedure TForm1.Button2Click(Sender: TObject);
{ Capture an image of the Desktop screen on high res monitors by using
Monitor to set the bitmap dimensions. Tested on a Surface Pro 3.}
begin
WindowState := wsMinimized;
Sleep(250);
ImageEnView1.Bitmap.PixelFormat := pf24bit;
ScreenShot2(False, ImageEnView1.Bitmap);
ImageEnView1.Update;
WindowState := wsNormal;
end;
end.
Bill Miller
Adirondack Software & Graphics
Email: w2m@hughes.net
EBook: http://www.imageen.com/ebook/
Custom Commercial ImageEn Development