⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 jvformmagnet.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 2 页
字号:
      if Abs(FormRect.Top - ScreenRect.Top) < Integer(FArea) then
        DockOnTop
      else
      if (ScreenRect.Bottom - FormRect.Bottom) in [2..FArea] then
        DockOnBottom
      else
      if Abs(ScreenRect.Bottom - FormRect.Bottom) in [1..FArea] then
        UndockOnBottomOutside;
    end
    else
    if Abs(FormRect.Top - ScreenRect.Top) < Integer(FArea) then
      DockOnTop
    else
    if Abs(ScreenRect.Bottom - FormRect.Bottom) < Integer(FArea) then
      UndockOnBottomOutside;
end;

procedure TJvFormMagnet.GlueForms(var FormRect: TRect);
var
  I: Integer;
begin
  if Assigned(FForm) then
    for I := 0 to Application.ComponentCount - 1 do
      if Application.Components[I] is TForm then
        with Application.Components[I] as TForm do
          if (Left = FForm.Left + FForm.Width) or
            (Top = FForm.Top + FForm.Height) or
            (Left + Width = FForm.Left) or
            (Top + Height = FForm.Top) then
          begin
            Left := Left + (FormRect.Left - FForm.Left);
            Top := Top + (FormRect.Top - FForm.Top);
          end;
end;

procedure TJvFormMagnet.MagnetToMain(OldRect: TRect; var FormRect: TRect; MainRect: TRect);
var
  FormWidth, FormHeight: Integer;

  function OkayForAll(var Value: TDateTime): Boolean;
  begin
    Result := Abs(Value - Now) > EncodeTime(0, 0, 0, 250);
  end;

  function OkayForRight: Boolean;
  begin
    Result := OkayForAll(FLastRightDock);
  end;

  function OkayForTop: Boolean;
  begin
    Result := OkayForAll(FLastTopDock);
  end;

  function MovingToLeft: Boolean;
  begin
    Result := OldRect.Left > FormRect.Left;
  end;

  function MovingToRight: Boolean;
  begin
    Result := OldRect.Left < FormRect.Left;
  end;

  function MovingToTop: Boolean;
  begin
    Result := OldRect.Top > FormRect.Top;
  end;

  function MovingToBottom: Boolean;
  begin
    Result := OldRect.Top < FormRect.Top;
  end;

  function InWidth: Boolean;
  begin
    Result := ((FormRect.Left > MainRect.Left) and (FormRect.Left < MainRect.Right)) or
      ((FormRect.Left < MainRect.Left) and (FormRect.Right > MainRect.Left));
  end;

  function InHeight: Boolean;
  begin
    Result := ((FormRect.Top > MainRect.Top) and (FormRect.Top < MainRect.Bottom)) or
      ((FormRect.Top < MainRect.Top) and (FormRect.Bottom > MainRect.Top));
  end;

  procedure DockOnBottom;
  begin
    FormRect.Top := MainRect.Bottom;
    FormRect.Bottom := FormRect.Top + FormHeight;
    FLastTopDock := Now;
  end;

  procedure UndockOnBottomInside;
  begin
    FormRect.Top := MainRect.Bottom - Integer(FArea);
    FormRect.Bottom := FormRect.Top + FormHeight;
    FLastTopDock := Now;
  end;

  procedure UndockOnBottomOutside;
  begin
    FormRect.Top := MainRect.Bottom + Integer(FArea);
    FormRect.Bottom := FormRect.Top + FormHeight;
    FLastTopDock := Now;
  end;

  procedure DockOnTop;
  begin
    FormRect.Top := MainRect.Top - FormHeight;
    FormRect.Bottom := MainRect.Top;
    FLastTopDock := Now;
  end;

  procedure UndockOnTopOutside;
  begin
    FormRect.Top := MainRect.Top - FormHeight - Integer(FArea);
    FormRect.Bottom := MainRect.Top - Integer(FArea);
    FLastTopDock := Now;
  end;

  procedure UndockOnTopInside;
  begin
    FormRect.Top := MainRect.Top - FormHeight + Integer(FArea);
    FormRect.Bottom := MainRect.Top + Integer(FArea);
    FLastTopDock := Now;
  end;

  procedure DockOnRight;
  begin
    FormRect.Left := MainRect.Right;
    FormRect.Right := FormRect.Left + FormWidth;
    FLastRightDock := Now;
  end;

  procedure UndockOnRightInside;
  begin
    FormRect.Left := MainRect.Right - Integer(FArea);
    FormRect.Right := FormRect.Left + FormWidth;
    FLastRightDock := Now;
  end;

  procedure UndockOnRightOutside;
  begin
    FormRect.Left := MainRect.Right + Integer(FArea);
    FormRect.Right := FormRect.Left + FormWidth;
    FLastRightDock := Now;
  end;

  procedure DockOnLeft;
  begin
    FormRect.Left := MainRect.Left - FormWidth;
    FormRect.Right := MainRect.Left;
    FLastRightDock := Now;
  end;

  procedure UndockOnLeftInside;
  begin
    FormRect.Left := MainRect.Left - FormWidth + Integer(FArea);
    FormRect.Right := MainRect.Left + Integer(FArea);
    FLastRightDock := Now;
  end;

  procedure UndockOnLeftOutside;
  begin
    FormRect.Left := MainRect.Left - FormWidth - Integer(FArea);
    FormRect.Right := MainRect.Left - Integer(FArea);
    FLastRightDock := Now;
  end;

begin
  FormWidth := FormRect.Right - FormRect.Left;
  FormHeight := FormRect.Bottom - FormRect.Top;

  // Magnet/UnMagnet Bottom, Magnet/UnMagnet Top
  if MovingToTop and InWidth then
    if OkayForTop then
    begin
      if (FormRect.Top - MainRect.Bottom) in [2..FArea] then
        DockOnBottom
      else
      if -(FormRect.Top - MainRect.Bottom) in [2..FArea] then
        UndockOnBottomInside
      else
      if (FormRect.Bottom - MainRect.Top) in [2..FArea] then
        DockOnTop
      else
      if -(FormRect.Bottom - MainRect.Top) in [2..FArea] then
        UndockOnTopOutside;
    end
    else
    if Abs(FormRect.Top - MainRect.Bottom) < Integer(FArea) then
      DockOnBottom
    else
    if Abs(FormRect.Bottom - MainRect.Top) < Integer(FArea) then
      DockOnTop;

  if MovingToBottom and InWidth then
    if OkayForTop then
    begin
      if (FormRect.Top - MainRect.Bottom) in [2..FArea] then
        UndockOnBottomOutside
      else
      if -(FormRect.Top - MainRect.Bottom) in [2..FArea] then
        DockOnBottom
      else
      if (FormRect.Bottom - MainRect.Top) in [1..FArea] then
        DockOnTop
      else
      if Abs(FormRect.Bottom - MainRect.Top) in [2..FArea] then
        UndockOnTopInside;
    end
    else
    if Abs(FormRect.Top - MainRect.Bottom) < Integer(FArea) then
      DockOnBottom
    else
    if (FormRect.Bottom - MainRect.Top) < Integer(FArea) then
      DockOnTop;

  if MovingToLeft and InHeight then
    if OkayForRight then
    begin
      if (FormRect.Left - MainRect.Right) in [2..FArea] then
        DockOnRight
      else
      if Abs(FormRect.Left - MainRect.Right) in [2..FArea] then
        UndockOnRightInside
      else
      if (FormRect.Right - MainRect.Left) in [2..FArea] then
        DockOnLeft
      else
      if Abs(FormRect.Right - MainRect.Left) in [2..FArea] then
        UndockOnLeftOutside;
    end
    else
    if Abs(FormRect.Left - MainRect.Right) < Integer(FArea) then
      DockOnRight
    else
    if Abs(FormRect.Right - MainRect.Left) < Integer(FArea) then
      DockOnLeft;

  if MovingToRight and InHeight then
    if OkayForRight then
    begin
      if (MainRect.Left - FormRect.Right) in [2..FArea] then
        DockOnLeft
      else
      if Abs(MainRect.Left - FormRect.Right) in [2..FArea] then
        UndockOnLeftInside
      else
      if (MainRect.Right - FormRect.Left) in [2..FArea] then
        DockOnRight
      else
      if Abs(MainRect.Right - FormRect.Left) in [2..FArea] then
        UndockOnRightOutside;
    end
    else
    if Abs(MainRect.Left - FormRect.Right) < Integer(FArea) then
      DockOnLeft
    else
    if Abs(MainRect.Right - FormRect.Left) < Integer(FArea) then
      DockOnRight
end;

function TJvFormMagnet.NewWndProc(var Msg: TMessage): Boolean;
var
  R, R3: TRect;
begin
  Result := False;
  with Msg do
    if FActive then
      case Msg of
        WM_MOVING:
          begin
            R := PRect(LParam)^;
            R3.Left := FForm.Left;
            R3.Top := FForm.Top;
            R3.Right := R3.Left + FForm.Width;
            R3.Bottom := R3.Top + FForm.Height;
            MoveTo(R3, R);
            PRect(LParam)^ := R;
          end;
      end;
end;

procedure TJvFormMagnet.MoveTo(var SrcRect, Rect: TRect);
var
  DesktopWorkRect, PreviousRect: TRect;
begin
  PreviousRect := SrcRect;

  // Move to a side of the desktop?
  if FScreenMagnet then
  begin
    SystemParametersInfo(SPI_GETWORKAREA, 0, @DesktopWorkRect, 0);
    MagnetScreen(PreviousRect, Rect, DesktopWorkRect);
  end;

  // Move another form too?
  if FFormGlue then
    GlueForms(Rect);

  // Magnet to main form?
  if FMainFormMagnet and (Application.MainForm <> nil) then
  begin
    DesktopWorkRect.Left := Application.MainForm.Left;
    DesktopWorkRect.Top := Application.MainForm.Top;
    DesktopWorkRect.Right := Application.MainForm.Left + Application.MainForm.Width;
    DesktopWorkRect.Bottom := Application.MainForm.Top + Application.MainForm.Height;
    MagnetToMain(PreviousRect, Rect, DesktopWorkRect);
  end;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -