appbar.pas

与系统的桌面工具栏同样的功能 。 developed in delphi

      w := rc.Right - rc.Left;
      h := rc.Bottom - rc.Top;
      // Adjust width and height
      SystemParametersInfo(SPI_GETWORKAREA, 0, @rcWorkArea, 0);
      if (w >= (rcWorkArea.Right - rcWorkArea.Left)) or
         (h >= (rcWorkArea.Bottom - rcWorkArea.Top)) then begin
        w := FABS.rcFloat.Right - FABS.rcFloat.Left;
        h := FABS.rcFloat.Bottom - FABS.rcFloat.Top;
      end;
      // Save new floating position
      FABS.rcFloat.Left   := rc.Left;
      FABS.rcFloat.Top    := rc.Top;
      FABS.rcFloat.Right  := rc.Left + w;
      FABS.rcFloat.Bottom := rc.Top + h;
    end;
  end;

  // After setting the dimensions, set the AppBar to the proposed state
  SetEdge(abEdgeProposedPrev);
end;


// TAppBar.OnMoving ///////////////////////////////////////////////////////////
procedure TAppBar.OnMoving (var Msg : TMessage);
var
  prc            : PRect;
  pt             : TSmallPoint;
  abEdgeProposed : TAppBarEdge;
  w, h           : Integer;
begin
  // We control the moving of the AppBar.  For example, if the mouse moves
  // close to an edge, we want to dock the AppBar
  // The lParam contains the window's position proposed by the system
  prc := PRect(Msg.LParam);

  // Get the location of the mouse cursor
  pt := GetMessagePosition;

  // Where should the AppBar be based on the mouse position?
  abEdgeProposed := CalcProposedState(pt);

  if ((FabEdgeProposedPrev <> abeFloat) and
      (abEdgeProposed = abeFloat)) then begin
    // While moving, the user took us from a docked/autohidden state to
    // the float state.  We have to calculate a rectangle location so that
    // the mouse cursor stays inside the window.
    prc^ := FABS.rcFloat;
    w := prc^.Right - prc^.Left;
    h := prc^.Bottom - prc^.Top;
    with prc^ do begin
      Left   := pt.X - w div 2;
      Top    := pt.Y;
      Right  := pt.X - w div 2 + w;
      Bottom := pt.Y + h;
    end;
  end;

  // Remember the most-recently proposed state
  FabEdgeProposedPrev := abEdgeProposed;

  // Tell the system where to move the window based on the proposed state
  GetRect(abEdgeProposed, prc^);

  // Tell our derived class that there is a proposed state change
  OnAppBarStateChange(True, abEdgeProposed);
end;


// TAppBar.OnSizing ///////////////////////////////////////////////////////////
procedure TAppBar.OnSizing (var Msg : TMessage);
var
  prc : PRect;
  rcBorder : TRect;
  nWidthNew, nHeightNew : Integer;
begin
  // We control the sizing of the AppBar.  For example, if the user re-sizes
  // an edge, we want to change the size in discrete increments.
  // The lParam contains the window's position proposed by the system
  prc := PRect(Msg.LParam);

  // Get the minimum allowed size of the window depending on current edge.
  // This is the width/height of the window that must always be present
  with FABS do
    case abEdge of
      abeFloat:
        rcBorder := Rect(0, 0, nMinWidth, nMinHeight);
      else
        rcBorder := Rect(0, 0, szMinDockSize.cx, szMinDockSize.cy);
    end;

  // We force the window to resize in discrete units set by the FABS.szSizeInc
  // member.  From the new, proposed window dimensions passed to us, round
  // the width/height to the nearest discrete unit
  if FABS.szSizeInc.cx <> 0 then
    nWidthNew  := ((prc^.Right - prc^.Left) - (rcBorder.Right - rcBorder.Left)
                   + FABS.szSizeInc.cx div 2) div FABS.szSizeInc.cx
                   * FABS.szSizeInc.cx + (rcBorder.Right - rcBorder.Left)
  else
    nWidthNew  := prc^.Right - prc^.Left;

  if FABS.szSizeInc.cy <> 0 then
    nHeightNew := ((prc^.Bottom - prc^.Top) - (rcBorder.Bottom - rcBorder.Top)
                   + FABS.szSizeInc.cy div 2) div FABS.szSizeInc.cy
                   * FABS.szSizeInc.cy + (rcBorder.Bottom - rcBorder.Top)
  else
    nHeightNew := prc^.Bottom - prc^.Top;

  // Adjust the rectangle's dimensions
  case Msg.wParam of
    WMSZ_LEFT:
      prc^.Left   := prc^.Right  - nWidthNew;

    WMSZ_TOP:
      prc^.Top    := prc^.Bottom - nHeightNew;

    WMSZ_RIGHT:
      prc^.Right  := prc^.Left   + nWidthNew;

    WMSZ_BOTTOM:
      prc^.Bottom := prc^.Top    + nHeightNew;

    WMSZ_BOTTOMLEFT: begin
      prc^.Bottom := prc^.Top    + nHeightNew;
      prc^.Left   := prc^.Right  - nWidthNew;
    end;

    WMSZ_BOTTOMRIGHT: begin
      prc^.Bottom := prc^.Top    + nHeightNew;
      prc^.Right  := prc^.Left   + nWidthNew;
    end;

    WMSZ_TOPLEFT: begin
      prc^.Left   := prc^.Right  - nWidthNew;
      prc^.Top    := prc^.Bottom - nHeightNew;
    end;

    WMSZ_TOPRIGHT: begin
      prc^.Top    := prc^.Bottom - nHeightNew;
      prc^.Right  := prc^.Left   + nWidthNew;
    end;
  end; // end of case
end;


// TAppBar.OnGetMinMaxInfo ////////////////////////////////////////////////////
procedure TAppBar.OnGetMinMaxInfo (var Msg : TWMGetMinMaxInfo);
begin
  if GetEdge = abeFloat then
    with Msg.MinMaxInfo^ do begin
      ptMinTrackSize.X := FABS.nMinWidth;
      ptMinTrackSize.Y := FABS.nMinHeight;
      ptMaxTrackSize.X := FABS.nMaxWidth;
      ptMaxTrackSize.Y := FABS.nMaxHeight;
    end
  else
    with Msg.MinMaxInfo^ do begin
      ptMinTrackSize.X := FABS.szMinDockSize.cx;
      ptMinTrackSize.Y := FABS.szMinDockSize.cy;
      ptMaxTrackSize.X := GetSystemMetrics(SM_CXSCREEN);
      ptMaxTrackSize.Y := GetSystemMetrics(SM_CYSCREEN);
      if not IsEdgeTopOrBottom(GetEdge) then
        ptMaxTrackSize.X := FABS.szMaxDockSize.cx;
      if not IsEdgeLeftOrRight(GetEdge) then
        ptMaxTrackSize.Y := FABS.szMaxDockSize.cy;
    end;
end;


{ AppBar-specific helper functions }


// TAppBar.IsEdgeLeftOrRight //////////////////////////////////////////////////
function TAppBar.IsEdgeLeftOrRight (abEdge : TAppBarEdge) : Boolean;
begin
  Result := (abEdge in [abeLeft, abeRight]);
end;


// TAppBar.IsEdgeTopOrBottom //////////////////////////////////////////////////
function TAppBar.IsEdgeTopOrBottom (abEdge : TAppBarEdge) : Boolean;
begin
  Result := (abEdge in [abeTop, abeBottom]);
end;


// TAppBar.IsFloating /////////////////////////////////////////////////////////
function TAppBar.IsFloating (abEdge : TAppBarEdge) : Boolean;
begin
  Result := (abEdge = abeFloat);
end;


// TAppBar.IsDockable /////////////////////////////////////////////////////////
function TAppBar.IsDockable (abFlags : TAppBarFlags) : Boolean;
begin
  Result := ((abFlags * [abfAllowLeft .. abfAllowBottom]) <> []);
end;


// TAppBar.IsDockableVertically ///////////////////////////////////////////////
function TAppBar.IsDockableVertically (abFlags : TAppBarFlags) : Boolean;
begin
  Result := ((abFlags * [abfAllowLeft, abfAllowRight]) <> []);
end;


// TAppBar.IsDockableHorizontally /////////////////////////////////////////////
function TAppBar.IsDockableHorizontally (abFlags : TAppBarFlags) : Boolean;
begin
  Result := ((abFlags * [abfAllowTop, abfAllowBottom]) <> []);
end;


// TAppBar.ResetSystemKnowledge ///////////////////////////////////////////////
procedure TAppBar.ResetSystemKnowledge;
{$ifdef DEBUG}
var
  abd : TAppBarData;
begin
  abd.cbSize := sizeof(abd);
  abd.hWnd := 0;
  SHAppBarMessage(ABM_REMOVE, abd);
end;
{$else}
begin
  // nothing to do when not in debug mode
end;
{$endif}


// TAppBar.GetEdgeFromPoint ///////////////////////////////////////////////////
function TAppBar.GetEdgeFromPoint (abFlags : TAppBarFlags;
                                   pt      : TSmallPoint) : TAppBarEdge;
var
  rc             : TRect;
  cxScreen       : Integer;
  cyScreen       : Integer;
  ptCenter       : TSmallPoint;
  ptOffset       : TSmallPoint;
  bIsLeftOrRight : Boolean;
  abSubstEdge    : TAppBarEdge;
begin
  // Let's get floating out of the way first
  if abfAllowFloat in abFlags then begin

    // Get the rectangle that bounds the size of the screen
    // minus any docked (but not-autohidden) AppBars
    SystemParametersInfo(SPI_GETWORKAREA, 0, @rc, 0);

    // Leave a 1/2 width/height-of-a-scrollbar gutter around the workarea
    InflateRect(rc,
                -GetSystemMetrics(SM_CXVSCROLL),
                -GetSystemMetrics(SM_CYHSCROLL));

    // If the point is in the adjusted workarea OR no edges are allowed
    if PtInRect(rc, SmallPointToPoint(pt)) or
       not IsDockable(abFlags) then begin
      // The AppBar should float
      Result := abeFloat;
      Exit;
    end;
  end;

  // If we get here, the AppBar should be docked; determine the proper edge
  // Get the dimensions of the screen
  cxScreen := GetSystemMetrics(SM_CXSCREEN);
  cyScreen := GetSystemMetrics(SM_CYSCREEN);

  // Find the center of the screen
  ptCenter.X := cxScreen div 2;
  ptCenter.Y := cyScreen div 2;

  // Find the distance from the point to the center
  ptOffset.X := pt.X - ptCenter.X;
  ptOffset.Y := pt.Y - ptCenter.Y;

  // Determine if the point is farther from the left/right or top/bottom
  bIsLeftOrRight :=
    ((Abs(ptOffset.Y) * cxScreen) <= (Abs(ptOffset.X) * cyScreen));

  // Propose an edge
  if bIsLeftOrRight then begin
    if 0 <= ptOffset.X then
      Result := abeRight
    else
      Result := abeLeft;
  end else begin
    if 0 <= ptOffset.Y then
      Result := abeBottom
    else
      Result := abeTop;
  end;

  // Calculate an edge substitute
  if abfAllowFloat in abFlags then
    abSubstEdge := abeFloat
  else
    abSubstEdge := FABS.abEdge;

  // Check if the proposed edge is allowed. If not, return the edge substitute
  case Result of
    abeLeft  : if not (abfAllowLeft   in abFlags) then Result := abSubstEdge;
    abeTop   : if not (abfAllowTop    in abFlags) then Result := abSubstEdge;
    abeRight : if not (abfAllowRight  in abFlags) then Result := abSubstEdge;
    abeBottom: if not (abfAllowBottom in abFlags) then Result := abSubstEdge;
  end;

end;


{ Public member functions }


// TAppBar.Create /////////////////////////////////////////////////////////////
constructor TAppBar.Create (Owner : TComponent);
begin
  // Force the shell to update its list of AppBars and the workarea.
  // This is a precaution and is very useful when debugging.  If you create
  // an AppBar and then just terminate the application, the shell still
  // thinks that the AppBar exists and the user's workarea is smaller than
  // it should be.  When a new AppBar is created, calling this function
  // fixes the user's workarea.
  ResetSystemKnowledge;

  // Set default state of AppBar to float with no width & height
  FABS.cbSize            := sizeof(TAppBarSettings);
  FABS.abEdge            := abeFloat;
  FABS.abFlags           := [abfAllowLeft .. abfAllowFloat];
  FABS.bAutohide         := False;
  FABS.bAlwaysOnTop      := True;
  FABS.bSlideEffect      := True;
  FABS.nTimerInterval    := SLIDE_DEF_TIMER_INTERVAL;
  FABS.szSizeInc.cx      := AB_DEF_SIZE_INC;
  FABS.szSizeInc.cy      := AB_DEF_SIZE_INC;
  FABS.szDockSize.cx     := AB_DEF_DOCK_SIZE;
  FABS.szDockSize.cy     := AB_DEF_DOCK_SIZE;
  FABS.rcFloat.Left      := 0;
  FABS.rcFloat.Top       := 0;
  FABS.rcFloat.Right     := 0;
  FABS.rcFloat.Bottom    := 0;
  FABS.nMinWidth         := 0;
  FABS.nMinHeight        := 0;
  FABS.nMaxWidth         := GetSystemMetrics(SM_CXSCREEN);
  FABS.nMaxHeight        := GetSystemMetrics(SM_CYSCREEN);
  FABS.szMinDockSize.cx  := 0;
  FABS.szMinDockSize.cy  := 0;
  FABS.szMaxDockSize.cx  := GetSystemMetrics(SM_CXSCREEN) div 2;
  FABS.szMaxDockSize.cy  := GetSystemMetrics(SM_CYSCREEN) div 2;
  FABS.abTaskEntry       := abtFloatDependent;
  FabEdgeProposedPrev    := abeUnknown;
  FbFullScreenAppOpen    := False;
  FbAutoHideIsVisible    := False;

  // Set default location of the settings in the registry
  with FabSettingsLocation do begin
    RootKey := AB_DEF_ROOT_KEY;
    KeyName := AB_DEF_KEY_NAME;
  end;

  // Call base class
  inherited Create(Owner);
end;


// TAppBar.Destroy ////////////////////////////////////////////////////////////
destructor TAppBar.Destroy;
begin
  ResetSystemKnowledge;

  // Call base class
  inherited Destroy;
end;


// TAppBar.UpdateBar //////////////////////////////////////////////////////////
procedure TAppBar.UpdateBar;
begin
  SetEdge(GetEdge);
end;

// TAppBar.LoadSettings ///////////////////////////////////////////////////////
function TAppBar.LoadSettings : Boolean;
var
  reg : TRegistry;
  abs : TAppBarSettings;
begin
  // Set the default return value
  Result := False;
  // Create a TRegistry object
  reg := TRegistry.Create;
  // Set the RootKey
  reg.RootKey := FabSettingsLocation.nRootKey;
  // Open the KeyName
  if reg.OpenKey(FabSettingsLocation.KeyName, False) then
    // Load the FABS record from the 'default' value
    if reg.ReadBinaryData('', abs, sizeof(abs)) = sizeof(abs) then begin
      FABS := abs;
      Result := True;
    end;
  // Free the TRegistry object
  reg.Destroy
end;

// TAppBar.SaveSettings ///////////////////////////////////////////////////////
function TAppBar.SaveSettings : Boolean;
var
  reg : TRegistry;
begin
  // Set the default return value
  Result := False;
  // Create a TRegistry object
  reg := TRegistry.Create;
  // Set the RootKey
  reg.RootKey := FabSettingsLocation.nRootKey;
  // Open the KeyName, creating it if not exists
  if reg.OpenKey(FabSettingsLocation.KeyName, True) then begin
    // Save the FABS record in the 'default' value
    reg.WriteBinaryData('', FABS, sizeof(FABS));
    Result := True;
  end;
  // Free the TRegistry object
  reg.Destroy
end;

end.