Flytte form på 2 skærme

unit multiMonCtrl;

interface

//MULTIPLE MONITOR CONTROL (for a single form)
//Keep form within multiple monitors screen boundaries.
//Works with monitors of different sizes and positions.
//IMPORTANT: Use only if form should stay at one screen of the time.

//HOW TO USE
//Simply add this unit into the form's uses-clause,
//and set reference to it in "FormCreate" like: mMonCtrl.ctrl:=self;

//Last updated: Aug 2010, mortenbs.com/it/delphi/multiple_monitors/

uses
windows,mbs,classes,controls;

type
//-----------------------------|----------------|----------------------|----------------------------
tMultiMonCtrl=class(tThread)
private
protected
  procedure execute;override;
public
  ctrl                        :tWinControl;    //The assigned form to manage.
  constructor create;reintroduce;
end;
//-----------------------------|----------------|----------------------|----------------------------

function taskBarRect(var r:tRect):boolean;
function findMostMonitor(aCtrl:tControl;out aMonitor:integer):boolean;
procedure keepFormWithinMostMonitor(aCtrl:tControl);
function mMonCtrl:tMultiMonCtrl;

implementation

uses
forms;

function taskBarRect(var r:tRect):boolean;
var h:hWnd;
begin h:=findWindow('Shell_TrayWnd',nil);
result:=h>0;if result then windows.getWindowRect(h,r)
end;

function findMostMonitor(aCtrl:tControl;out aMonitor:integer):boolean;
var i,x1,y1,x2,y2,w,h,sq,lSq:integer;
begin aMonitor:=-1;lSq:=0;
for i:=0 to screen.monitorCount-1 do with screen.monitors[i] do begin
  x1:=aCtrl.left;y1:=aCtrl.top;x2:=x1+aCtrl.width;y2:=y1+aCtrl.height;w:=0;h:=0;
if (x2>=left) and (x1<=left+width) and (y2>=top) and (y1<=top+height) then begin
  w:=x2-x1;if x1<left then dec(w,left-x1) else if x2>left+width then dec(w,x2-(left+width));
  h:=y2-y1;if y1<top then dec(h,top-y1) else if y2>top+height then dec(h,y2-(top+height));
  sq:=w*h;if sq>lSq then begin aMonitor:=i;lSq:=sq end
  end
end;result:=aMonitor>-1
end;

procedure keepFormWithinMostMonitor(aCtrl:tControl);
var aMonitor:integer;r:tRect;
begin
if findMostMonitor(aCtrl,aMonitor) then with screen.monitors[aMonitor] do begin
  //MONITOR
  if aCtrl.left+aCtrl.width>left+width then aCtrl.left:=(left+width)-aCtrl.width;if aCtrl.left<left then aCtrl.left:=left;
  if aCtrl.top+aCtrl.height>top+height then aCtrl.top:=(top+height)-aCtrl.height;if aCtrl.top<top then aCtrl.top:=top;
  //TASKBAR
  if taskBarRect(r) and (r.left>=left) and (r.right<=left+width) and (r.top>=top) and (r.bottom<=top+height) then
  if (r.top>screen.height div 2) then begin//LOWER TASKBAR
    if aCtrl.top+aCtrl.height>r.top then aCtrl.top:=r.top-aCtrl.height;
    if aCtrl.top<top then aCtrl.top:=top;
  end else //UPPER TASKBAR
    if aCtrl.top<r.top then aCtrl.top:=r.top;
end
end;

//--------------------------------------------------------------------------------------------------
//tMultiMonCtrl:

constructor tMultiMonCtrl.create;//reintroduce;
begin inherited create(true);freeOnTerminate:=true;
ctrl:=application.mainForm;resume
end;

procedure tMultiMonCtrl.execute;//override;
begin
while not terminated do begin
  if ctrl<>nil then try keepFormWithinMostMonitor(ctrl) except end;
  sleep(250)
end
end;

//--------------------------------------------------------------------------------------------------

var
fMultiMonCtrl:tMultiMonCtrl=nil;

function mMonCtrl:tMultiMonCtrl;
begin
if fMultiMonCtrl=nil then fMultiMonCtrl:=tMultiMonCtrl.create;
result:=fMultiMonCtrl
end;

initialization
mMonCtrl.resume;

finalization
if fMultiMonCtrl<>nil then begin
  if not fMultiMonCtrl.terminated then fMultiMonCtrl.terminate;
  fMultiMonCtrl:=nil
end;

end.

unit Unit1;

interface

uses
  Windows, multiMonCtrl, Classes, Controls, Forms, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
  private
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
mMonCtrl.ctrl:=self
end;

end.

unit Unit1;

interface

uses
  windows, messages, classes, controls, graphics, forms;

type
  TForm1 = class(TForm)
  private
    procedure wmMoving(var aMsg:tWmMoving);message WM_MOVING;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
DI_LEFT  = $01;
DI_RIGHT  = $02;
DI_TOP    = $03;
DI_BOTTOM = $04;

function findMostMonitor(x1,y1,x2,y2:integer;out aMon:integer;out r:tRect):boolean;
var i,w,h,sq,lSq:integer;
begin aMon:=-1;lSq:=0;
for i:=0 to screen.monitorCount-1 do with screen.monitors[i] do
  if (x2>=left) and (x1<=left+width) and (y2>=top) and (y1<=top+height) then begin
  w:=x2-x1;if x1<left then dec(w,left-x1) else if x2>left+width then dec(w,x2-(left+width));
  h:=y2-y1;if y1<top then dec(h,top-y1) else if y2>top+height then dec(h,y2-(top+height));
  sq:=w*h;if sq>lSq then begin aMon:=i;lSq:=sq end
  end;result:=aMon>-1;if result then r:=screen.monitors[aMon].workareaRect
end;

function hasMonitorAt(aDir:byte;aMon:integer;p,mP:pRect):boolean;
var i:integer;
begin result:=true;with screen do
for i:=0 to monitorCount-1 do if i<>aMon then with monitors[i].workareaRect do case aDir of
  DI_LEFT:  if (right<=mP^.left) and (top<=p.top) and (bottom>=p.bottom) then exit;
  DI_RIGHT: if (left>=mP^.right) and (top<=p.top) and (bottom>=p.bottom) then exit;
  DI_TOP:  if (bottom<=mP^.top) and (left<=p.left) and (right>=p.right) then exit;
  DI_BOTTOM:if (top>=mP^.bottom) and (left<=p.left) and (right>=p.right) then exit;
end;result:=false
end;

procedure TForm1.wmMoving(var aMsg:tWmMoving);
var aMon:integer;p:pRect;r:tRect;
begin
if not findMostMonitor(left,top,left+width,top+height,aMon,r) then exit;p:=aMsg.dragRect;
with p^ do begin
  if (left<r.left) and not hasMonitorAt(DI_LEFT,aMon,p,@r) then begin dec(right,left-r.left);left:=r.left end else
  if (right>r.right) and not hasMonitorAt(DI_RIGHT,aMon,p,@r) then begin dec(left,right-r.right);right:=r.right end;
  if (top<r.top) and not hasMonitorAt(DI_TOP,aMon,p,@r) then begin dec(bottom,top-r.top);top:=r.top end else
  if (bottom>r.bottom) and not hasMonitorAt(DI_BOTTOM,aMon,p,@r) then begin dec(top,bottom-r.bottom);bottom:=r.bottom end
end
end;


end.