dcoutpanel.pas

XP风格的outbar.rar.有DELPHI,C++BULIDER的例子及源码

        Else
          If ButtonType=btPin Then
            DrawImage(Canvas,FPinUp,Color,ButtonRect,0,True)
          Else
            DrawImage(Canvas,FButtonUpGlyph,Color,ButtonRect,0,True);
      End;
  End;
  FillRectEx(Canvas,ClientRect,ButtonRect);
  If FSelected Then
    DrawButton(Canvas,ClientRect,clBtnShadow,FDowned);
End;

{---------------------------------------------------------}

Procedure TDCCustomHotButton.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
Begin
  Inherited;
//  UpdateButton;
End;

{---------------------------------------------------------}

Procedure TDCCustomHotButton.SetButtonDownGlyph(Value:TBitmap);
Begin
  FButtonDownGlyph.Assign(Value);
End;

{---------------------------------------------------------}

Procedure TDCCustomHotButton.SetButtonType(Value:TButtonType);
Begin
  If FButtonType=Value Then
    Exit;
  FButtonType:=Value;
  Invalidate;
End;

{---------------------------------------------------------}

Procedure TDCCustomHotButton.SetButtonUpGlyph(Value:TBitmap);
Begin
  FButtonUpGlyph.Assign(Value);
End;

{---------------------------------------------------------}

Procedure TDCCustomHotButton.UpdateButton;
Var
  Pt:TPoint;
Begin
  If Parent=Nil Then
    Exit;
  If csDesigning In ComponentState Then
    Exit;  
  GetCursorPos(Pt);
  Pt:=ScreenToClient(Pt);
  If PtInRect(ClientRect,Pt) Then
  Begin
    If FMouseDown And Not FDowned Then
    Begin
      FDowned:=True;
      Invalidate;
    End;
    If FSelected Then
      Exit;
    FSelected:=True;
    Invalidate;
    Exit;
  End
  Else
    If FSelected And Not FMouseDown Then
    Begin
      FSelected:=False;
      Invalidate;
    End;
End;

{ TDCCustomHeaderButton }

Constructor TDCCustomHeaderButton.Create(AOwner: TComponent);
Begin
  Inherited;
  ControlStyle:=ControlStyle+[csOpaque,csSetCaption];
  // Main properties
  Width:=100;
  Height:=30;
  Color:=clBtnFace;
  //Font
  Font.OnChange:=OnFontChange;

  // Bitmap
  FBitmap:=TBitmap.Create;
  FBitmap.OnChange:=OnImagesChange;
  FImageAlignment:=iaRight;
  FArrowFontSize:=6;
  FSelectBorderColor:=clBtnShadow;
End;

{---------------------------------------------------------}

Destructor TDCCustomHeaderButton.Destroy;
Begin
  Destroying;
  ImageList:=Nil;
  FBitmap.Free;
  GetMouseManager.RemoveHandler(Self);
  Inherited;
End;

{---------------------------------------------------------}

Procedure TDCCustomHeaderButton.Click;
Begin
  Inherited;
  _TControl(Parent).Click;
End;

{---------------------------------------------------------}

Procedure TDCCustomHeaderButton.CMMouseLeave(Var Message:TMessage);
Begin
  If Not FIsDown Then
    UpdateSelection;
  If FSelected Then
  Begin
    FSelected:=False;
    UpdateSelection; 
  End;
  Inherited;
End;

{---------------------------------------------------------}

Procedure TDCCustomHeaderButton.CMTextChanged(Var Message:TMessage);
Begin
  Inherited;
  DoChanged;
End;

{---------------------------------------------------------}

Procedure TDCCustomHeaderButton.DblClick;
Begin
  Inherited;
  _TControl(Parent).DblClick;
End;

{---------------------------------------------------------}

Procedure TDCCustomHeaderButton.DoButtonClick;
Var
  Pt:TPoint;
Begin
  If (FDropDownMenu<>Nil) And (ButtonDown Or (ArrowButtonDown And FSeparateArrow))Then
  Begin
    If (ButtonDown And Not ArrowButtonDown And FSeparateArrow) Or (csDesigning In ComponentState) Then
      Exit;
    Pt:=Point(0,Height);
    Pt:=ClientToScreen(Pt);
    FIsMenuShowing:=True;
    FDropDownMenu.Popup(Pt.X,Pt.Y);
    FIsMenuShowing:=False;
    Application.ProcessMessages;
    FIsDown:=False;
    Invalidate;
    ArrowButtonDown:=False;
  End;
  If Assigned(FOnButtonClick) Then
    FOnButtonClick(Self);
End;

{---------------------------------------------------------}

Function TDCCustomHeaderButton.GetCalcWidth:Integer;
Var
  ButtonImageWidth:Integer;
  tm:TTextMetric;
Begin
  Result:=ItemsSpace;//left space;
  If Not ((FImageAlignment=iaLeft) And FButtonInCaption) Then
    Inc(Result,ItemsSpace);//right space;
  ButtonImageWidth:=GetButtonImageSize.cX;
  Inc(Result,ButtonImageWidth);
  If ButtonImageWidth<>0 Then
    Inc(Result,ItemsSpace);
  Canvas.Font:=Font;
  Inc(Result,Canvas.TextWidth(Caption));
  GetTextMetrics(Canvas.Handle,tm);
  Inc(Result,tm.tmOverhang);
  If FButtonInCaption Then
    Inc(Result,FArrowSize.cX+ItemsSpace*2);
End;

{---------------------------------------------------------}

Procedure TDCCustomHeaderButton.PaintButton;
  Function IsDrawBackground:Boolean;
  Begin
    Result:=Not ((Owner Is TDCCustomOutHeader) And (TDCCustomOutHeader(Owner).FBackgroundMode In [bkmGradientHorz,bkmGradientVert]));
  End;

  Procedure DrawImage(Var HeaderRect:TRect);
  Var
    ImageRect:TRect;
    ImageSize:TSize;
    Align:THorzAlignment;
    TotalImageRect:TRect;
  Begin
    ImageSize:=GetButtonImageSize;
    If FImageAlignment=iaRight Then
      Align:=haRight
    Else Begin
      Align:=haLeft;
    End;
    TotalImageRect:=HeaderRect;
    If FSelectType=stShrink Then
    Begin
      Inc(TotalImageRect.Top);
      CorrectTop(TotalImageRect);
      Dec(TotalImageRect.Bottom);
      CorrectBottom(TotalImageRect);
    End;
    ImageRect:=AlignRectByRect(Rect(0,0,ImageSize.cX,ImageSize.cY),TotalImageRect,Align,vaCenter,
                               0,0);
    If Not IsRectEmpty(ImageRect) Then
    Begin
      DrawButtonImage(ImageRect,IsDrawBackground);
      If IsDrawBackGround Then
        FillRectEx(Canvas,Rect(ImageRect.Left,HeaderRect.Top,ImageRect.Right,HeaderRect.Bottom),
                   ImageRect);
      If FImageAlignment=iaRight Then
      Begin
        HeaderRect.Right:=ImageRect.Left;
        CorrectRight(HeaderRect);
      End
      Else
      Begin
        HeaderRect.Left:=ImageRect.Right;
        CorrectLeft(HeaderRect);
      End;
      DrawSpace(Canvas,HeaderRect,ItemsSpace,0,FImageAlignment=iaRight,IsDrawBackground);
    End;
  End;

  Procedure DrawCaption(Var CaptionRect:TRect);
  Var
    TextRect:TRect;
    Alignment:DWord;
    ArrowWidth:Integer;
    FCaptionRect:TRect;
    Mode:DWord;
  Begin
    Canvas.Font:=Font;
    TextRect:=AlignTextByLeft(Canvas,CaptionRect,Caption);
    If FSeparateArrow Then
      Inc(TextRect.Right,ItemsSpace);

    If FButtonInCaption Then
    Begin
      Inc(TextRect.Right,FArrowSize.cX+ButtonArrowSpace*2);
      If FSeparateArrow Then
        Inc(TextRect.Right,TextButtonSpace);
      CorrectRightByRect(TextRect,CaptionRect);

      FCaptionRect:=TextRect;//save for use in mousemove
      FCaptionRect.Left:=GetClientRect.Left+1;
//      Inc(FCaptionRect.Top);
      If FSelectType=stShrink Then
      Begin
        Inc(FCaptionRect.Top);
        CorrectTop(FCaptionRect);
        Dec(FCaptionRect.Bottom);
        CorrectBottom(FCaptionRect);
      End;
      FTotalRect:=FCaptionRect;
      ArrowWidth:=FArrowSize.cX+ButtonArrowSpace*2;
      If FSeparateArrow Then
        Inc(ArrowWidth,TextButtonSpace);
      Dec(FCaptionRect.Right,ArrowWidth);
      FArrowRect:=FCaptionRect;
      FArrowRect.Left:=FCaptionRect.Right;
      FArrowRect.Right:=FArrowRect.Left+ArrowWidth;

      DrawSpace(Canvas,CaptionRect,CaptionRect.Right-TextRect.Right,0,True,IsDrawBackground);
      Canvas.Font:=MarlettFont;
      Canvas.Font.Color:=Font.Color;
      Canvas.Font.Size:=FArrowFontSize;
      Alignment:=DT_CENTER Or DT_SINGLELINE;
      If FArrowAlignment=aaCenter Then
        Alignment:=Alignment Or DT_VCENTER
      Else
        Alignment:=Alignment Or DT_BOTTOM;
      Inc(TextRect.Top,2);
      If IsDrawBackground Then
        DrawButtonTria(Canvas,CaptionRect,FArrowRect,Alignment)
      Else
        DrawButtonTria(Canvas,CaptionRect,FArrowRect,Alignment Or DT_NOFILL);
      CaptionRect.Right:=FArrowRect.Left;
    End;
    Canvas.Font:=Font;
    Mode:=DT_VCENTER Or DT_END_ELLIPSIS Or DT_SINGLELINE;
    If Not IsDrawBackground Then
      Mode:=Mode Or DT_NOFILL;
    DrawTextWithFill(Canvas,Caption,Mode,CaptionRect);
  End;

Var
  HeaderRect:TRect;
Begin
  HeaderRect:=GetClientRect;
  If Owner Is TDCCustomOutHeader Then
    Canvas.Handle:=TDCCustomOutHeader(Owner).Canvas.Handle;
  If IsDrawBackground Then
  Begin
    Canvas.Brush.Color:=Color;
    FillRectEx(Canvas,GetClientRect,HeaderRect);
  End;

  Canvas.Brush.Color:=Color;

  DrawSpace(Canvas,HeaderRect,ItemsSpace,0,False,IsDrawBackground);//left space
  If Not ((FImageAlignment=iaLeft) And FButtonInCaption) Then
    DrawSpace(Canvas,HeaderRect,ItemsSpace,0,True,IsDrawBackground);//right space
  DrawImage(HeaderRect);

  DrawCaption(HeaderRect);
  PaintSelection;
End;

{---------------------------------------------------------}

Procedure TDCCustomHeaderButton.DrawButtonImage(const ARect:TRect;IsFill:Boolean);
Begin
  If FImageList<>Nil Then
    DrawImage(Canvas,FImageList,Color,ARect,FImageIndex,IsFill)
  Else
    DrawImage(Canvas,FBitmap,Color,ARect,0,IsFill);
End;

{---------------------------------------------------------}

Function TDCCustomHeaderButton.GetButtonImageSize:TSize;
Begin
  Result.cX:=0;
  Result.cY:=0;
  If FImageList<>Nil Then
  Begin
    Result.cX:=FImageList.Width;
    Result.cY:=FImageList.Height;
  End
  Else
    If Not FBitmap.Empty Then
    Begin
      Result.cX:=FBitmap.Width;
      Result.cY:=FBitmap.Height;
    End;
End;

{---------------------------------------------------------}

Function TDCCustomHeaderButton.IsOnArrowButton(X,Y:Integer):Boolean;
Begin
  Result:=PtInRect(FArrowRect,Point(X,Y)) And FSeparateArrow;
End;

{---------------------------------------------------------}

Procedure TDCCustomHeaderButton.Loaded;
Begin
  Inherited;
  If FIsDown And FButtonInCaption Then
    DoButtonClick;
End;

{---------------------------------------------------------}

Procedure TDCCustomHeaderButton.MouseDown(Button:TMouseButton;Shift:TShiftState;X,Y:Integer);
Var
  LeftRect:TRect;
  Pt:TPoint;
Begin
  If csDesigning In ComponentState Then
    Exit;
  If FSeparateArrow Then
    SubtractRect(LeftRect,FTotalRect,FArrowRect)
  Else
    LeftRect:=FTotalRect;
  If FButtonInCaption And PtInRect(LeftRect,Point(X,Y)) And (Button=mbLeft) Then
  Begin
    ArrowButtonDown:=False;
    If FIsMenuShowing Then
      ButtonDown:=False
    Else
      ButtonDown:=Not ButtonDown;
  End;
  If FButtonInCaption And IsOnArrowButton(X,Y) And (Button=mbLeft) Then
    ArrowButtonDown:=Not ArrowButtonDown;
  Pt:=ClientToScreen(Point(X,Y));
  Pt:=Parent.ScreenToClient(Pt);
  _TControl(Parent).MouseDown(Button,Shift,Pt.X,Pt.Y);
  Inherited;
End;

{---------------------------------------------------------}

Procedure TDCCustomHeaderButton.MouseMove(Shift: TShiftState; X, Y: Integer);
Var
  Pt:TPoint;
Begin
  If csDesigning In ComponentState Then
    Exit;
  If FButtonInCaption And (PtInRect(FTotalRect,Point(X,Y)) Or