dcoutpanel.pas

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

    property OnStartDrag;

    {$IFDEF D4}
    property Anchors;
    property AutoSize;
    property BiDiMode;
    property Constraints;
    property DockSite;
    property DragKind;
    property OnCanResize;
    property OnConstrainedResize;
    property OnDockDrop;
    property OnDockOver;
    property OnEndDock;
    property OnGetSiteInfo;
    property OnStartDock;
    property OnUnDock;
    property ParentBiDiMode;
    property UseDockManager default True;
    {$ENDIF}
  End;

  TMouseManager=Class(TObject)
  Private
    FHandlers:TList;
    Procedure CallHandlers(Msg:Cardinal);
  Public
    Constructor Create;
    Destructor Destroy;override;

    Procedure AddHandler(Obj:TObject);
    Function MainWndProc(Var Message:TMessage):Boolean;
    Procedure RemoveHandler(Obj:TObject);
  End;

  Function GetMouseManager:TMouseManager;
  Procedure FreeMouseManager;

implementation

{$R *.RES}
{$R DcOutPanel.Dcr}

Const
  ItemsSpace=4;
  ButtonArrowSpace=2;
  MinLeftSpace=100;
  ButtonWidth=13;
  ButtonHeight=13;
  TextButtonSpace=2;
  MagicString='SplitHead';
  PropAcceptControls='AcceptControls';
  PropInsertFromDesigner='InsertFromDesigner';

  DT_NOFILL=$80000000;
Var
  FMarlettFont:TFont;
  CloseButtonRect:TRect;
  TotalCloseButtonSize:TSize;

Type
  THorzAlignment=(haNone,haLeft,haCenter,haRight);
  TVertAlignment=(vaNone,vaLeft,vaCenter,vaRight);

  TButtonMode=(bmAllUp,bmAllDown,bmRightDown);
  _TControl=Class(TControl);

  Var
    FMouseManager:TMouseManager;
    FMouseHook:THandle;

Function GetMouseManager:TMouseManager;
Begin
  If FMouseManager=Nil Then
    FMouseManager:=TMouseManager.Create;
  Result:=FMouseManager;
End;

Procedure FreeMouseManager;
Begin
  If FMouseManager<>Nil Then
    FMouseManager.Free;
  FMouseManager:=Nil;
End;

Function MouseProc(Code:Integer;WParam,lParam:Integer):Integer;stdcall;
Begin
  If (wParam=WM_LBUTTONDOWN) Or (wParam=WM_RBUTTONDOWN) Or
     (wParam=WM_NCLBUTTONDOWN) Or (wParam=WM_NCRBUTTONDOWN) Then
    FMouseManager.CallHandlers(WM_MOUSEDOWN);
  Result:=CallNextHookEx(FMouseHook,Code,wParam,lParam);
End;

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

Constructor TMouseManager.Create;
Begin
  Inherited;
  FHandlers:=TList.Create;
  FMouseHook:=SetWindowsHookEx(WH_MOUSE,@MouseProc,0,GetCurrentThreadId);
  Application.HookMainWindow(MainWndProc);
End;

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

Destructor TMouseManager.Destroy;
Begin
  Application.UnHookMainWindow(MainWndProc);
  UnhookWindowsHookEx(FMouseHook);
  FHandlers.Free;
  Inherited;
End;

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

Procedure TMouseManager.AddHandler(Obj:TObject);
Begin
  If FHandlers.IndexOf(Obj)<0 Then
    FHandlers.Add(Obj);
End;

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

Procedure TMouseManager.CallHandlers(Msg:Cardinal);
Var
  I:Integer;
  Message:TMessage;
Begin
  For I:=FHandlers.Count-1 Downto 0 Do
  Begin
    Message.Msg:=Msg;
    TObject(FHandlers[I]).Dispatch(Message);
  End;
End;

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

Function TMouseManager.MainWndProc(Var Message:TMessage):Boolean;
Begin
  If (Message.Msg=WM_ACTIVATEAPP) And Not Boolean(Message.wParam) Then
    CallHandlers(WM_APPLOSTFOCUS);
  Result:=False;
End;

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

Procedure TMouseManager.RemoveHandler(Obj:TObject);
Begin
  FHandlers.Remove(Obj);
End;

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

Function MarlettFont:TFont;
Begin
  If FMarlettFont=Nil Then
  Begin
    FMarlettFont:=TFont.Create;
    FMarlettFont.Name:='Marlett';
    FMarlettFont.Size:=6;
  End;
  Result:=FMarlettFont;
End;

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

Procedure CorrectLeft(Var ARect:TRect);
Begin
  With ARect Do
  If Left>Right Then
    Left:=Right;
End;

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

Procedure CorrectTop(Var ARect:TRect);
Begin
  With ARect Do
  If Top>Bottom Then
    Top:=Bottom;
End;

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

Procedure CorrectRight(Var ARect:TRect);
Begin
  With ARect Do
  If Right<Left Then
    Right:=Left;
End;

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

Procedure CorrectBottom(Var ARect:TRect);
Begin
  With ARect Do
  If Bottom<Top Then
    Bottom:=Top;
End;

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

Function GetMCharSize(Canvas:TCanvas;Char:Char;Size:Integer):TSize;
Begin
  With Canvas Do
  Begin
    Font:=MarlettFont;
    Font.Height:=GetSystemMetrics(SM_CYSMSIZE)-6;
    Font.Style:=[];
    Font.Size:=Size;
    GetTextExtentPoint32(Handle,'r',1,Result);
  End;  
End;

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

Function GetCloseButtonSize(Canvas:TCanvas):TSize;
Begin
  With Canvas Do
  Begin
    Font:=MarlettFont;
    Font.Height:=GetSystemMetrics(SM_CYSMSIZE)-6;
    Font.Style:=[];
    GetTextExtentPoint32(Handle,'r',1,Result);
    Inc(Result.cX,7);
    Inc(Result.cY,6);
  End;
End;

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

Procedure VBottomRect(Var Source:TRect;const Dest:TRect);
Var
  TextHeight:Integer;
Begin
  TextHeight:=Source.Bottom-Source.Top;
  Source.Bottom:=Dest.Bottom;
  Source.Top:=Dest.Bottom-TextHeight;
End;

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

Procedure VCenterRect(Var Source:TRect;const Dest:TRect);
Var
  TextHeight:Integer;
Begin
  TextHeight:=Source.Bottom-Source.Top;
  Source.Top:=(Dest.Bottom+Dest.Top-TextHeight) Div 2;
  Source.Bottom:=Source.Top+TextHeight;
End;

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

Procedure FillRectEx(Canvas:TCanvas;const ARect,ExcludeRect:TRect);//LLTTRR
Begin                                                              //LLEERR
  With Canvas Do                                                   //LLEERR
  Begin                                                            //LLBBRR
    FillRect(Rect(ARect.Left,ARect.Top,ExcludeRect.Left,ARect.Bottom));//left rect
    FillRect(Rect(ExcludeRect.Right,ARect.Top,ARect.Right,ARect.Bottom));//right rect
    FillRect(Rect(ExcludeRect.Left,ARect.Top,ExcludeRect.Right,ExcludeRect.Top));//top rect
    FillRect(Rect(ExcludeRect.Left,ExcludeRect.Bottom,ExcludeRect.Right,ARect.Bottom));//bottom rect
  End;
End;

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

Procedure DrawSelection(Canvas:TCanvas;Rect:TRect;Color1,Color2:TColor);
Begin
  With Canvas Do
  Begin
    MoveTo(Rect.Left,Rect.Bottom-1);
    Pen.Color:=Color1;
    LineTo(Rect.Left,Rect.Top);
    LineTo(Rect.Right-1,Rect.Top);
    Pen.Color:=Color2;
    LineTo(Rect.Right-1,Rect.Bottom-1);
    LineTo(Rect.Left-1,Rect.Bottom-1);{ TDCCustomHeaderPanel }
  End;
End;

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

Procedure DrawButton(Canvas:TCanvas;Rect:TRect;Color:TColor;IsDown:Boolean);
Begin
  If IsDown Then
    DrawSelection(Canvas,Rect,Color,clWhite)
  Else
    DrawSelection(Canvas,Rect,clWhite,Color)
End;

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

Procedure DrawArrowButton(Canvas:TCanvas;ARect:TRect;Color:TColor;ButtonMode:TButtonMode);
  Var
    LeftPoint:Integer;
  Procedure DrawDelimiter(Color1,Color2:TColor);
  Begin
    Canvas.Pen.Color:=Color1;
    Canvas.MoveTo(LeftPoint,ARect.Top);
    Canvas.LineTo(LeftPoint,ARect.Bottom);
    Canvas.Pen.Color:=Color2;
    Canvas.MoveTo(LeftPoint+1,ARect.Top+1);
    Canvas.LineTo(LeftPoint+1,ARect.Bottom-1);
  End;

Begin
  LeftPoint:=ARect.Right-GetMCharSize(Canvas,'6',8).cX-ButtonArrowSpace*2-TextButtonSpace;
  Case ButtonMode Of
    bmAllUp:
      Begin
        DrawSelection(Canvas,ARect,clWhite,Color);
        DrawDelimiter(Color,clWhite);
      End;
    bmAllDown:
      Begin
        DrawSelection(Canvas,ARect,Color,clWhite);
        DrawDelimiter(clWhite,Color);
      End;
    bmRightDown:
      Begin
        DrawSelection(Canvas,Rect(ARect.Left,ARect.Top,LeftPoint+1,ARect.Bottom),clWhite,Color);
        DrawSelection(Canvas,Rect(LeftPoint+1,ARect.Top,ARect.Right,ARect.Bottom),Color,clWhite)
      End;
  End;
End;

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

Function AlignTextByLeft(Canvas:TCanvas;const ARect:TRect;const AText:String):TRect;
Begin
  Result:=ARect;
  If AText<>'' Then
  Begin
    DrawText(Canvas.Handle,PChar(AText),Length(AText),Result,
             DT_END_ELLIPSIS Or DT_SINGLELINE Or DT_CALCRECT);
    CorrectRight(Result);
  End
  Else
    Result.Right:=ARect.Left;
  If Result.Right>ARect.Right Then
    Result.Right:=ARect.Right;
  Result.Top:=ARect.Top;
  Result.Bottom:=ARect.Bottom;
End;

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

Procedure DrawSpace(Canvas:TCanvas;Var ARect:TRect;SpaceWidth,MarginSpace:Integer;
                    FromRight:Boolean;IsDraw:Boolean);
Var
  ToPoint,MaxPoint:Integer;
  DrawRect:TRect;
Begin
  If SpaceWidth<0 Then
    Exit;
  If FromRight Then
  Begin
    ToPoint:=ARect.Right-SpaceWidth;
    MaxPoint:=ARect.Left+MarginSpace;
    If ToPoint<MaxPoint Then
      ToPoint:=MaxPoint;
    DrawRect:=Rect(ToPoint,ARect.Top,ARect.Right,ARect.Bottom);
  End
  Else
  Begin
    ToPoint:=ARect.Left+SpaceWidth;
    MaxPoint:=ARect.Right-MarginSpace;
    If ToPoint>MaxPoint Then
      ToPoint:=MaxPoint;
    DrawRect:=Rect(ARect.Left,ARect.Top,ToPoint,ARect.Bottom);
  End;
  If Not IsRectEmpty(DrawRect) Then
  Begin
    If IsDraw Then
      Canvas.FillRect(DrawRect);
    If FromRight Then
      ARect.Right:=ToPoint
    Else
      ARect.Left:=ToPoint;
  End;
End;

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

Procedure CorrectLeftByRect(Var InRect:TRect;const OutRect:TRect);
Begin
  If InRect.Left<OutRect.Left Then
    InRect.Left:=OutRect.Left
End;

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

Procedure CorrectTopByRect(Var InRect:TRect;const OutRect:TRect);
Begin
  If InRect.Top<OutRect.Top Then
    InRect.Top:=OutRect.Top
End;

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

Procedure CorrectRightByRect(Var InRect:TRect;const OutRect:TRect);
Begin
  If InRect.Right>OutRect.Right Then
    InRect.Right:=OutRect.Right
End;

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

Procedure CorrectBottomByRect(Var InRect:TRect;const OutRect:TRect);
Begin
  If InRect.Bottom>OutRect.Bottom Then
    InRect.Bottom:=OutRect.Bottom
End;

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