...

  published
    {: Activate the magnet by setting Active to true. }
    property Active: boolean read FActive 
      write SetActive default false;

  ...

procedure TMagnet.SetActive(const Value: boolean);
begin
  if (Active <> Value) then
  begin
    if Value then
    begin
      // hook into the Form to receive the Windows 
      // messages
      FClientInstance := 
        MakeObjectInstance(ClientWndProc);
      FPrevClientProc := Pointer(
        GetWindowLong(Form.Handle, GWL_WNDPROC));
      SetWindowLong(Form.Handle, 
        GWL_WNDPROC, Integer(FClientInstance));
      ...
     end
    else
    begin
      ...
      // unhook from the Form to stop reveiving 
      // the Windows messages
      SetWindowLong(Form.Handle, GWL_WNDPROC, 
        Integer(FPrevClientProc));
      FreeObjectInstance(FClientInstance);
      ...
     end;

    FActive := Value;
  end;
end;

procedure TMagnet.ClientWndProc(var Message: TMessage);
var
  R: TRect;
  P: TPoint;
begin
  with Message do
  begin
    case Msg of
      WM_ENTERSIZEMOVE:
        begin
          ...
        end;
      WM_EXITSIZEMOVE:
        begin
          ...
         end;
      WM_WINDOWPOSCHANGING:
        with TWmWindowPosChanging(Message).WindowPos^ do
        begin
          ...
        end;
      WM_DESTROY:
        Active := False;
    end;
    if (Result = 0) then
      Result := CallWindowProc(FPrevClientProc,
        Form.Handle, Msg, wParam, lParam);
  end;
end;

          FOldArea := Area;
          FDragStart := Area;
          FDragging := True;

          ClusterSnapList;
          FOldArea := Area;
          FDragging := False;

        with TWmWindowPosChanging(Message).WindowPos^ do
        begin
          FSnapList.Clear;
          if ... and
            (Dragging) then
          begin
            ...
            if (flags and SWP_NOMOVE = 0) then
            begin
              P := Point(x, y);
              WindowPosChanging(P, cx, cy);
              ...
              x := P.x;
              y := P.y;
            end;
            Result := 1;
          end
          ...
        end;

  if (soMagnet in SnapOptions) then
  begin
    i := ActiveMagnets.Count - 1;
    while (i >= 0) do
    begin
      // only enable snap to active magnets outside 
      // the cluster
      if (FCluster.IndexOf(ActiveMagnets[i]) < 0) then
      begin
        SnapNow := SnapToRect(
          aPos.x, aPos.y, W, H,
          TMagnet(ActiveMagnets[i]).Area,
          sbOuter);
        if SnapNow then
          FSnapList.Add(ActiveMagnets[i]);
      end;
      Dec(i);
    end;
  end;

  if (soInMainForm in SnapOptions) and
    (Form.Active) then
  begin
    MainFormR := Application.MainForm.BoundsRect;
    if RectOverlap(Area, MainFormR) then
      MainFormR := Classes.Rect(
        Application.MainForm.ClientToScreen(
          Application.MainForm.ClientRect.TopLeft),
        Application.MainForm.ClientToScreen(
          Application.MainForm.ClientRect.BottomRight));
    SnapNow := SnapToRect(
      aPos.x, aPos.y, W, H,
      MainFormR,
      sbNear);
  end;

  if (soInScreen in SnapOptions) then
  begin
    // determine screen snapping
    SnapNow := SnapToRect(
      aPos.X, aPos.Y, W, H,
      ScreenWorkArea,
      sbInner);
  end;

function TMagnet.SnapToRect(var aLeft, aTop: integer;
  const aWidth, aHeight: integer; aRect: TRect; aBorder:
  TSnapBorder): boolean;
var
  ISect, RangeRect: TRect;
begin
  Result := False;

  if (aBorder = sbInner) then
  begin
    // left edge
    if (aLeft < aRect.Left + Range) then
    begin
      aLeft := aRect.Left;
      Result := True;
    end;
    ...
  end
  else
    if (aBorder in [sbOuter, sbNear]) then
    begin
      RangeRect := GrowRect(aRect, Range);

      // if the source is not in range we can 
      // exit this routine
      IntersectRect(ISect, RangeRect, Rect(
        aLeft, aTop, aLeft + aWidth, aTop + aHeight));
      if IsRectEmpty(ISect) then Exit;

      // if sbOuter is specified the larger part of 
      // the rectangle must be outside
      if (aBorder = sbOuter) then
      begin
        IntersectRect(ISect, aRect, Rect(
          aLeft, aTop, aLeft + aWidth, aTop + aHeight));
        if (RectArea(ISect) >=
          RectArea(Rect(
            aLeft, aTop, aLeft + aWidth, aTop + aHeight)) 
            div 2) then
            Exit;
      end;

      // left to the right border
      if (Abs(aLeft - aRect.Right) < Range) then
      begin
        aLeft := aRect.Right;
        Result := True;
      end;
      // left on the left border
      if (Abs(aLeft - aRect.Left) < Range) then
      begin
        aLeft := aRect.Left;
        Result := True;
      end;
      ...
    end;
end;

procedure TMagnet.ClusterSnapList;
var
  j: integer;
begin
  try
    if (FSnapList.Count > 0) and (EnableClustering) then
    begin
      for j := 0 to FSnapList.Count - 1 do
        if RectAligned(Area, TMagnet(FSnapList[j]).Area) then
          AppendCluster(TMagnet(FSnapList[j]).Cluster);
      // distribute the assembled Cluster to all magnets
      for j := 0 to Cluster.Count - 1 do
        TMagnet(Cluster[j]).AppendCluster(Cluster);
    end;
  finally
    FSnapList.Clear;
  end;
end;

  // every magnet in the cluster has it's own snap
  // and is to be considered if in the cluster
  if (InCluster) and (Dragging) and 
    (ClusterSnapping) then
  begin
    for i := 0 to FCluster.Count - 1 do
    begin
      M := TMagnet(Cluster[i]);
      if (M <> Self) then
      begin
        P := Delta;
        // transform to M new position request
        P.X := M.Area.Left + P.X;
        P.Y := M.Area.Top + P.Y;
        // allow M to snap
        M.WindowPosChanging(P, 
          M.Area.Right-M.Area.Left, 
          M.Area.Bottom-M.Area.Top);

        // should merge snaplist with the most 
        // recent snaplist of M
        for j:=0 to M.FSnapList.Count-1 do
          if FSnapList.IndexOf(M.FSnapList[j]) < 0 then
            FSnapList.Add(M.FSnapList[j]);

        // transform M to the actual Delta
        P.X := P.X - M.Area.Left;
        P.Y := P.Y - M.Area.Top;
        // apply M's suggestion if it is different 
        // and not a zero-move.
        if ((P.X <> Delta.X) or (P.Y <> Delta.Y)) then
        begin
          // transform the adjusted delta to current 
          // coordinates
          aPos.X := aPos.X - Delta.x + P.X;
          aPos.Y := aPos.Y - Delta.y + P.Y;
        end;
      end;
    end;
  end;

      WM_WINDOWPOSCHANGING:
        with TWmWindowPosChanging(Message).WindowPos^ do
        begin
          FSnapList.Clear;
          if ((GetKeyState(VK_CONTROL) and $F0 = 0) 
            xor (not AutoSnap)) and
            (Dragging) then
          begin
            ...
            Result := 1;
          end
          else
          begin
            if Dragging and InCluster then
              UnCluster;
          end;
        end;

procedure TMagnet.UnCluster;
var
  j: integer;
  OldNeighbour: TMagnet;
  OldNeighbours: TList;
begin
  // remove this magnet from all others in the Cluster
  for j := Cluster.Count - 1 downto 0 do
  begin
    if (Cluster[j] <> Self) then
      TMagnet(Cluster[j]).RemoveFromCluster(Self);
  end;
  // reclusterize old neighbours which were in 
  // this cluster
  OldNeighbours := TList.Create;
  try
    for j:=Cluster.Count-1 downto 0 do
      if RectAligned(FOldArea, 
        TMagnet(Cluster[j]).Area) then
        OldNeighbours.Add(Cluster[j]);
    while (OldNeighbours.Count > 0) do
    begin
      OldNeighbour := TMagnet(OldNeighbours[0]);
      OldNeighbour.ReCluster(nil);
      OldNeighbours.Extract(OldNeighbour);
      // make sure other old neighbours which are now 
      // reclustered are no longer in the list to be 
      // reclustered again
      for j:=0 to OldNeighbour.Cluster.Count-1 do
        OldNeighbours.Extract(OldNeighbour.Cluster[j]);
    end;
    // empty the cluster list
    for j:=Cluster.Count-1 downto 0 do
      if Cluster[j] <> Self then
        Cluster.Delete(j);
  finally
    OldNeighbours.Free;
  end;
end;

procedure TMagnet.ReCluster(NewCluster: TList);
var
  i, j: integer;
  NewC: TList;
begin
  // assign the new clusterlist, of none is assigned 
  // this magnet is the initiator for the new cluster 
  // to be build.
  NewC := NewCluster;
  try
    if (NewC = nil) then
      NewC := TList.Create;
    // since we're asked to recluster we should be 
    // neighbour and be added
    NewC.Add(Self);
    // ask all magnets from the old cluster which is 
    // not yet in the new cluster to check for its 
    // neighbours.
    for j:=0 to Cluster.Count-1 do
    begin
      if (NewC.IndexOf(Cluster[j]) = -1) and
        (RectAligned(Area, 
         TMagnet(Cluster[j]).Area)) then
        TMagnet(Cluster[j]).ReCluster(NewC);
    end;
    // if this is the initiator for the new cluster 
    // broadcast the changes
    if (NewCluster = nil) then
    begin
      // extract all magnets in the new list from the 
      // old cluster
      for j:=Cluster.Count-1 downto 0 do
        for i:=0 to NewC.Count-1 do
          TMagnet(Cluster[j]).RemoveFromCluster(
            TMagnet(NewC[i]));
      // publish the new clusterlist to all magnets 
      // in this new list (incl self)
      for j:=0 to NewC.Count-1 do
        TMagnet(NewC[j]).Cluster.Assign(NewC);
    end;
  finally
    if (NewC <> NewCluster) then
      NewC.Free;
   end;
end;

[English] [welkom] [wie zijn wij] [info] [diensten] [producten] [download] [contact] [verwijzingen]