dfstoolbar.pas

动态提示控件

{$I DFS.INC}  { Standard defines for all Delphi Free Stuff components }

{------------------------------------------------------------------------------}
{ TdfsToolBar v1.13                                                            }
{------------------------------------------------------------------------------}
{ A descendant of the TToolBar component (D3, C3, & D4) that adds a            }
{ "maximize - restore" button.  This mimics the behavior of the toolbar in     }
{ Netscape Communicator.  Clicking the button makes the toolbar small, hiding  }
{ its controls.  Clicking again returns it to normal.                          }
{                                                                              }
{ Copyright 2000-2001, Brad Stowers.  All Rights Reserved.                     }
{                                                                              }
{ Copyright:                                                                   }
{ All Delphi Free Stuff (hereafter "DFS") source code is copyrighted by        }
{ Bradley D. Stowers (hereafter "author"), and shall remain the exclusive      }
{ property of the author.                                                      }
{                                                                              }
{ Distribution Rights:                                                         }
{ You are granted a non-exlusive, royalty-free right to produce and distribute }
{ compiled binary files (executables, DLLs, etc.) that are built with any of   }
{ the DFS source code unless specifically stated otherwise.                    }
{ You are further granted permission to redistribute any of the DFS source     }
{ code in source code form, provided that the original archive as found on the }
{ DFS web site (http://www.delphifreestuff.com) is distributed unmodified. For }
{ example, if you create a descendant of TdfsColorButton, you must include in  }
{ the distribution package the colorbtn.zip file in the exact form that you    }
{ downloaded it from http://www.delphifreestuff.com/mine/files/colorbtn.zip.   }
{                                                                              }
{ Restrictions:                                                                }
{ Without the express written consent of the author, you may not:              }
{   * Distribute modified versions of any DFS source code by itself. You must  }
{     include the original archive as you found it at the DFS site.            }
{   * Sell or lease any portion of DFS source code. You are, of course, free   }
{     to sell any of your own original code that works with, enhances, etc.    }
{     DFS source code.                                                         }
{   * Distribute DFS source code for profit.                                   }
{                                                                              }
{ Warranty:                                                                    }
{ There is absolutely no warranty of any kind whatsoever with any of the DFS   }
{ source code (hereafter "software"). The software is provided to you "AS-IS", }
{ and all risks and losses associated with it's use are assumed by you. In no  }
{ event shall the author of the softare, Bradley D. Stowers, be held           }
{ accountable for any damages or losses that may occur from use or misuse of   }
{ the software.                                                                }
{                                                                              }
{ Support:                                                                     }
{ Support is provided via the DFS Support Forum, which is a web-based message  }
{ system.  You can find it at http://www.delphifreestuff.com/discus/           }
{ All DFS source code is provided free of charge. As such, I can not guarantee }
{ any support whatsoever. While I do try to answer all questions that I        }
{ receive, and address all problems that are reported to me, you must          }
{ understand that I simply can not guarantee that this will always be so.      }
{                                                                              }
{ Clarifications:                                                              }
{ If you need any further information, please feel free to contact me directly.}
{ This agreement can be found online at my site in the "Miscellaneous" section.}
{------------------------------------------------------------------------------}
{ The lateset version of my components are always available on the web at:     }
{   http://www.delphifreestuff.com/                                            }
{ See DFSToolBar.txt for notes, known issues, and revision history.            }
{------------------------------------------------------------------------------}
{ Date last modified:  June 28, 2001                                           }
{------------------------------------------------------------------------------}


unit dfsToolBar;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ToolWin, ComCtrls;

const
  { This shuts up C++Builder 3 about the redefiniton being different. There
    seems to be no equivalent in C1.  Sorry. }
  {$IFDEF DFS_CPPB_3_UP}
  {$EXTERNALSYM DFS_COMPONENT_VERSION}
  {$ENDIF}
  DFS_COMPONENT_VERSION = 'TdfsToolBar v1.13';
  DEF_BUTTON_HIGHLIGHT_COLOR = $00FFCFCF; // same as RGB(207,207,255)

type
  TdfsOrientation = (oHorizontal, oVertical);

  TdfsToolBar = class(TToolBar)
  private
    FCaption: string;
    FShowTab: boolean;
    FTextureColor1: TColor;
    FTabColor: TColor;
    FArrowColor: TColor;
    FTextureColor2: TColor;
    FTabHighlightColor: TColor;
    FOnRestore: TNotifyEvent;
    FOnMaximize: TNotifyEvent;
    FMaximized: boolean;
    FRestoreVal: integer;
    FRestoreAutosize: boolean;
    FTabSizeMaximized: integer;
    FTabSizeMinimized: integer;
    FTabIndent: integer;
    FGotMouseDown: boolean;
    FIsHighlighted: boolean;
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
    procedure WMNCLButtonDown(var Message: TWMNCLButtonDown);
       message WM_NCLBUTTONDOWN;
    procedure WMNCLButtonUp(var Message: TWMNCLButtonUp); message WM_NCLBUTTONUP;
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
    procedure CMMouseLeave(var Msg: TWMMouse); message CM_MOUSELEAVE;
    function GetVersion: string;
    procedure SetArrowColor(const Value: TColor);
    procedure SetTabColor(const Value: TColor);
    procedure SetTabHighlightColor(const Value: TColor);
    procedure SetShowTab(const Value: boolean);
    procedure SetTextureColor1(const Value: TColor);
    procedure SetTextureColor2(const Value: TColor);
    procedure SetVersion(const Value: string);
    procedure SetMaximized(const Value: boolean);
    function GetHeight: integer;
    function GetWidth: integer;
    function GetOrientation: TdfsOrientation;
    procedure SetCaption(const Value: string);
    procedure SetHeight(const Value: integer);
    procedure SetWidth(const Value: integer);
    procedure SetTabSizeMaximized(const Value: integer);
    procedure SetTabSizeMinimized(const Value: integer);
    procedure SetTabIndent(const Value: integer);
    function GetTabRect: TRect;
    function GetAutoSize: boolean;
    procedure ReplacementSetAutoSize(Value: boolean);
    function GetAlign: TAlign;
    procedure SetAlign(const Value: TAlign);
    procedure CMFontChanged(var TMessage); message CM_FONTCHANGED;
  protected
    procedure DoMaximize; dynamic;
    procedure DoRestore; dynamic;
    procedure PaintTab(Highlight: boolean); dynamic;
    function TabHitTest(X, Y: integer): boolean; dynamic;
    function DrawArrow(ACanvas: TCanvas; AvailableRect: TRect; Offset: integer;
       ArrowSize: integer; Color: TColor): integer; dynamic;
    procedure InvalidateNonclientArea;
    procedure Resize; override;
    property Orientation: TdfsOrientation
      read GetOrientation;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    // SCREEN-RELATIVE!!!!
    property TabRect: TRect
       read GetTabRect;
  published
    // Overriden properties
    property Height: integer
       read GetHeight
       write SetHeight;
    property Width: integer
       read GetWidth
       write SetWidth;
    property AutoSize: boolean
       read GetAutoSize
       write ReplacementSetAutoSize;
    property Align: TAlign
       read GetAlign
       write SetAlign;

    // New Stuff
    property Version: string
       read GetVersion
       write SetVersion
       stored FALSE;
    property Caption: string
       read FCaption
       write SetCaption;
    property ShowTab: boolean
       read FShowTab
       write SetShowTab
       default TRUE;
    property Maximized: boolean
       read FMaximized
       write SetMaximized
       default TRUE;
    property TabColor: TColor
       read FTabColor
       write SetTabColor
       default clBtnFace;
    property ArrowColor: TColor
       read FArrowColor
       write SetArrowColor
       default clNavy;
    property TabHighlightColor: TColor
       read FTabHighlightColor
       write SetTabHighlightColor
       default DEF_BUTTON_HIGHLIGHT_COLOR;
    property TextureColor1: TColor
       read FTextureColor1
       write SetTextureColor1
       default clWhite;
    property TextureColor2: TColor
       read FTextureColor2
       write SetTextureColor2
       default clNavy;
    property TabSizeMaximized: integer
       read FTabSizeMaximized
       write SetTabSizeMaximized
       default 10;
    property TabSizeMinimized: integer
       read FTabSizeMinimized
       write SetTabSizeMinimized
       default 62;
    property TabIndent: integer
       read FTabIndent
       write SetTabIndent
       default 4;

    property OnMaximize: TNotifyEvent
       read FOnMaximize
       write FOnMaximize;
    property OnRestore: TNotifyEvent
       read FOnRestore
       write FOnRestore;
  end;

implementation

{ TdfsToolBar }

constructor TdfsToolBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FIsHighlighted := FALSE;
  FShowTab := TRUE;
  FTabColor := clBtnFace;
  FArrowColor := clNavy;
  FTabHighlightColor := DEF_BUTTON_HIGHLIGHT_COLOR;
  FTextureColor1 := clWhite;
  FTextureColor2 := clNavy;
  FMaximized := TRUE;
  FTabSizeMaximized := 10;
  FTabSizeMinimized := 62;
  FTabIndent := 4;
  FRestoreVal := Height;
  FGotMouseDown := FALSE;
  FRestoreAutosize := AutoSize;
end;

destructor TdfsToolBar.Destroy;
begin
  inherited Destroy;
end;


function TdfsToolBar.GetHeight: integer;
begin
  // If the component is being written to the DFM file, we need to tell it the
  // toolbar's real size if it's minimized.
  if (csWriting in ComponentState) and (not Maximized) and
     (Orientation = oHorizontal) then
    Result := FRestoreVal
  else
    Result := inherited Height;
end;

// This is SCREEN-RELATIVE!!!
function TdfsToolBar.GetTabRect: TRect;
begin
  // Have to use this since we are in the non-client area
  GetWindowRect(Handle, Result);

  // Adjust for EdgeBorders property
  if ebTop in EdgeBorders then
    inc(Result.Top, 2);
  if ebLeft in EdgeBorders then
    inc(Result.Left, 2);
  if ebBottom in EdgeBorders then
    dec(Result.Bottom, 2);
  if ebRight in EdgeBorders then
    dec(Result.Right, 2);

  if FMaximized then
  begin
    // paint skinny tab
    if Orientation = oVertical then
      Result.Bottom := Result.Top + FTabSizeMaximized
    else
      Result.Right := Result.Left + FTabSizeMaximized;
  end else begin
    // paint wide tab
    if Orientation = oVertical then
      Result.Bottom := Result.Top + FTabSizeMinimized
    else
      Result.Right := Result.Left + FTabSizeMinimized;
  end;
end;

function TdfsToolBar.GetVersion: string;
begin
  Result := DFS_COMPONENT_VERSION;
end;

function TdfsToolBar.GetWidth: integer;
begin
  // If the component is being written to the DFM file, we need to tell it the
  // toolbar's real size if it's minimized.
  if (csWriting in ComponentState) and (not Maximized) and
     (Orientation = oVertical) then
    Result := FRestoreVal
  else
    Result := inherited Width;
end;

procedure TdfsToolBar.PaintTab(Highlight: boolean);
const
  TEXTURE_SIZE = 3;
var
  TR, R: TRect;
  TextureBmp: TBitmap;
  RW, RH: integer;
  TabCanvas: TCanvas;
  x, y: integer;
  Poly: array[0..4] of TPoint;