dxwinxpbar.pas

delphi控件可以很好实现应用程序的界面设计

begin
  Result := FItems.Count;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxWinXPBarVisibleItems.Exists
  Author:    mh
  Date:      25-Okt-2002
  Arguments: Item: TdxWinXPBarItem
  Result:    Boolean
-----------------------------------------------------------------------------}

function TdxWinXPBarVisibleItems.Exists(Item: TdxWinXPBarItem): Boolean;
var
  i: Integer;
begin
  Result := False;
  for i := 0 to Count - 1 do
  if Items[i] = Item then
  begin
    Result := True;
    Break;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxWinXPBarVisibleItems.Add
  Author:    mh
  Date:      25-Okt-2002
  Arguments: Item: TdxWinXPBarItem
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxWinXPBarVisibleItems.Add(Item: TdxWinXPBarItem);
begin
  if Exists(Item) then
    Exit;
  FItems.Add(Item);
  FWinXPBar.SortVisibleItems(False);
end;

{-----------------------------------------------------------------------------
  Procedure: TdxWinXPBarVisibleItems.Delete
  Author:    mh
  Date:      25-Okt-2002
  Arguments: Item: TdxWinXPBarItem
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxWinXPBarVisibleItems.Delete(Item: TdxWinXPBarItem);
begin
  if not Exists(Item) then
    Exit;
  FItems.Delete(FItems.IndexOf(Item));
end;

{ TdxFadeThread }

{-----------------------------------------------------------------------------
  Procedure: TdxFadeThread.Create
  Author:    mh
  Date:      25-Okt-2002
  Arguments: WinXPBar: TdxCustomWinXPBar; FadeDirection: TdxWinXPBarRollDirection
  Result:    None
-----------------------------------------------------------------------------}

constructor TdxFadeThread.Create(WinXPBar: TdxCustomWinXPBar;
  RollDirection: TdxWinXPBarRollDirection);
begin
  inherited Create(False);
  FWinXPBar := WinXPBar;
  FRollDirection := RollDirection;
  FreeOnTerminate := True;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxFadeThread.Execute
  Author:    mh
  Date:      25-Okt-2002
  Arguments: None
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxFadeThread.Execute;
const
  RollSteps = 3;
var
  NewOffset: Integer;
begin
  while not Terminated do
  try
    FWinXPBar.FRolling := True;

    { calculate new roll offset }
    if FRollDirection = rdCollapse then
      NewOffset := FWinXPBar.RollOffset - RollSteps
    else
      NewOffset := FWinXPBar.RollOffset + RollSteps;

    { validate offset ranges }
    if NewOffset < 0 then
      NewOffset := 0;
    if NewOffset > FWinXPBar.FItemHeight then
      NewOffset := FWinXPBar.FItemHeight;
    FWinXPBar.RollOffset := NewOffset;

    { terminate on 'out-of-range' }
    if ((FRollDirection = rdCollapse) and (NewOffset = 0)) or
       ((FRollDirection = rdExpand) and (NewOffset = FWinXPBar.FItemHeight)) then
      Terminate;

    { idle process }
    Sleep(25);
  finally
    FWinXPBar.FRolling := False;
  end;

  { redraw button state }
  FWinXPBar.FCollapsed := FRollDirection = rdCollapse;
  if FWinXPBar.FShowRollButton then
    FWinXPBar.InternalRedraw;

  { update inspector }
  if csDesigning in FWinXPBar.ComponentState then
    TCustomForm(FWinXPBar.Owner).Designer.Modified;
end;

{ TdxCustomWinXPBar }

{-----------------------------------------------------------------------------
  Procedure: TdxCustomWinXPBar.Create
  Author:    mh
  Date:      20-Aug-2002
  Arguments: AOwner: TComponent
  Result:    None
-----------------------------------------------------------------------------}

constructor TdxCustomWinXPBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csDoubleClicks];
  ExControlStyle := [csRedrawCaptionChanged];
  Height := 46;
  HotTrack := True;  // initialize mouse events
  Width := 153;
  FBodyColor := $00F7DFD6;
  FCollapsed := False;
  FFadeThread := nil;
  FFont := TFont.Create;
  FFont.Color := $00E75100;
  FFont.Size := 10;
  FFont.OnChange := FontChanged;
  FGradient := TBitmap.Create;
  FGradientFrom := clWhite;
  FGradientTo := $00F7D7C6;
  FGradientWidth := 0;
  FHeaderFont := TFont.Create;
  FHeaderFont.Color := $00E75100;
  FHeaderFont.Size := 10;
  FHeaderFont.Style := [fsBold];
  FHeaderFont.OnChange := FontChanged;
  FHitTest := htNone;
  FHotTrackColor := $00FF7C35;
  FHoverIndex := -1;
  FIcon := TIcon.Create;
  FItemHeight := 20;
  FItems := TdxWinXPBarItems.Create(Self);
  FRolling := False;
  FRollMode := rmShrink;
  FRollOffset := FItemHeight;
  FSeperatorLine := $00F7D7C6;
  FShowLinkCursor := True;
  FShowRollButton := True;
  FVisibleItems := TdxWinXPBarVisibleItems.Create(Self);
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomWinXPBar.Destroy
  Author:    mh
  Date:      20-Aug-2002
  Arguments: None
  Result:    None
-----------------------------------------------------------------------------}

destructor TdxCustomWinXPBar.Destroy;
begin
  FFont.Free;
  FHeaderFont.Free;
  FGradient.Free;
  FIcon.Free;
  FItems.Free;
  FVisibleItems.Free;
  inherited;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomWinXPBar.Notification
  Author:    mh
  Date:      25-Okt-2002
  Arguments: AComponent: TComponent; Operation: TOperation
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxCustomWinXPBar.Notification(AComponent: TComponent;
  Operation: TOperation);
var
  i: Integer;
begin
  if not(csDestroying in ComponentState) and (Operation = opRemove) then
  begin
    if AComponent = FImageList then
      FImageList := nil;
    for i := 0 to FItems.Count - 1 do
      FItems[i].Notification(AComponent);
  end;
  inherited Notification(AComponent, Operation);
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomWinXPBar.IsFontStored
  Author:    mh
  Date:      30-Okt-2002
  Arguments: None
  Result:    Boolean
-----------------------------------------------------------------------------}

function TdxCustomWinXPBar.IsFontStored: Boolean;
begin
  Result := not ParentFont and not DesktopFont;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomWinXPBar.FontChanged
  Author:    mh
  Date:      30-Okt-2002
  Arguments: Sender: TObject
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxCustomWinXPBar.FontChanged(Sender: TObject);
begin
  if (not FFontChanging) and not(csLoading in ComponentState) then
    ParentFont := False;
  InternalRedraw;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomWinXPBar.ResizeToMaxHeight
  Author:    mh
  Date:      29-Okt-2002
  Arguments: None
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxCustomWinXPBar.ResizeToMaxHeight;
var
  NewHeight: Integer;
begin
  { TODO: Check this!!! }
  if IsLocked then
    Exit;

  NewHeight := FC_HEADER_HEIGHT + FVisibleItems.Count * FRollOffset + FC_ITEM_MARGIN + 1;

  { full collapsing }
  if (FRolling and not FCollapsed) or (not FRolling and FCollapsed) or
    (FVisibleItems.Count = 0) then Dec(NewHeight, FC_ITEM_MARGIN);

  Height := NewHeight;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomWinXPBar.GetHitTestAt
  Author:    mh
  Date:      05-Nov-2002
  Arguments: X, Y: Integer
  Result:    TdxWinXPBarHitTest
-----------------------------------------------------------------------------}

function TdxCustomWinXPBar.GetHitTestAt(X, Y: Integer): TdxWinXPBarHitTest;
begin
  Result := htNone;
  if PtInRect(GetHitTestRect(htHeader), Point(X, Y)) then
    Result := htHeader;
  if PtInRect(GetHitTestRect(htRollButton), Point(X, Y)) then
    Result := htRollButton;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomWinXPBar.GetItemRect
  Author:    mh
  Date:      25-Okt-2002
  Arguments: Index: Integer
  Result:    TRect
-----------------------------------------------------------------------------}

function TdxCustomWinXPBar.GetItemRect(Index: Integer): TRect;
begin
  Result.Left := 3;
  Result.Right := Width - 8;
  if FRollMode = rmShrink then
    Result.Top := FC_HEADER_HEIGHT + FC_ITEM_MARGIN div 2 + Index * FRollOffset + 1
  else
    Result.Top := FC_HEADER_HEIGHT + FC_ITEM_MARGIN div 2 + Index * FItemHeight + 1;
  Result.Bottom := Result.Top + FItemHeight;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomWinXPBar.GetHitTestRect
  Author:    mh
  Date:      05-Nov-2002
  Arguments: const HitTest: TdxWinXPBarHitTest
  Result:    TRect
-----------------------------------------------------------------------------}

function TdxCustomWinXPBar.GetHitTestRect(const HitTest: TdxWinXPBarHitTest): TRect;
begin
  case HitTest of
    htHeader:
      Result := Bounds(0, 5, Width, 28);
    htRollButton:
      Result := Bounds(Width - 24, 10, 18, 18);
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomWinXPBar.SortVisibleItems
  Author:    mh
  Date:      29-Okt-2002
  Arguments: const Redraw: Boolean
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxCustomWinXPBar.SortVisibleItems(const Redraw: Boolean);
begin
  if (csLoading in ComponentState) or (csDestroying in ComponentState) then
    Exit;
  FVisibleItems.FItems.Sort(@SortByIndex);
  if Redraw then
    InternalRedraw;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomWinXPBar.ItemVisibilityChanged
  Author:    mh
  Date:      25-Okt-2002
  Arguments: Item: TdxWinXPBarItem
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxCustomWinXPBar.ItemVisibilityChanged(Item: TdxWinXPBarItem);
begin
  // update visible-item list
  if Item.Visible then
    FVisibleItems.Add(Item)
  else
    FVisibleItems.Delete(Item);
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomWinXPBar.HookMouseDown
  Author:    mh
  Date:      30-Okt-2002
  Arguments: None
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxCustomWinXPBar.HookMouseDown;
var
  Rect: TRect;
begin
  inherited;  // update drawstate
  if FHitTest = htRollButton then
  begin
    Rect := GetHitTestRect(htRollButton);
    InvalidateRect(Handle, @Rect, False);
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomWinXPBar.HookMouseMove
  Author:    mh
  Date:      25-Okt-2002
  Arguments: X, Y: Integer
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxCustomWinXPBar.HookMouseMove(X, Y: Integer);
var
  Rect: TRect;
  OldHitTest: TdxWinXPBarHitTest;
  NewIndex, Header: Integer;
begin
  OldHitTest := FHitTest;
  FHitTest := GetHitTestAt(X, Y);
  if FHitTest <> OldHitTest then
  begin
    Rect := Bounds(0, 5, Width, 28);    // header
    InvalidateRect(Handle, @Rect, False);
    if FShowLinkCursor then
    begin
      if FHitTest <> htNone then
        Cursor := crHandPoint
      else
        Cursor := crDefault;
    end;
  end;