I have this following code that is working fine to screen capture without main form based in this example.

My trouble is that result screenshot is cut on right side and extended on left side for example testing this code to capture whole desktop with a website opened (image attached).

Like you can see, the vertical scrollbar can be see in both sides (left and right).

How can I fix this?

Here is the complete example:

zusammenfalten · markieren

Delphi-Quellcode:

type
  TForm1 = class(TForm)
    CAPTURE: TButton;
    SaveFileDialog1: TSaveDialog;
    procedure FormCreate(Sender: TObject);
    procedure CAPTUREClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  Magnification;

{$R *.dfm}

function HostWndProc(hWindow: HWND; Msg: UINT; wParam: wParam; lParam: lParam)
  : LRESULT; stdcall;
begin
  Result := DefWindowProc(hWindow, Msg, wParam, lParam);
end;

var
  MyBMP: TBitmap;
  abitmap: HBitmap;
  desktoprect: TRect;
  hWndMag: HWND;
  CallbackDone: Boolean = False;

function MagImageScalingCallback(HWND: HWND; srcdata: Pointer;
  srcheader: MAGIMAGEHEADER; destdata: Pointer; destheader: MAGIMAGEHEADER;
  unclipped: TRect; clipped: TRect; dirty: HRGN): BOOL; stdcall;
var
  lpbmi: TBitmapInfo;
  aDC: HDC;
begin

  Fillchar(lpbmi, sizeof(lpbmi), 0);
  lpbmi.bmiHeader.biSize := sizeof(lpbmi.bmiHeader);
                              // Otherwise the image is upside down.
  lpbmi.bmiHeader.biHeight := -srcheader.height;
  lpbmi.bmiHeader.biWidth := srcheader.width;
  lpbmi.bmiHeader.biSizeImage := srcheader.cbSize;
  lpbmi.bmiHeader.biPlanes := 1;
  lpbmi.bmiHeader.biBitCount := 32;
  lpbmi.bmiHeader.biCompression := BI_RGB;

  aDC := GetWindowDC(HWND);
  MyBMP := TBitmap.Create;
  abitmap := 0;
  try
    abitmap := CreateDIBitmap(aDC, lpbmi.bmiHeader, CBM_INIT, srcdata, lpbmi,
      DIB_RGB_COLORS);
    MyBMP.handle := abitmap;

    CallbackDone := True;

  finally
    DeleteDC(aDC);
  end;

  Result := True;
end;

procedure TForm1.CAPTUREClick(Sender: TObject);
var
  filterList: THWNDArray;
  sourceRect: TRect;
begin
  filterList[0] := Form1.handle;

  If (MagSetWindowFilterList(hWndMag, MW_FILTERMODE_EXCLUDE, 1,
    @filterList[0])) Then
  begin

    sourceRect.left := 0;
    sourceRect.top := 0;
    sourceRect.right := desktoprect.width;
    sourceRect.bottom := desktoprect.height;

    CallbackDone := False;

    If (MagSetWindowSource(hWndMag, sourceRect)) Then
      Screen.Cursor := crHourGlass;

    repeat

    until CallbackDone;

    Screen.Cursor := crDefault;

    SaveFileDialog1.Title := 'Save Image File';
    SaveFileDialog1.Filter := 'JPeg Image|*.jpg|Bitmap Image|*.bmp|Gif Image|*.gif|Png Image|*.png';
    SaveFileDialog1.DefaultExt := 'bmp';
    SaveFileDialog1.FilterIndex := 2;
    SaveFileDialog1.InitialDir := GetCurrentDir;

    if SaveFileDialog1.Execute then
    begin
      MyBMP.SaveToFile(SaveFileDialog1.FileName);
      MessageDlg('File saved: ' + SaveFileDialog1.FileName, mtInformation,
        [mbOK], 0);
    end
    else
      MessageDlg('Save file was cancelled', mtWarning, [mbOK], 0);

    DeleteObject(abitmap);
    MyBMP.Free;
  end;

end;

procedure TForm1.FormCreate(Sender: TObject);
const
  HOST_CLASSNAME = 'MagnifierHost';
var
  wc: TWndClass;
  hWndHost, desktop: HWND;
begin

 hWndHost := 0;

  wc.lpszClassName := HOST_CLASSNAME;
  wc.lpfnWndProc := @HostWndProc;
  wc.Style := 0;
  wc.hInstance := 0;
  wc.hIcon := 0;
  wc.hCursor := 0;
  wc.hbrBackground := 0;
  wc.lpszMenuName := nil;
  wc.cbClsExtra := 0;
  wc.cbWndExtra := 0;

  desktop := GetDesktopWindow;
  GetWindowRect(desktop, desktoprect);

  if (Winapi.Windows.RegisterClass(wc) <> 0) then

    hWndHost := CreateWindowEx(WS_EX_TOPMOST Or WS_EX_LAYERED Or
      WS_EX_TOOLWINDOW, HOST_CLASSNAME, 'Host Window',
      WS_POPUP Or WS_THICKFRAME Or WS_CLIPCHILDREN, 0, 0, desktoprect.width,
      desktoprect.height, 0, 0, hInstance, nil);

  if (hWndHost <> 0) then
    SetLayeredWindowAttributes(hWndHost, 0, 255, LWA_ALPHA);

  If (MagInitialize) Then
    hWndMag := CreateWindowEx(0, WC_MAGNIFIER, 'MagnifierWindow',
      WS_CHILD Or MS_SHOWMAGNIFIEDCURSOR Or WS_VISIBLE, 0, 0, desktoprect.width,
      desktoprect.height, hWndHost, 0, 0, nil);

  If (hWndMag = 0) Then
    ShowMessage(SysErrorMessage(GetLastError));

  if (MagSetImageScalingCallback(hWndMag, MagImageScalingCallback)) then
    {ShowMessage('MagSetImageScalingCallback registred!'};

  Left := (GetSystemMetrics(SM_CXSCREEN) - width) div 2;
  Top := (GetSystemMetrics(SM_CYSCREEN) - height) div 2;
end;

end.

Magnification.pas

zusammenfalten · markieren

Delphi-Quellcode:

unit Magnification;

{$ALIGN ON}
{$MINENUMSIZE 4}

interface

uses
  Windows;

const
  // Magnifier Class Name
  WC_MAGNIFIERA: AnsiString = 'Magnifier';
  WC_MAGNIFIERW: WideString = 'Magnifier';
  WC_MAGNIFIER = 'Magnifier';

  // Magnifier Window Styles
  MS_SHOWMAGNIFIEDCURSOR = $0001;
  MS_CLIPAROUNDCURSOR = $0002;
  MS_INVERTCOLORS = $0004;

  // Filter Modes
  MW_FILTERMODE_EXCLUDE = 0;
  MW_FILTERMODE_INCLUDE = 1;

type
  tagMAGTRANSFORM = record
    v: array[1..3, 1..3] of Single;
  end;
  MAGTRANSFORM = tagMAGTRANSFORM;
  TMagTransform = tagMAGTRANSFORM;
  PMagTransform = ^TMagTransform;

  tagMAGIMAGEHEADER = record
    width: UINT;
    height: UINT;
    format: TGUID;
    stride: UINT;
    offset: UINT;
    cbSize: UINT;
  end;
  MAGIMAGEHEADER = tagMAGIMAGEHEADER;
  TMagImageHeader = tagMAGIMAGEHEADER;
  PMagImageHeader = ^TMagImageHeader;

  tagMAGCOLOREFFECT = record
    transform: array[1..5, 1..5] of Single;
  end;
  MAGCOLOREFFECT = tagMAGCOLOREFFECT;
  TMagColorEffect = tagMAGCOLOREFFECT;
  PMagColorEffect = ^TMagColorEffect;

  TMagImageScalingCallback = function (hwnd: HWND; srcdata: Pointer;
    srcheader: MAGIMAGEHEADER; destdata: Pointer; destheader: MAGIMAGEHEADER;
    unclipped: TRect; clipped: TRect; dirty: HRGN): BOOL; stdcall;

  THWNDArray = array[0..0] of HWND;
  PHWNDArray = ^THWNDArray;

  // Public Functions
  function MagInitialize(): BOOL; stdcall;
  function MagUninitialize(): BOOL; stdcall;

  function MagSetWindowSource(hwnd: HWND; rect: TRect): BOOL; stdcall;
  function MagGetWindowSource(hwnd: HWND; var Rect: TRect): BOOL; stdcall;
  function MagSetWindowTransform(hwnd: HWND; var Transform: TMagTransform): BOOL; stdcall;
  function MagGetWindowTransform(hwnd: HWND; var Transform: TMagTransform): BOOL; stdcall;
  function MagSetWindowFilterList(hwnd: HWND; dwFilterMode: DWORD;
    count: Integer; pHWND: PHWNDArray): BOOL; stdcall;
  function MagGetWindowFilterList(hwnd: HWND; var dwFilterMode: DWORD;
    count: Integer; pHWND: PHWNDArray): Integer; stdcall;
  function MagSetImageScalingCallback(hwnd: HWND;
    MagImageScalingCallback: TMagImageScalingCallback): BOOL; stdcall;
// MagImageScalingCallback WINAPI MagGetImageScalingCallback(HWND hwnd );
  function MagSetColorEffect(hwnd: HWND; var Effect: TMagColorEffect): BOOL; stdcall;
  function MagGetColorEffect(hwnd: HWND; var Effect: TMagColorEffect): BOOL; stdcall;

implementation

const
  MagnificationDll = 'Magnification.dll';

  function MagInitialize; external MagnificationDll name 'MagInitialize';
  function MagUninitialize; external MagnificationDll name 'MagUninitialize';
  function MagSetWindowSource; external MagnificationDll name 'MagSetWindowSource';
  function MagGetWindowSource; external MagnificationDll name 'MagGetWindowSource';
  function MagSetWindowTransform; external MagnificationDll name 'MagSetWindowTransform';
  function MagGetWindowTransform; external MagnificationDll name 'MagGetWindowTransform';
  function MagSetWindowFilterList; external MagnificationDll name 'MagSetWindowFilterList';
  function MagGetWindowFilterList; external MagnificationDll name 'MagGetWindowFilterList';
  function MagSetImageScalingCallback; external MagnificationDll name 'MagSetImageScalingCallback';
  function MagSetColorEffect; external MagnificationDll name 'MagSetColorEffect';
  function MagGetColorEffect; external MagnificationDll name 'MagGetColorEffect';

end.

.. oops sorry, remove fix not your Trouble.

greets

Have you seen this MSDN note ?

Zitat:

Note The Magnification API is not supported under WOW64; that is, a 32-bit magnifier application will not run correctly on 64-bit Windows.

Rollo

Zitat von Rollo62:

Have you seen this MSDN note ?

Zitat:

Note The Magnification API is not supported under WOW64; that is, a 32-bit magnifier application will not run correctly on 64-bit Windows.

Rollo

C++ example (linked above) captures the screen correctly without any cut on image.

Solution:

markieren

Delphi-Quellcode:

 hWndHost := CreateWindowEx(WS_EX_TOPMOST or WS_EX_LAYERED or WS_EX_TRANSPARENT, HOST_CLASSNAME, 'Host Window', WS_POPUP or
                            WS_CLIPCHILDREN, 0, 0, desktoprect.width, desktoprect.height, 0, 0, hInstance, nil);