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

📄 appbar.pas

📁 与系统的桌面工具栏同样的功能 。 developed in delphi
💻 PAS
📖 第 1 页 / 共 4 页
字号:
    end; // end of else

  end; // end of case

  // Set the AppBar's z-order appropriately
  hWnd := HWND_NOTOPMOST; // Assume normal Z-Order
  if FABS.bAlwaysOnTop then begin
    // If we are supposed to be always-on-top, put us there
    hWnd := HWND_TOPMOST;
    if FbFullScreenAppOpen then
      // But, if a full-screen window is opened, put ourself at the bottom
      // of the z-order so that we don't cover the full-screen window
      hWnd := HWND_BOTTOM;
  end;
  SetWindowPos(Handle,
               hWnd,
               0, 0, 0, 0,
               SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);

  // Make sure that any auto-hide appbars stay on top of us after we move
  // even though our activation state has not changed
  AppBarMessage1(abmActivate);

  // Tell our derived class that there is a state change
  OnAppBarStateChange(False, abEdge);

  // Show or hide the taskbar entry depending on AppBar position
  case FABS.abTaskEntry of
    abtShow :
      ShowWindow(Application.Handle, SW_SHOW);
    abtHide :
      ShowWindow(Application.Handle, SW_HIDE);
    abtFloatDependent :
      case abEdge of
        abeFloat:
          ShowWindow(Application.Handle, SW_SHOW);
        abeLeft, abeTop, abeRight, abeBottom :
          ShowWindow(Application.Handle, SW_HIDE);
      end;
  end;
end;


// TAppBar.SetSlideTime ///////////////////////////////////////////////////////
procedure TAppBar.SetSlideTime (nInterval : Integer);
begin
  FABS.nTimerInterval := nInterval;
  FTimer.Interval := nInterval;
end;


{ Overridable functions }


// TAppBar.OnAppBarStateChange ////////////////////////////////////////////////
procedure TAppBar.OnAppBarStateChange (bProposed      : Boolean;
                                       abEdgeProposed : TAppBarEdge);
var
  bFullDragOn : LongBool;
begin
  // Find out if the user has FullDrag turned on
  SystemParametersInfo(SPI_GETDRAGFULLWINDOWS, 0, @bFullDragOn, 0);

  // If FullDrag is turned on OR the appbar has changed position
  if bFullDragOn or not bProposed then begin
    if abEdgeProposed = abeFloat then
      // Show the window adornments
      ModifyStyle(Handle,
                  GWL_STYLE,
                  0,
                  WS_CAPTION or WS_SYSMENU,
                  SWP_DRAWFRAME)
    else
      // Hide the window adornments
      ModifyStyle(Handle,
                  GWL_STYLE,
                  WS_CAPTION or WS_SYSMENU,
                  0,
                  SWP_DRAWFRAME);
  end;
end;


// TAppBar.OnAppBarForcedToDocked /////////////////////////////////////////////
procedure TAppBar.OnAppBarForcedToDocked;
const
  CRLF = #10#13;
begin
  // Display the application name as the message box caption text.
  MessageDlg('There is already an auto hidden window on this edge.' + CRLF +
             'Only one auto hidden window is allowed on each edge.',
             mtInformation,
             [mbOk],
             0);
end;

// TAppBar.OnABNFullScreenApp /////////////////////////////////////////////////
procedure TAppBar.OnABNFullScreenApp (bOpen : Boolean);
begin
  // This function is called when a FullScreen window is openning or
  // closing. A FullScreen window is a top-level window that has its caption
  // above the top of the screen allowing the entire screen to be occupied
  // by the window's client area.

  // If the AppBar is a topmost window when a FullScreen window is activated,
  // we need to change our window to a non-topmost window so that the AppBar
  // doesn't cover the FullScreen window's client area.

  // If the FullScreen window is closing, we need to set the AppBar's
  // Z-Order back to when the user wants it to be.
  FbFullScreenAppOpen := bOpen;
  UpdateBar;
end;


// TAppBar.OnABNPosChanged ////////////////////////////////////////////////////
procedure TAppBar.OnABNPosChanged;
begin
  // The TaskBar or another AppBar has changed its size or position
  if (GetEdge <> abeFloat) and (not FABS.bAutohide) then
    // If we're not floating and we're not auto-hidden, we have to
    // reposition our window
    UpdateBar;
end;


// TAppBar.OnABNWindowArrange /////////////////////////////////////////////////
procedure TAppBar.OnABNWindowArrange (bBeginning : Boolean);
begin
  // This function intentionally left blank
end;


{ Message handlers }


// TAppBar.OnAppBarCallbackMsg ////////////////////////////////////////////////
procedure TAppBar.OnAppBarCallbackMsg (var Msg : TMessage);
begin
  case Msg.WParam of

    ABN_FULLSCREENAPP:
      OnABNFullScreenApp(Msg.LParam <> 0);

    ABN_POSCHANGED:
      OnABNPosChanged;

    ABN_WINDOWARRANGE:
      OnABNWindowArrange(Msg.LParam <> 0);
  end;
end;


// TAppBar.OnCreate ///////////////////////////////////////////////////////////
procedure TAppBar.OnCreate (var Msg : TWMCreate);
var
  hMenu : THandle;
begin
  inherited;
  // Associate a timer with the AppBar.  The timer is used to determine
  // when a visible, inactive, auto-hide AppBar should be re-hidden
  FTimer := TTimer.Create(Self);
  with FTimer do begin
    Interval := FABS.nTimerInterval;
    OnTimer := OnAppBarTimer;
    Enabled := True;
  end;

  // Save the initial position of the floating AppBar
  FABS.rcFloat.Left   := Left;
  FABS.rcFloat.Top    := Top;

  // Register our AppBar window with the Shell
  AppBarMessage1(abmNew);

  // Update AppBar internal state
  UpdateBar;

  // Save the initial size of the floating AppBar
  PostMessage(Handle, WM_ENTERSIZEMOVE, 0, 0);
  PostMessage(Handle, WM_EXITSIZEMOVE,  0, 0);

  // Remove system menu
  hMenu := GetSystemMenu(Handle, False);
  DeleteMenu(hMenu, SC_RESTORE,  MF_BYCOMMAND);
  DeleteMenu(hMenu, SC_MINIMIZE, MF_BYCOMMAND);
  DeleteMenu(hMenu, SC_MAXIMIZE, MF_BYCOMMAND);
end;


// TAppBar.OnDestroy //////////////////////////////////////////////////////////
procedure TAppBar.OnDestroy (var Msg : TWMDestroy);
begin
  // Free the Autohide timer
  FTimer.Enabled := False;
  FTimer.Free;
  // Unregister our AppBar window with the Shell
  SetEdge(abeUnknown);
  inherited;
end;


// TAppBar.OnWindowPosChanged /////////////////////////////////////////////////
procedure TAppBar.OnWindowPosChanged (var Msg : TWMWindowPosChanged);
begin
  inherited;
  // When our window changes position, tell the Shell so that any
  // auto-hidden AppBar on our edge stays on top of our window making it
  // always accessible to the user
  AppBarMessage1(abmWindowPosChanged);
end;


// TAppBar.OnActivate /////////////////////////////////////////////////////////
procedure TAppBar.OnActivate (var Msg : TWMActivate);
begin
  inherited;
  if Msg.Active = WA_INACTIVE then
    // Hide the AppBar if we are docked and auto-hidden
    ShowHiddenAppBar(False);
  // When our window changes position, tell the Shell so that any
  // auto-hidden AppBar on our edge stays on top of our window making it
  // always accessible to the user.
  AppBarMessage1(abmActivate);
end;


// TAppBar.OnAppBarTimer //////////////////////////////////////////////////////
procedure TAppBar.OnAppBarTimer (Sender : TObject);
var
  pt : TSmallPoint;
  rc : TRect;
begin
  if GetActiveWindow <> Handle then begin
    // Possibly hide the AppBar if we are not the active window
    // Get the position of the mouse and the AppBar's position
    // Everything must be in screen coordinates
    pt := GetMessagePosition;
    GetWindowRect(Handle, rc);
    // Add a little margin around the AppBar
    InflateRect(rc,
                2 * GetSystemMetrics(SM_CXDOUBLECLK),
                2 * GetSystemMetrics(SM_CYDOUBLECLK));
    if not PtInRect(rc, SmallPointToPoint(pt)) then
      // If the mouse is NOT over the AppBar, hide the AppBar
      ShowHiddenAppBar(False);
  end;
  inherited;
end;


// TAppBar.OnNcMouseMove //////////////////////////////////////////////////////
procedure TAppBar.OnNcMouseMove (var Msg : TWMNCMouseMove);
begin
  // If we are a docked, auto-hidden AppBar, shown us
  // when the user moves over our non-client area
  ShowHiddenAppBar(True);
  inherited;
end;


// TAppBar.OnNcHitTest ////////////////////////////////////////////////////////
procedure TAppBar.OnNcHitTest (var Msg: TWMNCHitTest);
var
  u : UINT;
  bPrimaryMouseBtnDown : Boolean;
  rcClient : TRect;
  pt : TPoint;
  vKey : Integer;
begin
  // Find out what the system thinks is the hit test code
  inherited;
  u := Msg.Result;

  // NOTE: If the user presses the secondary mouse button, pretend that the
  // user clicked on the client area so that we get WM_CONTEXTMENU messages
  if GetSystemMetrics(SM_SWAPBUTTON) <> 0 then
    vKey := VK_RBUTTON
  else
    vKey := VK_LBUTTON;
  bPrimaryMouseBtnDown := ((GetAsyncKeyState(vKey) and $8000) <> 0);

  pt.X := Msg.XPos;
  pt.Y := Msg.YPos;
  pt := ScreenToClient(pt);
  if (u = HTCLIENT) and bPrimaryMouseBtnDown
     and (ControlAtPos(pt, False) = nil) then
    // User clicked in client area, allow AppBar to move.  We get this
    // behavior by pretending that the user clicked on the caption area
    u := HTCAPTION;

  // If the AppBar is floating and the hittest code is a resize code...
  if ((GetEdge = abeFloat) and
      (HTSIZEFIRST <= u) and (u <= HTSIZELAST)) then begin
    case u of
      HTLEFT, HTRIGHT:
        if FABS.szSizeInc.cx = 0
          then u := HTBORDER;
      HTTOP, HTBOTTOM:
        if FABS.szSizeInc.cy = 0
          then u := HTBORDER;
      HTTOPLEFT:
        if (FABS.szSizeInc.cx = 0) and (FABS.szSizeInc.cy = 0)
          then u := HTBORDER
        else if (FABS.szSizeInc.cx = 0) and (FABS.szSizeInc.cy <> 0)
          then u := HTTOP
        else if (FABS.szSizeInc.cx <> 0) and (FABS.szSizeInc.cy = 0)
          then u := HTLEFT;
      HTTOPRIGHT:
        if (FABS.szSizeInc.cx = 0) and (FABS.szSizeInc.cy = 0)
          then u := HTBORDER
        else if (FABS.szSizeInc.cx = 0) and (FABS.szSizeInc.cy <> 0)
          then u := HTTOP
        else if (FABS.szSizeInc.cx <> 0) and (FABS.szSizeInc.cy = 0)
          then u := HTRIGHT;
      HTBOTTOMLEFT:
        if (FABS.szSizeInc.cx = 0) and (FABS.szSizeInc.cy = 0)
          then u := HTBORDER
        else if (FABS.szSizeInc.cx = 0) and (FABS.szSizeInc.cy <> 0)
          then u := HTBOTTOM
        else if (FABS.szSizeInc.cx <> 0) and (FABS.szSizeInc.cy = 0)
          then u := HTLEFT;
      HTBOTTOMRIGHT:
        if (FABS.szSizeInc.cx = 0) and (FABS.szSizeInc.cy = 0)
          then u := HTBORDER
        else if (FABS.szSizeInc.cx = 0) and (FABS.szSizeInc.cy <> 0)
          then u := HTBOTTOM
        else if (FABS.szSizeInc.cx <> 0) and (FABS.szSizeInc.cy = 0)
          then u := HTRIGHT;
    end;
  end;

  // When the AppBar is docked, the user can resize only one edge.
  // This next section determines which edge the user can resize.
  // To allow resizing, the AppBar window must have the WS_THICKFRAME style

  // If the AppBar is docked and the hittest code is a resize code...
  if ((GetEdge <> abeFloat) and (GetEdge <> abeUnknown) and
      (HTSIZEFIRST <= u) and (u <= HTSIZELAST)) then begin

    if (IsEdgeLeftOrRight(GetEdge) and (FABS.szSizeInc.cx = 0)) or
       (not IsEdgeLeftOrRight(GetEdge) and (FABS.szSizeInc.cy = 0)) then begin
      // If the width/height size increment is zero, then resizing is NOT
      // allowed for the edge that the AppBar is docked on
      u := HTBORDER; // Pretend that the mouse is not on a resize border
    end else begin
      // Resizing IS allowed for the edge that the AppBar is docked on
      // Get the location of the appbar's client area in screen coordinates
      rcClient := GetClientRect;
      pt.X := rcClient.Left;
      pt.Y := rcClient.Top;
      pt := ClientToScreen(pt);
      rcClient.Left := pt.X;
      rcClient.Top  := pt.Y;
      pt.X := rcClient.Right;
      pt.Y := rcClient.Bottom;
      pt := ClientToScreen(pt);
      rcClient.Right  := pt.X;
      rcClient.Bottom := pt.Y;

      u := HTBORDER;  // Assume that we can't resize
      case GetEdge of
        abeLeft:
          if Msg.XPos > rcClient.Right then
            u := HTRIGHT;
        abeTop:
          if Msg.YPos > rcClient.Bottom then
            u := HTBOTTOM;
        abeRight:
          if Msg.XPos < rcClient.Left then
            u := HTLEFT;
        abeBottom:
          if Msg.YPos < rcClient.Top then
            u := HTTOP;
      end; // end of case
    end; // end of else
  end;

  // Return the hittest code
  Msg.Result := u;
end;


// TAppBar.OnEnterSizeMove ////////////////////////////////////////////////////
procedure TAppBar.OnEnterSizeMove (var Msg : TMessage);
begin
  // The user started moving/resizing the AppBar, save its current state
  FabEdgeProposedPrev := GetEdge;
end;


// TAppBar.OnExitSizeMove /////////////////////////////////////////////////////
procedure TAppBar.OnExitSizeMove (var Msg : TMessage);
var
  abEdgeProposedPrev : TAppBarEdge;
  rc, rcWorkArea : TRect;
  w, h : Integer;
begin
  // The user stopped moving/resizing the AppBar, set the new state
  // Save the new proposed state of the AppBar
  abEdgeProposedPrev := FabEdgeProposedPrev;

  // Set the proposed state back to unknown.  This causes GetState
  // to return the current state rather than the proposed state
  FabEdgeProposedPrev := abeUnknown;

  // Get the location of the window in screen coordinates
  GetWindowRect(Handle, rc);

  // If the AppBar's state has changed...
  if GetEdge = abEdgeProposedPrev then
    case GetEdge of
      abeLeft, abeRight:
        // Save the new width of the docked AppBar
        FABS.szDockSize.cx := rc.Right - rc.Left;
      abeTop, abeBottom:
        // Save the new height of the docked AppBar
        FABS.szDockSize.cy := rc.Bottom - rc.Top;
    end;

  // Always save the new position of the floating AppBar
  if abEdgeProposedPrev = abeFloat then begin
    // If AppBar was floating and keeps floating...
    if GetEdge = abeFloat then begin
      FABS.rcFloat := rc;
    // If AppBar was docked and is going to float...
    end else begin
      // Propose width and height depending on the current window position

⌨️ 快捷键说明

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