dxwinxpbar.pas

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

  Header := FC_HEADER_HEIGHT + FC_ITEM_MARGIN;
  if (Y < Header) or (Y > Height - FC_ITEM_MARGIN) then
    NewIndex := -1
  else
    NewIndex := (Y - Header) div ((Height - Header) div FVisibleItems.Count);
  if NewIndex <> FHoverIndex then
  begin
    if FHoverIndex <> -1 then
      DoDrawItem(FHoverIndex, []);
    FHoverIndex := NewIndex;
    if (FHoverIndex <> -1) and (FVisibleItems[FHoverIndex].Enabled) then
    begin
      DoDrawItem(FHoverIndex, [dsHighlight]);
      if FShowLinkCursor then
        Cursor := crHandPoint;
    end else
    if FShowLinkCursor then
      Cursor := crDefault;
  end;
  inherited;
end;

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

procedure TdxCustomWinXPBar.HookParentFontChanged;
begin
  if ParentFont then
  begin
    FFontChanging := True;
    try
      FFont.Color := $00E75100;
      FFont.Name := inherited Font.Name;
      FFont.Size := 10;
      FFont.Style := inherited Font.Style;
      FHeaderFont.Color := $00E75100;
      FHeaderFont.Name := Font.Name;
      FHeaderFont.Size := 10;
      FHeaderFont.Style := [fsBold];
    finally
      FFontChanging := False;
    end;
    inherited;
  end;
end;

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

procedure TdxCustomWinXPBar.HookResized;
begin
  // perform actions only on 'width'-change
  if FGradientWidth <> Width then
  begin
    FGradientWidth := Width;

    // recreate gradient rect
    dxCreateGradientRect(Width, 28, clWhite, $00F7D7C6, 32, gsLeft, True,
      FGradient);
  end;

  // resize to maximum height
  ResizeToMaxHeight;
  inherited;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomWinXPBar.SetCollapsed
  Author:    mh
  Date:      25-Okt-2002
  Arguments: Value: Boolean
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxCustomWinXPBar.SetCollapsed(Value: Boolean);
begin
  if Value <> FCollapsed then
    FFadeThread := TdxFadeThread.Create(Self, TdxWinXPBarRollDirection(Value));
end;

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

procedure TdxCustomWinXPBar.SetFont(Value: TFont);
begin
  FFont.Assign(Value);
  InternalRedraw;
end;

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

procedure TdxCustomWinXPBar.SetHeaderFont(Value: TFont);
begin
  FHeaderFont.Assign(Value);
  InternalRedraw;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomWinXPBar.SetHotTrack
  Author:    mh
  Date:      25-Okt-2002
  Arguments: Value: Boolean
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxCustomWinXPBar.SetHotTrack(Value: Boolean);
const
  MouseEvents: TdxControlStyle = [csRedrawMouseEnter, csRedrawMouseLeave];
begin
  if Value <> FHotTrack then
  begin
    FHotTrack := Value;
    if FHotTrack then
      ExControlStyle := ExControlStyle + MouseEvents
    else
      ExControlStyle := ExControlStyle - MouseEvents;
    if not(csLoading in ComponentState) then
      InternalRedraw;
  end;
end;

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

procedure TdxCustomWinXPBar.SetHotTrackColor(Value: TColor);
begin
  if Value <> FHotTrackColor then
  begin
    FHotTrackColor := Value;
    InternalRedraw;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomWinXPBar.SetIcon
  Author:    mh
  Date:      25-Okt-2002
  Arguments: Value: TIcon
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxCustomWinXPBar.SetIcon(Value: TIcon);
begin
  if Value <> FIcon then
  begin
    FIcon.Assign(Value);
    InternalRedraw;
  end;
end;

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

procedure TdxCustomWinXPBar.SetImageList(Value: TCustomImageList);
begin
  if Value <> FImageList then
  begin
    FImageList := Value;
    InternalRedraw;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomWinXPBar.SetItemHeight
  Author:    mh
  Date:      25-Okt-2002
  Arguments: Value: Integer
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxCustomWinXPBar.SetItemHeight(Value: Integer);
begin
  if Value <> FItemHeight then
  begin
    FItemHeight := Value;
    if not FCollapsed then
      RollOffset := FItemHeight;
  end;
end;

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

procedure TdxCustomWinXPBar.SetItems(Value: TdxWinXPBarItems);
begin
  FItems.Assign(Value);
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomWinXPBar.SetRollOffset
  Author:    mh
  Date:      25-Okt-2002
  Arguments: const Value: Integer
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxCustomWinXPBar.SetRollOffset(const Value: Integer);
begin
  if Value <> FRollOffset then
  begin
    FRollOffset := Value;
    ResizeToMaxHeight;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomWinXPBar.SetShowRollButton
  Author:    mh
  Date:      25-Okt-2002
  Arguments: Value: Boolean
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxCustomWinXPBar.SetShowRollButton(Value: Boolean);
begin
  if Value <> FShowRollButton then
  begin
    FShowRollButton := Value;
    InternalRedraw;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomWinXPBar.EndUpdate
  Author:    mh
  Date:      06-Nov-2002
  Arguments: None
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxCustomWinXPBar.EndUpdate;
begin
  inherited;
  ResizeToMaxHeight;
end;

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

procedure TdxCustomWinXPBar.Click;
var
  AllowChange: Boolean;
begin
  if (FShowRollButton) and (FHitTest <> htNone) then
    Collapsed := not Collapsed;
  if (FHoverIndex <> -1) and (FVisibleItems[FHoverIndex].Enabled) then
  begin
    AllowChange := True;
    if Assigned(FOnCanChange) then
      FOnCanChange(Self, FVisibleItems[FHoverIndex], AllowChange);
    if not AllowChange then
      Exit;
    if Assigned(FOnItemClick) then
      FOnItemClick(Self, FVisibleItems[FHoverIndex]);
    if Assigned(FVisibleItems[FHoverIndex].FOnClick) then
    begin
      { set linked 'action' as sender }
      if Assigned(FVisibleItems[FHoverIndex].Action) then
        FVisibleItems[FHoverIndex].FOnClick(FVisibleItems[FHoverIndex].Action)
      else
        FVisibleItems[FHoverIndex].FOnClick(FVisibleItems[FHoverIndex]);
    end;
  end;
  inherited;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomWinXPBar.DoDrawItem
  Author:    mh
  Date:      29-Okt-2002
  Arguments: const Index: Integer
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxCustomWinXPBar.DoDrawItem(const Index: Integer; State: TdxDrawState);
var
  Bitmap: TBitmap;
  ItemCaption: string;
  ItemRect: TRect;
  HasImages: Boolean;
begin
  Bitmap := TBitmap.Create;
  with Canvas do
  try
    Bitmap.Assign(nil);
    Font.Assign(Self.Font);
    if not FVisibleItems[Index].Enabled then
      Font.Color := clGray
    else if dsHighlight in State then
    begin
      Font.Color := FHotTrackColor;
      Font.Style := Font.Style + [fsUnderline];
    end;
    ItemRect := GetItemRect(Index);
    HasImages := FVisibleItems[Index].Images <> nil;
    if HasImages then
      FVisibleItems[Index].Images.GetBitmap(FVisibleItems[Index].ImageIndex, Bitmap);
    Bitmap.Transparent := True;
    if Assigned(FOnDrawItem) then
      FOnDrawItem(Self, Canvas, ItemRect, State, FVisibleItems[Index], Bitmap)
    else begin
      if HasImages then
        Draw(ItemRect.Left, ItemRect.Top + (FItemHeight - Bitmap.Height) div 2, Bitmap);
      ItemCaption := FVisibleItems[Index].Caption;
      if ItemCaption = '' then
        ItemCaption := Format('(untitled %d)', [Index]);
      Inc(ItemRect.Left, 20);
      DrawText(Handle, PChar(ItemCaption), -1, ItemRect, DT_SINGLELINE or
        DT_VCENTER or DT_END_ELLIPSIS or DT_NOPREFIX);
    end;
  finally
    Bitmap.Free;
  end;
end;

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

procedure TdxCustomWinXPBar.Paint;
var
  Rect: TRect;
  Bitmap: TBitmap;
  Index, i: Integer;
  OwnColor: TColor;
begin
  with Canvas do
  begin
    { get client rect }
    Rect := GetClientRect;

    { fill non-client area }
    Inc(Rect.Top, 5);
    Brush.Color := FBodyColor; //$00F7DFD6;
    FillRect(Rect);

    { draw header }
    dxCreateGradientRect(Width, 28, FGradientFrom, FGradientTo, 32, gsLeft, True,
      FGradient);
    Draw(0, Rect.Top, FGradient);

    { draw frame... }
    Brush.Color := clWhite;
    FrameRect(Rect);

    { ...with cutted edges }
    OwnColor := TdxWinControl(Parent).Color;
    Pixels[0, Rect.Top] := OwnColor;
    Pixels[0, Rect.Top + 1] := OwnColor;
    Pixels[1, Rect.Top] := OwnColor;
    Pixels[1, Rect.Top + 1] := clWhite;
    Pixels[Width - 1, Rect.Top] := OwnColor;
    Pixels[Width - 2, Rect.Top] := OwnColor;
    Pixels[Width - 1, Rect.Top + 1] := OwnColor;
    Pixels[Width - 2, Rect.Top + 1] := clWhite;

    { draw Button }
    if (FShowRollButton) and (Width >= 115) then