retMonitorTools - für Leute mit mehr als einem Bildschirm

retnyg · Verfasst: Di 26.04.05 12:52

Neue Version 2.0 - Alles Neugeschrieben // Feedback erwünscht !

eine unit mit hilfsfunktionen für den mehrschirm-betrieb.
alle funktionen selbstgeschrieben...

einfach den code in eine datei namens retmonitortools.pas reinkopieren.

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:

unit retmonitortools;

//  ============================================================================
//  retMonitorTools Unit for Delphi
//  version 2.0 : rewritten everything
//  ============================================================================
//  Author : retnyg @ http://krazz.net/retnyg
//
//  thanks to muetze1 who supported me with the development of this unit.
//
//  demo code:
//

(*
procedure TForm1.Button1Click(Sender: TObject);
begin
  caption := inttostr(GetNumberMonitors);
  if GetMonitorFromWindow(handle) = 0 then
    Movewindowtomonitor(handle,1,false)
  else
    Movewindowtomonitor(handle,0,false)
end;
*)

//  ============================================================================

interface
uses windows;
const
 DLL = 'User32.dll';
 MONITOR_DEFAULTTONULL = $0;    //If the monitor is not found, return 0
 MONITOR_DEFAULTTOPRIMARY = $1; //If the monitor is not found, return the primary monitor
 MONITOR_DEFAULTTONEAREST = $2; //If the monitor is not found, return the nearest monitor

type

  HMONITOR = integer;

  PMonitor = ^TMonitor;
  TMonitor = record
    handle: HMONITOR;
    rect: TRect;
  end;

  PMonitors = ^TMonitors;
  TMonitors = array of TMonitor;

  PMONITORINFO = ^TMONITORINFO;
  TMONITORINFO = record
    cbSize:DWORD;
    rcMonitor:TRECT;
    rcWork:TRECT;
    dwFlags:DWORD;
  end;

// own functions
 function getDesktopDimensionsXY: tpoint;
 function GetNumberMonitors:byte;
 function moveWindowToMonitor(hnd: HWND; monNum:byte; fullscreen: boolean = false):boolean;
 function GetMonitorFromWindow(hnd: HWND):byte;
// function GetDesktopDimensions:Trect;


implementation

var Screens: TMonitors = nil;

// imported API functions
 function GetMonitorInfo(AMonitorHandle: pointer; Var ADataRecord: TMonitorInfo): Boolean;
          stdcall; External DLL Name 'GetMonitorInfoA'; overload;
 function MonitorFromPoint(APoint: TPoint; AFlags: DWORD): pointer;
          stdcall; External DLL;
 function MonitorFromWindow(AWindowHandle: HWND; AFlags: DWORD): pointer;
          stdcall; External DLL;
 function EnumDisplayMonitors(dc: HDC; lprcClip:Prect; lpfnEnum: Pointer; dwData: LPARAM):boolean;
          stdcall; External DLL;


procedure GetMonitors;

  function EnumMonitorsProc(hm: HMONITOR; dc: HDC; r: PRect; Data: Pointer): Boolean; stdcall;
  var
    l:integer;
  begin
    l := length(Screens);
    setlength(Screens, l + 1);
    Screens[l].handle := HM;
    Screens[l].rect := r^;
    Result := True;
  end;

begin
   if Screens = nil then
     EnumDisplayMonitors(0,nil,@EnumMonitorsProc,0);
end;

function Point(X, Y: Integer): TPoint;
begin
  Result.X := X;
  Result.Y := Y;
end;

function getDesktopDimensionsXY: tpoint;
begin
   result := point(getsystemmetrics(SM_CXVIRTUALSCREEN),getsystemmetrics(SM_CYVIRTUALSCREEN));
end;

function GetNumberMonitors:byte;
Const
  SM_CMONITORS = 80;
begin
  Result := GetSystemMetrics(SM_CMONITORS);
end;

function moveWindowToMonitor(hnd: HWND; monNum:byte; fullscreen: boolean = false):boolean;

  function difF(a,b:integer):integer;
  begin
     if a > b then result := a - b
     else result := b -a ;
  end;

var dr: trect;

    X,Y,W,H:integer;
    l : integer;
    CurrentScreen, NewScreen: PMonitor;
    cSn: integer;

begin
   result:=false;
   if screens = nil then Getmonitors;
   l := length(screens);
   cSn := GetMonitorFromWindow(hnd);
   if  (cSn < L) and (monNum < L) and (cSn <> monNum) then
     if GetwindowRect(hnd,dr) then begin
        CurrentScreen := @Screens[cSn];
        NewScreen := @Screens[monNum];
        if fullscreen then begin
          X:=NewScreen^.rect.Left;
          Y:=NewScreen^.rect.Top;
          W:=abs(diff(NewScreen^.rect.Left,NewScreen^.rect.Right));
          H:=abs(diff(NewScreen^.rect.Top,NewScreen^.rect.Bottom));
        end else begin
          x := NewScreen^.rect.Left + abs(CurrentScreen^.rect.left - dr.Left);
          y := NewScreen^.rect.top  + abs(CurrentScreen^.rect.top - dr.top);
          w := diff(dr.Left, dr.Right);
          h := diff(dr.Top, dr.Bottom);
        end;
        if movewindow(hnd, X, Y, W, H,true) then
           result := true;
     end;
end;

function GetMonitorFromWindow(hnd: HWND):byte;
var HM : HMONITOR;
    i : integer;
begin
   result:=0;
   HM := integer(MonitorFromWindow(hnd, MONITOR_DEFAULTTONEAREST ));
   if Screens = nil then GetMonitors;
   for i := 0 to length(screens)-1 do
     if screens[i].handle = HM then begin
       result := i;
       break;
     end;
end;


end.

{function GetDesktopDimensions:Trect;
var DC: HDC;
    Cn: TCanvas;
begin
   DC:=GetDC(0);
   Cn:=TCanvas.Create;
   cn.Handle:=DC;
   Result:=cn.ClipRect;
   cn.Free;
   ReleaseDc(0,DC);
end; }

_________________
es gibt leute, die sind genetisch nicht zum programmieren geschaffen.
in der regel haben diese leute die regel...

retnyg · Verfasst: Do 26.05.05 20:30

update: Unit rechnet nun auch richtig, wenn ein Monitor ein negatives Offset hat.

_________________
es gibt leute, die sind genetisch nicht zum programmieren geschaffen.
in der regel haben diese leute die regel...

Muetze1 · Beiträge: 346

Moin!

Ok, ich habe mir die Unit mal zu Gemüte geführt. Folgendes:

Die eingebundene Unit "Types" existiert nicht und wird nicht benötigt.

Die Funktion GetNumberMonitors() geht einfacher: Windows fragen:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:

function GetNumberMonitors:byte;
Const
  SM_CMONITORS = 80;
begin
    // nicht unter NT und 95 ---> aber die beiden haben eh kein MultiMon Support...
  Result := GetSystemMetrics(SM_CMONITORS);
end;

warum nutzt du nicht einfach die Screen.Monitors[] Eigenschaft? Damit ist doch leichter an die Infos ranzukommen - genauso wie die Anzahl der Monitore (MonitorCount).
auch liefert dir borland eine multimon.pas mit, die dir weitere Funktionen bereitstellt. Dort ist nur ein Definitionsfehler in einer _EX Struktur. Das habe ich mal bei Borland gmeldet, ist gelistet aber bis heute nie behoben worden...

Und grundlegend: Also die Verschiebung von Monitor3 auf Monitor1 beim ButtonClick macht er. Danach rutscht er bei jedem Click aber nur rund 20 Pixel nach rechts mit der form bis er wieder auf monitor3 ist und dann gehts von vorne los. Er ignoriert meinen primären Monitor völlig. Auch springt er erst, wenn die Form komplett auf dem Monitor liegt. Im Normalfall sollten die Programme GetMonitorFromHWnd() benutzer und somit den richtigen Monitor bekommen, wenn mehr als die Hälfte auf dem Monitor liegt.

Mein Conifg:

links - mitte - rechts
sekundär - primär - sekundär
1152x864 - 1280x1024 - 1280x1024

Somit kann man sich die Koordinaten ausrechnen. Und ich habe UltraMon zu laufen, was aber daran nix ändert...

MfG
Muetze1

_________________
49 63 68 68 61 62 65 6B 65 69 6E 65 41 68 6E 75 6E 67 21

F34r0fTh3D4rk · Verfasst: Do 18.08.05 19:59

die desktop dimensionen lassen sich auch einfacher ausrechnen:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:

function GetDesktopRect: TRect;
var
  hdc : Thandle;
begin
  hdc := FindWindow('ProgMan', nil);
  if hdc <> 0 then
    GetWindowRect(hdc, result);
end;

retnyg · Verfasst: Fr 19.08.05 16:50

und was tust du wenn man keinen progman hat ? wie zum beispiel, wenn man eine alternative shell hat.
dein code wird dann versagen und fehler hervorrufen.
es geht übrigens noch kürzer:

markieren

Delphi-Quelltext

1:
2:
3:
4:

function getDesktopDimensions: tpoint;
begin
   result := point(getsystemmetrics(SM_CXVIRTUALSCREEN),getsystemmetrics(SM_CYVIRTUALSCREEN));
end;

ich empfehle übrigens keinem diese unit zu verwenden, da ich leider nicht die möglichkeit habe sie mit mehr als 2 schirmen zu testen. bei mir funktioniert sie astrein, aber bei muetze1's 3 schirmen gab es ja probleme

_________________
es gibt leute, die sind genetisch nicht zum programmieren geschaffen.
in der regel haben diese leute die regel...

retnyg · Verfasst: Mi 26.10.05 23:07

habe die unit aus anlass von diesem topic hier www.delphi-forum.de/viewtopic.php?t=50095
neugeschrieben. Die Mängel, die Muetze1 aufgezeigt hat, sollten nun der Vergangenheit angehören.
Würde mich aber trotzdem freuen wenn jemand die unit testet !

danke retnyg

_________________
es gibt leute, die sind genetisch nicht zum programmieren geschaffen.
in der regel haben diese leute die regel...

BenBE · Verfasst: Do 27.10.05 08:58

Als Pointer übergebene Parameter in API-Funktionen kannst Du auch als Var-Params entgegennehmen. Dadurch wrd die Übersicht etwas gesteigert, da du nicht ständig mit Pointern hantieren musst. Das macht dann Delphi.

Ansonsten ist es empfehlenswert, da nicht jeder immer sicherstellt, dass deine Unit nach Forms eingebunden wird, dass Du deine Typen etwas anpasst und z.B. TretMonitor(s) nennst ... Damit vermeidest Du von Anfang an Probleme wegen Gültigkeitsverschachtlungen.

Ansonsten ist die Unit (soweit ich das überblicke) erstmal schon recht gut geworden ;-)

_________________

Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.

crowley · Verfasst: Di 05.09.06 15:59

sers

ich habe leider ein Problem mit deiner Unit:

Die Nicht-Primary-Monitore haben bei mir alle einen Width von 0 o_O ...

ich konnte es in soweit nachvollziehen bzw. recherchieren, dass wohl die Windows API bei negativen Koordinaten automatisch 0 zurückzugeben scheint.

Left und Width waren 0 bei der Kostellation

markieren

Quelltext

1:
2:
3:

Bildschirm 1 <-----------------> Bildschirm 2
   links                           rechts
 secondary                         primary

Via Zugriff über Screen.Monitors bekomme ich allerdings die korrekten Daten...

Nutze jetzt an Stelle deiner "MoveWindowToMonitor" folgende Funktion:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:

function PositionWindow(AHandle: HWND; AMonNum: Byte; ACenter, AFit: Boolean; AFullscreen: Boolean = false): Boolean;

  function Diff(const a, b: Integer) : Integer;
  begin
     if a > b then
       Result := a - b
     else
       Result := b - a;
  end;

var
  loc_rect: TRect;
  loc_x,
  loc_y,
  loc_width,
  loc_height : Integer;
  loc_CurrScreen,
  loc_NewScreen: TMonitor;

  loc_monitor: Byte;
begin
  Result := False;

  loc_monitor := AMonNum;
  if (loc_monitor >= Screen.MonitorCount) then begin
    loc_monitor := 0;
    while (loc_monitor < Screen.MonitorCount) and
          (not Screen.Monitors[loc_monitor].Primary) do
      inc(loc_monitor);
  end;

  if GetWindowRect(AHandle, loc_rect) then begin
    loc_CurrScreen := Screen.Monitors[Screen.MonitorFromWindow(AHandle).MonitorNum];
    loc_NewScreen := Screen.Monitors[loc_monitor];
    if AFullscreen then
      with loc_NewScreen.BoundsRect do begin
        loc_x := Left;
        loc_y := Top;
        loc_width := abs(Diff(Left, Right));
        loc_height := abs(Diff(Top, Bottom));
      end
    else if ACenter then
      with loc_NewScreen.BoundsRect do begin
        loc_x := Left +
                 (abs(Diff(Left, Right)) -
                      Diff(loc_rect.Left, loc_rect.Right)) div 2;
        loc_y := Top +
                 (abs(Diff(Top, Bottom)) -
                      Diff(loc_rect.Top, loc_rect.Bottom)) div 2;
        loc_width := Diff(loc_rect.Left, loc_rect.Right);
        loc_height := Diff(loc_rect.Top, loc_rect.Bottom);
      end
    else if (Screen.MonitorFromWindow(AHandle).MonitorNum <> loc_monitor) then
      with loc_NewScreen.BoundsRect do begin
        loc_x := Left + abs(loc_CurrScreen.BoundsRect.Left - loc_rect.Left);
        loc_y := Top  + abs(loc_CurrScreen.BoundsRect.Top - loc_rect.Top);
        loc_width := Diff(loc_rect.Left, loc_rect.Right);
        loc_height := Diff(loc_rect.Top, loc_rect.Bottom);
      end
    else begin
      loc_x := loc_rect.Left;
      loc_y := loc_rect.Top;
      loc_width := Diff(loc_rect.Left, loc_rect.Right);
      loc_height := Diff(loc_rect.Top, loc_rect.Bottom);
    end;

    if AFit and not AFullscreen then begin
      if (loc_height >= abs(Diff(loc_NewScreen.BoundsRect.Top, loc_NewScreen.BoundsRect.Bottom))) then
        loc_height := abs(Diff(loc_NewScreen.BoundsRect.Top, loc_NewScreen.BoundsRect.Bottom));
      if (loc_width >= abs(Diff(loc_NewScreen.BoundsRect.Left, loc_NewScreen.BoundsRect.Right))) then
        loc_width := abs(Diff(loc_NewScreen.BoundsRect.Left, loc_NewScreen.BoundsRect.Right));

      if (loc_y < loc_NewScreen.BoundsRect.Top) then
        loc_y := loc_NewScreen.BoundsRect.Top
      else if ((loc_y + loc_height) > loc_NewScreen.BoundsRect.Bottom) then
        loc_y := loc_NewScreen.BoundsRect.Bottom - loc_height;

      if (loc_x < loc_NewScreen.BoundsRect.Left) then
        loc_x := loc_NewScreen.BoundsRect.Left
      else if ((loc_x + loc_width) > loc_NewScreen.BoundsRect.Right) then
        loc_x := loc_NewScreen.BoundsRect.Right - loc_width;
    end;

    if MoveWindow(AHandle, loc_x, loc_y, loc_width, loc_height, true) then
      Result := true;
  end
end;

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme