Source file: /~heha/hs/t_und_m.zip/SRC/MAGNET.PAS

library magnet;
{"Magnetische" Fenster à la KDE oder WinAmp für alle}
{$A+,B-,F-,G+,I-,K+,N-,P-,Q-,R-,S-,T+,V+,W-,X+}
{$C MOVEABLE PRELOAD PERMANENT}	{gleiche Attribute wie Unit SYSTEM}
{$D Magnetische Fenster V0.2 04/02}
{$M 8192,0}
{16-Bit-Variante mit ressourcenschonendem CBT-Hook;
 Nachteil: Kein optisches Feedback, SIZE funktioniert nur mit Maus
 Verwendung: In WIN.INI kann Schnapp-Reichweite eingetragen werden:
	Abschnitt [windows], Schlüssel snap=, Vorgabe ist 4 Pixel
	Unterdrückung des Schnappeffektes durch Druck auf Strg-Taste.
 Henrik.Haftmann@E-Technik.TU-Chemnitz.de}

uses WinProcs,WinTypes,Win31,WUtils;
type
 ASnap=(sleft,stop,sright,sbottom);
 SSnap=set of ASnap;
var
 SnapW:Integer;
 Hook:HHook;

procedure AbsMin(var x2:Integer; x:Integer);
{Setzt x2 auf das Betragsminimum}
 begin
  if Abs(x2)>Abs(x) then x2:=x;
 end;

procedure AdjustRect(W:HWnd; var R:TRect; snap:SSnap);
{Modifiziert Zielrechteck <R> des Fensters <W> in Abhängigkeit
 der Nachbar- und des Elternfensters an den durch <snap> erlaubten Kanten}
 label next;
 var
  R2: TRect;	{Eltern- oder Geschwister-Rechteck}
  MP: TPoint;	{Verschiebung}
  W2: HWnd;	{Eltern- oder Geschwister-Fenster}
  s: ts7;	{für Klassenname (IconTitle sollte ausgeschlossen sein)}
 begin
  MP.x:=MaxInt; MP.y:=MaxInt;
	{Ausrichtung an Eltern-Fenster: Client-Bereich, innen}
  W2:=GetParent(W);
  if W2=0 then W2:=GetDesktopWindow;
  GetClientRect(W2,R2);
  ClientToScreen(W2,PPoint(@R2.left)^);
  ClientToScreen(W2,PPoint(@R2.right)^);
  if (R2.top<R.bottom) and (R.top<R2.bottom) then begin
   if sleft in snap then AbsMin(MP.x,R.left-R2.left);
   if sright in snap then AbsMin(MP.x,R.right-R2.right);
  end;
  if (R2.left<R.right) and (R.left<R2.right) then begin
   if stop in snap then AbsMin(MP.y,R.top-R2.top);
   if sbottom in snap then AbsMin(MP.y,R.bottom-R2.bottom);
  end;
	{Ausrichtung an Geschwister: Ganze Fenster, außen}
  W2:=GetWindow(W2,GW_Child);
  while W2<>0 do begin
   if W2=W then goto next;	{Nicht das eigene Fenster benutzen!}
   if not IsWindowVisible(W2) then goto next;
   if IsIconic(W2) then goto next;
   GetClassName(W2,s,sizeof(s));
   if lstrcmp(s,'#32772')=0 then goto next;	{IconTitle}
   GetWindowRect(W2,R2);
   if (R2.top<R.bottom) and (R.top<R2.bottom) then begin
    if sleft in snap then AbsMin(MP.x,R.left-R2.right);
    if sright in snap then AbsMin(MP.x,R.right-R2.left);
   end;
   if (R2.left<R.right) and (R.left<R2.right) then begin
    if stop in snap then AbsMin(MP.y,R.top-R2.bottom);
    if sbottom in snap then AbsMin(MP.y,R.bottom-R2.top);
   end;
	{Ausrichtung an Geschwister: Eck-Kreuzungen bevorzugen}
   if (abs(R.bottom-R2.top)<=SnapW)
   or (abs(R.top-R2.bottom)<=SnapW) then begin
    if sleft in snap then AbsMin(MP.x,R.left-R2.left);
    if sright in snap then AbsMin(MP.x,R.right-R2.right);
   end;
   if (abs(R.left-R2.right)<=SnapW)
   or (abs(R.right-R2.left)<=SnapW) then begin
    if stop in snap then AbsMin(MP.y,R.top-R2.top);
    if sbottom in snap then AbsMin(MP.y,R.bottom-R2.bottom);
   end;
next:
   W2:=GetWindow(W2,GW_HWndNext);
  end;
	{Schnappeffekt prüfen}
  if Abs(MP.x)>SnapW then MP.x:=0;
  if Abs(MP.y)>SnapW then MP.y:=0;
	{Rechteck verändern}
  if sleft in snap then Dec(R.left,MP.x);
  if stop in snap then Dec(R.top,MP.y);
  if sright in snap then Dec(R.right,MP.x);
  if sbottom in snap then Dec(R.bottom,MP.y);
	{Fehlt noch: Sicherung, dass Titelzeile nicht oben herausrutscht}
 end;

function CbtHook(Code:Integer;wParam:Word;lParam:LongInt):LongInt;
  export;
 const
  snap: SSnap=[sleft..sbottom];
 var
  RP: PRect absolute lParam;
  W: HWnd;
  P: TPoint;
  HitCode: Integer;
 begin
  CbtHook:=CallNextHookEx(Hook,Code,wParam,lParam);
  case Code of
   HCBT_SysCommand: case wParam and $FFF0 of
    SC_Move: snap:=[sleft..sbottom];	{alle 4 Seiten ziehen lassen}
    SC_Size: begin
     snap:=[];
     GetCursorPos(P);		{funktioniert nur mit Maus}
     W:=WindowFromPoint(P);
     if W=0 then exit;
     HitCode:=SendMessage(W,WM_NCHitTest,0,LongInt(P));
     case HitCode of
      HTLeft:		snap:=[sleft];
      HTTopLeft:	snap:=[sleft,stop];
      HTTop:		snap:=[stop];
      HTTopRight:	snap:=[stop,sright];
      HTRight:		snap:=[sright];
      HTBottomRight:	snap:=[sright,sbottom];
      HTBottom:		snap:=[sbottom];
      HTBottomLeft:	snap:=[sleft,sbottom];
      {else MessageBeep($FFFF);}
     end;
    end;
   end;
   HCBT_MoveSize: if GetKeyState(VK_Control) and $FFFE =0
   then begin
    AdjustRect(wParam,RP^,snap);
   end;
  end;
 end;

var
 OldExit: Pointer;

procedure NewExit; far;
 begin
  UnhookWindowsHookEx(Hook);
 end;

begin
 SnapW:=GetProfileInt('Windows','Snap',4);
 Hook:=SetWindowsHookEx(WH_CBT,CbtHook,HInstance,0);
 OldExit:=ExitProc;
 ExitProc:=@NewExit;
end.
Detected encoding: ANSI (CP1252)4
Wrong umlauts? - Assume file is ANSI (CP1252) encoded