appbar.pas

来自「与系统的桌面工具栏同样的功能 。 developed in delphi」· PAS 代码 · 共 1,710 行 · 第 1/4 页

    // KeyName in the registry where settings should be loaded/saved
    property KeyName : String read  FabSettingsLocation.KeyName
                              write FabSettingsLocation.KeyName;

  end;


implementation


{ Internal implementation functions }


// TAppBar.CreateParams ///////////////////////////////////////////////////////
procedure TAppBar.CreateParams (var Params: TCreateParams);
var
  dwAdd, dwRemove, dwAddEx, dwRemoveEx : DWORD;
begin
  // Call the inherited first
  inherited CreateParams(Params);

  // Styles to be added
  dwAdd := 0;
  dwAddEx := WS_EX_TOOLWINDOW;

  // Styles to be removed
  dwRemove := WS_SYSMENU or WS_MAXIMIZEBOX or WS_MINIMIZEBOX;
  dwRemoveEx := WS_EX_APPWINDOW;

  // Modify style flags
  with Params do begin
    Style := Style and (not dwRemove);
    Style := Style or dwAdd;
    ExStyle := ExStyle and (not dwRemoveEx);
    ExStyle := ExStyle or dwAddEx;
  end;
end;


// TAppBar.AppBarMessage //////////////////////////////////////////////////////
function TAppBar.AppBarMessage (abMessage : TAppBarMessage;
                                abEdge    : TAppBarEdge;
                                lParam    : LPARAM;
                                bRect     : Boolean;
                                var rc    : TRect) : UINT;
var
  abd : TAppBarData;
begin
  // Initialize an APPBARDATA structure
  abd.cbSize := sizeof(abd);
  abd.hWnd := Handle;
  abd.uCallbackMessage := WM_APPBARNOTIFY;
  abd.uEdge := Ord(abEdge);
  if bRect then
    abd.rc := rc
  else
    abd.rc := Rect(0, 0, 0, 0);
  abd.lParam := lParam;
  Result := SHAppBarMessage(Ord(abMessage), abd);

  // If the caller passed a rectangle, return the updated rectangle
  if bRect then
    rc := abd.rc;
end;


// TAppBar.AppBarMessage1 /////////////////////////////////////////////////////
function TAppBar.AppBarMessage1 (abMessage : TAppBarMessage) : UINT;
var
  rc : TRect;
begin
  Result := AppBarMessage(abMessage, abeFloat, 0, False, rc);
end;


// TAppBar.AppBarMessage2 /////////////////////////////////////////////////////
function TAppBar.AppBarMessage2 (abMessage : TAppBarMessage;
                                 abEdge    : TAppBarEdge) : UINT;
var
  rc : TRect;
begin
  Result := AppBarMessage(abMessage, abEdge, 0, False, rc);
end;


// TAppBar.AppBarMessage3 /////////////////////////////////////////////////////
function TAppBar.AppBarMessage3 (abMessage : TAppBarMessage;
                                 abEdge    : TAppBarEdge;
                                 lParam    : LPARAM) : UINT;
var
  rc : TRect;
begin
  Result := AppBarMessage(abMessage, abEdge, lParam, False, rc);
end;


// TAppBar.AppBarMessage4 /////////////////////////////////////////////////////
function TAppBar.AppBarMessage4 (abMessage : TAppBarMessage;
                                 abEdge    : TAppBarEdge;
                                 lParam    : LPARAM;
                                 var rc    : TRect) : UINT;
begin
  Result := AppBarMessage(abMessage, abEdge, lParam, True, rc);
end;


// TAppBar.CalcProposedState //////////////////////////////////////////////////
function TAppBar.CalcProposedState (var pt : TSmallPoint) : TAppBarEdge;
var
  bForceFloat : Boolean;
begin
  // Force the AppBar to float if the user is holding down the Ctrl key
  // and the AppBar's style allows floating
  bForceFloat := ((GetKeyState(VK_CONTROL) and $8000) <> 0) and
                 (abfAllowFloat in FABS.abFlags);
  if bForceFloat then
    Result := abeFloat
  else
    Result := GetEdgeFromPoint(FABS.abFlags, pt);
end;


// TAppBar.GetRect ////////////////////////////////////////////////////////////
procedure TAppBar.GetRect (abEdgeProposed : TAppBarEdge;
                           var rcProposed : TRect);
begin
  // This function finds the x, y, cx, cy of the AppBar window
  if abEdgeProposed = abeFloat then begin
    // The AppBar is floating, the proposed rectangle is correct
  end else begin
    // The AppBar is docked or auto-hide
    // Set dimensions to full screen
    with rcProposed do begin
      Left   := 0;
      Top    := 0;
      Right  := GetSystemMetrics(SM_CXSCREEN);
      Bottom := GetSystemMetrics(SM_CYSCREEN);
    end;

    // Subtract off what we want from the full screen dimensions
    if not FABS.bAutohide then
      // Ask the shell where we can dock
      AppBarMessage4(abmQueryPos, abEdgeProposed, LPARAM(False), rcProposed);

    case abEdgeProposed of
      abeLeft:
        rcProposed.Right  := rcProposed.Left   + FABS.szDockSize.cx;
      abeTop:
        rcProposed.Bottom := rcProposed.Top    + FABS.szDockSize.cy;
      abeRight:
        rcProposed.Left   := rcProposed.Right  - FABS.szDockSize.cx;
      abeBottom:
        rcProposed.Top    := rcProposed.Bottom - FABS.szDockSize.cy;
    end; // end of case

  end; // end of else
end;


// TAppBar.AdjustLocationForAutohide //////////////////////////////////////////
function TAppBar.AdjustLocationForAutohide (bShow  : Boolean;
                                            var rc : TRect) : Boolean;
var
  x, y : Integer;
  cxVisibleBorder, cyVisibleBorder : Integer;
begin
  if ((GetEdge = abeUnknown) or (GetEdge = abeFloat) or
      (not FABS.bAutohide)) then begin
    // If we are not docked on an edge OR we are not auto-hidden, there is
    // nothing for us to do; just return
    Result := False;
    Exit;
  end;

  // Showing/hiding doesn't change our size; only our position
  x := 0; y := 0; // Assume a position of (0, 0)

  if bShow then
    // If we are on the right or bottom, calculate our visible position
    case GetEdge of
      abeRight:
        x := GetSystemMetrics(SM_CXSCREEN) - (rc.Right - rc.Left);
      abeBottom:
        y := GetSystemMetrics(SM_CYSCREEN) - (rc.Bottom - rc.Top);
    end
  else begin
    // Keep a part of the AppBar visible at all times
    cxVisibleBorder := 2 * GetSystemMetrics(SM_CXBORDER);
    cyVisibleBorder := 2 * GetSystemMetrics(SM_CYBORDER);

    // Calculate our x or y coordinate so that only the border is visible
    case GetEdge of
      abeLeft:
        x := -((rc.Right - rc.Left) - cxVisibleBorder);
      abeRight:
        x := GetSystemMetrics(SM_CXSCREEN) - cxVisibleBorder;
      abeTop:
        y := -((rc.Bottom - rc.Top) - cyVisibleBorder);
      abeBottom:
        y := GetSystemMetrics(SM_CYSCREEN) - cyVisibleBorder;
    end;
  end;

  with rc do begin
    Right  := x + (Right - Left);
    Bottom := y + (Bottom - Top);
    Left   := x;
    Top    := y;
  end;

  Result := True;
end;


// TAppBar.ShowHiddenAppBar ///////////////////////////////////////////////////
procedure TAppBar.ShowHiddenAppBar (bShow : Boolean);
var
  rc : TRect;
begin
  // Get our window location in screen coordinates
  GetWindowRect(Handle, rc);

  // Assume  that we are visible
  FbAutoHideIsVisible := True;

  if AdjustLocationForAutohide(bShow, rc) then begin
    // the rectangle was adjusted, we are an autohide bar
    // Remember whether we are visible or not
    FbAutoHideIsVisible := bShow;

    // Slide window in from or out to the edge
    SlideWindow(rc);
  end;
end;


// TAppBar.SlideWindow ////////////////////////////////////////////////////////
procedure TAppBar.SlideWindow (var rcEnd : TRect);
var
  bFullDragOn : LongBool;
  rcStart : TRect;
  dwTimeStart, dwTimeEnd, dwTime : DWORD;
  x, y, w, h : Integer;
begin
  // Only slide the window if the user has FullDrag turned on
  SystemParametersInfo(SPI_GETDRAGFULLWINDOWS, 0, @bFullDragOn, 0);

  // Get the current window position
  GetWindowRect(Handle, rcStart);
  if (FABS.bSlideEffect and bFullDragOn and
      ((rcStart.Left   <> rcEnd.Left  ) or
       (rcStart.Top    <> rcEnd.Top   ) or
       (rcStart.Right  <> rcEnd.Right ) or
       (rcStart.Bottom <> rcEnd.Bottom))) then begin

    // Get our starting and ending time
    dwTimeStart := GetTickCount;
    dwTimeEnd := dwTimeStart + FABS.nTimerInterval;
    dwTime := dwTimeStart;
    while (dwTime < dwTimeEnd) do begin
      // While we are still sliding, calculate our new position
      x := rcStart.Left - (rcStart.Left - rcEnd.Left)
           * Integer(dwTime - dwTimeStart) div FABS.nTimerInterval;

      y := rcStart.Top  - (rcStart.Top  - rcEnd.Top)
           * Integer(dwTime - dwTimeStart) div FABS.nTimerInterval;

      w := (rcStart.Right - rcStart.Left)
           - ((rcStart.Right - rcStart.Left) - (rcEnd.Right - rcEnd.Left))
           * Integer(dwTime - dwTimeStart) div FABS.nTimerInterval;

      h := (rcStart.Bottom - rcStart.Top)
           - ((rcStart.Bottom - rcStart.Top) - (rcEnd.Bottom - rcEnd.Top))
           * Integer(dwTime - dwTimeStart) div FABS.nTimerInterval;

      // Show the window at its changed position
      SetWindowPos(Handle, 0, x, y, w, h,
                   SWP_NOZORDER or SWP_NOACTIVATE or SWP_DRAWFRAME);
      UpdateWindow(Handle);
      dwTime := GetTickCount;
    end;
  end;

  // Make sure that the window is at its final position
  Left   := rcEnd.Left;
  Top    := rcEnd.Top;
  Width  := rcEnd.Right - rcEnd.Left;
  Height := rcEnd.Bottom - rcEnd.Top;
end;


// TAppBar.GetAutohideEdge ////////////////////////////////////////////////////
function TAppBar.GetAutohideEdge : TAppBarEdge;
begin
  if Handle = AppBarMessage2(abmGetAutoHideBar, abeLeft) then
    Result := abeLeft
  else if Handle = AppBarMessage2(abmGetAutoHideBar, abeTop) then
    Result := abeTop
  else if Handle = AppBarMessage2(abmGetAutoHideBar, abeRight) then
    Result := abeRight
  else if Handle = AppBarMessage2(abmGetAutoHideBar, abeBottom) then
    Result := abeBottom
  else
    // NOTE: If AppBar is docked but not auto-hidden, we return ABE_UNKNOWN
    Result := abeUnknown;
end;


// TAppBar.GetMessagePosition /////////////////////////////////////////////////
function TAppBar.GetMessagePosition : TSmallPoint;
var
  pt : TSmallPoint;
  dw : DWORD;
begin
  dw := GetMessagePos;
  pt.X := SHORT(dw);
  pt.Y := SHORT((dw and $FFFF0000) shr 16);
  Result := pt;
end;


// TAppBar.ModifyStyle ////////////////////////////////////////////////////////
function TAppBar.ModifyStyle (hWnd : THandle;
                              nStyleOffset : Integer;
                              dwRemove     : DWORD;
                              dwAdd        : DWORD;
                              nFlags       : UINT) : Boolean;
var
  dwStyle : DWORD;
  dwNewStyle : DWORD;
begin
  dwStyle := GetWindowLong(hWnd, nStyleOffset);
  dwNewStyle := (dwStyle and (not dwRemove)) or dwAdd;

  if dwStyle = dwNewStyle then begin
    Result := False;
    Exit;
  end;

  SetWindowLong(hWnd, nStyleOffset, dwNewStyle);

  if nFlags <> 0 then
    SetWindowPos(hWnd, 0, 0, 0, 0, 0,
      SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or nFlags);

  Result := True;
end;


{ Property selector functions }


// TAppBar.GetEdge ////////////////////////////////////////////////////////////
function TAppBar.GetEdge : TAppBarEdge;
begin
  if FabEdgeProposedPrev <> abeUnknown then
    Result := FabEdgeProposedPrev
  else
    Result := FABS.abEdge;
end;


// TAppBar.SetEdge ////////////////////////////////////////////////////////////
procedure TAppBar.SetEdge (abEdge : TAppBarEdge);
var
  abCurrentEdge : TAppBarEdge;
  currentRect : TRect;
  rc : TRect;
  hWnd : THandle;
begin
  // If the AppBar is registered as auto-hide, unregister it
  abCurrentEdge := GetAutohideEdge;

  if abCurrentEdge <> abeUnknown then
    // Our AppBar is auto-hidden, unregister it
    AppBarMessage3(abmSetAutoHideBar, abCurrentEdge, LPARAM(False));

  // Save the new requested state
  FABS.abEdge := abEdge;

  case abEdge of

    abeUnknown: begin
      // We are being completely unregistered.
      // Probably, the AppBar window is being destroyed.
      // If the AppBar is registered as NOT auto-hide, unregister it
      AppBarMessage1(abmRemove);
    end;

    abeFloat: begin
      // We are floating and therefore are just a regular window.
      // Tell the shell that the docked AppBar should be of 0x0 dimensions
      // so that the workspace is not affected by the AppBar
      currentRect := Rect(0, 0, 0, 0);
      AppBarMessage4(abmSetPos, abEdge, LPARAM(False), currentRect);
      Left   := FABS.rcFloat.Left;
      Top    := FABS.rcFloat.Top;
      Width  := FABS.rcFloat.Right - FABS.rcFloat.Left;
      Height := FABS.rcFloat.Bottom - FABS.rcFloat.Top;
    end;

    else begin
      if FABS.bAutohide and
         (AppBarMessage3(abmSetAutoHideBar,
                         GetEdge,
                         LPARAM(True)) = 0) then begin
        // We couldn't set the AppBar on a new edge, let's dock it instead
        FABS.bAutohide := False;
        // Call a virtual function to let derived classes know that the AppBar
        // changed from auto-hide to docked
        OnAppBarForcedToDocked;
      end;

      GetRect(GetEdge, rc);
      if FABS.bAutohide then begin
        currentRect := Rect(0, 0, 0, 0);
        AppBarMessage4(abmSetPos, abeLeft, LPARAM(False), currentRect);
      end else begin
        // Tell the shell where the AppBar is
        AppBarMessage4(abmSetPos, abEdge, LPARAM(False), rc);
      end;

      AdjustLocationForAutohide(FbAutoHideIsVisible, rc);

      // Slide window in from or out to the edge
      SlideWindow(rc);