AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Sprachen und Entwicklungsumgebungen Object-Pascal / Delphi-Language Delphi Why MagSetImageScalingCallback function fails when is executed in new desktop?
Thema durchsuchen
Ansicht
Themen-Optionen

Why MagSetImageScalingCallback function fails when is executed in new desktop?

Ein Thema von flashcoder · begonnen am 21. Mai 2018 · letzter Beitrag vom 25. Mai 2018
Antwort Antwort
flashcoder

Registriert seit: 10. Nov 2013
83 Beiträge
 
#1

Why MagSetImageScalingCallback function fails when is executed in new desktop?

  Alt 21. Mai 2018, 02:42
Delphi-Version: XE5
I'm trying get a screenshot of a new desktop created (CreateDesktop api + executing explorer.exe to new desktop) using Magnification api like showed in this tutorial.

I ported with success the C++ code from tutorial to Delphi and both examples (C++ and Delphi) works fine when executed from Win Vista ~ Win 10 and with Aero Theme enabled.

The trouble to this question is because if i create a new desktop (clone original desktop) and execute this example of screen capture, MagSetImageScalingCallback fails.

Someone know a possible solution to MagSetImageScalingCallback also work on new desktop created?

Thanks in advance by any help.

Main

Delphi-Quellcode:
type
  TForm1 = class(TForm)
    CAPTURE: TButton;
    SaveFileDialog1: TSaveDialog;
    procedure FormCreate(Sender: TObject);
    procedure CAPTUREClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  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
  lpbmih: TBitmapInfoHeader;
  lpbmi: TBitmapInfo;
  aDC: HDC;
begin

  aDC := GetWindowDC(HWND);

  Fillchar(lpbmih, sizeof(lpbmih), 0);
  lpbmih.biSize := sizeof(lpbmih);
                 // (-) Otherwise the image is upside down.
  lpbmih.biHeight := -srcheader.height { -GetDeviceCaps(aDC, VERTRES) };
  lpbmih.biWidth := srcheader.width { GetDeviceCaps(aDC, HORZRES) };
  lpbmih.biSizeImage := srcheader.cbSize;
  lpbmih.biPlanes := 1;
  lpbmih.biBitCount := 32;
  lpbmih.biCompression := BI_RGB;

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

  MyBMP := TBitmap.Create;
  abitmap := 0;
  try
    abitmap := CreateDIBitmap(aDC, lpbmih, CBM_INIT, srcdata, lpbmi,
      DIB_RGB_COLORS);
    MyBMP.handle := abitmap;
    MyBMP.PixelFormat := pf32bit;

    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.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if (MagUninitialize) then
    MessageDlg('Magnification api finished!', mtInformation, [mbOK], 0);
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_TRANSPARENT, HOST_CLASSNAME, 'Host Window',
      WS_POPUP Or WS_CLIPCHILDREN, 0, 0, desktoprect.width, desktoprect.height,
      0, 0, hInstance, nil);

  if (hWndHost <> 0) then
  begin
    SetWindowPos(hWndHost, 0, 0, 0, desktoprect.width, desktoprect.height,
      SWP_HIDEWINDOW);
    SetLayeredWindowAttributes(hWndHost, 0, 255, LWA_ALPHA);
  end;

  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!');

  ShowMessage(SysErrorMessage(GetLastError));

  left := (GetSystemMetrics(SM_CXSCREEN) - width) div 2;
  top := (GetSystemMetrics(SM_CYSCREEN) - height) div 2;
end;

end.
Magnification.pas

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.
  Mit Zitat antworten Zitat
Der schöne Günther

Registriert seit: 6. Mär 2013
6.176 Beiträge
 
Delphi 10 Seattle Enterprise
 
#2

AW: Why MagSetImageScalingCallback function fails when is executed in new desktop?

  Alt 21. Mai 2018, 08:22
  1. What does your GetLastError() return?
  2. Im sure you saw the
    Zitat:
    The MagSetImageScalingCallback function is deprecated in Windows 7 and later, and should not be used in new applications.
  3. Your example is missing your CreateDesktop shenanigans. As far as I recall, additional desktops are very limited. Example: They cannot have Aero features (and probably other DWM stuff).
  Mit Zitat antworten Zitat
flashcoder

Registriert seit: 10. Nov 2013
83 Beiträge
 
#3

AW: Why MagSetImageScalingCallback function fails when is executed in new desktop?

  Alt 21. Mai 2018, 13:17
  1. What does your GetLastError() return?
  2. Im sure you saw the
    Zitat:
    The MagSetImageScalingCallback function is deprecated in Windows 7 and later, and should not be used in new applications.
  3. Your example is missing your CreateDesktop shenanigans. As far as I recall, additional desktops are very limited. Example: They cannot have Aero features (and probably other DWM stuff).
GetLastError() returns 50 - ERROR_NOT_SUPPORTED - The request is not supported.

Really, this about DWM is true. And even that MagSetImageScalingCallback work, but MagSetWindowSource will fail because this api only works with Aero Theme enabled.

Geändert von flashcoder (21. Mai 2018 um 13:20 Uhr)
  Mit Zitat antworten Zitat
flashcoder

Registriert seit: 10. Nov 2013
83 Beiträge
 
#4

AW: Why MagSetImageScalingCallback function fails when is executed in new desktop?

  Alt 23. Mai 2018, 22:11
SOLVED!

This is working on Win 8/8.1 and 10, all x86 and x64.

Not works in Windows versions < 8
  Mit Zitat antworten Zitat
Der schöne Günther

Registriert seit: 6. Mär 2013
6.176 Beiträge
 
Delphi 10 Seattle Enterprise
 
#5

AW: Why MagSetImageScalingCallback function fails when is executed in new desktop?

  Alt 24. Mai 2018, 10:40
As I said, that's because Aero and all that Jazz is inactive on separate Desktops on Windows < 8.
  Mit Zitat antworten Zitat
flashcoder

Registriert seit: 10. Nov 2013
83 Beiträge
 
#6

AW: Why MagSetImageScalingCallback function fails when is executed in new desktop?

  Alt 25. Mai 2018, 02:29
As I said, that's because Aero and all that Jazz is inactive on separate Desktops on Windows < 8.
Exactly!
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 23:51 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz