dcoutpanel.pas

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

Procedure DrawTextWithFill(Canvas:TCanvas;const Str:String;Mode:Integer;AllRect:TRect);
Var
  TextRect:TRect;
  OldMode:Integer;
Begin
  OldMode:=Mode;
  TextRect:=AllRect;
  Mode:=Mode And Not DT_BOTTOM And Not DT_CENTER And Not DT_VCENTER And Not DT_NOFILL;
  If (OldMode And DT_NOFILL)<>0 Then
    SetBkMode(Canvas.Handle,TRANSPARENT);
  If Str<>'' Then
  Begin
    DrawText(Canvas.Handle,PChar(Str),Length(Str),TextRect,Mode Or DT_CALCRECT);
    CorrectRightByRect(TextRect,AllRect);
  End
  Else
    If (OldMode And DT_NOFILL)=0 Then
      Canvas.FillRect(AllRect);
  If IsRectEmpty(TextRect) Then
  Begin
    TextRect:=AllRect;
    Exit;
  End;
  If (OldMode And DT_CENTER)<>0 Then
    HCenterRect(TextRect,AllRect);
  If (OldMode And DT_BOTTOM)<>0 Then
    VBottomRect(TextRect,AllRect);
  If (OldMode And DT_VCENTER)<>0 Then
    VCenterRect(TextRect,AllRect);
  If TextRect.Top<AllRect.Top Then
    TextRect.Top:=AllRect.Top;
  If TextRect.Bottom>AllRect.Bottom Then
    TextRect.Bottom:=AllRect.Bottom;
  If TextRect.Left<AllRect.Left Then
    TextRect.Left:=AllRect.Left;
  If TextRect.Right>AllRect.Right Then
    TextRect.Right:=AllRect.Right;
  If (OldMode And DT_NOFILL)=0 Then
    FillRectEx(Canvas,AllRect,TextRect);
  DrawText(Canvas.Handle,PChar(Str),Length(Str),TextRect,Mode);
End;

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

Procedure DrawButtonTria(Canvas:TCanvas;const CaptionRect:TRect;Var ArrowRect:TRect;Mode:Integer);
Begin
  If (Mode And DT_BOTTOM)<>0 Then
  Begin
    Dec(ArrowRect.Bottom,ItemsSpace);
    CorrectBottom(ArrowRect);
  End;
  DrawTextWithFill(Canvas,'6',Mode,ArrowRect);
  If (Mode And DT_NOFILL)=0 Then
    FillRectEx(Canvas,Rect(ArrowRect.Left,CaptionRect.Top,ArrowRect.Right,CaptionRect.Bottom),
               ArrowRect);
End;

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

Procedure CorrectRectByRect(Var InRect:TRect;const OutRect:TRect);
Begin
  CorrectLeftByRect(InRect,OutRect);
  CorrectTopByRect(InRect,OutRect);
  CorrectRightByRect(InRect,OutRect);
  CorrectBottomByRect(InRect,OutRect);
End;

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

Function AlignRectByRect(const ARectIn,ARectOut:TRect;
                          HorzAlignment:THorzAlignment;
                          VertAlignment:TVertAlignment;
                          AMinHSpace,AMinVSpace:Integer):TRect;
Var
  Size:Integer;
  MaxPoint:Integer;
Begin
  Result:=ARectOut;
  Size:=ARectIn.Right-ARectIn.Left;
  Case HorzAlignment Of
    haLeft:
      With Result Do
      Begin
        Result.Right:=ARectOut.Left+Size;
        MaxPoint:=ARectOut.Right-AMinVSpace;
        If Right>MaxPoint Then
          Right:=MaxPoint;
      End;
    haCenter:
      With Result Do
      Begin
        Left:=(ARectOut.Right+ARectout.Left-Size) Div 2;
        Right:=Left+Size;
      End;
    haRight:
      With Result Do
      Begin
        Left:=ARectOut.Right-Size;
        MaxPoint:=ARectOut.Left+AMinHSpace;
        If Left<MaxPoint Then
          Left:=MaxPoint;
      End;
  End;
  Size:=ARectIn.Bottom-ARectIn.Top;
  Case VertAlignment Of
    vaLeft:
      With Result Do
      Begin
        Result.Bottom:=ARectOut.Top+Size;
        MaxPoint:=ARectOut.Bottom-AMinVSpace;
        If Bottom>MaxPoint Then
          Bottom:=MaxPoint;
      End;
    vaCenter:
      With Result Do
      Begin
        Top:=(ARectOut.Bottom+ARectout.Top-Size) Div 2;
        Bottom:=Top+Size;
      End;
    vaRight:
      With Result Do
      Begin
        Top:=ARectOut.Bottom-Size;
        MaxPoint:=ARectOut.Top+AMinHSpace;
        If Top<MaxPoint Then
          Top:=MaxPoint;
      End;
  End;
  CorrectRectByRect(Result,ARectOut);
End;

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

Procedure BitBltTransparent(DestDC:THandle;DestLeft,DestTop,Width,Height:Integer;
                           SourceDC:THandle;SourceLeft,SourceTop:Integer;TransColor:TColor);
Var
  ScreenDC:THandle;
  hMaskBitmap:THandle;
  MaskDC:THandle;
  OldBkColor:TColorRef;
  OldTextColor:TColorRef;
  OldObject:THandle;
Begin
  ScreenDC:=GetDC(0);
  MaskDC:=CreateCompatibleDC(ScreenDC);
  ReleaseDC(0,ScreenDC);

  hMaskBitmap:=CreateCompatibleBitmap(MaskDC,Width,Height);
  OldObject:=SelectObject(MaskDC,hMaskBitmap);
  OldBkColor:=SetBkColor(SourceDC,ColorToRgb(TransColor));
  BitBlt(MaskDC,0,0,Width,Height,SourceDC,SourceLeft,SourceTop,SRCCOPY);
  SetBkColor(SourceDC,OldBkColor);

  OldBkColor:=SetBkColor(DestDC,Rgb(255,255,255));
  OldTextColor:=SetTextColor(DestDC,0);
  BitBlt(DestDC,DestLeft,DestTop,Width,Height,SourceDC,SourceLeft,SourceTop,SRCINVERT);
  BitBlt(DestDC,DestLeft,DestTop,Width,Height,MaskDC,0,0,SRCAND);
  BitBlt(DestDC,DestLeft,DestTop,Width,Height,SourceDC,SourceLeft,SourceTop,SRCINVERT);
  SetBkColor(DestDC,OldBkColor);
  SetTextColor(DestDC,OldTextColor);
  SelectObject(MaskDC,OldObject);
  DeleteObject(hMaskBitmap);
  DeleteDC(MaskDC);
End;

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

Procedure DrawImage(Canvas:TCanvas;Image:TPersistent;Color:TColor;
                    const ARect:TRect;ImageIndex:Integer;IsFill:Boolean);
Var
  DrawRect:TRect;                    
Begin
  If Not ((Image Is TImageList) Or (Image Is TBitmap)) Then
    Exit;
  If IsFill Then
  Begin
    Canvas.Brush.Color:=Color;
    Canvas.FillRect(ARect);
  End;  
  If Image Is TImageList Then
  Begin
    DrawRect.Left:=(ARect.Left+ARect.Right-TImageList(Image).Width) Div 2;
    DrawRect.Top:=(ARect.Top+ARect.Bottom-TImageList(Image).Height) Div 2;
    DrawRect.Right:=ARect.Left+TImageList(Image).Width;
    DrawRect.Bottom:=ARect.Top+TImageList(Image).Height;
    CorrectRectByRect(DrawRect,ARect);
    ImageList_DrawEx(TImageList(Image).Handle,ImageIndex,Canvas.Handle,DrawRect.Left,DrawRect.Top,
                     DrawRect.Right-DrawRect.Left,DrawRect.Bottom-DrawRect.Top,CLR_NONE,CLR_NONE,ILD_NORMAL)
  End
  Else
  Begin
    DrawRect.Left:=(ARect.Left+ARect.Right-TBitmap(Image).Width) Div 2;
    DrawRect.Top:=(ARect.Top+ARect.Top-TBitmap(Image).Height) Div 2;
    DrawRect.Right:=ARect.Left+TBitmap(Image).Width;
    DrawRect.Bottom:=ARect.Top+TBitmap(Image).Height;
    CorrectRectByRect(DrawRect,ARect);
    If Not TBitmap(Image).Empty Then
      BitBltTransparent(Canvas.Handle,DrawRect.Left,DrawRect.Top,TBitmap(Image).Width,TBitmap(Image).Height,
                       TBitmap(Image).Canvas.Handle,0,0,TBitmap(Image).Canvas.Pixels[0,0]);
  End;                     
End;

Procedure Frame3DSides(Canvas:TCanvas;Var Rect:TRect;TopColor,BottomColor:TColor;
                       BorderSides:TBorderSides;Width:Integer);

  procedure DoRect;
  Var
    TopRight,BottomLeft:TPoint;
  begin
    with Canvas, Rect do
    begin
      TopRight.X := Right;
      TopRight.Y := Top;
      BottomLeft.X := Left;
      BottomLeft.Y := Bottom;
      Pen.Color := TopColor;
      If bdLeft In BorderSides Then
      Begin
        With BottomLeft Do
          MoveTo(X,Y);
        With TopLeft Do
          LineTo(X,Y-1);
      End;
      If bdTop In BorderSides Then
      Begin
        With TopLeft Do
          MoveTo(X,Y);
        With TopRight Do
          LineTo(X,Y);
      End;
      Pen.Color := BottomColor;
      Dec(BottomLeft.X);
      If bdRight In BorderSides Then
      Begin
        With TopRight Do
          MoveTo(X,Y);
        With BottomRight Do
          LineTo(X,Y);
      End;    
      If bdBottom In BorderSides Then
      Begin
        With BottomRight Do
          MoveTo(X,Y);
        With BottomLeft Do
          LineTo(X,Y);
      End;    
    end;
  end;

begin
  Canvas.Pen.Width := 1;
  If bdBottom In BorderSides Then
    Dec(Rect.Bottom);
  If bdRight In BorderSides Then
    Dec(Rect.Right);
  while Width > 0 do
  begin
    Dec(Width);
    DoRect;
    If bdLeft In BorderSides Then
      Inc(Rect.Left);
    If bdTop In BorderSides Then
      Inc(Rect.Top);
    If bdRight In BorderSides Then
      Dec(Rect.Right);
    If bdBottom In BorderSides Then
      Dec(Rect.Bottom);
  end;
  If bdBottom In BorderSides Then
    Inc(Rect.Bottom);
  If bdRight In BorderSides Then
    Inc(Rect.Right);
end;

Type
  TPublicWinControl=Class(TWinControl);

{ TDCHotButton }

Constructor TDCCustomHotButton.Create(AOwner:TComponent);
Begin
  Inherited;
  ControlStyle:=ControlStyle+[csOpaque];
  Width:=17;
  Height:=17;
  Color:=clBtnFace;
  FButtonDownGlyph:=TBitmap.Create;
  FButtonDownGlyph.OnChange:=OnGlyphsChange;
  FButtonUpGlyph:=TBitmap.Create;
  FButtonUpGlyph.OnChange:=OnGlyphsChange;

  FPinDown:=TBitmap.Create;
  FPinDown.LoadFromResourceName(hInstance,'HOTBUTTONPINDOWN');
  FPinUp:=TBitmap.Create;
  FPinUp.LoadFromResourceName(hInstance,'HOTBUTTONPINUP');
  FCloseButton:=TBitmap.Create;
  FCloseButton.LoadFromResourceName(hInstance,'CLOSEBUTTON');
End;

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

Destructor TDCCustomHotButton.Destroy;
Begin
  FCloseButton.Free;
  FPinUp.Free;
  FPinDown.Free;
  FButtonDownGlyph.Free;
  FButtonUpGlyph.Free;
  Inherited;
End;

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

Procedure TDCCustomHotButton.CMMouseLeave(var Message: TMessage);
Begin
  Inherited;
  If FSelected Then
  Begin
    If FMouseDown Then
      FDowned:=False
    Else
      FSelected:=False;
    Invalidate;
  End;
End;

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

Procedure TDCCustomHotButton.DoButtonClick;
Begin
  If Assigned(FOnButtonClick) Then
    FOnButtonClick(Self);
  If Assigned(FInternalButtonClick) Then
    FInternalButtonClick(Self);
End;

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

Procedure TDCCustomHotButton.MouseDown(Button : TMouseButton ; Shift : TShiftState ; X , Y : Integer);
Begin
  Inherited;
  If csDesigning In ComponentState Then
    Exit;
  If Button<>mbLeft Then
    Exit;
  If FSelected Then
  Begin
    FDowned:=True;
    Invalidate;
  End;
  FMouseDown:=True;
End;

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

Procedure TDCCustomHotButton.MouseMove(Shift:TShiftState;X,Y:Integer);
Begin
  Inherited;
  If csDesigning In ComponentState Then
    Exit;
  UpdateButton;
End;

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

Procedure TDCCustomHotButton.MouseUp(Button : TMouseButton ; Shift : TShiftState ; X , Y : Integer);
Begin
  Inherited;
  If csDesigning In ComponentState Then
    Exit;
  If Button<>mbLeft Then
    Exit;
  FMouseDown:=False;
  UpdateButton;
  If FSelected Then
    DoButtonClick;
  FDowned:=False;
  Invalidate;
End;

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

Procedure TDCCustomHotButton.OnGlyphsChange(Sender:TObject);
Begin
  Invalidate;
End;

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

Procedure TDCCustomHotButton.Paint;
Var
  ButtonSize:TSize;
  ButtonRect:TRect;
Begin
  Canvas.Brush.Color:=Color;
  ButtonSize:=GetCloseButtonSize(Canvas);
  ButtonRect:=ClientRect;
  ButtonRect.Left:=ButtonRect.Right-ButtonSize.cX;
  Inc(ButtonRect.Top,1);
  If ButtonRect.Left<0 Then
    ButtonRect.Left:=0;
  ButtonRect:=AlignRectByRect(CloseButtonRect,
                              ClientRect,haCenter,vaCenter,0,0);
  InflateRect(ButtonRect,-1,-1);
  Case ButtonType Of
    btStandard:DrawImage(Canvas,FCloseButton,Color,ButtonRect,0,True);
    btPin,btCustom:
      Begin
        If FDowned And FSelected Then
          If ButtonType=btPin Then
            DrawImage(Canvas,FPinDown,Color,ButtonRect,0,True)
          Else
            If FButtonDownGlyph.Empty Then
              DrawImage(Canvas,FButtonUpGlyph,Color,ButtonRect,0,True)
            Else
              DrawImage(Canvas,FButtonDownGlyph,Color,ButtonRect,0,True)