Ada计算机图形DirectX之multimon

----------------------------------------
-- Microsoft DirectX Ada Binding Lib  --
-- File : multimon.ads                --
-- Translator:Dongfeng.Gu,2018/11/05  --
-- Mail: 515639@qq.com                --
-- Progress:100%                      --
----------------------------------------


with win32;              use win32;
with win32.windef;       use win32.windef;
with win32.winnt;        use win32.winnt;
with win32.objbase;      use win32.objbase;

package multimon is
   
   
   subtype HMONITOR is win32.winnt.HANDLE;
   
   SM_XVIRTUALSCREEN : constant := 76;

   SM_YVIRTUALSCREEN : constant := 77;

   SM_CXVIRTUALSCREEN : constant := 78;

   SM_CYVIRTUALSCREEN : constant := 79;

   SM_CMONITORS : constant := 80;

   SM_SAMEDISPLAYFORMAT : constant := 81;

   MONITOR_DEFAULTTONULL : constant := 16#00000000#;

   MONITOR_DEFAULTTOPRIMARY : constant := 16#00000001#;

   MONITOR_DEFAULTTONEAREST : constant := 16#00000002#;

   MONITORINFOF_PRIMARY : constant := 16#00000001#;

   type tagMONITORINFO is record
      cbSize: DWORD;
      rcMonitor: RECT;
      rcWork: RECT;
      dwFlags: DWORD;
   end record;

   subtype MONITORINFO is tagMONITORINFO;

   type LPMONITORINFO is access all tagMONITORINFO;

   CCHDEVICENAME : constant := 32;

   type tagMONITORINFOEXA is record
      cbSize: DWORD;
      rcMonitor: RECT;
      rcWork: RECT;
      dwFlags: DWORD;
      szDevice: CHAR_Array(0..CCHDEVICENAME-1);
   end record;

   subtype MONITORINFOEXA is tagMONITORINFOEXA;

   type LPMONITORINFOEXA is access all tagMONITORINFOEXA;

   type tagMONITORINFOEXW is record
      cbSize: DWORD;
      rcMonitor: RECT;
      rcWork: RECT;
      dwFlags: DWORD;
      szDevice: WCHAR_Array(0..CCHDEVICENAME-1);
   end record;

   subtype MONITORINFOEXW is tagMONITORINFOEXW;

   type LPMONITORINFOEXW is access all tagMONITORINFOEXW;


   subtype MONITORINFOEX is MONITORINFOEXA;

   subtype LPMONITORINFOEX is LPMONITORINFOEXA;



   type MONITORENUMPROC is access function(Arg_1:HMONITOR;Arg_2:HDC;Arg_3:LPRECT;Arg_4:LPARAM) return BOOL with Convention=>Stdcall;

   type tagDISPLAY_DEVICEA is record
      cb: DWORD;
      DeviceName: CHAR_Array(0..32-1);
      DeviceString: CHAR_Array(0..128-1);
      StateFlags: DWORD;
      DeviceID: CHAR_Array(0..128-1);
      DeviceKey: CHAR_Array(0..128-1);
   end record;

   subtype DISPLAY_DEVICEA is tagDISPLAY_DEVICEA;

   type PDISPLAY_DEVICEA is access all tagDISPLAY_DEVICEA;

   type LPDISPLAY_DEVICEA is access all tagDISPLAY_DEVICEA;

   type tagDISPLAY_DEVICEW is record
      cb: DWORD;
      DeviceName: WCHAR_Array(0..32-1);
      DeviceString: WCHAR_Array(0..128-1);
      StateFlags: DWORD;
      DeviceID: WCHAR_Array(0..128-1);
      DeviceKey: WCHAR_Array(0..128-1);
   end record;

   subtype DISPLAY_DEVICEW is tagDISPLAY_DEVICEW;

   type PDISPLAY_DEVICEW is access all tagDISPLAY_DEVICEW;

   type LPDISPLAY_DEVICEW is access all tagDISPLAY_DEVICEW;

   subtype DISPLAY_DEVICE is DISPLAY_DEVICEA;

   subtype PDISPLAY_DEVICE is PDISPLAY_DEVICEA;

   subtype LPDISPLAY_DEVICE is LPDISPLAY_DEVICEA;

   DISPLAY_DEVICE_ATTACHED_TO_DESKTOP : constant := 16#00000001#;

   DISPLAY_DEVICE_MULTI_DRIVER : constant := 16#00000002#;

   DISPLAY_DEVICE_PRIMARY_DEVICE : constant := 16#00000004#;

   DISPLAY_DEVICE_MIRRORING_DRIVER : constant := 16#00000008#;

   DISPLAY_DEVICE_VGA_COMPATIBLE : constant := 16#00000010#;

   -- MULTIMON_USE_SECURE_CRT : constant := 1;

   -- MULTIMON_USE_SECURE_CRT : constant := 0;

   type pfnGetSystemMetrics is access function(arg1:int) return int with convention=>stdcall;
   g_pfnGetSystemMetrics:pfnGetSystemMetrics:=Null;
   
   type pfnMonitorFromWindow is access function(h:HWND;Arg2:DWORD) return HMONITOR with Convention=>stdcall;
   g_pfnMonitorFromWindow:pfnMonitorFromWindow:=NUll;
   
   type pfnMonitorFromRect is access function(pcr:LPCRECT;Arg2:DWORD) return HMONITOR with Convention=>stdcall;
   g_pfnMonitorFromRect:pfnMonitorFromRect:=Null;
   
   type pfnMonitorFromPoint is access function(pt:POINT;Arg2:DWORD) return HMONITOR with Convention=>stdcall;
   g_pfnMonitorFromPoint:pfnMonitorFromPoint:=Null;
   
   type pfnGetMonitorInfo is access function(hm:HMONITOR;pmi:LPMONITORINFO) return BOOL with Convention=>stdcall;
   g_pfnGetMonitorInfo:pfnGetMonitorInfo:=Null;
   
   type pfnEnumDisplayMonitors is access function(dc:HDC;pcr:LPCRECT;proc:MONITORENUMPROC;lp:LPARAM) return BOOL with Convention=>stdcall;
   g_pfnEnumDisplayMonitors:pfnEnumDisplayMonitors:=Null;
   
   type pfnEnumDisplayDevices is access function(Arg1:PVOID;Arg2:DWORD;pdd:PDISPLAY_DEVICE;Arg4:DWORD) return BOOL with Convention=>Stdcall;
   g_pfnEnumDisplayDevices:pfnEnumDisplayDevices:=Null;
   
   
   g_fMultiMonInitDone:BOOL:=win32.FALSE;
   
   g_fMultimonPlatformNT:BOOL:=win32.FALSE;
   
   function IsPlatformNT return Bool;
   
   function InitMultipleMonitorStubs return Bool;
   
--     function xGetSystemMetrics(nIndex:in out int) return int with Convention=>stdcall;
--     
--     function xMonitorFromPoint(ptScreenCoords:POINT; dwFlags:DWORD) return HMONITOR with Convention=>Stdcall;
--     
--     function xMonitorFromRect(lprcScreenCoords:LPCRECT; dwFlags:DWORD) return HMONITOR with Convention=>Stdcall;
--     
--     function xMonitorFromWindow(hWnd:windef.HWND; dwFlags:DWORD) return HMONITOR with Convention=>Stdcall;

   
   function xGetSystemMetrics(Arg1:int) return int with Import,Convention=>stdcall,external_name=>"xGetSystemMetrics";

   function xMonitorFromWindow(Arg1:HWND;Arg2:DWORD) return HMONITOR with Import,Convention=>stdcall,external_name=>"xMonitorFromWindow";

   function xMonitorFromRect(Arg1:LPCRECT;Arg2:DWORD) return HMONITOR with Import,Convention=>stdcall,external_name=>"xMonitorFromRect";

   function xMonitorFromPoint(Arg1:POINT;Arg2:DWORD) return HMONITOR with Import,Convention=>stdcall,external_name=>"xMonitorFromPoint";

   function xGetMonitorInfo(Arg1:HMONITOR;Arg2:LPMONITORINFO) return BOOL with Import,Convention=>stdcall,external_name=>"xGetMonitorInfo";

   function xEnumDisplayMonitors(Arg1:HDC;Arg2:LPCRECT;Arg3:MONITORENUMPROC;Arg4:LPARAM) return BOOL with Import,Convention=>stdcall,external_name=>"xEnumDisplayMonitors";

   function xEnumDisplayDevices(Arg1:PVOID;Arg2:DWORD;Arg3:PDISPLAY_DEVICE;Arg4:DWORD) return BOOL with Import,Convention=>stdcall,external_name=>"xEnumDisplayDevices";

   
   function GetSystemMetrics(Arg1:int) return int with Import,Convention=>stdcall,external_name=>"xGetSystemMetrics";

   function MonitorFromWindow(Arg1:HWND;Arg2:DWORD) return HMONITOR with Import,Convention=>stdcall,external_name=>"xMonitorFromWindow";

   function MonitorFromRect(Arg1:LPCRECT;Arg2:DWORD) return HMONITOR with Import,Convention=>stdcall,external_name=>"xMonitorFromRect";

   function MonitorFromPoint(Arg1:POINT;Arg2:DWORD) return HMONITOR with Import,Convention=>stdcall,external_name=>"xMonitorFromPoint";

   function GetMonitorInfo(Arg1:HMONITOR;Arg2:LPMONITORINFO) return BOOL with Import,Convention=>stdcall,external_name=>"xGetMonitorInfo";

   function EnumDisplayMonitors(Arg1:HDC;Arg2:LPCRECT;Arg3:MONITORENUMPROC;Arg4:LPARAM) return BOOL with Import,Convention=>stdcall,external_name=>"xEnumDisplayMonitors";

   function EnumDisplayDevices(Arg1:PVOID;Arg2:DWORD;Arg3:PDISPLAY_DEVICE;Arg4:DWORD) return BOOL with Import,Convention=>stdcall,external_name=>"xEnumDisplayDevices";
   
   

   --
   -- THE END.
   --

end multimon;

 

----------------------------------------
-- Microsoft DirectX Ada Binding Lib  --
-- File : multimon.adb                --
-- Translator:Dongfeng.Gu,2018/11/05  --
-- Mail: 515639@qq.com                --
-- Progress:100%                      --
----------------------------------------


with win32.winbase;          use win32.winbase;
with win32.winuser;          use win32.winuser;
with Interfaces.C;
with System;                 use System;
with Ada.Unchecked_Conversion;

package body multimon is

   use type Interfaces.C.unsigned_long;
   use type Interfaces.C.long;
   use type Interfaces.C.int;

   function IsPlatformNT return Bool is
      osvi:OSVERSIONINFOA:=(OSVERSIONINFOA'size/8,0,0,0,0,(others=>char'First));
   begin
      if GetVersionExA(osvi'Unrestricted_Access)/=0 then
         return (if VER_PLATFORM_WIN32_NT = osvi.dwPlatformId then win32.TRUE else win32.FALSE);
      end if;
      return win32.false;
   end IsPlatformNT;

   function "+" is new Ada.Unchecked_Conversion(FARPROC,pfnGetSystemMetrics);
   function "+" is new Ada.Unchecked_Conversion(FARPROC,pfnMonitorFromWindow);
   function "+" is new Ada.Unchecked_Conversion(FARPROC,pfnMonitorFromRect);
   function "+" is new Ada.Unchecked_Conversion(FARPROC,pfnMonitorFromPoint);
   function "+" is new Ada.Unchecked_Conversion(FARPROC,pfnEnumDisplayMonitors);
   function "+" is new Ada.Unchecked_Conversion(FARPROC,pfnGetMonitorInfo);
   function "+" is new Ada.Unchecked_Conversion(FARPROC,pfnEnumDisplayDevices);


   function InitMultipleMonitorStubs return Bool is

      hUser32:HMODULE;
      Mhs:constant CHAR_Array:="USER32"&Char'First;
      gsm:constant CHAR_Array:="GetSystemMetrics"&CHAR'First;
      mfw:constant CHAR_Array:="MonitorFromWindow"&CHAR'First;
      mfr:constant CHAR_Array:="MonitorFromRect"&CHAR'First;
      mfp:constant CHAR_Array:="MonitorFromPoint"&CHAR'First;
      edm:constant CHAR_Array:="EnumDisplayMonitors"&CHAR'First;
      gmi:constant CHAR_Array:="GetMonitorInfoA"&CHAR'First;
      edd:constant CHAR_Array:="EnumDisplayDevicesA"&CHAR'First;
   begin
      if (g_fMultiMonInitDone/=0) then
         return (if g_pfnGetMonitorInfo /= NULL then win32.TRUE else win32.FALSE);
      end if;

      g_fMultimonPlatformNT := IsPlatformNT;
      hUser32 := GetModuleHandle(Mhs(Mhs'First)'unrestricted_Access);

      if hUser32/=Null_Address then
         g_pfnGetSystemMetrics:=+(GetProcAddress(hUser32,gsm(0)'unrestricted_Access));
         if g_pfnGetSystemMetrics/=null then
            g_pfnMonitorFromWindow:=+(GetProcAddress(hUser32,mfw(0)'unrestricted_Access));
            if g_pfnMonitorFromWindow/=null then
               g_pfnMonitorFromRect:=+GetProcAddress(hUser32,mfr(0)'unrestricted_Access);
               if g_pfnMonitorFromRect/=null then
                  g_pfnMonitorFromPoint:=+GetProcAddress(hUser32,mfp(0)'unrestricted_access);
                  if g_pfnMonitorFromPoint/=null then
                     g_pfnEnumDisplayMonitors:=+GetProcAddress(hUser32,edm(0)'unrestricted_access);
                     if g_pfnEnumDisplayMonitors/=null then
                        g_pfnGetMonitorInfo:=+GetProcAddress(hUser32,gmi(0)'unrestricted_Access);
                        if g_pfnGetMonitorInfo/=null then
                           g_pfnEnumDisplayDevices:=+GetProcAddress(hUser32,edd(0)'unrestricted_access);
                           if g_pfnEnumDisplayDevices/=null then
                              g_fMultiMonInitDone := Win32.TRUE;
                              return Win32.TRUE;
                           end if;
                        end if;
                     end if;
                  end if;
               end if;
            end if;
         end if;
      end if;


      g_pfnGetSystemMetrics    := NULL;
      g_pfnMonitorFromWindow   := NULL;
      g_pfnMonitorFromRect     := NULL;
      g_pfnMonitorFromPoint    := NULL;
      g_pfnGetMonitorInfo      := NULL;
      g_pfnEnumDisplayMonitors := NULL;
      g_pfnEnumDisplayDevices  := NULL;

      g_fMultiMonInitDone := win32.TRUE;
      return win32.FALSE;
   end InitMultipleMonitorStubs;

--     function xGetSystemMetrics(nIndex:in out int) return int is
--     begin
--
--        if (InitMultipleMonitorStubs/=Win32.FALSE) then
--           return g_pfnGetSystemMetrics(nIndex);
--        end if;
--
--        case nIndex is
--           when SM_CMONITORS|SM_SAMEDISPLAYFORMAT=>
--              return 1;
--           when SM_XVIRTUALSCREEN|SM_YVIRTUALSCREEN=>
--              return 0;
--           when SM_CXVIRTUALSCREEN=>
--              nIndex := SM_CXSCREEN;
--           when SM_CYVIRTUALSCREEN=>
--              nIndex := SM_CYSCREEN;
--           when others=>
--              Null;
--        end case;
--
--        return GetSystemMetrics(nIndex);
--
--     end xGetSystemMetrics;
--
--     xPRIMARY_MONITOR:constant:=16#12340042#;
--
--     function "+" is new Ada.Unchecked_Conversion(DWORD,system.address); pragma Warnings(off,"+");
--
--     function xMonitorFromPoint(ptScreenCoords:POINT; dwFlags:DWORD) return HMONITOR is
--     begin
--        if (InitMultipleMonitorStubs/=WIN32.FALSE) then
--           return g_pfnMonitorFromPoint(ptScreenCoords, dwFlags);
--        end if;
--
--        if ((dwFlags and (MONITOR_DEFAULTTOPRIMARY or MONITOR_DEFAULTTONEAREST))/=0 OR
--              ((ptScreenCoords.x >= 0) and
--                   (int(ptScreenCoords.x) < GetSystemMetrics(SM_CXSCREEN)) and
--                 (ptScreenCoords.y >= 0) and
--                   (int(ptScreenCoords.y) < GetSystemMetrics(SM_CYSCREEN)))) then
--
--           return +xPRIMARY_MONITOR;
--        end if;
--
--        return Null_Address;
--
--     end xMonitorFromPoint;
--
--     function xMonitorFromRect(lprcScreenCoords:LPCRECT; dwFlags:DWORD) return HMONITOR is
--     begin
--        if (InitMultipleMonitorStubs/=WIN32.FALSE) then
--           return g_pfnMonitorFromRect(lprcScreenCoords, dwFlags);
--        end if;
--
--        if ((dwFlags and (MONITOR_DEFAULTTOPRIMARY or MONITOR_DEFAULTTONEAREST)) /= 0 or
--          ((lprcScreenCoords.right > 0) and
--          (lprcScreenCoords.bottom > 0) and
--          (int(lprcScreenCoords.left) < GetSystemMetrics(SM_CXSCREEN)) and
--          (int(lprcScreenCoords.top) < GetSystemMetrics(SM_CYSCREEN)))) then
--          return +xPRIMARY_MONITOR;
--        end if;
--
--        return Null_Address;
--     end xMonitorFromRect;
--
--     function xMonitorFromWindow(hWnd:windef.HWND; dwFlags:DWORD) return HMONITOR is
--        wp:WINDOWPLACEMENT;
--     begin
--        if (InitMultipleMonitorStubs/=Win32.FALSE) then
--           return g_pfnMonitorFromWindow(hWnd, dwFlags);
--        end if;
--
--        if (dwFlags and (MONITOR_DEFAULTTOPRIMARY or MONITOR_DEFAULTTONEAREST))/=0 then
--           return +xPRIMARY_MONITOR;
--        end if;
--
--        if IsIconic(hWnd)/=Win32.FALSE then
--           if GetWindowPlacement(hWnd, wp'Unrestricted_Access)/=win32.FALSE then
--              return xMonitorFromRect(wp.rcNormalPosition'unrestricted_access, dwFlags);
--           end if;
--
--
--        else
--           if GetWindowRect(hWnd, wp.rcNormalPosition'unrestricted_access)/=Win32.FALSE then
--              return xMonitorFromRect(wp.rcNormalPosition'unrestricted_access, dwFlags);
--           end if;
--
--        end if;
--
--        return Null_Address;
--
--     end xMonitorFromWindow;
--




end multimon;